Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/comp/m3.mac
There is 1 other file named m3.mac in the archive. Click here to see a list.
SUBTTL M3 REL and ATR file creation
;Author: Elisabeth $lund
;Version: 4 [6,12,16,42,43,104,243,247]
;Purpose: Create a REL file adapted to the old loader
; Create ATR file
;Contents:
;Local subroutines: M3ATR Compare ATR files
; M3GR Convert blocks of type 2
; M3IQ Convert blocks of type 10
; M3LT Block containing line number table
; M3CO Convert blocks of type 1013, code and prototype
; M3ST Convert blocks of type 1014, symbols
; M3UNR Generate unique number
; M3NUNR Generate next unique number in sequence
;Normal exit: Return
;Error exit: T3T3 at error on IC2
SEARCH SIMMAC
SALL
MACINIT ;[247]
CTITLE M3
SEARCH SIMMCR
SEARCH SIMMC3 ;[104]
P3INIT ;[104]
TWOSEG
RELOC 400000
QOHATR==4 ;[12]
;External subroutines
EXTERN O3RA ;Read .ATR
EXTERN O3ATR ;Read ATR.TMP
EXTERN O3ATRC ;Check if core for ATR.TMP
EXTERN O3WATR ;Write ATR
EXTERN O3RI ;Read words from IC2
EXTERN O3RIB ;Input buffer from IC2
EXTERN O3WIB ;Write words to REL
EXTERN I3E ;Open .ATR
EXTERN I3I ;Open IC2
EXTERN T3I ;Close IC2 and REL files
EXTERN T3R ;Non-superseding close of REL file
EXTERN T3T3 ;Error routine
;Data
EXTERN IDLA ;[12]
EXTERN ZSE ;Symbol table
EXTERN .JBREL
EXTERN YSWITCH ;Switch word
EXTERN YBHEXT ;Buffer header .ATR
EXTERN YBHIC2 ;Buffer header IC2
EXTERN YBHREL ;Buffer header REL file
EXTERN YNOREL ;Start of REL counters
EXTERN Y3SIEN ;Number of words in entry list ATR
EXTERN Y3UNRA ;[243] For unique number
EXTERN Y3UNRD ;[243] For unique number
EXTERN Y3UNRE ;[243] For unique number
EXTERN Y3UNRF ;[243] For unique number
EXTERN Y3ATRE ;Pointer end of ATR.TMP
EXTERN Y3ATE2 ;Pointer ATR
EXTERN Y3PLTE ;Pointer end of line number table
EXTERN Y3PLTS ;Pointer first free place line number table
EXTERN YCADLV
EXTERN YCANTRY ;Start address at execution
EXTERN Y3REL ;REL counter
EXTERN YM3B ;Local buffer code prototype and internal request streams
EXTERN YM3BI ;Index of first free place in YM3BI
EXTERN YM3BRP ;Pointer REL word in YM3B
EXTERN YRELBL ;[6] Number of blocks filled on REL file
EXTERN Y3ENTRY ;[6] Entry point name or zero
INTERN M3 ;Module entry
SUBTTL M3 main loop
M3:
PROC
;COUNT NUMBER OF WORDS IN DIFFERENT STREAMS TO LOADER
LI X2,1
SETZB X3,Y3REL
SETZM Y3REL+1
LOOP
ADD X3,YNOREL(X2)
ST X3,Y3REL+1(X2)
AS
CAIE X2,5
AOJA X2,TRUE
SA
SETZM YM3BI ;RESET START INDEX
SETZM Y3ENTRY ;[6] Entry point undefined
;CREATE POINTER FOR LINENUMBER TABLE
IF ;Main program
IFOFF Y3MP
GOTO FALSE
THEN ;CREATE POINTER FOR LINE NUMBER TABLE
LI X0,IDL
ST X0,Y3PLTE
ST X0,Y3PLTS
ELSE ;EXT CLASS or PROC, GENERATE ATR FILE
EXEC M3ATR
IF ;Not a SIMULA procedure
IFON Y3ESIM
GOTO FALSE
THEN ;Do not generate REL file unless it is a class
IFOFF Y3ECLA
GOTO M3END
FI
L Y3ENTRY ;[6] Entry name or 0
IF ;[6] Nonzero name and entry block still not output
JUMPE FALSE
HRRZ X1,YRELBL ;Number of full buffers so far
;[16] Revised because of problems with io
;[16] CAIL X1,2 ;Less than two buffers?
;[16] GOTO FALSE
JUMPN X1,FALSE ;[16] Works only if none output
THEN ;Change entry name without much trouble
;[16] CAIL X1,1 ;Less than one?
;[16] SKIPA X1,@YBHREL ;No, find 1st buffer
L X1,YBHREL ;Yes, use current buffer
ST 4(X1)
SETZM Y3ENTRY ;Indicate no further change necessary
FI ;[6]
FI
EXEC I3I ;OPEN IC2
;FIRST PART OF OUTPUT BUFFER IS FILLED, MOVE TO LOCAL BUFFER
;COMPUTE START INDEX IN BUFFER
HRRZ X1,YBHREL
HRRZ X2,YBHREL+1
HRRM X1,YBHREL+1
AOS YBHREL+1
SUBI X2,1(X1)
ST X2,YM3BI
HRLI X1,2(X1)
HRRI X1,YM3B
BLT X1,YM3B-1(X2)
REPEAT 0,< ;[16] Code no good, wait till we get older and wiser
IF ;[6] Global class/proc and
; 1st buffer full and not yet output
L YRELBL
JUMPGE FALSE
HRRZ
JUMPE FALSE
CAIE 1
GOTO FALSE
THEN ;Output it first
L X1,@YBHREL
OUT QCHREL,(X1)
SOSGE YBHREL+2
GOTO [
L QT,[ASCIZ /REL/]
ERRT QT,Q.TER+4
BRANCH T3T3
]
FI ;[6]
> ;[16] End repeat 0
WHILE
EXEC O3RI ;READ WORD
SKIPA ;CORRECT RETURN
GOTO FALSE
DO
HLRZ X1,X0
HRRZ X10,X0 ;NUMBER OF WORDS UNTIL NEXT HEADER WORD
;CHECK FOR BLOCK TYPE
MOVSI X2,-6
;CHECK IF CORRECT HEADER IN IC2 AND CALL CURRENT ROUTINE
IF
CAMN X1,M3TYP(X2)
GOTO FALSE
THEN
AOBJN X2,.-2
;ERROR FAULTY HEADER IN IC2
ASSERT <OUTSTR [ASCIZ /FAULTY HEADER IN IC2
/]>
ERRT QT,Q.TER+3
BRANCH T3T3
FI
EXEC @M3BL(X2)
OD
IF ;Not main program
IFON Y3MP
GOTO FALSE
THEN ;SIMULA CLASS/PROC,OUTPUT ENTRIES (GLOBAL DEFINITIONS)
;MOVE ENTRIES TO LOCAL BUFFER AND OUTPUT TO REL FILE
L X3,Y3SIEN
L X2,YM3BI
LI X1,YM3B(X2)
HRL X1,Y3ATRE
;COMPUTE NUMBER OF FREE WORDS LEFT IN LOCAL BUFFER
LI X0,QBL
SUB X0,X2
IF ;Sufficient
CAMGE X0,X3
GOTO FALSE
THEN ADD X2,X3
ST X2,YM3BI
BLT X1,YM3B-1(X2)
ELSE ;THE ENTRIES NEED MORE THAN THIS BUFFER
LI X2,QBL
BLT X1,YM3B-1(X2)
ADDM X0,Y3ATRE
SUB X3,X0
EXEC M3UT
WHILE
CAIGE X3,QBL
GOTO FALSE
DO
L X0,Y3ATRE
LI X1,QBL
ADDM X1,Y3ATRE
SUBI X3,QBL
EXEC O3WIB
OD
LI X1,YM3B
HRL X1,Y3ATRE
BLT X1,YM3B-1(X3)
ST X3,YM3BI
FI
L X2,YM3BI
ELSE ;Main program
L X2,YM3BI ;Insert START address def (type 7 block)
LD X0,M3BL7
STD X0,YM3B(X2)
L X1,YCANTRY
ADD X1,Y3REL+QRELCD
ST X1,YM3B+2(X2)
ADDI X2,3
LD X4,M3GL2 ;Define global symbols (type 2 block)
STD X4,YM3B(X2)
L X0,M3MAIN
STD X0,YM3B+2(X2) ;.MAIN defined
L X0,M3MAIL
L X1,Y3REL+QRELLT+1
SUBI X1,1
STD X0,YM3B+4(X2) ;.MAINL defined
ADDI X2,6
FI
IF ;SIMULATION level defined
SKIPN X1,YCADLV
GOTO FALSE
THEN
IF ;Not main program
IFON Y3MP
GOTO FALSE
THEN ;External SIMULA CLASS/PROC
L X3,M3GL2
LI X4,0
STD X3,YM3B(X2)
ADDI X2,2
ELSE ;block will have 4 more words
ADDI X4,4
ST X4,YM3B-6(X2)
FI
L X0,M3SIML ;.SIMLV defined
STD X0,YM3B(X2)
L X0,M3SIMN ;.SIMVL (-.SIMLV) defined
HRRES X1
MOVNS X1
STD X0,YM3B+2(X2)
ADDI X2,4
FI
LD X0,M3BL5 ;End block (type 5)
STD X0,YM3B(X2)
L X0,Y3REL+6 ;PROGRAM BREAK
ST X0,YM3B+2(X2)
SETZM YM3B+3(X2)
ADDI X2,4
CAILE X2,QBL
EXEC M3UT
;OUTPUT LAST BUFFER, WHICH MAY BE PARTLY FILLED
LI X0,YM3B
L X1,X2
EXEC O3WIB
EXEC T3I ;Close IC2 (and delete it), close REL
M3END:
RETURN
EPROC
SUBTTL M3ATR
;PURPOSE COMPARE OLD AND NEW ATR FILE,IF UNEQUAL OUTPUT NEW ATR
;ENTRY: M3ATR
;INPUT ARGUMENTS: -
;NORMAL EXIT: RETURN
;ERROR EXIT: -
;OUTPUT ARGUMENTS:
; Y3PLTE POINTER TO FREE POS IN IDL AFTER DATA FROM ATR FILE TO
; REL FILE
; Y3SIEN NUMBER OF ENTRIES IN IDL
; THAT ARE TO BE OUTPUT TO THE REL FILE
; Y3ATRE POINTER TO POS AFTER ATR.TMP
;CALL FORMAT: EXEC M3ATR
M3ATR: PROC
SAVE <X2,X3,X4,X5,X6>
;READ ATR.TMP INTO CORE,RETURN Y3ATRE POINTER TO POS AFTER LIST
EXEC O3ATR
;INDEX ATRLIST
LI X3,IDLA+1
LI X5,0
LOOP
;REPLACE ID NUMBER WITH NAME AMONG ATTRIBUTES
IF
IFEQF (X3,ZDETYP,ZHB%V)
;COUNT ZHB
AOJA X5,FALSE
THEN
;ZQU
LF X1,ZQULID(X3)
LF X2,ZQUQID(X3)
LSH X1,1
LD X0,ZSE-4000(X1)
STD X0,2(X3)
SETF 0,ZQULID(X3)
IF
JUMPE X2,FALSE
THEN
;TWO IDENTIFIERS
LSH X2,1
LD X1,ZSE-4000(X2)
ELSE
;ONE IDENTIFIER
LI X1,0
FI
STD X1,4(X3)
ADDI X3,1
FI
ADDI X3,5
AS
SKIPE (X3)
GOTO TRUE
SOJE X5,FALSE
AOJA X3,.-3
SA
ADDI X3,1
ST X3,Y3ATE2
;REPLACE ID NUMBERS WITH NAME IN PART 3
WHILE
SKIPN (X3)
GOTO FALSE
DO
LF X1,ZHELID(X3)
LSH X1,1
LD X0,ZSE-4000(X1)
STD X0,2(X3)
ZF ZHELID(X3)
ADDI X3,4
OD
IF ;Old ATR file did not exist or could not be opened
EXEC I3E
GOTO FALSE
THEN ;A new unique number is needed
SETONA NEWUNR
ELSE ;Read old file and compare
SOSGE YBHEXT+2
EXEC O3RA
ILDB X1,YBHEXT+1
IF ;[12] New ATR file format
HLRZ X1
CAIE 4
GOTO FALSE
THEN ;Skip blocks before 1st comment block
WHILE ;Not type 0
JUMPE FALSE
DO
LI X3,2(X1)
LOOP SOSGE YBHEXT+2
EXEC O3RA
ILDB X1,YBHEXT+1
AS SOJG X3,TRUE
SA
HLRZ X1
OD
SOSGE YBHEXT+2
EXEC O3RA
ILDB X1,YBHEXT+1
FI ;[12]
SETONA OLDATR
IF
IFON Y3ESIM
GOTO FALSE
IFON Y3ECLA
GOTO FALSE
THEN
;MACRO/FORTRAN
;COMPARE HEADER
CAME X1,IDLA
SETONA NEWATR
ELSE
IFON Y3ESIM ;[226] Must not keep header from
SETZ X1, ;[226] poss. MACRO/FORTRAN proc
ST X1,IDLA
FI
;COMPARE ATTRIBUTES IN OLD AND NEW ATR FILE
LI X3,IDLA+1
LOOP
;START OF NEW RECORD
;SAVE POINTER TO START OF RECORD
LI X5,(X3)
LF X2,ZDETYP(X3)
HRLI X3,-6
SKIPN (X3)
HRLI X3,-1
LOOP
;COMPARE WORDS IN CURRENT RECORD AND ZEROWORDS
;READ ATR
SOSGE YBHEXT+2
EXEC O3RA
ILDB X1,YBHEXT+1
IF
CAMN X1,(X3)
GOTO FALSE
THEN ;WORDS DIFFER
;ZQUIND ZHBUNR AND ZQUUNR MAY DIFFER
LI X6,(X3)
IF ;ZHB
CAIE X2,ZHB%V
GOTO FALSE
THEN
IF ;[42] Unique number
CAIE X6,OFFSET(ZHBUNR)(X5)
GOTO FALSE
THEN ;Accept difference
ST X1,(X3) ;Use old
SKIPN Y3ENTRY ;[6] Entry point
ST X1,Y3ENTRY ;[6] first time
ADD X3,[1,,0]
ELSE ;Length field may differ
CAIE X6,OFFSET(ZHELEN)(X5)
GOTO M3ADIF
XOR X1,(X3)
SIZE(Q,ZHELEN)
Q1==<1_<Q>-1>B<%ZHELEN>
Q2==%ZHELEN-^d18
IFL <Q2>,<
TLZ X1,(Q1)
>
IFG <Q2+1>,<
IFG <Q2+1-Q>,<
TRZ X1,Q1
>
IFL <Q2-Q>,<
Q1==1-Q1
AND X1,[Q1]
>
>
JUMPN X1,M3ADIF
;Only length differed.
;Accepted, since any
;real difference will
;show up in other places
FI ;[42]
ELSE ;ZQU
IFNEQF (X5,ZQUMOD,QDECLARED)
GOTO M3ADIF
IF
CAIE X6,OFFSET(ZQUIND)(X5)
GOTO FALSE
THEN ;CHECK IF REST OF WORD EQUAL
XOR X1,(X3)
TLNE X1,-1
GOTO M3ADIF
;IND MAY DIFFER IF
;DECL CLASS/PROC/LABEL/SWITCH
LF X0,ZQUKND(X5)
IF
CAIE X0,QPROCE
CAIN X0,QCLASS
GOTO FALSE
LF X0,ZQUTYP(X5)
CAIN X0,QLABEL
GOTO FALSE
THEN
GOTO M3ADIF
FI
ELSE
CAIE X6,OFFSET(ZQUUNR)(X5)
GOTO M3ADIF
IFNEQF (X5,ZQUTYP,QLABEL)
GOTO M3ADIF
ST X1,(X3)
FI
FI
FI
AS
AOBJN X3,TRUE
SA ;END OF A RECORD
AS
;CHECK IF MORE RECORDS
CAME X3,Y3ATE2
GOTO TRUE
SA
WHILE
SKIPN (X3)
GOTO FALSE
DO
;COMPARE PART 3 CHECKS
HRLI X3,-4
LOOP
SOSGE YBHEXT+2
EXEC O3RA
ILDB X1,YBHEXT+1
CAME X1,(X3)
GOTO M3CDIF
AS
AOBJN X3,TRUE
SA
OD
SOSGE YBHEXT+2
EXEC O3RA
ILDB X1,YBHEXT+1
SKIPE X1
M3CDIF:
SETONA NEWATR
FI
IF
IFOFFA NEWUNR
GOTO FALSE
THEN
;GENERATE NEW UNIQUE NUMBERS
M3ADIF:
EXEC M3UNR
SETONA NEWATR
SETONA NEWUNR
IF ;CLASS
IFOFF Y3ECLA
GOTO FALSE
THEN ;Define symbol for ZCPSBL
EXEC M3NUNR
ST X1,IDLA
FI
LD X3,Y3UNRD ;[6,243] Save unique name info
STACK Y3UNRF ;[243]
EXEC M3NUNR ;[6] Entry name
ST X1,Y3ENTRY ;[6] Save it
UNSTK Y3UNRF ;[243]
STD X3,Y3UNRD ;[6,243] Restore to old status
LI X3,IDLA+1
LOOP
IF ;Not ZQU
IFEQF (X3,ZDETYP,ZQU%V)
GOTO FALSE
THEN
;ZHB OR ZERO WORD
IF
SKIPN (X3)
AOJA X3,FALSE
THEN ;GET NEW UNIQUE NUMBER
EXEC M3NUNR
SF X1,ZHBUNR(X3)
ADDI X3,5
FI
ELSE ;ZQU
IF ;Declared and (LABEL or SWITCH)
IFNEQF (X3,ZQUMOD,QDECLARED)
GOTO FALSE
IFNEQF (X3,ZQUTYP,QLABEL)
GOTO FALSE
THEN
EXEC M3NUNR
SF X1,ZQUUNR(X3)
FI
ADDI X3,6
FI
AS
CAME X3,Y3ATE2
GOTO TRUE
SA
FI
IF
IFON Y3ECLA
GOTO TRUE
IFOFF Y3ESIM
GOTO FALSE
THEN
;SIMULA PROCEDURE /CLASS
;DEF ENTRIES TO BE OUTPUT TO REL FILE
;COMPUTE SPACE THAT WILL BE NEEDED BY LIST CONTAINING ENTRIES
L X1,Y3ATE2
L X2,Y3ATRE
SUBI X1,IDLA
LSH X1,-1
SUBI X2,IDLA
ADD X1,X2
;CHECK IF SPACE FOR LIST AFTER ATR.TMP
EXEC O3ATRC
LI X3,IDLA+1
L X4,Y3ATRE
ADDI X4,1
LI X5,0
IF
SKIPN X1,IDLA
GOTO FALSE
THEN ;RELOCATE ZCPSBL
TLO X1,600000
LF X2,ZQUIND(X3)
SUBI X2,1
ADD X2,Y3REL+QRELPT
TLO X2,600000
FI
WHILE
;OUTPUT ENTRIES AFTER ATR IN CORE
IF ;Nonzero entry
JUMPE X1,FALSE
THEN
IF
SOJG X5,FALSE
THEN
;RELOCATION WORD
L X0,[OCT 042104210421]
ST X0,(X4)
LI X5,^D9
ADDI X4,1
FI
STD X1,(X4)
ADDI X4,2
LI X1,0
FI
CAML X3,Y3ATE2 ;End of list?
GOTO FALSE
SKIPN (X3) ;Skip zero words
AOJA X3,.-3
DO
IF ;Not ZQU
IFEQF (X3,ZDETYP,ZQU%V)
GOTO FALSE
THEN ;ZHB
LF X1,ZHBUNR(X3)
TLO X1,40000
ADDI X3,5
ELSE ;ZQU
IF ;Declared
IFNEQF (X3,ZQUMOD,QDECLA)
GOTO FALSE
THEN ;Define code address of symbol
LF X2,ZQUIND(X3)
;RELOCATE ADDRESS
IF ;LABEL or SWITCH
IFNEQF (X3,ZQUTYP,QLABEL)
GOTO FALSE
THEN
LF X1,ZQUUNR(X3)
TLO X1,40000
IF ;Simple label
IFNEQF (X3,ZQUKND,QSIMPLE)
GOTO FALSE
THEN ;REL TO CODE
ADD X2,Y3REL+QRELCD
ELSE ;CLASS or PROC,
;REL TO PROTOTYPE
ADD X2,Y3REL+QRELPT
FI
ELSE
;REL TO PROTOTYPE
ADD X2,Y3REL+QRELPT
FI
FI
ADDI X3,6
FI
OD
;CREATE HEADER WORD,COMPUTE LENGTH OF ENTRY LIST
ST X4,Y3PLTE
ST X4,Y3PLTS
SUB X4,Y3ATRE
ST X4,Y3SIEN
LI X2,-1(X4)
;EVERY 19TH WORD IS A REL WORD SHOULD NOT BE COUNTED
IDIVI X2,^D19
SUBI X4,1(X2)
SKIPE X3
SUBI X4,1
HRLI X4,2
ST X4,@Y3ATRE
ELSE
;MACRO/FORTRAN
;DEL REL.TMP
EXEC T3R
FI
;CREATE NEW ATR IF RELEVANT AND DEL OLD ATR IF EXISTING AND CLOSE .ATR
EXEC O3WATR
RETURN
EPROC
SUBTTL M3GR
COMMENT ;
PURPOSE: CONVERT BLOCK TYPE 2 TO SUIT OLD LOADER FORMAT
ENTRY: M3GR
INPUT ARGUMENTS: REG X10 CONTAINING NUMBER OF WORDS IN IC2 UNTIL NEXT HEADER WORD
NORMAL EXIT: RETURN
ERROR EXIT -
OUTPUT ARGUMENTS: -
CALL FORMAT EXEC M3GR
;
M3GR:
PROC
L X2,YM3BI
;CREATE HEADER WORD
MOVSI X0,2
HRR X0,X10
ST X0,YM3B(X2)
ADDI X2,1
LI X4,0 ;Force relocation word
WHILE ;[243] Item contains more data
SOJL X10,FALSE
DO
IF ;Relocation word
SOJG X4,FALSE
THEN ;OUTPUT BUFFER IF FILLED
CAIL X2,QBL
EXEC M3UT
;RELOCATE ADDRESS PART
L X0,[OCT 042104210421]
ST X0,YM3B(X2)
ADDI X2,1
LI X4,^D9
FI
;READ DATA WORD
SOSGE YBHIC2+2
EXEC M3IN
ILDB X0,YBHIC2+1
HLRZ X5,X0
TRZ X5,777700
ADD X0,Y3REL(X5)
HRLI X0,0
ST YM3B+1(X2)
SUBI X10,1
;NEXT WORD CONTAINS INFO ON CURRENT SYMBOL
SOSGE YBHIC2+2
EXEC M3IN
ILDB X1,YBHIC2+1
TLNN X1,-1
L X1,M3GL(X1)
ST X1,YM3B(X2)
ADDI X2,2
OD
CAIL X2,QBL
EXEC M3UT
ST X2,YM3BI
RETURN
EPROC
SUBTTL M3IQ
;PURPOSE: CONVERT BLOCK TYPE 10 TO SUIT OLD LOADER FORMAT
;ENTRY: M3IQ
;INPUT ARGUMENTS: REG X10 CONTAINING NUMBER OF WORDS TO READ FR IC2
;NORMAL EXIT: RETURN
;ERROR EXIT: -
;OUTPUT ARGUMENTS: -
;CALL FORMAT: EXEC M3IQ
M3IQ:
PROC
L X2,YM3BI ;GET INDEX
EXEC M3IQH
M3IQL:
IF
SOJGE X10,FALSE
THEN
;NO MORE WORDS TO READ
;OUTPUT BUFFER IF FILLED
;DELETE LAST WORD IN BUFFER IF REL WORD
CAIL X4,^D18
SUBI X2,1
CAIL X2,QBL
EXEC M3UT
ST X2,YM3BI
RETURN
FI
M3IQL1:
IF
SOJGE X4,FALSE
THEN
;REL WORD
;OUTPUT BUFFER IF FILLED
CAIL X2,QBL
EXEC M3UT
SETOM YM3B(X2) ;RELOCATE ALL WORDS
LI X4,^D18 ;18 DATA WORDS BETWEEN REL WORDS
AOJA X2,M3IQL1
FI
;READ TWO WORDS GET CURRENT REL COUNTER AND CREATE ONE WORD
SOSGE YBHIC2+2
EXEC M3IN
ILDB X0,YBHIC2+1
IF
SKIPN X0
;NO OUTPUT OF ZERO WORDS
;NO REL WORD FOR ZERO WORDS
AOJA X4,FALSE
THEN
HLRZ X5,X0
TRZ X5,777000
ADD X0,Y3REL(X5)
HRLZM X0,YM3B(X2) ;FIRST WORD INTO LEFT HALF
FI
SUBI X10,1
SOSGE YBHIC2+2
EXEC M3IN
ILDB X0,YBHIC2+1
JUMPE X0,M3IQL
HLRZ X5,X0
ADD X0,Y3REL(X5)
HRRM X0,YM3B(X2)
AOJA X2,M3IQL
EPROC
M3IQH:
;CREATE HEADER WORD
SOSGE YBHIC2+2
EXEC M3IN
ILDB X4,YBHIC2+1
LSH X4,-1
HRLI X4,10 ;HEADER BLOCK TYPE
ST X4,YM3B(X2)
ADDI X2,1
LI X4,0
RETURN
SUBTTL M3LT
;PURPOSE: CONVERT BLOCK TYPE 1013 OR 1015 TO SUIT OLD LOADER FORMAT
; TYPE 1015 INDICATES LINENUMBER TABLE,
; WHICH IS SAVED IF LINENUMBER TABLE WANTED IN LISTING
;ENTRY: M3LT IF TYPE 1015,
; M3CO IF TYPE 1013
;INPUT ARGUMENTS: REG X10 CONTAINING NUMBER OF WORDS TO READ FROM IC2
; REG X1 CONTAINING BLOCK TYPE
;NORMAL EXIT: RETURN
;ERROR EXIT: -
;OUTPUT ARGUMENTS: -
;CALL FORMAT: EXEC M3LT RESP EXEC M3CO
M3LT:
;ENTRY BLOCK TYPE 1015
L X11,.JBREL
M3CO:
PROC
;BLOCK TYPE 1013
;SAVE BLOCK TYPE
L X12,X1
;CREATE HEADER AND INIT INDEXES
EXEC M3HEAD
M3LTL:
IF
SOJGE X10,FALSE
THEN
;NO MORE WORDS IN ITEM
;OUTPUT BUFFER IF FILLED
CAIL X2,QBL
EXEC M3UT
ST X2,YM3BI
RETURN
FI
;READ WORDS FROM IC2
SOSGE YBHIC2+2
EXEC M3IN
ILDB X1,YBHIC2+1
IF ;Relocation word
SOJGE X4,FALSE
THEN ;SAVE REL WORD
L X7,X1
CAIL X2,QBL
EXEC M3UT
ST X7,YM3B(X2)
LI X4,^D18
ELSE ;DATA WORD
;UPDATE WORD USING CURRENT RELOCATION COUNTER
IF
JUMPGE X7,FALSE
THEN
;RELOCATE LEFT HALF
LDB X6,[POINT 3,X1,2]
TLZ X1,700000
HRLZ X0,Y3REL(X6)
ADD X1,X0
FI
LSH X7,1
IF
JUMPGE X7,FALSE
THEN
;RELOCATE RIGHT HALF
LDB X6,[POINT 3,X1,20]
TRZ X1,700000
ADD X1,Y3REL(X6)
FI
ST X1,YM3B(X2)
LSH X7,1
;CHECK IF WORD IS LINENUMBER
IF
CAIE X12,1015
GOTO FALSE
IFOFF YSWY
GOTO FALSE
;START ADDRESS SHOULD NOT BE OUTPUT
TLNN X1,-1
GOTO FALSE
JUMPL X1,FALSE
THEN
;LINENUMBER
;CHECK IF ENOUGH CORE
IF
CAML X11,Y3PLTE
GOTO FALSE
THEN
;MORE CORE NEEDED
LI X0,1000(X11)
IFG QTRACE,<EXTERN YTRPAS
IFOFF YTRSW>
CORE X0,
SKIPA
GOTO FALSE
ERRT QT,560
BRANCH T3T3
FI
ST X1,@Y3PLTE
AOS Y3PLTE
FI
FI
AOJA X2,M3LTL
EPROC
SUBTTL M3NO
;PURPOSE: OUTPUT BLOCK TYPE 0 TO REL FILE
;ENTRY: M3NO
;INPUT ARGUMENT: REG X10 CONTAINING NUMBER OF WORDS TO READ FROM IC2
;NORMAL EXIT: RETURN
;OUTPUT ARGUMENT: -
;CALL FORMAT: EXEC M3NO
M3NO:
;[43]AT PRESENT BLOCK TYPE 0 IS UTILIZED TO FILL THE REST OF AN IC2 BUFFER
; AFTER PARTLY FILLED LOCAL CODE STREAM BUFFERS ARE OUTPUT.
;THIS BLOCK IS NOT OUTPUT TO REL FILE
SKIPN X10 ;IF A ZERO WORD
RETURN
SUBM X10,YBHIC2+2 ;[43] SKIP ALL ZERO WORDS
RETURN
SUBTTL M3ST
;PURPOSE: CONVERT BLOCK TYPE 1014 CONTAINING SYMBOLS TO SUIT OLD LOADER FORMAT
;ENTRY: M3ST
;INPUT ARGUMENT: REG X10 CONTAINING NUMBER OF WORDS TO READ FROM IC2
;NORMAL EXIT: RETURN
;ERROR EXIT: -
;OUTPUT ARGUMENTS
;CALL FORMAT: EXEC M3ST
M3ST:
PROC
;CREATE HEADER AND INIT INDEXES
EXEC M3HEAD
SETZM YM3BRP
LOOP
IF
SOJGE X10,FALSE
THEN
;NO MORE WORDS IN ITEM
;OUTPUT BUFFER IF FILLED
;OUTPUT REL WORD
LSH X4,1
ROT X7,(X4)
ST X7,@YM3BRP
CAIL X2,QBL
EXEC M3UT
ST X2,YM3BI
RETURN
FI
;READ WORD FROM IC2
SOSGE YBHIC2+2
EXEC M3IN
ILDB X0,YBHIC2+1
IF ;Relocation word
SOJGE X4,FALSE
THEN ;OUTPUT OLD RELOCATION WORD
SKIPE YM3BRP
ST X7,@YM3BRP
L X7,X0
CAIL X2,QBL
EXEC M3UT
LI X0,YM3B(X2)
ST X0,YM3BRP
LI X4,^D18
ELSE
;DATA WORD
;UPDATE WORD USING CURRENT RELOCATION COUNTER
IF
JUMPGE X7,FALSE
THEN
;RELOCATE LEFT HALF
LDB X1,[POINT 3,X0,2]
TLZ X0,700000
HRLZ X6,Y3REL(X1)
ADD X0,X6
FI
ROT X7,1
IF
JUMPGE X7,FALSE
THEN
;RELOCATE RIGHT HALF
LDB X1,[POINT 3,X0,20]
TRZ X0,700000
IF
CAIL X1,QRELID
GOTO FALSE
THEN
;NO IDENTIFIER
ADD X0,Y3REL(X1)
ELSE
;IDENTIFIER
;NO REL
TLZ X7,400000
HRRZ X6,X0
LSH X6,1
CAIE X1,QRELID
;SECOND PART OF NAME
ADDI X6,1
L X0,ZSE-4000(X6)
FI
FI
ST X0,YM3B(X2)
ROT X7,1
FI
AS
AOJA X2,TRUE
SA
EPROC
;CODE COMMON TO OTHER ROUTINES
;CREATE HEADER AND INIT INDEXES
;GET INDEX OF BUFFER
M3HEAD:
L X2,YM3BI
;CREATE HEADER WORD
HRRZI X3,22(X10)
MOVSI X0,1
HRR X0,X10
IDIVI X3,^D19
SUB X0,X3
;THERE WILL ALWAYS BE ROOM FOR HEADER
ST X0,YM3B(X2)
ADDI X2,1
;INDICATE REL WORD NEXT
LI X4,0
RETURN
M3IN: ;INPUT ANOTHER BUFFER FROM IC2
IF
EXEC O3RIB
GOTO FALSE
THEN
;ERROR RETURN
ASSERT <OUTSTR [ASCIZ /FAULTY HEADER IN IC2/]>
M3INER:
L X1,[ASCIZ /IC2/]
ERRT QT,Q.TER+3
BRANCH T3T3
ELSE
SOS YBHIC2+2
RETURN
FI
M3UT:
;ROUTINE TO OUTPUT LOCAL BUFFER TO REL.TMP
;INPUT: REG X2 CONTAINING INDEX OF YM3B
IF
CAIGE X2,QBL
GOTO FALSE
THEN
LI X1,QBL
SUBI X2,QBL
ELSE
L X1,X2
FI
LI X0,YM3B
EXEC O3WIB
ST X2,YM3BI
IF
JUMPE X2,FALSE
THEN
L X11,[XWD YM3B+QBL,YM3B]
BLT X11,YM3B(X2)
FI
RETURN
SUBTTL Unique global identifiers [243]
Comment/
Purpose: In order to insure against loading REL files for external
classes and procedures which do not match the attribute
file information, a "unique" number is computed when the
attribute file is created. This number is built up from
the date and time of day. The global symbols (entries)
of the REL file are derived from the initial number
essentially by adding 1 to the previous symbol.
The derived number is used as a RADIX50 symbol, i e only
the last 32 bits are part of the symbol, the first 4 bits
are flag bits.
To avoid ambiguity, the null (space) character is not allowed
to appear. This is accomplished by treating the initial number
as a "RADIX47" symbol, where 0 stands for "0", adding 1 to
each character and reassembling as a RADIX50 symbol.
In M3NUNR, each character of the variable part is monitored to
yield no null character, starting each character at 1 ("0")
on overflow, and propagating carry to the next character to
the left.
Input: M3UNR: Date (universal time, i e days since Nov 1, 1858, GMT).
Time of day in "jiffies" (also GMT).
M3NUNR: Y3UNRA, Y3UNRD, Y3UNRE, Y3UNRF
Output: M3UNR: Y3UNRA - First part (AB%) of radix50 symbol. Is added to
Y3UNRD, -E, -F to give full symbol.
Y3UNRD = is 4th character (radix50) * 40^2
Y3UNRE = is 5th character * 40
Y3UNRF = is 6th character.
DEF stands for the last 3 characters of the symbol.
The symbol has the form AB%DEF, where A, B, D, E, F are in
the set [0-9, A-Z, ., $, %].
The third character is always % to avoid name clashes in LINK.
M3NUNR: X1 has next radix50 symbol (usually previous + 1), formed
by adding 1 to Y3UNRF, modifying and propagating carry if
the value becomes 50 octal, then adding Y3UNRA, Y3UNRD,
Y3UNRE, Y3UNRF.
Calls: Monitor UUO's GETTAB and TIMER
/
M3UNR: PROC ;Generate starting numbers
L [53,,11]
GETTAB ;Universal date-time
GOTO [DATE
GOTO .+2]
HLRZ ;Number of days since Nov 1, 1858
;First 3 characters: "AB%"
IDIVI 47 ;Use date to get two "RADIX47" characters
LI X2,1(X1) ;Save RADIX50 in X2
IDIVI 47
IMULI X1,50
ADDI X1,50(X2) ;We have " AB" in X1 now
IMULI X1,50 ;Shift left 1 character
ADDI X1,47 ;Add "%"
IMULI X1,50*50*50
ST X1,Y3UNRA ;Save first three characters
;Compute last 3 characters from time of day
CALLI 22 ;TIMER UUO
LSH -1 ;Jiffies//2
IDIVI 47
LI X1,1(X1)
ST X1,Y3UNRF ;6th char
IDIVI 47
LI X1,1(X1)
IMULI X1,50
ST X1,Y3UNRE ;5th char in right position
IDIVI 47
LI X1,1(X1)
IMULI X1,50*50
ST X1,Y3UNRD ;4th char in right position
RETURN
EPROC
M3NUNR: PROC ;[243] Next proper RADIX50 symbol (without spaces)
AOS X1,Y3UNRF ;Add 1 to last char
IF ;"Overflow"
CAIGE X1,50
GOTO FALSE
THEN ;Propagate, set to "0"
ADDB X1,Y3UNRE
LI 1
ST Y3UNRF
IF ;5th character now overflows
CAIGE X1,50*50
GOTO FALSE
THEN ;One more step
ADDB X1,Y3UNRD
LI 50
ST Y3UNRE
IF ;This blows it for 4th character
CAIGE X1,50*50*50
GOTO FALSE
THEN ;Set it to "0"
LI 50*50
ST Y3UNRD
FI FI
L X1,Y3UNRF
FI
ADD X1,Y3UNRE ;Add them all together for final symbol
ADD X1,Y3UNRD
ADD X1,Y3UNRA
RETURN
EPROC
SUBTTL TABLES
;TABLE CONTAINING ADDRESSES OF ROUTINES TO BE USED AT CURRENT HEADER
M3BL: XWD 0,M3CO
XWD 0,M3IQ
XWD 0,M3LT
XWD 0,M3GR
XWD 0,M3ST
XWD 0,M3NO
;BLOCK ITEM TYPES 5 and 7
M3BL5: XWD 5,2
XWD 200000,0
XWD 0
M3BL7:
XWD 7,1
XWD 200000,0
;TABLE OF LEGAL HEADERS IN IC2
M3TYP: XWD 0,1013
XWD 0,10
XWD 0,1015
XWD 0,2
XWD 0,1014
XWD 0,0
XWD 0,1010
XWD 0,1011
M3GL2: ;HEADER GLOBAL DEF
XWD 2,4
BYTE (4)1,1
M3MAIN: RADIX50 4,.MAIN
M3MAIL: RADIX50 4,.MAINL
M3SIML: RADIX50 4,.SIMLV
M3SIMN: RADIX50 4,.SIMVL
;MACRO TO GENERATE TABLE CONTAINING NAMES IN SIXBIT FORMAT OF RTS ROUTINES
;THE TABLE IS USED WHEN THE NAMES ARE TO BE OUTPUT TO THE REL FILE
DEFINE X(A,B,C,D)<
IFL<A-400K>,<
IFNB<D>,<RADIX50 60,D>
IFB<D>,<RADIX50 60,.'A>
>
>
DEFINE Y(A,B,C,D)<
X(A,B,C)>
M3GL: ;GLOBAL RTS ROUTINES NOT IN LOWSEG
0
RTSYMBOLS
LIT
END