⟦0949a8e7a⟧

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 codesize.12000 alarmenv tsenvir atcsource
o c
lookup pass6code
if ok.yes
( tsatcbin = set 1 disc1
tsatcbin = move pass6code
scope user tsatcbin )
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 *)
com_pool             : !sempointer; (* Pointer to the semaphore that holds
-                                   the vacant message resources of the TS *)
var
activity             : poll_activity;
var
delay                : integer;
var
node_test_frequency  : !integer;
var
traffic_counter      : integer;
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.09 /";
\f


(*********************************************************************************
* 
* description      : The purpose and function of the AT_CONNECTOR is mainly to
*                    run the protocol 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 PAC or DC.
*                    Furthermore commands originating from DC and AC are executed
*                    and alarms from AT are signalled to an AC.
*                    AT_CONNECTOR participates in the module supervision in
*                    the TS.
*
* externals        : check5
*                    testopen
*                    testout
*                    receipt_message
*                    reject_message
*
* 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_protocol;
*     <* 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_lth 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, PAC )
*                end;
*  
*              d_ack:
*               if no_of_bytes = block_lth then
*                signal( control_receipt, sender )
*               else
*                send_telegram( cntrl, next_cntrl_byte );
*  
*              t_ack,
*              e_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
*
* aac          alternative alarm centre
* ac, AC       alarm centre
* at, AT       alarm terminal
* atc, ATC     alarm terminal connector
* ath, ATH     alarm terminal (connector) handler
* au           alarm unit
* dc, DC       district centre
* driver       lam driver
* msg          reference to a message
* pac, PAC     primary alarm centre
* 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
*
*
*
*
*
*
*
*
*
*
*
*
*********************************************************************************)

\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 classified *)
\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;

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
*
*********************************************************************************)

const
(* pac log operation code *)
pac_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;

connect_test         = #h92;

(* updating of alarm centre table *)
upd_ac_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;
\f


node_test            = #hc0;

dummy_alarm          = #hc8;

break_proc_end       = #hce;
\f


(*********************************************************************************
* declaration part 6: alarm centre table and the management of it
*
*********************************************************************************)

var
ac_tbl               : ac_address_table;

actual_ac_index      : ac_table_range       := pac_index;
top_aac_index        : upper_ac_tbl_index   := 0;
\f


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

type
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
reject_code          : result_range         := not_ready;

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
*
*********************************************************************************)

type
receipt_route        = array( netc_route..netc_route1 ) of byte;

const
route_vect           = receipt_route( at_route, at_route1 );
override             = false;
dummy                = 0;

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 *)

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

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


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

procedure restrict_protocol;
forward;


procedure exception( excode: integer );
forward;
\f


<*t 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   := alfa( "            " );

begin

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 (* lock msg *)
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; (* lock msg *)

testout( z, string, param )

end;(* procedure print_telegram *) t*>
\f


procedure create_channel;

(*********************************************************************************
* description      : Updates and sends a create channel message to DRIVER
*
* globals          : driver_msg
*                    conversation
*********************************************************************************)

begin

lock driver_msg as locvar: create_ch_format do
with driver_msg^ do
begin

u1:= create_at_ch;
u2:= channel_no;
u3:= at_route;

locvar( 0 ):= at_control;
locvar( 1 ):= con_lam_time

end; (* lock *)

conversation:= busy;

signal( driver_msg, driver_sem^ )

end; (* procedure create_channel *)
\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 a transmission error is detected.
*                    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;

<*t print_telegram( driver_msg, true, ord( conversation ) ); t*>

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


procedure handle_queue(
var
msg                  : reference;
reject_cause         : result_range
);

(*********************************************************************************
* description    : Selects a message from the queue with a legal operation
*                  code. Messages illegal for the moment are receipted
*                  with result = reject_cause.
* call value     : msg          = nil or reference to a uncompleted message
* return value   : reject_cause = cause of rejection
*                  msg          = nil or a reference to a legal message
* globals        : ath_msg, queue_sem
*********************************************************************************)

begin

if not nil( msg ) or open( queue_sem.w^ ) then
repeat

if nil( msg ) then
wait( msg, queue_sem.w^ );

with msg^ do
if ( u3 = dummy_route ) then
return( msg )
else
begin

if ( u4 in (.ts_cntrl, group_cntrl, ts_teste.) ) then
package_count:= ( package_count + 1 ) mod max_int;

case reject_cause of

accepted          :
;

state_hs_error    :
if ( u4 = ts_teste ) then
receipt_message( msg, ath_sem, route_vect( u3 ), 0, reject_cause )
;

state_power_error ,
transmit_error    ,
no_resources      ,
no_connection     ,
breaked           ,
not_ready         ,
passivated        :
receipt_message( msg, ath_sem, route_vect( u3 ), 0, reject_cause )
;

illegal_operation ,
state_au_error    ,
state_serif_error :
if ( u4 in (.ts_cntrl, group_cntrl, ts_teste.) ) then
receipt_message( msg, ath_sem, route_vect( u3 ), 0, reject_cause )
;

otherwise
testout( z, "reject code: ", reject_cause )

end

end

until not nil( msg ) or passive( queue_sem.w^ )

end; (* procedure handle_queue *)
\f


function get_message(
var
msg            : reference;
operation_code ,
block_lth      : byte;
rec_macro      : macroaddr;
rec_micro      ,
ac_index       : integer
): boolean;

(*********************************************************************************
* description      : Waits max delay seconds for a message from com_pool.
*                    If ATC is timed out and ath_msg or queue_sem holds
*                    resources, these are receipted and another effort is
*                    made.
*                    a alarm net label is entered in the message.
* call value       : msg          = nil
* return value     : get_message  = true if a message is received, otherwise false.
*                    msg          = nil or reference to the message.
*                    msg^.u1      = number of bytes to enter in data part
*                    msg^.u2      = 0 ( will be used for counting )
* globals            ath_msg
*                    queue_sem
*********************************************************************************)

begin

definetimer( true );

repeat

case waitsd( msg, com_pool^, delay ) of

a_semaphore:
lock msg as locvar: alarmlabel do
with msg^, locvar do
begin

u1:= block_lth;
u2:= 0;
u3:= at_route;
u4:= operation_code;

rec.macro:= rec_macro;
rec.micro:= rec_micro;
send.macro:= ts_macro;
send.micro:= own_addr;

ts_add( 0 ):= ac_index

end (* lock *)
;

otherwise
begin

trace( 0 );
handle_queue( ath_msg, no_resources );

(* obs!!! clean up main if ATC must keep trying *)

end

end

until passive( queue_sem.w^ ) or not nil( msg );

definetimer( false );

get_message:= not nil( msg )

end; (* function get_message *)
\f


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

(*********************************************************************************
* description      : Enters one data byte in the message data part. 
* call value       : msg            = references message to fill 
*                    msg^.u1        = number of bytes to enter
*                    msg^.u2        = last byte entered
*                    data_byte      = byte in question
* return value     : ready_byte_msg = true if filling is completed
*                    msg^.u2        = last byte entered.
*                    data_byte      = unchanged
* globals          : none
*********************************************************************************)

begin

lock msg as locvar: al_form_byte do
with msg^, locvar, al_label do
begin

if ( u1 > u2 ) then
begin

u2:= u2 + 1;
data( u2 ):= data_byte

end;

ready_byte_msg:= ( u2 = u1 )

end

end; (* function ready_byte_msg *)
\f


procedure finish_message(
var
msg            : reference;
res            : result_range;
log_to_pac     : boolean
);

(***********************************************************************************
* description      : Updates the user fields and message label part and sends  
*                    the message to ATH.
*                    A log of an alarm may be send to PAC through ATH.
* call value       : msg           = references message to be send
*                    msg^.u2       = number of bytes except for alarmlabel.
*                    res           = message label information
*                    log_to_pac    = true if the alarm is to be logged at PAC
* return value     : msg           = nil
* globals          : none
************************************************************************************)


var
alarm_bytes        : data_bytes;
block_lth          : data_range;

begin

lock msg as locvar: al_form_byte do
with msg^, locvar, locvar.al_label do
begin

no_of_by:= label_size + u2;
result:= res;

if log_to_pac then
begin

block_lth:= u2;

for u2:= 1 to block_lth do
alarm_bytes( u2 ):= data( u2 )

end;

if u4 in (.pac_alarm_log, au_alarm_opc, line_alarm, state_alarm.) then
package_count:= ( package_count + 1 ) mod max_int

end; (* lock msg *)

signal( msg, ath_sem^ );
\f


if log_to_pac then
with ac_tbl( pac_index ) do
if get_message( msg, pac_alarm_log, block_lth, dummy_macro, dummy, sac_rac_ix ) then
begin

lock msg as locvar: al_form_0001 do
with msg^, locvar, al_label, aac_address do
begin

micro:= ac_tbl( actual_ac_index ).sac_rac_ix;

for u2:= 1 to block_lth do
data( u2 ):= alarm_bytes( u2 );

end;

finish_message( msg, res, not log_to_pac )

end

end; (* procedure finish_message *)
\f

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

(**********************************************************************************
* description      : Searches ac address table for the address code of a
*                    alarm centre.
* 
* 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          : ac_tbl           = unchanged
*********************************************************************************)

begin

table_index:= pac_index;

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

search_addr_code:= ( top_aac_index > 0 ) and ( table_entry = ac_tbl( table_index ).addr_code )

end; (* function search_addr_code *)
 
 
\f


function search_ac_index( table_entry: integer; var table_index: ac_table_range ): boolean;

(*********************************************************************************
* description      : Searches ac address table for the index of a alarm centre.
*
* call value       : table_entry     = entry to search
*                    table_index     = undefined
* return value     : search_ac_index = true if the entry is found, otherwise false
*                    table_entry     = unchanged
*                    table_index     = indices entry if it exists
* globals          : ac_tbl          = unchanged
*********************************************************************************)

begin

table_index:= pac_index;

while ( table_index < top_aac_index ) and
( table_entry <> ac_tbl( table_index ).sac_rac_ix ) do
table_index:= table_index + 1;

search_ac_index:= ( top_aac_index > 0 ) and ( table_entry = ac_tbl( table_index ).sac_rac_ix )

end; (* function search_ac_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          : reject_code       = 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 PAC 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          : none
*********************************************************************************)

var
msg                  : reference;

begin

if ( activity = start_code ) then
with ac_tbl( pac_index ) do
if get_message( msg, op_code, 1, dc_macro, dc_erh_mic_addr, sac_rac_ix ) then
if ready_byte_msg( msg, data ) then
finish_message( msg, accepted, override )

end; (* procedure send_line_state *)
\f


begin (* procedure transm_cntrl *)

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;

<*t print_telegram( driver_msg, false, ord( t_e_kind ) ); t*>
\f


if ( reject_code <> state_power_error ) 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 ( activity = start_code ) then
reject_code:= transmit_error

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 ( activity = start_code ) then
if reject_code = transmit_error then
reject_code:= accepted;

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

end; (* procedure transm_cntrl *)
\f


procedure initiate_conversation( var request_msg: reference );

(*********************************************************************************
* description      : Initiates a conversation with the AT in accordance with
*                    the operation code in the message from ATH
* call value       : request_msg    = references message from ATH
* return value     : request_msg    = nil if the message is rejected,
*                                     otherwise u1 = number of bytes to AT.
*                                               u2 = 0 ( will be used for counting )
* globals          : conversation   = updated according to operation code
*                    t_e_kind       = unchanged
*                    ac_tbl         = unchanged
*********************************************************************************)

var
result_code          : result_range := accepted;
steering_ac_index    : ac_table_range;

begin

lock request_msg as locvar: al_form_byte do
with request_msg^, locvar, al_label do

case u4 of (* operation code *)

ts_cntrl,
group_cntrl:
if search_ac_index( ts_add( 0 ), steering_ac_index ) then
begin

if ac_tbl( steering_ac_index ).steering then
begin (* legal sender *)

u1:= no_of_by - label_size;

conversation:= control;
send_telegram( atc_cntrl, data( 1 ),
(**)         ( 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

u1:= 1;
no_of_by:= no_of_by + 1;

conversation:= testi;

if ( 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

u1:= no_of_by - label_size;

conversation:= teste;
send_telegram( atc_teste, data( 1 ),
(**)         ( t_e_kind = ill_opc ), override (* ! *) )
(* ! override transmission error *)

end;

otherwise

end; (* lock, case request_msg^.u4 *)

if ( result_code <> accepted ) then
receipt_message( request_msg, ath_sem, route_vect( request_msg^.u3 ), 0, result_code )
else
request_msg^.u2:= 0

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          : reject_code
*                    according to operation code:
*                      actual_ac_index, top_ac_index, ac_tbl
********************************************************************************)

var
res                  : result_range := accepted;
table_index          : ac_table_range;
\f


procedure connect_message( var msg: reference; user4: byte );

var
work_addr     : alarmnetaddr;

begin

lock msg as locvar: al_form_0902 do
with msg^, locvar, al_label do
begin

u4:= user4;

work_addr:= send;
send:= al_net_addr;
al_net_addr:= work_addr

end

end; (* procedure connect_message *)
\f


procedure compute_delay( param: integer );

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

begin

delay:= param;

delay4:= 0;

while ( param > ( max_int div time_out_unit ) ) do
begin

param:= param div 2;
delay4:= delay4 + 1

end;

param:= param * time_out_unit;

while ( param > max_byte ) do
begin

param:= param div 2;
delay4:= delay4 + 1

end;

delay3:= param

end; (* procedure compute_delay *)
\f


procedure rw_param( var parameter: integer );

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

begin

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

case update of

read_code:
begin

params( 1 ):= parameter;
no_of_by:= no_of_by + 2;

end;

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

otherwise
res:= unknown_update

end (* case update *)

end; (* procedure rw_param *)
\f

 
begin (* procedure exec_conn_operation *)

<*t testout( z, "exec_conn_op", msg^.u4 ); t*>

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

reject_opc:
begin

return( msg );
testout( z, "garb. return", msg^.u3 )

end;

ts_newactivity:
lock msg as locvar: al_form_0900 do
with locvar, al_label do
if ( send.macro <> dc_macro ) and ( send.micro <> ath_mic_addr ) then
res:= forbidden
else
begin

case update of

stop_code:
begin

if not nil( alarm_msg ) then
with ac_tbl( actual_ac_index ) do
finish_message( alarm_msg, data_incomplete,
(**)          ( ac_tbl( pac_index ).sac_rac_ix <> sac_rac_ix ) );

if nil( driver_msg ) then
conversation:= busy
else
conversation:= idle;

activity:= stop_code;
reject_code:= passivated

end;
\f


start_code:
if ( top_aac_index < pac_index ) then
res:= not_ready
else
begin

t_e_counter:= t_e_c_init;

compute_delay( frequence );

line_state:= low;
no_succ_t_e:= 0;

activity:= start_code;
reject_code:= accepted;

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.)

end;
\f


service_code:
begin

if not nil( alarm_msg ) then
with ac_tbl( actual_ac_index ) do
finish_message( alarm_msg, data_incomplete,
(**)          ( ac_tbl( pac_index ).sac_rac_ix <> sac_rac_ix ) );

compute_delay( frequence );

activity:= service_code;
reject_code:= illegal_operation;

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

if nil( driver_msg ) then
conversation:= busy
else
conversation:= idle

end;

otherwise
res:= unknown_update

end (* case update *)

end; (* lock msg *)
\f


connect_test:
connect_message( msg, dummy_alarm - receipt )
;

dummy_alarm:
;

( dummy_alarm + receipt ):
connect_message( msg, connect_test )
;

upd_ac_table:
lock msg as locvar: al_form_1000 do
with locvar, ac_addr_tbl_e, al_label do
if ( send.macro <> dc_macro ) then
res:= forbidden
else
begin

<*t testout( z, "update kind ", update );
testout( z, "address code", addr_code );
testout( z, "ac index    ", ac_index );
testout( z, "blocksize   ", block_lth );
testout( z, "steering    ", ord( steering ) ); t*>
\f


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

read_code:
if search_addr_code( addr_code, table_index ) then
ac_addr_tbl_e:= ac_tbl( table_index )
else
res:= not_found
;

insert_code: (* insert new ac or modify existing entry *)
if search_addr_code( addr_code, table_index ) then (* modify *)
ac_tbl( table_index ):= ac_addr_tbl_e
else
if ( top_aac_index < ac_table_lth ) then
begin

top_aac_index:= top_aac_index + 1;
ac_tbl( top_aac_index ):= ac_addr_tbl_e

end
else
res:= no_room (* no room in ac address table *)
;
\f


remove_code: (* delete aac *)
if search_addr_code( addr_code, table_index ) then
if ( table_index = pac_index ) then
res:= illegal_operation
else
begin

top_aac_index:= top_aac_index - 1;

if ( actual_ac_index > table_index ) then 
actual_ac_index:= actual_ac_index - 1
else
if ( actual_ac_index = table_index ) then 
actual_ac_index:= pac_index;

(* compress *)
for table_index:= table_index to top_aac_index do 
ac_tbl( table_index ):= ac_tbl( table_index + 1 )

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

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 )
;

node_test:
begin

return( msg );

if ( activity = stop_code ) then
if not nil( driver_msg ) then
create_channel
else <* ? *>
else <* ? *>

end
;

otherwise
reject_message( msg, ath_sem, route_vect( msg^.u3 ), ts_macro, own_addr, unknown_opcode )

end; (* case operation code *)

if not nil( msg ) then
receipt_message( msg, ath_sem, route_vect( msg^.u3 ), 0, res )

end; (* procedure exec_conn_operation *)
\f


procedure supervise;

begin

if ( traffic_counter > ( abs( node_test_frequency ) + delay ) ) then
begin (* ATH didn't clear traffic_counter in time *)

activity:= stop_code;

reject_code:= no_connection;

(* OBS!!!
. handle_queue will clean up ath_msg and queue_sem when called with
. no_connection. Modifying runtimeset in this way mskes it impossible
. to get back to the original situation.
. outstanding:
.... a feasible reaction in this situation:
...... stop poll ?
...... modify runtimeset ?
...... tell who ?
...... recovery when/if ATH comes up with traffic_counter = 0
...... does ATC find out ?
*)

end
else
traffic_counter:= traffic_counter + delay

end; (* procedure supervise *)
\f


procedure finish_conversation;

(*********************************************************************************
* description      : Takes the appropriate 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
*                    reject_code        = updated
*                    conversation       = updated
*                    ac_tbl             = unchanged
*                    actual_ac_index    = updated
*                    state_bit          = updated
*********************************************************************************)

begin

if ( t_e_kind <> no_error ) then

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

if not nil( alarm_msg ) then
with ac_tbl( actual_ac_index ) do
finish_message( alarm_msg, data_incomplete,
(**)          ( ac_tbl( pac_index ).sac_rac_ix <> sac_rac_ix ) );

if not nil( ath_msg ) then
with ath_msg^ do
receipt_message( ath_msg, ath_sem, route_vect( u3 ), u2 - u1, data_incomplete );

conversation:= idle

end;

otherwise

end (* case conversation *)
else
\f


(* not transmission error *)

case at_op_code of

p_ack:
conversation:= idle;

au_alarm:
with ac_tbl( actual_ac_index ) do
if nil( alarm_msg ) then
if get_message( alarm_msg, au_alarm_opc, block_lth, 
dummy_macro, dummy, sac_rac_ix ) then
begin

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

with ac_tbl( actual_ac_index ) do
finish_message( alarm_msg, accepted,
(**)          ( ac_tbl( pac_index ).sac_rac_ix <> sac_rac_ix ) );

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 *)
with ac_tbl( actual_ac_index ) do
finish_message( alarm_msg, data_incomplete,
(**)          ( ac_tbl( pac_index ).sac_rac_ix <> sac_rac_ix ) )
;

if not search_addr_code( at_data, actual_ac_index ) then (* troubles with block_lth !!! *)
actual_ac_index:= pac_index;

with ac_tbl( actual_ac_index ) do
if get_message( alarm_msg, au_alarm_opc, block_lth,
dummy_macro, dummy, sac_rac_ix ) then
(* send a poll immediately *)
begin

conversation:= coll_alarm1;
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 *)
with ac_tbl( actual_ac_index ) do
finish_message( alarm_msg, data_incomplete,
(**)          ( ac_tbl( pac_index ).sac_rac_ix <> sac_rac_ix ) )
;

with ac_tbl( pac_index ) do
if get_message( alarm_msg, state_alarm, 1, dummy_macro, dummy, sac_rac_ix ) then
if ready_byte_msg( alarm_msg, at_data ) then
finish_message( alarm_msg, accepted, override )
;

lock driver_msg as locvar: state_byte do
begin

if ( locvar >= (.batt_limit, batt_supply.) ) then
reject_code:= state_power_error
else
if ( serif_error in locvar ) then
reject_code:= state_serif_error
else
if ( au_error in locvar ) then
reject_code:= state_au_error
else
if ( hs_error in locvar ) then
reject_code:= state_hs_error
else
reject_code:= accepted

end; (* lock driver_msg *)

conversation:= idle

end;
\f


d_ack,
t_ack,
e_ack:
with ath_msg^ do
if ready_byte_msg( ath_msg, at_data ) then
(* send result of control, testi1, testi2, teste to ATH *)
begin

receipt_message( ath_msg, ath_sem, route_vect( u3 ), 0, accepted );

conversation:= idle

end 
else
(* multi byte control/test: send the next data_byte *)
lock ath_msg as locvar: al_form_byte do
with last_telegram, locvar, al_label do
send_telegram( atc_opc, data( u2 + 1 ),
(**)         ( t_e_kind = ill_opc ), ( t_e_kind <> no_error ) )
; (* end lock ath_msg *)

otherwise

end (* case at_op_code *)

end; (* procedure finish_conversation *)
\f


procedure restrict_protocol;

(*********************************************************************************
* description      : Handles the situation, where ATC isn't allowed to
*                    communicate with the AT.
*                    The reason being either:
*                    initiating or stop activity ordered from DC.
* globals          : all globals may be used
*********************************************************************************)

begin

repeat

handle_queue( ath_msg, reject_code );

wait( atc_msg, main_sem.w^ );

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,
netc_route1: (* message from ATH *)
if atc_msg^.u4 in (.ts_cntrl, group_cntrl, ts_testi1, ts_testi2, ts_teste.) then 
signal( atc_msg, queue_sem.w^ )
else (* execute the operations that doesn't involve DRIVER *)
exec_conn_operation( atc_msg );
\f


at_route: (* message from DRIVER *)
begin

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

conversation:= idle;

if ( driver_msg^.u1 <> write_read_at ) then
begin
(* check u2 to repeat create channel ??? *)

with driver_msg^ do
u1:= write_read_at (* function field isn't altered by DRIVER *)

end;

supervise

end;

otherwise (* unknown route *)
reject_message( atc_msg, ath_sem, at_route, ts_macro, own_addr, unknown_route )

end (* case message origin *)

until ( top_aac_index > 0 ) and ( activity <> stop_code )

end; (* procedure restrict_protocol *)
\f

 
procedure exception( excode: integer );

begin
trace( excode );

if not nil( alarm_msg ) then
with ac_tbl( actual_ac_index ) do
finish_message( alarm_msg, data_incomplete,
(**)          ( ac_tbl( pac_index ).sac_rac_ix <> sac_rac_ix ) );

reject_code:= breaked;

repeat

handle_queue( ath_msg, reject_code );

wait( atc_msg, main_sem.w^ );

if ownertest( delay_pool, atc_msg ) then
delay_msg :=: atc_msg
else
with atc_msg^ do
case u3 of (* route *)

dummy_route:
return( atc_msg )
;

netc_route,
netc_route1:
begin

if u4 in (.ts_cntrl, group_cntrl, ts_testi1, ts_testi2, ts_teste.) then
signal( atc_msg, queue_sem.s^ )
else
if ( u4 <> break_proc_end ) then
exec_conn_operation( atc_msg )

end
;

at_route:
driver_msg :=: atc_msg
;

otherwise
reject_message( atc_msg, ath_sem, at_route, ts_macro, own_addr, unknown_route )

end

until not nil( atc_msg ); (* break_proc_end received *)

receipt_message( atc_msg, ath_sem, route_vect( atc_msg^.u3 ), 0, accepted )

end; (* procedure exception *)
\f


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

begin

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

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

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

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

create_channel;

(********************************************************************************
* 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
********************************************************************************)

<*t testout( z, "end init    ", ord( conversation ) ); t*>
\f


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

if ( conversation = idle ) then 
begin

handle_queue( ath_msg, reject_code );

if not nil( ath_msg ) then
(* repeat a interrupted conversation or start a queued one *)
initiate_conversation( ath_msg )
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

end;
\f


wait( atc_msg, main_sem.w^ );

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,
netc_route1: (* 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
(* always execute the operations that does not involve DRIVER *)
begin

exec_conn_operation( atc_msg );

if ( activity = stop_code ) then
restrict_protocol

end
;
\f


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;

supervise;

if ( activity = stop_code ) then
restrict_protocol

end
;

otherwise (* unknown route *)
reject_message( atc_msg, ath_sem, at_route, ts_macro, own_addr, unknown_route )

end (* case message origin *)

until forever;

end. (* process atconnector*)

«eof»
DataMuseum.dk

RC3500

⟦0949a8e7a⟧ TextFileVerbose

Derivation

TextFileVerbose
