DataMuseum.dk

top - metrics - download

    Length: 9984 (0x2700)
    Types: TextFileVerbose
    Names: »hlrec«

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

TextFileVerbose

(******************************************************************)
(*                                                                *)
(* process hdlcline receiver                                      *)
(* ---------------------------------------------------------------*)
(*                                                                *)
(* ltrm:          transmit semaphores for connectors in the node  *)
(* nnpreq:        waiting nnp-ev-requests for all connectors      *)
(* rtables:       routing tables for levels 1, 2, ... rlmax       *)
(* queues:        queue and state for each connector in the node  *)
(* netwtime:      network time                                    *)
(* hshake:        contents of handshake nnp packet                *)
(* nnpflags:      table with flags indicating nnp-packets to be   *)
(*                sent (for each connector)                       *)
(* poolh:         poolhandler process for transit packets         *)
(* supv:          router supervisor process                       *)
(* hdlc:          hdlc driver process                             *)
(* hlrec_sem:     main semaphore of hdlc line receiver            *)
(* stat:          statistics record of this line connector        *)
(* ownaddr:       network address of this node                    *)
(* c:             connector number of this connector (index in    *)
(*                arrays 1..cmax)                                 *)
(*                                                                *)
(******************************************************************)



process hlrec (var sys_vec: system_vector;
var ltrm: ! ltsmarray;
var nnpreq: csemarray;
var rtables: rtabarray;
var queues: qinftable;
var netwtime: nwtime;
var hshake: handshake;
var nnpflags: nnpfltable;
var poolh: ! tap_pointer;
var supv: ! tap_pointer;
var hdlc: ! tap_pointer;
var hlrec_sem: ! tap_pointer;
var stat: stat_hlcon;
var ownaddr: nwadr;
c: integer);



const

version='ver. 810410/';
(* streams   u4  *)

empty_buf=3;               (* empty buffer from ph *)
hdlc_data=10;             (* input from hdlc driver  *)

type
hlrecstate=(open,close);

var
z:zone;
i,nnpindex,rlindex: integer;
dest: integer;
daddr: nwadr;
linerange: integer:= 1;
action_p: boolean;
prejst: byte;
toprec,nextrec: integer;
msg,ref: reference;
hlrec_state:hlrecstate:=close;
packet_format,size: byte;
t: int32;
upd: cboolarray;

inpbuffers: pool rbuf of pack1;

msheads: pool rbuf;


begin

testopen(z,own.incname,sys_vec(operatorsem));
testout(z,version,0);
(* deliver buffers to the pool handler *)

while openpool(inpbuffers) do
begin
alloc(ref,inpbuffers,poolh.s^);
deliv_buf(ref,poolh.s^);
end;


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

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

(*------------------------------*)
(*     open hlrec               *)
(*------------------------------*)
open_rec:
begin (* hltrm has sent open message *)
linerange:=msg^.u3;
release(msg);
if hlrec_state = close then
begin
hlrec_state:=open;

(* empty msheads and request buffers *)
while openpool(msheads) do
begin
alloc(ref,msheads,hlrec_sem.s^);
req_buf(ref,poolh.s^,hdlc_in_prio,empty_buf);
end;
end; (* hlrec_state= close *)

end;  (* open message *)

(*------------------------------*)
(*     close hlrec              *)
(*------------------------------*)
close_rec:
begin (* hltrm has sent close message *)
release(msg);
hlrec_state:=close;
end;  (* close message *)
otherwise

(*------------------------------*)
(*     illegal messgae          *)
(*------------------------------*)
begin (* error *)
msg^.u2:=illegal;
return(msg);
end;  (* error *)
end; (* case *)
end;   (* message *)
otherwise

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

(*------------------------------*)
(*     empty buffer             *)
(*------------------------------*)
empty_buf:
begin (* empty buffer from ph *)
case hlrec_state of
open:
begin (* send input to hdlc *)
msg^.u1:=input;
msg^.u2:=message;
msg^.u4:=hdlc_data;
size:=msg^.size;
lock msg as a: drvbuftype do with a do
begin
first:=6+rparam_lgt;
last:=(size*2) - 1;
end;
signal(msg,hdlc.s^);
end;  (* open *)
close:
begin (* the hlrec has been closed *)
pop(ref,msg);
release(ref);
return(msg);     (* to ph *)
end;  (* close *)
end; (* case *)
end;  (* empty buffer *)

(*------------------------------*)
(*     hdlc data                *)
(*------------------------------*)
hdlc_data:
begin (* input from hdlc line *)
case msg^.u2 mod 8 of

(*-------------------------------*)
(*     status 0                  *)
(*-------------------------------*)
ok:
begin (* status ok *)
pop(ref,msg);
req_buf(ref,poolh.s^,hdlc_in_prio,empty_buf);
lock msg as p: pack1 do
begin
packet_format:=p.head.format;
if packet_format=dg_form1 then
if p.head.fac = fac_mask_0 then

(*------------------------------*)
(*  no facility bits set        *)
(*------------------------------*)
begin (* no facility bits set *)
get_addr(p,daddr);
action_p:=masterroute(p,dest,ownaddr,daddr,rtables,queues);
end        else

(*------------------------------*)
(*  facility bits  set           *)
(*------------------------------*)
begin (* facility mask set *)
toprec:=p.data(p.head.top_of_data+top_of_trail+1);
nextrec:=p.data(p.head.top_of_data+next_rec+1);
case check_facility(p,rtables,toprec,nextrec,dest,daddr
,ownaddr,prejst,netwtime,1) of

reject_p:
begin (* reject packet *)
if reject(p,prejst) then
begin
get_addr(p,daddr);
action_p:=masterroute(p,dest,ownaddr,daddr,rtables,queues);
end     else    action_p:=false;
end;  (* reject packet *)

route_p:
action_p:=masterroute(p,dest,ownaddr,daddr,rtables,queues);

route_to_dest:
begin
action_p:=true;
update_queue(queues,dest,1);
end;

route_to_sup:
begin
dest:=-1;
action_p:=true;
end;

end; (* case check facility *)
end;  (* facility bits set *)
end; (* lock msg *)

case packet_format of

(*------------------------------*)
(*     data packet format 1     *)
(*------------------------------*)
dg_form1:
begin (* data packet *)
inc16 (stat.recnorm);
if action_p then

(*------------------------------*)
(* route packet                 *)
(*------------------------------*)
begin (* route packet *)
if dest=-1 then
begin
msg^.u3:=c;
signal(msg,supv.s^);
end     else
begin
msg^.u1:=trm_packet;
msg^.u2:=message;
signal(msg,ltrm(dest).s^);
end;
end  (* route packet *)   else

(*------------------------------*)
(* return packet                *)
(*------------------------------*)
begin (* return packet *)
msg^.u2:=ok;
return(msg);
end;  (* return packet *)
end;  (* data packet *)

(*------------------------------*)
(*    nnp packet                *)
(*------------------------------*)
dg_form3:
begin (* nnp packet  *)
inc16 (stat.recnnp);
lock msg as p: packnnp do
if (p.head.func > 0) and (p.head.func <= nnpmax) then
begin
(* only known nnp functions are considered *)
nnpindex:= nnpi(p.head.func);
case p.head.func of

(*------------------------------*)
(*     initial handshake        *)
(*------------------------------*)
nnp_hshake:
begin (* initial handshake *)
if check_hshake (p, hshake) then
begin
wait (ref, nnpflags.key);        (* enter critical region *)
if set_nnp_fl (c, nnpindex+1, nnpflags) then
ret_nnp_req (nnpreq(c));    (* indicate next nnp to be sent *)
signal (ref, nnpflags.key);      (* exit critical region *)
end else
begin  (* handshake not ok *)
end;
end;  (* initial handshake *)

(*------------------------------*)
(*     network time sync        *)
(*------------------------------*)
nnp_nwtime:
begin (* network time synchronization *)
t.msp:=p.data(1);
t.lsp:=p.data(2);
chup_nwtime(t,netwtime);  (* check and update network time *)
end;  (* network time sync *)

(*------------------------------*)
(*     range vector             *)
(*------------------------------*)
otherwise  (* range vector *)

wait (ref, nnpflags.key);     (* enter critical region *)
rlindex:= nnprl(nnpindex);  (* get routing level *)

if rlindex > 1 then
begin
if p.data(ownaddr(rlindex)) = 0 then
begin (* neighbour in same group on this level *)
if nnpflags.nblevel(c) >= rlindex then
begin
nnpflags.nblevel(c):= rlindex-1;
if set_nnp_fl (c, nnpindex+1, nnpflags) then
ret_nnp_req (nnpreq(c));    (* init rng-transmit on next level *)
end;
end; (* neighbour in same group ... *)
end; (* rlindex > 1 *)


update_range (linerange, p);    (* update the ranges in range vector *)
rout_table_update (rtables(rlindex),p,c, upd);

for i:=1 to cmax do
if upd(i)= true then
if nnpflags.nblevel(c) <= rlindex then
if set_nnp_fl(i,nnpindex,nnpflags) then 
ret_nnp_req(nnpreq(i));

signal(ref,nnpflags.key);   (* exit critical region  *)
end;  (* case p.head.func *)
end; (* nnppacket locked *)

return(msg);   (* to ph *)
end;  (* nnp packet  *)
otherwise

(*------------------------------*)
(*     unknown packet format    *)
(*------------------------------*)
begin
 inc16 (stat.recunkn);    (* update statistics *)
 return(msg);   (* to ph *)
end;
end;  (* case packet_format *)
end;  (* status ok *)

otherwise

(*-------------------------------*)
(*     status<>0 - no data       *)
(*-------------------------------*)
begin (* no data in input *)
pop(ref,msg);
release(ref);
return(msg);    (* to ph *)
end;  (* no data in input *)
end;  (* case msg^.u2  *)
end;  (* input from hdlc line *)

otherwise
(*-------------------------------*)
(*     unknown answer            *)
(*-------------------------------*)
release(msg);   (* error *)
end;  (* case msg^.u4  *)
end;    (* answer *)
end;  (* case msg^.u2  *)
until false;
end.

«eof»