! FILE 'SBLD3KS'
!**********
!* 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 = 'R'
        PRINTSTRING('
PUT ON UNIT ')
        %IF FLAG = 'R' %START
           BLOCK = 9201
           PRINTSTRING('0 ON RL01 TOP SITE (BLOCK=9200)
')
        %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