DataMuseum.dk

top - metrics - download

    Length: 9216 (0x2400)
    Types: TextFileVerbose
    Names: »pxpohjob«

└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
    └─⟦72244f0ef⟧ 
        └─⟦this⟧ »pxpohjob« 

TextFileVerbose

job oer 8 200 time 11 0 area 10 size 100000
(
source = copy 25.1
pxpohlst=set 1 disc1
pxpoherr=set 1 disc1
pxpohlst=indent source mark lc
listc=cross pxpohlst
o pxpoherr
mode list.yes
message compile pxpoh
pascal80 codesize.1024 xtenv xncpenv xpoolenv xrouenv routenv testenv source
mode list.no
o c
lookup pass6code
if ok.yes
(pxpohbin=set 1 disc1
pxpohbin=move pass6code
scope user pxpohbin
)
pxpohlst=copy listc pxpoherr
scope user pxpohlst
scope user pxpoherr
finis
)
process pool_handler(var sysv:system_vector;
var poolh_sem,ncp_sem: semaphore; lcp_ident: !integer;
var ph:ph_type);

(******************************************************************)
(*                                                                *)
(*       pool handler process                                     *)
(*                                                                *)
(* transputmessage:                                 answer:       *)
(*                                                                *)
(* request buffer:                                                *)
(*  u1=0*4+1                                  u1=unch             *)
(*  u2=7                                      u2=result           *)
(*  u3=(timer*4) + priority                   u3=unch             *)
(*  u4= -                                     u4=unch             *)
(*                                                                *)
(*  timer=0,infinite(=63)                     result: 0 ok        *)
(*                                                    4 illegal   *)
(*                                                    5 no buffer *)
(*                                                                *)
(* return empty buffer(answer):                                   *)
(*  u1=?*4+2                                  no answer           *)
(*  u2= <>7                                                       *)
(*  u3= -                                                         *)
(*  u4= -                                                         *)
(*                                                                *)
(* deliver empty buffer:                                          *)
(* when a buffer is delivered to the p.h. for administration      *)
(*  u1=1*4+2                                no answer             *)
(*  u2= 7                                                         *)
(*  u3= -                                                         *)
(*  u4= -                                                         *)
(*                                                                *)
(* remove buffers:                                                *)
(* used when a process is removed                                 *)
(*  u1=2*4+0                                   u1=unch            *)
(*  u2=7                                       u2=0               *)
(*  u3=no of buffers                           u3=unch            *)
(*  u4= -                                      u4=unch            *)
(* the total number of buffers administrated by the p.h. is       *)
(* reduced with the number indicated in u3.                       *)
(*                                                                *)
(*                                                                *)
(* messages sent to the ncp:                                      *)
(* - connect lcp - u1 = connect_lcp                               *)
(* - wait message - u1=wait_message                               *)
(*                                                                *)
(* messages received from the ncp:                                *)
(* - get statistics - u1=sup_mess_buf                             *)
(*                                                                *)
(*                                                                *)
(*                                                                *)
(* note that requests and/or return of buffers may be stacked     *)
(******************************************************************)

const

(* functions *)


(* timers *)

infinite=infinite_wait div 4;

(* results *)


(* other *)


type

contype=record
first,last,next,
lcp_id: integer;
end;



pool_st_type=packed record
first,last,next: integer;
sp_head: sp_head_type;
plst: pst;
prst: prsttype;
end;


var
ncppool: pool 1 of array(1..8) of char;
starthead:pool 1;
timer,priority: integer;
ref1: reference;
msg: reference;
messtack:reference;
i: integer;

procedure reset_help(var i:stat);
begin
with i 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;


procedure init_stat;
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;
end;









begin
init_ph(ph,starthead);  (* init ph *)

(* connect lcp *)
alloc(msg,ncppool,poolh_sem);
lock msg as buf:contype do with buf do
lcp_id:=lcp_ident;
msg^.u1:=connect_lcp;
msg^.u2:=message;
signal(msg,ncp_sem);
(* end connect lcp *)

repeat
wait(messtack,poolh_sem);
repeat
pop(msg,messtack);
case msg^.u2 of

(*-------------------------------------------------*)
(*     message                                     *)
(*-------------------------------------------------*)
message:
begin   (*  message  *)
case msg^.u1 of

(*-------------------------------------------------*)
(*     request for a new buffer                    *)
(*-------------------------------------------------*)
request_buf:
begin (* request for a new buffer *)
timer:=msg^.u3 div 4;
priority:=msg^.u3 mod 4;
case timer of
no_wait:
begin
request_buffer(ref1,ph,priority);
if nil(ref1) then
begin 
msg^.u2:=no_buffers;
return(msg);
end else
begin
msg^.u2:=ok;
push(msg,ref1);
return(ref1);
end;
end;
infinite:
begin
request_buffer(msg,ph,priority);
if not nil(msg) then
begin
msg^.u2:=ok;
return(msg);
end;
end;
otherwise
begin
msg^.u2:=illegal;
return(msg);
end;
end;  (* case *)
end; (* request *)

(*--------------------------------------------------*)
(*   empty buffer delivered to the ph               *)
(*--------------------------------------------------*)
deliver_buf:
 (* empty buffer delivered to ph *)
deliver_buffer(msg,ph);

(*--------------------------------------------------*)
(*     remove buffers                               *)
(*--------------------------------------------------*)
remove_buf:
begin (* remove buffers *)
ph.bpool.stb.buf:=ph.bpool.stb.buf-msg^.u3;
msg^.u2:=ok;
return(msg);
end;

(*--------------------------------------------------*)
(*     read statistics                              *)
(*--------------------------------------------------*)
sup_mess_buf:
begin (* read statistics *)
lock msg as p: pool_st_type do with p do
begin (* lock msg *)
case sp_head.lcp_oper.basic of

lcp_cntr,
lcp_sense,
lcp_event:
begin (* illegal lcp operations *)
sp_head.status:=(.ill_lcp_oper.);
sp_head.bytecount:=0;
end;

lcp_get_stat:
begin (* get statistic operation *)
sp_head.status:=(..);
sp_head.bytecount:=29*2;
wait(ref1,ph.key);
plst:=ph.bpool;
for i:=0 to 3 do
prst(i):=ph.prio(i).st;
signal(ref1,ph.key);
end; (* get stat operation *)

end;  (* case sp_head.lcp_oper.basic *)

end;  (* lock msg *)

push(msg,messtack);   (* supervisor message is stacked *)
messtack^.u2:=ok;
return(messtack);
end;
otherwise
begin (* unknown functions *)
msg^.u2:=illegal;
return(msg);
end;
end;  (*  case  *)
end;  (* message  *)
otherwise

(*---------------------------------------------------*)
(*     answer                                       *)
(*--------------------------------------------------*)
begin (* answer *)
case msg^.u1 mod 4 of

(*---------------------------------------------------*)
(*     control                                       *)
(*---------------------------------------------------*)
control:
begin   (* control *)
case msg^.u1 of

(*---------------------------------------------------*)
(*     answer to lcp connect                         *)
(*---------------------------------------------------*)
connect_lcp:
begin (* answer to lcp connect *)
case msg^.u2 of
0:
begin (* connected *)
msg^.u1:=wait_message;
msg^.u2:=message;
signal(msg,ncp_sem);
end;
otherwise
begin (* connect not ok *)
release(msg);
end;
end; (* case *)
end;

(*----------------------------------------------------*)
(*     lcp message returned                          *)
(*----------------------------------------------------*)
wait_message:
begin (* lcp message returned send it again *)
msg^.u2:=message;
signal(msg,ncp_sem);
end;
otherwise release(msg);  (* error *)
end;   (* case *)
end;  (* control  *)

(*----------------------------------------------------*)
(*     output                                         *)
(*----------------------------------------------------*)
output:
return_buffer(msg,ph);
otherwise release(msg);  (* error *)
end;   (* case *)
end; (* answer *)
end;  (* case  *)


until nil(messtack)
until false
end. (* pool handler process *)

«eof»