!**********
!* SBLD13S *
!* NB: NOT SAME AS BPL SBLD1S !!!!
!* DATE: 17.MAR.80 *
!* SUPERVISOR BUILD PROGRAM *
!*************************************
PERMROUTINESPEC SVC(INTEGER EP, INTEGERNAME P1, INTEGER P2)
PERMINTEGERMAPSPEC INTEGER(INTEGER X)
PERMBYTEINTEGERMAPSPEC BYTEINTEGER(INTEGER X)
PERMINTEGERFNSPEC ADDR(INTEGERNAME X)
PERMINTEGERFNSPEC ACC
CONSTINTEGERNAME DUMMY = 0
CONSTINTEGERNAME NULLI = 0
BEGIN
!* STK = 76000, STRM = 3
ROUTINESPEC WRITE OUT FILE
ROUTINESPEC FILL INTS
ROUTINESPEC PRINT REST OF LINE
ROUTINESPEC MOVE 400 AND PLANT DKF
INTEGERFNSPEC ROCTAL
ROUTINESPEC OCTAL(INTEGER X)
INTEGERFNSPEC WORD
RECORDFORMAT STRDF(INTEGER A, B, C, BYTEINTEGER D, E, UNIT, C
FSYS, BYTEINTEGERARRAY NAME(0:5))
RECORDFORMAT STRPF(RECORD (STRDF) NAME ST)
RECORDFORMAT COREF(INTEGERARRAY CORE(0:K'34400'))
RECORDFORMAT CORE2F(BYTEINTEGERARRAY CORE(0:K'71000'))
RECORD (COREF) NAME CI
RECORD (CORE2F)CB
CONSTRECORD (STRPF) NAME STRP2 = K'160036'
CONSTBYTEINTEGERNAME ID = K'160030'
RECORD (STRDF) NAME STRD
OWNINTEGER SUPER CODE BASE
CONSTINTEGER INT6BASE = K'40'
INTEGER I, N, POS, DEDLOC, BC, LOADPT, BLOCK, FNO, GLAF, LBL
INTEGER TOP, CODE B, STK L, X, SUP TOP, START TOP
CONSTBYTEINTEGERARRAY SERA(0:4) = 3, 3, 0, 0, 28; ! SER NOS FOR DISC UNITS
OWNINTEGER SER = 3; ! NORMALLY UNIT 0 OR 1
OWNINTEGER STR = 2, LAST = 0, ELEVEN45 = 0
CONSTINTEGERARRAY DKF(0:8) = K'000005', K'000240', K'012706', C
K'001300', K'013701', K'060004', K'016101', K'000002',
K'004731'
INTEGERARRAY BUFF(0:255)
FNO = 0; ! FILE BEING READ IN
CI == CB
CB = 0
X = 0; SUP TOP = 0
STRD == STRP2_ST; ! MAP TO STREAM(2) DESCRIPTOR
SELECT INPUT(1)
SELECT OUTPUT(1)
UNTIL I=NL CYCLE ; READSYMBOL(I); PRINTSYMBOL(I); REPEAT
PROMPT("SUPER CODE BASE?")
SUPER CODE BASE = ROCTAL
OCTAL(SUPER CODE BASE); NEWLINE
CYCLE
PROMPT('FILE:')
SKIPSYMBOL WHILE NEXTSYMBOL < 'A' OR NEXTSYMBOL > 'Z'
STRD_NAME(I) = ' ' FOR I = 0, 1, 5
CYCLE I = 0, 1, 5
READSYMBOL(N)
IF N = NL OR N = ' ' THENEXIT
STRD_NAME(I) = N
REPEAT
IF I = 3 AND STRD_NAME(0) = 'E' AND STRD_NAME(1) = 'N' C
AND STRD_NAME(2) = 'D' START
FILL INTS
CYCLE
PROMPT('PATCH?')
I = ROCTAL
IF NEXTSYMBOL = 'S' START
PRINTSTRING("
SUPERVISOR LOADS FROM 000000 TO ")
OCTAL(LOAD PT)
PRINTSTRING(" AND 60000 TO ")
OCTAL(START TOP)
PRINTSTRING("
TOP OF STORE IS DETERMINED AT RUN TIME
")
MOVE 400 AND PLANT DKF
WRITE OUT FILE
STOP
FINISH
BC = I >> 1
OCTAL(I); PRINTSYMBOL(':'); OCTAL(CI_CORE(BC))
IF NEXTSYMBOL = '=' START
SKIPSYMBOL
N = ROCTAL
PRINTSTRING('->'); OCTAL(N)
CI_CORE(BC) = N
FINISH
PRINT REST OF LINE
REPEAT
FINISH
POS = LAST
!! DEFAULTED TO END OF LAST FILE
IF NEXTSYMBOL = NL THEN PROMPT('DED LOC?')
DEDLOC = ROCTAL
STK L = ROCTAL; ! GET THE STACK LEN
IF NEXTSYMBOL = 'N' THEN DEDLOC = 0
SKIPSYMBOL
CI_CORE(DEDLOC >> 1) = POS IF DEDLOC # 0
! NOW READ IN THE FILE
BLOCK = 0
SELECT INPUT(STR)
GLAF = 0; LBL = 0
IF F NO = 1 START
CODE B = SUPER CODE BASE; ! LOADS AT REAL ADDRESS
POS = SUPER CODE BASE; ! MUST AGREE WITH PARAM AT LINK T
ELSE CODE B = K'40000'
CYCLE
READSYMBOL(I) UNTIL I = 1; SKIPSYMBOL
BC = WORD-6
EXITIF BC = 0; ! FINISHED
LOAD PT = WORD
IF LOAD PT = K'61000' THEN SUPTOP = TOP
!! START CODE IS AT 61000, RETAIN CURRENT TOP FOR LATER
IF FNO = 0 OR FNO = 2 START ; ! BRUN & PERM
IF FNO=2 AND LOAD PT >= K'20000' C
THEN LOADPT=LOADPT-K'020000'
!! PERM 'PERM11S' ONWARSS IS AT 20000 (VIRTUAL)
LOAD PT = LOADPT+POS
ELSE
X=LOAD PT IF FNO = 1
IF LBL = 0 START ; ! TASK DESCRIPTOR
LBL = 1
SKIPSYMBOL AND BC = BC-1 UNTIL BC = 0
CONTINUE
FINISH
IF LOADPT&K'100000' # 0 START
IF SUP TOP# 0 START
START TOP = TOP; TOP = SUP TOP; SUP TOP = 0
FINISH
IF GLAF = 0 THEN GLAF = (TOP+K'77')&K'177700'
LOADPT = LOADPT-K'140000'+GLAF
ELSE
LOADPT = LOADPT-CODE B+POS
FINISH
FINISH
CYCLE BC = BC, -1, 0
READSYMBOL(I)
CB_CORE(LOAD PT) = I; LOAD PT = LOAD PT+1
REPEAT
BLOCK = BLOCK+1
!! BLOCK READ
TOP = LOAD PT
REPEAT
PRINTSYMBOL(STRD_NAME(I)) FOR I = 0, 1, 5
SPACES(2)
OCTAL(POS); SPACES(3); OCTAL(GLAF)
SPACES(3); OCTAL(LOAD PT)
SPACES(5); OCTAL(DEDLOC)
NEWLINE
LAST = (LOAD PT+STK L+K'77')&K'177700'
!! INCLUDE THE SPACE FOR 'STACK'
! TO NEXT BLOCK
IF DEDLOC # 0 START
CI_CORE(DEDLOC >> 1+1) = GLAF
CI_CORE(DEDLOC >> 1+2) = LAST
FINISH
CLOSE INPUT
SELECT INPUT(1)
FNO = FNO+1
REPEAT
ROUTINE FILL INTS
INTEGER INT, AD, BASE, X
BASE = CI_CORE(INT6BASE>>1); ! FIND ADDRESS OF INT -6
PRINTSTRING("
RESETTING OF INTERRUPT NUMBERS AND VECTORS
")
CYCLE
PROMPT("INT:")
READ(INT); RETURN IF INT=0
AD = ROCTAL; ! FIND ITS VECTOR ADDRESS
WRITE(INT, 2); PRINTSTRING(" VECTOR:")
OCTAL(AD)
IF INT > -6 START
PRINTSTRING("ERROR - INTS FROM 0 TO -5 ARE FIXED IN FILE BRUN
")
CONTINUE
FINISH
X = (-6-INT)*8; ! INDEX FROM NO -6
IF INT < -10 THEN X = X+4; ! INT -10 (BPTINT IS LENGTH 12
CI_CORE(AD>>1) = BASE+X
CI_CORE(AD>>1+1) = K'340'
PRINTSYMBOL('('); OCTAL(X+BASE); PRINTSYMBOL(')')
PRINT REST OF LINE
REPEAT
END
ROUTINE PRINT REST OF LINE
INTEGER I
SPACES(3)
CYCLE
READSYMBOL(I); PRINTSYMBOL(I)
RETURN IF I = NL
REPEAT
END
ROUTINE MOVE 400 AND PLANT DKF
!! THE AREA AT 400 IS MOVED TO K'060120' ONWARDS
!! AND THE INITIALISER IN 'DKF' IS MOVED INTO 400
!! IT IS ASSUMED THAT SUPERVIROR INITIALISER MOVES IT BACK
INTEGER I, N
CYCLE I = 0, 1, 20; ! MOVE 20 WORDS
CI_CORE((K'060120'>>1)+I) = CI_CORE((K'000400'>>1)+I)
REPEAT
!! NOW MOVE IN DKF
CYCLE I = 0, 1, 8
CI_CORE((K'400'>>1)+I) = DKF(I)
REPEAT
END
ROUTINE WRITE OUT FILE
INTEGER I, FLAG, N, BLOCK
RECORDFORMAT PF(BYTEINTEGER SERVICE, REPLY, INTEGER A1, C
INTEGERNAME A2, INTEGER A3)
RECORD (PF)P
PROMPT('DISC?')
READSYMBOL(FLAG) UNTIL FLAG = '0' OR FLAG = '1'
PRINTSTRING('
PUT ON UNIT ')
IF FLAG = '1' START
BLOCK = 14!K'020000'
PRINTSTRING('1
')
ELSE
IF FLAG = 'T' START
PRINTSTRING("0 ON SITE # 2
")
BLOCK = 4600
ELSE
IF FLAG = '4' START
SER = SERA(4); BLOCK = 1
PRINTSTRING("4 ON BOTTOM SITE
")
ELSE
BLOCK = 14; ! WAS 4600
PRINTSTRING('0
')
FINISH
FINISH
FINISH
CI_CORE(K'60000'//2) = LAST
P_SERVICE = SER; P_REPLY = ID
P_A1 = 0; P_A2 == NULLI; P_A3 = 0
PONOFF(P); ! TURN DK TEST OFF
IF P_A1 # 9 START
SELECT OUTPUT(0)
PRINTSTRING("
*** FAILED TO TURN DISC WRITE CHECK OFF
")
STOP
FINISH
CYCLE I = 0, 1, K'71'-1
CYCLE N = 0, 1, 255
BUFF(N) = CI_CORE(I*256+N)
REPEAT
P_SERVICE = SER; P_REPLY = ID
P_A1 = 1; ! WRITE
P_A3 = BLOCK+I
P_A2 == BUFF(0)
PONOFF(P)
IF P_A1 # 0 START
SELECT OUTPUT(0)
PRINTSTRING("
*** FAILED TO WRITE BLOCK TO DISC
")
STOP
FINISH
REPEAT
PRINTSTRING('CORE IMAGE WRITTEN
')
SELECT OUTPUT(0)
PRINTSTRING("NOW IPL
")
END
INTEGERFN WORD
INTEGER N, M
READSYMBOL(N); READSYMBOL(M)
RESULT = M << 8!N
END
ROUTINE OCTAL(INTEGER X)
INTEGER I
CYCLE I = 15, -3, 0
PRINTSYMBOL((X >> I)&7+'0')
REPEAT
END
INTEGERFN ROCTAL
INTEGER I, N, SUM
SUM = 0
SKIPSYMBOL WHILE NEXTSYMBOL = ' ' OR NEXTSYMBOL = NL
CYCLE
N = NEXTSYMBOL
RESULT = SUM IF N < '0' OR N > '7'
SUM = (SUM << 3)!(N-'0')
SKIPSYMBOL
REPEAT
END
ENDOFPROGRAM