! file 'fep_buff3'
!*******************************
!* emas-2900   buffer manager *
!*     file: buff5 (fep)      *
!*     date: 19 sep 84        *
!******************************

!! stk = size+200
%control 1
%include "deimosperm"


%begin
%conststring (9) vsn = "Buff..5a"

     %recordformat bf(%integer buff no, len,  %byte owner, mode, %c
       %byteintegerarray a(0:240))

     %recordformat qf(%record (bf) %name l)
     %recordformat pe(%byteinteger ser, reply, fn, port, %c
       %integer buff no, %byteinteger len, s1)

     %constinteger request buffer = 0
     %constinteger release buffer = 1
    %constinteger get buffer base = 2


     %constinteger t3 ser = 21

     %constinteger ser no = 17
     %constintegername ps == k'017776';   ! IN seg 0 (psw)


     %constinteger no of big = 200, big l = 320, big inc = 5
     %constinteger no of small = 204, small l = 128, small inc = 2
      ! Note:   The number of big buffers is not correct.
      !         They will be alocated until there is no more space


     %recordformat holdbf(%record (holdbf) %name l, %integer buff no)

     !!        5*small = big
     %constinteger ql = 23;            ! size of 'request' queue
     %ownrecord (qf) %name free big
     %ownrecord (qf) %name free small
     %ownrecord (holdbf) %name free h
     %owninteger nb
     %owninteger ns
     %owninteger qq
     %owninteger lb
     %owninteger ls
     %owninteger br
     %owninteger sr
     %owninteger queued
     %owninteger big start
     %owninteger delay = 180*6;       ! 180 mins
      %owninteger dcou

     %ownrecord (holdbf) %name h
     %ownrecord (holdbf) %array ha(0:no of big+no of small)
     %ownrecord (pe) %array pa(0:ql)



     %integer i, add, pt, len, pos, base, buff no
     %ownrecord (qf) %name fs
     %ownrecord (qf) %name fb

     %ownrecord (pe)p
     %ownrecord (bf) %name m



     %routinespec queue(%record (pe) %name p)
     %routinespec octal(%integer x)
     %integerfnspec unqueue(%integer len)


     %integerfn alloc buffer(%integer param)
        %integer i
        *mov_param,0
        *emt_7
        *mov_0,i
        %result = i
     %end

     %record (bf) %map map(%integer buff no)
        ! buff no is already in r0 - where its wanted
        *mov_#8,1;     ! desired vm seg no *2 ie 4*2
        *mov_#k'2006',2; ! length & permission for buffer
        *iot
        %result == record(k'100000')
     %end

     printstring(vsn)

     base = alloc buffer(k'1600');     ! For Dx11 use it MUST lie in the top 16 bits
     %if base = 0 %start
        printstring(" Failed to get space!
")
        %stop
     %finish
     printstring(" Space at:"); octal(base); newline


     linkin(ser no)
     map hwr(0);                  ! get access to processor status word PSW
     change out zero = t3 ser;       ! point output(0) to common out
     alarm(10*50);                    ! ten seconds

     pt = base+k'40'; pos = 1;  ! move it past the dedicated dx11 area
     %cycle i = 1, 1, no of small
         h == ha(pos)
         h_buff no = pt
         h_l == fs
         fs == h
         m == map(pt); ! map to it to initialise & check
         m = 0
         m_buff no = pt; m_mode = x'80';    ! only top bit set now
         pt = pt+small inc
         pos = pos+1
     %repeat

     big start = pt
     %cycle i = 1, 1, no of big
         h == ha(pos)
         h_buff no = pt
         h_l == fb
         fb == h
         m == map(pt)
         m_buff no = pt; m_mode = 0
         pt = pt+big inc
         pos = pos+1
         %exit %if pt > base+k'1600'-big inc
     %repeat
     free big == fb; free small == fs
     nb = i; ns = no of small
     lb = 999; ls = 999


     %cycle
        p_ser = 0;  poff(p)

         %if p_reply = 0 %start;      ! clock tick
            %if '0'<=int<='9' %then delay = (int-'0')*6 %and %c
               int = 'P' %and dcou = 0
            alarm(50*10)

            %if nb = 0 %start
              printstring("buff: no big buffers ******
")
           %finish
           %if ns = 0 %then printstring("buff: no small buffers ******
")
           dcou = dcou+1
            %if dcou = delay %or int = '?' %start
               int = 0
               dcou = 0
               printstring("        buff:")
               write(nb, 1); write(ns, 1)
               write(lb, 1); write(ls, 1)
               write(br, 3); write(sr, 1)
               write(queued, 3); write(qq, 1); newline
                qq = 0;  lb = 999; ls = 999; br = 0;  sr = 0
            %finish
            %continue
          %finish

        %if p_fn = request buffer %start
again:                                 ! comes here if it was a
                                       ! queued request
           ps = ps!k'340';            ! ensure uninterruptable
           %if p_len = 0 %start;       ! big buffer
              %unless free big == null %start
                 h == free big
                 %if h_l == null %and nb > 1 %start
                    printstring("Big Corruption
")
                    *=k'104001'
                 %finish
                 free big == h_l
                 nb = nb-1;  %if nb < lb %then lb = nb
                 br = br+1
                 -> reply
              %finish
              queue(p)
           %else
              !! small block request
              %unless free small == null %start
                 h == free small
                 %if h_l == null %and ns > 1 %start
                    printstring("Buff:Small Corruption
")
                    *=k'104001'
                 %finish
                 free small == h_l
                 ns = ns-1; %if ns < ls %then ls = ns
                 sr = sr+1
reply:           
                 p_buff no = h_buff no
                 h_buff no = 0
                 h_l == free h
                 free h == h

reply2:
                 ps = ps&(~k'340');    ! ints back on
                 p_ser = p_reply; p_reply = ser no
                 pon(p)
                 %if free small == null %start;  ! temp - to catch error
                    printstring("B:corrupt?
")
                    %cycle; %repeat
                 %finish
              %else
                 queue(p)
              %finish
           %finish
           ps = ps&(~k'340');        ! queued req, switch ints ON again
           %continue
        %finish

        !! should be release buffer
        %if p_fn = release buffer %start
           buff no = p_buff no

           %if buff no < base %or buff no >= base+k'1600' %start
              printstring("Buff:Illegal release:"); octal(buff no)
              printstring(", from"); write(p_reply, 1); newline
              %continue
           %finish

           m == map(buff no);       ! map to it
           %if m_buff no # buff no %or m_owner = own id %start
              printstring("Buff no corrupted !, from, exp, act,own:")
              write(p_reply, 1); write(buff no, 1); write(m_buff no, 1)
              write(m_owner, 1); newline
              %continue
           %finish
           m_owner = own id;          ! mark it as mine now

           ps = ps!k'340';            ! switch ints OFF
           h == free h; free h == h_l
           h_buff no = buff no

           %if buff no >= big start %start
              h_l == free big
              free big == h
              nb = nb+1
              len = 0;         ! big block
           %else
              h_l == free small; free small == h
              len = 1;                 ! small block
              ns = ns+1
           %finish
           ps = ps&(~k'340');        ! switch ints back ON

           %if free small == null %start;   ! temp again
              printstring("B:Corrupt 2?
")
              %cycle; %repeat
           %finish
           !! check for a queued request
           %if queued > 0 %start
              %if un queue(len) # 0 %then -> again
              !! # 0 -> found a request, which is copied to "p"

           %finish
        %finish
     %repeat


     %routine queue(%record (pe) %name p)
        %integer i
        %record (pe) %name p2

        %cycle i = 0, 1, ql
           p2 == pa(i)
           %if p_ser = 0 %start;      ! queue slot not allocated
              p2 = p;                  ! copy p into pa
              queued = queued+1;  qq = qq+1
              %return
           %finish
        %repeat
        printstring("buff:full!
")
     %end


     %integerfn un queue(%integer len)
        %integer i, old
        %record (pe) %name p2
        %owninteger in turn

        old = in turn
        %cycle
           p2 == pa(in turn);  in turn = (in turn+1)&ql
           %if p_ser # 0 %and p_len = len %start
              p = p2;                  ! copy pa into p
              p_ser = 0;              ! slot now free
              queued = queued-1
              %result = 1
           %finish
           %if in turn = old %thenexit
        %repeat
        %result = 0
     %end

     %routine octal(%integer x)
        %integer i
        %cycle i = 15, -3, 0
           printsymbol((x >> i)&7+'0')
        %repeat
     %end
%endofprogram