Trailing-Edge
-
PDP-10 Archives
-
BB-4172H-BM
-
language-sources/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 6-Jan-83
;COPYRIGHT (C) 1973, 1983 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;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==5 ;DEC VERSION
DECMVR==1 ;DEC MINOR VERSION
DECEVR==2026 ;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.
SUBTTL BLOCK DISPATCH TABLES
XALL
NDSPTB: LITYPE (1000,1137) ;[1452]
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
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 !
; ----------------
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,1 ;TREAT 0 AND 1 AS T.1001
JRST T.1001 ;NOT A LONG SYMBOL
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
HRR T3,1(T1) ;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: 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: TRNN FL,R.LIB ;IN LIBRARY SEARCH MODE
JRST LOAD## ;YES, SYMBOL STORED SO GET NEXT BLOCK
MOVE W3,ENTPTR ;END OF BLOCK, GET POINTER
TLZE W3,007777 ;SUPER LONG?
ADDI W3,1 ;YES
MOVX W1,PT.EXT ;LONG SYMBOL BIT ON
MOVE W2,1(W3) ;FIRST 6 CHARS
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 ! COUNT !
; ----------------------
; ! FLAGS ! 0 ! PT.SGN!PT.TTL!PT.EXT
; ----------------- (PT.EXT OFF IF COUNT=3)
; ! PROGRAM TITLE !
; -----------------
; ! 0 !
; ----------------------
; ! FLAGS ! 0 ! S.TTL
; -----------------
; ! MORE TITLE !
; -----------------
; ! MORE TITLE !
; -----------------
;
; .
;
; .
;
; ----------------------
; ! FLAGS ! 0 ! S.TTL!S.CMT
; -----------------
; ! ASCII COMMENT !
; -----------------
; ! MORE COMMENT !
; -----------------
;
; .
;
; .
;
; ----------------------
; ! FLAGS ! 0 ! S.TTL!S.PRC
; -----------------
; ! COMPILER NAME !
; -----------------
; ! CODE ! CPUS !
; ----------------------
; ! FLAGS ! 0 ! S.TTL!S.PRC
; -----------------
; ! MORE C. NAME !
; -----------------
; ! MORE C. NAME !
; -----------------
;
; .
;
; .
;
; ----------------------
; ! FLAGS ! 0 ! S.TTL!S.CRE
; -----------------
; ! COMPIL DATIME !
; -----------------
; ! COMPILER VERS !
; ----------------------
; ! FLAGS ! 0 ! S.TTL!S.DEV
; -----------------
; ! DEVICE NAME !
; -----------------
; ! UFD !
; ----------------------
; ! FLAGS ! 0 ! S.TTL!S.NAM
; -----------------
; ! FILE NAME !
; -----------------
; ! FILE EXT !
; ----------------------
; ! FLAGS ! 0 ! S.TTL!S.SFD
; -----------------
; ! SFD1 !
; -----------------
; ! SFD2 !
; -----------------
;
; .
;
; .
;
; ----------------------
; ! FLAGS ! 0 ! S.TTL!S.VER
; -----------------
; ! SOURCE VER # !
; -----------------
; ! DATE ! TIME !
; ----------------------
;
; ALSO S.LST MUST BE ON IN LAST BLOCK IF MORE THAN 1 TRIPLET
IFE .NWBLK,<
T.1003==E$$IRB##
>
;HERE ON A BLOCK TYPE 1003 (NAME BLOCK)
;AC USAGE IN T.1003 ROUTINES:
;
; P1 AOBJN POINTER TO THE CURRENT SECONDARY TRIPLET
; P2 OR OF ALL THE SECONDARY TRIPLET FLAG WORDS SEEN
; P3 BIT MAP OF TRIPLETS WE KNOW WE'VE PASSED
;
;ALSO, THE W'S CONTAIN THE CURRENT TRIPLET AND THE T'S ARE SCRATCH.
IFN .NWBLK,<
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 T.1000 ;NO CHANCE, JUST IGNORE THIS BLOCK
PUSHJ P,D.TRIP ;GET THE FIRST TRIPLET
PUSHJ P,T1003E ;ERROR
TXNE W1,PT.MSF ;DESCRIBES A SECOND SOURCE FILE?
JRST T1003M ;YES, GO HANDLE SEPERATELY
; TXNE W1,PT.BLK ;JUST A LOCAL BLOCK HEADER?
; JRST T1003G ;YES, GO STICK IN THE SYMBOL TABLE
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
JUMPN T1,T1003E ;IF ANY BAD BITS, TELL OF ERROR
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
MOVE T1,LSYM ;WORD COUNT IN LOCAL SYMBOL TABLE
MOVEM T1,NAMPTR ;POINT TO THIS TITLE BLOCK
MOVEM W2,PRGNAM ;STORE 1ST 6 CHARS OF PROGRAM NAME
SETZM FBHPTR ;NO LOCAL BLOCK HEADERS YET
.JDDT LNKNEW,T.1003,<<CAMN W2,$NAME##>>
AOS PRGNO ;COUNT THIS PROGRAM IN TOTAL
;HERE TO SEE IF WE NEED TO COMPARE THE PROGRAM NAME AGAINST INC/EXC
;BLOCKS, AND IF SO, ALLOCATE A BLOCK TO STORE THE NAME IN AS WE GO
;ALONG. FIRST WORD OF BLOCK IS LENGTH, WORDS FOLLOWING ARE SIXBIT.
SETZM TTLADR ;ASSUME NO INC/EXC'S GIVEN
SKIPN INCPTR ;ARE THERE? (USUALLY NOT)
SKIPE EXCPTR ;MAYBE NEITHER, WHAT ABOUT IT?
CAIA ;ONE OR THE OTHER
JRST T1003R ;NEITHER, NO NEED TO WATCH TITLE
MOVEI T2,LN.SWV+1 ;GET STORAGE FOR PROGRAM NAME
PUSHJ P,DY.GET## ;ONLY NEED LN.SWV, SINCE LONGER CAN'T
HRLI T1,-<LN.SWV-1> ; BE INCLUDED OR EXCLUDED ANYWAY
ADDI T1,1 ;BYPASS LENGTH (1ST WORD)
MOVEM T1,TTLADR ;AOBJN POINTER TO STORED TITLE
MOVEM W2,(T1) ;STORE 1ST 6 CHARS OF NAME
T1003R: TXON W1,PT.EXT ;MORE TRIPLETS COMING?
JRST T1003F ;NO, GO FINISH SHORT TRIPLET
T1003A: PUSHJ P,LS.ADD## ;STORE THE PRIMARY TRIPLET
MOVSI P1,-STLEN ;SETUP TO PROCESS SECONDARY TRIPLETS
SETZ P2, ;NO SECONDARY TRIPLETS SEEN YET
SETO P3, ;AND NONE HAVE PASSED US BY
;HERE TO LOOP OVER THE INCOMING TRIPLETS, PROCESSING AS NEEDED
T1003L: PUSHJ P,D.TRIP ;READ IN THE NEXT TRIPLET
PUSHJ P,T1003E ;SOMETHING'S WRONG
TRNE W1,-1 ;ANY ILLEGAL BITS SET?
PUSHJ P,T1003E ;YES, ILLEGAL BLOCK TYPE
T1003B: MOVE T1,W1 ;GET FLAGS FOR DESTRUCTIVE TESTING
TDC T1,STBITS(P1) ;THESE BITS SHOULD BE OFF
TXZ T1,S.LST ;BUT DON'T CARE ABOUT THIS ONE
TLNN T1,-1 ;IS THIS THE RIGHT TRIPLET?
JRST T1003C ;YES, GO PROCESS IT
AOBJN P1,T1003B ;NO, SEE IF IT'S THE NEXT TYPE
PUSHJ P,T1003E ;UNRECOGNIZED TRIPLET
;HERE TO PROCESS A RECOGNIZED TRIPLET
T1003C: JFFO P3,.+1 ;COUNT TRIPLETS WE KNOW WE'VE PASSED
CAIL P4,(P1) ;SAME OR BETTER AS THOSE REALLY PASSED?
JRST T1003D ;YES, WE'RE OK
LSH P3,-1 ;NO, FLAG WE'VE SEEN AT LEAST ONE MORE
TXNN P2,S.MSF ;NO ACTION NEEDED IN MSF BLOCKS
PUSHJ P,@STAFT(P4) ;TAKE THE ACTION NEEDED WHEN PASSING ONE
JRST T1003C ;AND GO SEE IF WE'VE MISSED ANY MORE
T1003D: TXNN P2,S.MSF ;IN MSF PROCESSING?
JRST T1003W ;NO, PROCEED
MOVX T1,S.MSF ;YES, GET OK IN MSF BIT
TDNN T1,STBITS(P1) ;SET FOR THIS TRIPLET?
PUSHJ P,T1003E ;NO, ERROR
JRST T1003Z ;YES, SKIP STBFR AND PROCEED
T1003W: PUSHJ P,@STBFR(P1) ;TAKE ANY ACTION NEEDED FOR THIS TRIPLET
T1003Z: IOR P2,W1 ;ADD THESE FLAGS TO OUR COLLECTION
TXNE W1,S.LST ;IS THIS THE LAST TRIPLET?
JRST T1003F ;YES, GO FINISH UP
PUSHJ P,LS.ADD## ;NO, ADD THIS ONE TO THE SYMBOL TABLE
T1003I: MOVX T1,S.MUL ;GET 'MULTIPLE OF THIS TYPE OK' BIT
TXZN P2,S.LST ;FORCED LAST AT LOWER LEVEL? (STRNAM)
TDNN T1,STBITS(P1) ;MORE THAN ONE OF THIS TRIPLET LEGAL?
CAIA ;NO, GET NEXT OR ERROR IF LAST
JRST T1003L ;YES, LOOK FOR ANOTHER
AOBJN P1,T1003L ;WILL FALL THRU TO ERROR IF NONE LEFT
;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
;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 AT END OF SECONDARY TRIPLETS OR IF ONLY PRIMARY PRESENT
T1003F: TXNN P2,S.MSF ;MSF TRIPLET?
TXZ W1,S.LST ;NO, MORE TRIPLETS WILL FOLLOW
PUSHJ P,LS.ADD## ;OUTPUT THE LAST SECONDARY TRIPLET
TXNE P2,S.MSF ;CHECK FOR MSF AGAIN
JRST T1003T ;IF SO, JUST TEST FOR LAST & QUIT
T1003X: JFFO P3,.+1 ;MUST CHECK THESE BITS AGAIN
CAIL P4,STLEN ;DO WE KNOW WE'RE DONE?
JRST T1003Q ;YES, GO DUMP S.SEG BLOCK & EXIT
LSH P3,-1 ;WE'RE GETTING THERE
PUSHJ P,@STAFT(P4) ;FILL IN DEFAULTS ETC.
JRST T1003X ;MUST CHECK FOR BEING SURE WE'RE DONE
T1003Q: PUSHJ P,TTLRLC## ;DUMP RELOCATION COUNTER INFO
T1003T: PUSHJ P,D.GET1 ;MAKE SURE S.LST DIDN'T LIE
JRST LOAD## ;ALL OK, ******* EXIT FROM T.1003 ******
PUSHJ P,T1003E ;SOMETHING'S WRONG
;HERE WHEN THE 1ST TRIPLET OF A MSF BLOCK IS SEEN
T1003M: MOVE T1,W1 ;GET FLAGS FOR DESTRUCTIVE TESTING
TXC T1,PT.SGN!PT.TTL!PT.MSF!PT.EXT ;FLAGS THAT MUST BE ON
JUMPN T1,T1003E ;SOMETHING'S WRONG
HRRZ T1,NAMPTR ;GET ADDR OF LAST TITLE BLOCK
ADDI T1,2 ;POINT TO 3RD WORD (POINTER TO NEXT)
SUB T1,LW.LS ;CONVERT TO OFFSET FROM LS.LB
JUMPL T1,T1003P ;GO DO PAGING IF NOT IN CORE
ADD T1,LS.LB ;CONVERT TO PHYSICAL ADDRESS
MOVE T2,LSYM ;SETUP POINTER TO THIS TRIPLET
HRROM T2,(T1) ;STORE IN LAST BLOCK
T1003O: HRRM T2,NAMPTR ;UPDATE NAMPTR
PUSHJ P,LS.ADD## ;ADD PRIMARY TRIPLET TO THE LS AREA
MOVSI P1,-STLEN ;NOW SETUP TO PROCESS AS NORMAL
MOVX P2,S.MSF ;EXCEPT FLAG MSF BLOCK IN PROGRESS
SETO P3, ;NO TRIPLETS HAVE YET PASSED US BY
JRST T1003L ;AND JOIN MAIN LOOP
;HERE IF 3RD WORD OF PREVIOUS TITLE IS PAGED OUT. GENERATE A FIXUP
;INSTEAD OF READING IT BACK IN. PAGING ROUTINES WILL DO IT FOR US.
T1003P: HRRZ T2,NAMPTR ;ADDRESS OF TRIPLET TO BE FIXED UP
HRLI T2,SPF.TL ;TYPE OF FIXUP
PUSH P,W3 ;VALUE GOES IN W3, BUT WE STILL NEED IT
HRRO W3,LSYM ;ADDR OF NEXT, LH MEANS THIS IS MSF
MOVEI R,FS.SS-FX.S0 ;FIXUP IS TO LS AREA
PUSHJ P,SY.CHP## ;GENERATE THE FIXUP
POP P,W3 ;RESTORE VALUE FROM NEXT 3RPLET
MOVE T2,LSYM ;POINTER TO NEW TITLE BLOCK
JRST T1003O ;RE-JOIN MAIN ROUTINE
;MACRO TO DESCRIBE THE PROPERTIES OF THE 2NDARY TITLE TRIPLETS.
;
;CALL: X (<NAME OF S.??? BIT>,<NON-BLANK IF EXTRA FLAGS>,
<TRIPLET SEEN ROUTINE>,<TRIPLET PASSED ROUTINE>)
XALL
DEFINE SECTTL,<
X (,S.MUL!S.MSF,STRNAM,NAMRED);; ADDITIONAL TITLE (SIXBIT)
X (CMT,S.MUL,,MAPREL);; ASCII COMMENT (REST OF TITLE)
X (PRC,S.MUL,STRPRC,);; PROCESSOR (COMPILER) INFO
X (CRE,,,FAKCRE);; COMPILATION TIME & COMP VERSION
X (DEV,S.MSF,,);; SOURCE DEVICE & UFD
X (NAM,S.MSF,,);; SOURCE NAME & EXTENSION
X (SFD,S.MUL!S.MSF,,);; SOURCE SFD'S
X (VER,S.MSF,,);; SOURCE FILE VERSION & CREATION
>
DEFINE X(FLGBIT,XFLAG,SEEN,PASSED),<
IFB <FLGBIT>,<IFB <XFLAG>,<
EXP S.TTL ;FLGBIT
>
IFNB <XFLAG>,<
EXP S.TTL!'XFLAG ;FLGBIT
>>
IFNB <FLGBIT>,<IFB <XFLAG>,<
EXP S.TTL!S.'FLGBIT ;FLGBIT
>
IFNB <XFLAG>,<
EXP S.TTL!S.'FLGBIT!'XFLAG ;FLGBIT
>>>
;SECONDARY TRIPLET FLAG BITS IN THE ORDER EXPECTED IN THE .REL FILE
STBITS: SECTTL
STLEN==.-STBITS
DEFINE X(FLGBIT,XFLAG,SEEN,PASSED),<
IFB <SEEN>,<
EXP CPOPJ ;FLGBIT
>
IFNB <SEEN>,<
EXP SEEN ;FLGBIT
>>
;ROUTINES TO EXECUTE WHEN WE SEE A PARTICULAR TRIPLET
STBFR: SECTTL
DEFINE X(FLGBIT,XFLAG,SEEN,PASSED),<
IFB <PASSED>,<
EXP CPOPJ ;FLGBIT
>
IFNB <PASSED>,<
EXP PASSED ;FLGBIT
>>
;ROUTINES TO EXECUTE AFTER WE KNOW WE'VE PASSED A TRIPLET
STAFT: SECTTL
SALL
;HERE WHEN A NAME TRIPLET IS SEEN. STORE NAME FOR INCLUDE/EXCLUDE.
STRNAM: SKIPN T1,TTLADR ;STILL IN BUSINESS?
POPJ P, ;NO, NOTHING TO STORE
AOBJP T1,UNSTOR ;ANY ROOM LEFT?
MOVEM W2,(T1) ;YES, STORE FIRST WORD
JUMPE W3,[IORX P2,S.LST ;IS THIS THE LAST ONE?
JRST .+3] ;YES, FORCE LAST & RETURN FOR NEXT
AOBJP T1,UNSTOR ;NO, ANY ROOM?
MOVEM W3,(T1) ;YES, STORE HIM TOO
MOVEM T1,TTLADR ;RESET AOBJN PTR
POPJ P,
;HERE TO FREE THE INC/EXC BLOCK AND FLAG NOT TO CHECK INC/EXC.
UNSTOR: HLRO T2,TTLADR ;FIND LENGTH USED SO FAR
ADDI T2,LN.SWV ;SO WE CAN FIND 1ST WORD IN BLOCK
HRRZ T1,TTLADR ;POINT TO CURRENT WORD
SUBI T1,0(T2) ;BACK UP TO FIRST ONE
MOVEI T2,LN.SWV+1 ;WHOLE BLOCK IS THIS LONG
SETZM TTLADR ;FLAG WE'RE NO LONGER LOOKING
PUSHJ P,DY.RET## ;FREE THE BLOCK
TRNN FL,R.LIB!R.INC ;GOING TO LOAD THIS?
POPJ P, ;YES, KEEP GOING
; PJRST UNLOAD ;NO, STOP IT NOW
;HERE WHEN WE HAVE DECIDED NOT TO LOAD AFTER ALL. ABORT EVERYTHING.
UNLOAD: SOS PRGNO ;UNDO OUR PREVIOUS WORK
MOVE T1,NAMPTR ;POINTS TO WHERE LSYM USED TO BE
SUB T1,LSYM ;DON'T NEED TO WORRY ABOUT PAGING
ADDM T1,LSYM ;SINCE ALL TRIPLETS WILL STILL BE IN
ADDM T1,LS.FR ;SINCE (3/2)*LN.SWV .LT. .IPS
IFL <.IPS>-<<3*LN.SWV>/2>,<PRINTX ?HORRIBLE ERROR> ;SEE?
ADDB T1,LS.PT ;IF MSG APPEARS, LN.SWV IS TOO BIG!!
HRL T1,T1 ;NOW ZERO ALL THE UNUSED DATA
ADDI T1,1 ;THAT USED TO CONTAIN OUR TRIPLETS
SETZM -1(T1) ;ZAP FIRST WORD
BLT T1,@LS.AB ;AND THE REST
TRZ FL,R.LOD ;NO LONGER LOADING
TRO FL,R.LIB ;MAKE SURE REST OF MODULE IS IGNORED
HRROI W1,400000(WC) ;PUT WORD COUNT WHERE T.1000 CAN GET IT
MOVN W1,W1 ;MAKE POSITIVE
POP P,0(P) ;RE-ADJUST STACK
JRST T.1000 ;IGNORE REST OF THIS BLOCK
;HERE WHEN THE PROGRAM NAME HAS BEEN READ IN COMPLETELY
NAMRED: SKIPN TTLADR ;LOADING A SUPER-LONG TITLE?
JRST E01LMN ;[1174] YES, BROADCAST ITS NAME AND RETURN
PUSH P,W2 ;SAVE OVER CALLS TO LNKOLD
HLRO T1,TTLADR ;GET WORDS LEFT IN AOBJN PTR
ADDI T1,LN.SWV ;CONVERT TO WORDS USED
HRRZ W2,TTLADR ;RH(W2) IS PTR TO START OF NAME
SUBI W2,(T1) ;RESET W2 FROM AOBJN'S
MOVEM T1,0(W2) ;BLOCK IS CNT, THEN <SIXBIT LIST>
CAIN T1,1 ;UNLESS THIS IS A SHORT TITLE
MOVE W2,1(W2) ;IN WHICH CASE WE WANT THE TITLE ITSELF
TRNE FL,R.LIB!R.INC ;NEED AN EXCUSE TO LOAD THIS MODULE?
JRST NAMINC ;YES, SEE IF WE HAVE ONE
PUSHJ P,EXCCHK## ;CONVERSELY, MAKE SURE NOT FORBIDDEN
JRST NAMPOP ;IT IS, ABORT LOADING NOW
LOADIT: TRZ FL,R.LIB!R.INC ;LOADING FOR SURE
POP P,W2 ;RESTORE SYMBOL FROM NEXT TRIPLET
E01LMN::.ERR. (MS,.EC,V%L,L%I5,S%I,LMN) ;[1174] TELL WHAT WE'RE LOADING
.ETC. (LSP,.EC!.EP,,,,NAMPTR) ;[1303]
.ETC. (STR,.EC,,,,,< from file >) ;[1303]
.ETC. (FSP,,,,,DC) ;[1303]
POPJ P,
;HERE WHEN WE NEED AN EXCUSE TO LOAD THIS MODULE
NAMINC: PUSHJ P,INCCHK## ;IN /INCLUDES?
CAIA ;NO, ABORT
JRST LOADIT ;YES, PROCEED
NAMPOP: POP P,W2 ;RESTORE W2 (FIX STACK)
TRO FL,R.LIB ;FLAG TO NOT LOAD
JRST UNSTOR ;AND ABORT LOADING
;HERE WHEN TIME TO OUTPUT THE REL FILE INFO.
MAPREL: SPUSH <W1,W2,W3> ;SECREL USES THESE AC'S
PUSHJ P,TTLREL## ;OUTPUT THE REL FILE INFO
SPOP <W3,W2,W1> ;RESTORE CURRENT TRIPLET
POPJ P, ;DONE
;HERE ON THE PROCESSOR NAME TRIPLET(S).
;STORE THE CPU BITS, & CALL COMPILER SPECIFIC ROUTINES.
STRPRC: TXNE P2,S.PRC ;IS THIS THE FIRST SUCH TRIPLET?
POPJ P, ;NO, JUST STORE EXTENDED C. NAME
REPEAT 0,<
MOVEM W3,CTYPE ;YES, STORE XWD C.TYPE,CPU BITS
HLRZ T1,W3 ;RETRIEVE COMPILER TYPE INDEX
CAILE T1,CT.LEN ;EVER HEARD OF IT?
JRST [SETZ T1, ;NO, MAKE IT UNKNOWN
HRRZS W1,CTYPE ; ..
JRST .+1] ;CONTINUE
HRRZ T2,W3 ;GET CPU TYPE INDEX
CAILE T2,CP.LEN ;KNOWN TYPE?
JRST [SETZ T2, ;NO, MAKE UNKNOWN
HLLZS W3,CTYPE ; ..
JRST .+1] ;CONTINUE
MOVE T3,PROCSN ;GET BIT MAP OF COMPILERS SEEN SO FAR
MOVE T4,CPUSN ;AND CPUS SEEN (NEITHER COUNTS THIS ONE)
> ;[1440]
LDB T1,[POINT 6,W3,5] ;[1440] GET RUNNABLE CPU BITS
ANDI T1,CP.MSK ;[1440] CLEAR CPUS WE DON'T KNOW ABOUT
JUMPN T1,.+2 ;[1440] ASKED FOR NONE?
MOVEI T1,CP.MSK ;[1440] YES--MEANS ALL
HRRZM T1,CTYPE ;[1440] SAVE WITH COMPILER TYPE
MOVE T2,CPUTGT ;[1440] GET TARGET CPUS
JUMPE T2,NOTGT ;[1440] THE CPU SWITCHES ARE NOT BEING USED
TDON T1,T2 ;[1440] TEST FOR A GOOD TARGET SWITCH
JRST E$$CPU## ;[1440] .DIRECTIVE IS FOR WRONG CPU
NOTGT: SKIPN OKCPUS ;[1440] CAN ANY CPU RUN THIS CODE?
JRST CPUEND ;[1440] NO--FORGET THIS TEST
ANDM T1,OKCPUS ;[1440] ENFORCE CPU FLAGS
SKIPN OKCPUS ;[1440] CAN PROG RUN AT ALL NOW?
PUSHJ P,E$$CCD## ;[1440] NO--CPU CONFLICT DETECTED
CPUEND: LDB T1,[POINT 12,W3,17] ;[1440] NOW GET PROCESSOR TYPE
HRRZS (P) ;[1440] LEAVE JUST BLANK COMMON ON STACK
CAILE T1,CT.LEN ;CHECK FOR RANGE
SETZ T1, ;[1440] MAKE IT UNKNOWN
HRLM T1,CTYPE ;[1440] SAVE COMPILER TYPE
MOVE T2,PROCSN ;[1440] GET LIST OF PROCS SEEN SO FAR
MOVE P1,T1 ;SAFE PLACE
PUSH P,[0] ;ALGNAM WANTS -1(P) SET UP
XCT CT.NAM##(T1) ;CALL C. SPECIFIC ROUTINE OR JFCL
POP P,0(P) ;CLEAR 0 PUSHED ABOVE
HLRZ T1,W3 ;RETRIEVE COMPILER INDEX
MOVE T1,CT.BIT##(T1) ;GET BIT CORRESPONDING TO THIS ONE
IORM T1,PROCSN ;INCLUDE IN MASK OF ALL SEEN SO FAR
IORM T1,LIBPRC ;ALSO IN SPECIAL MASK FOR LIB SEARCHING
REPEAT 0,< MOVE T1,CP.BIT##(W3) ;GET BIT CORRESPONDING TO CPU TYPE
IORM T1,CPUSN ;UPDATE MASK OF ALL SEEN SO FAR
> ;[1440]
POPJ P,
;HERE WHEN CRE HAS BEEN PASSED. FAKE IT FROM THE REL FILE IF NOT THERE
FAKCRE: TXNE P2,S.CRE ;DID WE SEE A REAL S.CRE TRIPLET?
POPJ P, ;YES, NO NEED TO FAKE IT
LDB T2,[POINT 12,FCRE,35] ;LOW 12 BITS OF DATE
LDB T1,[POINT 3,FEXT,20] ;HIGH 3 BITS
DPB T1,[POINT 3, T2,23] ;MERGE DATE INTO T2
LDB T1,[POINT 11,FCRE,23] ;GET TIME (MINS) IN T1
IMULI T1,^D60*^D1000 ;SCAN WANTS TIME IN MILLISECONDS
PUSHJ P,.CNVDT## ;CONVERT TO UNIVERSAL FORMAT
SPUSH <W1,W2,W3> ;SAVE NEXT TRIPLET SO WE CAN FAKE ONE
MOVX W1,S.TTL!S.CRE ;FLAGS FOR CREATION TIME INFO TRIPLET
MOVE W2,T1 ;CREATION TIME (UNIVERSAL FORMAT)
SETZ W3, ;COMPILER VERSION IS UNKNOWN
PUSHJ P,LS.ADD## ;STORE WHERE MAP CAN FIND IT
SPOP <W3,W2,W1> ;RESTORE NEXT TRIPLET
POPJ P,
> ;END IFN .NWBLK ON PAGE 13
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: HRRZS WC,W1 ;FAKE UP OLD TYPE RELOC WORD
JUMPE W1,LOAD## ;IGNORE 0 ENTRIES
PUSH P,W1 ;SAVE NO. OF WORDS LEFT
PUSHJ P,RB.2## ;READ AND RELOCATE FIRST TWO WORDS
JRST LOAD ;FAILED, TRY NEXT BLOCK
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
TLZ W1,77 ;[1470] NO BOGUS INDEX REGISTERS
POP P,W2 ;RESTORE BYTE COUNT
SOS (P) ;ONE LESS DATA WORD
T1004A: POP P,R3 ;SAFE PLACE FOR WORD COUNT
SUBI R3,3 ;NO. OF DATA WORDS LEFT
LDB T3,[POINT 6,W1,11] ;GET BYTE SIZE
MOVEI T1,^D36
IDIVI T1,(T3) ;GET NO. OF BYTES PER WORD
MOVE P3,T1 ;PUT NO. OF BYTE PER WORD IN SAFE PLACE
LDB T1,[POINT 6,W1,5]
;[1445]
IDIVI T1,(T3) ;SEE HOW MANY BYTES LEFT IN FIRST WORD
JUMPE T1,[TLZ W1,770000 ;WANTS TO POINT TO NEXT WORD
TLO W1,440000 ;SO CHANGE BYTE POINTER
AOJA W1,T1004B] ;AND ADDRESS
CAIN T1,(P3) ;IS IT A FULL WORD?
SETZ T1, ;YES, THEN NO EXTRA BYTES NEEDED
T1004B: ADD T1,W2 ;TOTAL NO. OF BYTES
IDIVI T1,(P3) ;GET NO. OF WORDS
SKIPE T2
ADDI T1,1 ;PLUS 1 FOR LAST PARTIAL WORD
PUSH P,P3 ;[1470] SAVE BYTES PER WORD
PUSH P,W2 ;SAVE BYTE COUNT
PUSH P,W1 ;SAVE BYTE POINTER
HRRZS P3,W1 ;START ADDRESS OF ARRAY
HLL P3,LSTRRV ;[1742] Insert section number
ADDI W1,(T1) ;END ADDRESS OF ARRAY
HLL W1,LSTRRV ;[1742] Insert section number
SETZ W3, ;SIGNAL JUST RETURN FROM T.1 CODE
PUSHJ P,T.1AD## ;SET UP FOR DATA STORE
JRST T1004Z ;[1776] THROW IT AWAY
JRST T1004Z ;[1776] THROW IT AWAY
HRRM P3,(P) ;FIXUP READ BYTE POINTER ON STACK
SKIPG DCBUF+2 ;IF REL BLOCK EMPTY?
T1004C: PUSHJ P,D.CNT## ;[1467] YES, GET A NEW BLOCK
POP P,P1 ;GET DESTINATION BYTE POINTER
POP P,T4 ;GET DESTINATION COUNT
POP P,P3 ;[1470] GET BYTES PER WORD
CAMG R3,DCBUF+2 ;ARE THERE ENOUGH WORDS IN REL BUFFER?
JRST T1004D ;YES
MOVE T1,R3 ;[1470] NO. OF WORDS IN REL FILE
SUB T1,DCBUF+2 ;[1470] LESS WHATS IN REL BUFFER
PUSH P,T1 ;[1470] NO. LEFT TO DO NEXT TIME
MOVE T1,DCBUF+2 ;NO. OF WORDS IN REL BUFFER
IMULI T1,(P3) ;NO. OF BYTES IN REL BUFFER
EXCH T1,T4 ;T4 = NO. OF BYTES WE CAN DO THIS TIME
SUBI T1,(T4) ;DIFFERENCE
PUSH P,T1 ;STORE DIFFERENCE FOR NEXT TIME
SKIPA R3,DCBUF+2 ;NO. WE WILL DO THIS TIME
T1004D: PUSH P,[0] ;SIGNAL ALL DONE
MOVE T1,T4 ;SET BOTH COUNTS THE SAME
HRRZ T2,DCBUF+1 ;GET SOURCE BYTE ADDRESS
HLL T2,P1 ;CONVERT TO BYTE POINTER
TLZ T2,770000 ;CLEAR STORE BYTE START
ADD T2,[440000,,1] ;FORM BYTE POINTER WE REALLY WANT
ADDM R3,DCBUF+1 ;ADVANCE REL POINTER
MOVN T3,R3
ADDM T3,DCBUF+2 ;DECREMENT REL COUNT
SETZB T3,P2 ;JUST TO BE SAFE
IFN TOPS20,<
EXTEND T1,[MOVSLJ] ;MOVE THE STRING
JFCL
>
IFE TOPS20,<
ILDB T3,T2 ;GET A BYTE
IDPB T3,P1 ;STORE IT
SOJG T1,.-2 ;LOOP
>
POP P,T4 ;NO. OF BYTES LEFT TO MOVE
JUMPE T4,LOAD ;ALL DONE
POP P,R3 ;NO. OF WORDS LEFT IN REL BLOCK
PUSH P,P3 ;[1470] SAVE BYTES PER WORD
PUSH P,T4 ;SAVE COUNT
PUSH P,P1 ;SAVE DESTINATION POINTER
JRST T1004C ;GET NEXT REL BUFFER
;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) ! -----
; --------------------
; ...
DEFINE NEWBLK(RBSIZ,RBNUM,RELTYP)<
MOVE P1,[POINT RBSIZ,RB,-1] ;;HOW TO ACCESS RELOC BYTES
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## ;[1405] 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::
NEWBLK(2,^D9,RLADD) ;[1405]
T.1021::
NEWBLK(3,6,RLADD) ;[1405]
T.1022::
NEWBLK(6,3,RLADD) ;[1405]
T.1023::
NEWBLK(9,2,RLADD) ;[1405]
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?
JRST R.ERR## ;[1405] 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
HLRM T1,W1 ;[1405] 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
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
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
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,[POINT 2,@WRTDAT,35] ;[1704] ADD TEMPLATE BYTE POINTER TO ADDR
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 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
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##>>
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)
T1070U ;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## ;
;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
CAIN T1,4 ;CHAINED FIXUP?
JRST [MOVE T2,W3
MOVE W3,2(P1)
JRST SY.CHR##] ;YES, JUMP
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
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 INSRT## ;YES, JUMP
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
HRRZ P1,W3 ;[1002] 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
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
;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
XCT T1070S(T3) ;SET FLAGS FOR FX BLOCK
CAIE T2,6 ;SKIP IF SYMBOL FIXUP
JRST SY.RA## ;JUMP IF ADDITIVE FIXUP
TXO W1,FS.FXS ;FLAG SYMBOL FIXUP
PUSHJ P,SY.QS##
JRST T1070X
JRST SY.RA##
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
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
LNGNM: POP P,W2 ;1ST WORD OF NAME
EXCH W1,0(P) ;FLAGS INTO W1, AND 2ND WORD OF NAME ON STACK
TXO W1,PT.EXT!PS.EXO ;EXTENDED SYMBOL
PUSH P,T1 ;KEEP N ON STACK FOR A WHILE
SETZ T2, ;
LSHC T1,-1 ;HALF OF N
JUMPE T2,.+2 ;ANY REMAINDER?
ADDI T1,1 ;ONE MORE FOR ODD N
ADDI T1,1 ;ONE MORE FOR PRIMARY TRIPLET
IMULI T1,3 ;THAT MANY TRIPLETS NEEDED
MOVE T2,T1 ;NEEDED SPACE IN T2
PUSH P,T1 ;ACTUAL GS WORD COUNT
PUSHJ P,GS.GET## ;GET IT IN GLOBAL SYMBOL AREA
TMOVEM W1,0(T1) ;STORE PRIMARY TRIPLET
POP P,W2 ;POP OFF GS WORD COUNT
POP P,T2 ;POP OFF N
EXCH W2,0(P) ;2ND WORD OF NAME INTO W2,& GS WORD CNT BACK ON STACK
PUSH P,T1 ;SAVE PTR
ADDI T1,.L ;NEXT TRIPLET
JRST T1070N ;GO GET 3RD WORD
T1070M: ADDI T1,.L ;NEXT TRIPLET
PUSHJ P,D.GET1 ;NEXT WORD OF NAME
JRST LOAD## ;??
MOVE W2,W1
T1070N: PUSHJ P,D.GET1 ;NEXT WORD
SETZ W1, ;
MOVX W3,S.SYM!S.LNM ;SECONDARY FLAGS
SUBI T2,2 ;INCREMENT BY 2 EACH TIME
JUMPG T2,.+2 ;SKIP IF MORE
TXO W3,S.LST!S.LLN ;IT IS THE LAST WORD
EXCH W1,W3 ;GET INTO THE ORDER WE WANT
TMOVEM W1,0(T1) ;INTO THE TRIPLET
JUMPG T2,T1070M ;LOOP BACK IF MORE
POP P,T1 ;RESTORE POINTER
DMOVE W1,0(T1) ;GET PRIMARY TRIPLET ALSO IN ACS
SUB T1,NAMLOC ;CONVERT ADR TO GS OFFSET
MOVEM T1,W3 ;AND INTO THE VALUE AC
POP P,T2 ;RECOVER NUMBER OF WORDS IN GS AREA
SKIPN NOSYMS ;NO LOCAL SYMBOLS?
MOVEM T2,SYMLEN ;USED BY LS.ADD(ROUTINE TO ADD TO LS)
HRL W3,T2 ;GS WORD COUNT ALSO IN LH OF W3 FOR TRYSYM
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 LNKOLD,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) ;SET POLISH FIXUP BIT
ADDI W1,2 ;ACCOUNT FOR OVERHEAD WORDS
ADD W2,FX.LB ;FIX IN CORE
ADD W3,FX.LB ;...
MOVEM W1,(W2) ;STORE HEADER WORD PLUS SYMBOLS
SETZM 1(W2) ;CLEAR GLOBAL COUNT
ADDI W2,2 ;BYPASS
PUSH P,RC.CUR ;SAVE CURRENT
SETZ P4, ;STORE RELOC FOR THIS BLOCK HERE
;FALL THRU
;NOW READ IN 2 HALF WORDS AT A TIME FROM BUFFER
;CHECK TO SEE IF A HALF WORD IS ONE OF THE FOLLOWIN:
; 1. PSECT INDEX
; 2. OPERATOR CODE
; 3. STORE OPERATOR CODE
; 4. DATA OPERATOR CODE
;THE PRIMARY PURPOSE HERE IS TO DO THE RELOCATION CALCULATION FOR
;A RELOCATABLE DATA WHEN ONE IS ENCOUNTERED.
T1072R: GET.2H ;GET 2 HALF WORDS INTO T1 AND T2
MOVEM T1,SAVCOD ;INCASE ERROR
JMP.IN (T1, PL.IL, PL.IH, GOT.I1) ;JUMP IF PSECT INDEX
JMP.IN (T1, PL.OL, PL.OH, RHALF,1) ;JUMP IF OPERATOR
JMP.IN (T1, PL.SL, PL.SH, GOT.S1, 1) ;JUMP IF STORE OPERATOR
GOT.D1: TRNE T1,INVALID ;NONE OF THE ABOVE, VALID DATA CODE?
JRST T11IPO ;NO, ERROR
TRNE T1,RELOC ;RELOCATABLE DATA COMING UP?
JRST [PUSHJ P,GOT.R1 ;GOT A RELOC DATA CODE ON THE LEFT
JRST RHALF ;RETURN HERE TO PROCESS RIGHT HALF NEXT
HRR W1,T1 ;[1001] UPDATE TO ABS ADDR
JRST STOR1W] ;NEXT WORD
LSH T1,-9 ;NO, ABSOLUTE. RIGHT-JUSTIFY DATA LEN
MOVEM W1,(W2) ;STORE CURRENT WORD
AOJ W2, ;ADVANCE POINTER
JUMPE T1,T1072R ;ONLY HALF WORD DATA.
MOVE T3,T1 ;USE T3
GOT.D2: GET.2H ;GET NEXT WORD
SOJLE T3,RHALF ;[1001] DECREMENT LENGTH AND JUMP IF FINISHED
GOT.D3: MOVEM W1,(W2) ;NOT FINISHED, STORE
AOJ W2,
SOJLE T3,T1072R ;[1001] DECREMENT LENGTH AND JUMP IF FINISHED
JRST GOT.D2 ;NOT FINISHED, LOOP
RHALF: MOVEM T2,SAVCOD ;INCASE OF ERROR
JMP.IN (T2, PL.IL, PL.IH, GOT.I2) ;JUMP IF PSECT INDEX
JMP.IN (T2, PL.OL, PL.OH, STOR1W, 1) ;[1001] JUMP IF OPERATOR TO RIGHT HALF
JMP.IN (T2, PL.SL, PL.SH, GOT.S2, 1) ;JUMP IF STORE OPERATOR
TRNE T2,INVALID ;NONE OF THE ABOVE, VALID DATA CODE?
JRST T11IPO ;NO, ERROR
MOVEM W1,0(W2) ;STORE
AOJ W2, ;ADVANCE POINTER
TRNE T2,RELOC ;RELOCATABLE DATA COMING UP?
JRST [PUSHJ P,GOT.R2 ;GOT RELOC DATA CODE ON THE RIGHT
JRST RHALF ;CONTINUE WITH RIGHT HALF
JRST STOR1W]
LSH T2,-9 ;NO, RIGHT JUSTIFY DATA LENGTH
JUMPE T2,[JMP.2H RHALF] ;NEXT 2 HALF WORDS AND JUMP
MOVE T3,T2 ;USE T3
GET.2H ;[1001] GET 2 HALF WORDS
SOJLE T3,STOR1W ;[1001] JUMPE IF FULL WORD
JRST GOT.D2 ;
STOR1W: MOVEM W1,(W2)
AOJA W2,T1072R
;HERE TO RELOC STARTING AT RIGHT HALF
GOT.R1: LSH T1,-9 ;YES, RELOC DATA
JUMPE T1,[PUSH P,W1 ;MUST RELOC ONE HALF WORD
MOVE T1,T2 ;GET VALUE IN T1
PUSHJ P,R.CUR ;GO RELOCATE IT WITH CURRENT PSECT
HLL W1,0(P) ;RESTORE LEFT HALF AS IS
POP P,0(P) ;ADJUST STACK
AOS 0(P) ;SKIP-RETURN
POPJ P,] ;FOR NEXT WORD
PUSH P,W1 ;SAVE CURRENT WORD, NEED W1 FOR RELOC CALC.
PUSH P,T2 ;SAVE RIGHT HALF FOR A WHILE
GET.2H ;GET ANOTHER 2 HALF WORDS
HRL T1,0(P) ;GET 1ST HALF INTO LEFT HALF
POP P,(P) ;FIX STACK
PUSHJ P,R.CUR ;RELOCATE
MOVE T1,W1
POP P,W1 ;RESTORE LAST WORD
HLR W1,T1 ;RELOCATED VALUE IN RIGHT HALF
MOVEM W1,(W2) ;STORE IT
AOJ W2, ;ADVANCE POINTER
HRLZ W1,T1 ;2ND HALF WORD IN LEFT HALF
HRR W1,T2 ;RESTORE RIGHT HALF ALSO
POPJ P, ;NON-SKIP RETURN, GO PROCESS RIGHT HALF
;HERE TO RELOCATE STARTING A WORD BOUNDARY
GOT.R2: LSH T2,-9
JUMPE T2,[GET.2H
PUSH P,T2 ;[1001] R.CUR USES T2
PUSHJ P,R.CUR
POP P,T2 ;[1001]
HRL W1,T1 ;ADDRESS RETURNED IN T1
POPJ P,]
GET.2H
MOVE T1,W1
PUSHJ P,R.CUR
MOVEM T1,(W2)
AOJ W2,
AOS (P)
POPJ P,
;HERE WHEN WE GOT PSECT INDEX IN THE LEFT HALF
GOT.I1: PUSHJ P,GOT.ID
JRST RHALF
;HERE WHEN WE GOT SPECT INDEX IN THE RIGHT
GOT.I2: EXCH T1,T2
PUSH P,GOT.ID
EXCH T1,T2
JRST STOR1W
GOT.ID: HRRZI T1,-377777(T1)
CAILE T1,RC.NO
JRST E$$IPX##
MOVEM T1,RC.CUR
SKIPN P4
MOVE P4,AC
HRRO P4,P4
POPJ P,
;HERE ON STORE
GOT.S1: TRNE T1,S.ADR ;AN ADDRESS?
TRZN T1,S.REL ;NEED TO RELOCATE?
JRST GOTSOP ;NO,
HRL W1,T1 ;OFF WITH RELOCATION BIT
MOVEM P4,RC.CUR
PUSHJ P,GOT.R1
JRST GOTSOP
HRR W1,T1 ;ADDR IN T1
GOTSOP: MOVEM W1,(W2)
PUSHJ P,D.GET1
JRST T1072C
AOJA W2,.+3
GOT.S2: TRNE T2,S.ADR ;ADDRESS?
TRZN T2,S.REL ;NEED TO RELOCATE
JRST GOTSOP ;NO,
HRR W1,T2 ;OFF WITH RELOCA BIT
MOVEM W1,(W2)
AOJ W2,
MOVEM P4,RC.CUR
PUSHJ P,GOT.R2
JRST GOTSOP
HRL W1,T1 ;UPDATE LEFT WITH ADDR
JRST GOTSOP
;HERE TO FIND THE STORE OPERATOR AND CHECK TO SEE IF WE WANT IT.
;IF NOT (/ONLY OR NON-LOADED LOCAL), DELETE THE FIXUP NOW.
T1072C: POP P,RC.CUR ;RESET ORIGINAL PSECT
MOVE W1,T11BP ;[633] RESET BYTE POINTER
ADD W1,FX.LB ;[633] FIX IN CORE
JRST T.11C1 ;[633] BYPASS FIRST TIME
T.11C0: IBP W1 ;[633] BYPASS NEXT HALF WORD
T.11C1: ILDB T1,W1 ;[633] READ HALF WORD
MOVEM T1,SAVCOD ;INCASE OF ERROR
JMP.IN (T1,PL.SL,PL.SH,T.11SP, 1) ;JUMPE IF STORE OPERATOR
JMP.IN (T1,PL.IL,PL.IH,T.11C1) ;IGNORE PSECT INDEX
JMP.IN (T1,PL.OL,PL.OH,T.11C1, 1) ;IGNORE OPERATORS
TRNE T1,INVALID ;NONE OF THE ABOVE, VALID DATA CODE?
JRST T11IPO ;NO, ERROR
TRNE T1,SYMBOL ;SYMBOL?
JRST [LSH T1,-9 ;YES,
JUMPN T1,T.11C2 ;JUMP IF IN SIXBIT
AOJA W1,T.11C1] ;JUMP IF IN RADIX 50
LSH T1,-9 ;RIGHT JUSTIFY LENGTH
JUMPE T1,T.11C0 ;SKIP HALF WORD
T.11C2: IBP W1 ;INCREMENT POINTER TO SKIP OVER THE LONG DATA
SOJG T1,.-1
JRST T.11C0 ;LOOP
;HERE ON A STORE OPERATOR. SEE IF WE WANT IT.
;IF NOT, DELETE THE POLISH BLOCK AND RETURN.
;IF SO, CHECK STORE OP TO SEE IF DEFINING A SYMBOL
; AND CONVERT THE SYMBOL TO LSTSYM PTR (GLOBAL,,LOCAL) IF SO.
T.11SP: JMP.IN(T1,PL.SSL,PL.SSH,T1072S, 1) ;JUMP IF SYMBOL FIXUP
JMP.IN(T1,PL.SNL,PL.SNH,T11SPE, 1) ;JUMPE IF UNDEFINED STORE OP
LSH T1,-9 ;GET LENGTH
JUMPN T1,[ILDB T2,W1
ILDB W1,W1
HRL W1,T2
JRST .+2]
ILDB W1,W1 ;NO, LOAD UP ADDRESS
TRNE FL,R.LSO!R.HSO ;SELECTIVE LOADING?
PUSHJ P,CHKSEG## ;YES, SEE IF WE NEED IT
JRST T.11GC ;[633] YES WE DO
PUSHJ P,T.11RT ;NO, RETURN BLOCK
JRST LOAD## ;AND GIVE UP
;FALL THROUGH TO NEXT PAGE
;HERE IF STORE OP IS A VALID SYMBOL FIXUP
;IF STORE IS TO SYMBOL TABLE THERE ARE 2 SYMBOLS FOLLOWING
;1 ACTUAL SYMBOL TO BE FIXED UP
;2 BLOCK NAME IT IS IN
T1072S: MOVE T2,T1
TRZ T2,777770 ;CLEAR ALL BUT LAST DIGIT
MOVE T2,[0 ;750
0 ;751
0 ;752
0 ;753
FS.FXF ;754
FS.FXE ;755
FS.FXL ;756
FS.FXR](T2)
LSH T1,-9 ;GET DATA LENGTH
PUSH P,T1 ;SAVE DATA LENGTH FOR LATER
PUSH P,W1 ;SAVE POINTER TO START OF SYMBOL NAME
PUSH P,T2 ;SAVE FLAGS FOR SY.QS
ILDB T2,W1 ;YES, GET LEFT PART
ILDB W2,W1 ;GET RIGHT
HRL W2,T2 ;FULL SYMBOL
JUMPN T1,.+4 ;SKIPE IF NOT ZERO, ALREADY SIXBIT
PUSH P,T1
PUSHJ P,R50T6 ;IF 0, WE HAVE RADIX 50 SYMBOL
POP P,T1
MOVE T3,W1 ;FX POINTER IN T3 FOR GET.LS
POP P,W1 ;RESTORE FLAGS FOR GET.LS
SOJLE T1,.+2 ;IF 1, FULL WORDS SIXBIT
PUSHJ P,GET.LS ;IF .GT.1, LONG SYMBOL NAME IN SIXBIT
EXCH W2,W3 ;PUT SYMBOL IN W3
PUSHJ P,SY.QS## ;SEE IF WE WANT THIS SYMBOL
JRST [POP P,W1 ;RESTORE STACK
POP P,T1 ;[612] NO, NON LOADED LOCAL
PUSHJ P,T.11RT ;[612] SO CLEAN UP FX
JRST LOAD##] ;[612] AND RETURN
POP P,W1 ;RESTORE BYTE POINTER AT SYMBOL NAME START
POP P,T1 ;RESTORE SYMBOL NAME LENGTH
EXCH W2,W3 ;W2 NOW CONTAINS SYMBOL PTRS
HLRZ T2,W2 ;LEFT HALF
IDPB T2,W1
IDPB W2,W1 ;RIGHT HALF
SETZ T3,
SOJLE T1,.+3
IDPB T3,W1
JRST .-2
ILDB T1,W1 ;YES, GET LEFT PART
ILDB W2,W1 ;GET RIGHT
HRL W2,T1 ;FULL SYMBOL
JUMPE W2,T.11GC ;ALWAYS 0 IF MACRO-51
PUSHJ P,R50T6## ;CONVERT NOW
SUBI W1,1 ;BACKUP BYTE PTR
HLRZ T1,W2 ;LEFT HALF
IDPB T1,W1
IDPB W2,W1 ;RIGHT HALF
;FALL THROUGH TO NEXT PAGE
;HERE TO COUNT AND EVALUATE GLOBAL REQUESTS
T.11GC: MOVE W1,T11BP ;RESET BYTE POINTER
ADD W1,FX.LB ;FIX IN CORE
JRST T.11G1 ;BYPASS FIRST TIME
T.11G0: IBP W1 ;BYPASS NEXT HALF WORD
T.11G1: ILDB T1,W1 ;READ HALF WORD
MOVEM T1,SAVCOD
JMP.IN (T1,PL.OL,PL.OH,T.11G1,1) ;IGNORE OPERATORS
JMP.IN (T1,PL.IL,PL.IH,T.11G1) ;IGNORE PSECT INDEX
JMP.IN (T1,PL.SL,PL.SH,T.11GE,1) ;JUMPE IF STORE OPERATOR
TRNE T1,INVALID ;INVALID DATA CODE
JRST T11IPO ;ERROR
TRNE T1,SYMBOL ;SYMBOL REQUEST?
JRST T1072G ;YES, JUMP
LSH T1,-9 ;NO, ADDRESS FIXUP
JUMPE T1,T.11G0 ;HALF WORD ADDR.
AOJA W1,T.11G1 ;FULL WORD ADDR.
;HERE IF GLOBAL SYMBOL REQUEST
T1072G: ILDB T2,W1 ;GET FIRST PART OF SYMBOL
ILDB W2,W1 ;GET RIGHT HALF PART
HRL W2,T2 ;FULL SYMBOL IN W2
LSH T1,-9 ;GET DATA LENGTH
JUMPN T1,.+4 ;SKIP IF NOT ZERO, ALREADY SIXBIT
PUSH P,T1 ;
PUSHJ P,R50T6## ;IF 0, RADIX 50 SYMBOL--CONVERT TO SIXBIT IN W2
POP P,T1
.JDDT LNKNEW,T1072G,<< CAMN W2,$SYMBOL##>>
SETZ W3,
MOVE T3,W1 ;POINTER IN T3 FOR GET.LS
SUB W1,FX.LB ;INCASE FX AREA MOVES
PUSH P,W1 ;SAVE RELA FX PTR OF START OF SYMBOL
MOVX W1,PT.SGN!PT.SYM
SOJLE T1,.+3 ;SKIP OVER GET.LS
PUSHJ P,GET.LS ;IF .GT. 1, LONG SYMBOL IN SIXBIT
HRL W3,T2
SUB T3,FX.LB ;INCASE FX AREA MOVES
PUSH P,T3 ;SAVE RELA FX PTR OF END OF SYMBOL
PUSHJ P,TRYSYM## ;SEE IF DEFINED
JRST T.11ND ;NO, NEED TO DEFINE IT
JRST T.11UN ;UNDF, SO JUST AS BAD
POP P,0(P) ;FIX STACK, DON'T NEED PTR TO END OF SYMBOL
POP P,W1 ;RESTORE BYTE POINTER TO START OF SYMBOL
ADD W1,FX.LB ;ADD CORE OFFSET
SUBI W1,2 ;BACKUP BYTE POINTER
IBP W1 ;TO POINT TO 2
ILDB T1,W1 ;GET THE CODE AGAIN
MOVE T2,T1
LSH T2,-9 ;GET DATA LENGTH
JUMPN T2,.+2 ;SKIPE IF LENGTH NOT ZERO
MOVEI T1,001000 ;ZERO IS A SPECIAL CASE
TRZ T1,SYMBOL ;CHANGE SYMBOL MARKER TO 36BIT VALUE
DPB T1,W1 ;UPDATE, KEEP LENGTH INFO AS BEFORE
MOVS T1,2(P1) ;GET VALUE
IDPB T1,W1
MOVSS T1
IDPB T1,W1
SOJLE T2,T.11G1
SETZ T1,
JRST .-3
T.11GE: MOVE W3,T11BP
ADD W3,FX.LB
SKIPN -1(W3) ;[633] ANY UNDEFINED GLOBALS?
PUSHJ P,T.11EV ;[633] NO, EVALUATE FIXUP NOW
JRST LOAD## ;[633] ELSE WAIT TILL ALL DEFINED
T11SPE: .ERR. (MS,.EC,V%L,L%F,S%F,ISO,<Invalid store operator >)
.ETC. (OCT,.EP,,,,T1)
;HERE TO EXTRACT A LONG SYMBOL IN GS AREA FROM FX AREA AS PART
;OF THE BLOCK 1072.
;ENTER WITH:
;
; T1/ #OF HALF WORDS-2
; T3/ POINTER INTO FX AREA
;
;RETURN WITH W1,W2,W3 SETUP FOR TRYSYM.
GET.LS:PUSH P,T1 ;SAVE DATA LENGTH FOR A WHILE
PUSH P,T3 ;SAVE IT FOR A WHILE
ILDB T3,T3 ;A REAL LONG SYMBOL, NOT JUST PADDING?
JUMPN T3,GET.L2 ;JUMP IF YES
POP P,T3 ;NO, GOT A NULL
POP P,T1 ;RECOVER LENGTH
IBP T3 ;JUST SKIP OVER THE NULL PADDING
SOJG T1,.-1 ;FINISHED?
TXZ W1,PS.EXO ;MAKE SURE FLAG FOR LONG NAME IS OFF
POPJ P, ;AND RETURN
GET.L2: POP P,T3 ;GET BACK THE ORIGINAL POINTER INTO FX
LSH T1,-1 ;CONVERT #OF HALF WORDS TO # OF WORDS
SETZ T2,
LSHC T1,-1 ;2 WORDS TO EACH ADDITIONAL TRIPLET
JUMPE T2,.+2 ;ANY REMAINDER?
ADDI T1,1 ;YES, ONE ADDITIONAL TRIPLET
ADDI T1,1 ;ONE MORE FOR PRIMARY TRIPLET
IMULI T1,3 ;THAT MANY WORDS NEEDED
MOVE T2,T1 ;NEEDED SPACE IN T2
PUSH P,T2 ;SAVE ACTUAL GS WORD COUNT
PUSH P,T3 ;GS.GET USES T3
PUSHJ P,GS.GET## ;GO GET IN GS AREA
POP P,T3 ;RESTORE BYTE POINTER
TXO W1,PT.SGN!PT.SYM!PT.EXT!PS.EXO ;SET SOME VALID FLAGS
TMOVEM W1,(T1) ;PRIMARY TRIPLET
POP P,T2 ;POP OFF GS WORD COUNT
EXCH T2,0(P) ;ORIGINAL DATA LENGTH IN T2, CNT BACK ON STACK
PUSH P,T1 ;SAVE POINTER IN GS
GET.L1: ADDI T1,.L ;NEXT TRIPLET
ILDB W1,T3 ;NEXT HALF WORD FROM FX
SOJLE T2,[HRLZ W2,W1 ;IF FINISHED, JUMP OUT
SETZ W3,
JRST GET.L3]
ILDB W2,T3 ;NOT FINISHED, NEXT HALF WORD FROM FX
HRL W2,W1
SOJLE T2,[SETZ W3, ;IF FINISHED, JUMP OUT
JRST GET.L3]
ILDB W1,T3 ;NEXT HALF WORD FROM FX
SOJLE T2,[HRLZ W3,W1 ;IF FINISHED, RESTORE FIRST WORD
JRST GET.L3]
ILDB W3,T3 ;NOT FINISHED, NEXT HALF WORD FROM FX
HRL W3,W1 ;
SOJLE T2,GET.L3 ;FINISHED
MOVX W1,S.SYM!S.LNM ;SET FLAGS
TMOVEM W1,0(T1) ;ADDITIONAL TRIPLET
JUMPG T2,GET.L1 ;LOOP BACK IF NOT FINISHED
GET.L3: MOVX W1,S.SYM!S.LNM!S.LST!S.LLN ;SET FLAGS
TMOVEM W1,0(T1) ;THE LAST TRIPLET
POP P,T1 ;GET BEGINNING POINTER INTO GS
DMOVE W1,0(T1) ;UPDATE CURRENT W1,W2
SUB T1,NAMLOC ;RELATIVE GS POINTER IN T1
MOVEM T1,W3 ;AND UPDATE W3 WITH IT
POP P,T2 ;GS WORD COUNT IN T2
POPJ P, ;RETURN
;HERE IF GLOBAL SYMBOL NOT IN GLOBAL SYMBOL TABLE YET
;TREAT AS IF ADDITIVE GLOBAL REQUEST
;GET EXTENDED TRIPLET AND POINT TO FIXUP TRIPLET IN FIXUP AREA
;INTURN THIS TRIPLET POINTS TO THE POLISH FIXUP
;NOTE AT THIS POINT W1, W2, AND W3 ARE USED FOR NON-SYMBOL
;STUFF, THEY MUST BE SAVED
T.11ND: AOS USYM ;INCREMENT UNDEF COUNT
PUSH P,W2 ;SAVE ACCS
TXO W1,PS.REQ ;USUAL FLAGS
PUSH P,W1 ;SAVE PRIMARY FLAGS
PUSH P,[0] ;ZERO VALUE
MOVX W1,S.FXP ;[612] SECONDARY SYMBOL FLAG
PUSHJ P,GS.FX0## ;PUT IN GLOBAL TABLE
MOVX W1,FP.SGN!FP.SYM!FP.PTR!FP.POL ;
HRRZ W3,T11FA ;ADDRESS (RELATIVE TO FX.LB) OF POLISH
PUSHJ P,SY.FX0## ;NOW PUT INTO FIXUP TABLE
PUSHJ P,SY.GX0## ;LINK TO GLOBAL
T.11GD: POP P,W2
POP P,W1 ;RESTORE RELA FX PTR TO END OF SYMBOL
POP P,0(P) ;DON'T NEED PTR TO START OF SYMBOL
ADD W1,FX.LB ;RELOCATE AGAIN
MOVE W3,T11BP
ADD W3,FX.LB ;...
AOS -1(W3) ;BUMP COUNT OF UNDEFINED SYMBOLS
MOVE T1,SAVCOD
TRNE T1,LENGTH
JRST T.11G1 ;ALREADY IN SIXBIT
SUBI W1,2 ;NEED TO UPDATE STORE CODE ALSO
IBP W1 ;
ADDI T1,001000 ;UPDATE LENGTH TO 1
IDPB T1,W1 ; NEW CODE
MOVS T1,W2 ;PUT SYMBOL IN T1 SWAPPED
;OVERWRITING THE RADIX-50
IDPB T1,W1 ;STORE IT
MOVSS T1
IDPB T1,W1 ;W1 BACK AS IT WAS
JRST T.11G1 ;GET NEXT HALF WORD
;HERE TO SEE IF FIXUP REQUESTS EXIST FOR THIS SYMBOL
;IF SO ADD TO CHAIN, IF NOT CREATE CHAINED LIST IN EXTENDED SYMBOL
T.11UN: PUSH P,W2 ;SAVE ACCS
MOVE W1,0(P1) ;FLAGS GO IN W1 NOW
TXNE W1,PS.FXP ;ALREADY FIXUPS DEFERED?
JRST T.11DF ;YES, JUST LINK TO CHAIN
MOVEI T1,.L ;[612] NEED ANOTHER TRIPLET
PUSHJ P,SY.MOV## ;[612] SO STRETCH CURRENT ONE
MOVX W1,PS.FXP ;[612] WE NOW HAVE A FIXUP TRIPLET
IORM W1,0(P1) ;[612] SO MARK IT
SUB T1,GS.LB ;[612] GET REL. ADDR OF NEW TRIPLET
PUSH P,T1 ;[612] SAVE IT
MOVX W1,FP.SGN!FP.SYM!FP.PTR!FP.POL ;[612] PTR TO POLISH
HRRZ W3,T11FA ;[612] TO TRY AGAIN WHEN SYMS DEFINED
PUSHJ P,SY.FX0## ;[612] PUT W1-W3 IN FX AREA
POP P,T1 ;[612] RESTORE POINTER INTO GS
ADD T1,GS.LB ;[612] MAKE ABSOLUTE AGAIN
MOVX W1,S.FXP!S.LST ;POINTER TO FIXUP CHAIN
TMOVEM W1,0(T1) ;[612] STORE IN NEW TRIPLET
JRST T.11GD ;[612] RETURN TO SCAN REST OF POLISH
;HERE IF FIXUP REQUEST EXISTS ALREADY
;JUST LINK INTO FRONT OF CHAIN
T.11DF: ADDI P1,.L ;LOOK FOR ADDITIVE GLOBAL REQUEST
SKIPG W1,0(P1) ;GET SECONDARY FLAGS
JRST T11DFE ;PRIMARY OR NO FLAGS SET
TXNN W1,S.FXP ;IS THIS THE ONE
JRST T.11DF ;NO TRY AGAIN
SKIPN W1,2(P1) ;GET POINTER, BETTER BE NON-ZERO
JRST T11DFE
HRLI W1,(FP.SGN!FP.SYM!FP.PTR!FP.POL) ;
HRRZ W3,T11FA ;POINT TO POLISH
SUB P1,NAMLOC ;INCASE CORE MOVES
PUSH P,P1 ;SAVE UNRELOCATED POINTER
PUSHJ P,SY.FX0## ;PUT IN FIXUP AREA
POP P,P1 ;RESTORE POINTER
ADD P1,NAMLOC ;RELOCATE IT
HRRM W3,2(P1) ;FIXUP REQUEST POINTER CHAIN
JRST T.11GD ;GET NEXT HALF-WORD
T11DFE: .ERR. (MS,,V%L,L%F,S%F,ISP)
;HERE TO EVALUATE POLISH FIXUP
T.11EV:SKIPN W3,POLSTK ;GET STACK POINTER
PUSHJ P,T.11PD ;NOT SETUP YET
MOVEI T3,100 ;INCASE OF ON OPERATOR
MOVEM T3,SVSAT
PUSH W3,[MXPLOP##] ;FAKE OPERATOR
MOVE W2,T11BP ;SETUP READ BYTE POINTER
IFN DEBSW,<
MOVEI W1,-2(W2) ;[632] POINT TO 1ST WORD OF BLOCK
> ;END IFN DEBSW
.JDDT LNKOLD,T.11EV,<<CAMN W1,$FIXUP##>> ;[632]
ADD W2,FX.LB ;FIX IN CORE
T.11RP: ILDB W1,W2 ;READ A HALF-WORD
MOVEM W1,SAVCOD
JMP.IN (W1,PL.SL,PL.SH,T.11ST,1) ;JUMP IF STORE OPERATOR
JMP.IN (W1,PL.IL,PL.IH,T.11RP) ;IGORE PSECT INDEX
JMP.IN (W1,PL.OL,PL.OH,SAVOP,1) ;JUMP IF OPERATOR
TRNN W1,INVALID ;INVALID DATA CODE?
TRNE W1,SYMBOL ;SYMBOL REQUEST? SHOULD BE DONE BY NOW
JRST T11IPO ;YES, ERROR
JRST T.11OP ;GOT AN OPERAND
SAVOP: PUSH W3,W1 ;SAVE OPERATOR ON STACK
MOVE T3,DESTB-100(W1) ;GET NUMBER OF OPERANDS NEEDED
MOVEM T3,SVSAT ;ALSO SAVE IT
JRST T.11RP ;BACK FOR MORE
T.11PD: MOVEI T2,LN.PPD ;[603] SIZE REQUIRED
PUSHJ P,DY.GET## ;GET SPACE FOR STACK
MOVEM T1,POLSTK ;START OF STACK
MOVEI W3,-1(T1) ;FORM PUSHDOWN STACK IN W3
HRLI W3,-LN.PPD ;FORM STACK POINTER
MOVEM W3,POLSTK ;STORE FOR NEXT TIME
POPJ P,
T11IPO: MOVE W1,SAVCOD
T11RPE: JRST E$$IPO## ;INVALID POLISH OPERATOR
;HANDLE OPERANDS
T.11OP: MOVE T1,W1 ;GET THE OPERAND TYPE HERE
ILDB W1,W2 ;THIS IS AT LEAST PART OF THE OPERAND
MOVE T2,W1
LSH T1,-9 ;GET DATA LENGTH
JUMPE T1,T.11P0 ;0 IS HALF-WORD OPERAND
ILDB W1,W2 ;NEED FULL WORD GET 2ND HALF
HRL T2,W1 ;GET IN RIGHT ACC
MOVS T2,T2 ;WRONG ORDER
SOJLE T1,T.11P0
IBP W2
JRST .-2
T.11P0: SETZ T1, ;VALUE OPERAND
T.11P1: SOJL T3,T.11ES ;ENOUGH OPERANDS SEEN
PUSH W3,T2 ;SAVE VALUE
HRLI T1,400000 ;PUT IN A VALUE MARKER
PUSH W3,T1
JRST T.11RP ;GET MORE POLISH
;HERE WHEN WE HAVE ENOUGH OPERANDS FOR THE CURRENT OPERATOR
T.11ES: SKIPN SVSAT ;IS IT UNARY
JRST T.11UO ;YES, NO NEED FOR 2ND OPERAND
POP W3,T1 ;POP OFF MARKER
POP W3,T1 ;AND VALUE
T.11UO: POP W3,T3 ;OPERATOR
XCT OPTAB##-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 T.11P1 ;GO SEE WHAT WE SHOULD DO NOW
;HERE TO STORE THE FINAL VALUE
T.11ST: MOVE T2,-2(W3) ;THIS SHOULD BE THE FAKE OPERATOR
CAIE T2,MXPLOP ;IS IT
JRST T11STE ;NO
ILDB T2,W2 ;[572] GET CORE ADDR OR GS POINTER
MOVE W3,-1(W3) ;GET THE VALUE AFTER IGNORING THE FLAG
TRZ W1,777000 ;DON'T USE LENGTH IN INDEXING INTO THE TABLE
XCT STRTAB-PL.SSL(W1) ;CALL THE CORRECT FIXUP ROUTINE
;ALL DONE, NOW GIVE SPACE BACK
T.11RT: HRRZ T1,T11FA ;START OF FIXUP AREA
ADD T1,FX.LB ;IN REAL CORE
HLRZ T2,T11FA ;LENGTH OF AREA
PUSHJ P,FX.RET## ;RETURN FIXUP BLOCK
SETZM T11FA ;AND CLEAR MARKER
SETZM T11BP ;BYTE POINTER ALSO
POPJ P, ;RETURN TO GET NEXT BLOCK
;STORE OPERATOR ACTION TABLE
STRTAB: ;[735]
REPEAT 0,< T11LNK## > ;[735] -10 STORE LINK OR LINK END
REPEAT 0,<PUSHJ P,T11MVM##> ;[735] -7 MOVEM
JRST T11SPE ;750 NOT DEFINED
JRST T11SPE ;751 NOT DEFINED
JRST T11SPE ;752 NOT DEFINED
JRST T11SPE ;753 NOT DEFINED
PUSHJ P,T11SYF## ;754 FULL WORD SYMBOL FIXUP
PUSHJ P,T11SYF## ;755 30-BIT SYMBOL FIXUP
PUSHJ P,T11SYL## ;756 LEFT HALF SYMBOL FIXUP
PUSHJ P,T11SYR## ;757 RIGHT HALF SYMBOL FIXUP
JRST T11SPE ;760 NOT DEFINED
JRST T11SPE ;761 NOT DEFINED
JRST T11SPE ;762 NOT DEFINED
JRST T11SPE ;763 NOT DEFINED
PUSHJ P,SY.CHF## ;764 FULL WORDS SYMBOL FIXUP
PUSHJ P,SY.CHF## ;765 30-BIT SYMBOL FIXUP
PUSHJ P,SY.CHL## ;766 LEFT HALF SYMBOL FIXUP
PUSHJ P,SY.CHR## ;767 RIGHT HALF SYMBOL FIXUP
STRLEN== .-STRTAB-1 ;[735] LENGTH OF STORE OP TABLE
T11STE: .ERR. (MS,.EC,V%L,L%F,S%F,IPO)
.ETC. (OCT,.EP,,,,T2)
;HERE TO DISPATCH FOR SYMBOL TABLE FIXUPS
;T2 = ADDRESS OF SYMBOL IN GLOBAL TABLE
;W3 = VALUE
;USES
;W1 = FIXUP FLAGS
;HERE TO STORE SYMBOL TABLE FIXUP
SY.ASP: ILDB T1,W2 ;[572] PICK UP LOCAL POINTER
HRL T1,T2 ;[572] FORM STANDARD GLOBAL,,LOCAL
PUSH P,T1 ;[572] SAVE OVER GS.GET
MOVEI T2,.L ;[572] SET UP FAKE DEFINING TRIPLET
PUSHJ P,GS.GET## ;[572] IN GS AREA SO CAN USE SY.STF
MOVE P1,T1 ;[572] P1=ADDR OF FAKE DEFINING TRIPLET
MOVX T1,PT.SGN!PT.SYM!PS.GLB ;[572] SOME GOOD FLAGS
MOVEM T1,0(P1) ;[572] SET IN TRIPLET
;[572] LEAVE NAME BLANK TO CATCH ERRORS
MOVEM W3,2(P1) ;[572] STORE POLISH RESULT AS VALUE
POP P,W3 ;[572] W1=FLAGS, W3=PTR, P1=DEF. TRPLET
PUSHJ P,SY.STF## ;[572] DO ALL NECESSARY SYMBOL FIXUPS
MOVE T1,P1 ;[572] NOW RETURN FAKE BLOCK
MOVEI T2,.L ;[572] T1=ADDR, T2=LENGTH
PJRST GS.RET## ;[572] FREE IT UP AND RETURN
T11PSF: .ERR. (MS,,V%L,L%W,S%W,PSF,<Polish symbol fixups not yet implemented>)
SETZ W1, ;NO-OP
POPJ P, ;CONTINUE
;HERE IF FAIL INNER BLOCK LABELED LITERALS
;HERE TO SEE IF REQUESTED BLOCK HAS BEEN LOADED FOR THIS PROGRAM
T11FBH: SKIPN T1,FBHPTR ;GET POINTER TO BLOCK HEADERS
POPJ P, ;NONE LOADED
HRRZ T1,NAMPTR ;GET POINTER TO LOCAL SYMBOL
CAIA ;ALREADY IN T1 FIRST TIME
T11FBL: HLRZ T1,2(T1) ;GET POINTER TO BLOCK HEADER
JUMPE T1,CPOPJ ;END OF CHAIN
CAMGE T1,LW.LS ;IN CORE?
JRST T11PSF ;NOT AVAILABLE YET
SUB T1,LW.LS ;GET ADDRESS IN CORE
ADD T1,LS.LB
SKIPGE T2,(T1) ;MUST BE PRIMARY
TXNN T2,PT.TTL ;AND A TITLE BLOCK
JRST E01SFU## ;NO
CAME W2,1(T1) ;SEE IF THIS IS THE BLOCK
JRST T11FBL ;NOT YET
MOVE W2,W3 ;PUT SYMBOL WE WANT IN W2
T11FBS: ADDI T1,.L ;ADVANCE
CAML T1,LS.AB ;MAKE SURE WE DON'T GO TOO FAR
POPJ P, ;DIDN'T FIND IT
SKIPLE T2,(T1) ;ONLY WANT PRIMARIES (OR 0)
JRST T11FBS ;IGNORE ALL SECONDARY STUFF
JUMPE T2,.+2 ;0 MARKS END
TXNE T2,PT.TTL ;STOP AT NEXT BLOCK
POPJ P,
TXNE T2,PT.SYM ;MUST BE A SYMBOL
CAME W2,1(T1) ;YES, BUT IS IT ONE WE WANT?
JRST T11FBS ;NO REQUIRED SYMBOL
SUB T1,LS.LB ;RELATIVE-IZE THIS POINTER
ADD T1,LW.LS
SETZ T2, ;CLEAR GLOBAL SYMBOL PTR
JRST CPOPJ1 ;OK RETURN
> ;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,2(P3) ;[2020] ALLOCATE A STORAGE BLOCK
PUSHJ P,DY.GET## ;[1405] TO HOLD THE INFO
HRLZM T2,ABLNK(T1) ;[2020] STORE SIZE,,0 IN LINK WORD
MOVE W3,PRGNAM ;[2005] GET THE MODULE NAME
MOVEM W3,ABMOD(T1) ;[2020] SAVE IT
MOVEI W3,ABABA(T1) ;[2020] SAVE A PTR
MOVN T2,P3 ;[1405]
HRL W3,T2 ;[1405] MAKE W3 AN AOBJN PTR
MOVE W2,W3 ;[1405] W2 IS A BASE PTR
SUB W2,[2,,2] ;[2020] POINT AT ACTUAL BASE
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 T4,ABCNT(W2) ;[1472] NOTE COUNT
CAILE T4,6 ;[1472] NO MORE THAN SIX PLEASE
MOVEI T4,6 ;[1472]
MOVE T2,[POINT 7,ABNAM(W2)] ;[1472]
MOVE T3,[POINT 6,W3] ;[1472] PUT IT IN W3
SETZM W3 ;[1472]
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 TYPES 1130-1134 -- COERCION BLOCKS
T.1130::
PUSHJ P,STDATA ;[1704] USE GENERAL ROUTINE
MOVEM W2,COERPT ;[1405]
JRST LOAD## ;[1701]
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