DataMuseum.dk

top - metrics - download

    Length: 56064 (0xdb00)
    Types: TextFileVerbose
    Names: »tsatcjoba«

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

TextFileVerbose

job nla 9 200 area 10 size 100000 time 11 59 perm disc1 2000 20 
( mode list.yes
source = copy 25.1
atcsource = set 1 disc1
( i atcedit1
atcsource = edit source
end )
if ok.no
finis
outlst = set 1 disc1
outlst = indent atcsource mark lc 
templist = set 1 disc1
templist = cross outlst
clear temp outlst
o errors
pascal80 spacing.12000 codesize.10000 alarmenv atcsource
o c
lookup pass6code
if ok.yes
( tsatcbina = set 1 disc1
tsatcbina = move pass6code
scope user tsatcbina )
tsatclst = set 1 disc1
tsatclst = copy templist errors
scope user tsatclst
convert errors
clear temp templist
finis
)
process atconnector(
(*t1 op_sem               : sempointer; t1*)
var
main_sem             ,              (* Pointer to ATC's main semaphore.
-                                   All messages are received here *)
queue_sem            : !ts_pointer; (* Pointers to the queue semaphore, that
-                                   holds control an test messages while ATC is busy *)
var
ath_sem              ,              (* Pointer to the main semaphore of ATH *)
driver_sem           ,              (* Pointer to main semaphore of LAM driver *)
timer_sem            ,
com_pool             : !sempointer; (* Pointer to the semaphore that holds
-                                   the vacant message resources of the TS *)
var
dc_macro             ,              (* macro address of own dc *)
ts_macro             : !macroaddr;  (* macro address of own ts *)
own_addr             : integer;     (* Micro address of this ATC inarnation *)
channel_no           : byte );      (* i/o channel number used by this ATC incarnation *)

const
version              = "vers  3.08a/";



(*********************************************************************************
* 
* description      : The purpose and function of the AT_CONNECTOR is mainly to
*                    run the protocole with an AT. The ATC is the master of 
*                    this communication.
*                    The state of the transmission line is monitored by ATC
*                    and alarms concerning the conditions of transmission are
*                    signalled to PVC or DC.
*                    Furtermore commands originating from DC and VC are executed
*                    and alarms from AT are signalled to a VC.
*                    AT_CONNECTOR participates in the module supervision in
*                    the TS.
*
* externals        : check5
*                    testopen
*                    testout
*
* environment      : alarm environment (latest version)
*
* author           : NLA
*
*********************************************************************************)
\f


(*********************************************************************************
*
* PSEUDO CODE of AT_CONNECTOR
*
* process atconnector
*
* constant, type and variable declaration parts
*   1) shielded types
*   2) telegrams from TS to AT
*   3) telegrams from AT to TS
*   4) state telegrams from AT to TS
*   5) operation codes and formats
*   6) watch central table and management of it
*   7) management of states and protocol
*   8) supervision of transmission line
*   9) miscellaneous
*
* forward declaration part
*
* subroutine declaration part
*
*
* begin
*   
*   initialize;
*
*   restrict_protocole;
*     <* end of initialize sequence *>
*
*   repeat <* forever *>
*
*     if conversation = idle then
*      begin
*        if open( queue ) then <* preprocess queue *>
*         begin
*           wait( msg, queue );
*           initiate_conversation <* messages in the queue always involve AT *>
*         end
*        else
*         begin
*           sendtimer( delay_msg );
*           send_telegram( poll, 0 )
*         end
*      end;
*  
*     wait( msg, main );
*  
*     if ownertest( driver_pool, msg ) then
*      driver_msg :=: msg
*     else
*      case message_origin of
*  
*        ATH:
*          begin
*            if operation_code in (.control, testi1, testi2, teste.) then
*             signal( msg, queue )
*            else
*             read_write( msg ) <* AT not involved, execute at once *>
*          end;
*  
*        DRIVER:
*         if transmission_error and limit_overflow then
*           signal( call_limit_alarm, ATH )
*          else
*           begin
*             if limit_underflow then
*              signal( recall_limit_alarm, ATH );
*  
*             case AT_operation_code of
*  
*              p_ack: conversation:= idle;
*  
*              au_alarm:
*               if no_of_bytes = AVC_block_size then
*                signal( au_alarm, AVC )
*               else
*                send_telegram( poll, 0 );
*  
*              addr:
*               begin
*                 search_address_code;
*                 send_telegram( poll, 0 )
*               end;
*  
*              state_alarm:
*               if state_byte <> current_state then
*                begin
*                  update_current_state;
*                  signal( state_alarm, PVC )
*                end;
*  
*              d_ack:
*               if no_of_bytes = block_size then
*                signal( control_receipt, sender )
*               else
*                send_telegram( cntrl, next_cntrl_byte );
*  
*              t_ack:
*               begin
*                 signal( test_receipt, sender );
*                 conversation:= idle
*               end;
*
*             end <* case AT_operation_code *>
*
*           end
*
*     end <* case message origin *>
*
*   until forever
*
* end. <* process AT_CONNECTOR *>
*
*********************************************************************************)




\f


(*********************************************************************************
*
* ABBREVIATION LIST
*
* at, AT       alarm terminal
* atc, ATC     alarm terminal connector
* ath, ATH     alarm terminal (connector) handler
* au           alarm unit
* avc          alternative watch central
* dc           district centre
* driver       lam driver
* msg          reference to a message
* pvc          primary watch central
* r_w          read_write
* sem          semaphore
* s_a..        stop activity (e.g. s_a_limit)
* t_e../..t_e  transmission error (e.g. t_e_counter)
* TS, ts       terminal station
* vc           watch central
*
*
*
*
*
*
*
*
*
*
*
*
*********************************************************************************)

\f


(*********************************************************************************
* declaration part 1: shielded types
*
*********************************************************************************)

var

(* pools. Allocation takes place with main_sem as answer semaphore *)

driver_pool          : pool 1 of integer; (* driver message is allocated from this pool *)
delay_pool           : pool 1;    (* delay message is allocated from this pool *)

(* reference variables *)

delay_msg,                        (* holds delay out message while it's unused *)
ath_msg,                          (* holds message from ATH while waiting for response from AT *)
driver_msg,                       (* holds message from DRIVER while while it's unused *)
alarm_msg,                        (* general use. Holds alarm message while it's updated *)
atc_msg              : reference; (* holds message from input semaphore 
while it's inspected *)
\f


(*********************************************************************************
* declaration part 2: telegrams from master (TS) to slave (AT)
*
*********************************************************************************)

const
(* operation codes *)
poll_opc             = 0;
atc_cntrl            = 1;
atc_testi            = 2;
atc_teste            = 3;

(* data bytes *)
poll_byte            = 0;
tEsti1_byte          = 0;
testi2_byte          = 1;

type
atc_op_codes         = poll_opc..atc_teste;

atc_format           = packed record
out_data      : byte;
atc_opc       : atc_op_codes;
serial_number : boolean;
checkbits     : 0..31
end;

var
last_telegram        : atc_format   := atc_format( 0, 0, false, 0 );

\f


(*********************************************************************************
* declaration part 3: telegrams from slave (AT) to master (TS)
*
*********************************************************************************)

const
(* operation codes *)
p_ack                = 0;
state                = 1;
au_alarm             = 2;
addr                 = 3;
d_ack                = 4;
t_ack                = 5;
e_ack                = 6;
n_ack                = 7;

(* test intern bytes *)
test_int_ok          = #h06;  (* 0000 0110 *)
test_int_err         = #h15;  (* 0001 0101 *)

type
at_op_codes          = p_ack..n_ack;

at_format            = packed record
in_data   : byte;
at_opc    : at_op_codes;
checkbits : 0..31
end;
\f


(*********************************************************************************
* declaration part 4: state telegrams from slave (AT) to master (TS)
*
*********************************************************************************)

const
(* at state bits *)
unused               = 0;
at_time_out          = 1;
hs_error             = 2;
au_error             = 3;
serif_error          = 4;
restart              = 5;
batt_limit           = 6;
batt_supply          = 7;

type
state_bits           = unused..batt_supply;
state_byte           = set of state_bits;

var
state_bit            : state_bits  := unused;
\f


(*********************************************************************************
* declaration part 5: alarm net operation codes and formats
*
*********************************************************************************)

const
(* pvc log operation code *)
pvc_alarm_log        = #h01;

(* garbage message *)
reject_opc           = #h12;

(* alarms *)
au_alarm_opc         = #h30;
line_alarm           = #h31;
state_alarm          = #h32;
service_alarm        = #h34;
s_a_alarm            = #h35;

(* control *)
ts_cntrl             = #h40;
group_cntrl          = #h44;

(* tests *)
ts_testi1            = #h80;
ts_testi2            = #h82;
ts_teste             = #h84;


(* change of activity *)
ts_newactivity       = #h90;
service_poll         = ts_newactivity + service_code;

connect_test         = #h92;
\f


(* updating of watch central table *)
upd_vc_table         = #ha0;

(* read package counter *)
read_package_count   = #hb4;

(* read or update of parameter *)
r_w_tec              = #hb2;
r_w_service_limit    = #hb6;
r_w_s_a_limit        = #hba;
r_w_max_succ_t_e     = #hbc;

dummy_alarm          = #hc8;

type
word_msg_format      = record
alarmnetlabel : alarmlabel;
param         : array( 0..( size_listen - ( label_size + 1 ) ) )
of integer
end;

byte_msg_format      = record
alarmnetlabel : alarmlabel;
datapart      : alarm
end;

connect_msg_format   = record
alarmnetlabel : alarmlabel;
vc_address    : alarmnetaddr
end;
\f


(*********************************************************************************
* declaration part 6: watch central table and management of it
*
*********************************************************************************)

const 
pvc_index            = 1;

type
vc_spann             = pvc_index..vc_addr_l;

vc_update_format     = record
alarmnetlabel : alarmlabel;
new_vc        : vc_addr_e
end;

var
vc_addr_table        : array( vc_spann ) of vc_addr_e;

actual_vc_index,
top_avc_index        : vc_spann := pvc_index;
\f


(*********************************************************************************
* declaration part 7: management of states and protocol
*
*********************************************************************************)

const
forever              = false;
driver_ready         = #hff;

type
run_set              = set of byte;

type_of_conversation = (
idle,                       (* no telegram pending *)
busy,                       (* poll pending *)
control,                    (* control pending *)
testi,                      (* testi1 or testi2 telegram pending *)
teste,                      (* test extern pending *)
coll_alarm1 ,               (* ATC is collecting multi byte alarm *)
coll_alarm2 );              (* a poll is pending to look for a new alarm *) 

var
runtimeset           : run_set              := (..);

conversation         : type_of_conversation := idle;
\f


(*********************************************************************************
* declaration part 8: supervision of transmission line
*
*********************************************************************************)

type
valid_set            = set of at_op_codes;

t_e_kind_type        = (
no_error,
time_excess,                (* reported from DRIVER *)
not_ack,                    (* n_ack operation code received *)
bit_error,                  (* error in checksum *)
ill_opc,                    (* unexpected operation code in response *)
channel_error );            (* reported from DRIVER *)

var
t_e_step             : integer := trans_err_rate;   (* increment of t_e_counter 
when a transmission error occurs *)
service_limit        : integer := service_lim;      (* t_e_counter service_limit. *)
s_a_limit            : integer := stop_poll_lim;    (* t_e_counter stop activity limit. *)
max_succ_t_e         : integer := max_succ_lin_err; (* number of successive 
transmission errors before line alarm *)

t_e_counter,                                        (* transmission error counter *)
no_succ_t_e          : integer           := 0;

valid_response       : array( busy..coll_alarm2 ) of valid_set;

t_e_kind             :  t_e_kind_type    := no_error;

line_state           : (
low,                        (* t_e_counter below service limit *)
serv_lim_excess,            (* service_limit exceeded *)
s_a_lim_excess ) := low;    (* stop activity limit exceeded *)



\f


(*********************************************************************************
* declaration part 9: miscellaneous
*
*********************************************************************************)

const
override             = false;
dummy                = 0;
dummy_macro          = macroaddr( dummy, dummy, dummy );

(*t3 tek_offs             = #h18;
tec_offs             = #h28;
cnv_offs             = #h60; t3*)

(*t3 dump_st_off          = #hd0;
dump_st_on           = #hd1; t3*)

type
create_ch_format     = array( 0..1 ) of byte;

var
package_count        : integer           := 0;      (* is counted circular from 0 
through 32766 = ( max_int - 1) *)

delay3, delay4       : byte;                        (* contents u3 and u4 values of delay message *)

current              : byte              := 1;
block_size           : byte              := 0;

at_op_code           : at_op_codes       := 0;
at_data              : byte              := 0;

(*t3 dump_state           : boolean           := false; t3*)

(*t1 z                    : zone; t1*)
\f


(*********************************************************************************
* forward declaration part
*
*********************************************************************************)

procedure restrict_protocol; forward;


\f


(*t3 procedure dump_state_block( text: alfa; param: integer );

type
hexa                 = array( 0..15 ) of char;
four_digits          = packed array( 9..12 ) of 0..15;
state_block          = array( 0..15 ) of four_digits;

const
hex_convert          = hexa( "0", "1", "2", "3", "4", "5", "6", "7",
"8", "9", "a", "b", "c", "d", "e", "f" );

var
temp_msg             : reference;
string               : alfa;
word                 : 0..15;
position             : 9..12;

begin

testout( z, text, param );

string:= "            ";
repeat
wait( temp_msg, com_pool^ );
if ( temp_msg^.u3 = dummy_route ) then
return( temp_msg )
until not nil( temp_msg );

lock temp_msg as locvar: run_set do 
locvar:= runtimeset; t3*) (* end lock temp_msg *)   

(*t3 lock temp_msg as locvar: state_block do
begin
for word:= 0 to 15 do
begin

for position:= 9 to 12 do
string( position ):= hex_convert( locvar( word, position ) );

testout( z, string, word )
end
end; t3*) (* lock temp_msg *)

(*t3 return( temp_msg )

end; t3*) (* procedure dump_state_block *)
\f


(*t3 procedure print_telegram( var msg: reference; transmit: boolean; param: byte );

type 
hexa                 = array( 0..15 ) of char;

const
hex_convert          = hexa( "0", "1", "2", "3", "4", "5", "6", "7", "8", "9",
"a", "b", "c", "d", "e", "f" );

var
string               : alfa;

begin

string:= "            ";

if transmit then
lock msg as locvar: atc_format do
with locvar do
begin
string(  1 ):= "T";
string(  4 ):= hex_convert( atc_opc );
string(  6 ):= hex_convert( ord( serial_number ) );
string(  8 ):= hex_convert( checkbits div 16 );
string(  9 ):= hex_convert( checkbits mod 16 );
string( 11 ):= hex_convert( out_data div 16 );
string( 12 ):= hex_convert( out_data mod 16 )
end t3*) (* lock msg *)
(*t3 else
lock msg as locvar: at_format do
with locvar do
begin
string(  1 ):= "R";
string(  6 ):= hex_convert( at_opc );
string(  8 ):= hex_convert( checkbits div 16 );
string(  9 ):= hex_convert( checkbits mod 16 );
string( 11 ):= hex_convert( in_data div 16 );
string( 12 ):= hex_convert( in_data mod 16 );
end; t3*) (* lock msg *)

(*t3 testout( z, string, param )

end; t3*)(* procedure print_telegram *)
\f


procedure send_telegram( 
new_opc :atc_op_codes; data_byte :byte;
new_serial_no, transmission_error: boolean);

(*********************************************************************************
* description      : Updates and sends a telegram to AT (through DRIVER) and requests a
*                    delay message from TIMER
* 
* call value       : new_opc            = operation code of telegram or unsignificant
*                    data_byte          = data byte of telegram or unsignificant
*                    new_serial_no      = indicates whether serial number of
*                                         telegram is to be alternated. Significant
*                                         only if transmission error
*                    transmision_error  = indicates whether last telegram is to be
*                                         repeated.
* return value     :                      all are unchanged
* globals          : driver_msg         = nil after the call
*                    last_telegram      = updated
*********************************************************************************)

begin

if transmission_error and ( not new_serial_no ) then      (* repeat last telegram *)
lock driver_msg as locvar: atc_format do
locvar:= last_telegram (* end lock driver_msg *)
else
with last_telegram do
begin

if not transmission_error then         (* set up new telegram *)
begin
atc_opc:= new_opc;
serial_number:= not serial_number;
out_data:= data_byte
end
else
if new_serial_no then 
serial_number:= not serial_number;

lock driver_msg as locvar: atc_format do
locvar:= last_telegram; (* end lock driver_msg *)

if check5( driver_msg, generate ) then;

lock driver_msg as locvar: atc_format do
last_telegram:= locvar (* end lock driver_msg *)

end;

(*t3 print_telegram( driver_msg, true, ord( conversation ) ); t3*)

if not nil( delay_msg ) then
with delay_msg^ do
begin
u3:= delay3;
u4:= delay4;

sendtimer( delay_msg )

end;

driver_msg^.u2:= channel_no;
signal( driver_msg, driver_sem^ )

end; (* procedure send_telegram *)
\f


function ready_byte_msg( var msg: reference;
data_byte: byte;
var current: byte;
block_size: byte ): boolean;

(*********************************************************************************
* description      : Enters one data byte in message datapart. Takes a message
*                    from common resources when it's necessary
* call value       : msg            = references message to fill 
*                    data_byte      = byte in question
*                    current        = indices byte number in message
*                    block_size     = number of bytes to fill
* return value     : ready_byte_msg = true if filling is completed
*                    current        = next position. Initiated if there's no more 
*                                     data to fill
*                    data_byte, block_size
*                                   = unchanged
* globals          : none
*********************************************************************************)

begin

if nil( msg ) then
sensesem( msg, com_pool^ );

if nil( msg ) then
ready_byte_msg:= true
else
begin

(*t3 testout( z, "current byte", current ); t3*)

if ( current <= block_size ) then
lock msg as locvar: byte_msg_format do 
locvar.datapart( current ):= data_byte; (* end lock msg *)

ready_byte_msg:= ( current >= block_size );

if ( current < block_size ) then 
current:= current + 1
else
current:= 1
end

end; (* function ready_byte_msg *)
\f


procedure finish_message(
var
msg            : reference;
rec_macro      : macroaddr;
rec_micro      : integer;
vc_index       : vc_spann;
route          ,
operation_code ,
block_size     : byte;
res            : result_range;
log_to_pvc     : boolean );

(***********************************************************************************
* description      : Updates the user fields and message label part and sends  
*                    then message to ATH.
* call value       : msg           = references message to be send
*                    vc_index      = index to vc address table for receiver vc if any
*                    route, operation_code, block_size, res
*                                  = message label information
*                    log_to_pvc    = true if the alarm is to be logged at pvc
* return value     : msg           = nil
*                                    the others are unchanged
* globals          : own_addr      = unchanged
************************************************************************************)

type
log_msg_format     = record
alarmnetlabel : alarmlabel;
avc_address   : alarmnetaddr;
data_part     : array( 5..2 * size_listen - label_size - 2 ) of byte
end;

var
temp_msg           : reference;
alarm_bytes        : alarm;
\f


begin

if not nil( msg ) then
begin

with msg^ do
begin
(*t3 testout( z, "OUT.   route", route ); t3*)
(*t3 testout( z, "OUT.  opcode", operation_code ); t3*)
u3:= route;
u4:= operation_code

end;

lock msg as locvar: byte_msg_format do
with locvar, locvar.alarmnetlabel do
begin

if ( route <> at_route ) then
begin

no_of_by:= block_size + label_size;
rec.macro:= rec_macro;
rec.micro:= rec_micro;
ts_add( 0 ):= vc_addr_table( vc_index ).vc_index;

if log_to_pvc then
alarm_bytes:= datapart;

end
else
begin
rec:= send;

if ( block_size <> 0 ) then
no_of_by:= block_size + label_size;

end;

send.macro:= ts_macro;
send.micro:= own_addr;
result:= res

end; (* lock msg *)

signal( msg, ath_sem^ );
\f


if log_to_pvc then
begin
sensesem( temp_msg, com_pool^ );

if not nil( temp_msg ) then
lock temp_msg as locvar: log_msg_format do
with locvar, avc_address do
begin
micro:= vc_addr_table( actual_vc_index ).vc_index;

for current:= 1 to block_size do
data_part( current + 5 ):= alarm_bytes( current );

end;

finish_message( temp_msg, dummy_macro, dummy, pvc_index, route, pvc_alarm_log,
(**)          ( block_size + 4 ), res, not log_to_pvc );

current:= 1
end;

if operation_code in (.pvc_alarm_log, au_alarm_opc, line_alarm, state_alarm,
ts_cntrl, group_cntrl, ts_teste, ts_newactivity.) then
package_count:= ( package_count + 1 ) mod max_int;

end

end; (* procedure finish_message *)
\f

 
procedure garbage_message( var msg: reference; (*t3 text: alfa; t3*)error_code: result_range );

(*********************************************************************************
* description      : Sends an unrecognizable message to ATH. The supposed
*                    message label is moved to the data part of the message
*                    and a normal alarmnetlabel and user fields is set up.
*                    If this is impossible, the message is released
* call value       : msg              = references message in question
*                    text             = error diagnose
*                    error_code       = entered in label
* return value     : msg              = nil
*                    text, error_code = unchanged
* globals          : none
*********************************************************************************)

type
error_format         = array( 0..1 ) of alarmlabel;

begin

(*t3 testout( z, text, error_code ); t3*)

if ( msg^.size >= (label_size + 2 )) then
begin

lock msg as locvar: error_format do
begin
locvar( 1 ):= locvar( 0 );
locvar( 1 ).op_code:= msg^.u4
end; (* lock msg *)

finish_message( msg, dummy_macro, dummy, actual_vc_index,
(**)        at_route, reject_opc, ( label_size + 2 ), error_code, override )

end
else
release( msg )

end; (* procedure garbage_message *)

\f


function search_addr_code( table_entry: byte; var table_index: vc_spann ): boolean;

(**********************************************************************************
* description      : Searches vc address table for watch central address code
* 
* call value       : table_entry      = address code to search
*                    table_index      = undefined
* return value     : search_addr_code = true if the entry is found else false
*                    table_entry      = unchanged
*                    table_index      = indices entry if it exists
* globals          : vc_addr_table    = unchanged
*********************************************************************************)

begin

table_index:= pvc_index;

while ( table_index < top_avc_index ) and 
( table_entry <> vc_addr_table( table_index ).addr_code ) do
table_index:= table_index + 1;

search_addr_code:= ( table_entry = vc_addr_table( table_index ).addr_code )

end; (* function search_addr_code *)
 
 
\f


function search_vc_index( table_entry: integer; var table_index: vc_spann ): boolean;

(*********************************************************************************
* description      : Searches vc address table for watch central index
*
* call value       : table_entry     = entry to search
*                    table_index     = undefined
* return value     : search_vc_index = true if the entry is found, otherwise false
*                    table_entry     = unchanged
*                    table_index     = indices entry if it exists
* globals          : vc_addr_table   = unchanged
*********************************************************************************)

begin

table_index:= pvc_index;

while ( table_index < top_avc_index ) and
( table_entry <> vc_addr_table( table_index ).vc_index ) do
table_index:= table_index + 1;

search_vc_index:= ( table_entry = vc_addr_table( table_index ).vc_index )

end; (* function search_vc_index *)
\f


procedure transm_cntrl(
var at_op_code: at_op_codes;
var at_data: byte;
valid_response: valid_set );

(*********************************************************************************
* description      : Monitors the conditions of transmission and manages
*                    the sending of messages concerning the state of the transmission line.
*                    Alarms are hold back when ATC is in service_poll.
*                    The counters are not updated if AT state says no power
* call value       : at_op_code        = undefined
*                    at_data           = undefined
*                    valid_response    = the set of responses from AT (slave) which are
*                                        valid in relation to the telegram send
* return value     : at_op_code        = the operation code of the telegram
*                                        if this is found to be valid
*                    at_data           = data byte from telegram if transmission
*                                        isn't disturbed
*                    valid_response    = unchanged
* globals          : runtimeset        = updated
*                    t_e_counter       = updated
*                    no_succ_line_err  = updated
*                    line_state        = updated
*                    t_e_kind          = updated acc. to state/kind of transmission
*                    max_succ_t_e, service_limit, s_a_limit
*                                      = unchanged
********************************************************************************)
\f


procedure send_line_state( op_code, data: byte );

(*********************************************************************************
* description      : Sends a message to DC or VC concerning the state of
*                    the transmission line
* call value       : op_code         = line, service or stop_activity alarm
*                    data            = call (may be time out) or recall
* return value     :                   both are unchanged
* globals          : runtimeset      = unchanged
*                    actual_vc_index = unchanged
*********************************************************************************)

var
temp_msg             : reference;
current              : byte := 1;

begin

if not ( service_poll in runtimeset ) then
if ready_byte_msg( temp_msg, data, current, 1 ) then
finish_message( temp_msg, dc_macro, dc_erh_mic_addr, pvc_index,
(**)          at_route1, op_code, 1, accepted, override )

end; (* procedure send_line_state *)
\f


begin (* procedure transm_cntrl *)

(*t3 runtimeset:= runtimeset - t3*)
 (**) (*t3       (.ord( t_e_kind ) + tek_offs, ord( line_state ) + tec_offs.); t3*)

if ( driver_msg^.u2 = ok_result ) then       (* no error result from DRIVER *)
begin
if check5( driver_msg, check ) = false then   (* bit error *)
t_e_kind:= bit_error
else
lock driver_msg as locvar: at_format do
with locvar do
begin
if ( at_opc = n_ack ) then
t_e_kind:= not_ack
else
if at_opc in valid_response then
begin
t_e_kind:= no_error;
at_op_code:= at_opc;
at_data:= in_data
end
else
t_e_kind:= ill_opc
end (* lock driver_msg *)
end
else
begin   (* driver_msg^.u2 <> ok_result: error result from DRIVER *)
if ( driver_msg^.u2 = timeout_err ) then 
t_e_kind:= time_excess
else
t_e_kind:= channel_error
end;

(*t3 print_telegram( driver_msg, false, ord( t_e_kind ) ); t3*)
\f


if not ( runtimeset >= (.batt_limit, batt_supply.) ) then
begin

if ( t_e_kind <> no_error ) then
begin

t_e_counter:= t_e_counter +
( ord( t_e_counter < s_a_limit ) ) * t_e_step; (* don't go too high *)

(*t1 no_succ_t_e:= no_succ_t_e +
( ord( no_succ_t_e < max_int ) ); t1*) (* don't overflow *)

if ( no_succ_t_e = max_succ_t_e ) then (* send line alarm *) 
begin
send_line_state( line_alarm,
(**)            ( ord( t_e_kind = time_excess ) * ( timeout_err - 1 ) + call ) );

if not ( service_poll in runtimeset ) then
runtimeset:= runtimeset - (.ts_cntrl, group_cntrl, ts_testi1, ts_testi2, ts_teste.)
end

end
else
begin

t_e_counter:= t_e_counter - ord( t_e_counter > 0 ); (* freeze at zero point *)

if ( no_succ_t_e >= max_succ_t_e ) then (* recall line alarm *)
begin
send_line_state( line_alarm, recall );
if not ( service_poll in runtimeset ) then
runtimeset:= runtimeset + (.ts_cntrl, group_cntrl, ts_testi1, ts_testi2, ts_teste.);
no_succ_t_e:= 0
end

end;
\f


case line_state of

low:
if ( t_e_counter >= service_limit ) then (* send service alarm *)
begin
send_line_state( service_alarm, call );
line_state:= serv_lim_excess
end;

serv_lim_excess:
if ( t_e_counter < service_limit ) then   (* recall service alarm *)
begin
send_line_state( service_alarm, recall );
line_state:= low
end
else
if ( t_e_counter >= s_a_limit ) then    (* send stop activity alarm *)
begin
send_line_state( s_a_alarm, call );
line_state:= s_a_lim_excess
end;

s_a_lim_excess:
if ( t_e_counter < s_a_limit ) then     (* recall stop activity alarm *)
begin
send_line_state( s_a_alarm, recall );
line_state:= serv_lim_excess
end

otherwise

end (* case line_state *)

end;

(*t3 runtimeset:= runtimeset + t3*)
 (**) (*t3       (.ord( t_e_kind ) + tek_offs, ord( line_state ) + tec_offs.) t3*)

end; (* procedure transm_cntrl *)
\f


procedure initiate_conversation( var request_msg: reference );

(*********************************************************************************
* description      : Initiates a conversation witg AT in accordance with
*                    operation code in then message from ATH
* call value       : request_msg    = references message from ATH
* return value     : request_msg    = nil if the message is rejected,
*                                     otherwise unchanged
* globals          : conversation   = updated according to operation code
*                    current        = initiated
*                    block_size     = number of bytes to send to AT
*                    t_e_kind       = unchanged
*                    vc_addr_table  = unchanged
*********************************************************************************)

var
result_code          : result_range := accepted;
steering_vc_index    : vc_spann;

begin

lock request_msg as locvar: byte_msg_format do
with locvar, locvar.alarmnetlabel do
begin
block_size:= no_of_by - label_size;
\f


case request_msg^.u4 of (* operation code *)

ts_cntrl:
if search_vc_index( ts_add( 0 ), steering_vc_index ) then
begin
if vc_addr_table( steering_vc_index ).steering then
begin (* legal sender *)
conversation:= control;
send_telegram( atc_cntrl, datapart( current ),
(**)         ( t_e_kind = ill_opc ), override (* ! *) )
(* ! override transmission error *)
end
else
result_code:= not_steering
end
else
result_code:= unknown_sender;

ts_testi1, ts_testi2:
if ( send.macro <> dc_macro ) then
result_code:= forbidden
else
begin

conversation:= testi;
block_size:= block_size + 1;

if ( request_msg^.u4 = ts_testi1 ) then
send_telegram( atc_testi, testi1_byte,
(**)         ( t_e_kind = ill_opc ), override (* ! *) )
(* ! override transmission error *)
else
send_telegram( atc_testi, testi2_byte,
(**)         ( t_e_kind = ill_opc ), override (* ! *) )
(* ! override transmission error *)

end;

ts_teste:
begin
conversation:= teste;
send_telegram( atc_teste, datapart( current ),
(**)         ( t_e_kind = ill_opc ), override (* ! *) )
(* ! override transmission error *)
end;

otherwise

end; (* case request_msg^.u4 *)

end; (* lock request_msg *)

if ( result_code <> accepted ) then
finish_message( request_msg, dummy_macro, dummy, actual_vc_index, at_route,
(**)          ( request_msg^.u4 + receipt ), 0, result_code, override )

end; (* procedure initiate_conversation *)
\f


procedure exec_conn_operation( var msg: reference );

(********************************************************************************
* description      : Executes on request from ATH, those operation types,    
*                    that doesn't involve DRIVER and sends a receipt to ATH                  
* call value       : msg    = reference to message from ATH               
* return value     : msg    = nil                                             
* globals          : runtimeset
*                    according to operation code:
*                      actual_vc_index, top_vc_index, vc_addr_table
********************************************************************************)

var
res                  : result_range := accepted;
block_size           : byte         := 0;
operation_code       : byte;
table_index          : vc_spann;

\f


procedure compute_delay( delay: integer );

(*********************************************************************************
* description      : Computes delay to enter the u3 and u4 fields of the delay
*                    message as (u3*2^u4) 
* call value       : delay          = integer value of delay
* return value     : delay          = unchanged
* globals          : delay3, delay4 = altered according to formula above
*********************************************************************************)

begin
delay:= ( delay mod 33 ) * time_out_unit;
delay4:= 0;
while delay > max_byte do
begin
delay:= delay div 2;
delay4:= delay4 + 1
end;
delay3:= delay;

end; (* procedure compute_delay *)
\f


procedure rw_param( var parameter: integer );

(*********************************************************************************
* description      : Reads or updates a parameter according to operation code
*                    and update field and sends a receipt to ATH
* call value       : parameter      = parameter en question
* return value     : parameter      = updated if update is insert_code
* globals          : none
*********************************************************************************)

begin

lock msg as locvar: word_msg_format do
with locvar, locvar.alarmnetlabel do
if ( send.macro <> dc_macro ) then
res:= forbidden
else

case update of

read_code:
begin
param( 0 ):= parameter;
block_size:= 2
end;

modify_code:
if ( msg^.u4 <> read_package_count ) then
parameter:= param( 0 )
else
res:= forbidden;

otherwise
res:= unknown_update

end (* case update *)

end; (* procedure rw_param *)

\f

 
begin (* procedure exec_conn_operation *)

(*t3 testout( z, "exec_conn_op", msg^.u4 ); t3*)
if ( msg^.u4 <> max_byte ) then
operation_code:= msg^.u4 + receipt;

case msg^.u4 of (* operation code *)

reject_opc:
return( msg );

ts_newactivity:
lock msg as locvar: word_msg_format do
with locvar, alarmnetlabel do
if ( send.macro <> dc_macro ) and ( send.micro <> ath_mic_addr ) then
res:= forbidden
else
begin
(*t3 testout( z, "new activity", update ); t3*)

case update of

stop_code:
begin
(*t3 runtimeset:= runtimeset - (.( tek_offs + ord( t_e_kind ) ),
( tec_offs + ord( line_state ) ), ( cnv_offs + ord( conversation ) ).); t3*)

if not nil( alarm_msg ) then
with vc_addr_table( pvc_index ) do
begin
finish_message( alarm_msg, dummy_macro, dummy, actual_vc_index, at_route, au_alarm_opc,
(**)          ( current - 1 ), data_incomplete,
(**)          ( vc_addr_table( actual_vc_index ).vc_index <> vc_index ) );
current:= 1;
conversation:= busy
end;

runtimeset:= runtimeset - (.ts_cntrl, group_cntrl, ts_testi1, ts_testi2, ts_teste,
ts_newactivity, service_poll.)

end;
\f


start_code:
if not ( upd_vc_table in runtimeset ) then
res:= not_ready
else
begin
(*t3 runtimeset:= runtimeset + (.tek_offs, tec_offs, cnv_offs.); t3*)
t_e_counter:= param( 0 );

compute_delay( param( 1 ) );

valid_response( busy ):= (.p_ack, au_alarm, addr, state, n_ack.);
valid_response( control ):= (.state, d_ack, n_ack.);
valid_response( testi ):= (.state, t_ack, n_ack.);
valid_response( teste ):= (.state, e_ack, n_ack.);
valid_response( coll_alarm1 ):= (.au_alarm, addr, state, n_ack.);
valid_response( coll_alarm2 ):= (.p_ack, au_alarm, addr, state, n_ack.);

line_state:= low;
no_succ_t_e:= 0;

runtimeset:= runtimeset + (.ts_cntrl, group_cntrl, ts_testi1, ts_testi2, ts_teste,
ts_newactivity.) - (.at_time_out..batt_supply, service_poll.)

end;
\f


service_code:
begin
(*t3 runtimeset:= runtimeset + (.tek_offs, tec_offs, cnv_offs.); t3*)
runtimeset:= runtimeset + (.ts_testi1, ts_testi2, ts_newactivity, service_poll.) -
(.ts_cntrl, group_cntrl, ts_teste.) - (.at_time_out..batt_supply.);

if not nil( alarm_msg ) then
with vc_addr_table( pvc_index ) do
begin
finish_message( alarm_msg, dummy_macro, dummy, actual_vc_index, at_route, au_alarm_opc,
(**)          ( current - 1 ), data_incomplete,
(**)          ( vc_addr_table( actual_vc_index ).vc_index <> vc_index ) );
current:= 1;
conversation:= busy
end;

compute_delay( param( 1 ) );

valid_response( busy ):= (.p_ack, n_ack.);
valid_response( testi ):= (.t_ack, n_ack.)


end;

otherwise
res:= unknown_update

end (* case update *)

end; (* lock msg *)
\f


connect_test:
begin
lock msg as locvar: connect_msg_format do
with locvar, alarmnetlabel do
begin

rec:= vc_address;
vc_address:= send;
send:= rec

end;

operation_code:= dummy_alarm
end;

dummy_alarm:
;

( dummy_alarm + receipt ):
lock msg as locvar: connect_msg_format do
with locvar, alarmnetlabel do
begin

rec:= vc_address;
vc_address:= send;
send:= rec;

operation_code:= connect_test + receipt

end
;
\f


upd_vc_table:
lock msg as locvar: vc_update_format do
with locvar, new_vc, alarmnetlabel do
if ( send.macro <> dc_macro ) then
res:= forbidden
else
begin
(*t3 testout( z, "update kind ", update );
testout( z, "address code", addr_code );
testout( z, "vc index    ", vc_index );
testout( z, "blocksize   ", block );
testout( z, "steering    ", ord( steering ) ); t3*)

case update of (* change of vc address table *)

read_code:
if search_addr_code( addr_code, table_index ) then
begin

new_vc:= vc_addr_table( table_index );
res:= accepted

end
else
res:= not_found
;

insert_code: (* insert new vc *)
begin
if ( upd_vc_table in runtimeset ) then
begin

if ( top_avc_index < vc_addr_l ) then
begin
(*t3 runtimeset:= runtimeset + (.upd_vc_table + top_avc_index.); t3*)
if search_addr_code( addr_code, table_index ) then (* .. modify!!!!!! *)
vc_addr_table( table_index ):= new_vc
else
begin
top_avc_index:= top_avc_index + 1;
vc_addr_table( top_avc_index ):= new_vc
end
end 
else
res:= no_room (* no room in vc address table *)

end
else
begin
runtimeset:= runtimeset + (.upd_vc_table.);
vc_addr_table( pvc_index ):= new_vc
end
end;
\f


remove_code: (* delete avc *)
begin
if search_addr_code( addr_code, table_index ) then
begin
if ( table_index = pvc_index ) then
res:= forbidden
else
begin
top_avc_index:= top_avc_index - 1;
runtimeset:= runtimeset - (.upd_vc_table + top_avc_index.);

if ( actual_vc_index > table_index ) then 
actual_vc_index:= actual_vc_index - 1
else
if ( actual_vc_index = table_index ) then 
actual_vc_index:= pvc_index;

(* compress *)
for table_index:= table_index to top_avc_index do 
vc_addr_table( table_index ):= vc_addr_table( table_index + 1 )

end
end
else
res:= not_found (* vc index not found *)
end;

otherwise
res:= unknown_update

end (* case update *)
end; (* lock *)
\f


r_w_tec:
rw_param( t_e_counter );

read_package_count:
rw_param( package_count );

r_w_service_limit:
rw_param( service_limit );

r_w_s_a_limit:
rw_param( s_a_limit );

r_w_max_succ_t_e:
rw_param( max_succ_t_e );

(*t3 dump_st_off, dump_st_on:
begin
dump_state:= ( msg^.u4 <> dump_st_off );

if dump_state then
dump_state_block( " state block", ord( conversation ) );

return( msg )
end; t3*)

otherwise
garbage_message( msg,(*t3 "exec conn op", t3*) unknown_opcode );

end; (* case operation code *)

finish_message( msg, dummy_macro, dummy, actual_vc_index, at_route,
(**)          operation_code, 0 + block_size, res, override )

end; (* procedure exec_conn_operation *)
\f


procedure finish_conversation;

(*********************************************************************************
* description      : Takes the approbiate action in relation to a received
*                    response from DRIVER (AT)
* globals          : alarm_msg          = nil or holding a message
*                    driver_mes         = nil or holding driver message
*                    runtimeset         = updated
*                    current            = updated
*                    block_size         = updated
*                    conversation       = updated
*                    vc_addr_table      = unchanged
*                    actual_vc_index    = updated
*                    state_bit          = updated
*********************************************************************************)

begin

(*t3 runtimeset:= runtimeset - (.ord( conversation ) + cnv_offs.); t3*)

if ( t_e_kind <> no_error ) then
begin

case conversation of 

busy:
conversation:= idle;

testi, teste, control, coll_alarm1, coll_alarm2:
if ( no_succ_t_e < max_succ_t_e ) then
(* try to get through with the last telegram *)
send_telegram( dummy, dummy, ( ( no_succ_t_e > 1 ) and ( t_e_kind = ill_opc ) ),
(**)         ( t_e_kind <> no_error ) )
else
begin

conversation:= idle;

with vc_addr_table( actual_vc_index ) do
finish_message( alarm_msg, dummy_macro, dummy, actual_vc_index,
(**)          at_route1, au_alarm_opc, ( current - 1 ), data_incomplete,
(**)          ( vc_addr_table( pvc_index ).vc_index <> vc_index ) );
current:= 1

end;

otherwise

end (* case conversation *)
end
else
\f



begin
(* not transmission error *)

case at_op_code of

p_ack:
conversation:= idle;

au_alarm:
with vc_addr_table( actual_vc_index ) do
begin

if ready_byte_msg( alarm_msg, at_data, current , block ) then
begin
(* au alarm is collected *)

with vc_addr_table( actual_vc_index ) do
finish_message( alarm_msg, dummy_macro, dummy, actual_vc_index,
(**)          at_route1, au_alarm_opc, block, accepted,
(**)          ( vc_addr_table( pvc_index ).vc_index <> vc_index ) );

if ( conversation = coll_alarm2 ) then
conversation:= idle
else
begin
(* poll immediately *)
conversation:= coll_alarm2;
send_telegram( poll_opc, poll_byte,
(**)         ( t_e_kind = ill_opc ), ( t_e_kind <> no_error ) )
end

end
else
begin
(* collect multi byte alarm *)
if ( conversation <> coll_alarm2 ) then
conversation:= coll_alarm1;
send_telegram( poll_opc, poll_byte,
(**)         ( t_e_kind = ill_opc ), ( t_e_kind <> no_error ) )
end

end;
\f


addr:
begin

if not nil( alarm_msg ) then
(* finish not completed alarm *)
begin
with vc_addr_table( actual_vc_index ) do
finish_message( alarm_msg, dummy_macro, dummy, actual_vc_index, at_route1, au_alarm_opc,
(**)         ( current - 1 ), data_incomplete,
(**)          ( vc_addr_table( pvc_index ).vc_index <> vc_index ) );
current:= 1
end;

if not search_addr_code( at_data, actual_vc_index ) then
actual_vc_index:= pvc_index;

(* send a poll immediately *)
begin
conversation:= busy;
send_telegram( poll_opc, poll_byte,
(**)         ( t_e_kind = ill_opc ), ( t_e_kind <> no_error ) )
end

end;
\f


state:
begin

if not nil( alarm_msg ) then (* finish not completed alarm *)
begin
with vc_addr_table( actual_vc_index ) do
finish_message( alarm_msg, dummy_macro, dummy, actual_vc_index, at_route1, au_alarm_opc,
(**)          ( current - 1 ), data_incomplete, 
(**)          ( vc_addr_table( pvc_index ).vc_index <> vc_index ) );
current:= 1
end;

lock driver_msg as locvar: state_byte do
begin

runtimeset:= runtimeset + (.ts_cntrl, group_cntrl, ts_testi1, ts_testi2, ts_teste.)
- (.unused..batt_supply.) + locvar;

if ready_byte_msg( alarm_msg, at_data, current, 1 ) then
finish_message( alarm_msg, dummy_macro, dummy, pvc_index, at_route1, state_alarm, 1,
(**)          accepted, override );

if ( runtimeset >= (.batt_limit, batt_supply.) ) then
runtimeset:= runtimeset -
(.ts_cntrl, group_cntrl, ts_testi1, ts_testi2, ts_teste.)
else
if ( (.serif_error, au_error.) * runtimeset ) <> (..) then
runtimeset:= runtimeset - (.ts_cntrl, group_cntrl, ts_teste.)
else
if ( hs_error in runtimeset ) then
runtimeset:= runtimeset - (.ts_teste.);


end; (* lock driver_msg *)

conversation:= idle
end;
\f


d_ack,
t_ack,
e_ack:
 if ready_byte_msg( ath_msg, at_data, current, block_size ) then
(* send result of control, testi1, testi2, teste to ATH *)
begin
finish_message( ath_msg, dummy_macro, dummy, actual_vc_index, at_route,
(**)          ( ath_msg^.u4 + receipt ), block_size, accepted, override );
conversation:= idle
end 
else
(* multi byte control: send the next data_byte *)
lock ath_msg as locvar: byte_msg_format do
with locvar do
send_telegram( atc_cntrl, datapart( current ),
(**)         ( t_e_kind = ill_opc ), ( t_e_kind <> no_error ) ); (* end lock ath_msg *)

otherwise

end (* case at_op_code *)
end;

(*t3 runtimeset:= runtimeset + (.ord( conversation ) + cnv_offs.) t3*)

end; (* procedure finish_conversation *)
\f


procedure restrict_protocol;

(*********************************************************************************
* description      : Handles the situation, where ATC isn't allowed to run the
*                    full protocol against AT. The reason being either:
*                    initiating, stop activity or service_poll ordered from DC or
*                    the following state errors in AT: serif, au, hs or
*                    battery supply + limit
* globals          : all globals may be used
*********************************************************************************)

var
temp_msg           : reference;
res                : result_range := accepted;

begin

repeat (* until 'full' runtimeset *)

if ( conversation = idle ) then
begin

while ( conversation = idle ) and ( open( queue_sem.w^ ) or not nil( ath_msg ) ) do
begin

if nil( ath_msg ) then
repeat
wait( ath_msg, queue_sem.w^ );
if ( ath_msg^.u3 = dummy_route ) then
return( ath_msg )
until passive( queue_sem.w^ ) or  not nil( ath_msg );

if not nil( ath_msg ) then
begin
if ( ath_msg^.u4 in runtimeset ) then
initiate_conversation( ath_msg )
else
begin

if ( ts_newactivity in runtimeset ) then
begin

if ( service_poll in runtimeset ) then
res:= forbidden
else
begin

if ( no_succ_t_e >= max_succ_t_e ) then
res:= transmit_error
else
res:= state_error

end

end
else
res:= passivated;

finish_message( ath_msg, dummy_macro, dummy, actual_vc_index, at_route,
(**)          ( ath_msg^.u4 + receipt ), 0, res, override )

end

end

end;

if ( conversation = idle ) then
if ( ts_newactivity in runtimeset ) and not nil( delay_msg ) then
begin

conversation:= busy;
send_telegram( poll_opc, poll_byte, 
(**)         ( t_e_kind = ill_opc ), ( t_e_kind <> no_error ) )

end

end;
\f


wait( atc_msg, main_sem.w^ );

(*t3 testout( z, "PROTL. route", atc_msg^.u3 ); t3*)
(*t3 if dump_state then dump_state_block( "PROTL.RESTR.", atc_msg^.u4 ); t3*)

if ownertest( delay_pool, atc_msg ) then
delay_msg :=: atc_msg (* hold the message *)
else
case atc_msg^.u3 of 
(* message origin *)

dummy_route:
return( atc_msg );

netc_route: (* message from ATH *)
if atc_msg^.u4 in (.ts_cntrl, group_cntrl, ts_testi1, ts_testi2, ts_teste.) then 
signal( atc_msg, queue_sem.s^ )
else (* execute the operations that doesn't involve DRIVER *)
exec_conn_operation( atc_msg );
\f


at_route: (* message from DRIVER *)
begin
(*t3 runtimeset:= runtimeset - (.ord( conversation ) + cnv_offs.); t3*)

driver_msg :=: atc_msg; (* hold message *)

if ( driver_ready in runtimeset ) then
begin

if ( ts_newactivity in runtimeset ) then
begin

transm_cntrl( at_op_code, at_data, valid_response( conversation ) );

if ( runtimeset >= (.batt_limit, batt_supply.) ) then
begin
if ( t_e_kind = no_error ) and ( at_op_code = state ) then
finish_conversation
else
conversation:= idle
end
else
begin
finish_conversation;

end

end
else
conversation:= idle

end
else
begin
runtimeset:= runtimeset + (.driver_ready.);
conversation:= idle;

(********************************************************************
* Set up the user field, that DRIVER doesn't update
********************************************************************)

with driver_msg^ do
u1:= write_read_at;

end;

(*t3 runtimeset:= runtimeset + (.ord( conversation ) + cnv_offs.) t3*)

end;

otherwise (* unknown route *)
garbage_message( atc_msg, (*t3 "PROTL. error", t3*) unknown_route );

end (* case message origin *)

until ( runtimeset >= (.ts_cntrl, group_cntrl, ts_testi1, ts_testi2, ts_teste,
ts_newactivity, upd_vc_table, driver_ready.) );

end; (* procedure restrict_protocol *)
\f

 
(*********************************************************************************
*
*                             AT CONNECTOR : MAIN
*
*********************************************************************************)

begin

(*t1 testopen( z, own.incname, op_sem ); t1*)

(*t1 testout( z, version , al_env_version );
testout( z, "chann/addr  ", ( ( channel_no * 1000 ) + own_addr ) ); t1*)

runtimeset:= (..);

(*********************************************************************************
* Set up and send a buffer create channel to DRIVER
*********************************************************************************)

alloc( driver_msg, driver_pool, main_sem.s^ );

with driver_msg^ do
begin
u1:= create_at_ch;
u2:= channel_no;
u3:= at_route
end;

lock driver_msg as locvar: create_ch_format do
begin
locvar( 0 ):= at_control;
locvar( 1 ):= con_lam_time
end; (* lock driver_msg *)

conversation:= busy;
signal( driver_msg, driver_sem^ );

\f


(********************************************************************************
* Allocate TIMER message with main_sem as answer- and delay_pool semaphore
* as owner-semaphore
********************************************************************************)

alloc( delay_msg, delay_pool, main_sem.s^ );

(********************************************************************************
* Start initialisation sequence
********************************************************************************)

restrict_protocol;

(********************************************************************************
* End of initialization sequence
********************************************************************************)

(*t3 testout( z, "end init    ", ord( conversation ) ); t3*)
\f


repeat
(* forever........................................................................ *)

if ( conversation = idle ) then 
begin
(*t3 runtimeset:= runtimeset - (.ord( conversation ) + cnv_offs.); t3*)

if not nil( ath_msg ) or open( queue_sem.w^ ) then 
(* ignore delay and resume the interrupted conversation or start a queued one *)
begin

if nil( ath_msg ) then (* message(s) in queue *)
repeat
wait( ath_msg, queue_sem.w^ ); 
if ( ath_msg^.u3 = dummy_route ) then
return( ath_msg )
until passive( queue_sem.w^ ) or not nil( ath_msg );

initiate_conversation( ath_msg )
end
else
if not nil( delay_msg ) then
begin
conversation:= busy;
send_telegram( poll_opc, poll_byte,
(**)         ( t_e_kind = ill_opc ), ( t_e_kind <> no_error ) )
end;

(*t3 runtimeset:= runtimeset + (.ord( conversation ) + cnv_offs.) t3*)
end;

wait( atc_msg, main_sem.w^ );

(*t3 if dump_state then dump_state_block( "RUNN.  route", atc_msg^.u3 ); t3*)
\f


if ownertest( delay_pool, atc_msg ) then
delay_msg :=: atc_msg (* hold the message *)
else
case atc_msg^.u3 of (* message origin *)

dummy_route:
return( atc_msg );

netc_route: (* message from ATH *)
begin

if atc_msg^.u4 in (.ts_cntrl, group_cntrl, ts_testi1, ts_testi2, ts_teste.) then
signal( atc_msg, queue_sem.s^ )
else
(* always execute the operations that does not involve DRIVER *)
begin
exec_conn_operation( atc_msg );

if not ( ts_newactivity in runtimeset ) or ( service_poll in runtimeset ) then
restrict_protocol

end

end;

at_route: (* response message from DRIVER *)
begin

driver_msg :=: atc_msg; (* hold message *)
transm_cntrl( at_op_code, at_data, valid_response( conversation ) );
finish_conversation;

if not ( runtimeset >= (.ts_cntrl, group_cntrl, ts_testi1, ts_testi2, ts_teste.) ) then
restrict_protocol

end;

otherwise (* unknown route *)
garbage_message( atc_msg, (*t3 "run error   ", t3*) unknown_route )

end (* case message origin *)

until forever;

end. (* process atconnector*)
«eof»