Trailing-Edge
-
PDP-10 Archives
-
bb-d868c-bm_tops20_v4_2020_distr
-
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 24-Aug-79
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1973, 1979 BY DIGITAL EQUIPMENT CORPORATION
SEARCH LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
SALL
ENTRY LNKNEW
EXTERN LNKSCN,LNKLOD,LNKCOR,LNKWLD,LNKLOG,LNKCST
CUSTVR==0 ;CUSTOMER VERSION
DECVER==4 ;DEC VERSION
DECMVR==1 ;DEC MINOR VERSION
DECEVR==1220 ;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 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).
SUBTTL BLOCK DISPATCH TABLES
XALL
NDSPTB: LITYPE (1000,1060)
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 ;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,.EP,,,,NAMPTR)
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
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)
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
MOVE T1,CP.BIT##(W3) ;GET BIT CORRESPONDING TO CPU TYPE
IORM T1,CPUSN ;UPDATE MASK OF ALL SEEN SO FAR
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,
SUBTTL BLOCK TYPES 1042 AND 1043 - PROGRAM AND LIBRARY REQUESTS
; -----------------
; ! 1042 ! COUNT !
; -----------------
; ! DEVICE !
; -----------------
; ! FILE NAME !
; -----------------
; ! EXT !DIR CNT!
; -----------------
; ! PROJ ! PROG !
; -----------------
; ! SFD !
; -----------------
;
; .
;
; .
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
> ;END IFN .NWBLK ON PAGE 13
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## ;[1174] 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
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 !
; -----------------
;
; .
;
; .
IFE .NWBLK,< ;THIS PAGE INSTALLED IN EDIT 454
T.1060==T.1000
> ;END IFE .NWBLK
IFN .NWBLK,<
T.1060: JRST E$$IRB## ;[1174] SHOULD PUT INFO IN LS FOR MAP
> ;END 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 THE END
NEWLIT: END