|
DataMuseum.dkPresents historical artifacts from the history of: RC3500 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC3500 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 46848 (0xb700)
Types: TextFileVerbose
Names: »tsnetjob«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »tsnetjob«
job oer 8 200 time 11 0 area 10 size 100000
(
source = copy 25.1
tsnetlst = set 1 disc1
tsneterr = set 1 disc1
tsnetlst = indent source mark lc
listc = cross tsnetlst
o tsneterr
mode list.yes
message compile netcon
pascal80 alarmenv paxenv source
mode list.no
o c
tsnetlst=copy listc tsneterr
scope user tsnetlst
scope user tsneterr
lookup pass6code
if ok.yes
( tsnetbin = set 1 disc1
tsnetbin = move pass6code
scope user tsnetbin
finis output.no
)
finis
)
process netconnector(
global_timeout : byte;
op_sem : sempointer; (* operator semaphore *)
var
pax_pool_sem,
main_sem : !ts_pointer ; (* main semaphore *)
local_sems
: netc_loc_sems;
var
com_pool_sem,
timeout_sem,
dte_sem : !sempointer (* dte semaphore *)
);
const
version = "vers 1.18 /";
(* --------------*)
(*=================================================================
" "
" net connector "
" "
" establishes a connection between the alarmapplikation and "
" a x.25 dte module "
" "
" the module can receive three kinds of messages : "
" "
" - messages to net connector "
" - messages to node supervisor "
" - messages to paxnet "
" "
==================================================================*)
\f
(* introduction to netconnector
abbreviation list :
-----------------
sem semaphore
pseudo code version 81.15.01 :
----------------------------
*)
(*--- udest}ender :
udtagelse fra generel ventek|
reset af str|m
clear str|m
behandling af ikke-ok resultater
end-to-end kontrol
---- *)
\f
(*----------------------------------------------------------------
. constants .
------------------------------------------------------------------*)
const
ric_delay_1 = 0; (* delay used for receiving on incomming call *)
ric_delay_2 = 0; (* delay used for ric-buffers *)
(* delay = ric-delay-1 * (2 ** ric-delay-2) msec *)
all_ric_bufs = 2; (* total number of ric-buffers *)
dc_index = max_locals +2;
own_index = 1;
max_pax_table = dc_index + max_globals;
netc_routes = (. netc_route, netc_route1, netc_route2 .);
\f
type
mess_10_12_type
= record
a : alarmlabel;
pax_index : integer;
pax_entry : paxnet_e;
end;
release_cause = (accept, reject);
stat_type = array (1..15) of integer;
\f
(*-------------------------------------------------------------------
. variables section .
----------------------------------------------------------------------*)
var
act_pax_index,
act_stream_index : integer;
act_pax_addr : ext_pax_addr;
local_macro,
alarm_macro : macroaddr;
alarm_micro : integer;
alarm_op_code : byte;
no_address : boolean := true;
pax_table_top,
local_mac_top : byte;
i,j,k : integer;
z : zone;
act_facilities : integer := 0;
const
loca_packets = 1;
lost_packets = 2;
nons_packets = 3;
send_packets = 4;
reci_packets = 5;
retr_packets = 6;
call_packets = 7;
rica_packets = 8;
netc_packets = 9;
copy_packets = 10;
aicc_packets = 11;
reji_packets = 12;
no_pax_bufs = 13;
no_com_bufs = 14;
ill_adr_bufs= 15;
var
stat : stat_type := stat_type(15 *** 0);
tst : integer := 255;
(*
2 - protocol values
4 - actions on each stream
8 - results from dte
16 - write checkpoints
32 - write table contents
64 - write procedurecalls
----*)
\f
(*---------------------------------------------------------------
. pools .
-----------------------------------------------------------------*)
var
timer_pool : pool 1;
(*---------------------------------------------------------------
. references .
-----------------------------------------------------------------*)
nil_ref,
ref,
in_ref (* input reference *)
: reference;
(*--------------------------------------------------------------
. internal semaphores .
-----------------------------------------------------------------*)
\f
(*----------------------------------------------------------------
. tables section .
------------------------------------------------------------------*)
var
pax_table (* is used for routing alarmnetmessages *)
: array(1..max_pax_table+1) of paxnet_e;
stream_states
: array (min_stream_no-1..max_stream_no) of stream_s_e;
\f
(*------------------------------------------------------------------
. externals
--------------------------------------------------------------------*)
procedure reject_message (
var
msg : reference;
sender_macro : macroaddr;
sender_micro : integer;
result_code,
route : byte
);
external;
\f
(*----------------------------------------------------------
- forwards -
------------------------------------------------------------*)
procedure send_aic_buf(
stream,
call_id,
c_data
: byte );
forward;
procedure send_rejic_buf (
call_id,
diag_code : byte );
forward;
function local_transmitter (
var
ref : reference;
local_macro : macroaddr): integer;
forward;
procedure send_rdata_bufs (
no_of_bufs,
stream : byte );
forward;
procedure send_sdata_buf (
var iref : reference;
stream_no : byte;
opr_code : byte ;
c_data : byte );
forward;
procedure send_to_stream (
var
ref : reference;
stream_index : integer
); forward;
procedure release_uo_data (
cause : release_cause;
stream : byte );
forward;
\f
(*===============================================================
" procedures section "
==================================================================*)
procedure write_create_pars;
(*-------------------------------------------------------
. writes all the create parameters
---------------------------------------------------------*)
begin
testout(z,"global-timou", global_timeout);
testout(z,"pax-pool ", pax_pool);
testout(z,"common pool ", com_pool);
testout(z,"main sem no ", netc_sem_no);
testout(z,"local supsem", tssup_sem_no);
testout(z,"local ncsem ", nc_sem_no);
testout(z,"timeoutsemno", timeout_sem_no);
testout(z,"dte sem no ", dte_sem_no);
end;
\f
procedure write_paxnet_entry ( i:integer);
begin
with pax_table(i) do
begin
testout(z,"pax-table-no", i);
testout(z,"al_mac_dc ", al_mac_addr.dc_addr);
testout(z,"al_mac_nc ", al_mac_addr.nc_addr);
testout(z,"al_mac_ts ", al_mac_addr.ts_addr);
testout(z,"ext_pax_net ", pax_addr(3));
testout(z,"ext_pax_reg ", pax_addr(6));
testout(z,"ext_pax_node", pax_addr(8)*10+pax_addr(9));
testout(z,"stream-no ", stream_no);
testout(z,"max-retrans ", max_retrans);
end;
end;
\f
procedure write_stream_state (i:integer);
begin
with stream_states(i) do
begin
testout(z,"stream-stats", i);
if not nil( act_out) then
testout(z,"not-nil-act ", 1)
else
testout(z,"nil-act-out ", 0);
case state of
free : testout(z,"s=free ", l_queue);
calling : testout(z,"s=calling ", l_queue);
sending : testout(z,"s=sending ", l_queue);
receiving : testout(z,"s=receiving ", l_queue);
waiting : testout(z,"s=waiting ", l_queue);
clearing : testout(z,"s=clearing ", l_queue);
resetting : testout(z,"s=resetting ", l_queue);
end;
testout(z,"timers-1 ", timers(1));
end;
end;
\f
function connec_to_addr (
var stream_indx : integer ) : boolean;
(*--------------------------------------------------------------
. checks if there is a stream active to pax
----------------------------------------------------------------*)
var i : integer := min_stream_no;
begin
connec_to_addr := false;
stream_indx := min_stream_no -1;
while i <= max_stream_no do
with stream_states(i) do
begin
if (state <> free)
and ( act_pax_addr = pax_addr) then
begin
connec_to_addr := true;
stream_indx := i;
i:= max_stream_no;
end;
i := i+1;
end;
if tst>64 then
testout(z,"connec-to-ad", stream_indx);
end;
\f
procedure init_stream_states ;
(*---------------------------------------------------------------
. initializes the stream_table .
-----------------------------------------------------------------*)
var
i,j : integer;
ref : reference;
begin
for i := min_stream_no-1 to max_stream_no do
with stream_states(i) do
begin
l_queue := 0;
max_retrans := 0;
retrans_count := 0;
retrans_timer := 0;
retrans_timo := glob_timeout;
pax_addr := ext_pax_addr(14***0);
v_s_inc := 0;
v_s := 0;
v_r_inc := 0;
v_r := 0;
for j:= 1 to max_queue do
timers( j ) := 0;
state := free;
end
end;
\f
procedure update_stream_state (
entry : byte;
upd_kind : upd_kinds ;
new_state : state_type );
(*---------------------------------------------------
. updates the streamstates
-----------------------------------------------------*)
var
ref : reference;
begin
with stream_states(entry) do
begin
case upd_kind of
inc_all :
begin
state := new_state;
l_queue := l_queue +1;
timers( l_queue) := stream_timeout;
end;
dec_all :
begin
state := new_state;
l_queue:= l_queue-1;
for i := 1 to l_queue do
timers(i) := timers( i+1);
end;
inc_q :
begin
l_queue := l_queue +1;
timers( l_queue) := stream_timeout;
end;
dec_q :
begin
l_queue:=l_queue-1;
for i := 1 to l_queue do
timers(i) := timers( i+1);
end;
new_stat :
state := new_state;
end (* case *);
if tst>64 then
write_stream_state( entry);
end
end;
\f
procedure update_pax_table (
i : integer;
var a : alarmlabel;
var new_pax_e : paxnet_e );
(*------------------------------------------------------
. updates the pax-table with new-pax-e in respect to
. upd-code, and deleivers the result in res-code
--------------------------------------------------------*)
begin
if (i>0) and (i<=max_pax_table) then
begin
a.result := accepted;
if i>=max_locals+1 then i:=i+1;
(* because DC has no entry for searching *)
case a.update of
read_code : (* read from pax-table *)
new_pax_e := pax_table(i);
insert_code : (* insert entry in pax-table *)
(* entryes can only be inserted just below the top *)
begin
if ((i=local_mac_top-1) and (new_pax_e.stream_no>0)) or
(( i=pax_table_top-1) and (new_pax_e.stream_no=0)) then
begin
pax_table(i) := new_pax_e;
if i = 1 then no_address := false;
if (i=local_mac_top-1) and (local_mac_top<max_locals+1) then
local_mac_top := local_mac_top +1
else
if (i=pax_table_top-1) and (pax_table_top<max_pax_table) then
pax_table_top := pax_table_top +1;
end
else
a.result := not_accepted;
end;
\f
modify_code : (* modify entry in pax-table *)
begin
(* modifying can be done anywhere in the table *)
pax_table(i) := new_pax_e;
if i <= max_locals then
if i >= local_mac_top then
local_mac_top := i+1
else
else
if i >= pax_table_top then
pax_table_top := i+1;
if i=1 then no_address := false;
end;
remove_code : (* remove entry in pax-table *)
(* entryes has to be removed from the top *)
begin
if (i=local_mac_top-1) or (i=pax_table_top-1) then
begin
pax_table(i).al_mac_addr := nil_macro;
if i=1 then no_address := true;
if i=local_mac_top-1 then
local_mac_top := local_mac_top-1
else
pax_table_top := pax_table_top -1;
end
else
a.result := not_accepted;
end;
otherwise
a.result := unknown_update
end
end
else
a.result := no_room;
if tst>64 then
write_paxnet_entry(i);
end;
\f
procedure init_pax_table ;
(*-----------------------------------------------------
. initializes the pax-table
-------------------------------------------------------*)
var
i: integer;
begin
for i := 2 to max_pax_table do
with pax_table(i) do
begin
al_mac_addr := nil_macro;
stream_no := 1;
max_retrans := 0;
end;
with pax_table(1) do
begin
al_mac_addr := macroaddr(0,0,0);
pax_addr := ext_pax_addr(13***0, netc_mic_addr);
stream_no := 1;
end;
with pax_table( dc_index) do
begin
al_mac_addr := dc_alarm_macro;
pax_addr := paxnet_config(1);
end;
end;
\f
procedure send_to_systimer (
var
ref : reference );
(*-----------------------------------------------------
. sends a timerbuffer to systemtimer
-------------------------------------------------------*)
begin
ref^.u3 := 50;
ref^.u4 := 8;
sendtimer( ref);
end;
function free_stream : byte;
(*---------------------------------------------------------------
. finds the first idle stream in the stream-states .
-----------------------------------------------------------------*)
var
i : integer;
begin
i:= min_stream_no;
while (stream_states(i).state <> free) and (i<max_stream_no) do
i:= i+1;
if stream_states(i).state = free then
free_stream := i
else
free_stream := min_stream_no -1;
if tst>64 then
testout(z,"free-stream ", i);
end;
\f
procedure start_new_inc(
stream : byte );
begin
with stream_states( stream) do
begin
v_s_inc := (v_s_inc +1) mod 256;
v_s := 0;
v_r_inc := (v_r_inc +1) mod 256;
v_r := 0;
end;
if tst>64 then
testout(z,"start-new-in", stream);
end;
\f
procedure set_control (
stream : byte;
opr : byte;
var call_field : call_field_type );
begin
with call_field.control do
with stream_states( stream) do
begin
op_code := opr;
data := 0;
n_s_inc := v_s_inc;
n_s := v_s;
n_r_inc := v_r_inc;
n_r := v_r;
if tst>64 then
testout(z,"set-control ", stream);
end
end;
\f
procedure make_a_call (
stream_no : byte );
(*-------------------------------------------------------
. makes a call request at dte
---------------------------------------------------------*)
var
ref : reference;
begin
count( stat( call_packets));
sensesem( ref, pax_pool_sem.w^);
if not nil( ref) then
begin
ref^.u1 := dte_car;
ref^.u2 := dte_default;
ref^.u3 := stream_no;
ref^.u4 := to_link;
lock ref as buf : car_buf_type do
with buf do
begin
first := ric_first_val;
q_bit := false;
start_new_inc(stream_no);
set_control( stream_no, dte_car, call_buf);
with call_buf do
begin
dte_adr_l := l_dte_adr;
dte_adr := act_pax_addr;
facility_l := l_facilities;
facility := act_facilities;
lock stream_states( stream_no).act_out as abuf : max_alarm_mess do
begin
alarm_mess := abuf;
last := ric_first_val + l_control + abuf.al.no_of_by -1+2;
end;
end
end;
signal( ref, dte_sem^);
if tst>64 then
testout(z,"make-a-call ", stream_no);
end
else
begin
if tst>4 then
testout(z,"no car buf ",0);
count( stat( no_pax_bufs));
end;
end;
\f
procedure start_stream (
var ref : reference;
stream_no,
pax_index : byte );
(*--------------------------------------------------------
- makes a stream ready for use -
----------------------------------------------------------*)
begin
stream_states( stream_no).pax_addr := pax_table( pax_index).pax_addr;
ref^.u1 := pax_index;
ref :=: stream_states( stream_no).act_out;
update_stream_state( stream_no, inc_all, calling);
act_pax_addr := pax_table( pax_index).pax_addr;
make_a_call( stream_no);
with stream_states( stream_no) do
begin
max_retrans := pax_table( act_out^.u1).max_retrans;
retrans_count := 0;
if max_retrans>0 then
retrans_timo := glob_timeout div max_retrans
else
retrans_timo := glob_timeout;
retrans_timer := retrans_timo;
end;
if tst>64 then
testout(z,"start-stream", stream_no);
end;
\f
function copy_data (
amess : max_alarm_mess;
var user_ref : reference ) : byte;
(*--------------------------------------------------------
. copies an alarmmess into a buffer from common pool
----------------------------------------------------------*)
begin
sensesem( user_ref, com_pool_sem^);
if not nil( user_ref) then
begin
user_ref^.u3 := netc_route;
lock user_ref as abuf : max_alarm_mess do
begin
abuf := amess;
user_ref^.u4 := amess.al.op_code;
if tst>64 then
testout(z,"copy data ", amess.al.no_of_by);
end;
count( stat( copy_packets));
copy_data := data_received;
end
else
begin
copy_data := data_not_received;
count( stat( no_com_bufs));
if tst>64 then
testout(z,"copy data ", 0);
end;
end;
\f
procedure handle_10_12_mess (
var in_ref : reference );
(*---------------------------------------------------------
. handles any message with netconnector as receiver
-----------------------------------------------------------*)
begin
count( stat( netc_packets));
if in_ref^.u4 = #hac then
begin
(*-- update paxnettable --*)
lock in_ref as buf : mess_10_12_type do
begin
update_pax_table( buf.pax_index, buf.a, buf.pax_entry);
buf.a.op_code := #had;
local_macro := buf.a.rec.macro;
buf.a.rec := buf.a.send;
buf.a.send.macro := local_macro;
buf.a.send.micro := netc_mic_addr;
in_ref^.u4 := #had;
end;
in_ref^.u3 := netc_route2;
act_pax_index := local_transmitter( in_ref, local_macro);
end
\f
else
(*-- message <> 10.12 received with netcon as receiver --*)
begin
count( stat( ill_adr_bufs));
if in_ref^.u4 = #h12 then
return( in_ref)
else
begin
lock in_ref as buf:alarmlabel do
local_macro := buf.rec.macro;
reject_message
( in_ref, local_macro,
netc_mic_addr, unknown_opcode, netc_route1);
if not nil( in_ref) then
k := local_transmitter( in_ref, local_macro);
if tst>4 then
testout(z,"address err ", i)
end;
end;
end;
\f
procedure handle_node_test (
var alabel : alarmlabel );
(*---------------------------------------------------------------
. updates pax-table with act-pax-addr when node-test comes
. and netc has no address
-----------------------------------------------------------------*)
begin
if alabel.op_code = #hc0 then
begin
pax_table(1).al_mac_addr := alabel.rec.macro;
no_address := false;
if alabel.send.macro.nc_addr = 0 then
k := dc_index
else
k := dc_index + 1;
pax_table(k).al_mac_addr := alabel.send.macro;
pax_table(k).pax_addr := act_pax_addr;
pax_table(k).max_retrans := 0;
if tst>16 then
begin
testout(z,"ha-node-test", k);
write_paxnet_entry(k);
end;
if pax_table_top <= k then
pax_table_top := k+1;
end;
end;
\f
function stream_transmitter (
var stream : byte; (* zero means make a call *)
op_code : byte;
c_data : byte;
var ref : reference (* nil means send a receipt *)
) : integer;
(*----------------------------------------------------------
. 1. sends a receipt without data on stream
. 2. sends a receipt with data on stream
. 3. makes a call if stream is zero and a free stream exists
------------------------------------------------------------*)
var
alarm_macro : macroaddr;
i : integer;
begin
if tst>64 then
testout(z,"strm-transm ", stream);
if not nil(ref) then
begin
(*- a message has to be send to net -*)
if stream = 0 then
begin
lock ref as abuf : alarmlabel do
alarm_macro := abuf.rec.macro;
pax_table( pax_table_top).al_mac_addr := alarm_macro;
i:= dc_index;
while pax_table(i).al_mac_addr <> alarm_macro do
i:= i+1;
\f
if i<pax_table_top then
begin
(*- a receiver exists ; now check streams -*)
if tst>16 then
testout(z,"rec exists ", i);
stream := free_stream;
if stream >= min_stream_no then
begin
start_stream( ref, stream, i);
act_pax_addr := pax_table(i).pax_addr;
make_a_call( stream);
end
else
begin (* put in queue *)
ref^.u1 := i;
signal( ref, stream_states( min_stream_no -1).out_queue);
update_stream_state( min_stream_no-1, inc_q, free);
end;
end
\f
else
begin
(*- no receiver exists in table -*)
(*- check exit-addr or free stream -*)
if tst>16 then
testout(z,"no addr ",i);
act_pax_addr := pax_table( dc_index).pax_addr;
if connec_to_addr( act_stream_index) then
begin
ref^.u1 := dc_index;
send_to_stream( ref, act_stream_index)
end
else
begin
stream:=free_stream;
if stream >= min_stream_no then
begin
start_stream( ref, stream, dc_index);
act_pax_addr := pax_table( dc_index).pax_addr;
make_a_call( stream);
end
else
begin
if tst>16 then
testout(z,"wait exit ",stream);
ref^.u1 := dc_index;
signal( ref, stream_states( min_stream_no-1).out_queue);
update_stream_state( min_stream_no-1, inc_q, free);
end;
end;
end
\f
end
else
begin
if tst>16 then
testout(z,"send datarec", op_code);
send_sdata_buf( ref, stream, op_code,c_data);
end;
end (* not nil ref *)
else
begin
(*- a receipt has to be made *)
if tst>16 then
testout(z,"send receipt", op_code);
send_sdata_buf( ref, stream, op_code,c_data);
end;
stream_transmitter := stream;
if tst>64 then
testout(z,"strm-transm ", stream);
end;
\f
function local_receiver (
var
ref : reference;
var
remote_macro : macroaddr
): integer;
(*----------------------------------------------------------------
. routes a message either to further handling by netconnector .
. or routes it to local user at once .
------------------------------------------------------------------*)
var
i : integer := 1;
begin
count( stat( loca_packets));
ref^.u3 := netc_route;
lock ref as buf : alarmlabel do
begin
buf.op_code := ref^.u4;
remote_macro := buf.rec.macro;
end;
pax_table( pax_table_top).al_mac_addr := remote_macro;
while pax_table(i).al_mac_addr <> remote_macro do i:= i+1;
if (i < local_mac_top) then
signal( ref, local_sems(pax_table(i).stream_no)^);
pax_table( pax_table_top).al_mac_addr := nil_macro;
local_receiver := i;
if tst>64 then
testout(z,"local-receiv", i);
end;
\f
function stream_receiver (
func : byte;
var ref: reference ) : integer;
(*-------------------------------------------------------
. receives a message from dte-module and looks at
. control.op-code
. if this is a command, the data are either used by netcon
. or send to local user via local-transmitter
. if it is a receipt, this is handled by the netcon
---------------------------------------------------------*)
var
stream : byte := 0;
user_ref : reference;
result : byte;
begin
case func of
dte_ric : (*- incomming call -*)
begin
count( stat( rica_packets));
lock ref as buf : ric_buf_type do
with buf do
begin
result := copy_data( call_buf.alarm_mess, user_ref);
if tst>64 then
testout(z,"strm-rec-ric", result);
if result = data_received then
begin
act_pax_addr := call_buf.dte_adr;
if not connec_to_addr( act_stream_index) then
begin
stream := free_stream;
result := result +1;
if stream >= min_stream_no then
begin
send_rdata_bufs( windowsize, stream);
stream_states( stream).pax_addr := act_pax_addr;
update_stream_state( stream, new_stat, receiving);
send_aic_buf( stream, call_id, data_received);
end
else
send_rejic_buf( call_id, data_received);
end;
lock user_ref as abuf : alarmlabel do
begin
alarm_macro := abuf.rec.macro;
if no_address then
handle_node_test( abuf);
end;
if tst>16 then
testout(z,"ric to local", alarm_macro.ts_addr);
act_pax_index := local_transmitter( user_ref, alarm_macro);
if result = data_received then
send_aic_buf( stream, call_id, data_received);
end
else
(*-- no buffer ready for data --*)
send_rejic_buf( call_id, data_not_received);
end;
end;
\f
dte_rdata : (*- receive data -*)
begin
count( stat( reci_packets));
stream := ref^.u3;
lock ref as dbuf : dte_sdata_data do
with dbuf do
begin
result := copy_data( alarm_mess, user_ref);
if tst>64 then
testout(z,"strm-rec-dat", result);
if result = data_received then
begin
lock user_ref as abuf : alarmlabel do
begin
alarm_macro := abuf.rec.macro;
if no_address then
begin
act_pax_addr := stream_states( stream).pax_addr;
handle_node_test( abuf);
end;
end;
stream := stream_transmitter( ref^.u3, opc_receipt, data_received, nil_ref);
if tst>16 then
testout(z,"rdata to loc", alarm_macro.ts_addr);
act_pax_index := local_transmitter( user_ref, alarm_macro);
end
else
(*-- no buffer ready for data --*)
stream := stream_transmitter( ref^.u3, opc_receipt, data_not_received, nil_ref);
end
end;
otherwise
count( stat( nons_packets));
end (* case *);
stream_receiver := stream;
end;
\f
function local_transmitter (
var
ref : reference;
local_macro : macroaddr ):integer;
(*----------------------------------------------------
. routes a message to local user, i e .
. tssupervisor, ncsupervisor, dcsimulator .
. or others .
. either because it is received from the net .
. or because it is not transmitted to the net .
----------------------------------------------------*)
var
i : integer := 1;
begin
if not( ref^.u3 in netc_routes) then
ref^.u3 := netc_route;
pax_table( local_mac_top).al_mac_addr := local_macro;
while pax_table(i).al_mac_addr <> local_macro do i:= i+1;
if (i = local_mac_top) or (pax_table(i).stream_no =0) then
begin
if tst>64 then
testout(z,"local-transm", 1);
signal( ref, local_sems(1)^)
end
else
begin
if tst>64 then
testout(z,"local-transm", i);
signal( ref, local_sems(pax_table(i).stream_no)^);
end;
pax_table( local_mac_top).al_mac_addr := nil_macro;
local_transmitter := i;
end;
\f
procedure send_to_stream (
var
ref : reference ;
stream_index : integer
);
(*--------------------------------------------------------------
- sends an outputmessage to stream and updates the tables -
----------------------------------------------------------------*)
begin
if stream_states( stream_index).l_queue < max_queue then
begin
if tst>64 then
testout(z,"send to strm", stream_index);
case stream_states( stream_index).state of
calling :
update_stream_state( stream_index, inc_q, calling);
sending :
update_stream_state( stream_index, inc_q, sending);
waiting,
receiving :
update_stream_state( stream_index, inc_all, sending);
otherwise;
end (*case*) ;
if nil( stream_states(stream_index).act_out) then
begin
ref :=: stream_states(stream_index).act_out;
send_sdata_buf( stream_states(stream_index).act_out, stream_index, opc_command,0);
end
else
signal( ref, stream_states(stream_index).out_queue);
end
\f
else
if ref^.u4 = #h12 then
return( ref)
else
begin
if tst>64 then
testout(z,"queu too big", stream_index);
lock ref as a : alarmlabel do
local_macro := a.send.macro;
reject_message
( ref, local_macro,
netc_mic_addr, no_resources, netc_route1);
if not nil( ref) then
k:= local_transmitter( ref, local_macro);
end;
end;
\f
procedure send_to_wait (
var ref : reference;
pax_index : byte );
(*-------------------------------------------------------------
. sends an outputbuffer to wait_queue at stream-states index
. no min-stream-no - 1
---------------------------------------------------------------*)
begin
update_stream_state( min_stream_no-1, inc_q, free);
ref^.u1 := pax_index;
if nil( stream_states(min_stream_no-1).act_out) then
ref :=: stream_states( min_stream_no-1).act_out
else
signal( ref, stream_states( min_stream_no-1).out_queue);
if tst>64 then
testout(z,"send-to-wait", pax_index);
end;
\f
procedure make_ric_bufs (
no_of_bufs : byte
);
(*-------------------------------------------------------------
. - gets a receive incomming call buffer and makes it ready .
. for use .
---------------------------------------------------------------*)
var
i : integer;
ref : reference;
begin
if tst>64 then
testout(z,"make-ric-buf", no_of_bufs);
for i:= 1 to no_of_bufs do
begin
sensesem( ref, pax_pool_sem.w^);
if not nil( ref) then
begin
ref^.u1 := dte_ric;
ref^.u2 := dte_default;
ref^.u3 := netc_route;
ref^.u4 := to_link;
lock ref as ric_buf : ric_buf_type do
with ric_buf do
begin
first := ric_first_val;
last := ric_first_val+min_ric_data-1;
delay1:=ric_delay_1;
delay2:=ric_delay_2;
call_id:= 0;
end;
signal( ref, dte_sem^ );
end
\f
else
begin
count( stat( no_pax_bufs));
if tst>4 then
testout(z,"no ric bufs ", i);
end;
end;
end; (* make-ric-bufs *)
\f
procedure send_aic_buf (
stream,
call_id,
c_data
: byte );
(*----------------------------------------------------------------
. sends an aic-buffer to the dte .
------------------------------------------------------------------*)
var
ref : reference;
begin
if tst>64 then
testout(z,"send-aic-buf", stream);
sensesem( ref, pax_pool_sem.w^);
if not nil( ref) then
begin
count( stat( aicc_packets));
ref^.u1 := dte_aic;
ref^.u2 := dte_default;
ref^.u3 := stream;
ref^.u4 := to_link;
lock ref as aic : aic_buf_type do
with aic do
begin
first := aic_first_val;
last := aic_first_val +1;
aic_id:= call_id;
aic_q := false;
end;
signal( ref, dte_sem^);
send_sdata_buf( ref, stream, dte_aic, c_data);
end
else
begin
count( stat( no_pax_bufs));
if tst>4 then
testout(z,"no aic buf ",0);
end;
end (* send-aic-buf *);
\f
procedure send_rejic_buf (
call_id,
diag_code : byte );
(*----------------------------------------------------------
. sends a ric-buffer to dte .
------------------------------------------------------------*)
var
ref : reference ;
begin
if tst>64 then
testout(z,"send-rejic ", call_id);
sensesem ( ref, pax_pool_sem.w^);
if not nil( ref) then
begin
count( stat( reji_packets));
ref^.u1 := dte_rejic;
ref^.u2 := dte_default;
ref^.u3 := call_id;
ref^.u4 := to_link;
lock ref as rejic : rejic_buf_type do
with rejic do
begin
first := rejic_first_val;
last := rejic_first_val +1;
rejic_id := call_id;
rejic_diag := diag_code;
end;
signal( ref, dte_sem^);
end
else
begin
count( stat( no_pax_bufs));
if tst>4 then
testout(z,"no rejic buf", 0);
end;
end (* send-rejic-buf *);
\f
procedure send_ric_buf (
var
ref : reference );
(*--------------------------------------------------------
- sends a ric-buffer to dte -
----------------------------------------------------------*)
begin
ref^.u2 := dte_default;
signal( ref, dte_sem^);
end;
\f
procedure send_sdata_buf (
var iref : reference;
stream_no : byte;
opr_code : byte ;
c_data : byte );
(*-------------------------------------------------
. sends a sdata buffer to dte
---------------------------------------------------*)
var
ref : reference;
i : integer;
begin
if tst>64 then
begin
testout(z,"send-sdata-b", stream_no);
testout(z,"op-code ", opr_code);
end;
sensesem( ref, pax_pool_sem.w^);
if not nil( ref) then
begin
count( stat( send_packets));
ref^.u1 := dte_sdata;
ref^.u2 := dte_default;
ref^.u3 := stream_no;
ref^.u4 := to_link;
lock ref as buf : dte_sdata_data do
begin
buf.first := sdata_first_val;
buf.last := sdata_first_val + l_control -1;
buf.q_bit := false;
buf.m_bit := false;
\f
with buf.control do
with stream_states( stream_no) do
begin
op_code := opr_code;
data := c_data;
n_s_inc := v_s_inc;
n_s := v_s;
n_r_inc := v_r_inc;
n_r := v_r;
end;
if not nil( iref) then
lock iref as abuf : max_alarm_mess do
begin
buf.alarm_mess := abuf;
buf.last := buf.last + abuf.al.no_of_by+2;
end
else
buf.alarm_mess.al.no_of_by := 0;
with stream_states( stream_no) do
v_s := ( v_s +1) mod 256;
end;
signal( ref, dte_sem^);
end
else
begin
count( stat( no_pax_bufs));
if tst>4 then
testout(z,"no sdata buf", 0);
end;
end;
\f
procedure retransmit_data (
stream : byte );
(*--------------------------------------------------------------
. retransmits the data at stream_states(stream).act_out
----------------------------------------------------------------*)
begin
if tst>64 then
testout(z,"retransmit ", stream);
with stream_states( stream) do
begin
if not nil( act_out) then
begin
retrans_count := retrans_count +1;
if retrans_count <= max_retrans then
begin
retrans_timer := retrans_timo;
send_sdata_buf( act_out, stream, opc_command,0);
end
else
begin (* reject the packet *)
count( stat( lost_packets));
release_uo_data( reject, stream);
end;
end;
end;
end;
\f
procedure release_uo_data (
cause : release_cause;
stream : byte );
(*---------------------------------------------------------------
. releases the data at stream_states(stream).act_out
-----------------------------------------------------------------*)
begin
if tst>64 then
testout(z,"release-uo ", stream);
(*---- release act-out ----*)
if not nil( stream_states(stream).act_out) then
begin
if cause = accept then
return( stream_states(stream).act_out)
else
if stream_states(stream).act_out^.u4 = #h12 then
return( stream_states(stream).act_out)
else
begin
lock stream_states(stream).act_out as a:alarmlabel do
local_macro := a.send.macro;
reject_message
(stream_states(stream).act_out,
local_macro,
netc_mic_addr, no_connection, netc_route1);
k:= local_transmitter( stream_states(stream).act_out, local_macro);
end;
update_stream_state( stream, dec_q, free);
end;
\f
(*---- take the next in queue ----*)
sensesem( stream_states(stream).act_out, stream_states(stream).out_queue);
if nil( stream_states(stream).act_out) then
begin
if stream_states( stream).state = calling then
update_stream_state( stream, new_stat, free)
else
if cause = accept then
update_stream_state( stream, new_stat, waiting)
else
update_stream_state( stream, new_stat, free)
end
else
begin
with stream_states( stream) do
begin
max_retrans := pax_table( act_out^.u1).max_retrans;
retrans_count := 0;
if max_retrans > 0 then
retrans_timo := glob_timeout div max_retrans
else
retrans_timo := glob_timeout;
retrans_timer := retrans_timo;
if cause = accept then
send_sdata_buf( act_out, stream, opc_command, 0)
else
begin
make_a_call( stream);
update_stream_state( stream, new_stat, calling);
end;
end;
end;
end;
\f
procedure return_rdata_buf (
var ref : reference );
(*----------------------------------------------------------
. sends a rdata-buffer to dte again
------------------------------------------------------------*)
begin
if tst>64 then
testout(z,"return-rdata", ref^.u2);
ref^.u2 := dte_default;
lock ref as rdata : dte_sdata_data do
rdata.last := sdata_first_val + l_control + l_listen -1;
signal( ref, dte_sem^);
end;
\f
procedure send_rdata_bufs (
no_of_bufs,
stream : byte );
(*------------------------------------------------------
- sends rdata bufs to dte -
--------------------------------------------------------*)
var
i : integer;
ref : reference ;
begin
if tst>64 then
testout(z,"send-rdata-b", stream);
for i := 1 to no_of_bufs do
begin
sensesem( ref, pax_pool_sem.w^);
if not nil( ref) then
begin
ref^.u1 := dte_rdata;
ref^.u2 := dte_default;
ref^.u3 := stream;
ref^.u4 := to_link;
lock ref as rdata : dte_sdata_data do
with rdata do
begin
first := sdata_first_val;
last := sdata_first_val +l_control+ l_listen -1;
end;
signal( ref, dte_sem^);
end
else
begin
count( stat( no_pax_bufs));
if tst>4 then
testout(z,"no rdata buf",0);
end;
end
end (* send-rdata-bufs *);
\f
function ok_receive_state (
var ref : reference
) : boolean;
(*----------------------------------------------------------
. tests the dte-rdata-buffer
. in ( control.op-code and control.data )
. and checks the state of the stream
. value :
. true -- if data should be received by stream-receiver
. false - if it is an answer on a command
-------------------------------------------------------------*)
begin
if tst>64 then
testout(z,"ok-receiv-st", 0);
ok_receive_state := false;
case stream_states( ref^.u3).state of
free : (*-- the rdata is nonsens --*)
begin
count( stat( nons_packets));
(*-- send clear stream --*)
(*--?????????--*)
end;
\f
calling :
(*----- dte-aic, dte-rejic and dte-clr is interesting ---*)
begin
lock ref as rdata : dte_sdata_data do
case rdata.control.op_code of
dte_aic :
(*----- the call has been accepted -----*)
begin
update_stream_state( ref^.u3, new_stat, sending);
if rdata.control.data = data_received then
release_uo_data( accept, ref^.u3)
else
if rdata.control.data = data_not_received then
retransmit_data( ref^.u3);
end;
dte_rejic :
(*------- the call was rejected ---*)
begin
if rdata.control.data = data_received then
begin
release_uo_data( accept, ref^.u3);
(* clear stream *)
(*-----?????????????------*)
end
else
if rdata.control.data = data_not_received then
begin
act_pax_addr := stream_states( ref^.u3).pax_addr;
make_a_call( ref^.u3);
end;
end;
\f
opc_receipt :
(*--------- data receipt from remote netcon -------*)
if rdata.control.data = data_received then
release_uo_data( accept, ref^.u3)
else
if rdata.control.data = data_not_received then
retransmit_data( ref^.u3);
dte_clr :
(*----- clear from remote netcon ---*)
(*--- clear stream ---*)
(*---??????????????---*)
begin
end;
otherwise
(*------ nonsens ---*)
begin
count( stat( nons_packets));
end;
end (*case *)
end (*calling *);
\f
sending :
(*----- opc-receipt and opc-command are interesting ----*)
begin
lock ref as rdata : dte_sdata_data do
case rdata.control.op_code of
opc_receipt :
(*--------- receipt for send uo-data ----- *)
begin
if rdata.control.data = data_received then
release_uo_data( accept, ref^.u3)
else
retransmit_data( ref^.u3);
end;
opc_command :
(*--------- data-received on active stream ------- *)
begin
ok_receive_state := true;
count( stat( reci_packets));
end;
dte_reset :
(*------- reset counters and retransmit data ------*)
begin
end;
dte_clr :
(*----- send clear ok and make a new call -----*)
begin
end;
otherwise
count( stat( nons_packets));
end (* case *);
end; (* sending *)
\f
receiving,
waiting :
(*------- opc-command, dte-clr and dte-reset are interesting --*)
begin
lock ref as rdata : dte_sdata_data do
case rdata.control.op_code of
opc_command :
(*--------- data received on active stream -----*)
begin
ok_receive_state := true;
count( stat( reci_packets));
update_stream_state( ref^.u3, new_stat, receiving);
end;
dte_reset :
(*------- reset counters -----*)
begin
end;
dte_clr :
(*----- send clear ok ------*)
begin
end;
otherwise
count( stat( nons_packets));
end(* case *)
end (* waiting *);
clearing :
(*------ implemented later ------*)
begin
end;
resetting :
(*------ implemented later --------*)
begin
end;
otherwise;
end; (* case *)
end; (* procedure *)
\f
procedure dte_result_handler (
var
ref : reference
);
(*----------------------------------------------------------
. - handles all not ok results given from dte .
------------------------------------------------------------*)
begin
if tst>16 then
testout(z,"dte-res-nok ", ref^.u2);
case ref^.u1 of
dte_rdata :
begin
if tst>16 then
testout(z,"dte-rdata-no",ref^.u2);
case in_ref^.u2 of
dte_remo_clear : (* rejic or clear *)
if ok_receive_state( ref) then
begin
signal( ref, pax_pool_sem.s^);
end;
otherwise
begin
return_rdata_buf( ref);
end
end (* case *);
end;
dte_aic, dte_rejic :
begin
if tst>16 then
testout(z,"in dte-ric ",0);
signal( ref, pax_pool_sem.s^);
end;
dte_clr :
begin
if tst>16 then
testout(z,"in dte-clr ",0);
signal( ref, pax_pool_sem.s^);
end;
\f
dte_res :
begin
if tst>16 then
testout(z,"in dte-res ",0);
signal( ref, pax_pool_sem.s^);
end;
dte_stat :
begin
if tst>16 then
testout(z,"in dte-stat ",0);
signal( ref, pax_pool_sem.s^);
end;
dte_ric :
begin
if tst>16 then
testout(z,"in dte-ric ",0);
signal( ref, pax_pool_sem.s^);
end
otherwise
begin
if tst>16 then
testout(z,"in unkn fct ",0);
signal( ref, pax_pool_sem.s^);
end;
ref^.u2 := dte_default;
signal( ref, dte_sem^);
end;
end;
\f
procedure ts_wait (
var
mes_ref : reference;
var
sem_ptr : sempointer
);
(*----------------------------------------------------------------
. wait with return of dummy messages .
----------------------------------------------------------------*)
begin
wait( mes_ref, sem_ptr^);
while (mes_ref^.u3 = dummy_route)
and not ownertest( timer_pool, mes_ref) do
begin
if tst>4 then
testout(z,"dummybuf ret",0);
signal(mes_ref, pax_pool_sem.s^);
wait( mes_ref, sem_ptr^);
end;
end (* ts_wait *);
\f
(*---------------------------------------------------------------
. main program .
-----------------------------------------------------------------*)
begin
testopen( z, own.incname, op_sem);
testout( z, version , al_env_version);
write_create_pars;
(*--- initialize internal tables ---*)
local_mac_top := 2;
pax_table_top := dc_index + 1;
init_stream_states;
init_pax_table;
(*--- listen at dte ---*)
make_ric_bufs( all_ric_bufs);
alloc( ref, timer_pool, main_sem.s^);
send_to_systimer( ref);
\f
(*------------------------------------------------------------
. main loop .
--------------------------------------------------------------*)
repeat (* until forever *)
ts_wait( in_ref, main_sem.w);
if ownertest ( timer_pool, in_ref) then
begin
(*-------------------------------------------------------
. buffer from TIMER
---------------------------------------------------------*)
send_to_systimer( in_ref);
for i := min_stream_no-1 to max_stream_no do
with stream_states(i) do
begin
j:= 1;
while j <= l_queue do
if timers(j) > 0 then
begin
timers(j) := timers(j) -1;
if timers(j) = 0 then
begin
if tst>4 then
testout(z,"timeout on ", i);
(* reject uo data *)
release_uo_data( reject, i);
end
else
j:=j+1
end
else
begin
if tst>4 then
testout(z,"wrong timer ", j);
timers(j) := 60;
j:= l_queue +1;
end;
if not nil( act_out) then
if retrans_timer > 0 then
begin
retrans_timer := retrans_timer -1;
if retrans_timer = 0 then
begin
(*--- the action is dependent on the stream state --*)
case state of
free : (* do nothing *)
begin
end;
calling : (* make a new call *)
begin
retrans_count := retrans_count +1;
if retrans_count <= max_retrans then
begin
retrans_timer := retrans_timo;
act_pax_addr := pax_addr;
make_a_call(i);
end
else
begin (* reject the packet *)
count( stat( lost_packets));
release_uo_data( reject, i);
end;
end;
\f
sending : (* send again *)
retransmit_data(i);
waiting,
clearing : (*- clear stream -*)
begin
(*--- ??????? --*)
end;
resetting : (*-- reset stream ---*)
begin
(*--- ??????? --*)
end;
receiving : (* do nothing *)
begin
end
otherwise;
end ; (* case *)
end
end;
end
end
\f
else
if in_ref^.u4 = to_link then
begin (* a buffer from dte *)
(*-----------------------------------
. buffer from DTE
-------------------------------------*)
if in_ref^.u2 = dte_ok_result then
begin (* all went well at dte *)
case in_ref^.u1 of
dte_car : (* ok-answer on call request *)
begin
if tst>16 then
testout(z,"dte-car-ok ",0);
signal( in_ref, pax_pool_sem.s^);
end;
dte_aic, dte_rejic : (* ok-answer on receipt on call *)
begin
if tst>16 then
testout(z,"dte-rec-ok ",0);
signal( in_ref, pax_pool_sem.s^);
end;
dte_clr : (* ok-answer on clear request *)
begin
if tst>16 then
testout(z,"dte-clr-ok ", 0);
signal( in_ref, pax_pool_sem.s^);
end;
\f
dte_res : (* ok-answer on reset request *)
begin
if tst>16 then
testout(z,"dte-reset-ok",0);
signal( in_ref, pax_pool_sem.s^);
end;
dte_stat : (* ok-answer on stream status *)
begin
if tst>16 then
testout(z,"dte-stat-ok ",0);
signal( in_ref, pax_pool_sem.s^);
end;
\f
dte_sdata : (* ok-answer on send data *)
begin
if tst>16 then
testout(z,"dte-sdata-ok",0);
signal( in_ref, pax_pool_sem.s^);
end;
dte_rdata : (* ok-answer on receive data *)
begin
if tst>16 then
testout(z,"dte-rdata-ok",0);
if ok_receive_state( in_ref) then
i := stream_receiver( dte_rdata, in_ref);
return_rdata_buf( in_ref);
end;
dte_ric : (* ok-answer on receive call *)
begin
if tst>16 then
testout(z,"dte-ric-ok ", 0);
i := stream_receiver( dte_ric, in_ref);
in_ref^.u2 := dte_default;
signal( in_ref, dte_sem^);
end
otherwise
begin
signal( in_ref, pax_pool_sem.s^);
end
end (* case *);
end
else
begin
dte_result_handler( in_ref);
if not nil( in_ref) then
begin
if tst>16 then
testout(z,"resulthandle",0);
signal( in_ref, pax_pool_sem.s^);
end
end
end
\f
else
if in_ref^.u4 = dyn_test then
begin
(*----------------------------------------------------
. buffer to set testmode
------------------------------------------------------*)
tst := in_ref^.u3;
if in_ref^.u2 = 1 then
lock in_ref as buf : stat_type do
buf := stat;
return( in_ref);
end
\f
else
(*-------------------------------------
. buffer from SUPERVISOR
---------------------------------------*)
if (in_ref^.u3 >= netc_route)
and (in_ref^.u3 <= netc_route2 ) then
begin (* message to paxnet *)
if tst>16 then
testout(z,"tss-buffer ", in_ref^.u4);
lock in_ref as buf : alarmlabel do
alarm_macro := buf.rec.macro;
if in_ref^.u3 = netc_route1 then
handle_10_12_mess( in_ref)
\f
else
begin
(*-- a message to the net --*)
act_pax_index := local_receiver( in_ref, alarm_macro);
if not nil( in_ref) then
if act_pax_index < pax_table_top then (* the alarmmacro is in pax-table *)
begin
if tst>16 then
testout(z,"macro in tab", act_pax_index);
act_pax_addr := pax_table( act_pax_index).pax_addr;
if not connec_to_addr( act_stream_index) then
begin (* no stream active to this address *)
(* and no waiting on this address *)
act_stream_index := free_stream;
if act_stream_index < min_stream_no then
begin (* no streams are ready for use *)
if tst>16 then
testout( z, "no streams ",in_ref^.u4);
send_to_wait( in_ref, act_pax_index);
end
else
begin (* act-stream-index points to an idle stream *)
if tst>16 then
testout( z, "idle stream ", act_stream_index);
send_rdata_bufs( windowsize, act_stream_index);
start_stream( in_ref,act_stream_index, act_pax_index);
end
end
else
begin
(* index at act-pax-index points to active stream *)
in_ref^.u1 := act_pax_index mod 256 ;
send_to_stream( in_ref, act_stream_index);
end;
end
\f
else
if in_ref^.u4 = #h12 then
return( in_ref)
else
begin
(*-- no alarmmacro in table --*)
lock in_ref as a : alarmlabel do
local_macro := a.send.macro;
reject_message
( in_ref, local_macro,
netc_mic_addr, unknown_receiver, netc_route1);
if not nil( in_ref) then
k := local_transmitter( in_ref, local_macro);
end;
end
end
\f
else
if in_ref^.u4 = #h12 then
return( in_ref)
else
begin (* message from paxnet *)
if tst>4 then
begin
testout( z, "unknown mess", in_ref^.u3);
testout( z, "in notownbuf", in_ref^.u4);
end;
lock in_ref as a : alarmlabel do
local_macro := a.send.macro;
reject_message
( in_ref, local_macro,
netc_mic_addr, unknown_route, netc_route1);
if not nil( in_ref) then
k:= local_transmitter( in_ref, local_macro);
end;
until false;
end.
«eof»