⟦dc0c8bd20⟧

TextFile

prefix search_table;

function search_table(local_key: ! integer;
var local_index: integer;
local_top: ! integer;
local_bottom: ! integer;
var local_table: indextab): boolean;

(***********************************************************************)
(*                                                                     *)
(*                           search_table                              *)
(*                                                                     *)
(* parameters:                                                         *)
(*   local_key: the key that is searched for (call parameter).         *)
(*   local_index: the index in the local_table, where local_key        *)
(*     is found. it is unchanged, if local_key is not found (return    *)
(*     parameter).                                                     *)
(*   local_top: first element in local_table (call parameter).         *)
(*   local_bottom: last element in local_table (call parameter).       *)
(*   local_table: specifies the actual index table that is used (call  *)
(*     parameter).                                                     *)
(* call of other procedures: none.                                     *)
(* use of global variables: none.                                      *)
(* waiting points: none.                                               *)
(* function: search the local_table for an element with                *)
(*   local_key as key. local_index returns with the index in           *)
(*   local_table, if the element is found, else it is unchanged.       *)
(*   search_table is true if the element is found else false.          *)
(*                                                                     *)
(***********************************************************************)

var
top, bottom, middle: integer;

begin
if local_bottom >= local_top then
begin     (* local_table is not empty *)
top:= local_top;
bottom:= local_bottom;
repeat
middle:= (top + bottom) div 2;
if local_key > local_table(middle).skey then
top:= middle + 1
else
bottom:= middle - 1;
until (local_key = local_table(middle).skey) or (top > bottom);
if local_key = local_table(middle).skey then
begin
local_index:= middle;
search_table:= true;
end     (* if local_key = local_table(middle).key *)
else     (* local_key <> local_table(middle).key *)
search_table:= false;
end     (* if local_bottom >= local_top *)
else     (* local_bottom < local_top *)
search_table:= false;
end.     (* search_table *)
endbody;
\f



prefix insert_table;
function insert_table(local_key: ! integer;
var local_index: integer;
local_top: ! integer;
var local_bottom: integer;
var local_table: indextab): boolean;

(*********************************************************************)
(*                                                                   *)
(*                            insert_table                           *)
(*                                                                   *)
(* parameters:                                                       *)
(*   local_key: the key of the element that is to be inserted in     *)
(*     the ordered local_table (call parameter).                     *)
(*   local_index: second part of the element that is to be inserted  *)
(*     in the local_table. if the element is inserted, then          *)
(*     local_index is unchanged at return. if the element is not     *)
(*     inserted, then local_index returns with the index in the      *)
(*     local_table, where the element already exist (call and return *)
(*     parameter).                                                   *)
(*   local_top: first element in local_table (call parameter).       *)
(*   local_bottom: last element in local_table. if element is        *)
(*     inserted, then local_bottom is incremented (call and return   *)
(*     parameter).                                                   *)
(*   local_table: specifies the actual index table that is used      *)
(*     (call and return parameter).                                  *)
(* call of other procedures: search_table.                           *)
(* use of global variables: none.                                    *)
(* waiting points: none.                                             *)
(* function: the function inserts the element that consists of       *)
(*   local_key and local_index in the ordered local_table.           *)
(*   local_key is the key. if the element is not already present     *)
(*   in the table then insert_table is true, else it is false, and   *)
(*   the element is not inserted.                                    *)
(*                                                                   *)
(*********************************************************************)

var
destination, source: integer;
local_inx: integer;
local_cont: boolean:= true;

begin
if not search_table(local_key, local_inx, local_top, local_bottom, local_table) then
begin     (* element is not already in the table *)
source:= local_bottom;
local_bottom:= local_bottom + 1;
destination:= local_bottom;
if local_bottom > local_top then
while local_cont do
if source < local_top then
local_cont:= false
else     (* source >= local_top *)
if local_table(source).skey > local_key then
begin
local_table(destination):=local_table(source);
destination:= destination - 1;
source:= source - 1;
end     (* if local_table(source).key > local_key *)
else
local_cont:= false;
local_table(destination).skey:= local_key;
local_table(destination).index:= local_index;
insert_table:= true;
end     (* if not search_table(local_key, .... ) *)
else     (* search_table(local_key, .... ) *)
begin     (* element is already in the table *)
local_index:= local_inx;
insert_table:= false;
end;     (* else search_table(local_key, .... ) *)
end.     (* insert_table *)

endbody;
\f



prefix remove_table;



function remove_table(local_key: ! integer;
var local_index: integer;
local_top: ! integer;
var local_bottom: integer;
var local_table: indextab): boolean;

(********************************************************************)
(*                                                                  *)
(*                          remove_table                            *)
(*                                                                  *)
(* parameters:                                                      *)
(*   local_key: the key of the element that is to be removed from   *)
(*     the ordered local_table (call parameter).                    *)
(*   local_index: second part of the element that is removed from   *)
(*     local_table. it is unchanged, if the element is not found    *)
(*     (return parameter).                                          *)
(*   local_top: first element in local_table (call parameter).      *)
(*   local_bottom: last element in local_table. if the specified    *)
(*     element is removed, then local_bottom is decremented (call   *)
(*     and return parameter).                                       *)
(*   local_table: specifies the actual index table that is used     *)
(*     (call and return parameter).                                 *)
(* call of other procedures: search_table.                          *)
(* use of global variables: none.                                   *)
(* waiting points: none.                                            *)
(* function: the function removes the element pointed out by        *)
(*   local_key from the local_table. if the element is found        *)
(*   then remove_table is true else remove_table is false at        *)
(*   return.                                                        *)
(*                                                                  *)
(********************************************************************)

var
destination, source: integer;

begin
if search_table(local_key, destination, local_top, local_bottom, local_table) then
begin     (* element is in the table *)
local_index:= local_table(destination).index;
source:= destination + 1;
while source <= local_bottom do
begin
local_table(destination):= local_table(source);
destination:= destination + 1;
source:= source + 1;
end;     (* while source <= local_bottom *)
local_bottom:= local_bottom - 1;
remove_table:= true;
end     (* if search_table(local_key, .... ) *)
else     (* not search_table(local_key, .... ) *)
remove_table:= false;
end.     (* remove_table *)
endbody;
\f



prefix answ_lcp;





procedure answ_lcp(var ref: reference;
stat: set of sp_status_bit; bcnt: integer);

begin
lock ref as p: r_lcp_head do
with p.sp_head do
begin
status:=stat;
bytecount:= bcnt;
end;
ref^.u2:=ok;
return(ref);
end.
endbody;
\f



prefix copy_event;



procedure copy_event (var r: reference);

(* this procedure copies an internal router event report to the
ncp event buffer deliveed along with it. The top of r (popped off)
which is the internal event is returned in r and the rest af the
message is returned by a return call after the copying. *)

var top: reference;

begin
pop (top, r);
lock r as ncp_ev: r_lcp_event do
lock top as int_ev: int_event_type do
begin
ncp_ev.evtrec:= int_ev.evtrec;
ncp_ev.data:= int_ev.data;
ncp_ev.sp_head.bytecount:=2+int_ev.evtrec.bytecount;
ncp_ev.last:=ncp_ev.first-1+ncp_ev.sp_head.bytecount+sp_head_lgt;
end;
r^.u2:= ok;
return (r);    (* return event buf to ncp *)
r:=: top;      (* return top in returnparam r *)
end. (* procedure copy_event *)
endbody;
\f




prefix find_dest;
procedure find_dest(own_addr,dest_addr: nwadr;
                     var dest_level: integer);

(* the procedure finds the destination level as an index
in the destination address array *)

begin
dest_level:=rlmax;
while (dest_level<>1) and (own_addr(dest_level)=dest_addr(dest_level))
do dest_level:=dest_level-1;
end.
endbody;
\f





prefix get_addr;

procedure get_addr(var p: pack1; var addr: nwadr);

(* the destination address (ext,reg,net) of the specified packet
is placed in the address array - element no 1 is the node no *)

begin
if rlmax>=1 then
addr(1):=p.head.node_dst;
if rlmax>=2 then
addr(2):=p.head.reg_dst;
if rlmax>=3 then
addr(3):=p.head.net_dst;
end.
endbody;
\f





prefix swaph1;
procedure swaph1(var packet: pack1);

(* the origin/destination addresses are swapped *)

var
h:phead1;

begin
with packet do
begin
h.net_dst:=head.net_dst;
h.reg_dst:=head.reg_dst;
h.node_dst:=head.node_dst;
h.ext_dst:=head.ext_dst;
with head do
begin
net_dst:=net_org;
reg_dst:=reg_org;
node_dst:=node_org;
ext_dst:=ext_org;
end;
head.net_org:=h.net_dst;
head.reg_org:=h.reg_dst;
head.node_org:=h.node_dst;
head.ext_org:=h.ext_dst;
end;
end.
endbody;
\f





prefix update_queue;
procedure update_queue(var queues: qinftable;
                       conn_no,update: integer);

(* the procedure updates the queuelength for the specified
connector no - queue(conn_no):=queue(conn_no)+update.
Note that the procedure contains a waiting point as
it waits for the queues semaphore *)

var
ref: reference;

begin
wait (ref, queues.key);    (* enter critical region *)
queues.qlgt(conn_no):= queues.qlgt(conn_no)+ update;
signal(ref,queues.key);    (* exit critical region *)
end.
endbody;
\f




prefix update_range;
procedure update_range (update: integer; var rng: packnnp);

(* the procedure updates a received rangevector by adding update
to each stated range in the vector. *)

var
i,lgt: integer;

begin
lgt:= (rng.drvbuf.last - rng.drvbuf.first + 1 - pnnph_lgt-rparam_lgt) div 2;
for i:=1 to lgt do
rng.data(i):= rng.data(i) + update;
end.
endbody;
\f




prefix check_hshake;
function check_hshake (var p: packnnp; var hshake: handshake): boolean;

(* the procedure checks the received handshake packet against the
handshake packet (password etc.) kept in this node in var hshake.
if the compare is satisfying the result is true. *)

var
i: integer;

begin
check_hshake:= true;
for i:= 1 to lgt_hshake do
if p.data(i) > hshake(i) then
check_hshake:= false;
end. (* check hshake *)
endbody;
\f




prefix chup_nwtime;
procedure chup_nwtime (actual: int32; var time: nwtime);

(* the procedure checks the actual (received) networktime against
the network time in this node. If actual is greatest the local
network time is updated (to actual) *)

var
r: reference;

begin
wait (r, time.key);        (* critical region *)
if comp32 (actual, time.t)= gr then
time.t:= actual;  (* update network time *)
signal (r, time.key);
end.
endbody;
\f




prefix rout_table_update;
procedure rout_table_update (var t: routtable; var p: packnnp;
conn_no: integer; var upd: cboolarray);

(* this procedure updates a routing matrix on basis of a received
range vector. the procedure inserts the new range column in the
routing matrix at column index conn_no. in the return parameter upd
is stated which connectors needs to transmit new nnp information.
if upd(i) after return is true then connector no i must transmit
a new range vector. *)

var
nn, dnew, dold, dmin, i: integer;
c_upd: integer:= -1;
rt: reference;

begin (* procedure begin *)
for i:= 1 to cmax do upd(i):= false;  (* init no updates *)
wait (rt, t.key);                     (* enter critical region *)

for nn:= 1 to t.act_nmax do
begin  (* loop through range vector *)
dnew:= p.data(nn);  (* get range to nn *)
if dnew> t.infway then dnew:= t.infway;
dold:= t.tab(nn, conn_no);
if dnew <> dold then
begin  (* distance changed *)
t.tab(nn, conn_no):= dnew;
if c_upd <> 0 then
begin  (* check which connectors needs to change *)
if dnew < dold then dmin:= dnew
else dmin:= dold;
c_upd:= 0;
for i:= 1 to cmax do
if (i <> conn_no) and (dmin >= t.tab(nn, i)) then
if c_upd= 0 then c_upd:= i else c_upd:= -1;
if c_upd= 0 then  (* all must change *)
begin
for i:= 1 to cmax do
if i <> conn_no then upd(i):= true
end
else
if c_upd> 0 then upd(c_upd):= true;    (* one must change *)
(* c_upd= -1:  none must change *)
end;  (* check which connectors ... *)
end;  (* dnew <> dold *)
end;  (* loop through range vector  (nn-loop) *)

signal (rt, t.key);            (* exit critical region *)
end. (* procedure *)
endbody;
\f




prefix insert_local_node;
procedure insert_local_node (var t: routtable; conn_no, node_no: integer);

(* this procedure performs the updating of the node routing table needed
when a local connector connects itself to the router, i.e. inserts the
range vector with one zero (the node no) and infinite in all other posi-
tions *)

var
rngvec: packnnp;
upd: cboolarray;
i: integer;

begin
rngvec.drvbuf.first:=6;
rngvec.drvbuf.last:=5+pnnph_lgt+rparam_lgt+(2*t.act_nmax);
for i:= 1 to t.act_nmax do rngvec.data(i):= t.infway;
rngvec.data(node_no):= 0;   (* range to this node = 0 *)
rout_table_update (t, rngvec, conn_no, upd);
end.  (* procedure insert local node *)
endbody;
\f




prefix conn_down;
procedure conn_down (var rtabs: rtabarray; conn_no: integer);

(* this procedure performs the updating of the routing tables
needed when a connector (line connector) goes down. The routing
tables of the levels relevant to this connector are updated so
that infinite is inserted in the column corresponding to this
connector. *)

var
rngvec: packnnp;
upd: cboolarray;
level, i: integer;

begin
for level:= 1 to rlmax do
begin
for i:= 1 to pnnpmax do rngvec.data(i):= rtabs(level).infway;
rout_table_update (rtabs(level), rngvec, conn_no, upd);
end; (* level loop *)
end. (* procedure conn_down *)
 endbody;
\f


prefix new_conn_state;
procedure nwe_conn_state(var queues: qinftable;
conn_no:integer; state:c_state_type);

(* The procedure sets a new connector state *)

var
r:reference;
begin
wait(r,queues.key);
queues.state(conn_no):=state;
signal(r,queues.key);
end.
endbody;
\f



prefix ret_nnp_req;
procedure ret_nnp_req(var waiting: semaphore);
(* the procedure returns a nnp event request if there is one *)
var
r: reference;

begin
if open(waiting) then
begin
wait(r,waiting);
r^.u2:=ok;
return(r);
end;
end.
endbody;
\f





prefix get_nnpfl;
function get_nnpfl(var flagtable: nnpfltable;
                   conn_no: integer; var inx: integer): boolean;

(* the function reads the nnp flag table and returns the nnp
function according to the first flag set. The flag is then reset.
If no flags are set the function is false.
Note that the function contains a waiting point as it 
waits for the nnp flag table. *)

var
ref: reference;
b: boolean;

begin
wait(ref,flagtable.key);        (* enter critical region *)
b:= false;
with flagtable do
begin
inx:=0;
repeat
inx:=inx+1;
if flag(conn_no,inx)=1 then
begin  (* flag found *)
flag(conn_no,inx):=0;      (* reset flag *)
cnt(conn_no):=cnt(conn_no)-1;
b:= true;
end;
until b or (inx= nnpmax);
end;
signal(ref,flagtable.key);        (* exit critical region *)
get_nnpfl:= b;
end.
endbody;
\f





prefix set_nnp_fl;
function set_nnp_fl(conn_no,index: integer;
var tab: nnpfltable): boolean;

(* the function sets the specified flag in the nnp flag table.
The function is false if the flag was set already. the nnp flag
table must be waited for before the function is called *)

begin
with tab do
if flag(conn_no,index)=1 then set_nnp_fl:=false else
begin
flag(conn_no,index):=1;
cnt(conn_no):=cnt(conn_no)+1;
set_nnp_fl:=true;
end;
end.
endbody;
\f




prefix build_hshake;
procedure build_hshake (var h: handshake; var packet: packnnp);

(* this procedure creates the handshake nnp packet (nnp protocol)
with the data part defined in the var param h. First and last is
initialized. And packet header except function is initialized. *)

var
i: integer;

begin
with packet.head do
begin
format:= dg_form3;
priority:= nnp_prio;
typ:= int_sup_p;
end; (* with head do *)
packet.drvbuf.first:=6+rparam_lgt;
packet.drvbuf.last:=2*lgt_hshake+pnnph_lgt+6+rparam_lgt-1;
for i:= 1 to lgt_hshake do
packet.data(i):= h(i);
end. (* procedure *)
endbody;
\f




prefix build_nwtime;
procedure build_nwtime (var nwt: nwtime; var packet: packnnp);

(* this procedure creates the nnp networktime packet (nnp protocol)
both data part and header (incl. first and last) except function. *)

var
r: reference;

begin
with packet.head do
begin
format:= dg_form3;
priority:= nnp_prio;
typ:= int_sup_p;
end; (* with head do *)
packet.drvbuf.first:=6+rparam_lgt;
packet.drvbuf.last:=4+pnnph_lgt+6+rparam_lgt-1;
wait (r, nwt.key);                (* get network time *)
packet.data(1):= nwt.t.msp;
packet.data(2):= nwt.t.lsp;
signal (r, nwt.key);              (* release network time *)
end. (* procedure *)
endbody;
\f




prefix build_rngvec;
procedure build_rngvec (var t: routtable; var packet: packnnp;
conn: integer);

(* this procedure creates a rangevector packet (nnp protocol)
on basis of the routing matrix t. The column with index no
conn is not used. First and last is initialized. And packet-
head format, priority and type but not function is initiali-
zed. *)

var
ref: reference;
i,j,r,d: integer;
inx: integer:= 0;

begin
wait (ref, t.key);        (* enter critical region *)
with packet.head do
begin
format:= dg_form3;
priority:= nnp_prio;
typ:= int_sup_p;
end;
packet.drvbuf.first:=6+rparam_lgt;
packet.drvbuf.last:=2*t.act_nmax+pnnph_lgt+6+rparam_lgt-1;
for i:= 1 to t.act_nmax do
begin
d:= t.infway;
for j:= 1 to cmax do
if j <> conn then
begin
r:= t.tab(i,j);
if r < d then d:= r;
end;
inx:= inx+1;
packet.data(inx):= d;      (* least distance found *)
end;  (* i-loop *)
signal (ref, t.key);        (* exit critical region *)
end.
endbody;
\f



prefix reject;

function reject(var packet: pack1; rej_state:integer) : boolean;

(* the function tests whether or not the specified packet
may be rejected. If so the packet is changed to a rejected 
packet with state as parameter rej_state. A packet may be
rejected if state = 0 and facility reject bit is true. Or
if state = 0, facility 'reject by exceeded lifetime' is true
and parameter rej_state indicates exceeded lifetime. *)

begin
reject:= false;
if packet.head.state= 0 then
if (packet.head.fac.rej= 1) or
((rej_state= st_ltexceed) and (packet.head.fac.rejlt= 1)) then
begin (* packet may be rejected *)
reject:= true;
swaph1 (packet);
with packet do
begin
if head.fac.hrej= 1 then drvbuf.last:= drvbuf.first+phead1_lgt;
head.state:= rej_state;
end;
end;
end. (* reject function *)
endbody;
\f





prefix route;
function route (var t: routtable; var q: qinftable;
    var dest: integer; dyn: boolean): boolean;

(* finds the optimal direction towards dest. The found
   conn.no. is returned in dest. *)

var
c, lastused, min, dist, conn: integer;
rt, rq: reference;

begin
if (dest>0) and (dest<=t.act_nmax) then
begin

wait (rq, q.key);  (* get queueinformation *)

wait (rt, t.key);  (* get routing table *)

min:= t.infway;
conn:= 0;
lastused:= t.lastconn(dest);
for c:= 1 to cmax do
begin
if q.state(c) = running then
begin
if dyn then dist:= t.tab(dest,c)+q.qlgt(c)
       else dist:= t.tab(dest,c);
if dist < t.infway then
begin
if dist < min then
begin
min:= dist;
conn:= c;        (* minimal path so far *)
end else
if dist = min then
if conn = lastused then conn:= c;
end;
end;
end;             (* search through row n *)

if conn = 0 then
route:= false   (* no path found *)
else
begin
t.lastconn(dest):= conn;
q.qlgt(conn):= q.qlgt(conn) + 1;  (* incr queuelgt *)
dest:= conn;
route:= true;
end;

signal (rt, t.key);   (* release routing table *)

signal (rq, q.key);   (*release queueinformation *)

end   else
route:=false;


end.    (* routing procedure *)
endbody;
\f




prefix masterroute;
function masterroute (var packet: pack1; var dest: integer;
var ownadr, destadr: nwadr; var rtables: rtabarray;
var queues: qinftable): boolean;

(* performs the routing/rejecting of one packet *)

var
destlev: integer;
b: boolean;

begin
find_dest (ownadr, destadr, destlev);
dest:= destadr(destlev);
b:= route (rtables(destlev), queues, dest, false);
if b then
masterroute:= b
else
begin
if reject (packet,st_extunkn-destlev) then
begin
get_addr (packet, destadr);
masterroute:= masterroute (packet, dest, ownadr, destadr, rtables, queues)
end
else
masterroute:= false;
end;
end.
endbody;
\f




prefix check_node;
function check_node(var t: routtable; node: integer;var dest:integer)
: boolean;

(* The function tests if the specified node is this node i.e.
the row in the routing table pointed out by node is searched
to find a zero. if a zero is found the node is this
node (connector number dest ) and the function is true else false.
- Note that the function contains a waiting point as it waits
for the routing table *)

var
ref: reference;
b: boolean:= false;

begin
wait(ref,t.key);    (* get routing table  *)
dest:=0;
repeat
dest:= dest+1;
if t.tab(node,dest)=0 then b:=true;
until b or (dest=cmax);
check_node:=b;
signal(ref,t.key);  (* release routing table *)
end.
endbody;
\f




prefix check_neighb;
function check_neighb(var t: routtable; node: integer;
var dest: integer) : boolean;

(* The function tests if the specified node is a neigbhour
i.e. the row in the routing table pointed out by node is
searched for elements smaller than infway. For each of these
elements the involved column is searched to check whether or not
the element is the smallest element in the column. If the element
is the smallest element the node is a neigbhour node on connector
number dest and the function is true else false.
- note that the function contains a waiting point as it waits
for the routing table *)

var
ref: reference;
b: boolean:= false;
j: integer;

begin
wait(ref,t.key);     (* get routing table  *)
dest:=0;

repeat
dest:= dest+1;
if t.tab(node,dest) < t.infway then
begin
j:=0;
b:=true;
repeat
j:= j+1;
if j<>node then
if t.tab(j,dest) < t.tab(node,dest) then b:=false;
until not(b) or (j=t.act_nmax);
end;
until b or (dest=cmax);
check_neighb:=b;
signal(ref,t.key);   (* release routing table  *)
end.
endbody;
\f




prefix lifetime_exc;
function lifetime_exc(var p: pack1; var netwtime: nwtime):boolean;

(* the function checks whether or not the lifetime control is
on and if on, the function checks if the lifetime of the packet
has exceeded. If the lifetime has exceeded the function is true
else false.
If the link measurement is on the link limit is decremented -
note that only the right byte of the linklimit is significant *)

var
i: integer;
b: boolean;

begin
b:=false;
if p.head.fac.linklt=1 then
begin (* link control on *)
if p.data(p.head.top_of_data+link_limit+1) = 0 then
 (* link exceeded *)
b:=true
else
p.data(p.head.top_of_data+link_limit+1):=
p.data(p.head.top_of_data+link_limit+1)-1;
end;

if (p.head.fac.timelt=1) and not(b) then
begin (* time control on *)
i:=(p.data(p.head.top_of_data+tim_limit))*256
+ p.data(p.head.top_of_data+tim_limit+1);
if dif16(i,netwtime.t.lsp) < 0 then b:=true;
end;
lifetime_exc:=b;
end.
endbody;
\f



prefix upd_nxt_rec;

function upd_nxt_rec(var p:pack1; toprec:integer;
var nextrec: integer) : boolean;

(* the function updates the next record in the trailer of
the packet and the variable nextrec. the updating is equal
to trrec_lgt. if there is not enough room in the packet
no updating is issued and the function is false else true.
- note that only the right byte of the next record field is
significant *)

begin
if nextrec + trrec_lgt <= toprec then
begin
nextrec:=nextrec+trrec_lgt;
p.data(p.head.top_of_data+next_rec+1):=nextrec;
upd_nxt_rec:=true;
end else    upd_nxt_rec:=false;
end.
endbody;
\f



prefix place_trace;

procedure place_trace(var p:pack1; toprec: integer;
var nextrec:integer; var netwtime: nwtime; var ownadr: nwadr);

(* if room, the procedure places a trailer record in the specified
packet at the index pointed out by nextrec. 
The variable nextrec and next record in the trailer are updated
with trrec_lgt *)

begin
if nextrec+trrec_lgt<=toprec then
begin
p.data(nextrec+tr_rec_reg):=ownadr(2);   (* region *)
p.data(nextrec+tr_rec_node):=ownadr(1);   (* node *)
p.data(nextrec+tr_rec_time):=netwtime.t.lsp div 256;
p.data(nextrec+tr_rec_time+1):=netwtime.t.lsp mod 256;
nextrec:=nextrec+trrec_lgt;
p.data(p.head.top_of_data+next_rec+1):=nextrec;
end;
end.
endbody;
\f



prefix check_path;

function check_path(var p:pack1; var rt:rtabarray;
toprec: integer; var nextrec: integer; var dest : integer;
var daddr: nwadr; var ownaddr: nwadr) : pfacttype;

(* the function handles the fixed path bit which must be
set when the function is called - the actions are:

1) if the  path has exceeded i.e. nextrec>toprec the
function is route_p and daddr contains the destination address
read from the packet header. The packet should then be routed
using masterroute.

2) if the  path has not exceeded it is tested whether or
not the node pointed out by nextrec in the trailer is this
node. If so , the next record in the packet and the variable
nextrec are updated. If the node is not this node no updating
is issued. If the updating results in an overflow the actions
are as described in 1).

3a) If fixed  path is specified in the facility mask:
Then the node of the next record is tested  for being a
neighbour node. If so the function is route_to_dest and the variable
dest contains the connector number to which the packet should
be routed. If the node is not a neighbour node 
 the function is reject_p ( the packet should be rejected ).

3b) If selected path is specified in the facility mask:
The destination address held in the next record of the
trailer is placed in daddr. The function is route_p and the
packet should be routed using masterroute.

Note that the function contains waiting points as it calls
check_node and check_neigh *)



begin
if nextrec>toprec then
begin (*  path exceeded *)
check_path:=route_p;
get_addr(p,daddr);
end   else
begin
if check_node(rt(1),p.data(nextrec+tr_rec_node),dest) then
begin (* this node *)
nextrec:=nextrec+trrec_lgt;
p.data(p.head.top_of_data+next_rec+1):=nextrec;
end;
if nextrec>toprec then
begin (*  path exceeded *)
check_path:=route_p;
get_addr(p,daddr);
end  else
begin (*  path not exceeded *)
if p.head.fac.fpath=1 then
begin (* fixed path *)
if check_neighb(rt(1),p.data(nextrec+tr_rec_node),dest) then
check_path:=route_to_dest else
check_path:=reject_p;
end else
begin (* selected path *)
daddr(3):=ownaddr(3);  (* net *)
daddr(2):=p.data(nextrec+tr_rec_reg); (* region *)
daddr(1):=p.data(nextrec+tr_rec_node); (* node *)
check_path:=route_p;
end;
end;
end;
end.
endbody;
\f



prefix check_facility;

function check_facility(var p: pack1; var rt:rtabarray;
toprec: integer; var nextrec: integer; var dest: integer;
var daddr: nwadr; var ownaddr: nwadr; var prejst: byte;
var netwtime: nwtime; mode:integer) : pfacttype;

(* The function checks the facility mask of the specified
packet. The value of the function:

reject_p:   The packet should be rejected with the reject
            cause as specified in prejst. The function has
            this value when:
            - The lifetime of the packet has exceeded(not tested if mode=0)
              (prejst=st_ltexceed)
            - If the node in the trailer of a fixed path record
              is not a neighbour node to this node.
              (prejst=st_fpatherr)

route_p:    The packet should be routed to the destination
            address held in daddr using the function masterroute.

route_to_dest: The packet should be routed (signalled) to the
            connector number held in dest.

route_to_sup: The packet should be routed (signalled) to the
            supervisor (only if the broadcast bit is set).

Note that the facility mask should be <>0 when the function
is called. If unknown facility bits are set the value og the
function is route_p.
The function should only be called by transmitter processes in the
Router. 

Note that the function contains waiting points if the fixed or
selected path bits are set as the function check_path is called.*)

label
return1;


begin
if mode <> 0 then
if lifetime_exc(p,netwtime) then
begin (* lifetime exceeded *)
check_facility:=reject_p;
prejst:=st_ltexceed;
goto return1;
end;
if p.head.fac.bcast=1 then check_facility:=route_to_sup else
begin (* broadcast not set *)
if (p.head.fac.fpath=1) or (p.head.fac.spath=1) then
begin (* fixed or selected path *)
check_facility:=check_path(p,rt,toprec,nextrec,dest,daddr,ownaddr);
prejst:=st_fpatherr;  (* used if reject_p *)
end  (* fixed or selected path *) else
if p.head.fac.trace=1 then
begin (* trace *)
place_trace(p,toprec,nextrec,netwtime,ownaddr);
get_addr(p,daddr);
check_facility:=route_p;
end (* trace *) else
begin (* other facility bits set *)
get_addr(p,daddr);
check_facility:=route_p;
end;
end; (* broadcast not set *)
return1:
end. (* function *);

endbody;
.
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦dc0c8bd20⟧ TextFile

Derivation

TextFile
