⟦6643f1311⟧

TextFileVerbose

job oer 7 200 time 11 0 area 10 size 100000
(
source = copy 25.1
pxsuplst=set 1 disc1
pxsuperr=set 1 disc1
pxsuplst=indent source mark lc
listc=cross pxsuplst
o pxsuperr
mode list.yes
message compile pxsup
pascal80 codesize.1024 xtenv xncpenv xpoolenv xrouenv routenv testenv source
mode list.no
o c
lookup pass6code
if ok.yes
(pxsupbin=set 1 disc1
pxsupbin=move pass6code
scope user pxsupbin
)
pxsuplst=copy listc pxsuperr
scope user pxsuplst
scope user pxsuperr
finis
)

(****************************************************************)
(*                                                              *)
(* process:  router supervisor                                  *)
(* ------------------------------------------------------------ *)
(*                                                              *)
(* ncp         ncp process semaphore                            *)
(* lcp_ident   receiver id in supervisor packets                *)
(* ltrm        connector transmitter semaphore array            *)
(* lrec        connector receiver semaphore array               *)
(* ldrv        line driver semaphore array                      *)
(* ldrv2       line driver second semaphore array (hdlcsim)     *)
(* conn_desc   array with connector create descriptions         *)
(* supv        supervisor semaphore                             *)
(* poolh       transit buffer pool process                      *)
(* poolnnp     nnp buffer pool process                          *)
(* ownaddr     address of this node                             *)
(* udelay      network time update                              *)
(* bdelay      network time broadcast                           *)
(*                                                              *)
(****************************************************************)

process supervisor ( var sysvec: system_vector;
var ncp: ! tap_pointer;
lcp_ident: integer;
var ltrm: !ltsmarray;
var lrec: ! ltsmarray;
var ldrv: ! ltsmarray;
var ldrv2: ! ltsmarray;
var conn_desc: conn_desc_array;
var supv: !tap_pointer;
var poolh, poolnnp: ! tap_pointer;
 udlay1,udlay2,bdlay1,bdlay2: byte;
var ownaddr: nwadr);

const

(* const *)

(* u1 values *)
tim_updnwt=255;     (* update networktime *)
tim_bnwt=tim_updnwt-1; (* broadcast networktime *)

(* u4 values *)
ncp_stream=1;


(* other constants *)

nwaitmess=2;  (* no of wait message buffers *)
netwtime_step=1;
no_protect_tab=rlmax+3;


(* type *)


var

(*------------------------------------------------------------*)
(*                                                            *)
(*   critical variables in the router module:                 *)
(*   ========================================                 *)
(*                                                            *)
(*   the variables are listed in the sequence of priority.    *)
(*   if several variables are to be monopolized at the same   *)
(*   time (by one process), they must be waited for in the    *)
(*   same sequence as listed below in order to prevent        *)
(*   deadlocks.                                               *)
(*------------------------------------------------------------*)



(* ==========    network time    ============================= *)

netwtime: nwtime:=nwtime(?,int32(0,0));

(* ==========    nnp flag table    =========================== *)

nnpflags: nnpfltable:=nnpfltable(?,cnnparbit(cmax***pipar(nnpmax***0)),
cmaxarint(cmax***0),cmaxarint(cmax***0));

(* ==========    queue information table ===================== *)

queues: qinftable:=qinftable(?,cmaxarint(cmax***0),cstarray(cmax***not_crea));

(* ==========    routing tables    =========================== *)

rtables: rtabarray;



(* ==========    shared variables  (not critical)    ========= *)


(* semaphores for waiting nnp event requests *)
nnpreq: csemarray;

(* handshake contents (password, version etc. *)
hshake: handshake:= handshake(1,2,3,4,5,6,7,8,9,10);




(* other variables *)

udelay1,udelay2,bdelay1,bdelay2: byte;

moduletype: byte;
lcp_op:lcp_oper_type;
dest,lcp_index: integer;
ref,msg: reference;

messpool: pool nwaitmess of r_lcp_ident;
timerpool: pool 2;
unlockpool: pool no_protect_tab;

supvhelp: semaphore;
j,i: integer;
nn, ibase: integer;
sharray: array(1..cmax) of shadow;
sp_bcnt: integer;
sp_st: set of sp_status_bit;
nametrm: alfa;



process lotrm( var sysvec:system_vector;
var ltrm: ! ltsmarray;
var cparams: cparams_type;
var rtables: rtabarray;
var queues: qinftable;
var netwtime: nwtime;
var supv: !tap_pointer;
var utrm_sem: !tap_pointer;
var ownaddr: nwadr;
var nnpflags: nnpfltable;
var nnpreq: csemarray;
c: integer);
external;

process hltrm( var sysvec:system_vector;
var ltrm: ! ltsmarray;
var lrec: ! tap_pointer;
var hdlc_sem: ! tap_pointer;
var hdlcsim2: ! tap_pointer;
var nnpreq: csemarray;
var rtables: rtabarray;
var queues: qinftable;
var netwtime: nwtime;
var hshake: handshake;
var nnpflags: nnpfltable;
var poolh,poolnnp: ! tap_pointer;
var supv: !tap_pointer;
var cparams: cparams_type;
var ownaddr: nwadr;
c: integer);
external;





(*-------------------------------*)
(*  internal supv procedures     *)
(*-------------------------------*)

procedure initrouttables;

var rl,nn,cn: integer;

begin
for rl := 1 to rlmax do
with rtables(rl) do
begin
act_nmax:=rlnmax(rl);
infway:=rlinf(rl);
for nn := 1 to nmax do
for cn := 1 to cmax do
tab(nn,cn):=infway;
end;
end;

procedure unlocktables;

(* the procedure unlocks the protected tables in the
router module  *)

begin
alloc(msg,unlockpool,queues.key);
signal(msg,queues.key);
alloc(msg,unlockpool,netwtime.key);
signal(msg,netwtime.key);
for i:=1 to rlmax do
begin
alloc(msg,unlockpool,rtables(i).key);
signal(msg,rtables(i).key);
end;
alloc(msg,unlockpool,nnpflags.key);
signal(msg,nnpflags.key);
end;

function cr_local_con(j: integer) : integer;

var i: integer;

begin
i:=link('lotrm       ',lotrm);
nameinit (nametrm, 'lotrm       ', 6, j);    (* set lotrm name *)
i:=create(nametrm,lotrm(sysvec,
ltrm,conn_desc(j).cparams,rtables,queues,netwtime,supv,
lrec(j),ownaddr, nnpflags, nnpreq,j),sharray(j),700);
if i=0 then start(sharray(j),stdpriority);
cr_local_con:=i;
end;

function cr_hdlc_con(j:integer) : integer;

var i:integer;

begin
i:=link('hltrm       ',hltrm);
nameinit (nametrm, 'hltrm       ', 6, j);    (* set hltrm name *)
i:=create(nametrm,hltrm(sysvec,
ltrm,lrec(j),ldrv(j),ldrv2(j),nnpreq,
rtables,queues,netwtime,hshake,nnpflags,poolh,poolnnp,
supv,conn_desc(j).cparams,ownaddr,j),
sharray(j),1000);
if i=0 then start(sharray(j),stdpriority);
cr_hdlc_con:=i;
end;









begin

udelay1:=udlay1;
udelay2:=udlay2;
bdelay1:=bdlay1;
bdelay2:=bdlay2;


initrouttables;



(*------------------------------*)
(* connect lcp                  *)
(*------------------------------*)

alloc(msg,messpool,supvhelp);
repeat
lock msg as p: r_lcp_ident do with p do
lcp.id:=lcp_ident;
msg^.u1:=connect_lcp;
msg^.u2:=message;
signal(msg,ncp.s^);
wait(msg,supvhelp);
until msg^.u2=ok;
lcp_index:=msg^.u3;
release(msg);

while openpool(messpool) do

(*------------------------------*)
(* signal wait mes bufs to ncp  *)
(*------------------------------*)
begin (* signal wait message buffer to ncp *)
alloc(msg,messpool,supv.s^);
msg^.u1:=wait_message;
msg^.u2:=message;
msg^.u3:=lcp_index;
msg^.u4:=ncp_stream;
signal(msg,ncp.s^);
end;  (* signal wait message buffer to ncp *)


(*------------------------------*)
(* signal timeroperations       *)
(*------------------------------*)
alloc(msg,timerpool,supv.s^);
msg^.u1:=tim_updnwt;
msg^.u2:=message;
msg^.u3:=udelay1;
msg^.u4:=udelay2;
sendtimer(msg);

alloc(msg,timerpool,supv.s^);
msg^.u1:=tim_bnwt;
msg^.u2:=message;
msg^.u3:=bdelay1;
msg^.u4:=bdelay2;
sendtimer(msg);

(*------------------------------*)
(*  create connectors           *)
(*------------------------------*)

for j:=1 to cmax do
begin (* create connectors *)
case conn_desc(j).ctyp of

none:  ;

typ_locon:
begin  (* local connectors *)
i:=cr_local_con(j);
if i<>0 then trace(i);
end;

typ_hlcon:
begin  (* hdlc connectors *)
i:=cr_hdlc_con(j);
if i<>0 then trace(i);
end;

end;  (* case conn_desc(i).ctype *)

end;  (* create connectors  *)

(*------------------------------*)
(*  unlock protected tables     *)
(*------------------------------*)

unlocktables;


(*-----------------------------*)
(*  main loop                  *)
(*-----------------------------*)


repeat
wait(msg,supv.w^);
case msg^.u2 of

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

(*------------------------------*)
(*  request nnp event           *)
(*------------------------------*)
req_nnp_ev:
begin (* request nnp event *)
wait(ref,nnpflags.key);  (* enter critical region *)
if nnpflags.cnt(msg^.u3) = 0 then
signal(msg,nnpreq(msg^.u3)) else
begin (* return nnp event request *)
msg^.u2:=ok;
return(msg);
end;
signal(ref,nnpflags.key);  (* exit critical region *)
end;  (* request nnp event *)

(*------------------------------*)
(* event report from connector  *)
(*------------------------------*)
wait_event_buf:
begin (* wait event buffer *)
msg^.u3:=lcp_index;
signal(msg,ncp.s^);    (* reroute event to ncp *)
end;  (* wait event buffer *)

otherwise

(*------------------------------*)
(*  illegal function            *)
(*------------------------------*)
begin (* illegal function *)
trace (1);    (* tttttttttttttttttttttttttttttttttt  1  *)
msg^.u2:=illegal;
return(msg);
end;  (* illegal function *)

end;  (* case msg^.u1 *)

end;  (* message *)

otherwise

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

(*------------------------------*)
(* update networktime           *)
(*------------------------------*)
tim_updnwt:
begin (* update networktime *)
msg^.u2:=message;
msg^.u3:=udelay1;
msg^.u4:=udelay2;
sendtimer(msg);

wait(ref,netwtime.key); (* enter critical region *)
for i:=1 to netwtime_step do
inc32(netwtime.t);     (* nice  isn't it ????   *)
signal(ref,netwtime.key); (* exit critical region *)
end; (* update networktime *)

(*------------------------------*)
(*  broadcast networktime       *)
(*------------------------------*)
tim_bnwt:
begin (* broadcast networktime *)
msg^.u2:=message;
msg^.u3:=bdelay1;
msg^.u4:=bdelay2;
sendtimer(msg);

wait(ref,nnpflags.key);  (* enter critical region *)
for i:=1 to cmax do
begin (* set nnp nwtime flags *)
if set_nnp_fl(i,nnpi(nnp_nwtime),nnpflags) then
ret_nnp_req(nnpreq(i));
end;  (* set nnp nwtime flags *)
signal(ref,nnpflags.key);
end;  (* broadcast networktime *)

otherwise

begin    (* answers with u4 set *)
if msg^.u4=ncp_stream then
begin (* ncp stream *)
if msg^.u1=wait_message then

(*------------------------------*)
(* supervisor message           *)
(*------------------------------*)
begin (* supervisor message *)
pop(ref,msg);
ref^.u2:=message;
signal(ref,ncp.s^);  (* wait for a new supv mess *)
sp_st:= (.ill_lcp_oper.);
lock msg as p: r_lcp_head do 
begin (* lock *)
moduletype:=p.rout_mod;
dest:=p.incarnation;
lcp_op:=p.sp_head.lcp_oper;
sp_bcnt:=p.sp_head.bytecount;
end; (* lock *)
case moduletype of

(*------------------------------*)
(* supervisor message for supv  *)
(*------------------------------*)
supervisor_mod:
begin (* supv mess for supervisor *)
case lcp_op.basic of

(*------------------------------*)
(* control operations           *)
(*------------------------------*)
lcp_cntr:
begin (* control *)
case lcp_op.modif of

(*------------------------------*)
(* create connectors            *)
(*------------------------------*)
opc_crea_conn:
begin (* create connectors *)
lock msg as p: cntr_cr_con do with p do
begin (* lock msg *)
sp_st:=(..);
if (inc<1) or (inc>cmax) then
sp_st:=(.data_error.) else
if conn_desc(inc).ctyp<>none then
sp_st:=(.data_error.) else
begin
conn_desc(inc).cparams:=cparams;
case ctype of

1:
 (* local connector *)
if cr_local_con(inc) <> 0 then
sp_st:=(.no_free_res.) else
conn_desc(inc).ctyp:=typ_locon;
  (* local connector *)

2:
 (* hdlc connector *)
if cr_hdlc_con(inc) <> 0 then
sp_st:=(.no_free_res.) else
conn_desc(inc).ctyp:=typ_hlcon;
  (* hdlc connector *)

otherwise

sp_st:=(.data_error.);

end;  (* case *)
end;
end;  (* lock *)

end;  (* create connectros *)

otherwise
(*-----------------------------*)
(* illegal control operation   *)
(*-----------------------------*)
end;  (* case lcp_op_modif *)
end;  (* control operation *)

(*------------------------------*)
(* sense operations             *)
(*------------------------------*)
lcp_sense:
begin (* sense *)
case lcp_op.modif of

(*------------------------------*)
(* get timers                   *)
(*------------------------------*)
opc_get_timers:
begin (* get timers *)
sp_st:= (..);
lock msg as p: get_tim_op_type do with p do
begin (* lock msg *)
supv.netwtim:=netwtime.t;
supv.nwt_del1:=udelay1;
supv.nwt_del2:=udelay2;
supv.nwt_update:=netwtime_step;
supv.broadc_del1:=bdelay1;
supv.broadc_del2:=bdelay2;
sp_bcnt:=12;
j:=1;
for i:=1 to cmax do
if conn_desc(i).ctyp = typ_locon then
begin
sp_bcnt:=sp_bcnt+8;
with local(j) do
begin
c:=i;
node:=conn_desc(i).cparams(1);
ps_del1:=conn_desc(i).cparams(2);
ps_del2:=conn_desc(i).cparams(3);
p_xmit_del1:=conn_desc(i).cparams(4);
p_xmit_del2:=conn_desc(i).cparams(5);
j:=j+1;
end;
end;
end; (* lock msg *)
end; (* get timers *)

(*------------------------------*)
(* sense connectors             *)
(*------------------------------*)
opc_sense_conn:
begin (* sense connectors *)
sp_st:= (..);
sp_bcnt:= 2+2+(cmax*lgtconnsense);
lock msg as p: senseconn_pack do with p do
begin
cnumber:= cmax;
for i:= 1 to cmax do
with cdesc(i) do
begin
conn_no:= i;
conn_type:= ord (conn_desc(i).ctyp);
cid:= conn_desc(i).cparams(1);
nblevel:= nnpflags.nblevel(i);
conn_state:= ord (queues.state(i));
queuelgt:= queues.qlgt(i);
end; (* for .. with .. *)
end; (* lock .. with .. *)
end; (* sense connectors *)

(*---------------------------------*)
(* get routing table               *)
(*---------------------------------*)
opc_get_rtab:
begin (* get routing table *)
lock msg as p: rtab_pack do with p do
begin
j:= h.rl; (* get routing level *)
if (j<1) or (j>rlmax) then
sp_st:= (.data_error.)
else
begin (* routing level ok *)
h.connmax:= cmax;
with rtables(j) do
begin
h.nnmax:= act_nmax;
h.infway:= infway;
ibase:= 0;
for i:= 1 to cmax do
begin
for nn:= 1 to act_nmax do
t(ibase+nn):=tab(nn,i);
ibase:= ibase+act_nmax;
end; (* for i loop *)
end; (* with rtables(j) do *)
sp_st:= (..);
sp_bcnt:= 2+lgtrtabhead+(2*ibase);
end; (* routing level ok *)
end; (* lock .. with .. *)
end; (* get routing table *)

otherwise

(*------------------------------*)
(* illegal sense operations     *)
(*------------------------------*)
end; (* case lcp_op_modif *)
end; (* sense op *)


otherwise

(*-----------------------------*)
(* illegal lcp operation       *)
(*-----------------------------*)
end;  (* case sp_head *)

answ_lcp (msg, sp_st, sp_bcnt);

end;   (* supv mess for supervisor *)

(*------------------------------*)
(* supv message for connector   *)
(*------------------------------*)
connector_mod:
begin (* supv message for connectors *)
if (dest<1) or (dest>cmax) then
answ_lcp(msg,(.data_error.),sp_bcnt)
else
if queues.state(dest)=not_crea then
answ_lcp(msg,(.data_error.),sp_bcnt)
else signal(msg,ltrm(dest).s^);
end; (* supv mess for connectors *)

otherwise

(*------------------------------*)
(* illegal moduletype           *)
(*------------------------------*)
answ_lcp(msg,(.data_error.),sp_bcnt);

end;  (* case moduletype *)


end   (* supervisor message *)      else

begin
trace (1);    (* tttttttttttttttttttttttttttttttt  1  *)
release(msg);   (* error *)
end;
end (* ncp stream *)  else

begin
trace (1);    (* tttttttttttttttttttttttttttttttt  1  *)
release(msg);     (* error *)
end;
end;  (* answers with u4 set *)

end;  (* case msg^.u1 *)

end; (* answer *)

end;  (* case msg^.u2 *)

until false;

end.  (* process supervisor *)

«eof»
DataMuseum.dk

RC3500

⟦6643f1311⟧ TextFileVerbose

Derivation

TextFileVerbose
