⟦23c3d52cc⟧

TextFile

job oer 5 200 time 11 0 area 10 size 100000
(
source = copy 25.1
pxhltlst=set 1 disc1
pxhlterr=set 1 disc1
pxhltlst=indent source mark lc
listc=cross pxhltlst
o pxhlterr
mode list.yes
message compile pxhlt
pascal80 codesize.1024 xtenv xncpenv xpoolenv xrouenv routenv testenv source
mode list.no
o c
lookup pass6code
if ok.yes
(pxhltbin=set 1 disc1
pxhltbin=move pass6code
scope user pxhltbin
)
pxhltlst=copy listc pxhlterr
scope user pxhltlst
scope user pxhlterr
finis
)
(******************************************************************)
(*                                                                *)
(* process hdlcline transmitter                                   *)
(* ---------------------------------------------------------------*)
(*                                                                *)
(* ltrm:          transmit semaphores for connectors in the node  *)
(* hlrec_sem:     this line receive connector semaphore           *)
(* hdlc_sem:      hdlc semaphore                                  *)
(* hdlcsim2:      other end of hdlc simulator (for test)          *)
(* 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         *)
(* poolnnp:       poolhandler process for nnp packets             *)
(* supv:          router supervisor process                       *)
(* cparams:       specific parameters for this connector          *)
(*                  1: hardwarelevel of driver                    *)
(*                  2: drivertype to be created:                  *)
(*                     0: hdlc driver                             *)
(*                     1: hdlc simulator (intern hdlc)            *)
(*                     2: alc driver                              *)
(* ownaddr:       network address of this node                    *)
(* c:             connector number of this connector (index in    *)
(*                arrays 1..cmax)                                 *)
(*                                                                *)
(******************************************************************)



process hltrm ( var sysvec: system_vector;
var ltrm: ! ltsmarray;
var hlrec_sem: ! 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, supv: ! tap_pointer;
var cparams: cparams_type;
var ownaddr: nwadr;
c: integer);


const

version='ver. 810410/';
(* basic constants *)

lcpbuf=2;        (* no of buffers for lcp etc. *)

(* hdlc u1 values *)

hl_sense_status= 0+0;
hl_connect= 0+4;
hl_disconn= 0+8;
hl_return_all= 0+12;
hl_ret_unused= 0+16;
hl_modem_contr= 0+24;
hl_read_stati= 0+28;
hl_recl_stati= 0+32;
hl_sense_lspeed= 0+36;
hl_event= 0+40;
hl_testout= 0+44;

(* hdlc other values *)

not_trm= 5;    (* result (u2): no attempt to transmit packet *)
hlup = 0;      (* hdlc line state up (result div 8) *)
hlclosed = 1;  (* hdlc line state closed *)

(* streams  (u4) *)

nnp_ev_req= 1;
hdlc_data= 7;
hdlc_dirtrm= 6;
hdlc_nnp= 8;
hdlc_other= 5;
nnp_buf= 2;
ev_return= 3;


createerror='create error';
linkerror='link error  ';

(* type declarations *)

type

hl_conn_type= record
na1, na2, na3: integer;
autoconnect: boolean;
connect_ident,
t1,
n2,
k: integer;
end;

hl_modem_cnt_type= record
na1, na2, na3: integer;
update_rts,
rts,
update_dtr,
dtr: boolean
end;

hl_stati_type= record
d: array (1 .. 80) of byte;
end;
 (* temporary *)



(* variables *)

var

z:zone;
linerange: integer:= 1;
linespeed: integer;

trm_heads: pool tbuf;
nnp_heads: pool 1;
nnp_bufs: pool 1 of pack1;   (* should be packnnp *)
lrecbuf: pool 1;
lcp_ops: pool 2 of hl_stati_type;
ev_heads: pool 2 of int_event_type;  (* for events (hdlc and lcp) *)
wpsem: semaphore;    (* for waiting packets *)
wp: integer:= 0;     (* no of waiting packets *)

helpsem: semaphore;

state: c_state_type:= stopped;    (* connector state *)

(* hdlc line connector statistics *)
stat: stat_hlcon:= stat_hlcon (0,0,0,0,0,0,0);

lcp_op: lcp_oper_type;
sp_st: set of sp_status_bit;
sp_bcnt: integer;

str: integer;
daddr: nwadr;
mastrt: boolean;
dest: integer;
hl_u3: byte;
result: integer;
i: integer;
h, msg: reference;

hlrec_proc, hdlc_proc: shadow;

(*------------------------------------------------------------*)
(*  line receiver process declaration                         *)
(*------------------------------------------------------------*)

process hlrec (var sysvec: 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, supv, hdlc, hlrec_sem: ! tap_pointer;
var stat: stat_hlcon; var ownaddr: nwadr;
c: integer);
external;

(*------------------------------------------------------------*)
(*  hdlc driver process declaration                           *)
(*------------------------------------------------------------*)

process hdlc(
var req_sem: semaphore; rec_level: integer);
external;

(*------------------------------------------------------------*)
(*  hdlc simulator process declaration                        *)
(*------------------------------------------------------------*)

process hdlc_sim (var sysvec: system_vector;
var req_sem, other_req_sem: ! tap_pointer;
rec_level: integer);
external;

(*-----------------------------------------------------------*)
(*  alc driver process declaration                           *)
(*-----------------------------------------------------------*)

process alc (
var req_sem: ! tap_pointer;
var second_sem: ! sempointer;
port_no: byte);
external;

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

procedure send_to_sup (var r: reference; u1, u4: integer);

(* signals the operation r to sup after inserting u1, u4 and
setting u2= message and u3= c (conn. no).
uses global:
  c        connector number
  supv     supervisor process
*)

begin
r^.u1:= u1;
r^.u2:= message;
r^.u3:= c;
r^.u4:= u4;
signal (r, supv.s^);
end; (* send to sup *)


 procedure event_to_sup (var r: reference; ev, lstate: byte);

(* sends an event to supervisor *)
(* uses global:  c, supv, ev_return *)

begin
lock r as p: int_event_type do
begin
p.evtrec.event_type:= ev;
p.evtrec.rout_mod:= connector_mod;
p.evtrec.incarnation:= c;
p.evtrec.bytecount:= 3;
p.data(1):= lstate*256;
end; (* lock *)
r^.u1:= wait_event_buf;
r^.u2:= message;
r^.u3:= c;
r^.u4:= ev_return;
signal (r, supv.s^);  (* send to supervisor *)
end;


procedure lrec_command (var h: reference; u1value: byte);

(* sends a command (param) to line receiver. Uses global:
  lrecbuf   pool with buffer for this purpose
*)

begin
alloc (h, lrecbuf, ltrm(c).s^);
h^.u1:= u1value;
h^.u2:= message;
h^.u3:= linerange;
signal (h, hlrec_sem.s^);
end;  (* lrec_command *)


procedure contr_to_hdlc (var r: reference; u1: integer);

(* sends the message in r to hdlc with u1 as param. Inserts
u2 = message, u3 = hl_u3 , u4 = hdlc_other (stream).
uses global:
  hl_u3    variable for u3
  hdlc_sem hdlc process
*)

begin
r^.u1:= u1;
r^.u2:= message;
r^.u3:= hl_u3;
r^.u4:= hdlc_other;
signal (r, hdlc_sem.s^);
end; (* contr_to_hdlc *)


procedure send_to_hdlc (var r: reference; stream: integer);

(* sends an output to hdlc-driver on specified stream (u4). Be-
sides parameters is used: hdlcsemaphore. *)

begin
r^.u1:= output;
r^.u2:= message;
r^.u4:= stream;
lock r as p: pack1 do
r^.u3:= p.head.priority div 32;  (* map and set prio (0-7) *)
signal (r, hdlc_sem.s^);        (* send output to hdlc *)
end;


procedure free_h;

(* releases message header h to pool trmheads or uses the header
to transmit a waiting packet to hdlc driver if any waiting.
uses global: h (message header), wp and wpsem (waiting packets).
calls procedure send to hdlc. *)

var
m: reference;
s: integer:= hdlc_data;

begin
if wp > 0 then
begin
wait (m, wpsem);        (* get first waiting packet *)
wp:= wp-1;
if m^.u1 = dir_transm then s:= hdlc_dirtrm;
push (h, m);
send_to_hdlc (m, s);    (* send packet on stream *)
end
else
release (h);
end;  (* procedure free_h *)


(***************************************************************)
(*                                                             *)
(*                    execution part                           *)
(*                                                             *)
(***************************************************************)

begin

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

(* create hdlc receiver process *)

i:= link ('hlrec       ', hlrec);
if i<>0 then testout(z,linkerror,i);
i:=create('hlrec       ',hlrec(sysvec,
ltrm, nnpreq, rtables, queues, netwtime, hshake, nnpflags,
poolh, supv, hdlc_sem, hlrec_sem, stat,
ownaddr, c), hlrec_proc, 500);
if i<>0 then testout(z,createerror,i);
start (hlrec_proc, stdpriority);

(* create driver process *)

if cparams(2) = 0 then
begin (* create ordinary hdlc driver *)
i:= link ('hdlc        ', hdlc);
if i<>0 then testout(z,linkerror,i);
i:= create ('hdlc        ', hdlc (
hdlc_sem.w^, cparams(1)), hdlc_proc, 1500);
if i<>0 then testout(z,createerror,i);
start (hdlc_proc, 0);             (* hdlc prio ?? *)
end else

if cparams(2) = 1 then
begin (* create hdlc simulator *)
i:= link ('hdlc_sim    ', hdlc_sim);
if i<>0 then testout(z,linkerror,i);
i:= create ('hdlcsim     ', hdlc_sim (sysvec,
hdlc_sem, hdlcsim2, cparams(1)), hdlc_proc, 500);
if i<>0 then testout(z,createerror,i);
start (hdlc_proc, stdpriority);
end else

if cparams(2) = 2 then
begin (* create alc driver *)
i:= link ('alc         ', alc);
if i<>0 then testout(z,linkerror,i);
i:= create ('alc         ', alc (
hdlc_sem, hdlcsim2.s, cparams(1)), hdlc_proc, 1000);    (* stacksize ?? *)
if i<>0 then testout(z,createerror,i);
start (hdlc_proc, stdpriority);                         (* priority  ?? *)
end else

(* cparams(2) doesn't define a known driver type *)
trace (1);    (* ttttttttttttttttttttttttttttttttttttttttt 1 *)

(* deliver nnp buffer to nnp buffer pool handler *)

alloc (h, nnp_bufs, poolnnp.s^);
deliv_buf (h, poolnnp.s^);

new_conn_state(queues,c,state);

repeat

(*-------------------------------------------------------------*)
(*        central waiting point                                *)
(*-------------------------------------------------------------*)
wait (msg, ltrm(c).w^);

case msg^.u2 of
message:
begin (* message *)

case msg^.u1 of

(*-------------------------------------------------------------*)
(*        transmit and directed transmit                       *)
(*-------------------------------------------------------------*)
trm_packet, dir_transm:

begin
if msg^.u1= trm_packet then
begin
str:= hdlc_data;
inc16 (stat.trmnorm);
end else
begin
str:= hdlc_dirtrm;
inc16 (stat.trmdir);
end;
if openpool (trm_heads) then
begin
alloc (h, trm_heads, ltrm(c).s^);    (* allocate header *)
push (h, msg);
send_to_hdlc (msg, str);
end else
begin
signal (msg, wpsem);      (* save packet in waiting queue *)
wp:= wp+1;                (* incr no of waiting *)
end;
end;

(*-----------------------------------------------------------*)
(*        lcp operation from ncp via supv                    *)
(*-----------------------------------------------------------*)
sup_mess_buf:

begin
lock msg as sp: r_lcp_head do
begin
lcp_op:= sp.sp_head.lcp_oper;
sp_bcnt:= sp.sp_head.bytecount;
end;
sp_st:= (.ill_lcp_oper.);

case lcp_op.basic of

(*--------------------------------*)
(* control operation              *)
(*--------------------------------*)
lcp_cntr:

if openpool (lcp_ops) then
case lcp_op.modif of

(*----------------------*)
(* start line connector *)
(*----------------------*)
opc_start_conn:
begin
if sp_bcnt < lgt_rhlopen then sp_st:= (.data_error.) else
begin
sp_st:= (..);
if state= stopped then
begin
state:= down;
new_conn_state (queues, c, down);
alloc (h, lcp_ops, ltrm(c).s^);      (* open hdlc line *)
lock msg as sp: r_hlopen_type do
lock h as hlopen: hl_conn_type do
with hlopen do
begin
autoconnect:= true;
connect_ident:= sp.oprm.conn_id;    (* dte/dce timer *)
k:= 2;
n2:= 4;
t1:= sp.oprm.t1;    (* retransmission timer *)
end;  (* lock .. with .. *)
contr_to_hdlc (h, hl_connect);
while openpool (ev_heads) do
begin
alloc (h, ev_heads, ltrm(c).s^);
contr_to_hdlc (h, hl_event);
end;
end; (* if state= stopped *)
end; (* sp_bcnt >= lgt_rhlopen *)
end;  (* start line connector *)

(*---------------------*)
(* stop line connector *)
(*---------------------*)
opc_stop_conn:

begin
sp_st:= (..);
if state <> stopped then
begin
state:= stopped;
new_conn_state (queues, c, stopped);
conn_down (rtables, c);
lrec_command (h, close_rec);  (* close line receiver *)
alloc (h, lcp_ops, helpsem); (* disconnect hdlc line *)
contr_to_hdlc (h, hl_disconn);
wait (h, helpsem);
contr_to_hdlc (h, hl_return_all);
wait (h, helpsem);
release (h);
end; (* state <> stopped *)
end; (* stop line connector *)

otherwise
; (* illegal lcp operation *)
end (* case lcp_op.modif *)
else sp_st:= (.no_free_res.);    (* no free lcp buffer *)

(*-----------------------------------*)
(* sense operation                   *)
(*-----------------------------------*)
lcp_sense:

; (* illegal *)

(*-----------------------------------*)
(* get statistics operation          *)
(*-----------------------------------*)
lcp_get_stat:

case lcp_op.modif of

opc_g_hlcon_st:
(*-------------------------------*)
(* get hdlc connector statistics *)
(*-------------------------------*)

begin
lock msg as sp: r_hlconstat_type do
sp.stat:= stat;
sp_st:= (..);
sp_bcnt:= 2+stathlconlgt;
end;

(*----------------------------*)
(* get hdlc driver statistics *)
(*----------------------------*)
opc_g_hldrv_st:

begin

(* not implemented yet *)

end;

otherwise
; (* illegal lcp operation *)
end;  (* case sp. ... .modif *)

otherwise
; (* illegal lcp operation *)
end;  (* case lcp_op.basic *)

answ_lcp (msg, sp_st, sp_bcnt);

end;

otherwise

msg^.u2:= illegal;
return (msg);

end; (* case msg^.u1 *)

end; (* message *)

otherwise
(* answer *)
case msg^.u4 of

(*----------------------------------------------------------*)
(*        nnp event request returned                        *)
(*----------------------------------------------------------*)
nnp_ev_req:
begin
if state= running then
req_buf (msg, poolnnp.s^, nnp_rq_prio, nnp_buf)
else release (msg);
end;

(*----------------------------------------------------------*)
(*        answer upon output data                           *)
(*----------------------------------------------------------*)
hdlc_data:
begin
result:= msg^.u2;
pop (h, msg);
update_queue (queues, c, -1);    (* decr queue lgt *)
case result of
not_trm:
begin  (* no attempt to transmit packet *)
lock msg as p: pack1 do
begin (* p locked *)
get_addr (p, daddr);
mastrt:= masterroute (p, dest, ownaddr, daddr, rtables, queues);
end; (* p locked *)
if mastrt then
signal (msg, ltrm(dest).s^)
else
begin  (* masterroute false *)
msg^.u2:= ok;   (* ???????????????????????????*)
return (msg);
end;   (* masterroute false *)
end;  (* no attempt to transmit ... *)
otherwise  (* maybe transmitted *)
msg^.u2:= ok;
return (msg);    (* return buffer with ok *)
end; (* case result *)
free_h;    (* free and maybe use header *)
end;

(*----------------------------------------------------------*)
(*        answer upon directed transmit                     *)
(*----------------------------------------------------------*)
hdlc_dirtrm:
begin
pop (h, msg);
update_queue (queues, c, -1);    (* critical region *)
msg^.u2:= ok;
return (msg);  (* return message with ok *)
free_h;        (* free and maybe use header *)
end;

(*----------------------------------------------------------*)
(*        answer upon output nnp packet                     *)
(*----------------------------------------------------------*)
hdlc_nnp:
begin
update_queue (queues, c, -1);    (* decr queuelgt  (critical) *)
pop (h, msg);
msg^.u1:= output;
msg^.u2:= ok;
return (msg);        (* return buffer to nnp pool *)
if state= running then
send_to_sup (h, req_nnp_ev, nnp_ev_req)  (* request new nnp event *)
else release (h);                        (* or release header *)
end;

(*----------------------------------------------------------*)
(*        answer upon other hdlc message                    *)
(*----------------------------------------------------------*)
hdlc_other:
begin  (* answer on contr to hdlc *)
result:= msg^.u2;    (* save result *)
case msg^.u1 of
hl_read_stati, hl_recl_stati, hl_modem_contr:
begin (* answer lcp request *)
release (msg);    (* not implemented yet *)







end;
hl_sense_lspeed:
begin (* answer on sense line speed *)
release (msg);    (* not implemented yet *)






end;
hl_event:
begin (* event *)
if (result mod 8) = ok then
begin
result:= result div 8;  (* line state in result *)
if ((result mod 16) = hlup) and (state <> running)
and (state <> stopped) then
begin (* line has come up *)
state:= running;
new_conn_state (queues, c, running);    (* critical *)
if openpool (nnp_heads) then
begin
alloc (h, nnp_heads, ltrm(c).s^);
send_to_sup (h, req_nnp_ev, nnp_ev_req);
end;
if set_nnp_fl (c, nnpi (nnp_hshake), nnpflags) then
ret_nnp_req (nnpreq(c));    (* init nnp protocol dialogue *)
(* sense line speed  -  not implemented yet *)

lrec_command (h, open_rec);    (* start line receiver *)
event_to_sup (msg, ev_hline_up, result);
end else
if (state = running) and ((result mod 16) <> hlup) then
begin (* line has gone down *)
state:= down;
new_conn_state (queues, c, down);
conn_down (rtables, c);    (* change routing tables *)
event_to_sup (msg, ev_hline_down, result);
end (* line has gone down *)
else
event_to_sup (msg, ev_hlev, result);

end (* if result mod 8 = ok *)
else
if state <> stopped then contr_to_hdlc (msg, hl_event)
else release (msg);

end;

otherwise
(* uninteresting answers *)
release (msg);
end;  (* case msg^.u1 *)
end;  (* answer on contr to hdlc *)


(*----------------------------------------------------------*)
(*        buffer for nnp packet                             *)
(*----------------------------------------------------------*)
nnp_buf:
begin
if state <> running then
begin  (* don't transmit nnp information *)
pop (h, msg);
release (h);
return (msg);
end else
if get_nnpfl (nnpflags, c, i) then        (* enter + exit critical ! *)
begin
lock msg as p: packnnp do
begin
p.head.func:= nnpf(i);      (* convert nnpindex to function *)
case p.head.func of
nnp_hshake:
build_hshake (hshake, p);
nnp_nwtime:
build_nwtime (netwtime, p);
otherwise    (* routing level *)
build_rngvec (rtables (nnprl(i)), p, c);
inc16 (stat.trmrng);
end; (* case p.head.func *)
end; (* lock msg *)
inc16 (stat.trmnnp);
update_queue (queues, c, 1);    (* incr queuelgt  (critical) *)
send_to_hdlc (msg, hdlc_nnp);      (* send nnp packet to hdlc driver *)
end else
begin  (* no flag set *)
pop (h, msg);
msg^.u1:= output;
msg^.u2:= ok;
return (msg);    (* return free buffer to pool handler *)
send_to_sup (h, req_nnp_ev, nnp_ev_req);  (* request new nnp event *)
end;  (* if get_nnpfl *)
end; (* buffer for nnp packet *)

(*------------------------------------------------------------*)
(*        returned supervisor event buffer                    *)
(*------------------------------------------------------------*)
ev_return:
begin (* event report returned with ncp buffer *)
copy_event (msg);
if state <> stopped then contr_to_hdlc (msg, hl_event)
else release (msg);
end; (* event report returned *)

end; (* case msg^.u4 *)

end;    (* case message/answer *)

until forever;

end.

▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦23c3d52cc⟧ TextFile

Derivation

TextFile
