!**************************
!* LINK6S/LINK *
!* DATE: 25.FEB.80 *
!* 4TH PASS FOR IMP COMP. *
!**************************
CONTROL K'101011'; ! 11/45 & TRUSTED
RECORDFORMAT DFGH(INTEGER G)
CONSTRECORD (DFGH) NAME NULL = 0
BEGIN
!! STK = 27200
CONSTBYTEINTEGERNAME ID = K'160030'
CONSTBYTEINTEGERNAME FSYS = K'160055'
CONSTINTEGER EXAMINE = 0
CONSTINTEGER OUT = 2; ! 'MAP' OUTPUT STREAM
INTEGER CKSM, BC, LOADPT, STK, STR, I, J
INTEGER LOAD, N, STK STRT, CODEL, GLAL, LDL
INTEGER STK GAP, TSTK, CODE STRT
OWNINTEGER GLA STRT = K'20'; ! LEAVES 20 BYTES FOR ME
OWNINTEGER CODE BASE = K'40000'
CONSTINTEGER SUPER CODE BASE = K'1400'
OWNINTEGER U REF = 0
OWNINTEGER PROG FILE = 0
OWNINTEGER F BLOCK =- 1
RECORDFORMAT SEGDF(INTEGER TYPE, LEN)
RECORDFORMAT FBF(INTEGER S, BC, LD, BYTEINTEGERARRAY C
NAME(0:3), INTEGER SP, RECORD (SEGDF) ARRAY SEGDEF(0:7))
OWNRECORD (FBF)FB
CONSTINTEGER NO ACCESS = 4
CONSTINTEGER READ ONLY = 5
CONSTINTEGER READ WRITE = 6
CONSTINTEGER SHARED = 7
CONSTINTEGER GLA MAX = 11000, GLA MAXI = 5500
RECORDFORMAT GF(INTEGERARRAY C(0:GLA MAXI))
RECORDFORMAT GBF(BYTEINTEGERARRAY C(0:GLA MAX))
RECORD (GF) NAME GLAI
RECORD (GBF)GLA
RECORDFORMAT LFMF(STRING (8)NAME, BYTEINTEGER FLAG, INTEGER C
REF)
RECORDFORMAT R1F(RECORD (LFMF) NAME LFM)
RECORDFORMAT R2F(BYTEINTEGERNAME N)
RECORDFORMAT R3F(INTEGER X)
RECORD (R1F)R1
RECORD (R2F) NAME R2
RECORD (R3F) NAME R3
RECORDFORMAT GLA HEADF(INTEGERARRAY A(0:4), INTEGER CODES, C
STK LM, GLA END)
RECORD (GLA HEADF) NAME GLA HEAD
RECORDFORMAT REFF(INTEGER PT, INTEGER CODE, GLA)
RECORD (REFF) NAME REF
RECORDFORMAT STRDF(INTEGER R, N, G, BYTEINTEGER S, RP, UNIT, C
FSYS, BYTEINTEGERARRAY NAME(0:5), INTEGER BLOCK)
RECORDFORMAT STRPF(RECORD (STRDF) NAME STRD)
RECORD (STRDF) NAME STRD
CONSTRECORD (STRPF) NAME STRP1 = K'160034'
CONSTRECORD (STRPF) NAME STRP5 = K'160044'
CONSTINTEGERNAME STRP2 = K'160036'
RECORDFORMAT UNDEFF(STRING (8)NAME, BYTEINTEGER FLAG, C
INTEGER REF)
CONSTINTEGER LIB END = 2
CONSTINTEGER LIB FILE = 1
RECORDFORMAT P2F(BYTEINTEGER SERVICE, REPLY, INTEGER A1, C
BYTEINTEGERNAME A2, INTEGER A3)
OWNRECORD (UNDEFF) ARRAY UNDEFA(0:100)
OWNINTEGER UND PT = 0
CONSTINTEGER LIB ENTRIES = 41
RECORD (LFMF) ARRAY LIBA(0:LIB ENTRIES+1)
ROUTINESPEC FIX GLA HEADER
ROUTINESPEC DO REFS(INTEGER PT)
ROUTINESPEC CHECK REFS
ROUTINESPEC GET LIB(BYTEINTEGER FSYS)
ROUTINESPEC LOAD FILE
ROUTINESPEC FIX EXTERNALS(BYTEINTEGER FSYS)
ROUTINESPEC STUFF SEGS
ROUTINESPEC PUT BLOCK(RECORD (GBF) NAME C, INTEGER INIT, C
MAX)
ROUTINESPEC START BLOCK
ROUTINESPEC DIGEST(RECORD (GBF) NAME C)
ROUTINESPEC PUT DUMMY HEADER
ROUTINESPEC COPY HEADER(RECORD (FBF) NAME FB)
ROUTINE OCTAL(INTEGER N)
INTEGER I
SPACE
CYCLE I = 15, -3, 0
PRINTSYMBOL((N >> I)&7+'0')
REPEAT
END
INTEGERFN SYM
INTEGER N
READSYMBOL(N)
RESULT = N
END
INTEGERFN WORD
INTEGER N
N = SYM
RESULT = SYM << 8!(N&X'FF')
END
ROUTINE PUT(INTEGER I)
PRINTSYMBOL(I)
CKSM = CKSM+I
END
ROUTINE PUT WORD(INTEGER I)
PUT(I&X'FF'); PUT(I >> 8)
END
ROUTINE PLANT(INTEGER QUANT, ACCESS, INTEGERNAME SEGS)
INTEGER LEN, N
N = 0
UNTIL QUANT <= 0 CYCLE
N = N+1; LEN = QUANT
IF LEN > K'17777' THEN LEN = K'17777'
FB_SEGDEF(SEGS)_TYPE = ACCESS
FB_SEGDEF(SEGS)_LEN = LEN
QUANT = QUANT-LEN-1; SEGS = SEGS+1
REPEAT
END
INTEGERFN ROCTAL
INTEGER SUM, N, I
SUM = 0
SKIPSYMBOL WHILE NEXTSYMBOL = ' ' OR NEXTSYMBOL = NL
CYCLE
N = NEXTSYMBOL-'0'
RESULT = SUM IF N < 0 OR N > 7
SUM = SUM << 3+N
SKIPSYMBOL
REPEAT
END
GLAI == GLA
R2 == R1; R3 == R2
FB_NAME(I) = ' ' FOR I = 0, 1, 3
IF STRP2 = 0 START
STRD == STRP5_STRD
UNLESS STRD == NULL START
FB_NAME(I) = STRD_NAME(I) FOR I = 0, 1, 3
FINISH
STK = K'14000'
STR = K'5000'
ELSE
PROMPT('NAME?')
CYCLE I = 0, 1, 3
READSYMBOL(J)
EXITIF J = NL
FB_NAME(I) = J
REPEAT
PROMPT('STACK:')
STK = ROCTAL
IF STK = 0 THEN CODE BASE = SUPER CODE BASE
PROMPT('STREAMS:'); STR = ROCTAL
STR = STR*K'1030'+K'500'
FINISH
CODE STRT = 0
SELECT OUTPUT(1)
PUT DUMMY HEADER
STRD == STRP5_STRD
F BLOCK = STRD_BLOCK UNLESS STRD == NULL
SELECTOUTPUT(OUT)
PRINTSTRING('PROG:'); PRINTSYMBOL(FB_NAME(I)) FOR I = 0, 1, 3
NEWLINE
LOAD FILE
DO REFS(GLAL)
FIX EXTERNALS(FSYS)
FIX EXTERNALS(0)
STUFF SEGS
GLAI_C(0) = GLA HEAD_GLA END; ! ACTUAL TOP-OF-STACK WORD
IF STK = 0 THEN STK STRT = K'140000'; ! SPECIAL FOR SUPERVISOR
PUT BLOCK(GLA, STK STRT, GLAL)
START BLOCK
CHECK REFS
STOP
ROUTINE FIX GLA HEADER
R2_N == GLA_C(GLA STRT)
GLA HEAD == R1_LFM; ! POINT GLA RECORD AT GLA
GLA HEAD_CODES = CODE BASE+CODE STRT
GLA HEAD_STK LM = STK STRT
GLA HEAD_GLA END = STK STRT+GLAL
END
ROUTINE QUIT(STRING (20)S)
SELECT OUTPUT(0)
PRINTSTRING(S); NEWLINE
STOP
END
RECORD (UNDEFF) MAP GET LINK(RECORD (LFMF) NAME LFM)
INTEGER N
N = 0
IF UND PT # 0 START
CYCLE N = 0, 1, UND PT
RESULT == UNDEFA(N) IF UNDEFA(N)_NAME = LFM_NAME
REPEAT
FINISH
UNDEFA(N)_NAME = LFM_NAME; UND PT = UND PT+1
RESULT == UNDEFA(N)
END
ROUTINE FILL CHAIN(RECORD (LFMF) NAME LFM, INTEGER RADD)
INTEGERNAME LINK
RECORD (UNDEFF) NAME UNDEF
UNDEF == GET LINK(LFM); ! GET EXISTING, OR A NEW, CHAIN
IF UNDEF_FLAG = 1 START
PRINTSTRING(LFM_NAME); WRITE(UNDEF_FLAG, 2)
WRITE(LFM_FLAG, 2); SPACE
QUIT('*DOUBLE DEF?')
FINISH
WHILE UNDEF_REF # 0 CYCLE ; ! SEARCH THE ENTRIES
LINK == GLAI_C(UNDEF_REF >> 1)
UNDEF_REF = LINK; ! REMEMBER NEXT LINK
LINK = RADD; ! AND FILL IN THIS ONE
REPEAT
UNDEF_FLAG = 1
UNDEF_REF = RADD; ! REMEMBER ADDRESS FOR FUTURE USE
IF UNDEF_NAME = '#GO' THEN GLAI_C(1) = RADD
END
ROUTINE DO REFS(INTEGER PT)
CONSTSTRING (5) ARRAY TYPE(0:3) = C
'XDEF:', 'XREF:', 'DDEF:', 'DREF:'
RECORD (R2F) NAME R2
RECORD (R1F)R1
RECORD (LFMF) NAME LFM
RECORD (UNDEFF) NAME UNDEF
INTEGER I, N, P, Q, C, CTY, TYP, SHSF, PR
INTEGERNAME LINK
R2 == R1
C = 0; CTY = 0; ! FORMATTING VARIABLE FOR 'REFS'
SHSF = 0; ! SHARED CODE FLAG
CYCLE
R2_N == GLA_C(PT)
LFM == R1_LFM
EXITIF LENGTH(LFM_NAME) = 0
TYP = LFM_FLAG
IF TYP&1 # 0 START
!! REFERENCE
U REF = U REF+1
LFM_REF = LFM_REF+GLA STRT
! ADD IN BASE OF LOCAL GLA
UNDEF == GET LINK(LFM)
GLAI_C(LFM_REF >> 1) = UNDEF_REF
UNDEF_REF = LFM_REF IF UNDEF_FLAG = 0
! IE, NOT ALREDY DEFINED
!! IF IT EAS DEFINED, THEN FILL IN THE REFERENCE
!! OTHERWISE: CONSTRUCT LINKS THROUGH THE REFERENCES
IF C = 0 OR CTY # TYP START
C = 0; CTY = TYP
SPACES(2); PRINTSTRING(TYPE(TYP))
FINISH
PRINTSTRING(LFM_NAME); SPACES(10-LENGTH(LFM_NAME))
IF C = 4 THEN C = 0 AND NEWLINE ELSE C = C+1
ELSE
!! DEFINITION
NEWLINE IF C # 0; C = 0
P = LFM_REF+GLA STRT; ! P IS THE ARRAY INDEX OF ITEM
Q = P+STK STRT+(2-TYP&127); ! Q IS THE REAL ADDRESS OF ITEM
PR = Q
R2_N == GLA_C(P)
REF == R1_LFM; ! REF POINTS TO BEGINNING OF
! THE 3 WORDS
IF TYP&127 = 0 START ; ! FOR ROUTINE REFS ONLY
REF_PT = Q
IF TYP = 0 START
REF_CODE = REF_CODE+CODE BASE+CODE STRT
PR = REF_CODE
ELSE
SHSF = 1
FINISH
REF_GLA = GLA STRT+STK STRT
FINISH
FILL CHAIN(LFM, Q); ! DEAL WITH UNDEFINEDS
SPACES(2)
PRINTSTRING(TYPE(TYP&127)); OCTAL(PR); SPACES(2)
PRINTSTRING(LFM_NAME); NEWLINE
FINISH
PT = PT+12
REPEAT
NEWLINE IF C # 0
FIX GLA HEADER IF SHSF = 0; ! NOT IN CASE OF SHARED FILE
END
ROUTINE CHECK REFS
INTEGER N
RECORD (UNDEFF) NAME UNDEF
SELECT OUTPUT(0)
N = 0
WHILE N <= UNDPT-1 CYCLE
UNDEF == UNDEFA(N)
IF UNDEF_FLAG = 0 START
PRINTSTRING(UNDEF_NAME); PRINTSTRING(' UNDEFINED!
')
FINISH
N = N+1
REPEAT
END
ROUTINE GET LIB(BYTEINTEGER FSYS)
CONSTBYTEINTEGERARRAY LIB(0:5) =
'L', 'I', 'B', '0', '0', '0'
RECORD (P2F)P2, P3
RECORDFORMAT FILEF(BYTEINTEGER UNIT, FSYS, C
BYTEINTEGERARRAY NAME(0:5))
RECORD (FILEF)FILE
RECORDFORMAT F1F(BYTEINTEGER X)
RECORD (F1F) NAME F1
F1 == LIBA(0)
FILE_NAME(I) = LIB(I) FOR I = 0, 1, 5
FILE_FSYS = FSYS; FILE_UNIT = 0
LIBA(0)_FLAG = LIB END; ! PROTECTION AGAINST NO LIB
P2_SERVICE = 4; P2_REPLY = ID
P2_A1 = EXAMINE; P2_A2 == FILE_UNIT
PONOFF(P2)
IF P2_A1 = 0 THENRETURN
P3_SERVICE = 3; P3_REPLY = ID
P3_A1 = 0; ! READ BLOOCK
P3_A2 == F1_X
P3_A3 = P2_A1
PONOFF(P3)
END
ROUTINE LOAD FILE
INTEGER PHY ADD, LINO
SELECT INPUT(1)
READSYMBOL(I) UNTIL I = 1; SKIPSYMBOL
BC = WORD; LOAD PT = WORD
CODEL = WORD+CODE STRT; GLAL = WORD+GLA STRT; LDL = WORD
IF PROG FILE = 0 START
TSTK = STK+GLAL+K'100'; ! WITH EXTRA FOR EXT GLAS
STK GAP = K'160000'-TSTK
STK STRT = STK GAP&K'160000'
IF STK STRT = K'40000' START
SELECT OUTPUT(0); PRINTSTRING('STACK OVERFLOW?
')
SELECT OUTPUT(OUT)
STK STRT = K'60000'
FINISH
IF STK = 0 THEN STK STRT = (CODE BASE+CODEL+K'77')&K'177700'
!! SUPERVISOR GLA ON END OF CODE
FINISH
PROG FILE = PROG FILE+1
PHY ADD = CODE STRT+CODE BASE
PRINTSTRING(' CODE:'); OCTAL(PHY ADD)
PRINTSTRING(' GLA:'); OCTAL(GLA STRT+STK STRT)
NEWLINE
IF GLAL > GLA MAX THEN QUIT('GLA BUFFER OVERFLOW')
SKIPSYMBOL AND BC = BC-1 UNTIL BC = 11
! INCLUDE CKSM
CYCLE
READSYMBOL(I) UNTIL I = 1; SKIPSYMBOL
BC = WORD
EXITIF BC = 6
LOAD = WORD
IF BC < 6 THEN QUIT('FILE FORMAT ERROR')
IF LOAD >= 0 START
SELECT OUTPUT(1)
CKSM = 0
PUT WORD(1); PUT WORD(BC)
PUT WORD(LOAD+PHY ADD)
DIGEST(NULL)
PRINTSYMBOL(-CKSM)
LINO = WORD; PUT WORD(LINO)
PRINTSYMBOL(0); PRINTSYMBOL(0)
SELECT OUTPUT(OUT)
ELSE
LOAD = LOAD&K'77777'+GLA STRT
DIGEST(GLA)
FINISH
REPEAT
END
ROUTINE ARRANGE FOR LOAD(RECORD (LFMF) NAME LIB)
RECORD (STRDF) NAME STRD
SELECT INPUT(1)
CLOSE INPUT
STRD == STRP1_STRD
STRD_FSYS = LIB_REF; ! COPY FILE SYSTEM NUMBER
STRD_NAME(I) = CHARNO(LIB_NAME, I+1) FOR I = 0, 1, 5
END
ROUTINE FIX EXTERNALS(BYTEINTEGER FSYS)
INTEGER FLAG, I
RECORD (LFMF) NAME LIB, LIBN
RECORD (UNDEFF) NAME UNDEF
RETURNIF UREF = 0
GET LIB(FSYS)
FLAG = 1; N = 0
WHILE N <= UND PT-1 CYCLE
UNDEF == UNDEFA(N)
IF UNDEF_FLAG = 0 START
CYCLE I = 0, 1, LIB ENTRIES
LIB == LIBA(I)
EXITIF LIB_FLAG = LIB END
IF LIB_FLAG = LIB FILE START
LIBN == LIB
CONTINUE
FINISH
IF UNDEF_NAME = LIB_NAME START
IF LIB_FLAG&128#0 START ; ! SHARED ENTRY
FILL CHAIN(LIB, LIB_REF); ! DEAL WITH IT NOW
CONTINUE
FINISH
PRINTSTRING('FILE:'); PRINTSTRING(LIBN_NAME)
NEWLINE
ARRANGE FOR LOAD(LIBN)
! SET THE STREAM UP
CODE STRT = CODEL
IF STK=0 AND PROG FILE=1 THEN C
CODE STRT=K'61000'-SUPER CODE BASE
GLA STRT = GLAL
LOAD FILE
DO REFS(GLAL)
EXIT
FINISH
REPEAT
FINISH
N = N+1
REPEAT
END
ROUTINE STUFF SEGS
INTEGER SS, SEGPT, TSTK, SEG, DIFF, SS2
TSTK = STK+GLAL; ! WORK IT OUT AGAIN
IF TSTK+STK STRT > K'160000' THEN TSTK = K'160000'-STK STRT
SS = (K'160000'-TSTK)>>13; SS2 = STK STRT>>13
PRINTSTRING('
TOTALS: CODE =')
OCTAL(CODEL)
PRINTSTRING(' GLA/STACK ='); OCTAL(TSTK); NEWLINE
SEGPT = 1
FB_SEGDEF(0)_TYPE = 4
FB_SEGDEF(1)_TYPE = SHARED; FB_SEGDEF(1)_LEN = 0
SEG = 2
PLANT(CODEL+4, READ ONLY, SEG)
IF SEG > SS2 AND STK # 0 THEN QUIT("VIRTUAL MEMORY TOO SMALL")
WHILE SEG < SS2 CYCLE
FB_SEGDEF(SEG)_TYPE = NO ACCESS
SEG = SEG+1
REPEAT
PLANT(TSTK, READ WRITE, SEG)
IF SS # SS2 START
FB_SEGDEF(SEG)_TYPE = NO ACCESS; SEG = SEG+1
FINISH
PLANT(STR, READ WRITE, SEG)
FB_S = 1
FB_BC = 8*4+6+4+2
FB_LD = 0
FB_SP = STK STRT+TSTK-2
COPY HEADER(FB)
END
ROUTINE PUT BLOCK(RECORD (GBF) NAME C, INTEGER INIT, MAX)
INTEGER I
SELECT OUTPUT(1)
CKSM = 0
PUT(1); PUT(0); PUT WORD(MAX+6)
PUT WORD(INIT)
CYCLE I = 0, 1, MAX-1
PUT(C_C(I))
REPEAT
PUT(-CKSM)
PUT WORD(0)
SELECT OUTPUT(OUT)
END
ROUTINE START BLOCK
SELECT OUTPUT(1)
CKSM = 0
PUT WORD(1); PUT WORD(6); PUT WORD(-1)
PUT(-CKSM)
SELECT OUTPUT(OUT)
END
ROUTINE DIGEST(RECORD (GBF) NAME C)
INTEGER N
CYCLE BC = BC-7, -1, 0
READSYMBOL(N)
IF C == NULL START
PRINTSYMBOL(N); CKSM = CKSM+N
ELSE
C_C(LOAD) = N; LOAD = LOAD+1
FINISH
REPEAT
SKIPSYMBOL; ! THE CHECKSUM
END
ROUTINE PUT DUMMY HEADER
INTEGER I
PRINTSYMBOL(0) FOR I = 1, 1, 47
END
ROUTINE COPY HEADER(RECORD (FBF) NAME FB)
RECORDFORMAT RX2F(BYTEINTEGER X)
RECORD (RX2F) NAME RX2
RECORD (FBF) NAME RX
RECORD (P2F)P3
RX == LIBA(0)
RX2 == RX
QUIT('NO OUTPUT FILE') IF FBLOCK = -1
SELECT OUTPUT(1)
PRINTSYMBOL(0) FOR I = 1, 1, 512-60
SELECT OUTPUT(OUT)
P3_SERVICE = 3; P3_REPLY = ID
P3_A1 = 0
P3_A2 == RX2_X
P3_A3 = F BLOCK
PONOFF(P3); ! READ THE FIRST BLOCK AGAIN
QUIT('READ DISC FAILS') IF P3_A1 # 0
RX = FB; ! COPY NEW HEADER
P3_SERVICE = 3; P3_REPLY = ID
P3_A1 = 1; ! WRITE
P3_A2 == RX2_X
P3_A3 = FBLOCK
PONOFF(P3); ! AND WRITE THE BLOCK OUT
QUIT('WRITE DISC FAILS') IF P3_A1 # 0
END
ENDOFPROGRAM