|
DataMuseum.dkPresents historical artifacts from the history of: RC3500 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC3500 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 33024 (0x8100)
Types: TextFileVerbose
Names: »athedit«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »athedit«
job nla 4 200 time 11 0 area 9 size 90000 perm disc1 1000 2
(mode list.yes
source = copy 25.1
tsathlst= set 1 disc1
tsathlst = indent source mark lc
athlst = cross tsathlst
o errors
pascal80 codesize.12000 alarmenv tsenvir source
o c
lookup pass6code
if ok.yes
( tsathbin= set 1 disc1
tsathbin = move pass6code
scope user tsathbin)
tsathlst=copy athlst errors
scope user tsathlst
convert errors
finis)
process at_handler(
op_sem : sempointer;
var
dc_address ,
own_address : !macroaddr;
var
sem : !ts_pointer_vector
);
const
version = "vers 3.18 /";
(* ------------------------------------------------------------------------
.
. The at_handler presupposes the following surroundings:
.
. - at runtime:
.
. Libraries: tslib.
.
. Externals: at_connector, receipt_message, reject_message.
.
.
. - at compile time:
.
. Environments: alarmenv, tsenvir
.
. Call: <object> = pascal80 <options> alarmenv tsenvir <source>
.
------------------------------------------------------------------------ *)
\f
(*
INTRODUCTION TO THE AT-HANDLER:
Abbreviation list for the AT-HANDLER process:
---------------------------------------------
ac alarm centre
addr address
at alarm terminal
atc at-connector
ath at-handler
dc district centre
del delete
incar incarnation
ins insert
ix index
locvar local variable
mac macro address
max greatest
mic micro address
min smallest
msg message
no number
pac primary alarm centre
rac receiving alarm centre
rec receiver
sac sending alarm centre
sem semaphore
send sender
tss ts-supervisor
\f
Pseudo-code for the AT-HANDLER process:
--------------------------------------
( this pseudo_code will be updated regularly - last time was 80.06.03 )
PROCESS at_handler("process_parameters");
CONST
. "process_constants, installation dependent" (may be moved to alarm-environment);
TYPE
. "message_format" (may be moved to alarm-environment);
VAR
. "sac_rac_table";
. "atc_table, binary search";
. "addressing_data";
. "atc_incarnation_data";
. "error_handling_data";
. "input_semaphore";
BEGIN
. "initialization";
. REPEAT
. "collect a buffer on the input_semaphore, and
. "handle the message in the buffer, corresponding to the
. operation_code, and produce resulting messages";
. "for each resulting message do addressing/indexing
. do supervising and signal each of the buffers to the
. corresponding input_semaphore";
. UNTIL forever;
END;
(end of pseudo_code)
*)
\f
(* ------------------------------------------------------------------------
. Declaration part 1: sac_rac table and table control variables.
------------------------------------------------------------------------ *)
var
sac_rac_tbl : sac_rac_table
:= sac_rac_table( sac_rac_lth ***
sac_rac_tbl_entry ( sac_rac_entry( empty_addr, empty_addr ), false ) );
sac_rac_ix : sac_rac_range := 1;
sac_rac_top : upper_sac_rac_index := 0; (* Indicates the highest used sac_rac_index *)
\f
(* ------------------------------------------------------------------------
. Declaration part 2: ATC incarnation table and ATC shadow table and table
. control variables.
------------------------------------------------------------------------ *)
var
atc_tbl : atc_table
:= atc_table( atc_tbl_lth *** atc_description( 0, 1, 1, 0, poll_delay_time,
(..), stop_code, stop_code, 1 ) );
shadows : atc_shadow_table;
atc_tbl_ix : atc_table_range := 1;
atc_tbl_top : upper_atc_tbl_index := 0;
\f
(* ------------------------------------------------------------------------
. Declaration part 3: resource handling.
------------------------------------------------------------------------ *)
var
main_wait : (
idle_main ,
busy_main ,
busy_pool ) := idle_main;
claim_level : atc_inc_claim := claim_none;
resource_claims : integer := 0;
queue_lth : byte := 0;
aux_msg ,
working_0404_msg ,
working_0608_msg : reference;
\f
(* ------------------------------------------------------------------------
. Declaration part 4: main part.
------------------------------------------------------------------------ *)
type
route_vector = array( netc_route..netc_route1 ) of byte;
const
route_vct = route_vector( at_route, at_route1 );
var
main_msg : reference;
result_code : result_range := accepted;
atc_name : alfa;
atc_no : integer := at_addr_limit;
alfa_pos : 1..alfalength := 1;
\f
(* ------------------------------------------------------------------------
. Declaration part 5: supervision.
------------------------------------------------------------------------ *)
var
book_up_pool : pool 1 of updates;
time_out_pool : pool 1 of integer;
book_up_msg ,
time_out_msg : reference;
node_test_freq : integer := max_int;
traffic_test_freq : integer := max_int;
nt_time_out : boolean := false;
dc_disconnect : boolean := true;
\f
(* ------------------------------------------------------------------------
. Declaration part 6: miscellaneous.
------------------------------------------------------------------------ *)
var
(*q test : boolean := false; q*)
z : zone;
\f
(* ------------------------------------------------------------------------
. Declaration part 7: Externals.
------------------------------------------------------------------------ *)
process atconnector(
op_sem : sempointer;
var
main_sem ,
queue_sem : !ts_pointer;
var
ath_sem ,
driversem ,
com_pool : !sempointer;
var
actual_activity : !connector_state;
var
poll_delay : !integer;
var
traffic_test_freq : !integer;
var
traffic_counter : integer;
var
own_dc ,
own_ts : !macroaddr;
ownaddr : !integer;
channelno : !byte
);
external;
\f
procedure book_up(
var
time_out_msg ,
book_up_msg : reference;
seconds : integer
);
(* -----------------------------------------------------------------------
----------------------------------------------------------------------- *)
begin
if not nil( book_up_msg ) then
begin
lock book_up_msg as locvar: updates do
with locvar do
count:= seconds
;
if nil( time_out_msg ) then
begin
book_up_msg^.u1:= update_req;
book_up_msg^.u4:= #hc4
end
else
begin
book_up_msg^.u1:= book_req;
book_up_msg^.u4:= #hc3;
push( time_out_msg, book_up_msg )
end;
signal( book_up_msg, sem( timeout_sem_no ).s^ )
end
end; (* procedure book_up *)
\f
function get_message(
var
msg : reference;
route ,
opc : byte;
noofbytes : integer;
rec_macro : macroaddr;
rec_micro : integer;
upd : update_range;
res : result_range
): boolean;
(* -----------------------------------------------------------------------
. Function : Returns as true with a message, supplied with a fully
. updated alarmlabel, if one is available on the
. semaphore, that holds the vacant resources, and if
. no messages are hanging on the main semaphore.
----------------------------------------------------------------------- *)
begin
if passive( sem( ath_sem_no ).w^ ) then
begin
sensesem( msg, sem( com_pool ).w^ );
if not nil( msg ) then
lock msg as locvar: alarmlabel do
with msg^, locvar do
begin
u3:= route;
u4:= opc;
no_of_by:= label_size + noofbytes;
rec.macro:= rec_macro;
rec.micro:= rec_micro;
send.macro:= own_address;
send.micro:= ath_mic_addr;
update:= upd;
result:= res;
main_wait:= idle_main
end
else
main_wait:= busy_pool
end
else
main_wait:= busy_main
;
get_message:= not nil( msg )
end; (* function get_message *)
\f
function foreign_nc(
node_address : macroaddr
): boolean;
(* -----------------------------------------------------------------------
. Function : Returns as true if - in the alarm net hierarchy - the node
. in question is a foreign NC or located below a foreign NC.
----------------------------------------------------------------------- *)
begin
with node_address do
foreign_nc:= ( dc_addr <> own_address.dc_addr )
or
( nc_addr <> own_address.nc_addr )
end; (* function foreign_nc *)
\f
function acting_ac(
sac_rac_ix : sac_rac_range
): alarmnetaddr;
(* -----------------------------------------------------------------------
. function : Returns with the alarm net address of the AC that
. for the moment is functioning as receiver/sender at the
. entry in sac_rac table indicated by sac_rac_ix.
----------------------------------------------------------------------- *)
begin
with sac_rac_tbl( sac_rac_ix ).sac_rac_e do
if ( substitute_ac_addr <> empty_addr ) then
acting_ac:= substitute_ac_addr
else
acting_ac:= usual_ac_addr
end; (* function acting_ac *)
\f
function search_sac_rac(
ac_address : alarmnetaddr;
var
sac_rac_ix : sac_rac_range
): boolean;
(* -----------------------------------------------------------------------
. function : Searches the sac_rac table for an entry, where
. ac_address is the functioning AC.
----------------------------------------------------------------------- *)
begin
sac_rac_ix:= 1;
while ( acting_ac( sac_rac_ix ) <> ac_address ) and ( sac_rac_ix < sac_rac_top ) do
sac_rac_ix:= sac_rac_ix + 1;
search_sac_rac:= acting_ac( sac_rac_ix ) = ac_address
end; (* function search_sac_rac *)
\f
(*------------ atc_tbl-part ------------*)
function find_atc_tbl_entry(
mic_addr : integer;
var
atc_tbl_ix : atc_table_range
): boolean;
(* ----------------------------------------------------------------------
. This function returns the index of the element with the given micro address.
. If not found, then the index is the place of the new element.
. The search strategy is a binary search in an ordered list of
. elements. The smallest element has the index = 1.
. Error - will not appear.
----------------------------------------------------------------------- *)
VAR
low, mid : atc_table_range;
BEGIN
if ( atc_tbl_top > 0 ) then
begin (* now the search is started *)
low := 1;
atc_tbl_ix:= atc_tbl_top;
while ( atc_tbl( atc_tbl_ix ).atc_mic_addr > mic_addr ) and ( ( atc_tbl_ix - low ) > 0 ) do
begin
mid:= ( atc_tbl_ix - low ) div 2 + low;
if ( atc_tbl( mid ).atc_mic_addr < mic_addr ) then
low:= mid + 1
else
atc_tbl_ix:= mid
end;
if ( atc_tbl( atc_tbl_ix ).atc_mic_addr <> mic_addr ) then
begin
find_atc_tbl_entry:= false;
atc_tbl_ix:= atc_tbl_ix + ord( atc_tbl( atc_tbl_ix ).atc_mic_addr < mic_addr )
end
else
find_atc_tbl_entry:= true
end
else
begin
find_atc_tbl_entry:= false;
atc_tbl_ix:= 1
end
end; (* find_atc_tbl_entry *)
\f
procedure place_atc_tbl_entry(
atc_tbl_ix : atc_table_range;
atc_mic : integer;
pac_index : sac_rac_range
);
(* ---------------------------------------------------------------------
. Function : Enters and initialize a new entry and re-arranges the
. table.
. Call only if there's room in the table and the position
. in the table is located.
----------------------------------------------------------------------- *)
var
work_ix : upper_atc_tbl_index;
work_entry : atc_description;
begin
work_entry:= atc_tbl( atc_tbl_top + 1 );
for work_ix:= atc_tbl_top downto atc_tbl_ix do
atc_tbl( work_ix + 1 ):= atc_tbl( work_ix );
atc_tbl( atc_tbl_ix ):= work_entry;
with atc_tbl( atc_tbl_ix ) do
begin
atc_mic_addr := atc_mic;
pac_ix := pac_index;
traffic_count:= 0;
delay:= poll_delay_time;
claim_set:= (..);
actual_activity:= stop_code;
wanted_activity := stop_code
end;
atc_tbl_top:= atc_tbl_top + 1
end (* place_atc_tbl_entry *);
\f
procedure del_atc_tbl_entry(
atc_tbl_ix : atc_table_range
);
(* ---------------------------------------------------------------------
. Function : Removes the entry and re-arranges the table.
. Call only if the entry in question is located.
---------------------------------------------------------------------- *)
var
work_entry : atc_description;
begin
if not nil( shadows( atc_tbl( atc_tbl_ix ).shad_ix ) ) then
remove( shadows( atc_tbl( atc_tbl_ix ).shad_ix ) );
work_entry:= atc_tbl( atc_tbl_ix );
while ( atc_tbl_ix < atc_tbl_top ) do
begin
atc_tbl( atc_tbl_ix ):= atc_tbl( atc_tbl_ix + 1 );
atc_tbl_ix:= atc_tbl_ix + 1
end;
atc_tbl( atc_tbl_top ):= work_entry;
atc_tbl_top := atc_tbl_top - 1
end (* del_atc_tbl_entry *);
\f
procedure decrease_claims(
var
claim_set : atc_claim_set;
msg_kind : atc_inc_claim
);
(* -----------------------------------------------------------------------
----------------------------------------------------------------------- *)
begin
if msg_kind in claim_set then
begin
claim_set:= claim_set - (.msg_kind.);
resource_claims:= resource_claims - 1
end
end; (* procedure decrease_claims *)
\f
procedure increase_claims(
first_ix ,
last_ix : atc_table_range;
msg_kind : atc_inc_claim
);
(* -----------------------------------------------------------------------
----------------------------------------------------------------------- *)
begin
for first_ix:= first_ix to last_ix do
with atc_tbl( first_ix ) do
if not ( msg_kind in claim_set ) then
begin
claim_set:= claim_set + (.msg_kind.);
resource_claims:= resource_claims + 1
end
;
if ( msg_kind > claim_level ) then
claim_level:= msg_kind
end; (* procedure increase_claims *)
\f
procedure atc_stop_poll(
first_ix : atc_table_range;
last_ix : upper_atc_tbl_index
);
(* -----------------------------------------------------------------------
----------------------------------------------------------------------- *)
var
msg : reference;
begin
if ( first_ix <= last_ix ) then
repeat
with atc_tbl( first_ix ), sac_rac_tbl( pac_ix ) do
if ( disconnected and ( actual_activity = start_code ) )
or
( dc_disconnect and ( actual_activity = service_code ) ) then
if get_message( msg, netc_route1, #h90, 0,
own_address, atc_mic_addr, stop_code, accepted ) then
begin
signal( msg, sem( ts_vect_ix ).s^ );
decrease_claims( claim_set, msg_0900_stop );
first_ix:= ( first_ix mod last_ix ) + 1
end
else
increase_claims( first_ix, last_ix, msg_0900_stop )
until ( first_ix = 1 ) or ( main_wait <> idle_main )
end; (* procedure atc_stop_poll *)
\f
procedure atc_start_poll(
first_ix : atc_table_range;
last_ix : upper_atc_tbl_index
);
(* -----------------------------------------------------------------------
----------------------------------------------------------------------- *)
var
msg : reference;
begin
if ( first_ix <= last_ix ) then
repeat
with atc_tbl( first_ix ), sac_rac_tbl( pac_ix ) do
if ( actual_activity <> break_code ) then
if ( actual_activity <> wanted_activity ) then
if ( ( not disconnected ) and ( wanted_activity = start_code ) )
or
( ( not dc_disconnect ) and ( wanted_activity = service_code ) ) then
if get_message( msg, netc_route1, #h90, 4, own_address, atc_mic_addr,
wanted_activity, accepted ) then
begin
lock msg as locvar: al_form_0900 do
with locvar do
begin
t_e_c_init:= 0;
frequence:= delay
end
;
signal( msg, sem( ts_vect_ix ).s^ );
decrease_claims( claim_set, msg_0900_start );
first_ix:= ( first_ix mod last_ix ) + 1
end
else
increase_claims( first_ix, last_ix, msg_0900_start )
until ( first_ix = 1 ) or ( main_wait <> idle_main )
end; (* procedure atc_start_poll *)
\f
procedure atc_supervise;
(* -----------------------------------------------------------------------
----------------------------------------------------------------------- *)
var
msg : reference;
begin
if ( atc_tbl_top > 0 ) then
begin
atc_tbl_ix:= 1;
repeat
with atc_tbl( atc_tbl_ix ) do
if ( actual_activity <> break_code ) then
begin
if ( traffic_count > 0 ) then (* - Traffic since the last test - *)
traffic_count:= 0
else
if ( traffic_count < 0 ) then
begin (* - No reaction on the last node test - *)
end
else
begin (* - No traffic since the last node test. Node test the ATC - *)
traffic_count:= -1;
if get_message( msg, netc_route1, #hc0, 0,
own_address, atc_mic_addr, read_code, accepted ) then
begin
signal( msg, sem( ts_vect_ix ).s^ );
decrease_claims( claim_set, msg_1200 );
atc_tbl_ix:= ( atc_tbl_ix mod atc_tbl_top ) + 1
end
else
increase_claims( atc_tbl_ix, atc_tbl_top, msg_1200 )
end
end
until ( atc_tbl_ix = 1 ) or ( main_wait <> idle_main )
end
end; (* procedure atc_supervise *)
\f
procedure ac_check_connection(
sac_rac_ix : sac_rac_range
);
(* -----------------------------------------------------------------------
. Function : Signals a check of the connection to an disconnected AC
. if there is a vacant resource.
----------------------------------------------------------------------- *)
var
msg : reference;
begin
with sac_rac_tbl( sac_rac_ix ) do
if disconnected then
if get_message( msg, at_route, #hc8, 0,
acting_ac( sac_rac_ix ).macro, acting_ac( sac_rac_ix ).micro, read_code, accepted ) then
signal( msg, sem( tssup_sem_no ).s^ )
end; (* procedure ac_check_connection *)
\f
begin
(*------------ main program ------------*)
testopen( z, own.incname, op_sem );
testout( z, version, ts_env_vers );
(*------------ initialisation ------------*)
for atc_tbl_ix:= 1 to atc_tbl_lth do
with atc_tbl( atc_tbl_ix ) do
begin
shad_ix:= atc_tbl_ix;
ts_vect_ix:= atc_sem_no + 2 * ( atc_tbl_ix - 1 )
end;
alloc( book_up_msg, book_up_pool, sem( ath_sem_no ).s^ );
with book_up_msg^ do
u3:= netc_route1;
lock book_up_msg as locvar: updates do
with locvar do
object:= ath_mic_addr;
alloc( time_out_msg, time_out_pool, sem( ath_sem_no ).s^ );
with time_out_msg^ do
begin
u1:= book_req;
u3:= netc_route1;
u4:= #hc2
end;
lock time_out_msg as locvar: integer do
locvar:= ath_mic_addr;
if ( link( "atconnector ", atconnector ) = accepted ) then
book_up( time_out_msg, book_up_msg, node_test_freq );
\f
repeat (* ......................... forever .............................. *)
repeat
case main_wait of
idle_main,
busy_main:
wait( main_msg, sem( ath_sem_no ).w^ )
;
busy_pool:
case waitsd( main_msg, sem( ath_sem_no ).w^, wait_sem_delay ) of
a_semaphore:
;
a_delay:
;
otherwise
end
;
otherwise
end
until not nil( main_msg )
;
result_code:= accepted;
(*q if test then testout(z,"main_msg u3:",main_msg^.u3);
if test then testout(z," u4:",main_msg^.u4); q*)
with main_msg^ do
case u3 (* this is the routings information *) of
(* And then we handle the message depending on the receiver address.
*)
dummy_route:
return( main_msg )
;
\f
at_route: (* Message from an ATC to be routed through ATH *)
begin
(*q if test then testout(z,"from an atc ",0); q*)
case u4 of (* Operation code *)
(* 00.01 - Log to PAC. Enter AC net addresses *)
#h01:
lock main_msg as locvar: al_form_0001 do
with locvar, al_label, aac_address do
if ( 0 < ts_add( 0 ) ) and ( ts_add( 0 ) <= sac_rac_top ) then
begin
rec:= acting_ac( ts_add( 0 ) );
if ( 0 < micro ) and ( micro <= sac_rac_top ) then
aac_address:= acting_ac( micro )
end
else
result_code:= unknown_receiver
;
(* 03.00 *)
(* 03.01 *)
(* 03.02 - Alarms. Enter AC address *)
#h30..#h32:
lock main_msg as locvar: alarmlabel do
with locvar do
begin
if ( ( 0 < ts_add( 0 ) ) and ( ts_add( 0 ) <= sac_rac_top ) ) then
rec:= acting_ac( ts_add( 0 ) )
else
result_code:= unknown_receiver;
(* inconsistency between ac_address table in ATC and sac_rac_table
- maybe because of a time dependent event *)
end
;
\f
(* 09.01 - Receipt for change of poll activity. Actual activity is modified of ATC. *)
#h91:
lock main_msg as locvar: al_form_0900 do
with locvar, al_label do
if find_atc_tbl_entry( send.micro, atc_tbl_ix ) then
if ( result = accepted ) then
with atc_tbl( atc_tbl_ix ), sac_rac_tbl( pac_ix ) do
begin
wanted_activity:= update;
if disconnected or dc_disconnect then
atc_stop_poll( atc_tbl_ix, atc_tbl_ix )
end
else
else
result_code:= unknown_sender
;
otherwise
(* Other operation code are passed uninspected and unaltered *)
end (* case u4 *)
;
if ( result_code <> accepted ) then
reject_message( main_msg,
sem( tssup_sem_no ).s, route_vct( u3 ), own_address, ath_mic_addr, result_code )
else
signal( main_msg, sem( tssup_sem_no ).s^ )
end (* Message from an ATC *)
;
\f
at_route1: (* Message from ATC to ATH *)
begin
case u4 of (* Operation code *)
(* 01.02 - Rejected message *)
#h12:
testout( z, "garb return ", u3 )
;
(* 04.05 - Receipt for group control. Dropped unless ATC says serious error *)
#h45:
lock main_msg as locvar: alarmlabel do
with locvar do
if not ( result in (.accepted, not_steering, unknown_sender.) ) then
begin
result_code:= result;
lock working_0404_msg as a_label: alarmlabel do
rec:= a_label.send
end
;
(* 09.01 - Receipt for modification of connector state. *)
#h91:
;
(* 12.15 - Receipt for completion of break routine. *)
#hcf:
lock main_msg as locvar: alarmlabel do
with locvar, send do
if find_atc_tbl_entry( micro, atc_tbl_ix ) then
begin
del_atc_tbl_entry( atc_tbl_ix );
end
;
otherwise
testout( z, "at_route1 ", u4 )
end
;
if ( result_code <> accepted ) then
signal( main_msg, sem( tssup_sem_no ).s^ )
else
return( main_msg )
end
;
\f
netc_route1: (* Message from TSS or from time out process to ATH *)
begin
case u4 of (* Operation code *)
(* 01.02 - Rejected message *)
#h12:
testout( z, "garb return ", u3 );
;
(* 02.00 - Broadcast. DC fall-out. *)
#h20:
lock main_msg as locvar: al_form_020_ do
with locvar, al_net_addr, macro do
if ( dc_addr <> own_address.dc_addr ) then
begin (* - Foreign DC - *)
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to sac_rac_top do
if ( acting_ac( sac_rac_ix ).macro.dc_addr <> own_address.dc_addr ) then
sac_rac_tbl( sac_rac_ix ).disconnected:= true
;
atc_stop_poll( 1, atc_tbl_top )
end
else
begin (* - Own DC - *)
dc_disconnect:= true;
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to sac_rac_top do
if foreign_nc( acting_ac( sac_rac_ix ).macro ) then
sac_rac_tbl( sac_rac_ix ).disconnected:= true
;
atc_stop_poll( 1, atc_tbl_top )
end
;
\f
(* 02.01 - Broadcast. DC re-established. *)
#h21:
lock main_msg as locvar: al_form_020_ do
with locvar, al_net_addr, macro do
if ( dc_addr <> own_address.dc_addr ) then
begin (* - Foreign DC - *)
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to sac_rac_top do
if ( acting_ac( sac_rac_ix ).macro.dc_addr <> own_address.dc_addr ) then
ac_check_connection( sac_rac_ix )
end
else
begin (* - Own DC - *)
if dc_disconnect then
if get_message( aux_msg, at_route, #hc8, 0,
dc_address, dc_erh_mic_addr, read_code, accepted ) then
signal( aux_msg, sem( tssup_sem_no ).s^ )
;
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to sac_rac_top do
if foreign_nc( acting_ac( sac_rac_ix ).macro ) then
ac_check_connection( sac_rac_ix )
end
;
\f
(* 02.02 - Broadcast. NC fall-out. *)
#h22:
lock main_msg as locvar: al_form_020_ do
with locvar, al_net_addr, macro do
if foreign_nc( macro ) then
begin (* - Foreign NC - *)
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to sac_rac_top do
if foreign_nc( acting_ac( sac_rac_ix ).macro ) then
sac_rac_tbl( sac_rac_ix ).disconnected:= true
;
atc_stop_poll( 1, atc_tbl_top )
end
else
begin (* - Own NC - *)
dc_disconnect:= true;
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to sac_rac_top do
if ( acting_ac( sac_rac_ix ).macro <> own_address ) then
sac_rac_tbl( sac_rac_ix ).disconnected:= true
;
atc_stop_poll( 1, atc_tbl_top )
end
;
\f
(* 02.03 - Broadcast. NC re-established. *)
#h23:
lock main_msg as locvar: al_form_020_ do
with locvar, al_net_addr, macro do
if foreign_nc( macro ) then
begin (* - Foreign NC - *)
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to sac_rac_top do
if foreign_nc( acting_ac( sac_rac_ix ).macro ) then
ac_check_connection( sac_rac_ix )
end
else
begin (* - Own NC - *)
if dc_disconnect then
if get_message( aux_msg, at_route, #hc8, 0,
dc_address, dc_erh_mic_addr, read_code, accepted ) then
signal( aux_msg, sem( tssup_sem_no ).s^ )
;
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to atc_tbl_top do
if ( acting_ac( sac_rac_ix ).macro <> own_address ) then
ac_check_connection( sac_rac_ix )
end
;
\f
(* 02.04 - Broadcast. TS fall-out. *)
#h24:
lock main_msg as locvar: al_form_020_ do
with locvar, al_net_addr do
begin
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to sac_rac_top do
if ( acting_ac( sac_rac_ix ).macro = macro ) then
sac_rac_tbl( sac_rac_ix ).disconnected:= true
;
atc_stop_poll( 1, atc_tbl_top )
end
;
\f
(* 02.05 - Broadcast. TS re-established. *)
#h25:
lock main_msg as locvar: al_form_020_ do
with locvar, al_net_addr do
begin
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to sac_rac_top do
if ( acting_ac( sac_rac_ix ).macro = macro ) then
ac_check_connection( sac_rac_ix )
end
;
\f
(* 02.06 - Broadcast. AC fall-out. *)
#h26:
begin
lock main_msg as locvar: al_form_020_ do
with locvar do
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to sac_rac_top do
if ( acting_ac( sac_rac_ix ) = al_net_addr ) then
sac_rac_tbl( sac_rac_ix ).disconnected:= true
;
atc_stop_poll( 1, atc_tbl_top )
end
;
\f
(* 02.07 - Broadcast. AC re-established. *)
#h27:
lock main_msg as locvar: al_form_020_ do
with locvar do
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to sac_rac_top do
if ( acting_ac( sac_rac_ix ) = al_net_addr ) then
ac_check_connection( sac_rac_ix )
;
\f
(* 04.04 - Group control is multiplied by ATH - if the sender is known *)
#h44:
if atc_tbl_top > 0 then
begin
lock main_msg as locvar: al_form_0404 do
with locvar, al_label do
if ( ( no_of_by - 4 ) > 0 ) and ( ( high_micro - low_micro ) > - 1 ) then
begin
if search_sac_rac( send, sac_rac_ix ) then
ts_add( 0 ):= sac_rac_ix
else
result_code:= unknown_sender
end
else
result_code:= data_inconsistent;
if ( result_code = accepted ) then
signal( main_msg, sem( ath_int1 ).s^ )
end
else
result_code:= unknown_receiver
;
\f
(* 06.00 - Creation of an ATC incarnation *)
#h60:
if ( atc_tbl_top < atc_tbl_lth ) then
begin
lock main_msg as locvar: al_form_0600 do
with locvar, al_label, atc_tbl_e do
if ( send.macro <> dc_address ) then
result_code:= forbidden
else
begin
if find_atc_tbl_entry( atc_mic, atc_tbl_ix ) then
result_code:= existing_entry
else
if ( pac_ix < 1 ) or ( sac_rac_top < pac_ix ) then
result_code:= out_of_range
else
begin
place_atc_tbl_entry( atc_tbl_ix, atc_mic, pac_ix );
(* calculate an unambigouos atc_name *)
atc_name:= "atc__ ";
atc_no:= atc_mic;
alfa_pos:= 8;
repeat
atc_name( alfa_pos ):= chr( atc_no mod 10 + ord( "0" ) );
atc_no:= atc_no div 10;
alfa_pos:= alfa_pos - 1
until ( alfa_pos = 4 );
(* Create and start the incarnation *)
with atc_tbl( atc_tbl_ix ) do
result_code:= create(
atc_name ,
atconnector(
op_sem ,
sem( ts_vect_ix ) ,
sem( ts_vect_ix + 1 ) ,
sem( ath_sem_no ).s ,
sem( lam_no + lam_sem_no ).s ,
sem( com_pool ).w ,
actual_activity ,
delay ,
node_test_freq ,
traffic_test_freq ,
dc_address ,
own_address ,
atc_mic ,
port_no
) ,
shadows( shad_ix ) ,
atc_size
);
if ( result_code = accepted ) then
start( shadows( atc_tbl( atc_tbl_ix ).shad_ix ), atc_pri )
else
begin
del_atc_tbl_entry( atc_tbl_ix );
result_code:= breaked
end
end
end
end
else
result_code:= no_room
;
\f
(* 06.08 - Remove ATC incarnation. *)
#h68:
lock main_msg as locvar: al_form_0608 do
with locvar, al_label, atc_tbl_e do
if ( send.macro <> dc_address ) then
result:= forbidden
else
if find_atc_tbl_entry( atc_mic, atc_tbl_ix ) then
del_atc_tbl_entry( atc_tbl_ix )
else
result_code:= not_found
;
\f
(* 10.10 - Operation on sac_rac table *)
#haa:
lock main_msg as locvar: al_form_1010 do
with locvar, al_label do
if ( send.macro <> dc_address ) then
result_code:= forbidden
else
if ( sac_rac_tbl_ix < 1 ) or ( sac_rac_lth < sac_rac_tbl_ix ) then
result_code:= out_of_range
else
case update of
read_code:
tbl_entry:= sac_rac_tbl( sac_rac_tbl_ix ).sac_rac_e
;
insert_code:
with sac_rac_tbl( sac_rac_tbl_ix ) do
begin
sac_rac_e:= tbl_entry;
disconnected:= true;
if ( sac_rac_tbl_ix > sac_rac_top ) then
sac_rac_top:= sac_rac_tbl_ix
;
ac_check_connection( sac_rac_tbl_ix )
end
;
remove_code:
with sac_rac_tbl( sac_rac_tbl_ix ) do
begin
sac_rac_e:= sac_rac_entry( empty_addr, empty_addr );
disconnected:= false;
if ( sac_rac_top = sac_rac_tbl_ix ) then
begin
while ( sac_rac_top > 1 ) and ( acting_ac( sac_rac_top ) = empty_addr ) do
sac_rac_top:= sac_rac_top - 1
;
if ( acting_ac( sac_rac_top ) = empty_addr ) then
sac_rac_top:= sac_rac_top - 1
end
end
;
otherwise
result_code:= unknown_update
end
;
\f
(* 12.00 - Node test. Check connection to disconnected DC and AC's. *)
#hc0:
begin
lock main_msg as locvar: al_form_1200 do
with locvar do
begin
node_test_freq:= master_time_out;
traffic_test_freq:= master_time_out + tolerance
end
;
book_up( time_out_msg, book_up_msg, node_test_freq );
if dc_disconnect then
if get_message( aux_msg, at_route, #hc8, 0,
dc_address, dc_erh_mic_addr, read_code, accepted ) then
signal( aux_msg, sem( tssup_sem_no ).s^ )
;
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to sac_rac_top do
ac_check_connection( sac_rac_ix )
;
nt_time_out:= false;
atc_supervise
end
;
\f
(* 12.02 - Time out alarm on own TSS. Overtake the node test function.
- Disconnect DC and all AC's and stop all ATC's. *)
#hc2:
begin
book_up( main_msg, book_up_msg, node_test_freq );
if not nt_time_out then
begin
nt_time_out:= true;
dc_disconnect:= true;
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to sac_rac_top do
if ( acting_ac( sac_rac_ix ) <> empty_addr ) then
sac_rac_tbl( sac_rac_ix ).disconnected:= true
;
atc_stop_poll( 1, atc_tbl_top )
end
;
atc_supervise
end
;
\f
(* 12.03 *)
(* 12.04 - Returned book/update message from time out process *)
#hc3..#hc4:
book_up_msg :=: main_msg
;
(* 12.09 - Receipt for dummy alarm from PAC or from DC. *)
#hc9:
begin
lock main_msg as locvar: alarmlabel do
with locvar do
if ( send.macro = dc_address ) then
dc_disconnect:= false
else
if ( sac_rac_top > 0 ) then
for sac_rac_ix:= 1 to sac_rac_top do
if ( acting_ac( sac_rac_ix ) = send ) then
sac_rac_tbl( sac_rac_ix ).disconnected:= false
;
atc_start_poll( 1, atc_tbl_top )
end
;
\f
otherwise
reject_message( main_msg,
sem( tssup_sem_no ).s, route_vct( u3 ), own_address, ath_mic_addr, unknown_opcode )
end (* case u4 to ATH *)
;
if not nil( main_msg ) then
if main_msg^.u4 in (.#h12, #h20..#h27, #hc9.) then
return( main_msg )
else
receipt_message( main_msg, sem( tssup_sem_no ).s, route_vct( u3 ), 0, result_code )
end (* Message from TSS to ATH *)
;
\f
netc_route: (* Message to an ATC from TSS to be routed through ATH *)
begin
(*q if test then testout(z,"to an atc ",0); q*)
if atc_tbl_top > 0 then
lock main_msg as locvar: alarmlabel do
with locvar do
if find_atc_tbl_entry( rec.micro, atc_tbl_ix ) then
with atc_tbl( atc_tbl_ix ) do
if ( actual_activity <> break_code ) then
case u4 of (* Operation code *)
(* 04.00 - Control. Find index of AC in sac_rac table. *)
#h40:
begin
if ( acting_ac( pac_ix ) <> send ) then
begin
if search_sac_rac( send, sac_rac_ix ) then
result_code:= accepted
else
result_code:= unknown_sender
end
else
sac_rac_ix:= pac_ix;
if ( result_code = accepted ) then
ts_add( 0 ):= sac_rac_ix
end
;
(* 08.04 - Extern test. Check the legitimacy *)
#h84:
if ( acting_ac( pac_ix ) <> send ) then
result_code:= forbidden
else
ts_add( 0 ):= pac_ix
;
otherwise
(* Other operation codes are passed uninspected and unaltered *)
\f
end (* case operation code *)
else
result_code:= breaked
else
result_code:= not_found
else
result_code:= unknown_receiver
;
(* end - lock main_msg. end - with locvar, atc_tbl *)
if ( result_code <> accepted ) then
reject_message( main_msg,
sem( tssup_sem_no ).s, route_vct( u3 ), own_address, ath_mic_addr, result_code )
else
signal( main_msg, sem( atc_tbl( atc_tbl_ix ).ts_vect_ix ).s^ )
end (* Message from TSS to an AT *)
;
otherwise (* Unknown route *)
begin
(*q test := not test;
if test then testout(z,"starttestout",0);
if not test then testout(z,"stop testout",0); q*)
reject_message( main_msg,
sem( tssup_sem_no ).s, at_route, own_address, ath_mic_addr, unknown_route )
end
;
end (* case route - with main_msg^ *)
until forever
end (* process at_handler *).
«eof»