Trailing-Edge
-
PDP-10 Archives
-
BB-JR93K-BB_1990
-
10,7/link/lnknew.mac
There are 53 other files named lnknew.mac in the archive. Click here to see a list.
TITLE LNKNEW - LOAD NEW BLOCKS MODULE FOR LINK
SUBTTL D.M.NIXON/DMN/JLd/TXR/JNG/DZN/PAH/PY/HD/RJF 22-SEP-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,OVRPAR ;[1704]
SALL
ENTRY LNKNEW
EXTERN LNKSCN,LNKLOD,LNKCOR,LNKWLD,LNKLOG,LNKCST
CUSTVR==0 ;CUSTOMER VERSION
DECVER==6 ;DEC VERSION
DECMVR==0 ;DEC MINOR VERSION
DECEVR==2422 ;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
;52 ADD ASCIZ TEXT BLOCK
;START OF VERSION 2
;141 TURN ON AND FIX BUGS IN ASCII TEXT BLOCKS
;START OF VERSION 2B
;253 Correct problems with ASCII blocks: make work with
; CCL entry; cause multiple line blocks to not lose
; characters by initializing byte pointer once (here).
;404 Re-insert edits 344 and 340, which got lost.
;405 Recover if EOF encountered while reading ASCII text.
;411 Don't try to free core here that was freed in LNKSCN.
;START OF VERSION 2C
;454 Allow (but ignore) the trace blocks from MAKLIB.
;471 Add code for ALGOL debugging system.
;517 Make first word of ALGOL symbol file be 1044,,count.
;530 Get definition of triplet flag bits right.
;534 Store files from the same .TEXT block in the right order.
;557 Clean up the listing for release.
;START OF VERSION 3A
;560 Release on both TOPS-10 and TOPS-20 as LINK version 3A(560)
;START OF VERSION 4
;731 SEARCH MACTEN,UUOSYM
;765 Release on both TOPS-10 and TOPS-20 as LINK version 4(765)
;Start of version 5I
;1000 Add Block 1070
;START OF VERSION 4A
;1174 Label and clean up all error messages.
;1212 Use E$$NEB instead of EOFTS label in T.1003 (in an off conditional).
;1217 Clean up the listings for release.
;1220 Release on both TOPS-10 and TOPS-20 as version 4A(1220).
;1303 Change the LNKLNM message to also include the file name.
;START OF VERSION 5
;1405 New blocks T.1010 thru T.1134 and supporting routines added.
;1426 Delete redundant T.1042-T.1044 routines introduced during merge.
;1430 Remove .NWBLK conditionals forcing an error from T.1060 blocks,
; and ignore them.
;1434 New block type 1004 ( byte pointer initialization ) added.
;1440 Apply edit 1240,1237, and 1120 to the new blocks.
;1443 Make sure PDV .REL blocks aren't in LINK-10.
;1445 Typo in block type 1004 corrected.
;1452 Lengthen LITYPE bounds to include all new blocks.
;START OF VERSION 5A
;1467 Change D.IN1 call to D.CNT at T1004C.
;1470 Correct stack discipline in T.1004 and make sure there are
; no index registers on return from T.1S6
;1471 Remove use of T.11XX and PB.1 from type 1130 blocks, which
; have no relocation words, also alter type 112x block to
; handle just one relocation byte.
;1472 Get the right number of chars for a function name and
; don't lose the count, in T.112X. Use symbols for the
; offsets. Also clean up the dispatch macros.
;
;1500-1677 Reserved for Maintenance
;1503 Make 1010-1034 blocks do thirty-bit reloc on their start addresses.
;
;1510 Test for include mode at LNKNEW+4.
;1701 Correct typos in T.1130 introduced during V5A source merge.
;1704 Handle Type 1045 block.
;1706 Handle COMMONs in Type 1045 properly.
;1707 Correct typo in 1706.
;1712 Call WRTPTR not WRTDAT at T1045C+3.
;1714 Remove increment of RC.CV in TNYBTL, this should be done at
; end of module.
;1720 Change POPJ to POP at REL.TB+2.
;1721 Correct space initialization at TNYBTB+17.
;1722 Fix RLADD not to lose right half is left half is absolute.
;1726 Fixes to 101X block processing to speed up loops and avoid some
; boundary errors.
;1730 Test limit values and handle overlays okay in Type 101x block
; processing.
;1742 Don't lose the section number when calling T.1AD from T.1004.
;1745 Don't lose T4 across the call to DY.GET in T.1045 processing.
;1754 Type 1072 block support.
;1770 Change JRST CPOPJ to POPJ P, at TSTSEG+5
;1776 Change call to T.1AD from T.1004, include call in T.1010-1034.
;2005 Store module name for 112x blocks.
;2007 Give the LNKUCB message a long error message.
;2020 Add a word to the typechecking blocks for linking them together.
;2022 Change tests at T1045C to terminate more surely.
;2026 Update copyright and cleanup listings.
;2031 Don't set the writable bit in OVERLW unless actually doing overlays.
;2072 Skip unused byte when relocating the address in type 102X blocks.
;2073 Add contents of WRTDAT, not address of WRTDAT in WRTPTR.
;Start of Version 6
;2200 Use 30 bit addresses in fixup blocks for SY.CHP
;2205 Don't add 30 bit address to 18 bit byte pointer.
;2212 Fix problems with type 1072 long polish block.
;2222 Implement the type 1050, 1051, and 1052 rel blocks.
;2223 Implement the type 1131 psect redirection block.
;2231 Fix typo in edit 2223.
;2236 Keep stack straight for long symbols in type 1131.
;2246 Fix chained and additive fixups.
;2247 Allow for .LOW. not existing yet.
;2254 Remove FAIL block header chain, use 30 bit NAMPTR.
;2255 Use 30 bit addresses for LS area fixups.
;2262 Implement the 1160 data block, use common code for the 1004 block.
;2266 Don't truncate type 112x symbol names.
;2270 Allow type 112x blocks to page.
;2272 Default psects to .LOW. and .HIGH. in the type 1131 block.
;2301 Handle error from D.CNT correctly.
;2303 Push correct register in non-symbolic type 1004 blocks.
;2305 Make 1070 blocks work, Make 1002 blocks work
;2307 Fix problem with typechecking routines with six character names.
;2310 Implement the type 1074 long symbol common block.
;2313 Make type 1004 and 1160 work in overlays.
;2324 Make polish chained fixup handlers clear P1 before calling SY.CHx.
;2326 Make 1003 (long title) blocks work
;2327 Fix problem with relocation in type 1160 block.
;2333 Set flags for fixup block in 1070 code.
;2340 Check for invalid psect index in 1074.
;2343 Fix problem with sparse data below address 140.
;2345 Clean up and fix t1003 block code.
;2366 Fix type 1160 block on TOPS-10.
;2377 Fix 1045 for long symbols.
;2400 Restore W2 after call to T.6RED in X03OK.
;2401 Fix off by one bug in 1002 block code.
;2403 New coporate copywrite statement.
;2410 Fix X160SS so TAB.UW doesn't get updated unless we are paging.
;2411 Fix all kinds of problems with long symbol entry counts.
;2417 Update copywrite statement to 1988.
;2422 Failed to initialize ABLNK after allocating a typechecking block.
SUBTTL BLOCK DISPATCH TABLES
XALL
NDSPTB: LITYPE (1000,1160) ;[2262]
NDISPL==.-NDSPTB
SALL
SUBTTL DISPATCH TO NEW BLOCK TYPE
;ENTER WITH BLOCK TYPE IN T1
;ALSO IN W1
LNKNEW: CAILE T1,1777 ;IS IT DEC SUPPLIED
JRST LNKCST ;NO, TRY CUSTOMER LINK ITEMS
CAIL T1,1000+NDISPL*2 ;IS IT LEGAL TYPE
JRST E$$IRB## ;[1174] NO, NOT YET AVAILABLE
TRNE FL,R.LIB!R.INC ;[1510] IN LIBRARY SEARCH MODE?
JRST T.SRCH ;YES, IGNORE IF NOT ENTRY BLOCK TYPE
HRREI T2,-<1000+NDISPL>(T1) ;OFFSET TYPE
JUMPGE T2,.+2 ;IF NEGATIVE, USE RHS
SKIPA T2,NDSPTB+NDISPL(T2) ;USE RIGHT HALF
HLRZ T2,NDSPTB(T2) ;USE LEFT HALF
JRST (T2) ;DISPATCH
;HERE IF IN LIBRARY SEARCH MODE - TEST FOR BLOCK TYPE 1001, 1002
T.SRCH: CAIN T1,1001 ;IS IT ENTRY BLOCK?
JRST T.1001 ;YES, SEE IF WE WANT IT
CAIN T1,1002 ;OR EXTENDED ENTRY BLOCK?
JRST T.1002
CAIN T1,1003 ;TITLE BLOCK (INCASE /INCLUDE)
JRST T.1003
JRST T.1000 ;IGNORE THIS BLOCK
SUBTTL BLOCK TYPE 1000 - JUNK WORDS
; ----------------
; ! 1000 ! COUNT !
; ----------------
; ! DATA WORD !
; ----------------
; ! DATA WORDS !
; ----------------
T.1000: HRRZ T1,W1 ;GET WORD COUNT
JUMPE T1,LOAD## ;JUST IGNORE
T1000A: CAML T1,DCBUF+2 ;ENOUGH WORDS IN BLOCK?
SOJA T1,T1000B ;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
T1000B: SUB T1,DCBUF+2 ;COUNT DOWN WORDS IN BUFFER
PUSHJ P,D.INP## ;GET NEXT BUFFER
JRST T1000A ;FINISH OFF BLOCK
T1000C: MOVNI W1,400000(WC) ;[2262] PUT WORD COUNT IN W1
JRST T.1000 ;[2262] IGNORE REST OF BLOCK
SUBTTL BLOCK TYPE 1001 - SINGLE WORD ENTRIES
; ----------------
; ! 1001 ! COUNT !
; ----------------
; ! SYMBOLS !
; ----------------
; ! SYMBOLS !
; ----------------
IFE .NWBLK,<
T.1001==E$$IRB## ;[1174] ILLEGAL IF NOT THERE
> ;END IFE .NWBLK
IFN .NWBLK,<
T.1001: MOVEI T2,0(W1) ;GET NUMBER OF ENTRIES IN THIS MODULE
MOVE R3,T2 ;SAFE PLACE FOR COUNT DOWN
JUMPE T2,LOAD## ;IGNORE 0 ENTRIES
SKIPN ENTPTR ;ALREADY SOME ENTRIES FOR THIS MODULE?
JRST T1001E ;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 T1001D
;HERE WHEN THIS IS THE FIRST BLOCK TYPE 1001,1002 OR 4 SEEN.
T1001E: 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
T1001D: HRLI W3,(POINT 36) ;SO USE AS DEPOSIT BYTE POINTER
TRNN FL,R.LIB ;IN LIBRARY SEARCH MODE
JRST T1001B ;NO, JUST STORE SYMBOLS FOR LATER
T1001A: SOJLE R3,LOAD## ;END OF BLOCK
PUSHJ P,D.IN1## ;READ A WORD
MOVE W2,W1 ;PUT SYMBOL IN SYMBOL ACC
SETZ W1, ;ZERO FLAGS
IDPB W2,W3 ;STORE ENTRY
PUSHJ P,TRYSYM## ;SEE IF SYMBOL IS IN TABLE
JRST T1001A ;NO, TRY NEXT
TRZA FL,R.LIB ;UNDEF, CLEAR SKIP CONTROL
JRST T1001A ;DEFINED, DON'T NEED THIS DEFINITION
T1001B: SOJL R3,LOAD## ;END OF BLOCK
PUSHJ P,D.IN1##
IDPB W1,W3 ;STORE
JRST T1001B ;LOOP
>
SUBTTL BLOCK TYPE 1002 - LONG SYMBOL ENTRY
; ----------------
; ! 1002 ! COUNT !
; ----------------
; ! SYMBOL !
; ----------------
; ! MORE SYMBOL !
; ----------------
; // ... //
; ----------------
; ! 0 ! ;[2411]
; ----------------
IFE .NWBLK,<
T.1002==E$$IRB## ;[1174] ERROR UNLESS FIXED
> ;END IFE .NWBLK
IFN .NWBLK,<
T.1002: MOVEI R3,0(W1) ;GET NUMBER OF WORDS OF ENTRY IN THIS BLOCK
CAIG R3,2 ;[2401] TREAT 0 AND 1 AS T.1001
JRST T.1001 ;NOT A LONG SYMBOL
CAIL R3,<SYMSIZ-1> ;[2305] IS IT LONGER THAN MAX NAME SIZE?
PUSHJ P,E$$STL ;[2305] YES - GIVE ERROR
MOVEI T2,1 ;NEED ONE MORE WORD FOR POINTER
SKIPN ENTPTR ;ALREADY SOME ENTRIES FOR THIS MODULE?
JRST T1002E ;NO
HLRO T1,ENTPTR ;GET -NUMBER
SUB T2,T1 ;NUMBER WE NEED
PUSHJ P,DY.GET## ;GET IT
HRLZ T3,ENTPTR ;FORM BLT PTR
HRRI T3,1(T1) ;[2411] BUT LEAVE SPACE AT TOP
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
HRRZ W3,ENTPTR ;RESET W3 TO POINT TO TOP ITEM (HOLE)
JRST T1002D
T1002E: 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
T1002D: MOVE T2,R3 ;[2305] get count for this entry name
SUBI T2,1 ;[2401] don't count header word in sym length
PUSHJ P,DY.GET## ;[2305] get the space we need
MOVN T2,T2 ;[2305] negate the length
HRLS T2 ;[2305] make left half of aobjn pointer
HRR T2,T1 ;[2305] make right half of abojn (addres of dy
;[2305] block for name)
T1002L: PUSHJ P,D.IN1 ;[2305]
MOVEM W1,(T2) ;[2305] store a word
AOBJN T2,T1002L ;[2305]
JRST T1002B ;[2305]
MOVEI T2,-1(R3) ;THESE MANY EXTRA (AFTER FIRST) WORDS
ROTC T1,-1 ;CUT IN HALF
SKIPGE T1 ;NO CARRY
ADDI T2,1 ;EXTRA BLOCK FOR LAST WORD
IMULI T2,.L ;THESE MANY WORDS IN TRIPLETS
ADDI T2,.L ;PLUS INITIAL ONE
HRLZM T2,0(W3) ;STORE WORD COUNT IN EMPTY SLOT
TRNE T2,770000 ;UNLESS SYMBOL IS SUPER LONG
ADDI T2,1 ;IN WHICH CASE ONE MORE FOR COUNT
PUSHJ P,DY.GET## ;GET SPACE
HRRM T1,0(W3) ;STORE POINTER ADDRESS
TRNE T2,770000 ;FIX IF SUPER LONG
JRST [HRRZS 0(W3) ;CLEAR COUNT
MOVEM T2,0(T1) ;STORE AS FIRST WORD
AOJA T1,.+1] ;PASS OVER IT
HRRZ W3,T1 ;USE DATA BLOCK TO STORE ENTRY
HRLI W3,(POINT 36) ;SO USE AS DEPOSIT BYTE POINTER
MOVX W1,PT.SYM!PT.EXT ;SOME FLAGS
IDPB W1,W3
PUSHJ P,D.IN1## ;GET FIRST 6
IDPB W1,W3 ;STORE ALSO
MOVE W2,W1 ;SAVE FIRST 6 CHARS
SETZ W1, ;ZERO VALUE
IDPB W1,W3
T1002A: SOJLE R3,T1002B ;END OF BLOCK
MOVX W1,S.LST ;CLEAR LAST TRIPLET FLAG IN PREV
ANDCAM W1,-2(W3) ;SINCE WE NOW COME AFTER IT
MOVX W1,S.SYM!S.LNM!S.LST ;SECONDARY FLAGS
IDPB W1,W3
PUSHJ P,D.IN1## ;READ A WORD
IDPB W1,W3 ;STORE SYMBOL
SOJLE R3,T1002B ;END OF BLOCK
PUSHJ P,D.IN1## ;NO
IDPB W1,W3 ;STORE SECOND WORD
JRST T1002A ;LOOP
;HERE WHEN SYMBOL STORED
T1002B: HRL T1,R3 ;[2305] GET THE COUNT
MOVE T2,ENTPTR ;[2305]
MOVEM T1,(T2)
TRNN FL,R.LIB ;IN LIBRARY SEARCH MODE?
JRST LOAD## ;NO, SYMBOL STORED SO GET NEXT BLOCK
MOVE W2,(W3) ;[2411] ADDRESS OF SYMBOL NAME TO W2
SOS R3 ;[2411] NUMBER OF WORDS IN LONG SYMBOL
HRL W2,R3 ;[2411] COUNT,,ADDRESS OF SYMBOL NAME
PUSHJ P,TRYSYM## ;SEE IF SYMBOL IS IN TABLE
JRST LOAD## ;NO, GET NEXT BLOCK
TRZ FL,R.LIB ;UNDEF, CLEAR SKIP CONTROL
JRST LOAD## ;DEFINED, DON'T NEED THIS DEFINITION
>
SUBTTL BLOCK TYPE 1003 - NAME
; _____________________________________________________
; | 1003 | Long count |
; -----------------------------------------------------
; | 1 | Count of Title words |
; -----------------------------------------------------
; | Program Title |
; -----------------------------------------------------
; | additional program title |
; -----------------------------------------------------
; | additional program title |
; -----------------------------------------------------
; . . .
; _____________________________________________________
; | 2 | # ascii comment words |
; -----------------------------------------------------
; | comment word |
; -----------------------------------------------------
; | more comment words |
; -----------------------------------------------------
; . . .
; _____________________________________________________
; | 3 | count of compiler words |
; -----------------------------------------------------
; | compiler code | CPU bits |
; ------------------------------------------------------
; | Compiler name (in ascii) |
; ------------------------------------------------------
; | additional compiler name |
; ------------------------------------------------------
; | additional compiler name |
; ------------------------------------------------------
; . . .
; ______________________________________________________
; | 4 | 0 |
; ------------------------------------------------------
; | Compile Date and Time |
; ------------------------------------------------------
; | Compiler version number |
; ------------------------------------------------------
; | 5 | 0 |
; ------------------------------------------------------
; | Device Name |
; ------------------------------------------------------
; | UFD or 0 for TOPS-20 |
; ------------------------------------------------------
; | 6 | 0 |
; ------------------------------------------------------
; | Tops-10 file Name |
; ------------------------------------------------------
; | file extention | 0 |
; ------------------------------------------------------
; | 7 | number of SFDs |
; ------------------------------------------------------
; | SFD 1 |
; ------------------------------------------------------
; | SFD 2 |
; -----------------------------------------------------
; . . .
; ______________________________________________________
; | 10 | Number of TOPS-20 file |
; | | spec words (in ascii) |
; ------------------------------------------------------
; | TOPS-20 file spec |
; ------------------------------------------------------
; | more TOPS-20 file spec |
; ------------------------------------------------------
; . . .
; ______________________________________________________
; | 11 | 0 |
; ------------------------------------------------------
; | Source version number |
; ------------------------------------------------------
; | Date | Time |
; ------------------------------------------------------
IFE .NWBLK,<
T.1003==E$$IRB##
>
;HERE ON A BLOCK TYPE 1003 (NAME BLOCK)
;THE W'S CONTAIN THE CURRENT TRIPLET AND THE T'S ARE SCRATCH.
T.1003: RELOCATE (NONE) ;THIS BLOCK TYPE CONTAINS NO RELOCATION
TRNE FL,R.LIB!R.INC ;NEED AN EXCUSE TO LOAD THIS?
SKIPE INCPTR ;ANY POSSIBILITY WE'LL GET ONE?
CAIA ;DON'T NEED AN EXCUSE OR COULD GET ONE
JRST T1000C ;[2345] NO CHANCE, JUST IGNORE THIS BLOCK
PUSHJ P,D.GET1
PUSHJ P,T1003E ;ERROR
HLR T1,W1 ;[2326] get the sub-block code
HRRZS W1 ;[2326] save just sub-block count
CAIE T1,1 ;[2326] this is first sub-block must be name
;[2326] sub-block
JRST E$$IRB ;[2326] else the block is bad
XCT X03BIT(T1) ;[2326] set the correct bits in flag word (w1)
MOVE T1,W1 ;COPY FLAGS FOR DESTRUCTIVE TESTING
TXC T1,PT.SGN!PT.TTL ;THESE BITS SHOULD BE ON
TXZ T1,PT.EXT ;IGNORE THIS BIT HOWEVER
TROE FL,R.LOD ;DID WE SEE AND END BLOCK FOR LAST PRGM?
PUSHJ P,E$$NEB## ;[1212] WARN USER, BUT TRY TO CONTINUE
TRNE FL,R.FHS ;FORCED TO HIGH SEGMENT?
PUSHJ P,T1003H ;YES, MAKE SURE THERE IS ONE
PUSHJ P,X03TTL ;[2326] get the module name
;[2326] Now check /include /exclude to see if we have to load this module
TRNE FL,R.LIB!R.INC
JRST X03INC
SKIPN EXCPTR ;[2326] if any /excludes
SKIPE INCPTR ;[2326] no but may have to purge entry in
;[2326] include list.
JRST X03EXC ;[2326] see if should be excluded (t.6exc)
X03OK: TRZ FL,R.LIB!R.INC ;[2326] loading this module for sure
MOVEM W2,PRGNAM ;[2326] save name for error messages
SKIPE REDLO ;[2326] doing /REDIRECT
PUSHJ P,T.6RED## ;[2326] yes so do it
TRNE FL,R.FHS ;[2326] need to adjust relocation tables?
PUSHJ P,T.6RC## ;[2326] yes so do it
MOVE W2,PRGNAM ;[2400] get back name incase T.6RED called
MOVE T1,LSYM ;WORD COUNT IN LOCAL SYMBOL TABLE
MOVEM T1,NAMPTR ;POINT TO THIS TITLE BLOCK
PUSHJ P,E$$LMN## ;[2326] tell that this module is being loaded
SETZM W3 ;[2326] zero w3
PUSHJ P,X03ADD ;[2326] since it is loaded put in local symbol
;[2326] for map
AOS PRGNO ;[2326] one more module seen
X03SRT: PUSHJ P,D.GET1 ;[2326] get the next word
JRST X03ND ;[2345] go output seg info
HRRZ T1,W1 ;[2326] get count if any
HLRZ T2,W1 ;[2326] get the sub-block code for index
SKIPLE T2 ;[2345] Index must be greater than 0
CAIL T2,MAXBIT ;[2345] but less than maximun index
JRST T1003E ;[2345] Not a valid sub-block index code
XCT X03BIT(T2) ;[2326] set the appropriate bits in w1
XCT X03JMP(T2) ;[2326] go to the appropriate routine
;[2326] this routine handles the CPU code and the compiler name and code.
X03PRC: HRRZ P1,T1 ;[2326] save count of extra compiler name words
HLLZS W1 ;[2326] clear the count from flag word
PUSH P,W1 ;[2326] put the flags on the stack
PUSH P,P1 ;[2326] store the count since p1 is used later
PUSHJ P,D.GET1 ;[2326] get the next word
JRST T1003E ;[2345] something is wrong with rel blk
MOVE W2,W1 ;[2326] first compiler & CPU bits to w2
LDB T1,[POINT 6,W2,5] ;[2345] get runnable cpu bits
ANDI T1,CP.MSK ;[2326] clear CPUS we don't know about
SKIPN T1 ;[2345] asked for none?
MOVEI T1,CP.MSK ;[2326] yes--means all
HRRZM T1,CTYPE ;[2326] save with compiler type
MOVE T2,CPUTGT ;[2326] get target CPUs
JUMPE T2,x03TGT ;[2326] the CPU switches are not being used
TDON T1,T2 ;[2326] test for a good target switch
JRST E$$CPU## ;[2326] .DIRECTIVE is for wrong CPU
X03TGT: SKIPN OKCPUS ;[2345] can any CPU run this code?
JRST X03END ;[2345] no--forget this test
ANDM T1,OKCPUS ;[2326] enforce CPU flags
SKIPN OKCPUS ;[2326] can prog run at all now?
PUSHJ P,E$$CCD## ;[2326] no--CPU conflict detected
X03END: LDB T1,[POINT 12,W2,17] ;[2345] now get processor type
CAILE T1,CT.LEN ;[2326] check for range
SETZ T1, ;[2326] make it unknown
HRLM T1,CTYPE ;[2326] save compiler type
MOVE T2,PROCSN ;[2326] get list of procs seen so far
MOVE P1,T1 ;[2326] safe place
PUSH P,W2 ;[2345] put on stack for CT.NAM(t1) call
XCT CT.NAM##(T1) ;[2326] proc routines expect many ACs + (p)
MOVE T1,CT.BIT##(P1) ;[2326] get corresponding bit
IORM T1,PROCSN ;[2326] signal we have seen this one
IORM T1,LIBPRC ;[2326] a new module this library pass
POP P,W2 ;[2326] clear flags off stack
POP P,P1 ;[2326] restore count of name words
JUMPE P1,NONAME ;[2345] check for no compiler name
PUSHJ P,D.GET1 ;[2326] get next word - 1st name word
JRST T1003E ;[2345] something is wrong with rel blk
SKIPA W3,W1 ;[2345] put first compiler name word in w3
NONAME: SETZM W3 ;[2345] if no compiler word then put in 0
POP P,W1 ;[2345] restore compiler type and CPU bits
PUSHJ P,LS.ADD## ;[2326] store the triplet
SOS P1 ;[2326] decrement count of
JRST RELLP ;[2326] check and put rest of long compiler
;[2326] name in the ls area
;[2326] this routine takes the string stored as count,,address in w2 and builds
;[2326] triplets then stores them in ls area.
X03ADD: TLNE W2,770000 ;[2326] is it a long title?
PJRST LS.ADD## ;[2345] no - just one words worth - go do it
HLRZ P1,W2 ;[2326] count of words to p1
HLLZS W1 ;[2326] clear count form w1 need to set trip
;[2326] bits there
HRRZ P2,W2 ;[2326] the address of string to p2
CAILE P1,1 ;[2326] do we need extended triplets
TXC W1,PS.EXO ;[2326] yes extended triplets to follow
PUSHJ P,X031WD ;[2326] build primary triplet
TXZ W1,PS.EXO ;[2326] clear secondary following bit
TXZ W1,PT.SGN!PT.EXT;[2326] clear primary flags
TRPLP: JUMPLE P1,DONE ;[2326] have we finished?
CAIGE P1,2 ;[2326] need whole triplet?
JRST X031WD ;[2326] no - build last triplet
PUSHJ P,X03TRP ;[2326] yes - build whole triplet
JRST TRPLP ;[2326] go back and check for more
DONE: POPJ P, ;[2326] finished
;[2326] build whole triplet from string address stored in p2,
;[2326] count stored in p1.
X03TRP: DMOVE W2,@P2 ;[2326] put the 2 words in w2, w3
SUBI P1,2 ;[2326] two words stored so decrement count
ADDI p2,2 ;[2326] got two so bump address
PUSHJ P, LS.ADD## ;[2326] put them in the ls area
POPJ P,
;[2326] build a triplet with only one word of title left and store in ls area
X031WD: MOVE W2,@P2 ;[2326] get word form source and put in w2
SETZM W3 ;[2326] zero w3
SOS P1 ;[2326] subtract one from count
AOS P2 ;[2326] add one to the address
PJRST LS.ADD## ;[2345] store the triplet in the ls area
;[2326] This routine builds triplets from the rel file and stores them in the
;[2326] ls area enters with the flags in w1 and count in right half of w1.
;[2326] Gets the next two words and puts them in w2,and w3.
X03STR: HRRZ P1,T1 ;[2326] count of words to p1
PUSHJ P,X03TRW ;[2326] build primary triplet
RELLP: JUMPLE P1,X03SRT ;[2345] go back for next sub-block
CAIGE P1,2 ;[2326] need whole triplet?
JRST X031RW ;[2326] no - build last triplet
PUSHJ P,X03TRW ;[2326] yes - build whole triplet
JRST RELLP
;[2326] gets a word form the rel block and put it in w2, zeroes w3, then
;[2326] stores the triplet in the ls area.
X031RW: PUSH P,W1 ;[2326] save the flags
PUSHJ P,D.GET1 ;[2326] get the next word from the rel file
JRST T1003E ;[2345] something is wrong with the rel block
MOVE W2,W1 ;[2326] put the word in w2
SETZM W3 ;[2326] third word is a zero
POP P,W1 ;[2326] restore the flags
SUBI P1,1 ;[2326] decrease the count of words
PUSHJ P,LS.ADD## ;[2326] store the triplet in the ls area
JRST X03SRT ;[2345] back for the next sub-block
;[2326] gets two words from the rel block and puts them in w2,w3 then
;[2326] stores the triplet in the ls area.
X03TRW: PUSH P,W1 ;[2326] save the flags
PUSHJ P,D.GET1 ;[2326] get the next word for rel block
JRST T1003E ;[2345] something is wrong
MOVE W2,W1 ;[2326] word to w2
PUSHJ P,D.GET1 ;[2326] get the next word from the rel block
JRST T1003E ;[2345] block is bad
MOVE W3,W1 ;[2326] last word for the triplet
SUBI P1,2 ;[2326] 2 words gone
POP P,W1 ;[2326] get back the flags
PJRST LS.ADD## ;[2345] store the triplet in the ls area
;[2326] this routine gets the name words and builds the name in NAMBLK for
;[2326] testing against /INCLUDES, /EXCLUDES
X03TTL: HRRZ T2,W1 ;[2326]* count of title words to t2
CAIL T2,SYMSIZ ;[2345] is it longer than max symbol length?
PUSHJ P,E$$STL ;[2326] Yes - give an error
PUSH P,W1 ;[2326] save the flags
CAIG T2,1
JRST X03SHT ;[2326] just one word so put in w2
TXC W1,PT.EXT ;[2326] need additional triplets
MOVNS T2 ;[2326] negative count
HRLZS T2 ;[2326] put it in left half for AOBJN ptr
X03LP: PUSHJ P,D.GET1 ;[2326] get the next name word
JRST LOAD ;[2326] end of block
MOVEM W1,NAMBLK(T2) ;[2326] store the next word
AOBJN T2,X03LP ;[2326] done? - no get the next word
MOVEI W2,NAMBLK ;[2326] address of title to w2
POP P,W1 ;[2326] restore the flags
HRL W2,W1 ;[2326] count to left of w2
SETZM W3 ;[2326] zero last word of triplet
HLLZS W1 ;[2326] don't want count in flag word
POPJ P, ;[2326] all done
X03SHT: PUSHJ P,D.GET1 ;[2326] get the name word
JRST T1003E ;[2345] error bad rel block
SKIPN W2,W1 ;[2345] put it in w2
MOVE W2,[SIXBIT/.MAIN./] ;[2326] yes - use the default name
SETZM W3 ;[2326] zero w3
POP P,W1 ;[2326] restore the flags
POPJ P, ;[2326] return
;[2326] Now we have the name as count,,ptr in program name and stored in LS.
;[2326] lets see if we need to load this module.
X03INC: PUSHJ P,INCCHK## ;[2326] check /INCLUDES
SKIPA ;[2326] don't load this module
JRST X03OK ;[2326] found it in /INCLUDES so go load it
TRZA FL,R.LOD ;[2326] not there clear loading flag
X03POP: TRO FL,R.LIB ;[2326] cause module to be ignored by /EXCLUDE
POP P,W1 ;[2326] restore w1
JRST T1000C ;[2326] ignore rest of the block
;[2326] check the /EXCLUDE to see if it's there
X03EXC: PUSHJ P,EXCCHK## ;[2326] see if in the /EXCLUDE list
JRST X03POP ;[2326] yes so don't load this module
JRST X03OK ;[2326] not excluded so go load
X03STT: PUSHJ P,X03TRW ;[2326] store triplet in ls area
JRST X03SRT ;[2326] back for the next part
;[2326] table of bits that get set according to left half of sub-block flag
;[2326] word. The code in the sub-block flag word is the index into the table
;[2326] and the bits are saved in the first word of the ls triplets generated
;[2326] by the sub-blocks.
X03BIT: JFCL ;[2326]
TXO W1,PT.SGN!PT.TTL!PT.EXT ;[2345] sign, primary title, extended
MOVX W1,S.TTL!S.CMT ;[2345] comment
MOVX W1,S.TTL!S.PRC!S.CMT ;[2345] Processor
MOVX W1,S.TTL!S.CRE ;[2345] Creation date
MOVX W1,S.TTL!S.DEV ;[2345] Device
MOVX W1,S.TTL!S.NAM ;[2345] File name
MOVX W1,S.TTL!S.SFD ;[2345] Sfd
MOVX W1,S.TTL!S.FIL ;[2345] TOPS-20 file spec
MOVX W1,S.TTL!S.VER ;[2345] Source version number
MAXBIT== . - X03BIT ;[2345] table size
;[2326] Table of routines to execute based on the code in left half of
;[2326] sub-block flag word. Uses that code as index to table.
X03JMP: JRST T1003E ;[2345] Bad sub-block code
JRST T1003E ;[2345] Second name sub-block - error
JRST X03STR ;[2345] Comment sub-block - store ascii text
JRST X03PRC ;[2345] Compile/CPU sub-block check processor info
JRST X03STT ;[2345] Compile date/time/version # - 3 word sub-blocks
JRST X03STT ;[2345] Device/UFD - 3 word sub-block
JRST X03STT ;[2345] TOPS-10 file spec/ext - 3 word sub-block
JRST X03STR ;[2345] SFDs
JRST X03STR ;[2345] TOPS-20 file spec
JRST X03STT ;[2345] Source version number/date and time
;HERE IF /SEG:HIGH. MAKE SURE HIGH SEG EXISTS, THEN FAKE THE RC TABLES.
T1003H: PUSH P,W1 ;SAVE OVER SETRC CALL
SETZ W1, ;CREATE HIGH SEGMENT WITH DEFAULT ORIGIN
SKIPN SG.TB+2 ;HIGH SEGMENT EXIST ALREADY?
PUSHJ P,SETRC## ;NO, CREATE ONE
MOVEI R,1 ;NOW MAKE .LOW. POINT TO HIGH SEG
MOVE T1,SG.TB+2 ;ADDR OF HIGH SEG DATA BLOCK
MOVEM T1,@RC.TB ;MAKE .LOW. (RC #1) POINT TO IT
POP P,W1 ;RESTORE FLAGS OF NEXT TRIPLET
POPJ P,
;Here after all sub-blocks have been processed. Call TTLRCL to put the segment
;descriptor triplets in the LS area. Then go get the next block.
X03ND: PUSHJ P,TTLRLC## ;[2345] build segment info triplets-put in LS
JRST LOAD## ;[2345] get the next block
;HERE ON SOME TYPE OF ERROR OR INVALID FORMAT IN THE 1003 BLOCK TYPE
T1003E: MOVEI T1,1003 ;SHOULD NEVER GET HERE
JRST E$$IRB## ;[1174] SO WARN THE USER
SUBTTL BLOCK TYPE 1004 - BYTE ARRAY INITIALIZATION
; or
;
; ---------------- ----------------
; ! 1004 ! count ! ! 1004 ! count !
; ---------------- ----------------
; ! relocation ! ! relocation !
; ---------------- ----------------
; ! byte count ! ! global symbol!
; ---------------- ----------------
; ! byte pointer ! ! byte count !
; ---------------- ----------------
; ! byte string ! ! byte pointer !
; ---------------- ----------------
; ! ... ! ! byte string !
; ---------------- ----------------
; ! ... !
; ----------------
T.1004: PUSHJ P,RB.2## ;READ AND RELOCATE FIRST TWO WORDS
JRST LOAD## ;[2262] FAILED, TRY NEXT BLOCK
SETZ W3, ;[2205] VALUE OF SYMBOL (ZERO IF NONE)
TLNN W2,770000 ;IS IT A 6-BIT GLOBAL SYMBOL?
JRST T1004A ;NO
PUSH P,W1 ;YES, SAVE BYTE COUNT
PUSHJ P,T.1S6## ;CALL T.1 CODE TO EVALUATE SYMBOL
SKIPA W3,W2 ;[2262] KEEP THE SYMBOL VALUE
T1004A: PUSH P,W2 ;[2303] SAVE BYTE COUNT
LDB T3,[POINT 6,W1,11] ;GET BYTE SIZE
MOVEM T3,BYTSIZ ;[2262] SAVE IT
LDB T1,[POINT 6,W1,5] ;[2262] GET BYTE POSITION
MOVEM T1,BYTPOS ;[2262] SAVE IT
MOVEM W1,BYTADR ;[2262] STORE IT
MOVEI T1,1 ;[2262] GET THE REPETITION COUNT
MOVEM T1,REPCNT ;[2262] SET IT
SETZM FILCNT ;[2262] 1004 BLOCKS DON'T FILL
POP P,W1 ;[2262] GET THE BYTE COUNT
MOVEM W1,BYTCNT ;[2262] SAVE IT
PUSHJ P,X160SZ ;[2262] FIX UP THE BYTE POINTER
;[2262] The following calculation deliberately throws away the carry
;[2262] which may have occured by incrementing BYTADR in X160SZ. This
;[2262] is because FORTRAN uses a 777777 address in a byte pointer to
;[2262] point to the beginning of a common block.
HLLZ T2,LSTRRV ;[2262] GET THE SECTION NUMBER
HLLM T2,BYTADR ;[2205] PUT IT INTO THE ADDRESS (CLOBBER CARRY)
ADDM W3,BYTADR ;[2262] AND ADD THE SYMBOL
JRST T1160S ;[2262] JOIN THE COMMON CODE
;Enter here from error in T.1S code
;Clean up and just ignore this block.
T1004U::.ERR. (MS,.EC,V%L,L%W,S%W,USB,<Undefined symbol in byte array (type 1004) block>)
.ETC. (JMP,,,,,.ETIMF##)
POP P,T1 ;POP OFF THE RETURN ADDRESS
MOVE R3,-1(P) ;RESTORE THE WORD COUNT
SUBI R3,3 ;ACCOUNT FOR THE WORDS WE HAVE ALREADY READ
T1004Z: POP P,T1 ;CLEAN UP THE STACK
POP P,T1 ; ...
POP P,P3 ;[1470] ...
MOVE W1,R3 ;RESTORE WORD COUNT
JRST T.1000 ;AND JUST IGNORE THE BLOCK
SUBTTL BLOCK TYPE 1010-1014 RIGHT HALF RELOCATION
;
; --------------------
; ! 101X ! n ! header word
; !------------------!
; !b1!b2! ... !bi! -----
; !------------------! !
; ! beginning addr. ! !
; !------------------! !
; ! data 1 ! !--- subblock
; !------------------! !
; // .... // !
; !------------------!
; ! data(i-1) ! -----
; --------------------
; ...
;**;[2072] Replace 2 lines at T1004Z+25L. PAH 19-Jul-84
DEFINE NEWBLK(RBSIZ,RBNUM,RELTYP,ROFF<0>)< ;;[2072]
MOVE P1,[POINT RBSIZ,RB,<RBSIZ*ROFF>-1] ;;[2072]
MOVEI P2,RBNUM ;;NUMBER OF RELOC BYTES
MOVE P4,[ RELTYP ] ;;HOW TO DO THE RELOC
JRST T.NYBT ;;COMMON CODE TO INTERPRET THIS
> ;[1405]
CPSECT=.TEMP ;[2262] TEMPORARY
T.1010::
NEWBLK(2,^D18,RADD) ;[1405]
T.1011::
NEWBLK(3,^D12,RADD) ;[1405]
T.1012::
NEWBLK(6,6,RADD) ;[1405]
T.1013::
NEWBLK(9,4,RADD) ;[1405]
T.1014::
NEWBLK(18,2,RADD) ;[1405]
SUBTTL BLOCK TYPES 1020-1023 LEFT/RIGHT HALFWORD RELOCATION
;
; --------------------
; ! 102X ! n !
; !------------------!
; !l1,r1! ... !li,ri! --
; !------------------! |
; ! beginning addr. ! |
; !------------------! |
; ! data 1 ! |
; !------------------! | -- subblock
; // .... // |
; !------------------! |
; ! data(i-1) ! |
; -------------------- --
; ...
;
T.1020::
;**;[2072] Change 1 line at T.1020+1. PAH 19-Jul-84
NEWBLK(2,^D9,RLADD,1) ;[2072]
T.1021::
;**;[2072] Change 1 line at T.1021+1. PAH 19-Jul-84
NEWBLK(3,6,RLADD,1) ;[2072]
T.1022::
;**;[2072] Change 1 line at T.1022+1. PAH 19-Jul-84
NEWBLK(6,3,RLADD,1) ;[2072]
T.1023::
;**;[2072] Change 1 line at T.1023+1. PAH 19-Jul-84
NEWBLK(9,2,RLADD,1) ;[2072]
SUBTTL BLOCK TYPES 1030-1034 FOR 30-BIT RELOCATION
;
; --------------------
; ! 103X ! n ! header word
; !------------------!
; !b1!b2! ... !bi! -----
; !------------------! !
; ! beginning addr. ! !
; !------------------! !
; ! data 1 ! !--- subblock
; !------------------! !
; // .... // !
; !------------------!
; ! data(i-1) ! -----
; --------------------
;
T.1030::
NEWBLK(2,^D18,THADD) ;[1405]
T.1031::
NEWBLK(3,^D12,THADD) ;[1405]
T.1032::
NEWBLK(6,6,THADD) ;[1405]
T.1033::
NEWBLK(9,4,THADD) ;[1405]
T.1034::
NEWBLK(18,2,THADD) ;[1405]
SUBTTL SUBROUTINES SUPPORTING BLOCK TYPES 1010-1034
PB.1:
;
; This routine can return in one of three ways:
; +1 means the end of the REL block has been seen.
; +2 means the end of the sub-block has been seen.
; +3 means that a word has been placed in W1 and its
; corresponding psect index is found in R
;
TRNN WC,377777 ;[1405] END OF BLOCK?
JRST PB0 ;[1405] YES, RETURN +1
PUSHJ P,D.IN1## ;[1471] PICK UP A WORD
AOBJP WC,PB1 ;[1471] END OF SUBBLOCK?
ILDB R,P1 ;[1405] AND A PSECT INDEX
PB2: AOS (P) ;[1405]
PB1: AOS (P) ;[1405]
PB0: POPJ P, ;[1405]
PSORGN:
;
; On entry, R contains a psect index.
; Check this index against the total number seen.
; Return in R the pointer to this psect's relocation counter
JUMPE R,CPOPJ ;[1444] LEAVE ABS DATA ALONE
CAMG R,RC.NO ;PSECT INDEX EXIST?
JRST PSORG0 ;[1405] YES
CAIG R,2 ;[1405] MIGHT BE TWOSEG?
TRNN FL,R.TWSG ;[1405]
JRST E$$IPX## ;NO, GIVE ERROR
SKIPA ;[1405] YES, FETCH COUNTER DIRECTLY
PSORG0: HRRZ R,@RC.MAP ;[1444] GET INTERNAL PSECT NUMBER
MOVE R,@RC.TB ;[1405] FETCH COUNTER
SKIPGE RC.AT(R) ;[1405] ORIGIN SET?
PUSHJ P,R.ERR## ;[2247] NO, NEEDS AN ORIGIN
POPJ P, ;[1405] RETURN
RADD:
;
; Right-half relocation.
;
JUMPE R,CPOPJ ;[1444] LEAVE ABS VALUES ALONE
HRR T2,W1 ;[1444] PICK UP THE HALFWORD
PUSHJ P,TSTSEG ;[1444]
ADD T1,T2 ;[1444] ADD IN THE PSECT ORIGIN
HRR W1,T1 ;[1405] RELOCATED HALFWORD
POPJ P,
THADD:
;
; Thirty-bit relocation.
;
JUMPE R,CPOPJ ;[1444] LEAVE ABS VALUES ALONE
LDB T2,[POINT 30,W1,35] ;[1405] PICK UP EXTENDED ADDR
PUSHJ P,TSTSEG ;[1444]
ADD T1,T2 ;[1444] ADD IN THE PSECT ORIGIN
DPB T1,[POINT 30,W1,35] ;[1405] AND PUT IT BACK
POPJ P,
RLADD:
;
; Relocation of left and right halfwords.
;
JUMPE R,LADD ;[1722] LEAVE ABS VALUES ALONE
HLR T2,W1 ;[1444] PICK UP LEFT HALF
PUSHJ P,TSTSEG ;[1444]
ADD T1,T2 ;[1444] ADD IN THE PSECT ORIGIN
;**;[2072] Change 1 line at RLADD+8L. PAH 19-Jul-84
HRLM T1,W1 ;[2072] RELOCATED LEFT HALF
LADD: ILDB R,P1 ;[1722] FETCH NEXT RELOC BYTE
PUSHJ P,PSORGN ;[1405] CHECK IT OVER
JRST RADD ;[1405] FINISH WITH RIGHTHALF
TSTSEG:
; [1444] This routine picks up the value to be added in for relocating
; a word against a psect -- special case code for .HIGH. and .LOW. is
; here.
MOVE T1,RC.NM(R) ;[1444] WHAT IS IT?
CAME T1,[SIXBIT /.HIGH./] ;[1444] HIGHSEG?
CAMN T1,[SIXBIT /.LOW./] ;[1444] OR LOWSEG?
JRST [ MOVE T1,RC.SG(R) ;[1444] IF SO,
MOVE T1,LL.S0(T1) ;[1444] CALCULATE RELOCATION
ADD T1,RC.CV(R) ;[1444] SOMEWHAT DIFFERENTLY
SUB T1,RC.IV(R) ;[1444]
JRST CPOPJ ] ;[1444] AND RETURN
MOVE T1,RC.CV(R) ;[1727] ELSE RELOC WRT. ORIGIN
POPJ P, ;[1770]
T.NYBT:
;
; T.1010 through T.1037 come here after setting up ACs as follows:
; P1 -an initialized byte pointer for the relocation bytes
; P2 -number of relocation bytes in the word
; P4 -dispatch address for type of relocation (left,right,30bit)
;
SPUSH <P1,P2> ;[1405] SAVE REGISTERS
TNYBTB: MOVN T1,P2 ;[1726] WC GETS SUBBLOCK COUNT AGAIN
HRLI WC,-2(T1) ;[1726] COUNT INCLUDES RELOC WORD
; BEGIN PROCESSING A SUB-BLOCK
PUSHJ P,PB.1 ;[1405] FETCH FIRST WORD OF BLOCK
JRST [ SPOP <P2,P1>
JRST LOAD ] ;[1405] NO MORE IN BLOCK
JFCL ;[1405] "IMPOSSIBLE"
MOVE RB,W1 ;[1405] SETUP RELOC BYTE
MOVE P1,-1(P) ;[1405] RESET BYTEPOINTER
PUSHJ P,PB.1 ;[1405] FETCH START ADDRESS
JRST [ SPOP <P2,P1>
JRST LOAD ] ;[1405] NO MORE
JFCL ;[1405] "IMPOSSIBLE"
PUSHJ P,PSORGN ;[1405] FETCH THE RELOC COUNTER PTR
MOVEM R,CPSECT ;[1405] "CURRENT PSECT" COUNTER PTR
PUSHJ P,THADD ;[1503] RELOCATE THE START ADDR
MOVE P3,W1 ;[1405] PICK UP START ADDRESS
;
;[1721] Here compute the size of the subblock into P2 The number of
;[1721] of words in the rest of the block is in the right half of WC and the
;[1721] subblock cannot have more than P2-1 words in it.
;
HRROI T1,400000(WC) ;[1721] RECOVER SIZE OF BLOCK ( RH OF
MOVN T1,T1 ;[1721] WC CONTAINS -( SIZE + 400000 )
SUBI P2,2 ;[1721] SIZE OF SUBBLOCK IN P2 INCLUDES
;[1721] REL WORD, SO DECR IT ONCE AND
;[1721] AGAIN FOR THE FENCE IN
;[1721] "FINISH=START+SIZE-1" BELOW
CAIL P2,-1(T1) ;[1721] SHORT SUBBLOCK?
MOVEI P2,-1(T1) ;[1721] YES, USE SIZE OF BLOCK-1
ADDB P2,W1 ;[1776] HIGHEST LOCATION TO BE LOADED
PUSHJ P,T.1AD ;[1776]
JFCL ;[1776] THROW IT AWAY
JFCL ;[1776] DEFER IT AWHILE
TNYBTL: PUSHJ P,PB.1 ;[1405] FETCH A DATA WORD
JRST [ SPOP <P2,P1>
JRST LOAD ] ;[1405] NO MORE
JRST [ DMOVE P1,-1(P) ;[1726] FETCH PTR AND COUNT AGAIN
JRST TNYBTB ] ;[1405] RESET FOR NEXT SUBBLOCK
PUSHJ P,PSORGN ;[1405] GET ANY PSECT INDICES
PUSHJ P,@P4 ;[1405] DO THE RELOCATION
IFN FTOVERLAY,<
SKIPE RT.LB ;[1730] DOING OVERLAYS?
SKIPA W3,[JSP T1,CS.RHS##] ;[1730] YES, NOTE OVL RELOC
> ;[1401] END OF IFN FTOVERLAY
MOVE W3,[MOVEM W1,(P3)] ;[1730] NO, SIMPLE DEPOSIT
XCT W3 ;[1730]
AOJA P3,TNYBTL ;[1714] INCR DESTINATION PTR AND
;[1714] DO IT AGAIN
SUBTTL BLOCK TYPES 1042 AND 1043 - PROGRAM AND LIBRARY REQUESTS
; -----------------
; ! 1042 ! COUNT !
; -----------------
; ! DEVICE !
; -----------------
; ! FILE NAME !
; -----------------
; ! EXT !DIR CNT!
; -----------------
; ! PROJ ! PROG !
; -----------------
; ! SFD !
; -----------------
;
; .
;
; .
IFN .NWBLK,<
T.1042: SKIPA P1,[PRGPTR] ;TYPE 1042 IS PROGRAMS TO LOAD
T.1043: MOVEI P1,LIBPTR ;TYPE 1043 IS LIBRARIES TO SEARCH
RELOCATE (NONE) ;FILE NAMES ETC ARE NOT RELOCATABLE
PUSHJ P,D.TRIP ;GET THE 1ST THREE WORDS (REQUIRED)
JRST E$$IRR ;[1174] ERROR - NOT ENOUGH DATA WORDS
T1042A: MOVEI T2,R.LEN ;LENGTH OF A REQUEST/REQUIRE BLOCK
PUSHJ P,DY.GET## ;ALLOCATE ONE
DSTORE W1,<R.DEV(T1)>,<R.NAM(T1)> ;STORE DEVICE & FILENAME
HLLZM W3,R.EXT(T1) ;STORE EXTENSION, BUT NOT COUNT
HRRZ P2,W3 ;REMEMBER DIRECTORY LENGTH IN P2
JUMPE P2,T1042X ;DONE IF NO DIRECTORY GIVEN
PUSHJ P,D.GET1 ;GET THE PPN
JRST E$$IRR ;[1174] ERROR
MOVEM W1,R.PPN(T1) ;REMEMBER IT
SOJLE P2,T1042X ;DONE IF NO SFD'S
MOVE T2,T1 ;GET A COPY OF REQUEST BLOCK POINTER
HRLI T2,-5 ;MAKE AN AOBJN POINTER FOR SFD'S
T1042L: PUSHJ P,D.GET1 ;GET THE NEXT SFD
JRST E$$IRR ;[1174] NONE THERE, COUNT LIED
MOVEM W1,R.SFD(T2) ;STORE THIS SFD
SOJLE P2,T1042X ;QUIT IF COUNT RUNS OUT
AOBJN T2,T1042L ;OR IF NO MORE ROOM IN OUR BUFFERS
T1042X: PUSHJ P,T.RQST## ;GO CHAIN THIS REQUEST IN IF UNIQUE
PUSHJ P,D.TRIP ;ANYTHING ELSE THERE?
JRST LOAD## ;NO, LOAD NEXT BLOCK
JRST T1042A ;YES, LOAD IT TOO
E$$IRR::.ERR. (MS,.EC,V%L,L%W,S%W,IRR,<Illegal request/require block>) ;[1174]
.ETC. (JMP,,,,,.ETNMF##) ;[1174]
JRST LOAD## ;NOT ALWAYS A FATAL ERROR
SUBTTL BLOCK TYPE 1044 - BLOCK STRUCTURED ALGOL LOCAL SYMBOLS
; -----------------
; ! 1044 ! COUNT !
; -----------------
; ! STRUCTURED !
; -----------------
; ! ALGOL SYMBOLS !
; -----------------
; ! SIXBIT - MAY !
; -----------------
; ! BE EXTENDED !
; -----------------
;
; .
;
; .
;THIS BLOCK TYPE INSERTED IN EDIT 471
T.1044: SKIPE NOSYMS ;NO SYMBOLS REQUESTED?
PJRST T.1000 ;YES, DUMP THIS BLOCK
RELOCATE (NONE) ;NO RELOCATION INFO IN ALGOL SYMBOLS
T1044L: PUSHJ P,D.GET1 ;READ NEXT WORD OF DATA
JRST LOAD## ;END OF BLOCK
SKIPG AS.FR ;ENOUGH ROOM LEFT IN AS AREA?
JRST T1044G ;NO, GET SOME MORE
T1044P: MOVEM W1,@AS.PT ;PUT CURRENT DATUM IN PLACE
AOS AS.PT ;UPDATE FREE POINTER
SOS AS.FR ;AND FREE COUNT
AOS ASYM ;COUNT ONE MORE WORD OF ALGOL SYMBOLS
JRST T1044L ;LOOP OVER ENTIRE ALGOL SYMBOL BLOCK
;HERE TO GET MORE FREE SPACE IN THE AS AREA
T1044G: MOVEI P1,AS.IX ;POINT TO THE AS AREA FOR LNKCOR
SKIPN AS.LB ;HAS AREA BEEN SETUP?
JRST T1044I ;NO, GO INITIALIZE IT
MOVEI P2,1 ;EXPAND BY ONE BLOCK
PUSHJ P,LNKCOR## ;GET THE CORE
PUSHJ P,E$$MEF## ;CAN'T???
JRST T1044P ;NOW GO PUT THE SYMBOL INTO THE FILE
;HERE TO INITIALIZE THE AS AREA (FIRST TIME TYPE 1044 SEEN).
T1044I: PUSHJ P,XX.INI## ;CALL GENERAL INITIALIZER
AOS AS.PT ;RESERVE ROOM FOR COUNT WORD
SOS AS.FR ; BY DECREMENTING ALL COUNTS
AOS ASYM ; AS IF ONE WORD HAD BEEN USED
JRST T1044P ;NOW PUT AWAY THE DATA
> ;IFN .NWBLK
SUBTTL BLOCK TYPE 1045 - DECLARE WRITABLE OVERLAY LINKS
T.1045::
PUSHJ P,STDATA ;[1704] USE GENERAL ROUTINE
PUSH P,W2 ;[1704] SAVE THE BLOCK IOWD
MOVE T4,W2 ;[1707] PUT THE IOWD IN W1
MOVX T1,$OVWRITABLE ;[1704] WRITABLE OVERLAY IS INDICATED
SKIPE OVERLW ;[2031] DON'T SET UNLESS DOING OVERLAYS
IORM T1,OVERLW ;[1704] REMEMBER THIS
SKIPN WRTDAT ;[1704] HAS A TABLE BEEN SET UP?
JRST [ MOVEI T2,WR.LEN ;[1704] FETCH WORDS NEEDED
PUSH P,T4 ;[1745] SAVE POINTER
PUSHJ P,DY.GET## ;[1704] ...
POP P,T4 ;[1745] RESTORE POINTER
MOVEM T1,WRTDAT ;[1704]
JRST .+1 ] ;[1704]
MOVE T1,(T4) ;[1704] CHECK WRITABLE BIT OF BLOCK
TLNN T1,200000 ;[1704]
JRST T1045A ;[1704] CURRENT LINK NOT WRITABLE
HRLZI T1,400000 ;[1704] SET SIGN BIT IN WRTDAT
IORM T1,WRTDAT ;[1704] SO /LINK CAN DEAL WITH IT
T1045A: AOBJP T4,T1045X ;[1704] UNTIL NO MORE
MOVE W2,(T4) ;[1704] PICK UP FIRST NAME
TLNN W2,770000 ;[2377] IS IT A LONG NAME?
PUSHJ P,T1045L ;[2377] YES IT IS
MOVX W1,PT.SGN!PT.SYM!PS.GLB!PS.COM!PS.REL
;[1706] SET SOME LIKELY FLAGS
PUSHJ P,TRYSYM## ;[1706] SEE IF KNOWN COMMON NAME
JRST E$$UCB ;[1706] WHOLLY UNKNOWN
JRST E$$UCB ;[1706] UNDEFINED ( NOT COMMON )
MOVE T1,(P1) ;[1706] GET PRIMARY FLAGS
TXNN T1,PS.COM ;[1706] ALREADY COMMON?
JRST E$$SNC## ;[1706] NO, ERROR
;IN WHAT LINK DOES THIS COMMON RESIDE?
TXNE T1,PS.BGS ;[1706] FROM SOMEPLACE ELSE?
JRST T1045B ;[1706] YES! WHERE?
HRLZI T1,400000 ;[1706] SET SIGN BIT IN WRTDAT
IORM T1,WRTDAT ;[1706] SO /LINK CAN DEAL WITH IT
JRST T1045A ;[1706] AND LOOK AT THE NEXT ONE
T1045B: MOVS P1,LSTPTR ;[1706] WALK BACKWARDS THROUGH TREE
T1045C:
TRNN P1,-1 ;[2022] REACHED ROOT?
JRST T1045A ;[2022] YES, CHECK THE NEXT
HRRZ T1,(P1) ;[1706] GET LINK#
HRRZ P1,1(P1) ;[2022] AND NEXT PTR
PUSHJ P,WRTPTR ;[1712] SET IT WRITABLE
MOVX T2,OW.WRT ;[1706] ...
DPB T2,T1 ;[1706] ...
JRST T1045C ;[1706] DO IT AGAIN
T1045X: POP P,W2 ;[1704] THROW AWAY THE BLOCK
HLRZ T2,W2 ;[1704]
MOVN T2,T2 ;[1704]
HRRZ T1,W2 ;[1704]
PUSHJ P,DY.RET## ;[1704]
JRST LOAD## ;[1704] ALL DONE
T1045L: CAILE W2,<SYMSIZ+1> ;[2377] Less than max sym size?
PUSHJ P,E$$STL ;[2377] Too long - give error
CAIGE W2,2 ;[2377] Need at least one word of symbol
JRST E$$IRB ;[2377] No symbol - illegal rel block
CAIN W2,2 ;[2377] More than one word of symbol name?
JRST [ AOBJP T4,E$$IRB ;[2377] Bad REL block
MOVE W2,(T4) ;[2377] Move name to w2
POPJ P,]
PUSH P,T3
PUSH P,T2 ;[2377] Long name - save T2
HLRE T2,T4 ;[2377] Count for AOBJN pointer
ADD T2,W2 ;[2377] Add number of name words to count
PUSH P,T2 ;[2377] Save for the return
MOVNS W2 ;[2377] Negate it count
HRL T4,W2 ;[2377] Count for new AOBJN pointer
SETZ T2, ;[2377] Clear T2
t1045H: AOBJP T4,T1045E ;[2377] Bump the AOBJN pointer
MOVE T3,(T4) ;[2377] Get the next symbol name word
MOVEM T3,SYMBLK(T2) ;[2377] Move name to SYMBLK
AOS T2 ;[2377] Bump index
JRST T1045H ;[2377] Go get next word
T1045E: MOVEI T2,SYMBLK ;[2377] Address of SYMBLK
MOVMS W2 ;[2377] Make count positive
SOS W2 ;[2377] Minus one for count word
MOVSS W2 ;[2377] Into the left half
HRR W2,T2 ;[2377] W2 gets count,,address
POP P,T2 ;[2377] Restore count left in Rel block
HRL T4,T2 ;[2377] Count for AOBJP pointer for return
POP P,T2 ;[2377] Restore T2
POP P,T3 ;[2377] Restore T3
POPJ P, ;[2377] Return
E$$UCB::.ERR. (MS,.EC,V%L,L%W,S%W,UCB,<Unknown COMMON />) ;[2007]
.ETC. (SBX,.EC!.EP,,,,W2) ;[1706]
.ETC. (STR,,,,,,</ referenced >) ;[1706]
JRST T1045A ;[1706] TRY TO GET ANOTHER
;WRTPTR RETURNS A BYTE POINTER TO THE WRITABLE LINK FLAGS FOR A SPECIFIED LINK.
;THIS IS USED TO TEST AND SET THE WRITABLE STATUS OF A LINK. THE CALL IS:
;
; T1/ LINK NUMBER
;
;ON RETURN, T1 CONTAINS THE BYTE POINTER. T2 IS USED.
WRTPTR::
IDIVI T1,^D18 ;[1704] FLAGS ARE 2 BITS PER LINK
ADD T1,WRTDAT ;[2073] ADD BASE ADDRESS
HRLI T1,(POINT 2,0,35) ;[2073] ADD TEMPLATE BYTE POINTER
IMULI T2,-2 ;[1704] COMPUTE P FIELD OF BYTE POINTER
ADDI T2,^D36 ;[1704] ..
DPB T2,[POINT 6,T1,5] ;[1704] STORE IN P FIELD
POPJ P, ;[1704] DONE
SUBTTL BLOCK TYPE 1050 - PSECT NAME BLOCK
; --------------------- ---------------------
; ! 1050 ! COUNT ! ! 1050 ! COUNT !
; --------------------- ---------------------
; ! 0 ! INDEX ! ! 0 ! INDEX !
; --------------------- ---------------------
; ! SIXBIT PSECT NAME ! ! 0 ! MBZ ! COUNT !
; --------------------- ---------------------
; ! (ATTRIBUTES) ! ! SIXBIT PSECT NAME !
; --------------------- ---------------------
; ! (ORIGIN) ! ! ADDITIONAL NAME !
; --------------------- ---------------------
;
; .
;
; .
;
; ---------------------
; ! ADDITIONAL NAME !
; ---------------------
; ! (ATTRIBUTES) !
; ---------------------
; ! (ORIGIN) !
; ---------------------
;[2222] This block sets up W1-W3 and joins common code in the type 24
;[2222] block.
T.1050: SKIPLE MODTYP ;[2222] Twoseg seen in module?
PUSHJ P,E$$MPT## ;[2222] Yes, error
SETOM MODTYP ;[2222] Flag psects seen
PUSHJ P,D.GET1 ;[2222] Get the index
JRST LOAD## ;[2222] Empty block?
MOVEI P1,(W1) ;[2222] Save it in P1
PUSHJ P,SYM.IN ;[2222] Get the psect name
JRST [MOVEI T1,1050 ;[2222] No name?
JRST E$$RBS##] ;[2222] Bad rel block
PUSHJ P,D.GET1 ;[2222] Get the attributes
SETZ W1, ;[2222] No attributes
TXO W1,AT.PS ;[2222] Remember this psect seen in this module
MOVE W3,W1 ;[2222] Save attributes in W3
PUSHJ P,D.GET1 ;[2222] Get the origin
SETZ W1, ;[2222] No origin
JRST T.24B## ;[2222] Join common code
;[2222] Here to read a symbol from the rel file. Returns symbol
;[2222] in W2 if short, length,,pointer in W2 if long. Long symbols
;[2222] are placed in SYMBLK. Returns skip if successful, non-skip
;[2222] if rel block is too short.
SYM.IN: PUSHJ P,D.GET1 ;[2222] Get the name (first word)
POPJ P, ;[2222] No symbol!
MOVE W2,W1 ;[2222] Get the symbol
TLNE W2,770000 ;[2222] Long symbol?
JRST CPOPJ1 ;[2222] No, done
JUMPE W2,CPOPJ1 ;[2223] Done if zero
SYMIN1: CAIN W2,1 ;[2262] Short symbol in disguise?
JRST [PUSHJ P,D.GET1 ;[2223] Yes, get one word
POPJ P, ;[2223] No word means bad rel block
MOVE W2,W1 ;[2223] Put it in W2
JRST CPOPJ1] ;[2223] Return with a short symbol
PUSH P,W2 ;[2222] Save the count
MOVNS W2 ;[2222] Negate it
HRLZS W2 ;[2222] Put it in left half for AOBJN
SYMINL: PUSHJ P,D.GET1 ;[2222] Get a symbol word name
JRST [POP P,W2 ;[2222] No more, clear up the stack
POPJ P,] ;[2222] And return
MOVEM W1,SYMBLK(W2) ;[2222] Store the word
AOBJN W2,SYMINL ;[2222] Go back if more
POP P,W2 ;[2222] Get the count
HRLZS W2 ;[2222] Count in left half
HRRI W2,SYMBLK ;[2222] Address in right half
JRST CPOPJ1 ;[2222] Successful return
SUBTTL BLOCK TYPE 1051 - SET CURRENT PSECT
; ---------------------
; ! 1051 ! COUNT !
; ---------------------
; ! 0 ! INDEX !
; ---------------------
T.1051: PUSHJ P,D.GET1 ;[2222] Get the index
JRST LOAD## ;[2222] Empty block?
MOVEI R,(W1) ;[2222] Psect index in R
CAMLE R,RC.NO ;[2222] Psect index exist?
JRST E$$IPX ;[2222] No, give error
HRRZ R,@RC.MAP ;[2222] Get internal psect number
MOVEM R,RC.CUR ;[2222] Set as the current psect
JRST LOAD## ;[2222] Done
SUBTTL BLOCK TYPE 1052 - PSECT END BLOCK
; ---------------------
; ! 1052 ! COUNT !
; ---------------------
; ! 0 ! INDEX !
; ---------------------
; ! PSECT BREAK !
; ---------------------
;
; .
;
; .
;
; ---------------------
; ! 0 ! INDEX !
; ---------------------
; ! PSECT BREAK !
; ---------------------
T.1052: PUSHJ P,D.GET1 ;[2222] Get the index
JRST LOAD## ;[2222] No more?
MOVEI R,(W1) ;[2222] Psect index in R
CAMLE R,RC.NO ;[2222] Psect index exist?
JRST E$$IPX ;[2222] No, give error
HRRZ R,@RC.MAP ;[2222] Get internal psect number
PUSHJ P,D.GET1 ;[2222] Give me a break
JRST [MOVEI T1,1052 ;[2222] Rel block should not end here
JRST E$$RBS##] ;[2222] Give an error
PUSH P,RC.CUR ;[2222] Save the current psect
MOVEM R,RC.CUR ;[2222] Set as the current psect
MOVE P1,@RC.TB ;[2222] Get pointer to new psect
MOVE T1,W1 ;[2222] Put the break in T1
PUSHJ P,R.CUR## ;[2222] Relocate it
MOVE W1,T1 ;[2222] Get it back
POP P,RC.CUR ;[2222] Restore the current psect
PUSHJ P,CHKSZ0## ;[2222] Check for psect too big
CAMLE W1,RC.HL(P1) ;[2222] A new record for the break?
MOVEM W1,RC.HL(P1) ;[2222] Yes, set HL (CV fixed in T.5)
JRST T.1052 ;[2222] Go back for another
SUBTTL BLOCK TYPE 1060 - BINARY PATCH TRACE BLOCK (MAKLIB)
; -----------------
; ! 1060 ! COUNT !
; -----------------
; ! EDIT NAME !
; -----------------
; ! ACTIV ! LASTA !
; -----------------
; ! CREAT ! DATE !
; -----------------
; ! INSTL ! DATE !
; -----------------
; ! (RESERVED) !
; -----------------
; ! # ASC ! # PCO !
; ----------------- !
; ! ASC EDIT NAME ! ! MAY BE ZERO OR MORE OF
; ----------------- ! THESE ASSOC. EDIT BLOCKS
; ! B0 IF INCLUDE ! !
; ----------------- !
;
; . MAY BE ANY # AND COMBINATION OF BELOW
; -------------------------------------
; .
;
; (INSERT PCO) (REMOVE PCO) (RE-INSERT PCO)
;
; ----------------- ----------------- -----------------
; ! 1 ! COUNT ! ! 2 ! COUNT ! ! 3 ! COUNT !
; ----------------- ----------------- -----------------
; ! RELOC ! ADDR ! ! EDIT NAME ! ! EDIT NAME !
; ----------------- ----------------- -----------------
; ! ORG ! P ADR !
; -----------------
;
; .
;
; .
T.1060==T.1000 ;[1430] IGNORE BLOCK. SHOULD SOMEDAY GO INTO
; LS AREA FOR .MAP FILE.
SUBTTL BLOCK TYPE 1070 - LONG SYMBOL NAME
; ----------------- -----------------
; ! 1070 ! COUNT ! ! 1070 ! COUNT !
; ----------------- OR -----------------
; !CODE! N!R! 0 ! !CODE! N!R! 0 !
; ----------------- -----------------
; ! VALUE ! ! ( PSECTS ) !
; ----------------- -----------------
; ! NAME ! ! VALUE !
; ----------------- -----------------
; ! NAME !
; -----------------
; ! ( . . . ) !
; -----------------
; ! (ADD. VALUE ) !
; -----------------
; ! ( . . . ) !
; -----------------
IFN .NWBLK,<
;THIS BLOCK TYPE INSERTED IN EDIT 1000
T.1070: PUSHJ P,D.GET1 ;GET FLAG WORD
JRST LOAD## ;END OF BLOCK
MOVE P2,W1 ;SAVE ORIGINAL FLAG WORD IN P2
SETO R, ;ASSUME NO EXPLICIT PSECTS
TRZN W1,400000 ;IS THERE A PSECT-WORD?
JRST T1070A ;NO, JUMP
PUSHJ P,D.GET1 ;YES, GET IT
JRST LOAD## ;??
MOVE R,W1 ;R CONTAINS TEMPORARY PSECTS
T1070A: LDB RB,[POINT 3,P2,21] ;RB/ RELOC TYPE
PUSHJ P,REL.1 ;GET RELOCATED VALUE-- W1/FLAG, W3/VALUE
JRST LOAD## ;??
TXO W1,PT.SGN!PT.SYM ;FLAG IT SYMBOL
LDB W2,[POINT 7,P2,17] ;GET N--SYMBOL LENGTH
CAIL W2,<SYMSIZ-1> ;[2305] IS IT LONGER THAN MAX SYMBOL LENGTH?
PUSHJ P,E$$STL ;[2305] YES GIVE AN ERROR
JUMPG W2,[PUSHJ P,T1070E
JRST T1070B]
PUSH P,W1 ;SAVE FLAG
PUSHJ P,D.GET1 ;READ NAME (1 WORD)
JRST LOAD## ;??
MOVE W2,W1 ;MOVE TO RIGHT AC
POP P,W1 ;RECOVER FLAGS(PRIMARY SYMBOL FLAGS)
;THE ORIGINAL FLAG WORD STILL IN P2
T1070B:
.JDDT LNKNEW,T1070B,<<CAMN W2,$SYMBOL##>>
LDB T1,[POINT 7,P2,28] ;[2305] IS IT AN EXTENDED VALUE?
CAIL T1,<SYMSIZ-1> ;[2305] IS IT LONGER THAN MAX SYMBOL LENGTH?
PUSHJ P,E$$STL ;[2305] YES GIVE AN ERROR
SKIPE T1 ;[2305]
PUSHJ P,EXVAL ;[2305] YES SET UP COUNT,,PTR TO VALBLK
SETZ P1, ;P1 & P2 USED IN LSHC FOR DECODING
LSHC P1,3 ;GET FIRST DIGIT OF CODE
PUSHJ P,@T1070T(P1) ;DISPATCH
JRST T.1070 ;LOOP BACK FOR NEXT ENTRY
;FIRST DIGIT DISPATCH TABLE
T1070T: T.1070U ;0XX - NAME (NEVER SHOULD HAPPEN)
T1070L ;1XX - LOCAL
T1070G ;2XX - GLOBAL
SY.BH## ;3XX - BLOCK HEADER (FAIL)
REPEAT 4,<T1070U> ;4XX - 7XX UNDEFINED
;UNDEFINE CODE -- GIVE ERROR MSSG
T1070W: POP P,W1 ;RESTORE FLAG AND THEN ERROR
T1070U: JRST E$$URC## ;OUT WITH ERROR MESSAGE
;L - LOCAL SYMBOL
T1070L: TXO W1,PS.LCL ;DOING LOCAL DEFINITION
SETZ P1, ;SETUP FOR NEXT DIGIT
LSHC P1,3 ;OF 9-BIT CODE
XCT [JFCL ;10X
TXO W1,PS.DDT ;11X - SUPPRESSED TO DDT
TXO W1,PS.MPO ;12X - MAP ONLY
REPEAT 5,<JRST T1070U>](P1) ;13X - 17X NOT DEFINED
SETZ P1, ;SET UP TO GET 3RD DIGIT OF THE 9-BIT CODE
LSHC P1,3 ;
JRST SY.LS## ;FOR ALL 1XX CODE
;G - GLOBAL SYMBOL
T1070G: SETZ P1, ;P1 & P2 USED TO DECODE 9-BIT CODE
LSHC P1,3 ;GET 1ST DIGIT
XCT [JFCL ;20X
TXO W1,PS.DDT ;21X - SUPPRESSED TO DDT
TXO W1,PS.MPO ;22X - MAP ONLY
JRST T1070U ;23X - UNDEFINED
JRST T1070Q ;24X - GLOBAL REQUEST FOR CHIN FIXUP
JRST T1070Q ;25X - GLOBAL REQEST FOR ADDITIVE FIXUP
JRST T1070Q ;26X - GLOBAL REQUEST FOR SYMBOL FIXUP
JRST T1070U](P1) ;27X - UNDEFINED
SETZ P1, ;2ND DIGIT
LSHC P1,3 ;
JRST @[SY.GS## ;200,210,220 - GLOBAL DEFINITION (1WORD VALUE)
SY.GS## ;201,211,221 - (EXTENDED VALUE-NOT IMPLEMNETED)
EXVAL ;[2305] 202,212,222 - NOT DEFINED
SY.DGR## ;3 - RIGHT HALF DEFERRED
SY.DGL## ;4 - LEFT HALF DEFERRED
T1070D ;5 - BOTH HALVES DEFERRED
T1070D ;6 - 30BIT DEFERRED
T1070D](P1) ;7 - FULL WORD DEFERRED
T1070D: TXO W1,PS.UDF ;FULL WORD DEFERRED
JRST SY.DGR## ;
;[2305] Here if V is not zero - stores the value symbol in VALBLK and stores
;[2305] count,,valblk in w3
EXVAL: PUSH P,W1 ;[2305] save flags
MOVEM W3,VALBLK ;[2305] store the first word of extended value
MOVEI W3,VALBLK ;[2305] W3 get address of symbol name
AOS T1 ;[2305] add 1 to count of words (count in block
;[2305] is number of addtional words)
HRL W3,T1 ;[2305] W3 gets count,,valblk
SOS T1 ;[2305] sub 1 from count since one word
;[2305] has been stored
MOVNS T1 ;[2305] negative count for AOBJN
HRLZS T1 ;[2305] put it in the left half
AOS T1 ;[2305] add one to right half for word already
;[2305] done
EXVAL1: PUSHJ P,D.GET1 ;[2305] get next word of extended value symbol
jfcl
;**** ;jrst e$$isn ;[2305] should be more, something is rotten
MOVEM W1,VALBLK(T1) ;[2305] store the name word
AOBJN T1,EXVAL1 ;[2305] done? no go back for next word
POP P,W1 ;[2305] restore flags
POPJ P, ;[2305] return w3/ count,,valblk
;Q - GLOBAL REQUESTS (CODES 24X, 25X, 26X)
T1070Q: PUSH P,P1 ;STORE 2ND DIGIT
SETZ P1, ;SET UP FOR 3RD DIGIT
LSHC P1,3 ;
PUSH P,P1 ;STORE 3RD DIGIT ALSO
TXO W1,PS.REQ ;SET REQUEST FLAG
PUSHJ P,TRYSYM## ;LOCATE THE GLOBAL SYMBOL
JRST T1070I ;NOT FOUND, GO PUT IN
JRST T1070J ;FOUND BUT UNDEFINED, MUST WAIT
JUMPE W3,[ POP P,0(P) ;RESTORE STACK AND RETURN
POP P,0(P) ;FOR A FAKE REQUEST
POPJ P,] ;
IOR W1,0(P1) ;GET FLAGS
TXNN W1,PS.REL ;RELOCATABLE?
TDZA W1,W1 ;NO, CLEAR FLAGS
MOVX W1,FS.REL
MOVEM W1,SYMFLG ;SAVE IT FOR SYMBOL TABLE FIXUP
POP P,T3 ;RESTORE 3RD DIGIT
POP P,T1 ;RESTORE 2ND DIGIT
XCT T1070S(T3) ;[2246] set the bits for type of fixup
CAIN T1,4 ;CHAINED FIXUP?
JRST X70CH ;[2246] check what type of chained fixup
CAIE T1,6 ;SKIPE IF SYMBOL FIXUP
PJRST SY.AD0## ;JUMP IF ADDITIVE
MOVE W2,W3 ;[1002] EXPECT DEFINING SYMBOL IN W3 & REQUEST IN W2
PJRST SY.AS## ;GO DO SYMBOL TABLE FIXUP
X70CH: MOVE T2,W3 ;
MOVE W3,2(P1)
TXNE W1,FS.FXR ;[2246] right half chained fixup?
JRST SY.CHR## ;[2246] yes
TXNE W1,FS.FXL ;[2246] left half chained fixup?
JRST SY.CHL## ;[2246] yes
TXNE W1,FS.FXE ;[2246] thirty bit chained fixup?
JRST SY.CHE## ;[2246] yes
JRST SY.CHF## ;[2246] full word is all that's left
T1070S: JRST T1070X ;2X0 - NOT A REAL FIXUP, RESTORE W1 AND RETURN
JRST T1070W ;2X1 - NOT DEFINED
JRST T1070W ;2X2 - NOT DEFINED
TXO W1,FS.FXR ;2X3 - RIGHT HALF FIXUP
TXO W1,FS.FXL ;2X4 - LEFT HALF FIXUP
JRST T1070W ;2X5 - NOT DEFINED
TXO W1,FS.FXE ;2X6 - EXTENDED(30-BIT) FIXUP
TXO W1,FS.FXF ;2X7 - FULL WORD FIXUP
T1070X: POP P,W1 ;RESTORE W1, THEN RETURN
POPJ P,
;GLOBAL SYMBOL NOT IN TABLE
T1070I: POP P,T3 ;GET BACK 3RD DIGIT
POP P,T2 ;GET 2ND DIGIT
AOS USYM ;COUNT ONE MORE UNDEFINED
CAIN T2,4 ;CHAINED FIXUP
JRST X70CHF ;[2305] Yes go handle chained request
JUMPE T3,INSRT## ;NOT A REAL FIXUP
TXO W1,PS.FXP!PT.EXT ;SET FIXUP FLAG
PUSH P,W1 ;FLAGS ON STACK
MOVX W1,FP.SGN!FP.SYM!FP.PTR ;THESE ARE FOR THE FX BLOCK
XCT T1070S(T3) ;MORE FLAGS
CAIE T2,6 ;SKIPE IF SYMBOL FIXUP
JRST T1070Y ;JUMP IF ADDITIVE FIXUP
TXO W1,FS.FXS ;FLAG SYMBOL FIXUP
PUSHJ P,SY.QS## ;
JRST [SOS USYM ;NON LOADED LOCAL
POP P,W1 ;
POPJ P,]
T1070Y: TXNN W1,PS.EXO ;A LONG SYMBOL NAME?
JRST SY.RQ2## ;NO, JUMP
MOVE P1,LSTGBL ;[2255] GET GS POINTER INTO P1
ADD P1,GS.LB ;MAKE IT ABS
PUSHJ P,INSRT## ;GO INSRT THE SYMBOL FIRST
MOVE W3,2(P1) ;REQUEST ADDR IN W3
MOVE T1,LSTGBL ;[2255] GET THE GLOBAL POINTER
MOVE W3,LSTLCL ;[2255] AND THE LOCAL POINTER
PUSHJ P,SY.RA## ;GO EXTEND THE ENTRY
MOVE W3,P1 ;GET POINTER TO GS
SUB W3,GS.LB ;MAKE IT RELATIVE, NEEDED FOR INSRTL
POPJ P, ;RETURN
X70CHF: CAIN T3,3 ;[2305] is it a right half chained request
JRST INSRT## ;[2305] yes - so just put it in
PUSH P,W1 ;[2305] save the primary flags
MOVX W1,FP.SGN!FP.SYM!FP.PTR ;[2305]
TXO W1,FS.FXC ;[2305] indicate we have a chained request
XCT T1070S(T3) ;[2305] set bit for type chained fixup request
JRST SY.RQ2 ;[2305] say a prayer and off you go.
;GLOBAL SYMBOL FOUND IN TABLE BUT UNDEFINED
T1070J: POP P,T3 ;GET 3RD DIGIT
POP P,T2 ;GET 2ND DIGIT
JUMPE W3,CPOPJ ;DUMMY REQUEST
CAIN T2,4 ;CHAINED REQUEST
JRST [IORM W1,0(P1)
JRST SY.RU3##] ;YES, JUMP
MOVE W1,0(P1)
TXOE W1,PS.FXP ;ALREADY DEFERED FIXUPS?
JRST T1070K ;YES,
PUSH P,W1 ;NO, SAVE PRIMARY FLAGS
MOVX W1,FP.SGN!FP.SYM!FP.PTR ;[2333] SET SOME FLAGS FOR FX BLOCK
XCT T1070S(T3) ;SET FLAGS FOR FX BLOCK
MOVE T1,W2 ;[2255] NAME SHOULD BE IN T1 IF NOT SYMBOL
CAIE T2,6 ;SKIP IF SYMBOL FIXUP
JRST SY.RA## ;JUMP IF ADDITIVE FIXUP
EXCH W2,W3 ;[2305] GET READY FOR CALL TO SY.QS
TXO W1,FS.FXS ;FLAG SYMBOL FIXUP
PUSHJ P,SY.QS##
JRST T1070X
PUSHJ P,TRYSYM ;[2305]
JRST TX70RD ;[2305]
JRST TX70PD ;[2305]
JRST TX70TD ;[2305]
TX70RD: AOS USYM ;[2305]
JRST SY.RQ2## ;[2305]
TX70PD: EXCH W2,W3 ;[2305]
MOVE T1,LSTGBL ;[2255] GET THE GLOBAL POINTER
MOVE W3,LSTLCL ;[2255] AND THE LOCAL POINTER
JRST SY.RA##
TX70TD: JRST SY.RC0## ;[2305]
T1070K: MOVEI T1,0(P1)
ADDI T1,.L
SKIPG W1,0(T1)
JRST SY.RUH##
TXNN W1,S.FXP
JRST T1070K+1
MOVE P1,T1
MOVX W1,FP.SGN!FP.SYM!FP.PTR ;[2333] SET SOME FLAGS FOR FX BLOCK
XCT T1070S(T3)
CAIE T2,6 ;SKIP IF SYMBOL FIXUP
JRST T1070F ;JUMP IF ADDITIVE
TXO W1,FS.FXS ;FLAG SYMBOL FIXUP
PUSHJ P,SY.QS##
POPJ P,
T1070F: HRR W1,2(P1)
SUB P1,NAMLOC
PUSHJ P,SY.FX0##
ADD P1,NAMLOC
HRRM W3,2(P1)
POPJ P,
;E - EXTENDED SYMBOL NAME
T1070E: MOVEI T1,0(W2) ;N (NAME LENGTH ) IN W2
PUSH P,W1 ;SAVE FLAGS
PUSHJ P,D.GET1 ;GET 1ST WORD OF NAME
JRST LOAD## ;
PUSH P,W1 ;SAVE 1ST WORDS OF NAME
PUSHJ P,D.GET1 ;GET 2ND WORD OF NAME
JRST LOAD## ;
JUMPN W1,LNGNM ;WE DO HAVE A LONG NAME, JUMP
POP P,W2 ;ONLY A SHORT NAME , INTO W2
SOJLE T1,.+4 ;FINISHED?
PUSHJ P,D.GET1 ;NO, MORE NULLS PADDED
JRST LOAD## ;
JRST .-3 ;SKIPE OVER THEM
POP P,W1 ;RECOVER FLAGS
POPJ P, ;AND RETURN
;HERE IF WE REALLY HAVE A LONG NAME
; 0(P)/ 1ST WORD OF NAME
; -1(P)/ FLAGS
;[2305] stores the symbol name in SYMBLK
;[2305] stores count,,symblk in W2
LNGNM: POP P,W2 ;1ST WORD OF NAME
EXCH W1,0(P) ;FLAGS INTO W1, AND 2ND WORD OF NAME ON STACK
ADDI T1,1 ;[2305] number of words of symbol name
MOVEM W2,SYMBLK ;[2305] store the first word
HRLZ W2,T1 ;[2305] into the left half of w2
HRRI W2,SYMBLK ;[2305] address of symbol to w2
MOVEI T1,1 ;[2305] set up index to symblk
POP P,T2 ;[2305] get the second word
MOVEM T2,SYMBLK(T1) ;[2305] store it away
AOS T1
HLRZ T2,W2 ;[2305] get the count to t2
SUBI T2,2 ;[2305] minus the words already done
SKIPN T2 ;[2371] if only 2 words then
POPJ P, ;[2371] done so return
MOVNS T2 ;[2305] -count
HRLS T2
HRR T2,T1 ;[2305] AOBJN pointer
PUSH P,W1 ;[2305] save the flags
T1070M: PUSHJ P,D.GET1 ;[2305] get the next name word
JRST LOAD
MOVEM W1,SYMBLK(T2) ;[2305] store the next word
AOBJN T2,T1070M
POP P,W1 ;[2305] restore the flags
POPJ P,
SUBTTL BLOCK TYPE 1072 - POLISH FIXUPS (SUPPORT LONG SYMBOLS)
; ----------------
; ! 1072! COUNT !
; ----------------
; ! BYTE ! BYTE !
; ----------------
;THE POLISH FIXUP BLOCK IS STORED IN THE FX AREA
;THE ACTION IS :-
;(1) READ AND RELOCATE THE FIXUPS
; STORE THEM IN FX AREA
;(1A) FIND THE STORE OPERATOR, AND DELETE THE FIXUP IF
; NOT WANTED (DUE TO NON-LOADED LOCAL OR /ONLY).
;(2) CHECK AND EVALUATE GLOBAL REQUESTS
; STORE VALUES BACK IN FIXUP
;(3) IF THERE ARE NO UNDEFINED GLOBAL REQUESTS
; EVALUATE POLISH AND STORE
;(4) IF THERE ARE UNDEFINED REQUESTS
; LINK GLOBAL SYMBOL TO FIXUP AREA AND CONTINUE
;(5) WHEN LAST UNDEFINED GLOBAL IS DEFINED
; EVALUATE AND STORE
;(6) IF STORE ADDRESS IS PAGED TO DSK
; STORE BACK IN FIXUP AREA AND PROCESS AT END
;HERE TO READ BLOCK AND STORE IN FX AREA
T.1072: 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 LNKNEW,T.1072,<<CAMN T1,$FIXUP##>>
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!FF.NEW) ;[2212] SET POLISH FIXUP BITS
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
;Now read in 2 half words at a time from buffer
;Check to see if a half word is one of the following:
; 1. Psect index
; 2. Operator code
; 3. Store operator code
; 4. Data operator code
;[2212] The primary purpose here is to do the relocation calculation for
;[2212] a relocatable data when one is encountered, and to change the
;[2212] halfword relocatable operator and the store operators to a
;[2212] different format which allows section numbers to be preserved.
MOVE P2,T11BP ;[2212] Byte pointer which will find store op
SETZ P3, ;[2212] Start by reading the first halfword
PUSHJ P,X72GN ;[2212] Get the first halfword
JRST LOAD## ;[2212] Completely empty block
PUSH P,RC.CUR ;[2212] Save current psect
JRST X72RD2 ;[2212] Join the main loop
X72RDF: PUSHJ P,X72SGN ;[2212] Eat a fullword as two halfwords
PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block
X72RDH: PUSHJ P,X72SGN ;[2212] Eat a halfword
PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block
;[2212] Read and decode the next operator
X72RD: PUSHJ P,X72SGN ;[2212] Get next halfword
PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block
;[2212] Check for a psect index
X72RD2: CAIL T1,PL.IL ;[2212] Psect index?
JRST X72PSI ;[2212] Yes
;[2212] Check for a data operator
JUMPE T1,X72RDH ;[2212] If absolute halfword, ignore next half
CAIN T1,PL.ABF ;[2212] Absolute Fullword?
JRST X72RDF ;[2212] Yes, Ignore two halfwords
CAIN T1,PL.RLH ;[2212] Relocatable halfword?
JRST X72RRH ;[2212] Yes, relocate next halfword
CAIN T1,PL.RLF ;[2212] Relocatable fullword?
JRST X72RRF ;[2212] Yes, relocate the next fullword
;[2212] Check for an operator
CAIL T1,PL.OL ;[2212] Too low for operator?
CAILE T1,PL.OH ;[2212] Or too high?
CAIA ;[2212] Not an operator
JRST X72RD ;[2212] An operator, ignore it
;[2212] Check for a store operator or symbol operator
MOVE T2,T1 ;[2212] Get the code
TRZ T2,LENGTH ;[2212] Ignore the count
CAIL T2,PL.SL ;[2212] Store operator?
JRST X72SOP ;[2212] Yes
CAIN T2,PL.SYM ;[2212] Symbol operator?
JRST X72RDS ;[2212] Yes, skip a bunch of halfwords
PUSHJ P,X72IPO ;[2212] Not a valid operator
;[2212] Here to handle a psect index
X72PSI: MOVEI R,-400000(T1) ;[2212] Get the psect index
CAMLE R,RC.NO ;[2212] In bounds?
PUSHJ P,E$$IPX ;[2212] No, die
HRRZ R,@RC.MAP ;[2212] Get the internal psect index
MOVEM R,RC.CUR ;[2212] Set the current index
JRST X72RD ;[2212] Read more operators
;[2212] Here to relocate a fullword
X72RRF: PUSHJ P,X72SGN ;[2212] Get next halfword
PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block
MOVE W3,T1 ;[2212] Keep this halfword
PUSHJ P,X72SGN ;[2212] Get next halfword
PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block
HRL T1,W3 ;[2212] Get back the left half
PUSHJ P,R.CUR## ;[2212] Relocate it
JRST X72BAK ;[2212] Put back the whole word
;[2212] Here to relocate a halfword. This requires replacing the operator,
;[2212] since part of the operator field must be used to remember the section
;[2212] number.
X72RRH: PUSHJ P,X72SGN ;[2212] Get next halfword
PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block
PUSHJ P,R.CUR## ;[2212] Relocate it
TLO T1,PL.NEW ;[2212] Set new halfword operator bits
;Here to put back a fullword in the polish string
X72BAK: JUMPE P3,X72BA1 ;[2212] Was last a right half?
HLRM T1,-1(W2) ;[2212] No, left half is in the previous word
HRL W1,T1 ;[2212] Right half is in left half of this one
JRST X72RD ;[2212] Continue reading the polish string
X72BA1: MOVE W1,T1 ;[2212] Just replace the entire word
JRST X72RD ;[2212] It will be stored soon
;[2212] Here to read a symbol
X72RDS: LSH T1,-^D9 ;[2212] Get the length
JUMPE T1,X72R50 ;[2212] Check for radix-50 special case
CAILE T1,MAXSYM/3-1 ;[2212] Make sure symbol not too big
PUSHJ P,E$$STL ;[2212] Can't handle it
MOVEI W3,1(T1) ;[2212] Count of halfwords to read
X72RS1: PUSHJ P,X72SGN ;[2212] Get next halfword
PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block
SOJG W3,X72RS1 ;[2212] Ignore all of them
JRST X72RD ;[2212] Go back for next operator
X72R50: PUSHJ P,X72SGN ;[2212] Get next halfword
PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block
MOVE W3,T1 ;[2212] Keep this half around
PUSHJ P,X72SGN ;[2212] Get next halfword
PUSHJ P,E$$NSO## ;[2212] Should not fall off end of block
PUSH P,W2 ;[2212] Keep the pointer safe
MOVE W2,T1 ;[2212] get the right half
HRL W2,W3 ;[2212] And the left half
PUSHJ P,R50T6## ;[2212] Convert it to sixbit
MOVE T1,W2 ;[2212] Put it where it belongs
POP P,W2 ;[2212] Get back the pointer
JRST X72BAK ;[2212] Put the word back in the block
;[2212] Here to get a polish halfword and store the previous one. This
;[2212] routine de-blocks the full words supplied by D.GET1 into halfwords.
;[2212] P3 / 0 to read left half, 1 to read right half
;[2212] P2 / Byte pointer for store op
;[2212] W2 / Byte pointer for store
;[2212] W1 / Full word read (returned)
;[2212] T1 / Next halfword (returned)
;[2212] This routine parallels the T11SGN routine in LNKOLD.
X72SGN: JUMPN P3,X72GN1 ;[2212] JUST PROCESSED RHS?
MOVEM W1,(W2) ;[2212] YES--STORE OLD WORD NOW
ADDI W2,1 ;[2212] COUNT ANOTHER WORD STORED
X72GN: JUMPN P3,X72GN1 ;[2212] TIME TO READ A NEW WORD?
PUSHJ P,D.GET1 ;[2212] YES--GET ONE
POPJ P, ;[2212] NO MORE--GIVE NON-SKIP RETURN
HLRZ T1,W1 ;[2212] FIRST TIME GIVE LHS
MOVEI P3,1 ;[2212] SIGNAL RHS FOR NEXT TIME
IBP P2 ;[2212] COUNT ANOTHER BYTE
JRST CPOPJ1 ;[2212] GIVE GOOD RETURN
X72GN1: HRRZ T1,W1 ;[2212] TIME FOR RHS
MOVEI P3,0 ;[2212] SIGNAL LHS FOR NEXT TIME
IBP P2 ;[2212] COUNT ANOTHER BYTE
JRST CPOPJ1 ;[2212] GIVE GOOD RETURN
;[2212] Here on store.
X72SOP: MOVEM W1,(W2) ;[2212] Make sure the last halfword is stored
ADD P2,FX.LB ;[2212] Relocate the store operator pointer
TRNE T1,S.ADR ;[2212] An address?
JRST X72SAD ;[2212] Yes, go handle it
;[2212] Here to test for a symbol and to determine if it is needed
PUSH P,T1 ;[2212] Save the store operator
MOVE T2,T1 ;[2212] Get a copy of the store operator
TRZ T2,777770 ;[2212] Clear all but last digit
PUSH P,[FS.FXF ;[2212] 754 Save bit for this fixup type
FS.FXE ;[2212] 755
FS.FXL ;[2212] 756
FS.FXR]-4(T2) ;[2212] 757
LSH T1,-^D9 ;[2212] Get the length
JUMPE T1,X72S50 ;[2212] Special if Radix 50
CAIN T1,1 ;[2212] Short symbol?
JRST X72SSM ;[2212] Yes, handle differently
;[2212] Here for long symbol. Copy it into SYMBLK.
CAILE T1,MAXSYM/3-1 ;[2212] Make sure symbol not too big
PUSHJ P,E$$STL ;[2212] Can't handle it
MOVE W3,T1 ;[2212] Keep the count in a better place
PUSH P,T1 ;[2212] And save it for SY.RQS call
MOVE P1,[POINT 18,SYMBLK] ;[2212] Get a pointer to a static area
X72SOL: PUSHJ P,X72BYT ;[2212] Get the next three characters
PUSHJ P,E$$ISM## ;[2212] Not complete?
IDPB T1,P1 ;[2212] Store the characters
SOJGE W3,X72SOL ;[2212] Keep going until all done
POP P,W3 ;[2212] Get the count back
ADDI W3,1 ;[2212] Make it a true count
TRNN W3,1 ;[2212] Is it odd?
JRST X72SEV ;[2212] No, even
SETZ T1, ;[2212] Yes,
IDPB T1,P1 ;[2212] Zero the extra halfword
ADDI W3,1 ;[2212] Account for it
X72SEV: LSH W3,-1 ;[2212] Convert to words
HRLZ W3,W3 ;[2212] Put count in left half
HRRI W3,SYMBLK ;[2212] Count,,Pointer
JRST X72SYM ;[2212] Go see if needed
;[2212] Here for radix-50 symbols. Replace with SIXBIT, treat as short symbol.
X72S50: PUSHJ P,X72BYT ;[2212] Get the next halfword
PUSHJ P,E$$ISM ;[2212] Not complete?
HRL W2,T1 ;[2212] Hold onto it
PUSHJ P,X72BYT ;[2212] Get one more
PUSHJ P,E$$ISM ;[2212] Not complete?
HRR W2,T1 ;[2212] Get the rest of the symbol
PUSHJ P,R50T6## ;[2212] Convert to SIXBIT
MOVE W3,W2 ;[2212] Get the symbol in the correct AC
JRST X72SYM ;[2212] Go see if needed
;[2212] Here for short symbol. Build it in W3.
X72SSM: PUSHJ P,X72BYT ;[2212] Get the next halfword
PUSHJ P,E$$ISM## ;[2212] Not complete?
HRL W3,T1 ;[2212] Hold onto it
PUSHJ P,X72BYT ;[2212] Get one more
PUSHJ P,E$$ISM ;[2212] Not complete?
HRR W3,T1 ;[2212] Get the rest of the symbol
; JRST X72SYM ;[2212] See if needed
;[2255] Here for a symbol. See if it is needed, and if so replace
;[2255] the symbol name and old store operator with the new store
;[2255] operator and the section number of the symbol in the LS area,
;[2255] followed by the rest of the LS pointer for the symbol, followed
;[2255] by the GS pointer to the symbol.
X72SYM: POP P,W1 ;[2212] Restore the bits
PUSHJ P,SY.QS## ;[2212] See if we want this symbol
JRST [POP P,0(P) ;[2212] Non-loaded local, clean up stack
PUSHJ P,T.11RT## ;[2212] Return block
JRST LOAD##] ;[2212] And exit
POP P,T1 ;[2212] Restore the op code
TRZ T1,^-7 ;[2212] Get the last digit
ADDI T1,PL.NSS ;[2212] Add the base for new fullword operator
LSH T1,^D12 ;[2212] Put it in the high order bits
HLRZ T2,LSTLCL ;[2255] Get the local symbols section number
ADD T1,T2 ;[2255] Put it in the opcode word
DPB T1,P2 ;[2212] Store the new store op code
HRRZ T2,LSTLCL ;[2212] Get the right half of the LS pointer
IDPB T2,P2 ;[2212] Store it
MOVE T2,LSTGBL ;[2255] Get the Global symbols pointer
IDPB T2,P2 ;[2212] Store it
;[2212] If this block is to be extended to handle FAIL block names
;[2212] code should be added here.
;[2212] It should read the symbol and store it into the block using P2
;[2212] so that it can be recognized correctly. This may make the
;[2212] block shorter but that should not matter.
JRST X72GC ;[2212] Check for undefined symbols
;[2212] Set up address for memory fixup
X72SAD: MOVE P1,T1 ;[2212] Save the store operator
TRNN T1,LENGTH ;[2212] Non-zero length?
JRST X72SAH ;[2212] No, it's a halfword store
;[2212] Here to handle fullword (possibly relocatable)
PUSHJ P,X72BYT ;[2212] Get a halfword
PUSHJ P,E$$NAP## ;[2212] Not complete?
MOVE W3,T1 ;[2212] Hold on to it
PUSHJ P,X72BYT ;[2212] Get another halfword
PUSHJ P,E$$NAP ;[2212] Not complete?
HRL T1,W3 ;[2212] Put fullword in T1
TRNE P1,S.REL ;[2212] Is this relocatable?
PUSHJ P,R.CUR ;[2212] Yes, relocate it
TRZ P1,^-7 ;[2212] Get the last digit
ADDI P1,PL.NSF ;[2212] Add the base for new fullword operator
LSH P1,^D12 ;[2212] Put it in the high order bits
DPB P1,P2 ;[2212] Store the new operator
HLRZ T2,T1 ;[2212] Get left half (section number)
IDPB T2,P2 ;[2212] Store it
IDPB T1,P2 ;[2212] Store right half (address)
JRST X72GC ;[2212] Check for undefined symbols
;[2212] Here to handle halfword (possibly relocatable)
X72SAH: PUSHJ P,X72BYT ;[2212] Get a halfword
PUSHJ P,E$$NAP ;[2212] Not complete?
TRNE P1,S.REL ;[2212] Is this relocatable?
PUSHJ P,R.CUR ;[2212] Yes, relocate it
TRZ P1,^-7 ;[2212] Get the last digit
ADDI P1,PL.NSH ;[2212] Add the base for new fullword operator
LSH P1,^D12 ;[2212] Put it in the high order bits
HLRZ T2,T1 ;[2212] Get left half (section)
ADD T2,P1 ;[2212] Add in the opcode
DPB T2,P2 ;[2212] Store it
IDPB T1,P2 ;[2212] Store right half (address)
JRST X72GC ;[2212] Check for undefined symbols
;[2212] Here to read a byte into T1. Similar to X72SGN except that
;[2212] the word is not stored and the byte pointers are not updated.
X72BYT: JUMPN P3,X72BT1 ;[2212] Just processed RHS?
PUSHJ P,D.GET1 ;[2212] Yes--get one
POPJ P, ;[2212] No more--Give non-skip return
HLRZ T1,W1 ;[2212] First time give LHS
MOVEI P3,1 ;[2212] Signal RHS for next time
JRST CPOPJ1 ;[2212] Give good return
X72BT1: HRRZ T1,W1 ;[2212] Time for RHS
MOVEI P3,0 ;[2212] Signal LHS for next time
JRST CPOPJ1 ;[2212] Give good return
;[2212] Here to count and evaluate global requests. This routine uses
;[2212] P1 and P2 as temporaries, and assumes that they are the accumulators
;[2212] after T4, since the extend instructions require 6 contiguous ACs.
X72GC: POP P,RC.CUR ;[2212] Restore the psect index
MOVE W1,T11BP ;[2212] Reset byte pointer
ADD W1,FX.LB ;[2212] Fix in core
JRST X72G1 ;[2212] Bypass first time
X72G0: IBP W1 ;[2212] Bypass next half word
X72G1: ILDB T1,W1 ;[2212] Read half word
CAIL T1,PL.NSO ;[2212] Store operator (new style)
JRST X72GE ;[2212] Yes
CAIL T1,PL.NEW ;[2212] Halfword data operator?
JRST X72G0 ;[2212] Yes, eat the next halfword
CAIL T1,PL.IL ;[2212] Psect index?
JRST X72G1 ;[2212] Yes, ignore it
JUMPE T1,X72G0 ;[2212] If absolute halfword eat 1 halfword
CAIE T1,PL.ABF ;[2212] Fullword absolute?
CAIN T1,PL.RLF ;[2212] Or fullword relocatable?
AOJA W1,X72G1 ;[2212] Yes, ignore the next 2 halfwords
CAIL T1,PL.OL ;[2212] Too low for operator?
CAILE T1,PL.OH ;[2212] Or too high?
CAIA ;[2212] Not an operator
JRST X72G1 ;[2212] An operator, ignore it
;[2212] Here if global symbol request. Find out if long or short, and
;[2212] prepare for TRYSYM.
MOVE T2,W1 ;[2212] Save the pointer for ILDB or MOVSLJ
SUB W1,FX.LB ;[2212] In case the area moves
PUSH P,W1 ;[2212] Save the pointer
LSH T1,-^D9 ;[2212] Get the length
PUSH P,T1 ;[2212] Save the length
CAIG T1,1 ;[2212] Short symbol (or converted radix-50)?
JRST X72GS ;[2212] Yes
;[2212] Here if long symbol. Copy it into SYMBLK and build a pointer to it
ADDI T1,1 ;[2212] Make into correct count
MOVE T4,T1 ;[2212] Also destination count
TLNE T4,1 ;[2212] Is it odd?
ADDI T4,1 ;[2212] Make it even (fullword for TRYSYM)
HRLZ W2,T4 ;[2212] Save the destination size
MOVE P1,[POINT 18,SYMBLK] ;[2212] Destination
EXTEND T1,[MOVSLJ T1, ;[2212] Move to word-aligned static area
0] ;[2212] Fill with zero byte if necessary
JFCL ;[2212] Destination is always largest
LSH W2,-1 ;[2212] Make the size in words
HRRI W2,SYMBLK ;[2212] Count,,pointer for TRYSYM
JRST X72TRY ;[2212] See if it's defined
;[2212] Here for short symbol
X72GS: ILDB T1,T2 ;[2212] Get left half of symbol
ILDB W2,T2 ;[2212] Get right half part
HRL W2,T1 ;[2212] Full symbol in W2
X72TRY: .JDDT LNKNEW,X72GS,<< CAMN W2,$SYMBOL##>>
MOVX W1,PT.SGN!PT.SYM ;[2212] Set the bits
PUSHJ P,TRYSYM## ;[2212] See if defined
JRST X72ND ;[2212] No, need to define it
JRST X72UN ;[2212] Undf, so just as bad
POP P,T1 ;[2212] Get the count back
POP P,W1 ;[2212] Restore byte pointer to start of symbol
ADD W1,FX.LB ;[2212] Add core offset
MOVEI T2,PL.ABF ;[2212] Get an absolute fullword operator
DPB T2,W1 ;[2212] Replace the symbol operator
MOVS T2,2(P1) ;[2212] Get value (reversed)
IDPB T2,W1 ;[2212] Store left half of value
MOVSS T2 ;[2212] Swap the value back
IDPB T2,W1 ;[2212] Store right half of value
SOJLE T1,X72G1 ;[2212] Find out how many words left
;[2212] (done if short symbol)
MOVEI T2,PL.IL ;[2212] Get a no-op (psect index is good here)
X72GZ: IDPB T2,W1 ;[2212] Clobber extra symbol name halfword
SOJG T1,X72GZ ;[2212] Continue until none left
JRST X72G1 ;[2212] Done with this symbol
X72GE: MOVE W3,T11BP ;[2212] Get pointer back to beginning
ADD W3,FX.LB ;[2212] Add base of area
SKIPN -1(W3) ;[2212] Any undefined globals?
PUSHJ P,T1072E ;[2212] No, evaluate fixup now
JRST LOAD## ;[2212] Else wait till all defined
;[2212] Here if global symbol not in global symbol table yet
;[2212] Treat as if additive global request
;[2212] Get extended triplet and point to fixup triplet in fixup area
;[2212] In turn this triplet points to the polish fixup
;[2212] NOTE AT THIS POINT W1, W2, AND W3 ARE USED FOR NON-SYMBOL
;[2212] STUFF, THEY MUST BE SAVED
X72ND: AOS USYM ;[2212] Increment undef count
TXO W1,PS.REQ ;Usual flags
PUSH P,W1 ;Save primary flags
PUSH P,[0] ;Zero value
MOVX W1,S.FXP ;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
X72GD: POP P,W1 ;[2212] Get back the length
POP P,T1 ;[2212] And the byte pointer in a temporary
ADD T1,FX.LB ;[2212] Relocate again
SKIPN W1 ;[2212] Was this radix-50?
MOVEI W1,1 ;[2212] Yes, set to length-1
ADDI W1,1 ;[2212] Get the actual length
ADJBP W1,T1 ;[2212] Pass the symbol, result back in W1
MOVE W3,T11BP
ADD W3,FX.LB ;...
AOS -1(W3) ;Bump count of undefined symbols
JRST X72G1 ;Get next half word
;[2212] Here to see if fixup requests exist for this symbol
;[2212] If so add to chain, if not create chained list in extended symbol
X72UN: MOVE W1,0(P1) ;Flags go in W1 now
TXNE W1,PS.FXP ;Already fixups defered?
JRST X72DF ;[2212] 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 ;Pointer to fixup chain
TMOVEM W1,0(T1) ;[612] Store in new triplet
JRST X72GD ;[612] Return to scan rest of polish
;HERE IF FIXUP REQUEST EXISTS ALREADY
;JUST LINK INTO FRONT OF CHAIN
X72DF: ADDI P1,.L ;[2212] Look for additive global request
SKIPG W1,0(P1) ;Get secondary flags
PUSHJ P,E$$ISP## ;[2212] Primary or no flags set
TXNN W1,S.FXP ;Is this the one
JRST X72DF ;[2212] No try again
SKIPN W1,2(P1) ;Get pointer, better be non-zero
PUSHJ P,E$$ISP## ;[2212] Bad pointer
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 X72GD ;Get next half-word
;HERE TO EVALUATE POLISH FIXUP
T1072E::SKIPN W3,POLSTK ;[2212] Get stack pointer
PUSHJ P,T.11PD## ;[2212] Not setup yet
MOVEI T3,100 ;Incase of on operator
MOVEM T3,SVSAT
PUSH W3,[MXPLOP##+100] ;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,T1072E,<<CAMN W1,$FIXUP##>> ;[632]
ADD W2,FX.LB ;Fix in core
X72RP: ILDB W1,W2 ;Read a half-word
MOVEM W1,SAVCOD
CAIL W1,PL.NSO ;[2212] Store operator (new style)
JRST X72ST ;[2212] Yes
CAIL W1,PL.NEW ;[2212] Halfword data operator?
JRST X72RH ;[2212] Yes, eat the next halfword
CAIL W1,PL.IL ;[2212] Psect index?
JRST X72RP ;[2212] Yes, ignore it
JUMPE W1,X72AH ;[2212] If absolute halfword eat 1 halfword
CAIE W1,PL.ABF ;[2212] Fullword absolute?
CAIN W1,PL.RLF ;[2212] Or fullword relocatable?
JRST X72FO ;[2212] Yes, ignore the next 2 halfwords
CAIL W1,PL.OL ;[2212] Too low for operator?
CAILE W1,PL.OH ;[2212] Or too high?
JRST X72IPO ;[2212] Not an operator, illegal
; JRST X72OP ;[2212] An operator, stack it
;[2212] Handle operators
X72OP: AOBJN W3,.+2 ;[2212] Check for overflow
PUSHJ P,T.11PL# ;[2212] Overflow-go enlarge stack
MOVEM W1,(W3) ;[2212] Save operator on stack
MOVE T3,DESTB##-100(W1) ;Get number of operands needed
MOVEM T3,SVSAT ;Also save it
JRST X72RP ;[2212] Back for more
X72IPO: MOVE W1,SAVCOD ;[2212] Remember what's the problem
X72RPE: PUSHJ P,E$$IPO## ;[2212] Invalid polish operator
;[2212] Handle operands
;[2212] Absolute halfword
X72AH: ILDB T2,W2 ;[2212] Get the operand
JRST X72P0 ;[2212] Handle the value
;[2212] Relocatable halfword - Looks sort of like a fullword
X72RH: TRZA W1,PL.NEW ;[2212] Get rid of opcode, leaving section
;[2212] Relocatable or absolute Fullword
X72FO: ILDB W1,W2 ;[2212] Get the first halfword
ILDB T2,W2 ;[2212] Get the second halfword
HRL T2,W1 ;[2212] Put both together
; JRST X72P0 ;[2212] Handle the value
X72P0: SETZ T1, ;[2212] Value operand
X72P1: SOJL T3,X72ES ;[2212] Enough operands seen
AOBJN W3,.+2 ;[2212] Check for overflow
PUSHJ P,T.11PL# ;[2212] Overflow-go enlarge stack
MOVEM T2,(W3) ;[2212] Save operator on stack
HRLI T1,400000 ;Put in a value marker
AOBJN W3,.+2 ;[2212] Check for overflow
PUSHJ P,T.11PL# ;[2212] Overflow-go enlarge stack
MOVEM T1,(W3) ;[2212] Save operator on stack
JRST X72RP ;Get more polish
;Here when we have enough operands for the current operator
X72ES: SKIPN SVSAT ;[2212] Is it unary
JRST X72UO ;[2212] Yes, no need for 2nd operand
POP W3,T1 ;[2212] Pop off marker
POP W3,T1 ;And value
X72UO: POP W3,T3 ;Operator
XCT OPTAB##-100(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##-100(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 X72P1 ;[2212] Go see what we should do now
;Here to store the final value
X72ST: MOVE T2,-2(W3) ;[2212] This should be the fake operator
CAIE T2,MXPLOP##+100 ;[2212] Is it
PUSHJ P,X72IPO ;[2212] No
ILDB T2,W2 ;[572] Get core addr or LS pointer
HRL T2,W1 ;[2212] Get the section (zero for symbols)
TLZ T2,PL.NMX ;[2212] Remove the high order (opcode) bits
MOVE W3,-1(W3) ;Get the value after ignoring the flag
LSH W1,-^D12 ;[2212] Get the opcode
PUSHJ P,@STRT72-PL.NS(W1) ;[2212] Call the correct fixup routine
PJRST T.11RT## ;[2212] All done, now give space back
;Store operator action table
;**;[2324] Change 2 lines at STRT72. PAH 16-Jul-84
STRT72: T11CHF## ;[2324] 0764 0774 Fullword chained
X72CHE ;[2324] 0765 0775 Thirty bit chained
T11CHL## ;[2212] 0766 0776 Left half chained
T11CHR## ;[2212] 0767 0777 Right half chained
X72FWS ;[2212] 1764 1774 Fullword chained
X72FWS ;[2212] 1765 1775 Thirty bit chained
X72FWS ;[2212] 1766 1776 Left half chained
X72FWS ;[2212] 1767 1777 Right half chained
T11SYF## ;[2212] xxx754 Fullword symbol
X72SYE ;[2212] xxx755 Thirty bit symbol
T11SYL## ;[2212] xxx756 Left half symbol
T11SYR## ;[2212] xxx757 Right half symbol
;**;[2324] Add 7 lines at STRT72+13. PAH 14-Jul-84
;[2324] Here to clear P1 before going to the thirty-bit chained fixup
;[2324] routine -- that routine calls others which interpret a nonzero
;[2324] value in P1 as a fixup block pointer.
X72CHE::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
X72SYE: MOVX W1,FS.FXE ;[2212] Thirty bit fixup
JRST SY.ASP## ;[2212] Join symbol fixup code
X72FWS: ILDB W2,W2 ;[2212] Get the next byte
HRL T2,W2 ;[2212] Put it in T2
MOVSS T2 ;[2212] Correct order
SUBI W1,<PL.NSF-PL.NSH> ;[2212] Fix up store opcode
PJRST @STRT72-PL.NS(W1) ;[2212] Go to the correct fixup routine
E$$STL::.ERR. (MS,.EC,V%L,L%F,S%F,STL,<Symbol too long>) ;[2007]
.ETC. (JMP,,,,,.ETIMF##)
SUBTTL BLOCK TYPE 1074 - FORTRAN COMMON BLOCK
; ---------------------------------
; ! 1074 ! COUNT !
; ---------------------------------
; ! PSECT INDEX ! SYMBOL LENGTH !
; ---------------------------------
; ! COMMON BLOCK LENGTH !
; ---------------------------------
; ! SIXBIT COMMON BLOCK NAME !
; ---------------------------------
; ! (MORE SIXBIT NAME) !
; ---------------------------------
T.1074::PUSHJ P,D.GET1 ;[2310] Get the index,,length
JRST LOAD## ;[2310] Empty block
HLRZ R,W1 ;[2310] Get the psect index
CAMLE R,RC.NO ;[2340] In bounds?
PUSHJ P,E$$IPX ;[2340] No, die
HRRZ R,@RC.MAP ;[2310] Convert to internal psect index
MOVE R,@RC.TB ;[2310] Get the RC block
MOVE W3,RC.CV(R) ;[2310] Get the current value
HRRZ W2,W1 ;[2310] Get number of characters
PUSHJ P,D.GET1 ;[2310] Get the COMMON block size
JRST [MOVEI T1,1074 ;[2310] No next word?
JRST E$$RBS##] ;[2310] Bad rel block
PUSH P,W1 ;[2310] Save the length
PUSHJ P,SYMIN1 ;[2310] Read the symbol
JRST [MOVEI T1,1074 ;[2310] Symbol fouled up?
JRST E$$RBS##] ;[2310] Bad rel block
POP P,W1 ;[2310] Restore the length
PUSHJ P,T.COMM## ;[2310] Build the common block
JRST LOAD## ;[2310] Done
HRRZ P1,@HT.PTR ;[2310] Set up pointer to symbol
ADD P1,GS.LB ;[2310] Unrelocate it
MOVE W3,.L+2(P1) ;[2310] Get the common length
ADDB W3,RC.CV(R) ;[2310] Bump relocation counter
CAML W3,RC.LM(R) ;[2310] Check against the limit
PUSHJ P,TOOBIG## ;[2310] Too big, give a warning
JRST LOAD## ;[2310]
> ;IFN .NWBLK
SUBTTL ASCIZ TEXT BLOCK
; -------------
; ! A S C I I !
; -------------
; ! T E X T 0 !
; -------------
IFN .ASBLK,<
LNKASC::TRNE FL,R.LIB!R.INC ;[602] ARE WE LOADING?
JRST ASCSKP ;[602] NO, SKIP OVER THIS TEXT BLOCK
MOVEI T2,^D128 ;USE STANDARD BUFFER OF 200 WORDS
PUSHJ P,DY.GET##
MOVEM T1,F.ASCC ;USE COUNT TO HOLD CURRENT POINTER
HRLI T1,(POINT 7,,35) ;BUILD THE BYTE POINTER
MOVEM T1,F.ASCI ;INITIAL AREA POINTER
ASCT0: MOVEI P1,1(T1) ;FIRST WORK IS USED AS A LINK IF MORE DATA
TLO P1,-^D127 ;FORM AOBJN POINTER
JRST ASCT2 ;JUMP INTO WORD STASHING LOOP
ASCT1: PUSHJ P,D.RED1## ;GET WORD FROM REL FILE
JRST ASCFIN ;END OF FILE
ASCT2: MOVEM W1,(P1) ;STORE TEXT WORD
TRNN W1,177B34 ;FINISHED IF NULL BYTE
JRST ASCFIN ;YES
AOBJN P1,ASCT1 ;NO, LOOP UNLESS BLOCK FULL
MOVEI T2,^D128 ;GET ANOTHER BLOCK
PUSHJ P,DY.GET##
MOVEM T1,@F.ASCC ;STORE POINTER
MOVEM T1,F.ASCC ;POINT TO NEW BLOCK
MOVEI P1,1(T1) ;FORM BYTE POINTER AGAIN
HRLI P1,-^D127
JRST ASCT1 ;AND CONTINUE
ASCFIN: MOVEI T1,^D127*5 ;CHARACTERS PER BLOCK
MOVEM T1,F.ASCC ;SET COUNT FOR FIRST BLOCK
PUSH P,F.NXZR ;REMEMBER POINTER TO END
PUSH P,F.INZR ;SAVE CURRENT FILE SPEC POINTERS
PUSH P,SWFLAG ;AND SWITCHES
INZLOC: SETZM F.INZR ;NOW CLEAR THEM
SETZM F.NXZR
SWFLOC: SETZM SWFLAG
ASZLOC: HLLZM FL,F.ASZR ;STORE GLOBAL FLAGS IN LH
JRST LNKSCN## ;GO TO SCANNER FOR INCORE COMMAND
;HERE TO PROCESS ASCII TEXT IN /INCLUDE OR /SEARCH MODE. JUST IGNORE IT.
ASCSKP: TRNN W1,177B34 ;[602] END OF ASCIZ STRING?
JRST LOAD## ;[602] YES, PROCESS NEXT BLOCK TYPE
PUSHJ P,D.IN1## ;[602] GET NEXT WORD, GOTO LOAD IF EOF
JRST ASCSKP ;[602] AND CONTINUE IGNORING IT
;RETURN HERE
ASCRET::HRRZ T1,F.ASZR ;SEEN ANY FILE NAMES YET?
JUMPN T1,ASCRT2 ;YES, NOT LOOKING AT SWITCHES
POP P,T1 ;RESTORE OLD SWFLAG
EXCH T1,SWFLAG ;PUT INCORE ONES FIRST
SKIPA T3,SWFLOC ;LOOK FOR END OF LIST
ASCRT1: MOVE T3,T2 ;STORE OLD
MOVE T2,(T3) ;GET NEXT POINTER
TRNE T2,-1 ;0 LINK IS END
JRST ASCRT1 ;NOT YET
HRRM T1,(T3) ;LINK OLD SWITCHES IN
PUSH P,SWFLAG ;NOW SAVE REVISED SWITCH LIST
ASCRT2: PUSHJ P,ASZCHN ;LINK NEW SPECS TO OLD F.ASZR
TRNE T1,-1 ;ANY SPECS SEEN THIS PASS?
PUSHJ P,INSEOL ;YES, INSERT /CRLF FOR SWITCHES
SETZM F.INZR ;NOW CLEAR VARIABLES FOR NEXT TIME
SETZM F.NXZR ;SO WON'T CONFUSE CLANS
MOVE T1,F.ASCI ;PICK UP POINTER TO CURRENT TEXT
CAME T1,[-1] ;REACHED EOF YET?
JRST LNKSCN## ;NO, GO PROCESS NEXT LINE
POP P,SWFLAG ;YES, RESTORE THINGS TO EARLIER
POP P,F.INZR ;OLD F.INZR (REST REAL COMMAND)
PUSHJ P,ASZCHN ;CHAIN OLD LINE TO END OF NEW
TRNE T1,-1 ;ANY MORE THIS REAL COMMAND LINE?
PUSHJ P,INSEOL ;YES, INSERT /CRLF
HLLO T2,F.ASZR ;LAST TIME, SO RESET GLOBAL FLAGS
TRNE T1,-1 ;T1 EITHER 0 OR ADDR OF SWITCH
MOVEM T2,2(T1) ;SWITCH, STORE VALUE
POP P,F.NXZR ;END OF NEW CHAIN SAME AS OLD
MOVE T1,F.ASZR ;PUT WHOLE CHAIN IN F.INZR
HRRZM T1,F.INZR ;SO LNKWLD CAN FIND IT
SETZM F.ASZR ;NOW CLEAN UP ASCII TEXT DATA BASE
SETZM F.ASCI ;..
SETZM F.ASCC ;..
SETZM F.ASCK
JRST LOAD ;CONTINUE WITH CURRENT .REL FILE
;HERE TO FOLLOW THE F.ASZR CHAIN, AND APPEND THE F.INZR CHAIN
; TO IT. RETURNS OLD F.INZR IN T1
ASZCHN: SKIPA T3,ASZLOC ;GET ADDR OF HEAD OF LIST
ASZCN1: MOVE T3,T2 ;REMEMBER LAST ADDR IN CASE END
HRRZ T2,F.NXT(T3) ;FOLLOW CHAIN
JUMPN T2,ASZCN1 ;IF NOT DONE, CONTINUE
MOVE T1,F.INZR ;GET START OF F.INZR CHAIN
HRRM T1,F.NXT(T3) ;STORE AT END OF F.ASZR CHAIN
POPJ P, ;DONE
;HERE TO PUT A GLOBAL SWITCH BLOCK ONTO THE SCAN BLOCK POINTED TO BY
; F.INZR TO INDICATE THAT /CRLF PROCESSING IS NEEDED BEFORE THIS FILE
; SPEC IS PROCESSED. THIS RESETS EOL DEFAULTS, ETC. SINCE THE POSITION
; OF CRLFS IS FORGOTTEN DURING ASCII BLOCK PROCESSING. THIS ROUTINE
; RETURNS THE ADDRESS OF THE ADDED SWITCH BLOCK IN T1.
INSEOL: MOVEI T2,3 ;SWITCH BLOCKS ARE 3 WORDS
PUSHJ P,DY.GET## ;GRAB ONE
MOVSI T2,3 ;1ST WORD IS LEN,,ADDR OF NEXT
MOVEM T2,0(T1) ;STORE IN BLOCK
MOVEI T2,%CRLF% ;2ND WORD IS TOKEN VALUE
MOVEM T2,1(T1) ;STORE IT TOO
HRRZ T2,F.INZR ;GET POINTER TO NEW SCAN BLOCK
HLRZ T3,F.SWP(T2) ;GET ADDR OF CURRENT SWITCHES
HRLM T1,F.SWP(T2) ;REPLACE WITH ADDR OF THIS BLOCK
HRRM T3,0(T1) ;LINK IN ANY OLD SWITCHES
POPJ P,
;NOW CALCULATE THE VALUE OF %CRLF% FROM THE SWMAC MACRO.
DEFINE SWMAC(A,B,C,D,E,F,G,H,I),<
IF1,<
IFIDN <B><CRLF>,<
IFNDEF %CRLF%,<
%CRLF%==TK.
>>
TK.==TK.+1
>>
TK.==0 ;INITIAL CONDITION
SWTCHS
>;END IFN .ASBLK
SUBTTL NEW BLOCK TYPE INPUT ROUTINES
COMMENT ^
THESE ROUTINES COUNT BLOCK LENGTH AND DO RELOCATION AS FOLLOWS:
AC WC CONTAINS THE NEGATIVE COUNT OF WORDS LEFT UNTIL THE NEXT
RELOCATION WORD IN THE LEFT HALF, AND THE NEGATIVE COUNT OF WORDS LEFT
IN THE CURRENT BLOCK IN THE RIGHT HALF. BIT 18 IS OFF SO THAT THE
OVERFLOW OF THE RIGHT HALF WILL NOT AFFECT THE LEFT HALF ON KA10'S.
THE ROUTINES FOR THOSE BLOCK TYPES THAT DO NOT EXPECT RELOCATION
WORDS SHOULD SET THE LEFT HALF OF WC TO 400000 (BY USE OF THE
RELOCATE MACRO) SO THAT THE CURRENT "RELOCATION BLOCK" WILL NEVER
EXPIRE.
AC RB CONTAINS THE CURRENT RELOCATION WORD. EACH TIME THAT
A NEW RELOCATION BYTE IS REQUIRED, RB (= R+1) IS SHIFTED C(RELSIZ)
BITS TO THE LEFT, THEREBY SETTING UP R. IF WE ARE NOT LOADING DATA
THAT CONTAINS RELOCATION WORDS, THIS CODE IS STILL EXECUTED, BUT
SINCE RB ALWAYS CONTAINS ZERO, THE CODE IS ALWAYS CONSIDERED ABSOLUTE.
NOTE THAT LH(WC) IS NOT KEPT UP TO DATE IF LOADING A BLOCK
TYPE THAT DOES NOT INCLUDE RELOCATION WORDS, AND PROCESSING ROUTINES
FOR THOSE BLOCK TYPES MAY SAVE OVERHEAD BY CALLING D.GET? INSTEAD OF
D.REL?, ALTHOUGH D.REL? WILL WORK CORRECTLY IF CALLED.
^
IFN .NWBLK,<
;SUBROUTINE TO READ IN A TRIPLET FROM THE CURRENT BLOCK.
;CALL IS:
;
; PUSHJ P,D.TRIP
; NO DATA RETURN (END OF BLOCK OR END OF FILE)
; HERE WITH W1-W3 SETUP
;
;USES W1-W3, T1-T2.
D.TRIP::PUSHJ P,D.GET1 ;GET NEXT WORD, CHECKING FOR END OF DATA
POPJ P, ;NONE LEFT
MOVE W3,W1 ;SAVE FLAGS FOR LATER
PUSHJ P,D.GET1 ;GET SYMBOL, IF THERE
POPJ P, ;IT'S NOT
MOVE W2,W1 ;POSITION SYMBOL CORRECTLY
PUSHJ P,D.REL1 ;NOW READ VALUE, POSSIBLY RELOCATING
POPJ P, ;OH WELL
EXCH W1,W3 ;PUT FLAGS & VALUE IN CORRECT PLACES
JRST CPOPJ1 ;GOOD RETURN
;ROUTINES TO GET THE NEXT WORD FROM THE DATA FILE AND DO ANY
;RELOCATION NECESSARY AS INDICATED BY RELSIZ, WC, AND RB. CALL IS:
;
; PUSHJ P,D.REL?
; NO DATA RETURN
; OK RETURN
;
;RETURNS THE NEXT WORD IN W1, OR W2 & W1. USES T1-T2.
D.REL2::PUSHJ P,D.REL1 ;GET THE FIRST WORD
POPJ P, ;NONE LEFT
MOVE W2,W1 ;SAVE FIRST WORD
;FALL IN TO GET SECOND WORD
D.REL1::TRNN WC,377777 ;MORE DATA IN THIS BLOCK?
POPJ P, ;NO, RETURN NO DATA
PUSHJ P,D.RED1## ;YES, GET NEXT WORD
JRST E$$PEF ;[1174] WORD COUNT WAS WRONG
AOBJN WC,DRELN ;GO RELOCATE UNLESS NEED NEW SUB-BLOCK
MOVE RB,W1 ;SAVE THE NEW RELOCATION WORD
MOVNI T1,^D36 ;FIND SIZE OF THIS SUB-BLOCK
IDIV T1,RELSIZ ;FROM THE BYTE SIZE
TRNE FL,R.LHR ;LEFT HALF RELOCATION DATA TOO?
ASH T1,-1 ;YES, ONLY 1/2 AS MANY WORDS IN BLOCK
HRL WC,T1 ;AND RESET SUB-BLOCK COUNT
PUSHJ P,D.GET1 ;NOW GET 1ST DATA WORD OF NEW BLOCK
POPJ P, ;???
DRELN: SETZ R, ;ZAP SOME BITS
LSHC R,@RELSIZ ;GRAB RELOCATION BYTE
JUMPE R,CPOPJ1 ;IF ABSOLUTE, WE'RE DONE
; SKIPN R,@RC.TB ;ELSE SET UP R FOR RELOCATION BLOCK
; JRST E$$IRC ;[1174] RELOCATED TO SEGMENT NOT SET UP
;********* ADD MORE CODE HERE ********************************
E$$IRC::.ERR. (MS,.EC,V%L,L%F,S%F,IRC,<Illegal relocation counter>) ;[1174]
.ETC. (JMP,,,,,.ETNMF##)
> ;END IFN .NWBLK<
;HERE TO GET THE NEXT WORD FROM THE CURRENT BLOCK. RETURNS NON-SKIP
;ON END OF BLOCK OR END OF FILE. EXPECTS WC TO BE SET UP FROM LNKLOD.
D.GET1::TRNN WC,377777 ;END OF BLOCK ON LAST WORD?
POPJ P, ;YES, NO MORE DATA
PUSHJ P,D.RED1## ;NO, GET NEXT WORD
JRST E$$PEF ;[1174] PREMATURE END OF FILE
AOJA WC,CPOPJ1 ;COUNT WORD & GIVE GOOD RETURN
CPOPJ1: AOS 0(P) ;THE USUAL
CPOPJ: POPJ P,
;HERE WHEN THE .REL FILE HAS A PREMATURE EOF.
E$$PEF::.ERR. (MS,.EC,V%L,L%F,S%W,PEF,<Premature end of file from file >) ;[1174]
.ETC. (FSP,,,,,DC)
POPJ P, ;TRY TO CONTINUE
SUBTTL WORD RELOCATION FOR BLOCK 1070
;ROUTINE TO RELOCATE A WORD (USED BY BLOCK 1070)
;
; PUSHJ P,REL.1
; NO DATA RETURN
; OK RETURN (W1/ RETURN VALUE)
;
;ENTER WITH:
;
; R/ TEMP. PSECTS (-1 IF NOT USED)
; RB/ RELOCATION TYPE
; RC.CUR/ CUREENT PSECT
;
;ACS USED: R,RB,T1,W1,W3
;
;RETURN VALUES:
; W1/ FLAG
; W3/ VALUE
IFN .NWBLK,<
;[1000]
REL.1::TRNN WC,377777 ;MORE DATA IN THIS BLOCK?
POPJ P, ;NO, RETURN NO DATA
PUSHJ P,D.GET1 ;GO GET A WORDS
POPJ P, ;???
MOVE W3,W1 ;RETURN VALUE IN W3
SETZ W1, ;CLEAR RETURN FLAG WORD
JUMPE RB,CPOPJ1 ;IF ABS, OK RETURN
MOVX W1,PS.REL ;RELOCATABLE SYMBOL
JUMPGE R,REL.T ;JUMP IF TEMPORARY PSECTS SPECIFIED
PUSHJ P,@[ REL.R ;1 - RIGHT HALF
REL.L ;2 - LEFT HALF
REL.B ;3 - BOTH HAVES
REL.E ;4 - EXTENDED(30BIT)
REL.F]-1(RB) ;5 - FULL WORD
JRST CPOPJ1 ;SKIP RETURN
REL.T: PUSH P,RC.CUR ;USE TEMP. PSECTS INSTEAD OF CURRENT ONE
PUSHJ P,@[ REL.TR ;1 - RIGHT HALF
REL.TL ;2 - LEFT HALF
REL.TB ;3 - BOTH HALVES
REL.TE ;4 - EXTENDED(30 BIT)
REL.TF]-1(RB) ;5 - FULL WORD
POP P,RC.CUR ;RESTORE ORIGINAL PSECT
JRST CPOPJ1 ;AND SKIP RETURN
REL.B: PUSHJ P,REL.L ;RELOCATE LEFT WITH CUREENT PSECT FIRST
JRST REL.R ;THEN DO THE SAME WITH RIGHT HALF
REL.TB: PUSH P,R ;SAVE FOR RIGHT
PUSHJ P,REL.TL ;RELOCATE LEFT WITH TEMP. PSECT
POP P,R ;[1720]
REL.TR: HRRZ R,@RC.MAP ;[1716] TRANSLATE RH PSECT INDEX TO INTERNAL
HRRM R,RC.CUR ;TEMPORARILY SWITCH CURRENT PSECT
REL.R: HRR T1,W3 ;ADDRESS IN T1
PUSHJ P,R.CUR## ;GO RELOCATE IT WITH CURRENT PSECT
HRR W3,T1 ;RETURN VALUE IN W3
POPJ P, ;
REL.TL: HLRZ R,R ;[1716] GET LH PSECT INDEX
HRRZ R,@RC.MAP ;[1716] TRANSLATE TO INTERNAL PSECT INDEX
HRRM R,RC.CUR ;[1716] SWITCH CURRENT PSECT
REL.L: HLR T1,W3 ;SET UP ADDRESS IN T1
PUSHJ P,R.CUR## ;GO RELOCATE IT
HRL W3,T1 ;RETURN VALUE IN W3
POPJ P, ;
REL.TE: HRRZ R,@RC.MAP ;[1716] TRANSLATE RH PSECT INDEX TO INTERNAL
HRRM R,RC.CUR ;SWITCH CURRENT PSECT
REL.E: LDB T1,[POINT 30,W3,35]
PUSHJ P,R.CUR## ;
LDB W3,[POINT 30,T1,35]
POPJ P,
REL.TF: HRRZ R,@RC.MAP ;[1716] TRANSLATE RH PSECT INDEX TO INTERNAL
HRRM R,RC.CUR ;SWITCH CURRENT PSECT
REL.F: MOVE T1,W3 ;SET UP ADDRESS IN T1
PUSHJ P,R.CUR## ;GO RELOCATE IT
MOVE W3,T1 ;RETURN VALUE IN W3
POPJ P, ;
> ;IFN .NWBLK
SUBTTL SUPPORT CODE FOR 11XX BLOCKS
DEFINE NEWBLX(SIZ,NUM,TYP,DSP,PRC,XIT)<
SETZM NORBYT ;;[1456]
PUSH P,[ PRC ] ;;DATA WORD PROCESSOR
MOVE P1,[POINT SIZ,RB] ;;HOW TO ACCESS RELOC BYTES
MOVEI P2,NUM ;;NUMBER OF RELOC BYTES
MOVE P4,[ TYP ] ;;HOW TO DO THE RELOC
PUSHJ P,DSP ;;COMMON CODE TO INTERPRET THIS
IFNB <XIT>,<PUSHJ P,XIT> ;;[1471]
JRST LOAD ;;TO GET BACK TO MAIN LOOP
> ;[1423]
T.11XX::
;
; T.1100 through T.1137 come here after setting up ACs as follows:
; P1 -an initialized byte pointer for the relocation bytes
; P2 -number of relocation bytes in the word
; P4 -dispatch address for type of relocation (30bit)
;
; First set up stack.
POP P,T1 ;[1405] UNSTACK RETURN ADDRESS
EXCH T1,(P) ;[1405] SWAP WITH PROCESSOR ADDRESS
PUSH P,T1 ;[1405] RETURN ONLY WHEN THRU
AOS P2 ;[1423] SUBBLOCK INCLUDING RELOC WORD
SPUSH <P1,P2> ;[1423] SAVE REGISTERS
MOVN T1,(P) ;[1423] SETUP WC
HRL WC,T1 ;[1423]
; Note the data blocksize as some processors need this data.
HRRZ P3,WC ;[1405]
TDO P3,[-1,,400000] ;[1405] REAL NEGATIVE NUMBER
MOVNS P3 ;[1405] NOW POSITIVE
PUSH P,P4 ;[1405] SAVE P4
IDIVI P3,1(P2) ;[1405] INCLUDE HEADER IN BLOCKSIZE
IMULI P3,1(P2) ;[1405] MAXIMUM DATA BLOCKSIZE
SKIPE P4 ;[1405] IF NONZERO RESIDUE
ADDI P3,-1(P4) ;[14YY] ADD IT, MINUS HEADER
POP P,P4 ;[1405] GET P4 BACK
T11XXR:
; BEGIN PROCESSING A SUB-BLOCK
PUSHJ P,PB.1 ;[1405] FETCH FIRST WORD OF BLOCK
JRST [ SPOP <T1,P2,P1>
POPJ P, ] ;[1405] NO MORE IN BLOCK
JFCL ;[1405] IMPOSSIBLE"
MOVE RB,W1 ;[1405] SETUP RELOC BYTE
MOVE P1,-1(P) ;[1405] RESET BYTEPOINTER
; BEGIN PROCESSING THE LIST
T11XXL: PUSHJ P,PB.1 ;[1423] FETCH A DATA WORD
JRST [ SPOP <T1,P2,P1>
POPJ P, ] ;[1423] NO MORE
JRST [ SKIPE RB,NORBYT ;[1456]
JRST T11XXA ;[1456]
MOVE P2,(P)
MOVE P1,-1(P)
MOVN T1,P2
HRL WC,T1
JRST T11XXR ] ;[1423] RESET FOR NEXT SUBBLOCK
T11XXA: PUSHJ P,PSORGN ;[1456] GET ANY PSECT INDICES
PUSHJ P,@P4 ;[1423] DO THE RELOCATION
PUSHJ P,@-2(P) ;[1405] AND THE PROCESSING
JRST T11XXL ;[1423] DO IT AGAIN
SUBTTL BLOCK TYPES 1100-1104 - PROGRAM DATA VECTORS
T.1100::
NEWBLX(2,^D18,THADD,T.11XX,T.110X) ;[1423]
T.1101::
NEWBLX(3,^D12,THADD,T.11XX,T.110X) ;[1423]
T.1102::
NEWBLX(6,6,THADD,T.11XX,T.110X) ;[1423]
T.1103::
NEWBLX(9,4,THADD,T.11XX,T.110X) ;[1423]
T.1104::
NEWBLX(18,2,THADD,T.11XX,T.110X) ;[1423]
T.110X: SKIPE W1 ;[1423] IGNORE ZEROS
MOVEM W1,PDVADR## ;[1423] STORE PDV ADDR
;** MAKE THIS WORK RIGHT FOR MULTIPLE PDVS **
POPJ P,
SUBTTL BLOCK TYPES 1120-1124 -- TYPE CHECKING BLOCKS
DEFINE T112XM(N)<
NEWBLX(N,<^D36/N>,THADD,T.11XX,T.112X,T112XP) > ;[1472]
T.1120::
T112XM(2) ;[1472]
T.1121::
T112XM(3) ;[1472]
T.1122::
T112XM(6) ;[1472]
T.1123::
T112XM(^D9) ;[1472]
T.1124::
T112XM(^D18) ;[1472]
T.112X: SETOM NORBYT ;[1456] DON'T READ ANY MORE RELOC BYTES
SKIPGE P3 ;[1405] FIRST TIME THRU?
JRST T112X ;[1405] NO
MOVEI T2,ABOVH(P3) ;[2270] MUST ALLOCATE A STORAGE BLOCK
SKIPE PAG.TP ;[2270] TP AREA PAGING?
JRST T112P ;[2270] YES
PUSHJ P,TP.GET## ;[2270] NO, ALLOCATE IN TP AREA
SKIPE PAG.TP ;[2270] DID IT JUST START PAGING?
T112P: PUSHJ P,DY.GET## ;[2270] PAGING, GET SPACE IN DY AREA
SETZM ABLNK(T1) ;[2422] INIT THE LINK WORD
MOVEM T2,ABSIZ(T1) ;[2270] STORE SIZE
MOVE W3,PRGNAM ;[2005] GET THE MODULE NAME
MOVEM W3,ABMOD(T1) ;[2020] SAVE IT
MOVE W2,T1 ;[2270] ADDRESS OF THE BLOCK
MOVEI W3,ABABA(T1) ;[2020] SAVE A PTR
MOVN T2,P3 ;[1405]
HRL W3,T2 ;[1405] MAKE W3 AN AOBJN PTR
SETOM P3 ;[1405] SAY WE'VE BEEN HERE
T112X: MOVEM W1,(W3) ;[1405] STORE THE DATA
ADD W3,[1,,1] ;[1471]
POPJ P, ;[1405] GET MORE
T112XP:
MOVE T1,ABCNT(W2) ;[2266] GET THE CHARACTER COUNT
SUBI T1,1 ;[2307] ACCOUNT FOR THE NULL
IDIVI T1,6 ;[2307] IN WORDS
SKIPE T2 ;[2266] ANY LEFT?
ADDI T1,1 ;[2266] YES, NEED ONE MORE WORD
HRLZ W3,T1 ;[2266] PUT IT IN AS THE SYMBOL LENGTH
HRRI W3,SYMBLK ;[2266] THE SYMBOL IN WILL BE IN SYMBLK
SETZM SYMBLK-1(T1) ;[2266] MAKE SURE NO JUNK IN LAST WORD
MOVE T4,ABCNT(W2) ;[1472] NOTE COUNT
MOVE T2,[POINT 7,ABNAM(W2)] ;[1472]
MOVE T3,[POINT 6,SYMBLK] ;[2266] PUT IT IN SYMBLK
T112X0: SOJL T4,T112X1 ;[1472] STOP WHEN ALL CHARS DONE
ILDB T1,T2 ;[1472] PICK UP ASCII
JUMPE T1,T112X1 ;[1472] NUL MUST BE END OF ASCIZ
SUBI T1," " ;[1472] ASCII TO SIXBIT
IDPB T1,T3 ;[1472] ACCUMULATE
JRST T112X0 ;[1472]
T112X1: EXCH W3,W2 ;[1472] W2/SIXBIT,W3/PTR
PUSHJ P,SY.TYP## ;[1472]
POPJ P,
SUBTTL BLOCK TYPE 1130 -- COERCION BLOCK
T.1130::
PUSHJ P,STDATA ;[1704] USE GENERAL ROUTINE
MOVEM W2,COERPT ;[1405]
JRST LOAD## ;[1701]
SUBTTL BLOCK TYPE 1131 - PSECT REDIRECTION
; ---------------------
; ! 1131 ! COUNT !
; ---------------------
; ! 0 ! INDEX !
; ---------------------
; ! LOWSEG PSECT NAME !
; ---------------------
; ! HIGHSEG PSECT NAME!
; ---------------------
;Where a psect name is:
; --------------------- ---------------------
; ! SIXBIT PSECT NAME ! ! 0 ! MBZ ! COUNT !
; --------------------- ---------------------
; ! (ATTRIBUTES) ! ! SIXBIT PSECT NAME !
; --------------------- ---------------------
; ! ADDITIONAL NAME !
; ---------------------
;
; .
;
; .
;
; ---------------------
; ! ADDITIONAL NAME !
; ---------------------
T.1131: PUSHJ P,X131GT ;[2223] Get the low psect
JRST [MOVEI T1,1131 ;[2223] No psect name is
JRST E$$RBS##] ;[2223] an error
JUMPE W2,X131HI ;[2223] No symbol, try high segment
EXCH W2,REDLO ;[2223] Save it, get old
PUSHJ P,X131RT ;[2223] Return the old symbol
X131HI: PUSHJ P,X131GT ;[2223] Get the high psect
JRST [MOVEI T1,1131 ;[2223] No psect name is
JRST E$$RBS##] ;[2223] an error
JUMPE W2,X131DF ;[2272] Done if no symbol
EXCH W2,REDHI ;[2223] Save it, get old
PUSHJ P,X131RT ;[2223] Return the old symbol
X131DF: MOVE T1,['.LOW. '] ;[2272] Get the default low seg psect
SKIPN REDLO ;[2272] Is there a low seg psect?
MOVEM T1,REDLO ;[2272] No, default it
MOVE T1,['.HIGH.'] ;[2272] Get the default high seg psect
SKIPN REDHI ;[2272] Is there a high seg psect?
MOVEM T1,REDHI ;[2272] No, default it
JRST LOAD## ;[2223] Done
;[2223] Here to read a possibly long symbol into the DY area.
;[2223] On exit, W2 contains the symbol.
X131GT: PUSHJ P,D.GET1 ;[2223] Get the symbol
POPJ P, ;[2223] Not there
MOVE W2,W1 ;[2223] Put it in W2
TLNE W2,770000 ;[2223] Long symbol?
JRST CPOPJ1 ;[2223] No, done
CAIN W2,1 ;[2223] Short symbol in disguise?
JRST [PUSHJ P,D.GET1 ;[2223] Yes, get one word
POPJ P, ;[2223] No word means bad rel block
MOVE W2,W1 ;[2223] Put it in W2
JRST CPOPJ1] ;[2223] Return with a short symbol
MOVE T2,W2 ;[2223] Get the length
JUMPE T2,CPOPJ1 ;[2223] Zero, no symbol
PUSHJ P,DY.GET ;[2223] Allocate some space
HRL T1,T2 ;[2223] Build length,,address
PUSH P,T1 ;[2223] Store it
MOVNS W2 ;[2223] Negate the count
HRLZS W2 ;[2223] Put it in the left half
HRR W2,T1 ;[2223] Make an AOBJN word
X131GL: PUSHJ P,D.GET1 ;[2223] Get a word
JRST [POP P,W2 ;[2223] No more, clear up stack
POPJ P,] ;[2223] Return
MOVEM W1,(W2) ;[2223] Save the word
AOBJN W2,X131GL ;[2223] Do all words
POP P,W2 ;[2236] Restore count,,address
JRST CPOPJ1 ;[2223] Done, return OK
;[2223] Here to return a possibly long symbol in the DY area.
;[2223] On entry, W2 contains the symbol.
X131RT: HLRZ T2,W2 ;[2231] Get the count
JUMPE T2,CPOPJ ;[2223] Done if empty
TRNE T2,770000 ;[2223] Long symbol?
POPJ P, ;[2223] No, done
HRRZ T1,W2 ;[2223] Long symbol
PJRST DY.RET## ;[2223] Return the space
SUBTTL BLOCK TYPE 1160 -- SPARSE DATA
; --------------------------------
; | 1160 | Long Count |
; --------------------------------
; |R|F|B|P|Symlen| Psect |
; --------------------------------
; | Symbol (Symlen words) |
; --------------------------------
; |S| Origin address |
; --------------------------------
; | Repetition Count if R=1 |
; --------------------------------
; | Fill Count if F=1 |
; --------------------------------
; | Fill Byte if F=1 |
; --------------------------------
; | Byte Count if B=1 |
; --------------------------------
; | Data Bytes |
; --------------------------------
T.1160: PUSHJ P,D.GET1 ;[2262] Get the first word of the rel block
JRST LOAD## ;[2262] Empty block
MOVE R,W1 ;[2262] Save the psect number etc.
LDB T1,[POINTR R,X60.P] ;[2262] Get the byte position
MOVEM T1,BYTPOS ;[2262] Save it
LDB W2,[POINTR R,X60.SL] ;[2262] Get the symbol length
SETZ W3, ;[2262] Zero the symbol value
JUMPE W2,X160NS ;[2262] Is there a symbol?
PUSHJ P,SYMIN1 ;[2262] Read the symbol
JRST [MOVEI T1,1160 ;[2262] No symbol?
JRST E$$RBS##] ;[2262] Bad rel block
MOVX W1,PT.SGN!PT.SYM!PS.GLB ;[2262] Set the flags
PUSHJ P,TRYSYM## ;[2262] See if defined
JRST E$$USD ;[2262] Not even in table
JRST E$$USD ;[2262] Undefined, so still no use
MOVE W3,2(P1) ;[2262] Get value
IFN FTOVERLAY,< ;[2262]
CAMGE W3,PH+PH.ADD ;[2262] Make sure array is in this link
JRST T.1SE## ;[2262] No, must be common in father link
>;[2262] IFN FTOVERLAY
X160NS: PUSHJ P,D.GET1 ;[2262] Get the next word
JRST [MOVEI T1,1160 ;[2262] No next word?
JRST E$$RBS##] ;[2262] Bad rel block
LDB T1,[POINTR W1,X60.S] ;[2262] Get the byte size
MOVEM T1,BYTSIZ ;[2262] Save it
LDB T1,[ADDRES W1] ;[2262] Get the address part
ADD W3,T1 ;[2262] Add the symbol part
TRNN R,-1 ;[2262] Psect relocation required?
JRST X160NP ;[2262] No
PUSH P,R ;[2262] Keep the bits around
PUSH P,RC.CUR ;[2327] Save the current psect
PUSHJ P,REL.TE ;[2262] Relocate the address (30 bit)
POP P,RC.CUR ;[2327] Restore the current psect
HRRM R,0(P) ;[2262] Keep the RC block pointer
POP P,R ;[2262] Get them back
X160NP: MOVEM W3,BYTADR ;[2262] Save the low address for the data
MOVEI W1,1 ;[2262] Get the default repetition count
TXNN R,X60.R ;[2262] Repetition count?
JRST X160NR ;[2262] No
PUSHJ P,D.GET1 ;[2262] Get the repetition count
JRST [MOVEI T1,1160 ;[2262] No count?
JRST E$$RBS##] ;[2262] Bad rel block
JUMPE W1,T1000C ;[2262] If zero, don't bother
X160NR: MOVEM W1,REPCNT ;[2262] Save the repetition count
SETZM FILCNT ;[2262] Assume no fill
TXNN R,X60.F ;[2262] Fill required?
JRST X160NF ;[2262] No
PUSHJ P,D.GET1 ;[2262] Get fill count
JRST [MOVEI T1,1160 ;[2262] No count?
JRST E$$RBS##] ;[2262] Bad rel block
MOVEM W1,FILCNT ;[2262] Save it
PUSHJ P,D.GET1 ;[2262] Get fill character
JRST [MOVEI T1,1160 ;[2262] No character?
JRST E$$RBS##] ;[2262] Bad rel block
MOVEM W1,FILCHR ;[2262] Save it
X160NF: MOVEI W1,1 ;[2262] Default byte count
TXNN R,X60.B ;[2262] Byte count given?
JRST X160NB ;[2262] No, no byte count
PUSHJ P,D.GET1 ;[2262] Get byte count
JRST [MOVEI T1,1160 ;[2262] No count?
JRST E$$RBS##] ;[2262] Bad rel block
X160NB: MOVEM W1,BYTCNT ;[2262] Save it
PUSHJ P,X160SZ ;[2262] Set up for size calculations
T1160S: SUB W1,T1 ;[2262] Minus number of bytes in first word
IDIV W1,BYTPWD ;[2262] Number of extra words needed
SKIPE W2 ;[2262] Any extra bytes?
ADDI W1,1 ;[2262] Yes, account for them
ADD W1,BYTADR ;[2262] Add first address to get last
MOVEM W1,LSTBYT ;[2262] Remember it
MOVE P3,BYTADR ;[2262] Get the first byte address
HRRZS R ;[2262] Get only the psect number
SETOM TP.PP ;[2270] Don't page the TP area for this
PUSHJ P,T.1AD## ;[2262] Try and allocate all of it
JRST [SETZM TP.PP ;[2270] Allow TP area paging
JRST T1000C] ;[2270] And ignore it (/ONLY switch in use)
PUSHJ P,T160DF ;[2262] Move window if deferred (less than 140)
SETZM TP.PP ;[2270] Allow the TP area to page
IFN FTOVERLAY,< ;[2313]
MOVN T1,PH+PH.ADD ;[2313] Get -base of overlay
ADDM T1,BYTADR ;[2313] Offset the first address
ADDM T1,LSTBYT ;[2313] Offset the last address
>;[2313] IFN FTOVERLAY
;[2262] Memory has been allocated. Set up for the loop to copy from the
;[2262] rel file buffer into memory.
;[2262] Set up number of bytes available in current source buffer
MOVE R,RC.SG(R) ;[2262] Get the high/low segment index
MOVE T1,DCBUF+2 ;[2262] Get the number of words in the buffer
IMUL T1,BYTPWD ;[2262] Number of bytes in buffer
MOVEM T1,SRCCNT ;[2262] Remember it
;[2262] Set up number of bytes which can be stored into in current
;[2262] destination buffer
MOVE T4,TAB.AB(R) ;[2262] Get the top of the area
SUB T4,TAB.LB(R) ;[2262] Minus bottom equals size
ADD T4,TAB.LW(R) ;[2262] Add the value of the bottom to get top
SUB T4,BYTADR ;[2262] Minus start address is what's left
IMUL T4,BYTPWD ;[2262] Number of bytes available
MOVE T1,BYTPOS ;[2262] Save it
MOVE T3,BYTSIZ ;[2262] Get the byte size
IDIVI T1,(T3) ;[2262] See how many bytes left in first word
ADD T1,T4 ;[2262] Add bytes in first word
MOVEM T1,DSTCNT ;[2262] Destination count
;[2262] Build the source byte pointer. Note that pointer is to end of
;[2262] previous word, and will be bumped by the MOVSLJ.
MOVE T1,BYTSIZ ;[2262] Get the byte size
HRRZ T2,DCBUF+1 ;[2262] Get the source pointer to the buffer
DPB T1,[POINT 6,T2,11] ;[2262] Set up the byte size
;[2262] Build the destination byte pointer
MOVE P1,BYTADR ;[2262] Get the byte address
SUB P1,TAB.LW(R) ;[2262] Minus the window offset
ADD P1,TAB.LB(R) ;[2262] Relocate
DPB T1,[POINT 6,P1,11] ;[2262] Put byte size in the byte pointer
MOVE T1,BYTPOS ;[2262] Get the byte position
DPB T1,[POINT 6,P1,5] ;[2262] Put it in the byte pointer
MOVE W3,BYTCNT ;[2262] Get number of bytes to move
DMOVE T3,DCBUF+1 ;[2262] Get location and size of buffer
DMOVEM T3,BUFBEG ;[2262] Remember them
;[2262] Loop to copy from the input buffers to the output windows.
X160NX: PUSHJ P,X160BF ;[2262] Make sure the buffer is not empty
PUSHJ P,X160CW ;[2262] Check the window
;[2262] Find the number of bytes which can be copied
MOVE T4,W3 ;[2262] Get the number of bytes desired
CAMLE T4,SRCCNT ;[2262] More than in the source buffer?
MOVE T4,SRCCNT ;[2262] Yes, can't do more than that
CAMLE T4,DSTCNT ;[2262] More than can fit in window?
MOVE T4,DSTCNT ;[2262] Yes, do only that much
MOVN T1,T4 ;[2262] Get minus what will be copied
ADDM T1,SRCCNT ;[2262] Update the source count
ADDM T1,DSTCNT ;[2262] And the destination count
MOVE T1,T4 ;[2262] Put count in both places
SUB W3,T4 ;[2262] Remember how many have been done
SETZB T3,P2 ;[2262] Just to be safe
EXTEND T1,[MOVSLJ] ;[2262] Copy the string
JFCL ;[2262] Should not run out
JUMPN W3,X160NX ;[2262] Continue until all bytes copied
;[2262] Now fix up the source buffer pointers. Use stored original
;[2262] pointers and the source byte pointer.
SKIPGE DCBUF+1 ;[2262] Is it new buffer pointer never ILDB'd?
ADDI T2,1 ;[2262] Yes, Point at next word
HRRM T2,DCBUF+1 ;[2262] And fix up the pointer
HRRZ T3,BUFBEG ;[2262] Get the beginning of the buffer
ADD T3,BUFLEN ;[2262] Plus length is end of buffer
SUBI T3,(T2) ;[2262] Minus how far was used
MOVEM T3,DCBUF+2 ;[2262] Restore it into DCBUF
;[2262] Here to do fill if necessary
SKIPN W3,FILCNT ;[2262] Get the fill count
JRST X160RP ;[2262] None, go do repeat count
MOVX P3,<MOVSLJ> ;[2262] Get the op code for the fill
MOVE P4,FILCHR ;[2262] And the fill byte
X160FL: PUSHJ P,X160CW ;[2262] Check the window
;[2262] Find the number of bytes which can filled this time
MOVE T4,W3 ;[2262] Get the number of bytes desired
CAMLE T4,DSTCNT ;[2262] More than can fit in window?
MOVE T4,DSTCNT ;[2262] Yes, do only that much
SUB W3,T4 ;[2262] Remember how many have been done
MOVN T3,T4 ;[2262] Get minus what will be copied
ADDM T3,DSTCNT ;[2262] Update the destination count
SETZ T1, ;[2262] No source characters
SETZB T3,P2 ;[2262] Just to be safe
EXTEND T1,P3 ;[2262] Fill as many as possible
JFCL ;[2262] Skips if filling
JUMPN W3,X160FL ;[2262] Do them all
;[2262] Here to handle the repeat count
X160RP: SOSG REPCNT ;[2262] Need to copy again?
JRST LOAD## ;[2262] No, done
;[2262] Here to pick a method for handling the repeat count.
;[2262] If all of the data will fit in the current window, just
;[2262] copy it with the MOVSLJ. If one copy of the data will
;[2262] fit in memory, and there is more than about 1/4 of the
;[2262] window (must be at least 1 page) free, copy what is
;[2262] possible with the MOVSLJ, move the window, and continue
;[2262] copying. Otherwise, split the window into two smaller
;[2262] windows, get a copy of the data into one, and copy it
;[2262] to the other.
;[2366] On TOPS-10 there are a couple extra wrinkles. If the
;[2366] area is split into source and destination windows, their
;[2366] contents must not overlap. This means that the windows
;[2366] must be shorter than the size of the data items. This
;[2366] means that, for an item less than one page long, the
;[2366] window size would be zero. It is necessary to use a
;[2366] one window move for such data. It is also possible
;[2366] that the area will be only one page long. If it will
;[2366] be necessary to move the window, at least two pages
;[2366] will be necessary.
MOVE W3,FILCNT ;[2262] Get the fill count
ADDB W3,BYTCNT ;[2262] Include it in the byte count
IMUL W3,REPCNT ;[2262] Total number of bytes to move
IFE TOPS20,< ;[2366]
MOVE T1,BYTCNT ;[2366] Get number of bytes
IDIV T1,BYTPWD ;[2366] Size in words
CAIGE T1,.IPS ;[2366] Less than one page?
JRST X160SS ;[2366] Yes, special case
>;[2366] IFE TOPS20
MOVE T3,BYTADR ;[2262] Get the origin address
CAMGE T3,TAB.LW(R) ;[2262] Outside of the window?
JRST X160CX ;[2262] Yes, too big for one window
CAMG W3,DSTCNT ;[2262] That many bytes left?
JRST X160SM ;[2262] Yes, it will fit in one window
MOVE T1,TAB.AB(R) ;[2262] Get the upper bound
SUBI T1,(P1) ;[2262] Minus what is left
CAIG T1,.IPS ;[2262] More than a page?
JRST X160CX ;[2262] No, too big for one window
IMULX T1,4 ;[2262] 4 times what's left
MOVE T3,TAB.AB(R) ;[2262] Get the upper bound
SUB T3,TAB.LB(R) ;[2262] Minus the lower
CAMGE T1,T3 ;[2262] More than a quarter of the window left?
JRST X160CX ;[2262] No, use two windows
X160SM: MOVE T2,BYTADR ;[2262] Get the first copy's address
SUB T2,TAB.LW(R) ;[2262] Minus the window bound
ADD T2,TAB.LB(R) ;[2262] Relocate it
MOVE T3,BYTSIZ ;[2262] Get the byte size
DPB T3,[POINT 6,T2,11] ;[2262] Put byte size in the byte pointer
MOVE T3,BYTPOS ;[2262] Get the byte position
DPB T3,[POINT 6,T2,5] ;[2262] Put it in the byte pointer
X160SL: MOVE T1,W3 ;[2262] Get the number of bytes left to copy
CAML T1,DSTCNT ;[2262] Less than what can be done?
MOVE T1,DSTCNT ;[2262] Yes, do that many
SUB W3,T1 ;[2262] Update what's left to do
MOVN T4,T1 ;[2262] Get minus how many to do
ADDM T4,DSTCNT ;[2262] Update count of what's left
MOVE T4,T1 ;[2262] Both counts the same
SETZB T3,P2 ;[2262] Just to be safe
EXTEND T1,[MOVSLJ] ;[2262] Copy the string
JFCL ;[2262] Should not run out
JUMPE W3,LOAD## ;[2262] Check for done
HRRZ P3,T2 ;[2262] Get the source
SUB P3,TAB.LB(R) ;[2262] Unrelocate it
ADD P3,TAB.LW(R) ;[2262] Get the true address
TXZ P3,.IPM ;[2262] Put on a page boundary
MOVE P2,P3 ;[2262] Get the bottom of the window area
ADD P2,TAB.AB(R) ;[2262] Plus the upper area limit
SUB P2,TAB.LB(R) ;[2262] Minus the lower
CAMLE P2,LSTBYT ;[2262] Is this more than necessary?
MOVE P2,LSTBYT ;[2262] Yes, only get this much
TXO P2,.IPM ;[2262] Put on a page boundary
SUB T2,TAB.LB(R) ;[2366] Unrelocate the pointers
SUB P1,TAB.LB(R) ;[2366] In case the area moves
PUSH P,T2 ;[2366] Save the source pointer
PUSH P,P1 ;[2366] And the destination pointer
PUSH P,TAB.LW(R) ;[2366] And the current window bottom
PUSHJ P,@[EXP PG.LSG##,PG.HSG##]-1(R) ;[2262] Move the window
POP P,T1 ;[2262] Get back the old lower bound
SUB T1,TAB.LW(R) ;[2262] How far the window moved
MOVNS T1 ;[2262] Make it positive
POP P,P1 ;[2262] Get back the destination pointer
SUB P1,T1 ;[2262] Adjust the pointer
POP P,T2 ;[2262] Get back the source pointer
SUB T2,T1 ;[2262] Adjust the pointer
ADD T2,TAB.LB(R) ;[2366] Relocate the pointers
ADD P1,TAB.LB(R) ;[2366] Back into the correct area
;[2262] Note that this calculation is incorrect for the last time the window
;[2262] is moved, since the window may be shrunk. This is not important, as
;[2262] LSTBYT guarantees the bytes which will be moved will fit in the window.
IMUL T1,BYTPWD ;[2262] In bytes
ADDM T1,DSTCNT ;[2262] Update the destination counter
JRST X160SL ;[2262] Go back and copy more bytes
IFE TOPS20,<
;[2366] Here for case of less than one page. Make sure that
;[2366] there are at least 2 pages in the area.
X160SS: MOVE T1,TAB.AB(R) ;[2366] Get the top of the area
SUB T1,TAB.LB(R) ;[2366] Minus the bottom for size
CAILE T1,.IPS-1 ;[2366] One page?
JRST X160SM ;[2366] No, no problem
PUSH P,P1 ;[2366] Save the destination pointer
MOVEI P1,(R) ;[2366] Point to the area
MOVEI P2,1 ;[2366] Expand by one page
PUSHJ P,LNKCOR## ;[2366] Get the core
PUSHJ P,E$$MEF## ;[2366] Not even one page?
MOVE P1,TAB.AB(R) ;[2366] Get new upper bound
SUB P1,TAB.LB(R) ;[2366] Get new size
ADD P1,TAB.LW(R) ;[2366] Add window bottom
SKIPE TAB.UW(R) ;[2410] IF THIS AREA IS PAGING
MOVEM P1,TAB.UW(R) ;[2366] New windown top
MOVE P1,BYTPWD ;[2366] Get bytes per word
IMULI P1,.IPS ;[2366] Get bytes per page
ADDM P1,DSTCNT ;[2366] Update the destination counter
POP P,P1 ;[2366] Retrieve destination pointer
JRST X160SM ;[2366] Process as simple case
>;[2366] IFE TOPS20
;[2262] Here to handle the case where multiple copies will not fit
;[2262] in the window. Split the window, and use half for the source
;[2262] and half for the destination.
X160CX: MOVE T1,TAB.LW(R) ;[2262] Get the lower window bound
MOVE T2,TAB.UW(R) ;[2262] And the upper bound
PUSHJ P,@[EXP LC.OUT##,HC.OUT##]-1(R) ;[2262] Empty the window
MOVE T2,TAB.AB(R) ;[2262] Get the maximum address
SUB T2,TAB.LB(R) ;[2262] Minus the minimum address
ADDI T2,1 ;[2262] Get actual window size
CAIL T2,2*.IPS ;[2366] At least two pages in area?
JRST X160CM ;[2366] Yes, no problem
MOVEI P1,(R) ;[2366] Point to the area
MOVEI P2,1 ;[2366] Expand by one page
PUSHJ P,LNKCOR## ;[2366] Get the core
PUSHJ P,E$$MEF## ;[2366] Not even one page?
MOVEI T2,2*.IPS ;[2366] Now there are two pages
X160CM: LSH T2,-1 ;[2262] Get size of half window
TRO T2,.IPM ;[2262] Put at end of page
IFE TOPS20,<
MOVE T4,W3 ;[2366] Get number of bytes
IDIV T4,BYTPWD ;[2366] Size in words
TRZ T4,.IPM ;[2366] Maximum window size to prevent overlap
SUBI T4,1 ;[2366] As an upper limit
CAMLE T2,T4 ;[2366] Window small enough?
MOVE T2,T4 ;[2366] No, use smaller size
>;[2366] IFE TOPS20
MOVE T1,TAB.LB(R) ;[2262] Get the lower bound
ADD T2,TAB.LB(R) ;[2262] End of lower window half
DMOVEM T1,DST.LB ;[2262] Save as the destination bounds
MOVEI T3,1(T2) ;[2262] Source LB is destination UB+1
IFE TOPS20,< ;[2366]
ADD T4,T3 ;[2366] Get the highest acceptable bound
CAML T4,TAB.AB(R) ;[2366] Is it OK?
JRST X160CZ ;[2366] Yes, no overlap possible
SETZM 1(T4) ;[2366] Zero first free word
HRLI T1,1(T4) ;[2366] From
HRRI T1,2(T4) ;[2366] To
BLT T3,@TAB.AB(R) ;[2366] Zero extra memory
MOVEM T4,TAB.AB(R) ;[2366] Set new bound
X160CZ:
>;[2366] IFE TOPS20
MOVE T4,TAB.AB(R) ;[2262] Get upper bound
DMOVEM T3,SRC.LB ;[2262] Save as the source bounds
MOVEM T2,TAB.AB(R) ;[2262] Set up destination window
HRRZ T1,P1 ;[2262] Get the destination address
SUB T1,TAB.LB(R) ;[2262] Relocate
ADD T1,TAB.LW(R) ;[2262] Make into an address
PUSH P,T1 ;[2262] Keep the address
TXZ T1,.IPM ;[2262] Set on block boundary
MOVEM T1,TAB.LW(R) ;[2262] New lower bound
MOVE T2,T1 ;[2262] Get the lower bound
ADD T2,DST.AB ;[2262] Add the destination upper bound
SUB T2,DST.LB ;[2262] Minus the lower is high address
MOVEM T2,TAB.UW(R) ;[2262] Save it
DMOVEM T1,DST.LW ;[2262] Save the window addresses
PUSHJ P,@[EXP LC.IN##,HC.IN##]-1(R) ;[2262] Read the window
POP P,T1 ;[2262] Get back the destination address
SUB T1,DST.LW ;[2262] Subtract the lower window bound
ADD T1,DST.LB ;[2262] Unrelocate it
HRR P1,T1 ;[2262] Put it back in the byte pointer
MOVE W1,P1 ;[2262] Get the destination byte pointer
PUSHJ P,X160CB ;[2262] Count the remaining bytes in the window
MOVEM T1,DSTCNT ;[2262] Remember it
DMOVE T1,SRC.LB ;[2262] Now switch to the source window
MOVEM T1,TAB.LB(R) ;[2262] Store the source lower bound
MOVEM T2,TAB.AB(R) ;[2262] And upper
MOVE T1,BYTADR ;[2262] Get the source address
TXZ T1,.IPM ;[2262] Set on a page boundary
MOVEM T1,TAB.LW(R) ;[2262] Save the lower window
ADD T2,T1 ;[2262] Lower window plus upper bound
SUB T2,SRC.LB ;[2262] Minus lower bound is upper window
MOVEM T2,TAB.UW(R) ;[2262] Save it
DMOVEM T1,SRC.LW ;[2262] Save it
PUSHJ P,@[EXP LC.IN##,HC.IN##]-1(R) ;[2262] Read the window
MOVE W1,BYTADR ;[2262] Get the source address
SUB W1,SRC.LW ;[2262] Subtract the lower window bound
ADD W1,SRC.LB ;[2262] Unrelocate it
MOVE T1,BYTSIZ ;[2262] Get the byte size
DPB T1,[POINT 6,W1,11] ;[2262] Put it in the byte pointer
MOVE T1,BYTPOS ;[2262] Get the source byte position
DPB T1,[POINT 6,W1,5] ;[2262] Put it in the byte pointer
PUSHJ P,X160CB ;[2262] Count the remaining bytes in the window
MOVEM T1,SRCCNT ;[2262] Remember it
MOVE T2,W1 ;[2262] Get the source address in memory
X160MB: PUSHJ P,X160SC ;[2262] Check the source window
PUSHJ P,X160DS ;[2262] And the destination window
;[2262] Find the number of bytes which can be copied
MOVE T4,W3 ;[2262] Get the number of bytes desired
CAMLE T4,SRCCNT ;[2262] More than in the source buffer?
MOVE T4,SRCCNT ;[2262] Yes, can't do more than that
CAMLE T4,DSTCNT ;[2262] More than can fit in window?
MOVE T4,DSTCNT ;[2262] Yes, do only that much
MOVN T1,T4 ;[2262] Get minus what will be copied
ADDM T1,SRCCNT ;[2262] Update the source count
ADDM T1,DSTCNT ;[2262] And the destination count
MOVE T1,T4 ;[2262] Put count in both places
SUB W3,T4 ;[2262] Remember how many have been done
SETZB T3,P2 ;[2262] Just to be safe
EXTEND T1,[MOVSLJ] ;[2262] Copy the string
JFCL ;[2262] Should not run out
JUMPN W3,X160MB ;[2262] Continue until all bytes copied
;[2262] Now unscrew the windows and return. Remove the source window,
;[2262] and leave the destination window only.
IFN TOPS20,< ;[2262]
DMOVE T1,SRC.LB ;[2262] Get the source bounds
MOVEM T1,TAB.LB(R) ;[2262] Set the lower bound
MOVEM T2,TAB.AB(R) ;[2262] And the upper
DMOVE T1,SRC.LW ;[2262] Get the window limits
MOVEM T1,TAB.LW(R) ;[2262] Set the lower window
MOVEM T2,TAB.UW(R) ;[2262] And the upper
PUSHJ P,@[EXP LC.OUT##,HC.OUT##]-1(R) ;[2262] Write the window
> ;[2262] IFN TOPS20
IFE TOPS20,<
MOVE T1,SRC.LB ;[2262] Get the lower bound
HRL T1,SRC.LB ;[2262] In both halves
SETZM (T1) ;[2262] Zero the first word
ADDI T1,1 ;[2262] From,,to for zero
MOVE T2,SRC.AB ;[2262] How far to go
BLT T1,(T2) ;[2262] Zero the memory
>
DMOVE T1,DST.LB ;[2262] Get the source bounds
MOVEM T1,TAB.LB(R) ;[2262] Set the lower bound
MOVEM T2,TAB.AB(R) ;[2262] And the upper
DMOVE T1,DST.LW ;[2262] Get the window limits
MOVEM T1,TAB.LW(R) ;[2262] Set the lower window
MOVEM T2,TAB.UW(R) ;[2262] And the upper
JRST LOAD## ;[2262] Done
;[2262] Here if deferred. What this really means is that it goes
;[2262] below address 140. Since this block cannot be deferred, move
;[2262] the window to page zero. Note that this must be in the low seg
;[2262] because the high segment cannot start below 140.
;[2343] Uses R, T1, T2
T160DF: MOVE R,SG.TB+1 ;[2343] In low segment
MOVE T1,LW.LC ;[2262] Get the low bound
MOVE T2,UW.LC ;[2262] And the high bound
PUSHJ P,LC.OUT## ;[2262] Write the window
MOVE T1,LC.LB ;[2262] Get the base of the area
IORI T1,.IPM ;[2262] Want only one block
MOVEM T1,LC.AB ;[2262] Allocate it
SETZB T1,LW.LC ;[2343] Starting at address zero
MOVEI T2,.IPM ;[2262] Want one page
MOVEM T2,UW.LC ;[2343] Set the window correctly
PJRST LC.IN## ;[2262] Go get it
;[2262] Here to compute the byte size, and diddle the byte pointer
;[2262] if necessary.
;[2343] On input W1 contains the byte count
;[2343] On return W1 contains the total number of bytes
;[2343] Uses T1,T2,T3
X160SZ: MOVE T3,BYTSIZ ;[2262] Get the byte size
MOVEI T1,^D36 ;[2262] Bits per wordt
IDIVI T1,(T3) ;[2262] Bytes per word
MOVEM T1,BYTPWD ;[2262] Save it
ADD W1,FILCNT ;[2262] Byte count plus fill bytes
IMUL W1,REPCNT ;[2262] Times the repetition count
MOVE T1,BYTPOS ;[2262] Get the byte position
MOVE T3,BYTSIZ ;[2262] Get the byte size
IDIVI T1,(T3) ;[2262] See how many bytes left in first word
JUMPN T1,CPOPJ ;[2262] Done if something in first word
MOVEI T1,^D36 ;[2262] Need to point to beginning
MOVEM T1,BYTPOS ;[2262] of word
AOS BYTADR ;[2262] Next word
MOVE T1,BYTPWD ;[2262] Number of bytes in first word
POPJ P, ;[2262] Continue calculation
;[2262] Here to check that there is something in the rel
;[2262] file buffer. If it is empty, read some more.
;[2262] Also updates the source pointer in T2.
;[2262] Uses T1,T2,T3,T4
X160BF: SKIPLE SRCCNT ;[2262] Rel buffer empty?
POPJ P, ;[2262] No, return
SKIPN DCBUF ;[2262] If zero, reading from core
JRST X160B1 ;[2262] Read buffer from FX area
PUSHJ P,D.CNT## ;[2262] Get the next buffer from disk
JRST X160B2 ;[2262] Not expected to skip
IFN TOPS20,< ;[2301]
SKIPLE RFLEN ;[2301] But it did, is it EOF?
>;[2301] IFN TOPS20
IFE TOPS20,<
STATO DC,IO.EOF ;[2301] EOF?
>;[2301] IFE TOPS20
JRST D.ERR## ;[2262] It's an error
MOVEI T1,1160 ;[2301] EOF, get the block type
PUSHJ P,E$$RBS## ;[2301] Give an error
X160B1: PUSHJ P,FXREAD## ;[2262] Read buffer from FX area
;[2366] When doing buffered I/O on TOPS-10, after an IN UUO the
;[2366] second word of the buffer header contains a 004400 byte
;[2366] pointer which points to the word before the first data
;[2366] word. On TOPS-20 The code which does the PMAP% builds
;[2366] a 444400 byte pointer which points to the first data word
;[2366] of the buffer. Set up the correct style of byte pointer.
;[2366] Note that T2 already has the byte size in the correct place.
X160B2: TLZ T2,770000 ;[2262] Clear the byte pointer
IFN TOPS20,< ;[2366]
TLO T2,440000 ;[2262] And set for beginning of word
>;[2366] IFE TOPS20
HRR T2,DCBUF+1 ;[2262] At the beginning of the buffer
MOVE T1,DCBUF+2 ;[2262] Number of words in buffer
IMUL T1,BYTPWD ;[2262] Number of bytes in buffer
MOVEM T1,SRCCNT ;[2262] Remember what's available
DMOVE T3,DCBUF+1 ;[2262] Get location and size of buffer
DMOVEM T3,BUFBEG ;[2262] Remember them
POPJ P, ;[2262] Return
;[2262] Here to check that the start of the destination transfer is within
;[2262] the window, and to move the window if it is not.
;[2262] Also updates the destination pointer in P1.
;[2262] Uses T1,T3
X160CW: SKIPLE DSTCNT ;[2262] Any more space in the window?
POPJ P, ;[2262] Yes
PUSHJ P,X160PU ;[2262] Push up the window
MOVEM T1,DSTCNT ;[2262] Save destination count
POPJ P,
;[2262] Here to check that the start of the source transfer is within
;[2262] the window when using half-windows, and to move the window
;[2262] if it is not. Also updates the source pointer in T2.
;[2262] Uses T1,T3,T4
X160SC: SKIPLE SRCCNT ;[2262] Any more space in the window?
POPJ P, ;[2262] Yes
DMOVE T3,SRC.LB ;[2262] Get the source bounds
MOVEM T3,TAB.LB(R) ;[2262] Set the lower bound
MOVEM T4,TAB.AB(R) ;[2262] And the upper
DMOVE T3,SRC.LW ;[2262] Get the window limits
MOVEM T3,TAB.LW(R) ;[2262] Set the lower window
MOVEM T4,TAB.UW(R) ;[2262] And the upper
EXCH P1,T2 ;[2262] Swap pointers (X160P1 updates P1)
PUSHJ P,X160P1 ;[2262] Get new window
MOVEM T1,SRCCNT ;[2262] Update source count
EXCH P1,T2 ;[2262] Swap back pointers
MOVE T3,TAB.LB(R) ;[2262] Get the lower bound
MOVE T4,TAB.AB(R) ;[2262] And the upper
DMOVEM T3,SRC.LB ;[2262] Save the new source bounds
MOVE T3,TAB.LW(R) ;[2262] Get the lower window
MOVE T4,TAB.UW(R) ;[2262] And the upper
DMOVEM T3,SRC.LW ;[2262] Save the window limits
POPJ P, ;[2262] Done
;[2262] Here to check that the start of the source transfer is within
;[2262] the window when using half-windows, and to move the window
;[2262] if it is not. Also updates the source pointer in T2.
;[2262] Uses T1,T3,T4
X160DS: SKIPLE DSTCNT ;[2262] Any more space in the window?
POPJ P, ;[2262] Yes
DMOVE T3,DST.LB ;[2262] Get the destination bounds
MOVEM T3,TAB.LB(R) ;[2262] Set the lower bound
MOVEM T4,TAB.AB(R) ;[2262] And the upper
DMOVE T3,DST.LW ;[2262] Get the window limits
MOVEM T3,TAB.LW(R) ;[2262] Set the lower window
MOVEM T4,TAB.UW(R) ;[2262] And the upper
PUSHJ P,X160PU ;[2262] Get new window
MOVEM T1,DSTCNT ;[2262] Update source count
MOVE T3,TAB.LB(R) ;[2262] Get the lower bound
MOVE T4,TAB.AB(R) ;[2262] And the upper
DMOVEM T3,DST.LB ;[2262] Save the destination bounds
MOVE T3,TAB.LW(R) ;[2262] Set the lower window
MOVE T4,TAB.UW(R) ;[2262] And the upper
DMOVEM T3,DST.LW ;[2262] Get the window limits
POPJ P, ;[2262] Done
;[2262] Routine to actually move the window up.
;[2262] Returns updated destination count in T1
;[2262] Uses T1,T3
X160P1: PUSH P,T2 ;[2262] Save the destination byte pointer
JRST X160P2 ;[2262] And don't write the window
X160PU: PUSH P,T2 ;[2262] Save the source byte pointer
MOVE T1,TAB.LW(R) ;[2262] Get the lower bound
MOVE T2,TAB.UW(R) ;[2262] And the upper bound
PUSHJ P,@[EXP LC.OUT##,HC.OUT##]-1(R) ;[2262] Write the window
X160P2: MOVE T1,TAB.UW(R) ;[2262] Get current upper window
ADDI T1,1 ;[2262] Plus one is new lower window
MOVE T2,T1 ;[2262] Get the low address
ADD T2,TAB.AB(R) ;[2262] Plus the upper area limit
SUB T2,TAB.LB(R) ;[2262] Minus the lower
CAMLE T2,LSTBYT ;[2262] Is this more than necessary?
MOVE T2,LSTBYT ;[2262] Yes, only get this much
TXO T2,.IPM ;[2262] Put on a block boundary
MOVEM T1,TAB.LW(R) ;[2262] Set the new lower bound
MOVEM T2,TAB.UW(R) ;[2262] And the new upper bound
PUSHJ P,@[EXP LC.IN##,HC.IN##]-1(R) ;[2262] Read the window
MOVE T1,TAB.UW(R) ;[2262] Get the upper bound
SUB T1,TAB.LW(R) ;[2262] Minus the lower gives area size
MOVE T2,T1 ;[2262] Hold onto the size
ADD T2,TAB.LB(R) ;[2262] Plus the lower bound gives actual bound
MOVEM T2,TAB.AB(R) ;[2262] Store it
TLZ P1,770000 ;[2262] Clear the position bits
TLO P1,440000 ;[2262] Point to beginning of word
HRR P1,TAB.LB(R) ;[2262] Address is beginning of window
ADDI T1,1 ;[2262] Number of words in window
IMUL T1,BYTPWD ;[2262] How many bytes in window
POP P,T2 ;[2262] Get back the source byte pointer
POPJ P, ;[2262]
;[2262] Here to compute the number of bytes left in the current window.
;[2262] Assumes the area is paging.
;[2262] Accepts a byte pointer in W1
;[2262] Returns a byte count in T1
;[2262] Uses T1-T4
X160CB: MOVE T4,TAB.AB(R) ;[2262] Get the upper bound
SUBI T4,(W1) ;[2262] Minus start address is what's left
IMUL T4,BYTPWD ;[2262] Number of bytes available
LDB T1,[POINT 6,W1,5] ;[2262] Get the byte position
MOVE T3,BYTSIZ ;[2262] Get the byte size
IDIVI T1,(T3) ;[2262] See how many bytes left in first word
ADD T1,T4 ;[2262] Add bytes in first word
POPJ P, ;[2262] Return
E$$USD::.ERR. (MS,.EC,V%L,L%W,S%W,USD,<Undefined symbol >) ;[2262]
.ETC. (SBX,.EC!.EP,,,,W2) ;[2262]
.ETC. (STR,.EC,,,,,< in sparse data (type 1160) block>) ;[2262]
.ETC. (JMP,,,,,.ETIMF##) ;[2262] Type the filename
JRST T1000C ;[2262] Ignore this block
.ZZ==.TEMP ;[2262] Allocate .TEMP space
U (BYTADR) ;[2262] First address for data store
U (BYTSIZ) ;[2262] Byte size
U (BYTCNT) ;[2262] Byte count
U (BYTPOS) ;[2262] Byte position
U (BYTPWD) ;[2262] Bytes per word
U (SRCCNT) ;[2262] Number of source bytes in buffer
U (DSTCNT) ;[2262] Number of destination bytes in window
U (LSTBYT) ;[2262] Last byte address
U (FILCHR) ;[2262] Fill Character
U (FILCNT) ;[2262] Fill count
U (REPCNT) ;[2262] Repetition count
;[2262] The next two words must be contiguous
U (BUFBEG) ;[2262] Beginning of buffer area copied
U (BUFLEN) ;[2262] Amount in buffer at beginning of copy
;[2262] The following four words must be contiguous
U (SRC.LB) ;[2262] TAB.LB(R) FOR SOURCE
U (SRC.AB) ;[2262] TAB.AB(R) FOR SOURCE
U (SRC.LW) ;[2262] TAB.LW(R) FOR SOURCE
U (SRC.UW) ;[2262] TAB.UW(R) FOR SOURCE
;[2262] The following four words must be contiguous
U (DST.LB) ;[2262] TAB.LB(R) FOR DESTINATION
U (DST.AB) ;[2262] TAB.AB(R) FOR DESTINATION
U (DST.LW) ;[2262] TAB.LW(R) FOR DESTINATION
U (DST.UW) ;[2262] TAB.UW(R) FOR DESTINATION
STDATA::
; Reads data out of a block without doing any relocation.
; Returns IOWD to storage in DY area holding the data in register W2.
; Uses T1-T2 and W1-W3.
HRRZ T2,WC ;[1471] GET BLOCKSIZE
TDO T2,[-1,,400000] ;[1471]
HRLM T2,WC ;[1471] SUBBLOCK=BLOCK
MOVNS T2 ;[1471] NOW POSITIVE
PUSHJ P,DY.GET## ;[1471] TO HOLD THE INFO
MOVE W3,T1 ;[1701] SAVE A PTR
MOVNS T2 ;[1701]
HRL W3,T2 ;[1701] MAKE W3 AN AOBJN PTR
MOVE W2,W3 ;[1701] W2 IS A BASE PTR
STDATL: PUSHJ P,D.IN1## ;[1471] PICK UP A WORD
MOVEM W1,(W3) ;[1471] STORE THE DATA
AOBJP W3,CPOPJ ;[1704] ALL DATA READ, NOW PROCESS IT
JRST STDATL ;[1471] GET ANOTHER WORD
SUBTTL THE END
NEWLIT: END