⟦cc42da80c⟧

TextFileVerbose

job oer 7 200 time 11 0 area 10 size 100000
(
source = copy 25.1
tssphlst = set 1 disc1
tsspherr = set 1 disc1
tssphlst = indent source mark lc
listc = cross tssphlst
o tsspherr
mode list.yes
message compile stream protocol handler
pascal80 alarmenv paxenv source
mode list.no
o c
lookup pass6code
if ok.yes
( tssphbin = set 1 disc1
tssphbin = move pass6code
scope user tssphbin
)
tssphlst = copy listc tsspherr
scope user tssphlst
scope user tsspherr
finis
)
\f


process stream_protocol_handler (
stream_no      :  byte;
mac_table_top : byte;
op_sem         :  sempointer;
var
com_pool_sem   : !ts_pointer;
var
dte_sem        : !sempointer;
local_sem_table
: netc_loc_sems;
var
local_mac_table
: netc_loc_macs;
max_no_retrans :  byte;
var
stream_sem     : semaphore;
var
user_req_sem   : semaphore
);

const
version = "vers  1.01 /";
(*      --------------*)

(*=================================================================
"                                                                 "
"   stream protocol handler                                       "
"                                                                 "
"   drives a simple protocol with a remote stream protocol   "
"   handler                                                       "
"                                                                 "
===================================================================*)

(*---------------  configuration parameters  ----------------------*)


\f


(*-----------------------------------------------------------------
.   constants                                                     .
-------------------------------------------------------------------*)


(*-----------------------------------------------------------------
.   types section                                                 .
-------------------------------------------------------------------*)

type
data_buf_type
= array (1..size_pax_listen) of integer ;


own_buf_type
= array (1..63) of integer;

my_buf_type
= array (1..127) of integer;

alarm_mess
= packed record
no_of_bytes : integer;
data : array (1..2*size_listen -2) of byte
end;

\f


(*-----------------------------------------------------------------
   variables section                                             .
------------------------------------------------------------------*)

var
ref : reference ;

own_pool : pool 1 of own_buf_type;
my_pool  : pool 2 of my_buf_type;

u_trm_acc_sem,
trm_acc_sem,
rec_acc_sem : semaphore;

z : zone;

act_pax_adr : ext_pax_addr ;
act_facilities : integer ;

window : byte := windowsize;

v_s_inc,
v_s,
v_r_inc,
v_r : byte;

\f


(*-------------------------------------------------------------
.   ALC-protocol                                              .
.   types, constants, variables                               .
---------------------------------------------------------------*)

type
statetype = (discon, idle, w_r_data, w_r_enq );
eventtype = (uo, reset, ack, timo, data, enq, nons );
actiontype = 0..15;

pri_action_row = array (uo..timo ) of actiontype;
sec_action_row = array (data..enq) of actiontype;

pri_act_t_type = array (discon..w_r_enq) of pri_action_row;
sec_act_t_type = array (  idle..idle   ) of sec_action_row;

pri_sta_row = array ( uo..timo ) of statetype;

pri_sta_t_type = array (discon..w_r_enq) of pri_sta_row;

const
pri_states = (.discon..w_r_enq.);
sec_states = (.idle.);

pri_events = (.uo..timo.);
sec_events = (.data..enq.);

(*--- primary command codes ---*)

data_0 = 128;
data_1 = 129;

enq_opc = 5;

(*--- secondary receipt codes ---*)

ack_0 = 19;
ack_1 = 20;

reset_opc = 21;
\f


pri_act_table =
pri_act_t_type (
(*                             uo         reset         ack         timo *)
(* discon *) pri_action_row (   1,          0,           9,           2   ),
(* idle   *) pri_action_row (   3,          0,           0,           0   ),
(*w_r_data*) pri_action_row (   4,          0,           5,           8   ),
(*w_r_enq *) pri_action_row (   4,          6,           7,           8   ));

sec_act_table =
sec_act_t_type (
(*                           data         enq    *)
(* idle *) sec_action_row (    2,          1      ));

pri_sta_table =
pri_sta_t_type (
(*                          uo          reset          ack         timo *)
(* discon *) pri_sta_row (discon,        idle,        idle,      discon  ),
(* idle   *) pri_sta_row (w_r_data,      idle,        idle,        idle  ),
(*w_r_data*) pri_sta_row (w_r_data,  w_r_data,    w_r_data,     w_r_enq  ),
(*w_r_enq *) pri_sta_row (w_r_enq,   w_r_data,    w_r_data,     w_r_enq  ));

var
pri_action,
sec_action : actiontype;

pri_state,
sec_state : statetype;

event : eventtype;

pri_data_no,
sec_last_rec,
trans_retry : integer;
\f


(*================================================================
.   procedures section                                           .
==================================================================*)

function own_state_ok (
state : byte ): boolean;
(*--------------------------------------------------------------
-  checks if the state is ok                                   -
----------------------------------------------------------------*)
begin
own_state_ok := true;
end;

function ok_user_buf (
var ref : reference ): boolean;
(*----------------------------------------------------------
-   checks if user buffer is ok                            -
------------------------------------------------------------*)
begin
ok_user_buf := true;
end;
\f


procedure start_new_inc ;
(*-------------------------------------------------------------
-   starts a new incarnation of the controlfield variables    -
---------------------------------------------------------------*)
begin
v_s_inc := v_s_inc + 1;
v_s := 0;
v_r_inc := v_r_inc + 1;
v_r := 0;
end;
\f


procedure local_transmitter (
var
ref : reference;
local_macro : macroaddr );
(*-------------------------------------------------------
.  routes a message to local users                      .
.  i e to tssupervisor, ncsupervisor, dcsimulator       .
.  or others                                            .
.  either because it is received from the net           .
.  or because it is not transmitted to the net          .
.  because of an error                                  .
---------------------------------------------------------*)
var
i : integer := 1;

begin
local_mac_table( mac_table_top) := local_macro;

while local_mac_table(i) <> local_macro do i:=i+1;

ref^.u1 := 2;

if i = mac_table_top then
signal( ref, local_sem_table(1)^)
else
signal( ref, local_sem_table(i)^);
end;
\f


procedure make_a_call;
(*--------------------------------------------------------------
-   makes a call request at dte                                -
----------------------------------------------------------------*)
var
ref : reference ;
begin
alloc( ref, own_pool, stream_sem);

ref^.u1 := dte_car;
ref^.u2 := dte_default;

lock ref as buf : car_buf_type do
with buf do
begin
first := 10;
last := 10 + l_call_buf ;
q_bit := false ;

with call_buf do
begin
dte_adr_l := l_dte_adr;
dte_adr := act_pax_adr;
facility_l := l_facilities;
facility := act_facilities;
end
end;
signal( ref, dte_sem^);
end;
\f


procedure send_rdata_bufs (
no_of_bufs : byte );
(*---------------------------------------------------------
-   sends rdata buffers to dte
-----------------------------------------------------------*)
var
i : integer;
ref : reference ;
begin
for i := 1 to no_of_bufs do
begin
alloc( ref, my_pool, stream_sem);

ref^.u1 := dte_rdata;
ref^.u2 := dte_default;
ref^.u3 := stream_no;

signal( ref, dte_sem^);
end
end;
\f


procedure send_sdata_buf (
opr_code : byte );
(*--------------------------------------------------------------
-   sends a sdata buffer to dte                                -
----------------------------------------------------------------*)
var
user_ref,
ref     : reference;
i : integer;

begin
alloc( ref, my_pool, stream_sem);

ref^.u1 := dte_sdata;
ref^.u2 := dte_default;

lock ref as buf : dte_sdata_data do
begin
buf.first := sdata_first_val;
buf.q_bit := false;
buf.m_bit := false;

with buf.control do
begin
op_code := opr_code;
credit :=  windowsize;
n_s_inc := v_s_inc;
n_s := v_s;
n_r_inc := v_r_inc;
n_r := v_r;
end;
\f


v_s := v_s + 1 mod 255;

sensesem( user_ref, user_req_sem);

if not nil( user_ref) then
(*         there is user data to transmit *)
if ok_user_buf( user_ref) then
lock user_ref as u_buf : alarm_mess do
begin
buf.no_user_by := u_buf.no_of_bytes;
for i:= 1 to buf.no_user_by do
buf.user_data(i) := u_buf.data(i)
end;
end;

signal( ref, dte_sem^);
signal( user_ref, u_trm_acc_sem);
end;
\f


(*--------------------------------------------------------------
.   MAIN PROGRAM                                                 .
------------------------------------------------------------------*)
begin

testopen( z, own.incname, op_sem);
testout(  z, version    , al_env_version);

v_s_inc := 0;
v_r_inc := 0;

(*----  initialize primary station ----*)

pri_state := discon;
pri_data_no := data_1;

(*----  initialize secondary station ----*)

sec_state := idle;
sec_last_rec := reset_opc;
\f


repeat  (* until forever *)

wait( ref, stream_sem);

if ownertest( own_pool, ref) then
case ref^.u1 of
dte_car :
begin
end
end
\f


else
if ownertest( my_pool, ref) then
case ref^.u1 of
dte_sdata :
begin
end;
dte_rdata :
begin
end;
end
\f


else
begin        (*  buffer from paxcon *)
case ref^.u1 of
sph_call :
begin
if own_state_ok(sph_call) then
begin
lock ref as buf : sph_buf_type do
act_pax_adr := buf.pax_adr;
make_a_call;
end;
release( ref);
end;

sph_rec_data :
begin
send_rdata_bufs(2);
start_new_inc;
send_sdata_buf( opc_rr);
end;

end;
end;

until false;

end.
«eof»
DataMuseum.dk

RC3500

⟦cc42da80c⟧ TextFileVerbose

Derivation

TextFileVerbose
