!**********
!* 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 = 'T' OR  FLAG = '0' OR  FLAG = '1' OR  FLAG='4'
        PRINTSTRING('
PUT ON UNIT ')
        IF  FLAG = '1' START 
           BLOCK = 1!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 = 1;                  ! 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