! 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