! file 'sys_sbld5s'
!*************************************
!* sbld15s                           *
!* date:  25.feb.82                  *
!* supervisor build program          *
!************************************
! prep options are:-
!                    e - emas imp
!                    d - deimos imp
#if ~(e!d)
   #report Must specify e OR d
   #abort
#fi
#if e
   #report Preparing Emas version
#else
   #report Preparing Deimos version
#fi

%conststring (13) vsn = "Sup Bld...1a
"

#if d
%constintegername dummy == 0
%constintegername nulli == 0




%include "deimosperm"
%control 1

%begin
#else

%externalroutine supbuild(%string (255) ss)

      %externalroutinespec define(%string (255) s)
      %externalroutinespec prompt(%string (17) s)
      %externalintegerfnspec smaddr(%integer chan, %integername len)
      %externalroutinespec newsmfile(%string (255) s)
      %externalroutinespec destroy(%string (255) s)
#fi


     %routinespec write out file
     %routinespec fill ints
     %routinespec print rest of line
     %integerfnspec roctal
     %routinespec octal(%integer x)
     %integerfnspec word

      %owninteger file address, filemax

      %constinteger no of discs = 4
      %conststring (4) %array discs(0:no of discs) = %c
      "RK05", "RL01", "TU58", "RX02", "RK07"



     %constinteger int6base = k'40'

     %integer i, n, pos, bc, loadpt, block, fno, glaf, lbl, tgla
     %integer top, code b, stk l, x, sup top, start top, cksm
      %integer type2, len2,len6, seg7 len, new prog, init pc, io seg

      %owninteger dedloc = k'115000', odedloc = k'115000'

     %constbyteintegerarray sera(0:4) = 3, 0, 8, 0, 28; ! ser nos for disc units
     %owninteger ser = 3;                    ! normally unit 0 or 1

      %string (25) s, a1, a2, a3
      %string (63) file
      %integer disct


     %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)

   #if d
   %recordformat sf(%integer type, len)
   %recordformat initblf(%integer n1, n2, sp, %record (sf) %array seg(0:7))
   #else
      %recordformat initblf(%byteintegerarray a(0:54))
   #fi

   %record (initblf) initbl

   %recordformat tf(%byteintegerarray a(0:100))
   %record (tf) %name tff
      %routinespec readstring(%string (*) %name s)
      %byteintegermapspec core(%integer n)
      %routinespec corei(%integer n, cont)
      %integerfnspec xcorei(%integer n)




      #if e
      %unless ss -> a1.("/").a2.(",").a3 %start
         printstring("Params: In/out,list
")
         %stop
      %finish
      define("1,".a1); define("4,".a2); define("3,".a3)
      define("5,map")
      #fi

      #if e
      destroy("Data")
      newsmfile("Data,60000")
      define("27,Data")
      file address = smaddr(27, filemax)
      %if file address = 0 %start
         printstring("Failed to connect sm file - data
")
         %stop
      %finish
      #fi
     fno = 0;                          ! file being read in
      core(x) = 0 %for x = 0, 1, file max
      %cycle x = 4, 4, k'774'
         corei(x, x+2);           ! trap catcher in lower store
      %repeat
     x = 0;  sup top = 0

     select input(1)
      #if d
      select output(1)
      #else
      select output(3)
      #fi
      printstring(vsn)
     %cycle; readsymbol(i); printsymbol(i); %repeat %until i=nl
      #if d
      prompt("Disc?")
      readstring(s); printstring(s); newline
      %cycle disct = 0, 1, no of discs
         -> found %if s = discs(disct)
      %repeat
      select output(0)
      printstring("disc'"); printstring(s); printstring("' not known
")
      %stop
found:
      #fi
      printstring("
                         code     gla     gla end      pc       dedloc
")
     %cycle
        prompt("file:")
        skipsymbol %while nextsymbol < 'A'
         file = ""
         %cycle
            i = nextsymbol
            %exit %if i = ' ' %or i = nl
            file = file.tostring(i)
            skipsymbol
         %repeat
         %if file = "END" %or file = "end" %start

           fill ints
           %cycle
              prompt("patch?")
              i = roctal
              %if nextsymbol = 'S' %start
                  skipsymbol
                  printstring("
supervisor loads from 000000 to ")
                  octal(top)
                  printstring("
top of store is determined at run time
")
                  write out file
                  %stop
               %finish

              octal(i);  printsymbol(':');  octal(core(i)!core(i+1)<<8)
              %if nextsymbol = '=' %start
                 skipsymbol
                 n = roctal
                 printstring("->");  octal(n)
                 corei(i, n)
              %finish
              print rest of line
           %repeat
        %finish



         define("2,".file)
        pos = last
        !! defaulted to end of last file

        corei(dedloc, pos)
                                       ! now read in the file

        block = 0
        select input(str)
        glaf = 0;  lbl = 0; tgla = 0; top = 0; newprog = 0; init pc = 0
        %if fno = 0 %then code b = 0 %else code b = k'40000'
        %cycle
           readch(i) %until i = 1;  readch(i)
           bc = word-6
           load pt = word
           %if bc = 0 %start
               init pc = load pt
               %exit
            %finish
!           %if load pt = k'61000' %then suptop = top
!           !! start code is at 61000, retain current top for later

           %if fno <= 2 %start; ! supnewy, shared, perm2y
              %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
           %finish %else %start
              %if lbl = 0 %start;   ! task descriptor
                 lbl = 1
                 tff == initbl
                 %cycle n = 0, 1, bc-1
                    readch(i); tff_a(n) = i
                 %repeat
                 readch(i)
                 type2 = initbl_a(14)
                 len2  = initbl_a(16) + (initbl_a(17)<<8)
                 len6  = (initbl_a(32) + (initbl_a(33)<<8)+k'77')&k'177700'
write(type2, 1); write(len2, 1); write(len6, 1); newline
                  %if initbl_a(6) = 7 %start;   ! new comp prog
                     seg7 len = initbl_a(36)+(initbl_a(37)<<8)
                                        ! nb: progs must have .codeseg 2
                                        !     for reason see 'sinnew'
                     glaf = (last+len2+k'77')&k'177700'
                     tgla = glaf+len6+seg7 len
                     ioseg = glaf+len6
                     new prog = 1
write(len2, 1); space; octal(tgla); space; octal(seg 7 len); newline
                  %finish %else %start

                     %if type2 = 5 %start
                         new prog = 0
                         glaf = (last+len2+k'77')&k'177700'
                         tgla = glaf+len6
                      %finish %else %start
                         select output(0)
                         printstring("Seg 2 has a type of:")
                         write(type2, 1); newline
                         %stop
                      %finish
                  %finish
                  %continue
                 %continue
              %finish
              %if loadpt&k'100000' # 0 %start
!                  %if sup top# 0 %start
!                     start top = top; top = sup top; sup top = 0
!                  %finish

                  %if new prog # 0 %and loadpt&k'160000'=k'160000' %start
                                        ! new compiler - include i/o preset
                     loadpt = loadpt-k'160000'+io seg
                  %finish %else %start
                     loadpt = loadpt-k'140000'+glaf
                  %finish
              %finish %else %start
                 loadpt = loadpt-code b+pos
              %finish
           %finish
           %cycle bc = bc, -1, 1
              readch(i)
              core(load pt) = i;  load pt = load pt+1
           %repeat
           readch(i); ! the checksum
           block = block+1
           !! block read
           top = load pt %unless load pt < top
        %repeat
        printstring("File:")
        printstring(file)
        spaces(19-length(file))
        octal(pos);  spaces(3);  octal(glaf)
        %if tgla # 0 %then top = tgla;   !  tgla is now the last position
        spaces(3);  octal(top)
        spaces(3); octal(init pc)
        spaces(5);  octal(dedloc)
        newline
        last = (top+k'77')&k'177700'
        !! include the space for 'stack'
                                       ! to next block
        corei(dedloc+2, glaf)
        corei(dedloc+8, last);      ! actually 1st position of next set
        %if new prog = 0 %then ioseg = last
        corei(dedloc+4, ioseg)
         %if new prog # 0 %start
           corei(dedloc+6, init pc)
            corei(k'160112', x'000a');    ! newline for loading
         %finish
        dedloc = dedloc+8
         %if last > o dedloc %start
            select output(0)
            printstring("The store image is overwriting the dedicated area !
")
            select output(1)
         %finish
        #if d
        close input
        #else
        select input(1)
        close stream(str)
        #fi
        select input(1)
        fno = fno+1
     %repeat


      %routine read string(%string (*) %name s)
         %integer i, n
         s = ""
         %cycle
            readsymbol(i); %return %if i = nl;  ! not included
            s = s.tostring(i)
         %repeat
      %end
      %byteintegermap core(%integer n)
         %integer i,j
         %if n > filemax %start
            select output(0)
            printstring("Store address is overwriting the end of sm file
")
            newline; %stop
         %finish
         %result == byteinteger(fileaddress+n)
      %end

      %routine corei(%integer n, cont)
         core(n) = cont&x'ff'
         core(n+1) = cont>>8&x'ff'
      %end

      %integerfn xcorei(%integer n)
         %result = core(n)+core(n+1)<<8
      %end



      %routine put(%integer n)
         #if d
         printsymbol(n)
         #else
         printch(n)
         #fi
         cksm = cksm+n
      %end

     %routine fill ints
        %integer int, ad, base, x
         base = xcorei(int6base);      ! 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
            PRINTSTRING("Int:")
           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
           corei(ad, base+x)
           corei(ad+2, 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 write out file
        %integer i, flag, n, block
        %recordformat pf(%byteinteger service, reply, %integer a1, %c
          %integername a2, %integer a3)
        %record (pf)p
         %switch sw(0:no of discs)

         corei(odedloc, last)
         flag = 'F'
         #if d
         skipsymbol; skipsymbol;    ! skip the s and nl
        prompt("where?")
        readsymbol(flag)
        printstring("
put on unit ")
         %if '0' <= flag <= '4' %start
            printsymbol(flag); newline
         %finish %else %start
            printstring("0, flag:"); printsymbol(flag); newline
         %finish
         block = 0
         %if flag = '0' %then block = 1
         -> sw(disct)

sw(0):   ! rk05
         %if flag = 'T' %then block = 4600
         %if flag = '1' %then block = 1!k'020000'
         -> try it

sw(1):   ! rl01
         %if flag = '4' %start
            block = 1; ser = sera(4)
         %finish
         -> try it

sw(2):   ! tu58
         %if flag = '0' %then block = 0;! illegal
         %if flag = '2' %start
            block = 8; ser = sera(2)
         %finish
         -> try it

sw(3):   ! rx02
         %if flag = '0' %then block = 16
         %if flag = '1' %then block = 16!k'020000'
         ->try it

sw(4):   ! rk07
         %if flag = '2' %then ser = sera(2) %and block = 26804

try it:

      %if flag # 'F' %start
         %if block = 0 %start
            select output(0)
            printstring("
That position is illegal for that disc
")
            %stop
         %finish

        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
      %finish

        %cycle i = 0, 1, k'66'-1
           %cycle n = 0, 1, 255
              buff(n) = corei(i*256+n
           %repeat
         %if flag # 'F' %start
           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

         %finish %else %start
         #else
         %cycle i = 0, 1, o dedloc>>9
         #fi
            select output(4)
            cksm = 0
            n = i<<9
            put(1); put(0)
            put((512+6)&x'ff'); put((512+6)>>8)
            put(0); put(n>>8)
            %cycle n = 0, 1, 511
               put(core(i*512+n))
            %repeat
   
            put(-cksm); put(0); put(0)
            select output(0)
         #if d
         %finish
         #fi
        %repeat
         %if flag = 'F' %start
            select output(4)
            cksm = 0
            put(1); put(0)
            put(6); put(0)
            put(k'1324'&x'ff'); put(k'1324'>>8); ! start address = k'1324'
            put(-cksm); put(0); put(0)
            select output(0)
         %finish
        printstring("core image written
")
        select output(0)
     %end


     %integerfn word
        %integer n, m
        readch(n);  readch(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

#if d
%endofprogram
#else
%end
%endoffile
#fi