DataMuseum.dk

Presents historical artifacts from the history of:

RC3500

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC3500

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦02cd597ce⟧ TextFileVerbose

    Length: 8448 (0x2100)
    Types: TextFileVerbose
    Names: »lorec«

Derivation

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

TextFileVerbose

(******************************************************************)
(*                                                                *)
(* process local    receiver                                      *)
(* ---------------------------------------------------------------*)
(*                                                                *)
(* ltrm:          transmit semaphores for connectors in the node  *)
(* rtables:       routing tables for levels 1, 2, ... rlmax       *)
(* queues:        queue and state for each connector in the node  *)
(* netwtime:      network time                                    *)
(* utrm_sem:      main semaphore of the local      receiver       *)
(* supv:          supervisor semaphore                            *)
(* cparams      : transmit delay = (cpm(1)*2**cpm(2)) msec        *)
(* ext_rout_tab:  extension level routing table (ELRT)            *)
(* index_elrt:    index ELRT                                      *)
(* no_of_ext:     number of extensions connected                  *)
(* ownaddr:       network address of this node                    *)
(* c:             connector number of this connector (index in    *)
(*                arrays 1..cmax)                                 *)
(*                                                                *)
(******************************************************************)



process lorec( var sysvec:system_vector;
var ltrm: !ltsmarray;
var rtables: rtabarray;
var queues: qinftable;
var netwtime: nwtime;
var ext_rout_tab: extrouttable;
var index_elrt: indextab;
var cparams: cparams_type;
var utrm_sem: !tap_pointer;
var supv: !tap_pointer;
var no_of_ext: integer;
var ownaddr: nwadr;
c: integer);

const

version='ver. 810119/';




var
z:zone;
action_p: boolean;
prejst: byte;
daddr: nwadr;
toprec,nextrec: integer;
extindex: integer;
dest: integer;
msg: reference;
timerhead: pool 1;
timersem: semaphore;


function check_p_form(var ref: reference; var extindex: integer;
no_of_ext: integer;
var index_elrt: indextab) : pack_error;

(* The function checks the format of the specified reference
( packet ). If the extension number does not exist in the ELRT
the function is equal to extunknown.If the format of the packet
is illegal the function is equal to form_error.If ok the function
is equal to form_ok and extindex holds the index in the ELRT.
 The procedure search_table is called.The 
following must be fulfilled:

-  ref^.size>=6+phead1_lgt+rparam_lgt
-  extension number must exist in ELRT
-  format = dg_form1
-  if broadcast in facility then lifetime must be set too
-  priority  ?
-  type is set to ext_user_p     *)

var
i:integer;
begin
if ref^.size < 6+phead1_lgt +rparam_lgt then
check_p_form:=form_error  else
begin
lock ref as p: pack1 do with p do
begin
case search_table(rparam.rparam1,i,1,no_of_ext,index_elrt) of
true:
begin
extindex:=index_elrt(i).index;
if head.format <> dg_form1 then
check_p_form:=form_error else
begin
if p.head.fac.bcast=1 then
if (p.head.fac.timelt=0) and (p.head.fac.linklt=0) then
check_p_form:=form_error   else
begin
  (* priority check ??? *)
head.typ:=ext_user_p;
check_p_form:=form_ok;
end     else check_p_form:=form_ok;
end;
end;
false:
check_p_form:=extunknown;
end; (* case *)
end;
end;
end;









begin

testopen(z,own.incname,sysvec(operatorsem));
testout(z,version,0);


(*   mangler:       ----------------------------------------------*)
(* evt andring af delay1,delay2  *)


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

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

(*------------------------------*)
(*  output                      *)
(*------------------------------*)
trm_packet,dir_transm:
begin (* output *)
case check_p_form(msg,extindex,no_of_ext,index_elrt) of

(*------------------------------*)
(*  packet format ok            *)
(*------------------------------*)
form_ok:
begin (* packet format ok *)
inc16(ext_rout_tab.tab(extindex).st.xmit);
case msg^.u1 of

(*------------------------------*)
(*  transmit packet             *)
(*------------------------------*)
trm_packet:
begin (* transmit packet *)
lock msg as p: pack1 do
begin (* lock *)
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,0) 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 *)
if action_p then

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

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


end; (* transmit packet *)

(*------------------------------*)
(*  directed transmit           *)
(*------------------------------*)
dir_transm:
begin (* directed transmit *)
dest:=msg^.u3;      (*  read connector number *)
if (dest<1) or (dest>cmax) then
begin (* connector no illegal *)
msg^.u2:=conn_unkn;
return(msg);
end  (* connector no illegal *) else

begin (* route packet *)
if queues.state(dest)=not_crea then
begin (* connector illegal *)
msg^.u2:=conn_unkn;
return(msg);
end        else
begin
lock msg as p:pack1 do
begin (* lock *)
if p.head.fac.trace=1 then
begin (* trace bit set *)
toprec:=p.data(p.head.top_of_data+top_of_trail+1);
nextrec:=p.data(p.head.top_of_data+next_rec+1);
place_trace(p,toprec,nextrec,netwtime,ownaddr);
end;  (* trace bit *)
end;  (* lock *)
signal(msg,ltrm(dest).s^);
update_queue(queues,dest,1);
end;
end;  (* route packet *)

end; (* directed transmit *)

end; (* case msg^.u1 *)

(*------------------------------*)
(*  wait a bit                  *)
(*------------------------------*)
if cparams(4)<>0 then
begin
alloc(msg,timerhead,timersem);
msg^.u2:=message;
msg^.u3:=cparams(4);
msg^.u4:=cparams(5);
sendtimer(msg);
wait(msg,timersem);
release(msg);
end;


end; (* packet format ok *)

(*------------------------------*)
(* packet format eror           *)
(*------------------------------*)
form_error:
begin (* packet format error *)
msg^.u2:=ill_p_form;
return(msg);
end; (* packet format error *)

(*------------------------------*)
(*  extension no unknown        *)
(*------------------------------*)
extunknown:
begin (* ext no unknown *)
msg^.u2:=ext_unkn;
return(msg);
end;  (* ext no unknown *)

end; (* case check_p_form *)


end;  (* output *)

otherwise

(*------------------------------*)
(*  unknown functions           *)
(*------------------------------*)
begin (* unknown functions *)
msg^.u2:=illegal;
return(msg);
end;  (* unknown function  *)

end;  (* case msg^.u1  *)

end;  (* message *)

otherwise

(*------------------------------*)
(*  answer                      *)
(*------------------------------*)
release(msg);   (* error  *)

end;  (* case msg^.u2  *)

until false;

end.  (* process lorec *)

«eof»