⟦779f6a7b8⟧

TextFile


(****************************************************)
(*                                                  *)
(*   external pool handler procedures               *)
(*                                                  *)
(****************************************************)

prefix deliv_buf;

procedure deliv_buf(var ref: reference; var ph_sem: semaphore);

(* the procedure delivers the specified buffer to the p.h. for
administration *)

begin
ref^.u1:=deliver_buf;
ref^.u2:=message;
signal(ref,ph_sem);
end.
endbody;

prefix req_buf;

procedure req_buf(var ref:reference; var ph_sem: semaphore;
u3,u4: byte);

(* the procedure sends a buffer request to the p.h. using the
reference specified in the call with u3,u4 set to the specified
values *)

begin
ref^.u1:=request_buf;
ref^.u2:=message;
ref^.u3:=u3;
ref^.u4:=u4;
signal(ref,ph_sem);
end.
endbody;

prefix remov_buf;

procedure remov_buf(var ref:reference; var ph_sem: semaphore;
number,u4: byte);

(* the procedure sends a remove buffer message to the p.h. using
the reference specified in the call. The number and the u4 
field are set according to the call. *)

begin
ref^.u1:=remove_buf;
ref^.u2:=message;
ref^.u3:=number;
ref^.u4:=u4;
signal(ref,ph_sem);
end.
endbody;

prefix update_stat;

procedure update_stat(priority:0..3;
statistic:stat_update; var ph:ph_type);

(* the procedure updates the statistics in the pool handler.
The procedures request_buffer , return_buffer etc call the 
procedure *)

procedure inc(var i:integer);
begin
if i=maxint then i:=minint else i:=i+1;
end;

procedure cal_req_w(var i:stat);
begin
with i do
begin
inc(req);
wreq:=wreq+1;
inc(twreq);
if wreq>mwreq then mwreq:=wreq;
end;
end;


begin
with ph do
begin
case statistic of
req_to_wait:
begin (* request sent for waiting *)
cal_req_w(bpool.st);
cal_req_w(prio(priority).st);
end;
get_buf:
begin (* get buffer from pool *)
with bpool.stb do
begin
freebuf:=freebuf-1;
if freebuf<minfree then minfree:=freebuf;
end;
inc(bpool.st.req);
inc(prio(priority).st.req);
end;
time_out:
begin (* no buffer available - timeout *)
with bpool.st do
begin
inc(req);
inc(tmout);
end;
with prio(priority).st do
begin
inc(req);
inc(tmout);
end;
end;
buf_to_wait:
begin (* no requests pending - send buffer for waiting *)
with bpool.stb do
begin
freebuf:=freebuf+1;
if freebuf>maxfree then maxfree:=freebuf;
end;
end;
get_req:
begin (* get request with the highest priority *)
with bpool.st do
wreq:=wreq-1;
with prio(priority).st do
wreq:=wreq-1;
end;
end; (* case *)
end;
end. (* procedure *)

endbody;

prefix return_buffer;

procedure return_buffer(var msg:reference; var ph:ph_type);

(* The buffer referenced by msg is returned to the pool handler
identified by ph *)

var
ref,ref1:reference;
priority:integer;

begin
wait(ref,ph.key);
msg^.u1:=output;
msg^.u2:=ok;
case ph.bpool.st.wreq of
0:
begin (* no waiting requests *)
update_stat(0,buf_to_wait,ph);
signal(msg,ph.buffer_sem);
end;
otherwise
begin (* return waiting request with highest priority *)
priority:=4;
repeat
priority:=priority-1;
until ph.prio(priority).st.wreq<>0;
update_stat(priority,get_req,ph);
wait(ref1,ph.prio(priority).sem);
ref1^.u2:=ok;
push(ref1,msg);
return(msg);
end;
end; (* case *)
signal(ref,ph.key);
end. (* procedure *)
endbody;


prefix request_buffer;

procedure request_buffer(var msg:reference;
var ph:ph_type;
priority:0..3);

(* A buffer is requested with the indicated priority from
the pool handler specified by ph.

msg:                                                 *)

(*  call   !      exit                               *)
(*---------------------------------------------------*)
(*         ! nil   : no buffer available             *)
(* nil     ------------------------------------------*)
(*         ! <>nil : buffer                          *)
(*---------------------------------------------------*)
(*         ! nil   : ref waits for buffer 1)         *)
(* <>nil   ------------------------------------------*)
(*         ! <>nil : ref pushed upon empty buffer 2) *)
(*---------------------------------------------------*)

(*
1) When a buffer arrives ref is pushed upon the buffer and
returned to the answer semaphore of ref with ref^.u2:=ok and
the other u fields unchanged. Note that ref must not be a reference
to a stack of messages.
The u fields of the buffer is: u1=output, u2=ok       
2) ref^.u2:=ok (other u fields unchanged )            *)



var

ref,ref2:reference;

begin
wait(ref,ph.key);
case ph.bpool.stb.freebuf of

0:  (* no free buffers  *)
if nil(msg) then update_stat(priority,time_out,ph)
else
begin
update_stat(priority,req_to_wait,ph);
signal(msg,ph.prio(priority).sem);
end;

otherwise

begin  (* free buffers *)
update_stat(priority,get_buf,ph);
if nil(msg) then wait(msg,ph.buffer_sem) else
begin
wait(ref2,ph.buffer_sem);
msg^.u2:=ok;
push(msg,ref2);
msg:=:ref2;
end;
end;

end;  (* case *)

signal(ref,ph.key);

end.

endbody;

prefix remove_buffers;


procedure remove_buffers(var ph:ph_type;count:integer);

(* The number of buffers administrated by the pool handler
identified by ph are reduced with count *)

begin
ph.bpool.stb.buf:=ph.bpool.stb.buf-count;
end.

endbody;

prefix deliver_buffer;


procedure deliver_buffer(var ref:reference; var ph:ph_type);

(* The buffer referenced by ref is delivered to the pool handler
identified by ph for administration *)

begin
inc16(ph.bpool.stb.buf);
return_buffer(ref,ph);
end.

endbody;


prefix init_ph;

procedure init_ph(var ph:ph_type;var lockpool:pool 1);

(* The procedure initializes the pool handler identified by ph.
The statistics are initialized and the semaphore that protects
the ph procedures are opened , using a message from lockpool *)

var
ref:reference;
i:integer;

procedure reset_help(var j:stat);
begin
with j do
begin
req:=0;
mwreq:=0;
twreq:=0;
tmout:=0;
end;
end;

procedure reset_stat;

begin
with ph.bpool.stb do
begin
buf:=0;
maxfree:=0;
minfree:=maxint;
end;
reset_help(ph.bpool.st);
for i:=0 to 3 do reset_help(ph.prio(i).st);
end;

begin
reset_stat;
with ph do
begin
bpool.stb.freebuf:=0;
bpool.st.wreq:=0;
for i:=0 to 3 do prio(i).st.wreq:=0;
end;
alloc(ref,lockpool,ph.key);
signal(ref,ph.key);
end.

endbody;


.








▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦779f6a7b8⟧ TextFile

Derivation

TextFile
