|
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: 30720 (0x7800)
Types: TextFileVerbose
Names: »athback«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »athback«
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 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)
athenvir;
const
version = "vers 3.12 /";
mmh_stack = 300;
empty_addr = alarmnetaddr( macroaddr( 0, 0, 0 ), 0 );
node_test_default = 30;
type
alarm_form4 = array( 0..1 ) of alarmlabel;
alarm_form5 = record
head : alarmlabel;
t_e_counter ,
frequence : integer
end;
alarm_form6 = record
head : alarmlabel;
data : array( 1..2 * size_listen - ( label_size + 2 + 4 ) ) of byte;
low_micro ,
high_micro : integer
end;
node_test_format = record
head : alarmlabel;
counter ,
frequency : integer
end;
vca_vcm_ix = 1..vca_vcm_l;
max_vcam_ix = 0..vca_vcm_l;
vca_vcm_table = array( vca_vcm_ix ) of vca_vcm_e;
at_table_ix = 1..at_l;
no_of_at = 0..at_l;
at_e = record
at_mic : integer;
ts_vect_ix : integer;
shad_ix : at_table_ix;
traffic_count ,
delay : integer;
wanted_activity ,
actual_activity : poll_activity;
pvc_index : vca_vcm_ix
end;
at_table = array( at_table_ix ) of at_e;
shad_table = array( at_table_ix ) of shadow;
alarm_form3 = record
head : alarmlabel;
address : alarmnetaddr
end;
\f
(*----------------- external declaration part -----------------------------*)
procedure receipt_message(
var
msg : reference;
route : byte;
res : result_range
);
external;
procedure reject_message(
var
msg : reference;
sender_macro : macroaddr;
sender_micro : integer;
res : result_range;
route : byte
);
external;
.
\f
process at_handler(
op_sem : sempointer;
var
dc_addr ,
own_address : !macroaddr;
var
sem : !ts_pointer_vector
);
\f
(*
INTRODUCTION TO THE AT-HANDLER:
Abbreviation list for the AT-HANDLER process:
( the introduction of the alarmenvironment has made some inconsistenses in the list )
---------------------------------------------
addr address
at alarm terminal
atc at-connector
ath at-handler
att at-table
buf buffer
dc district center
del delete
elm element
in input
incar incarnation
ins insert
ix index
mac macro address
max greatest
mes message
mic micro address
min smallest
nb number
pvc primary vc
rec receiver
sem semaphore
sen sender
sup supervising
tss ts-supervisor
vc alarm center
vcam vca-vcm-table
vcc vc-connector
\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
. "vca_vcm_table";
. "at_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
(*------------ att-part -------------*)
type
alarm_form1 = record (* is used in 6.0 *)
head : alarmlabel;
tail : record
atc_mic : integer;
lam_nb : byte; (* index to ts_pointer_vector *)
port_nb : byte; (* channel number *)
pvc_index : integer;
end;
end;
alarm_form2 = record (* is used in 10.10 *)
head : alarmlabel;
tail : record
vc_index : integer;
vca_addr ,
vcm_addr : alarmnetaddr;
end;
end;
\f
(*------------ vcam-part ------------*)
var
vcam : vca_vcm_table := vca_vcm_table( vca_vcm_l *** vca_vcm_e( empty_addr, empty_addr ) );
vcam_index : vca_vcm_ix := 1;
vcam_max : max_vcam_ix := 0; (* vcam_max is the greatest used vcam_index *)
(*------------ att-part ------------*)
var
att : at_table := at_table(
at_l *** at_e( 0, 1, 1, 0, poll_delay_time, stop_code, stop_code, 1 ) );
shadows : shad_table ;
att_index : at_table_ix := 1;
att_max : no_of_at := 0;
\f
(*------------ main-part ------------*)
in_mes : reference;
operation_code : byte;
result_code : result_range := accepted;
(*q test : boolean := false; (* true means testmode *)
atc_name : alfa;
atc_nb : integer := at_addr_limit;
alfa_pos : 1..alfalength := 1;
mmh_shadow : shadow;
node_test_freq : integer := node_test_default;
z : zone;
\f
(*------------ externals ------------*)
process atconnector(
op_sem : sempointer;
var
main_sem ,
queue_sem : !ts_pointer;
var
ath_sem ,
driversem ,
timer_sem ,
com_pool : !sempointer;
var
actual_activity : poll_activity;
var
poll_delay : !integer;
var
node_test_frequency : !integer;
var
traffic_counter : integer;
var
own_dc ,
own_ts : !macroaddr;
ownaddr : !integer;
channelno : !byte
);
external;
\f
process mmh(
op_sem : sempointer;
var
main_sem : !ts_pointer;
var
ath_sem ,
time_out_sem,
com_sem : !sempointer;
var
own_addr : !macroaddr;
var
at_tbl : !at_table;
var
vcam_tbl : !vca_vcm_table;
var
no_of_inc : !no_of_at;
var
top_vcam_ix : !max_vcam_ix;
var
nt_freq : integer
);
(* use netc_route1 to communicate with the at handler,
at_route to get a message through at handler to the supervisor
and netc_route when a message is to be routed through ath to an atc *)
var
book_up_pool : pool 1 of updates;
time_out_pool : pool 1 of integer;
book_up_msg ,
time_out_msg ,
request_msg ,
msg : reference;
at_ix : at_table_ix := 1;
vcam_ix : vca_vcm_ix := 1;
pvc_set : set of vca_vcm_ix := (..);
nt_time_out : boolean := false;
z : zone;
\f
(*----------------- forward declaration part -----------------------------*)
procedure get_message(
var
msg : reference;
route ,
opc : byte;
noofbytes : integer;
rec_macro : macroaddr;
rec_micro : integer;
upd : update_range;
res : result_range
);
forward;
\f
procedure book_up(
var
time_out_msg ,
book_up_msg : reference;
seconds : integer
);
begin
book_up_msg^.u2:= 0;
if nil( time_out_msg ) then
begin
book_up_msg^.u1:= update_req;
book_up_msg^.u4:= #hc4
end
else
begin
time_out_msg^.u2:= 0;
book_up_msg^.u1:= book_req;
book_up_msg^.u4:= #hc3;
lock book_up_msg as locvar: updates do
with locvar do
count:= seconds * time_out_unit;
push( time_out_msg, book_up_msg )
end;
signal( book_up_msg, time_out_sem^ )
end; (* procedure book_up *)
\f
function aac( vcam_ix: vca_vcm_ix ): alarmnetaddr;
begin
with vcam_tbl( vcam_ix ) do
if ( vcm_addr <> empty_addr ) then
aac:= vcm_addr
else
aac:= vca_addr
end; (* function aac *)
function foreign_dc( addr1, addr2: macroaddr ): boolean;
begin
foreign_dc:= ( addr1.dc_addr <> addr2.dc_addr )
end; (* function foreign_dc *)
function foreign_nc( addr1, addr2: macroaddr ): boolean;
begin
foreign_nc:= ( addr1.dc_addr <> addr2.dc_addr ) or
( addr1.nc_addr <> addr2.nc_addr )
end; (* function foreign_nc *)
\f
procedure check_pac_connection;
begin
vcam_ix:= 1;
while ( vcam_ix < top_vcam_ix ) and ( pvc_set <> (..) ) do
begin (* send a dummy alarm to involved pac's *)
if ( vcam_ix in pvc_set ) then
begin
get_message( msg, at_route, #hc8, 0,
aac( vcam_ix ).macro, aac( vcam_ix ).micro, 0, 0 );
pvc_set:= pvc_set - (.vcam_ix.)
end;
vcam_ix:= vcam_ix + 1
end
end; (* procedure check_pac_connection *)
\f
procedure get_message(
var
msg : reference;
route ,
opc : byte;
noofbytes : integer;
rec_macro : macroaddr;
rec_micro : integer;
upd : update_range;
res : result_range
);
begin
wait( msg, com_sem^ );
with msg^ do
begin
u3:= route;
u4:= opc
end;
lock msg as locvar: alarm_form5 do
with locvar, head do
begin
no_of_by:= label_size + noofbytes;
rec.macro:= rec_macro;
rec.micro:= rec_micro;
send.macro:= own_addr;
send.micro:= ath_mic_addr;
update:= upd;
result:= res;
end;
if ( noofbytes = 0 ) then
signal( msg, ath_sem^ )
end; (* procedure send_message *)
\f
begin
testopen( z, own.incname, op_sem );
testout( z, version, al_env_version );
alloc( book_up_msg, book_up_pool, main_sem.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, main_sem.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;
\f
repeat (* forever ....................... *)
wait( request_msg, main_sem.w^ );
with request_msg^ do
case u3 of (* route *)
dummy_route:
return( request_msg )
;
netc_route1:
case u4 of (* operation code *)
#h20..#h27: (* broadcast *)
begin
lock request_msg as locvar: alarm_form3 do
with locvar, address, macro do
begin
pvc_set:= (..);
for at_ix:= 1 to no_of_inc do
with at_tbl( at_ix ), vcam_tbl( pvc_index ) do
case u4 of
\f
(* 02.00 *) #h20: (* dc fall out *)
if ( dc_addr <> own_addr.dc_addr ) then
begin (* foreign dc fall out *)
if foreign_dc( aac( pvc_index ).macro, own_addr ) and
( actual_activity = start_code ) then
begin
get_message( msg, netc_route, #h90, 0,
own_addr, at_mic, stop_code, accepted );
pvc_set:= pvc_set + (.pvc_index.)
end
end
else
begin (* own dc fall out *)
if foreign_nc( aac( pvc_index ).macro, own_addr ) and
( actual_activity <> stop_code ) then
begin
get_message( msg, netc_route, #h90, 0,
own_addr, at_mic, stop_code, accepted );
pvc_set:= pvc_set + (.pvc_index.)
end
end
;
\f
(* 02.01 *) #h21: (* dc re-established *)
if ( actual_activity <> wanted_activity ) then
begin
if ( dc_addr <> own_addr.dc_addr ) then
begin (* foreign dc re-established *)
if foreign_dc( aac( pvc_index ).macro, own_addr ) then
pvc_set:= pvc_set + (.pvc_index.)
end
else
begin (* own dc re-established *)
if foreign_nc( aac( pvc_index ).macro, own_addr ) then
pvc_set:= pvc_set + (.pvc_index.)
end
end
;
\f
(* 02.02 *) #h22: (* nc fall out *)
if foreign_nc( address.macro, own_addr ) then
begin (* foreign nc fall out *)
if foreign_nc( aac( pvc_index ).macro, own_addr ) and
( actual_activity = start_code ) then
begin
get_message( msg, netc_route, #h90, 0,
own_addr, at_mic, stop_code, accepted );
pvc_set:= pvc_set + (.pvc_index.)
end
end
else
begin (* own nc fall out *)
if ( aac( pvc_index ).macro <> own_addr ) and
( actual_activity <> stop_code ) then
begin
get_message( msg, netc_route, #h90, 0,
own_addr, at_mic, stop_code, accepted );
pvc_set:= pvc_set + (.pvc_index.)
end
end
;
\f
(* 02.03 *) #h23: (* nc re-established *)
if ( actual_activity <> wanted_activity ) then
begin
if foreign_nc( address.macro, own_addr ) then
begin (* foreign nc re-established *)
if not foreign_nc( aac( pvc_index ).macro, address.macro ) then
pvc_set:= pvc_set + (.pvc_index.)
end
else
begin (* own nc re-established *)
if ( aac( pvc_index ).macro <> own_addr ) then
pvc_set:= pvc_set + (.pvc_index.)
end
end
;
\f
(* 02.04 *) #h24: (* ts fall out *)
if ( aac( pvc_index ).macro = address.macro ) and
( actual_activity = start_code ) then
begin
get_message( msg, netc_route, #h90, 0,
own_addr, at_mic, stop_code, accepted );
pvc_set:= pvc_set + (.pvc_index.)
end
;
(* 02.05 *) #h25: (* ts re-established *)
if ( aac( pvc_index ).macro = address.macro ) and
( actual_activity <> wanted_activity ) then
pvc_set:= pvc_set + (.pvc_index.)
;
\f
(* 02.06 *) #h26: (* ac fall out *)
begin
if ( aac( pvc_index ) = address ) and ( actual_activity = start_code ) then
get_message( msg, netc_route, #h90, 0,
own_addr, at_mic, stop_code, accepted );
pvc_set:= pvc_set + (.pvc_index.)
end
;
(* 02.07 *) #h27: (* ac re_established *)
if ( aac( pvc_index ) = address ) and ( actual_activity <> wanted_activity ) then
pvc_set:= pvc_set + (.pvc_index.)
;
otherwise
end
;
check_pac_connection
end
;
return( request_msg )
end
;
\f
(* 04.04 *) #h44: (* group control *)
begin
lock request_msg as locvar: alarm_form6 do
with locvar do
begin
at_ix:= 1;
while ( at_ix < no_of_inc ) and ( at_tbl( at_ix ).at_mic < low_micro ) do
at_ix:= at_ix + 1;
while ( at_ix < no_of_inc ) and ( at_tbl( at_ix ).at_mic < high_micro ) do
with at_tbl( at_ix ) do
begin
wait( msg, com_sem^ );
msg^.u3:= netc_route;
msg^.u4:= u4;
lock msg as copy: alarm_form6 do
begin
copy:= locvar;
copy.head.no_of_by:= copy.head.no_of_by - 4;
copy.head.rec.micro:= at_mic
end;
signal( msg, ath_sem^ );
at_ix:= at_ix + 1
end
end;
receipt_message( request_msg, at_route, accepted )
end
;
\f
(* 12.00 *) #hc0: (* node test *)
begin
lock request_msg as locvar: node_test_format do
with locvar do
nt_freq:= frequency;
receipt_message( request_msg, at_route, accepted );
book_up( time_out_msg, book_up_msg, nt_freq );
for at_ix:= 1 to no_of_inc do
with at_tbl( at_ix ) do
begin
if ( traffic_count > 0 ) then (* traffic since last node test *)
traffic_count:= 0
else
if ( traffic_count < 0 ) then (* no reaction on last node test *)
begin
get_message( msg, at_route, #h28, 4,
aac( pvc_index ).macro, aac( pvc_index ).micro, 0, accepted );
lock msg as locvar3: alarm_form3 do
with locvar3, address do
begin
macro:= own_addr;
micro:= at_mic
end;
signal( msg, ath_sem^ )
end
else (* no traffic since last node test *)
begin
get_message( msg, netc_route, #hc0, 0, own_addr, at_mic, 0, accepted );
traffic_count:= -1
end;
if nt_time_out then
pvc_set:= pvc_set + (.pvc_index.)
end;
if nt_time_out then
begin
check_pac_connection;
nt_time_out:= false
end
end
;
\f
(* 12.02 *) #hc2: (* time out on own nc or supervisor *)
begin
time_out_msg :=: request_msg;
nt_time_out:= true;
for at_ix:= 1 to no_of_inc do
with at_tbl( at_ix ) do
if ( actual_activity <> stop_code ) then
get_message( msg, netc_route, #h90, 0,
own_addr, at_mic, stop_code, accepted )
end
;
(* 12.03 *)
(* 12.04 *) #hc3, #hc4: (* returned book/update message *)
book_up_msg :=: request_msg
;
\f
(* 12.09 *) #hc9: (* receipt for dummy alarm *)
lock request_msg as locvar: alarmlabel do
with locvar do
begin
vcam_ix:= vcam_ix + 1;
if ( aac( vcam_ix ) = send ) then
for at_ix:= 1 to no_of_inc do
with at_tbl( at_ix ) do
begin
if ( pvc_index = vcam_ix ) and ( actual_activity <> wanted_activity ) then
get_message( msg, netc_route, #h90, 4,
own_addr, at_mic, wanted_activity, accepted );
lock msg as locvar: alarm_form5 do
with locvar do
begin
t_e_counter:= 0;
frequence := delay
end;
signal( msg, ath_sem^ )
end;
return( request_msg )
end
;
otherwise
end
;
otherwise
end
until false
end (* process mmh *)
;
\f
(*------------ vcam-part ------------*)
PROCEDURE ins_vcam_elm(
sen_addr ,
rec_addr : alarmnetaddr;
index : integer;
var
result : result_range
);
(*--------------------------------------------------------------------
. This procedure inserts a new element in the vcam, if room for it.
. But first it checks, that the index matches the next free element.
. Error => room := false.
----------------------------------------------------------------------*)
BEGIN
if ( index < 1 ) or ( vca_vcm_l < index ) then
begin
(*q if test then testout(z,"ins_vcam_err",vcam_max); q*)
result:= out_of_range
end
else
BEGIN
result:= accepted;
if ( index > vcam_max ) then
vcam_max:= index;
WITH vcam( index ) DO
BEGIN
vca_addr := sen_addr;
vcm_addr := rec_addr
END
END
end; (* procedure ins_vcam_elm *)
\f
function actual_rec( vcam_ix: vca_vcm_ix ): alarmnetaddr;
begin
with vcam( vcam_ix ) do
if ( vcm_addr <> empty_addr ) then
actual_rec:= vcm_addr
else
actual_rec:= vca_addr
end; (* function actual_rec *)
\f
function search_vca( var vca_ix: vca_vcm_ix; vca_address: alarmnetaddr ): result_range;
begin
vca_ix:= 1;
while ( actual_rec( vca_ix ) <> vca_address ) and
( vca_ix < vcam_max ) do
vca_ix:= vca_ix + 1;
if ( actual_rec( vca_ix ) <> vca_address ) then
search_vca:= unknown_sender
else
search_vca:= accepted
end; (* function search_vca *)
\f
(*------------ att-part ------------*)
function find_att_elm( mic: integer; var index: at_table_ix ): 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 strategi is a binary search in an ordered list of
. elements. The smallest element has the index = 1.
. Error - will not appear.
---------------------------------------------------------------------*)
VAR
low, mid : at_table_ix;
BEGIN
if ( att_max > 0 ) then
begin (* now the search is started *)
low := 1;
index:= att_max;
while ( att( index ).at_mic > mic ) and ( ( index - low ) > 0 ) do
begin
mid:= ( index - low ) div 2 + low;
if ( att( mid ).at_mic < mic ) then
low:= mid + 1
else
index:= mid
end;
if ( att( index ).at_mic <> mic ) then
begin
find_att_elm:= false;
index:= index + ord( att( index ).at_mic < mic )
end
else
find_att_elm:= true
end
else
begin
find_att_elm:= false;
index:= 1
end
end (* find_att_el *);
\f
procedure place_att_elm(
index : at_table_ix;
atc_mic : integer;
pvc_ix : at_table_ix
);
(*---------------------------------------------------------------------
. This procedure makes place for an element in the att, if room for it
. and initialize it.
. Error => room := false.
----------------------------------------------------------------------*)
var
ix : at_table_ix;
att_entry : at_e;
begin
if ( index <= att_max ) then
begin
att_entry:= att( att_max + 1 );
for ix:= att_max downto index do
att( ix + 1 ):= att( ix );
att( index ):= att_entry
end;
with att(index) do
begin
at_mic := atc_mic;
pvc_index := pvc_ix;
traffic_count:= 0;
delay:= poll_delay_time;
actual_activity:= stop_code;
wanted_activity := stop_code
end;
att_max:= att_max + 1
end (* place_att_elm *);
\f
procedure del_att_elm(
index : at_table_ix
);
(*---------------------------------------------------------------------
. This procedure deletes an element in the att, referenced by index.
. Error => ???
----------------------------------------------------------------------*)
var
ix : at_table_ix;
att_entry : at_e;
begin
break( shadows( att( index ).shad_ix ), #h2f );
remove( shadows( att( index ).shad_ix ) );
att_entry:= att( index );
for ix := index to att_max - 1 do
att( ix ):= att( ix + 1 );
att( att_max ):= att_entry;
att_max := att_max - 1
end (* del_att_elm *);
\f
begin
(*------------ main program ------------*)
testopen( z, own.incname, op_sem );
testout( z, version, al_env_version );
(*------------ initialisation ------------*)
for att_index:= 1 to at_l do
with att( att_index ) do
begin
shad_ix:= att_index;
ts_vect_ix:= atc_sem_no + 2 * ( att_index - 1 )
end;
result_code:= create( "m_m_handler ",
mmh( op_sem,
sem( ath_int1 ),
sem( ath_sem_no ).s,
sem( timeout_sem_no ).s,
sem( com_pool ).w,
own_address,
att,
vcam,
att_max,
vcam_max,
node_test_freq
),
mmh_shadow,
mmh_stack
);
start( mmh_shadow, minpriority );
(*----------- link of atconnector ---------------*)
result_code:= link( "atconnector ", atconnector );
\f
(*------------ main repeat_loop-part ------------*)
repeat (* until terminate situation *)
(*------------ wait effectively on the input semaphore -------*)
wait( in_mes, sem( ath_sem_no ).w^ );
operation_code:= in_mes^.u4;
result_code:= accepted;
(*q if test then testout(z,"in_mes u3:",in_mes^.u3);
if test then testout(z," u4:",in_mes^.u4); q*)
(* supervision - not programmed yet *)
\f
with in_mes^ do
case u3 (* this is the routings information *) of
(* And then we handle the message depending on the receiver address.
*)
dummy_route:
return( in_mes )
;
at_route, at_route1: (* message from an ATC or from mmh *)
begin
lock in_mes as mes: alarmlabel do
with mes do
if ( rec.micro <> ath_mic_addr ) then
u2:= max_byte
else
u2:= ath_mic_addr
;
(*q if test then testout(z,"from an atc ",0); q*)
if ( u2 = ath_mic_addr ) then (* message to at handler *)
begin
case u4 of (* operation code *)
(* 01.02 *) #h12:
begin
return( in_mes );
testout( z, "garb return ", u3 )
end
;
\f
(* 04.05 *) #h45:
begin
lock in_mes as mes: alarmlabel do
with mes do
result_code:= result;
if not ( result_code in (.accepted, not_steering, unknown_sender.) ) then
signal( in_mes, sem( tssup_sem_no ).s^ )
end
;
(* 09.01 *) #h91:
return( in_mes )
;
(* 12.09 *) #hc9:
signal( in_mes, sem( ath_int1 ).s^ )
;
otherwise (* garbage from mmh or from atc *)
begin
testout( z, "garb receive", u4 );
reject_message( in_mes, own_address, ath_mic_addr, unknown_opcode, at_route );
signal( in_mes, sem( tssup_sem_no ).s^ ) (* ??? *)
end
end (* case u4 to at handler *)
;
end
else
\f
begin (* message from an at connector( or mmh ), to be routed through supervisor *)
case u4 of (* operation code *)
(* 00.01 *) #h01: (* obs!! the guard might be changed !! *)
lock in_mes as mes: alarm_form3 do
with mes, head do
begin
if ( ( 0 < ts_add( 0 ) ) and ( ts_add( 0 ) <= vcam_max ) and
( 0 < address.micro ) and ( address.micro <= vcam_max ) ) then
begin
rec:= actual_rec( ts_add( 0 ) );
address:= actual_rec( address.micro )
end
else
result_code:= unknown_receiver
end
;
(* 03.00 *) #h30,
(* 03.01 *) #H31,
(* 03.02 *) #h32:
lock in_mes as mes: alarmlabel do
with mes do
begin
(* change index to full address -
. and then signal and supervise
*)
if ( ( 0 < ts_add( 0 ) ) and ( ts_add( 0 ) <= vcam_max ) ) then
rec:= actual_rec( ts_add( 0 ) )
else
result_code:= unknown_receiver;
(* inconsistency between vc_address table in atc and vcavcm_table
- maybe because of a time dependent event *)
end
;
\f
(* 04.05 *) #h45:
;
(* 09.01 *) #h91:
lock in_mes as mes: alarm_form5 do
with mes, head do
if find_att_elm( send.micro, att_index ) then
if ( result = accepted ) then
with att( att_index ) do
wanted_activity:= update
;
otherwise
begin
(* No check here. But this block is used, when
. the following operation codes are met:
. 01.02
. 03.04 03.05
. 04.01
. 08.01 08.03 08.05
. 09.02 09.03
. 10.01
. 11.03 11.07 11.11 11.13
. 12.08 12.09
. unknown operation codes
*)
end (* otherwise *)
end (* case, with *)
;
signal( in_mes, sem( tssup_sem_no ).s^ )
end
end (* messages from an atc *)
;
\f
netc_route1: (* message from supervisor ( or from mmh ) to at handler *)
begin
case u4 of (* operation code *)
(* 01.02 *) #h12:
begin
testout( z, "garb return ", u3 );
return( in_mes )
end
;
(* 02.00 *)
(* 02.01 *)
(* 02.02 *)
(* 02.03 *)
(* 02.04 *)
(* 02.05 *)
(* 02.06 *)
(* 02.07 *) #h20..#h27: (* broadcast *)
signal( in_mes, sem( ath_int1 ).s^ )
;
(* 04.04 *) #h44:
begin
lock in_mes as mes: alarmlabel do
with mes do
result_code:= search_vca( vcam_index, send );
if ( result_code = accepted ) then
signal( in_mes, sem( ath_int1 ).s^ )
end
;
\f
(* 06.00 *) #h60:
(* creation of an at connector incarnation *)
lock in_mes as mes: alarm_form1 do
with mes, head, tail do
if ( send.macro <> dc_addr ) then
result_code:= forbidden
else
begin
if find_att_elm( atc_mic, att_index ) then
result_code:= existing_entry
else
if ( pvc_index in (.1..vca_vcm_l.) ) then
begin
place_att_elm( att_index, atc_mic, pvc_index );
(* make an unambigouos atc_name *)
atc_name:= "atc__ ";
atc_nb:= atc_mic;
alfa_pos:= 8;
repeat
atc_name( alfa_pos ):= chr( atc_nb mod 10 + ord( "0" ) );
atc_nb:= atc_nb div 10;
alfa_pos:= alfa_pos - 1
until ( alfa_pos = 4 );
(* create and start the incarnation *)
with att( att_index ) 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_nb + lam_sem_no ).s,
sem( timeout_sem_no ).s,
sem( com_pool ).w,
actual_activity,
delay,
node_test_freq,
traffic_count,
dc_addr,
own_address,
atc_mic,
port_nb
),
shadows( shad_ix ),
atc_size ) );
if ( result_code = accepted ) then
start( shadows( att( att_index ).shad_ix ), atc_pri )
else
begin
del_att_elm( att_index );
result_code:= breaked
end
end
else
result_code:= out_of_range
end
;
(* 06.08 *) #h68:
lock in_mes as mes: alarm_form1 do
with mes, head, tail do
if ( send.macro <> dc_addr ) then
result:= forbidden
else
begin
if find_att_elm( atc_mic, att_index ) then
begin
if ( att( att_index ).wanted_activity <> stop_code ) then
result_code:= not_ready
else
del_att_elm( att_index )
end
else
result_code:= not_found
end
;
\f
(* 10.10 *) #haa:
lock in_mes as mes: alarm_form2 do
with mes, head, tail do
if ( send.macro <> dc_addr ) then
result_code:= forbidden
else
case update of
insert_code:
if ( vcam_max = vca_vcm_l ) then
result_code:= no_room
else
ins_vcam_elm( vca_addr, vcm_addr, vc_index, result_code )
;
modify_code:
ins_vcam_elm( vca_addr, vcm_addr, vc_index, result_code )
;
remove_code:
begin
ins_vcam_elm( empty_addr, empty_addr,
(**) vc_index, result_code );
if ( vcam_max = vc_index ) and ( result_code = accepted ) then
while ( 0 < vcam_max ) and ( vcam( vcam_max ).vca_addr = empty_addr ) do
vcam_max:= vcam_max - 1
end
;
otherwise
result_code:= unknown_update
end
;
(* 12.00 *) #hc0,
(* 12.09 *) #hc9:
signal( in_mes, sem( ath_int1 ).s^ )
;
\f
otherwise
begin
reject_message( in_mes, own_address, ath_mic_addr, unknown_opcode, at_route );
signal( in_mes, sem( tssup_sem_no ).s^ )
end
end (* case u4 to at handler *)
;
if not nil( in_mes ) then
begin
receipt_message( in_mes, at_route, result_code );
signal( in_mes, sem( tssup_sem_no ).s^ )
end
end (* message from supervisor to at handler *)
;
\f
netc_route: (* message to an at connector *)
begin
(*q if test then testout(z,"to an atc ",0); q*)
lock in_mes as mes: alarmlabel do
with mes do
begin
if find_att_elm( rec.micro, att_index ) then
case u4 of (* operation code *)
(* 04.00 *) #h40,
(* 04.04 *) #h44:
with att( att_index ) do
begin
(* steering *)
(* Find and add vc_index *)
(* First check, if pvc_index is usable *)
if ( actual_rec( pvc_index ) <> send ) then
result_code:= forbidden; (* not usable *)
if ( result_code <> accepted ) then
result_code:= search_vca( vcam_index, send );
if ( result_code = accepted ) then
ts_add( 0 ):= vcam_index
end (* steering, with *)
;
\f
(* 08.04 *) #h84: (* extern test *)
with att( att_index ) do
begin
(* check the legatimacy *)
if ( actual_rec( pvc_index ) <> send ) then
result_code:= forbidden (* invalid *)
else
mes.ts_add( 0 ):= pvc_index
end
;
otherwise
(*
. 08.00 08.02
. 09.00 09.02
. 10.00
. 11.02 11.04 11.06 11.10 11.12
. 12.08 12.09
*)
end (* case operation code *)
else
result_code:= not_found
end (* lock, with *)
;
\f
if ( result_code <> accepted ) then
begin
if ( operation_code <> #h44 ) then
begin
receipt_message( in_mes, at_route, result_code );
signal( in_mes, sem( tssup_sem_no ).s^ )
end
else
return( in_mes )
end
else
signal( in_mes, sem( att( att_index ).ts_vect_ix ).s^ )
end (* message from supervisor to an at connector *)
;
otherwise
begin
(*q test := not test;
if test then testout(z,"starttestout",0);
if not test then testout(z,"stop testout",0); q*)
reject_message( in_mes, own_address, ath_mic_addr, unknown_route, at_route );
signal( in_mes, sem( tssup_sem_no ).s^ )
end (* otherwise *)
;
end (* case - upon routings information - with in_mes^ *)
until false (* terminate situations isn't specified yet *);
end (* main program *).
(* end of file *)
«eof»