|
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: 79104 (0x13500)
Types: TextFileVerbose
Names: »newdcs«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »newdcs«
job nla 6 200 area 12 size 100000 time 19 59 temp disc 4000 30 perm disc1 800 11
( mode list.yes
source = copy 25.1
tsdcslst=set 170 disc1
outlist = indent source mark lc
crosslist = cross outlist
clear temp outlist
dcserrors = set 1 disc1
o dcserrors
pascal80 codesize.12000 alarmenv source
o c
scope user dcserrors
tsdcslst=copy crosslist dcserrors
scope user tsdcslst
lookup pass6code
if ok.yes
( tsdcsbin=set 1 disc1
tsdcsbin=move pass6code
scope user tsdcsbin)
finis )
process dcmodule(
op_sem : sempointer;
var
lam_sem ,
tsc_sem ,
com_sem ,
timeout_sem : !sempointer;
var
input_sem ,
queue_sem ,
timeout_answer_sem ,
lam_talk_sem : !ts_pointer);
const
version = "vers 3.17 /";
(*---------------------------------------------------------------------
- -
- DC-MODULE is used in the demonstrationmodel to simulate some -
- dc-functions from a TTY connected to RC3502. -
- -
----------------------------------------------------------------------*)
(*
function
--------
acts as dc for the ts-connectors.
i.e. it has two main functions
1. to interact with the operator at the tty, receiving commands
and sending receipts
2. to log messages at the tty.
requests from ts-connectors
---------------------------
u2 = not used
u3 = dc_route
u4 = operationcode
\f
messages from ts-connector
--------------------------
. 00.00 00.02
. 03.01 03.02 03.04 03.05
. 06.01
. 07.01
. 08.01 08.03
. 09.01
. 10.01 10.03 10.11
. 11.01
messages to ts-connector
------------------------
. 06.00 06.02 06.04
. 07.00
. 08.00 08.02
. 09.00
. 10.00 10.02 10.10
. 11.00
\f
tables operated from dc
-----------------------
ac-address-table :
operated by messtype 10.0
ac-address-code : byte
ac-index : integer
block : byte ( always 1 in demo )
steering : boolean
at-address-table :
operated by messtype 10.2
at-address : alarmnetaddress
at-code : byte
sac-rac-table :
operated by messtype 10.10
sac-address : alarmnetaddress
rac-address : alarmnetaddress (always 0 in demo )
\f
possible commands from dc
-------------------------
afl{s transmissionsfejlt{ller <adresse>
afl{s pakket{ller <adresse>
afl{s servicegr{nse <adresse>
afl{s aktuel modtagervagtcentral <adresse>
afl{s stop poll gr{nse <adresse>
afl{s max succ liniefejl <adresse>
fjern alternativ vagtcentral <vagt-adresse> <at-adresse> <aac-kode>
inds{t alternativ vagtcentral <vagt-adresse> <at-adresse> <aac-kode> <styretilladelse>
log ja
log nej
nedl{g dc
opret alarmterminal <at-adresse> <at-kode> <port> <pac-adresse>
opret vagtcentral <ac-adresse> <ac_kode> <port>
opret terminalstation <nc-nummer> <ts-nummer>
service poll <adresse> <poll-interval>
start poll <adresse> <poll-interval>
stop poll <adresse>
s{t transmissionsfejlt{ller <adresse> til <v{rdi>
s{t servicegr{nse <adresse> til <v{rdi>
s{t stop poll gr{nse <adresse> til <v{rdi>
s{t max succ liniefejl <adresse> til <v{rdi>
test alarmterminal <adresse> <testnummer>
test vagtcentral <adresse> <testnummer>
distriktscenter nummer <dist-nummer>
klokken er nu <hh> <mm>
hj{lp
*)
\f
const
max_locals = 6;
max_lam_bufs = 13;
linelength = 80;
firstindex = 1;
lastindex = firstindex + (linelength - 1);
base = 10; (* number base for input and output *)
my_dc_route = op_route;
max_no_dc = 1;
max_no_ts = 2;
max_no_ac = vc_l + 1;
max_no_at = at_l + 1;
max_params = 20;
empty_addr = alarmnetaddr( macroaddr( 0, 0, 0 ), 0 );
type
alpha_lth = 1..alfalength;
param_range = 1..max_params;
int_position = 0..20;
half_byte = 0..15;
state_range = 0..7;
extern_px_addr = packed array( 1..14 ) of 0..15;
state_set = set of state_range;
px_db_ix = 0..max_no_ts;
ts_db_ix = 1..max_no_ts;
ac_db_ix = 1..max_no_ac;
at_db_ix = 1..max_no_at;
\f
(*-------------- strings ------------------*)
const
zero = "0";
ch_star = "*";
ch_lt = "<";
ch_gt = ">";
ch_slash = "/";
txt_from = "fra";
txt_to = "til";
txt_of = "af";
txt_dis = "dis";
txt_at = "AT";
txt_ac = "VC";
txt_aac = "aVC";
txt_rac = "VCm";
txt_ts = "TS";
txt_dc = "DC";
txt_pax = "PAX";
txt_alarm = "alarm";
txt_log = "log";
txt_rej = "afvist";
txt_rec = "modtaget";
txt_receipt = "kvitteret";
txt_table = "tabel:";
txt_create = "opret";
txt_start = "start";
txt_stop = "stop";
txt_service = "service";
txt_line = "linje";
txt_state = "status";
txt_au = "au";
txt_steer = "styring";
txt_test = "test";
\f
txt_package = "pakke";
txt_counter = "t{ller";
txt_limit = "gr{nse";
txt_actual = "aktuel";
txt_poll = "poll";
txt_recall = "afmeldt";
time_out = "time out";
txt_hs = "handshake";
txt_serif = "serif";
txt_restart = "genstart";
txt_battery = "batteri";
txt_220_ac = "220 V";
txt_accepted = "udf|rt";
txt_refused = "afsl}et";
txt_range = "range";
txt_granted = "tilladt";
txt_finish = "afsluttet";
txt_delivered = "afleveret";
txt_read = "afl{s";
txt_insert = "inds{t";
txt_modify = "modificer";
txt_remove = "fjern";
txt_connected = "connected";
txt_result = "*resultat";
txt_ok = "ok";
txt_error = "fejl";
txt_undef = "udefineret";
txt_known = "kendt";
txt_unknown = "ukendt";
txt_busy = "busy";
\f
txt_send = "sendt";
txt_msg = "meddelelse";
txt_enter = "angiv";
txt_number = "nummer";
txt_star = "***";
txt_no = " #";
txt_port = "port";
txt_db = "db*";
txt_param = "params";
txt_cmmnd = "kommando";
txt_request = "foresp|rgsel";
txt_ovf = "ovflow";
txt_org = "oprindelig";
txt_addr = "adresse";
txt_group = "gruppe";
\f
(****************** types ********************************)
type
dcbuftype
= record
first,
last,
next: integer;
data: array (firstindex..lastindex) of char
end;
logmesstype
= record
a_label : alarmlabel;
fill : integer;
old_label : alarmlabel;
data : array ( 1..( 2 * size_supp - ( 2 * label_size + 2 ) ) ) of byte
end;
logstatustype
= record
a_label : alarmlabel;
fill : integer;
old_label : alarmlabel;
state : state_set
end;
alarmmesstype
= record
a_label : alarmlabel;
a_code : byte;
end;
statusalarmtype
= record
a_label : alarmlabel;
state : state_set
end;
\f
log02type
= record
a_label : alarmlabel;
at_adr : alarmnetaddr;
d_op_code : byte;
a_code : byte;
end;
receipttype
= record
r_label : alarmlabel;
mic : integer;
pac_adr: alarmnetaddr;
end;
lambuftype
= record
controle_byte: byte;
timeout: byte;
end;
mess_12_type
= record
a_label,
old_label : alarmlabel
end;
mess_2x_type
= record
a_label : alarmlabel;
node: alarmnetaddr
end;
\f
receipt_101_type
= record
a_label: alarmlabel;
ac_addr_tab: vc_addr_e;
end;
mess_102_type
= record
a_label : alarmlabel;
at_addr_tab : at_addr_e
end;
receipt_103_type
= record
r_label: alarmlabel;
at_addr_tab: at_addr_e;
end;
\f
receipt_1011_type
= record
a_label: alarmlabel;
ac_index: integer;
sac_rac_tab: vca_vcm_e;
end;
mess_60_type
= record
a_label: alarmlabel;
at_mic: integer;
lam_num: byte;
port_num: byte;
sac_rac_index: integer;
end;
mess_62_type
= record
a_label: alarmlabel;
at_adr: alarmnetaddr;
end;
mess_70_type
= record
a_label: alarmlabel;
ac_mic: integer;
ac_typ: byte;
lam_num: byte;
port_num: byte;
end;
mess_90_type
= record
a_label: alarmlabel;
trans_err: integer;
poll_int : integer;
end;
mess_98_type
= record
a_label : alarmlabel;
msg_text : alfa
end;
\f
mess_104_type
= record
a_label : alarmlabel;
ts_e : at_ts_e
end;
mess_106_type
= record
a_label : alarmlabel;
vcm_at_e : vcmat_e
end;
mess_1010_type
= record
a_label : alarmlabel;
sac_rac_index : integer;
sac_addr : alarmnetaddr;
rac_addr : alarmnetaddr;
end;
mess_1012_type
= record
a_label : alarmlabel;
pax_tbl_ix : integer;
al_mac_addr : macroaddr;
ext_pax_address : extern_px_addr;
stream_no ,
max_retrans : byte
end;
\f
mess_110_type
= record
a_label: alarmlabel;
tss_macro: macroaddr;
xx: integer;
dc_ts_macro: macroaddr;
end;
mess_11x_type
=record
a_label : alarmlabel;
counter : integer;
end;
mess_119_type
= record
a_label : alarmlabel;
act_rac : alarmnetaddr;
end;
mess_12_00_type
= record
a_label : alarmlabel;
counter ,
nt_freq : integer
end;
\f
const
no_request = 3;
removing = 4;
creating = 5;
type
current_activity = start_code..service_code;
pending_request = start_code..creating;
at_db_e = record
at_addr : alarmnetaddr;
at_code : byte;
at_state : state_set;
activity : current_activity;
dc_request ,
ac_request : pending_request;
poll_delay : integer;
lam_port : half_byte;
no_ac_e : 0..max_no_ac;
ac_indxs : array ( ac_db_ix ) of ac_db_ix;
ac_codes : array( ac_db_ix ) of byte;
ts_indx : ts_db_ix
end;
ac_db_e = record
ac_addr : alarmnetaddr;
ac_code : byte;
ts_indx : ts_db_ix;
lam_port : half_byte;
ac_state : state_set;
activity : current_activity;
ac_request ,
dc_request : pending_request;
poll_delay : integer
end;
\f
ts_db_e = record
ts_address : macroaddr;
ports_used : set of half_byte;
no_sac_e : 0..max_no_ac;
sac_rac_s : array( ac_db_ix ) of vca_vcm_e;
nt_receipt ,
disconnected : boolean
end;
px_db_e = record
mac_address : macroaddr;
fe_ix : integer;
max_no_retrans : byte;
ext_px_addr : extern_px_addr
end;
\f
(*--------- pools ---------------------------------*)
var
timeout_pool : pool 1 of integer;
book_up_pool : pool 1 of updates;
gettime_pool : pool 1 of ts_time;
lam_buf_pool : pool max_lam_bufs of dcbuftype;
(*--------- references -----------------------------*)
timeout_msg ,
book_up_msg ,
gettime_msg ,
output_to_dc , (* ref to buffer to dc *)
inref , (* ref to buffer from ts-connector or dc *)
tsc_listen_ref (* ref to listen-buffer *)
: reference;
\f
(*--------- integers -------------------------------*)
w_px_ix ,
px_ix : px_db_ix := 0;
ts_ix : ts_db_ix := 1;
ac_ix : ac_db_ix := 1;
at_ix : at_db_ix := 1;
sac_rac_ix : ac_db_ix := 1;
no_of_dc : 0..max_no_dc := 0;
no_of_ts : 0..max_no_ts := 0;
no_of_ac : 0..max_no_ac := 0;
no_of_at : 0..max_no_at := 0;
incharsleft , (* no. of not yet read chars in opinbuffer *)
no_digits : integer := 0;
noofparams (* no. of params in operator line *)
: 0..max_params := 0;
nt_time : integer := nt_default;
(*--------- booleans -------------------------------*)
(*q test_b : boolean := true; q*)
nt_on : boolean := false;
log_off : boolean := false;
readok (* indicates if the last call of readinteger
yielded a result *)
: boolean;
(*--------- arrays --------------------------------*)
params : array( param_range ) of integer; (* holds parameters from operator *)
overflows : packed array( param_range ) of boolean;
command1 ,
command2 : alfa;
px_db : array( px_db_ix ) of px_db_e;
ts_db : array ( ts_db_ix ) of ts_db_e;
at_db : array ( at_db_ix ) of at_db_e;
ac_db : array ( ac_db_ix ) of ac_db_e;
(*------ other variables ------------------------*)
opzone : zone;
opr_code : byte;
dc_macro : macroaddr := macroaddr( 0, 0, 0 );
\f
(*--------- external declarations ---------------------*)
procedure timerbook(
var
book_msg ,
timeout_msg : reference;
time ,
object : integer;
var
timeout_sem ,
answer_sem : semaphore
); external;
procedure timerupdate(
var
update_msg : reference;
time : integer;
var
answer_sem : semaphore
); external;
\f
(*--------- forward declarations --------------------*)
procedure getparams;
forward;
procedure outinteger( fill: char; int: integer; position: int_position );
forward;
procedure outstring( no_of_chars: alpha_lth; text: alfa );
forward;
function readchar: char;
forward;
function readinteger ( var overflow: boolean ): integer;
forward;
procedure newline;
forward;
procedure getcommand( var command: alfa );
forward;
procedure skipdelimiters;
forward;
procedure start_new_line;
forward;
procedure start_com_line;
forward;
function addr( mac: macroaddr; mic: integer ): alarmnetaddr;
forward;
function packmacro( dc_num, nc_num, ts_num: integer ): macroaddr;
forward;
function packaddr( index: param_range ): alarmnetaddr;
forward;
\f
procedure write_error( error1, error2, param: integer );
begin
case error1 of
1:
outstring( 3, txt_ac )
;
2:
outstring( 3, txt_at )
;
3:
outstring( 3, txt_ts )
;
4:
outstring( 5, txt_port )
;
5:
outstring( 3, txt_no )
;
6:
outstring( 3, txt_star )
;
otherwise
end
;
case error2 of
1:
outstring( 6, txt_known )
;
2:
outstring( 7, txt_unknown )
;
3:
outstring( 7, txt_limit )
;
4:
outstring( 4, txt_db )
;
5:
outstring( 9, txt_cmmnd )
;
6:
outstring( 6, txt_param )
;
7:
outstring( 5, txt_param )
;
8:
outstring( 6, txt_range )
;
9:
outstring( 5, txt_busy )
;
10:
outstring( 11, txt_undef )
;
11:
outstring( 7, txt_ovf )
;
otherwise
end;
outinteger( sp, param, 3 )
end; (* procedure write_error *)
\f
(*--------- checkfunctions --------------------------*)
function at_num_ok( at_num:integer ):boolean;
(*------ check for valid at-number -------------------*)
begin
at_num_ok:=(at_num>=256) and (at_num<=9999);
end;
function ac_num_ok( ac_num: integer ): boolean;
(*------ check for valid ac-number -------------------*)
begin
ac_num_ok:=(ac_num>=vc_addr_limit) and (ac_num<at_addr_limit);
end;
function aac_code_ok( aac_code: integer ): boolean;
(*------ check for valid aac code --------------------*)
begin
aac_code_ok:=(aac_code>=0) and (aac_code<=255);
end;
function range_ok( first, last: param_range; min, max: integer ): boolean;
var
ok : boolean := true;
ix : param_range;
begin
ix:= first;
repeat
ok:= ok and ( min <= params( ix ) ) and ( params( ix ) <= max );
ix:= ( ix mod last ) + 1
until ( not ok ) or ( ix = 1 );
range_ok:= ok
end; (* function range_ok *)
\f
function macro_ok( p1, p2, p3: integer ): boolean;
(*------------------------------------------------
. checks for valid macroaddress
. i e checks if the macroaddress is an existing
. ts-address
--------------------------------------------------*)
begin
macro_ok:=
( 0 <= p1 ) and ( p1 <= 15 )
and
( 0 <= p2 ) and ( p2 <= 63 )
and
( 0 <= p3 ) and ( p3 <= 63 )
end;
\f
function at_addr_ok( index: param_range ): boolean;
(*------ check for valid at-address ---------------------*)
begin
at_addr_ok:=
macro_ok( params( index ), params( index + 1 ), params( index + 2 ) )
and
at_num_ok( params( index + 3 ) )
end;
function ac_addr_ok( index: param_range ): boolean;
(*------ check for valid ac-address ---------------------*)
begin
ac_addr_ok:=
macro_ok( params( index ), params( index + 1 ), params( index + 2 ) )
and
ac_num_ok( params( index + 3 ) )
end;
\f
function addr_ok( index: param_range ): boolean;
(*-------------------------------------------------------
. check for valid address
---------------------------------------------------------*)
begin
if at_addr_ok( index ) or ac_addr_ok( index ) then
addr_ok:= true
else
begin
addr_ok:= false;
outstring( 5, txt_range )
end
end;
\f
function params_ok( params: param_range ): boolean;
(*----------------------------------------------------
. check that the parameters can be packed into an
. integer array
------------------------------------------------------*)
var
i: param_range := 1;
begin
if ( params <> noofparams ) then
write_error( 5, 6, params )
else
begin
while ( i < noofparams ) and ( not overflows( i ) ) do
i:=i+1;
if overflows( i ) then
write_error( 6, 11, i )
end;
params_ok:= ( not overflows( i ) ) and ( params = noofparams )
end; (* params_ok *)
\f
procedure read_at_dc;
(*---------------------------------------------
. sends a read-tty-buffer to lam-driver
. if there is one at inref
-----------------------------------------------*)
begin
inref^.u2 := dcm_in_port;
lock inref as dcbuf: dcbuftype do
dcbuf.next := firstindex;
start_com_line;
signal( inref, lam_sem^ )
end;
\f
procedure getinput;
(********************************************************
* *
* reads input from buffer at inref *
* *
*********************************************************)
begin
lock inref as dcbuf: dcbuftype do
with dcbuf do
begin
incharsleft:= next - first;
next:= firstindex
end;
skipdelimiters;
getcommand( command1 );
skipdelimiters;
getcommand( command2 );
getparams
end (* getinput *);
\f
procedure getparams;
(*******************************************************
* *
* reads integer parameters in buffer at dcinbuf *
* *
*******************************************************)
var
overflow: boolean;
begin
noofparams:= 0;
repeat
noofparams:= noofparams + 1;
params( noofparams ):= readinteger( overflow );
overflows( noofparams ):= overflow
until ( not readok ) or ( noofparams = max_params );
noofparams:= noofparams - 1
end (* getparams *);
\f
procedure getoutputbuf;
(**********************************************
* gets an outputbuffer from lam_talk_sem *
***********************************************)
begin
repeat
wait( output_to_dc, lam_talk_sem.w^ );
if ( output_to_dc^.u3 = dummy_route ) then
return( output_to_dc )
until not nil( output_to_dc );
lock output_to_dc as dcbuf: dcbuftype do
dcbuf.last:= firstindex - 1;
output_to_dc^.u2:= dcm_out_port
end;
\f
procedure outchar( ch: char );
(*******************************************************
* *
* writes ch into the buffer pointed to by output_to_dc *
* *
********************************************************)
var
buffull : boolean;
begin
if nil( output_to_dc ) then getoutputbuf;
lock output_to_dc as dcbuf: dcbuftype do
with dcbuf do
begin
last:= last + 1;
data (last):= ch;
buffull:= ( last >= lastindex )
end;
if buffull then signal( output_to_dc, lam_sem^ )
end (* outchar *);
\f
procedure space( no_of_sp: integer );
var
i: integer;
begin
for i:= 1 to no_of_sp do
outchar( sp )
end; (* procedure space *)
\f
procedure outinteger( fill: char; int: integer; position: int_position );
(*******************************************************
* *
* writes int into dcbuf starting at last and filling *
* positions. *
* *
********************************************************)
const
maxpos = 20; (* max number of positions in layout *)
var
pos : int_position;
digits : array( int_position ) of char;
begin
pos:= position;
if ( int < 0 ) then
outchar( "-" );
repeat
(* now we unpack the digits backwards and put them
into the digits array, starting at position *)
digits( pos ):= chr( abs( int mod base ) + ord( zero ) );
int:= int div base;
pos:= pos - 1
until ( pos = 0 ) or ( int = 0 );
for pos:= pos downto 1 do
digits( pos ):= fill;
for pos := 1 to position do
outchar( digits( pos ) );
if ( int <> 0 ) then
outchar( ch_star )
end (* procedure outinteger *);
\f
procedure outstring( no_of_chars: alpha_lth; text: alfa );
var
i : alpha_lth;
begin
for i:= 1 to no_of_chars do
outchar( text( i ) )
end; (* procedure outstring *)
\f
function readchar: char;
(****************************************************
* reads the next char from inref^. *
* next is incremented and charsleft is decremented *
*****************************************************)
begin
lock inref as dcbuf: dcbuftype do
with dcbuf do
begin
readchar:= data( next );
next:= next + 1
end;
incharsleft:= incharsleft - 1
end (* readchar *);
\f
function readinteger ( var overflow: boolean ): integer;
(****************************************************
* reads the next integer from input_from_dc^ starting
* at "inputpoint". upon return "inputpoint" will be
* the position just after the last char read.
* the global boolean "readok" will be true if an
* integer was read and false otherwise
*****************************************************)
type
maxnumber = array(1..5) of char;
const
digits = (. zero .. "9" .);
o_limit = maxnumber("3","2","7","6","7");
var
negative : boolean;
digit: boolean := false;
curdigit,
result: integer;
o_digits : maxnumber;
ch, lastchar: char := nul;
\f
procedure ovflow;
begin
overflow:= true;
digit:= false;
repeat
ch:= readchar
until ( not( ch in digits)) or ( incharsleft <= 0 )
end;
\f
procedure digitcheck;
var
i : integer := 0;
continue : boolean;
begin
repeat
i:= i + 1;
continue:=o_digits( i ) = o_limit( i )
until ( i = 5 ) or not continue;
if o_digits( i ) > o_limit( i ) then ovflow
end;
\f
begin (* readinteger *)
readok:= false;
overflow:= false;
(* now skip until a digit is encountered *)
if incharsleft > 0 then
repeat
lastchar:= ch;
ch:= readchar;
digit:= (ch in digits)
until digit or ( incharsleft <= 0 ) or ( ch = cr );
result:=0;
negative:= lastchar="-";
if digit then
begin
result:= ord (ch) - ord (zero);
readok:= true;
no_digits:= 1;
o_digits( 1 ):= ch
end;
\f
while digit and (incharsleft>0) do
begin (* read the digits *)
ch:= readchar;
digit:= ch in digits;
if digit then
begin
no_digits:= no_digits + 1;
o_digits( no_digits ):= ch;
if no_digits > 5 then ovflow
else
if no_digits = 5 then digitcheck;
if not overflow then
if negative and ( result = 3276 ) and ( ch ="8" ) then
begin
result:= -32768;
negative:= false;
end
else
result:= result * base + ( ord( ch ) - ord( zero ) )
end;
end (* while *) ;
if incharsleft > 0 then
begin
(* we read one char too many - spit it out *)
lock inref as dcbuf: dcbuftype do
dcbuf.next := dcbuf.next - 1;
incharsleft:= incharsleft + 1
end;
readinteger:=result
end (* read integer *);
\f
procedure newline;
begin
outchar( cr );
outchar( nl )
end;
\f
procedure writeaddress( fch: char; sender: alarmnetaddr; lch: char );
(*************************************************
* writes alarmnet addressaddress on dc-console *
*************************************************)
begin
with sender, macro do
begin
outchar( fch );
outinteger( zero, macro.dc_addr, 2 );
outchar( sp );
outinteger( zero, macro.nc_addr, 2 );
outchar( sp );
outinteger( zero, macro.ts_addr, 2 );
outchar( sp );
outinteger( zero, micro, 4 );
outchar( lch )
end
end (* writeaddress *);
\f
procedure write_to_from( rec, send: alarmnetaddr );
begin
outstring( 3, txt_to );
writeaddress( sp, rec, sp );
outstring( 3, txt_from );
writeaddress( sp, send, ":" );
outchar( sp )
end; (* procedure write_to_from *)
\f
procedure write_param( param: integer; pos: int_position );
begin
outchar( ch_lt );
outinteger( sp, param, pos );
outchar( ch_gt )
end; (* procedure write_param *)
\f
procedure writeresult( result: result_range );
(************************************************
* writes resultcode as text on dc-console *
*************************************************)
begin
outchar( sp );
case result of
accepted:
outstring( 6, txt_accepted );
not_accepted:
outstring( 7, txt_refused );
state_error:
outstring( 6, txt_state );
otherwise
begin
outstring( 10, txt_result );
outinteger( sp, result, 2 )
end
end;
outchar( sp )
end; (* procedure writeresult *)
\f
procedure write_table_update( upd: update_range );
begin
outstring( 7, txt_addr );
outstring( 7, txt_table );
case upd of
insert_code:
outstring( 7, txt_insert );
modify_code:
outstring( 10, txt_modify );
remove_code:
outstring( 6, txt_remove );
otherwise
outstring( 11, txt_undef )
end
end; (* procedure write_table_update *)
\f
procedure write_param_update( upd: update_range );
begin
case upd of
read_code:
outstring( 6, txt_read );
insert_code:
outstring( 7, txt_insert );
modify_code:
outstring( 10, txt_modify );
otherwise
outstring( 11, txt_undef )
end
end; (* procedure write_param_update *)
\f
procedure write_at_activity( act: update_range );
begin
case act of
start_code:
outstring( 6, txt_start )
;
stop_code:
outstring( 5, txt_stop )
;
service_code:
outstring( 8, txt_service )
;
otherwise
outstring( 11, txt_undef )
end;
outstring( 5, txt_poll )
end; (* procedure write_at_activity *)
\f
procedure write_state(
new_state : state_set;
var
current_state : state_set );
var
state_bit : state_range;
work_set : state_set;
begin
work_set:= new_state + current_state - (.0.);
outstring( 6, txt_state );
outstring( 6, txt_alarm );
outchar( ch_lt );
for state_bit:= 1 to 7 do
if state_bit in work_set then
begin
case state_bit of
1:
outstring( 9, time_out )
;
2:
outstring( 10, txt_hs )
;
3:
outstring( 3, txt_au )
;
4:
outstring( 6, txt_serif )
;
5:
outstring( 9, txt_restart )
;
6:
outstring( 8, txt_battery )
;
7:
outstring( 6, txt_220_AC )
;
otherwise
end; (* case *)
\f
if not ( state_bit in (.1, 5.) ) then
begin
if state_bit in new_state then
begin
current_state:= current_state + (.state_bit.);
outstring( 4, txt_error )
end
else
begin
current_state:= current_state - (.state_bit.);
outstring( 2, txt_ok )
end
end;
work_set:= work_set - (.state_bit.);
if work_set <> (..) then
outchar( ch_slash )
else
outchar( ch_gt )
end;
outchar( sp )
end; (* procedure write_state *)
\f
procedure write_line_state( state: update_range );
begin
outchar( ch_lt );
case state of
recall:
outstring( 7, txt_recall )
;
call:
outstring( 4, txt_error )
;
at_tim_excess:
outstring( 8, time_out )
;
otherwise
outstring( 10, txt_undef )
end;
outchar( ch_gt )
end; (* procedure write_line_state *)
\f
procedure write_op_code( op_code: byte );
begin
outinteger( zero, op_code div 16, 2 );
outchar(".");
outinteger( zero, op_code mod 16, 2 );
outchar( sp )
end;
\f
procedure unknown_msg( var msg: reference );
begin
lock msg as m: alarmlabel do
with m do
begin
write_op_code( msg^.u4 );
outstring( 3, txt_from );
writeaddress( sp, send, sp );
writeresult( result )
end (* lock *)
end; (* procedure unknown_msg *)
\f
procedure settime ( hh, mm : integer );
(************************************************
* sets time at timeoutmodule *
*************************************************)
begin
gettime_msg^.u1:=5;
lock gettime_msg as buf: ts_time do
begin
buf( 0 ):= hh;
buf( 1 ):= 100 * mm
end;
signal ( gettime_msg, timeout_sem^ );
repeat
wait( gettime_msg, timeout_answer_sem.w^ );
if ( gettime_msg^.u3 = dummy_route ) then
return( gettime_msg )
until not nil( gettime_msg );
gettime_msg^.u1:= 2
end;
\f
function gettime : ts_time;
(***********************************************
* gets the actual time at timeout-module *
************************************************)
begin
signal( gettime_msg, timeout_sem^ );
repeat
wait( gettime_msg, timeout_answer_sem.w^ );
if ( gettime_msg^.u3 = dummy_route ) then
return( gettime_msg )
until not nil( gettime_msg );
lock gettime_msg as buf: ts_time do
begin
buf( 0 ):= abs( buf( 0 ) mod 100 );
buf( 1 ):= abs( buf( 1 ) mod 10000 );
gettime := buf
end
end;
\f
procedure writetime( time: ts_time );
(**************************************************
* writes sender- or dc- time on dc-console *
**************************************************)
begin
newline;
outchar(sp);
if ( time( 0 ) > 23 ) or ( ( time( 1 ) div 100 ) > 59 ) then
outstring( 8, txt_star )
else
begin
outinteger( zero, time( 0 ), 2 );
outchar(".");
outinteger( zero, time( 1 ) div 100, 2 );
outchar(".");
outinteger( zero, time( 1 ) mod 100, 2 )
end;
space(2)
end (* writetime *);
\f
procedure skipdelimiters;
(************************************************
* skips all the following delimiters *
*************************************************)
const
delimiters = (.sp.."@".);
begin
while ( readchar in delimiters ) and ( incharsleft > 0 ) do
;
if incharsleft > 0 then
lock inref as dcbuf: dcbuftype do
dcbuf.next:= dcbuf.next - 1;
incharsleft:= incharsleft + 1
end;
\f
procedure getcommand( var command: alfa );
(***************************************************
* gets of command from inref *
****************************************************)
const
valids = (."a".."}", "0".."9".);
var
i : alpha_lth := 1;
begin
command( 1 ):= readchar;
while ( i < alfalength ) and ( command( i ) in valids ) and ( incharsleft > 0 ) do
begin
i:= i + 1;
command( i ):= readchar
end
end; (* procedure getcommand *)
\f
function packmacro( dc_num, nc_num, ts_num: integer ): macroaddr;
(*************************************************
* packs macroaddress into one integer *
**************************************************)
begin
packmacro.dc_addr:= dc_num;
packmacro.nc_addr:= nc_num;
packmacro.ts_addr:= ts_num
end;
\f
procedure build_alarm_label(
no_by : integer;
receiver_addr : alarmnetaddr;
route ,
opr_code : byte;
upd_code : update_range );
(*-------------------------------------------------------
. 1. builds a complete alarmlabel in the listenbuffer
. 2. returns the listenbuffer,
. i e it should be called as the last operation on
. a buffer
---------------------------------------------------------*)
begin
lock tsc_listen_ref as l: alarmlabel do
with l do
begin
no_of_by:= label_size + no_by;
rec:= receiver_addr;
send:= addr( dc_macro, 0 );
op_code:= opr_code;
update:= upd_code;
result:= accepted
end;
with tsc_listen_ref^ do
begin
u3:= route;
u4:= opr_code
end;
signal( tsc_listen_ref, tsc_sem^ );
wait( tsc_listen_ref, com_sem^ )
end;
\f
function packaddr( index: param_range ): alarmnetaddr;
(*********************************************
* packs alarmnetaddr into two integers *
**********************************************)
begin
packaddr.macro.dc_addr:= params( index );
packaddr.macro.nc_addr:= params( index + 1 );
packaddr.macro.ts_addr:= params( index + 2 );
packaddr.micro:= params( index + 3 )
end;
\f
function addr( mac: macroaddr; mic: integer ): alarmnetaddr;
begin
addr.macro:= mac;
addr.micro:= mic
end;
\f
function find_ac( var ac_ix: ac_db_ix; ac: alarmnetaddr ): boolean;
begin
ac_ix:= 1;
while ( ac <> ac_db( ac_ix ).ac_addr ) and ( ac_ix < max_no_ac ) do
ac_ix:= ac_ix + 1;
find_ac:= ( ac = ac_db( ac_ix ).ac_addr )
end; (* function find_ac *)
\f
function find_sac_entry( var sac_rac_ix: ac_db_ix; ts_ix: ts_db_ix;
ac: alarmnetaddr ): boolean;
begin
sac_rac_ix:= 1;
with ts_db( ts_ix ) do
begin
while ( sac_rac_ix < max_no_ac ) and ( ac <> sac_rac_s( sac_rac_ix ).vca_addr ) do
sac_rac_ix:= sac_rac_ix + 1;
find_sac_entry:= ( ac = sac_rac_s( sac_rac_ix ).vca_addr )
end
end;
\f
procedure init_ts_db_e ( ts_ix: ts_db_ix );
begin
with ts_db( ts_ix ) do
begin
ts_address := macroaddr(0,0,0);
ports_used:= (.0.);
no_sac_e := 0;
nt_receipt:= false;
disconnected:= true;
for ac_ix:= 1 to max_no_ac do
with sac_rac_s( ac_ix ) do
begin
vca_addr:= empty_addr;
vcm_addr:= empty_addr
end
end
end;
\f
function find_ts( var ts_ix: ts_db_ix; ts: macroaddr ): boolean;
begin
ts_ix:= 1;
while ( ts_db( ts_ix ).ts_address <> ts ) and ( ts_ix < max_no_ts ) do
ts_ix:= ts_ix + 1;
find_ts:= ts_db( ts_ix ).ts_address = ts
end;
\f
procedure init_ac_db_e( ac_ix: ac_db_ix );
begin
with ac_db( ac_ix ) do
begin
ac_addr:= empty_addr;
ac_code:= 0;
ts_indx:= 1;
lam_port:= 0;
activity:= stop_code;
ac_request:= no_request;
dc_request:= no_request;
poll_delay:= poll_delay_time;
ac_state:= (..)
end
end;
\f
procedure init_at_db_e( at_ix: at_db_ix );
begin
with at_db( at_ix ) do
begin
at_addr:= empty_addr;
at_code:= 0;
at_state:= (..);
activity:= stop_code;
dc_request:= no_request;
ac_request:= no_request;
poll_delay:=poll_delay_time;
lam_port:= 0;
no_ac_e :=0;
ts_indx:= 1;
for ac_ix:= 1 to max_no_ac do
begin
ac_indxs( ac_ix ):= 1;
ac_codes( ac_ix ):= 0
end
end
end;
\f
procedure restart_dc;
begin
newline;
outchar( ff );
start_new_line;
outstring( 3, txt_dc );
outstring( 12, version );
outinteger( sp, al_env_version, 2 );
start_new_line;
outstring( 6, txt_enter );
outstring( 3, txt_dc );
outstring( 6, txt_number );
newline;
no_of_dc:= 0;
for ts_ix:= 1 to max_no_ts do init_ts_db_e( ts_ix );
for ac_ix:= 1 to max_no_ac do init_ac_db_e( ac_ix );
for at_ix:= 1 to max_no_at do init_at_db_e( at_ix );
no_of_dc:= 0;
no_of_ts:= 0;
no_of_ac:= 0;
no_of_at:= 0
end; (* procedure restart_dc *)
\f
procedure broadcast(
address : alarmnetaddr;
opcode : byte
);
begin
for ts_ix:= 1 to no_of_ts do
begin
lock tsc_listen_ref as m2x: mess_2x_type do
with m2x do
node:= address;
build_alarm_label( 4,
addr( ts_db( ts_ix ).ts_address, 0 ), netc_route, opcode, 0 )
end
end; (* procedure broadcast *)
\f
function find_at( var at_ix: at_db_ix; at: alarmnetaddr ): boolean;
(****************************************************************
* finds the index in database where at is *
*****************************************************************)
begin
at_ix:= 1;
while ( at_db( at_ix ).at_addr <> at ) and ( at_ix < max_no_at ) do
at_ix:= at_ix + 1;
find_at:= at_db( at_ix ).at_addr = at
end;
\f
procedure start_new_line;
begin
newline;
space( 11 )
end;
\f
procedure start_com_line;
begin
newline;
newline;
space( 11 );
outchar( ch_gt );
if not nil( output_to_dc ) then
signal( output_to_dc, lam_sem^ )
end;
\f
function update_px_db(
px_ix : px_db_ix
): boolean;
var
ix : 1..14;
begin
if params_ok( 19 ) then
if macro_ok( params( 1 ), params( 2 ), params( 3 ) ) and
range_ok( 4, 5, 0, max_byte ) and
range_ok( 6, 19, 0, 15 ) then
with px_db( px_ix ) do
begin
update_px_db:= true;
mac_address:= packmacro( params( 1 ), params( 2 ), params( 3 ) );
fe_ix:= params( 4 );
max_no_retrans:= params( 5 );
for ix:= 1 to 14 do
ext_px_addr( ix ):= params( ix + 5 )
end
else
begin
outstring( 5, txt_range );
update_px_db:= false
end
end; (* function update_px_db *)
\f
procedure update_pax_table(
route : byte;
receiver_macro : macroaddr;
px_ix : px_db_ix;
remote_px_ix : integer;
update_kind : update_range
);
begin
lock tsc_listen_ref as m1012: mess_1012_type do
with m1012, px_db( px_ix ) do
begin
al_mac_addr:= mac_address;
ext_pax_address:= ext_px_addr;
max_retrans:= max_no_retrans;
pax_tbl_ix:= remote_px_ix;
stream_no:= pax_tbl_ix * ord( pax_tbl_ix <= max_locals )
end;
build_alarm_label( 13,
addr( receiver_macro, netc_mic_addr ), route, #hac, update_kind )
end; (* procedure update_pax_table *)
\f
(****************************************
* *
* m a i n p r o g r a m *
* *
****************************************)
begin
testopen( opzone, own.incname, op_sem );
testout( opzone, version, al_env_version );
(* create the lam-channels *)
alloc( output_to_dc, lam_buf_pool, lam_talk_sem.s^ );
output_to_dc^.u1:= create_tty_ch;
output_to_dc^.u2:= dcm_out_port;
output_to_dc^.u3:= my_dc_route;
lock output_to_dc as lambuf: lambuftype do
begin
lambuf.controle_byte:= 32 + 16 + 4 + 2;
(* i.e. 300 bps, 7 data, 2 stop, even par *)
lambuf.timeout:= 60
end;
signal( output_to_dc, lam_sem^ );
repeat
wait( output_to_dc, lam_talk_sem.w^ );
if ( output_to_dc^.u3 = dummy_route ) then
return( output_to_dc )
until not nil( output_to_dc );
output_to_dc^.u1:= write_tty;
output_to_dc^.u3:= my_dc_route;
\f
lock output_to_dc as dcbuf: dcbuftype do
dcbuf.first:= firstindex;
return( output_to_dc );
alloc( inref, lam_buf_pool, input_sem.s^ );
inref^.u1:= read_tty;
inref^.u3:= my_dc_route;
lock inref as dcbuf: dcbuftype do
begin
dcbuf.first:= firstindex;
dcbuf.last:= lastindex
end;
while openpool( lam_buf_pool ) do
begin
alloc( output_to_dc, lam_buf_pool, lam_talk_sem.s^ );
with output_to_dc^ do
begin
u1:= write_tty;
u2:= 0;
u3:= my_dc_route;
u4:= 0
end;
lock output_to_dc as dcbuf: dcbuftype do
dcbuf.first:= firstindex;
return( output_to_dc )
end;
\f
alloc( book_up_msg, book_up_pool, timeout_answer_sem.s^ );
book_up_msg^.u3:= netc_route;
alloc( timeout_msg, timeout_pool, input_sem.s^ );
timeout_msg^.u3:= netc_route;
alloc( gettime_msg, gettime_pool, timeout_answer_sem.s^ );
with gettime_msg^ do
begin
u1:= 2;
u3:= 1
end;
if nil( tsc_listen_ref ) then
wait( tsc_listen_ref, com_sem^ );
restart_dc;
read_at_dc;
\f
repeat
if passive( input_sem.w^ ) and open( queue_sem.w^ ) then
wait( inref, queue_sem.w^ )
else
wait( inref, input_sem.w^ );
case inref^.u3 of
dummy_route: return( inref );
netc_route ,
netc_route1 ,
netc_route2 : (* from net connector *)
if open( input_sem.w^ ) then
signal( inref, queue_sem.s^ )
else
begin
opr_code:=inref^.u4;
if not ( log_off and ( opr_code in (.#h00, #h02.) ) ) then
begin
lock inref as a: alarmlabel do
with a do
begin
writetime( gettime );
case opr_code of
#h00: outstring( 4, txt_log );
#h10:
begin
outstring( 4, txt_log );
outstring( 3, txt_of );
outstring( 7, txt_rej );
outstring( 11, txt_msg )
end;
#h12: outstring( 7, txt_rej );
#h31, #h32, #h34, #h35:
outstring( 6, txt_alarm );
otherwise
outstring( 9, txt_rec )
end;
outstring( 3, txt_from );
writeaddress( sp, send, sp );
writetime( ts_add )
end;
\f
case ( opr_code div 16 ) of
#h0: case ( opr_code mod 16 ) of
(* 00.00 *) #h0: (* log *)
begin
lock inref as logmess: logmesstype do
with logmess, old_label do
begin
opr_code:= a_label.op_code;
write_to_from( rec, send )
end;
if ( opr_code <> #h32 ) then
lock inref as logmess: logmesstype do
with logmess, old_label do
begin
case op_code of
#h30:
outstring( 3, txt_au )
;
#h31:
outstring( 5, txt_line )
;
#h40, #h41:
outstring( 8, txt_steer )
;
#h84, #h85:
outstring( 5, txt_test )
;
#h98:
outstring( 11, txt_msg )
;
#hc8, #hc9:
begin
outstring( 7, txt_connected );
outstring( 5, txt_test )
end
;
otherwise
write_op_code( op_code )
end;
\f
if not ( op_code in (.#h30, #h31.) ) then
begin
if ( ( op_code mod 2 ) = 0 ) then
outstring( 6, txt_send )
else
outstring( 9, txt_receipt )
end
else
outstring( 6, txt_alarm );
if not ( op_code in (.#hc8, #hc9.) ) then
begin
if ( op_code <> #h31 ) then
begin
outchar( ch_lt );
for noofparams:= 1 to ( no_of_by - label_size ) do
begin
outinteger( sp, data( noofparams ), 3 );
if ( noofparams <> ( no_of_by - label_size ) ) then
outchar( ch_slash )
end;
outchar( ch_gt )
end
else
write_line_state( data( 1 ) )
end;
if ( result <> accepted ) then
writeresult( result )
end (* with *)
\f
else
(* statusalarm from at *)
lock inref as l: logstatustype do
with l, old_label do
begin
if find_at( at_ix, send ) then
with at_db( at_ix ) do
write_state( state, at_state )
else
write_error( 2, 4, no_of_at )
end
end (* #h00 *);
\f
(* 00.02 *) #h2: (* log for delivered alarm *)
lock inref as log02: log02type do
with log02 do
begin
case d_op_code of
#h30:
outstring( 3, txt_au );
#h31:
outstring( 5, txt_line );
#h32:
outstring( 6, txt_state );
otherwise
outstring( 11, txt_undef )
end;
outstring( 6, txt_alarm );
outstring( 3, txt_from );
writeaddress( sp, at_adr, sp );
if d_op_code = #h30 then
write_param( a_code, 3 )
else
if ( d_op_code = #h31 ) then
write_line_state( a_code );
outchar( sp );
outstring( 9, txt_delivered )
end; (* with *)
otherwise
unknown_msg( inref )
end;
\f
#h1: case ( opr_code mod 16 ) of
(* 01.00 *)
(* 01.02 *) #h0, #h2: (* rejected message *)
lock inref as m: mess_12_type do
with m do
begin
with a_label do
writeresult( result );
with old_label do
begin
writetime( ts_add );
outstring( 11, txt_org );
outstring( 11, txt_msg );
write_op_code( op_code );
write_to_from( rec, send );
write_param( no_of_by - label_size, 2 )
end
end;
otherwise
unknown_msg( inref )
end;
\f
#h2: case ( opr_code mod 16 ) of
(* 02.00 *)
(* 02.01 *)
(* 02.02 *)
(* 02.03 *)
(* 02.04 *)
(* 02.05 *)
(* 02.06 *)
(* 02.07 *)
(* 02.08 *)
(* 02.09 *) #h0..#h9: (* broadcast *)
lock inref as m2x: mess_2x_type do
with m2x, a_label do
begin
writeaddress( sp, node, sp );
if ( opr_code mod 2 ) <> 1 then
outstring( 3, txt_dis );
outstring( 9, txt_connected )
end;
otherwise
unknown_msg( inref )
end;
\f
#h3: case ( opr_code mod 16 ) of
(* 03.01 *)
(* 03.04 *)
(* 03.05 *) #h1, #h4, #h5:
lock inref as alarm: alarmmesstype do
with alarm do
begin
case opr_code of
#h31:
outstring( 4, txt_error );
#h34:
outstring( 7, txt_service );
#h35:
begin
outstring( 4, txt_stop );
outstring( 4, txt_poll )
end;
otherwise
end;
outstring( 7, txt_limit );
write_line_state( a_code )
end;
\f
(* 03.02 *) #h2 : (* statusalarm *)
lock inref as a: statusalarmtype do
with a do
begin
if find_ac( ac_ix, a_label.send ) then
with ac_db( ac_ix ) do
write_state( state, ac_state )
else
write_error( 1, 4, no_of_ac )
end;
otherwise
unknown_msg( inref )
end;
\f
#h6: case ( opr_code mod 16 ) of
(* 06.01 *) #h1 : (* receipt for at-creation *)
lock inref as receipt: mess_60_type do
with receipt, a_label do
begin
(*q if test_b then
testout( opzone,"6.1 received", result); q*)
outstring( 6, txt_create );
outstring( 3, txt_at );
outchar( ch_lt );
outinteger( sp, at_mic, 3 );
outchar( ch_slash );
outinteger( sp, lam_num, 3 );
outchar( ch_slash );
outinteger( sp, port_num, 3 );
outchar( ch_slash );
outinteger( sp, sac_rac_index, 3 );
outchar( ch_gt );
writeresult( result );
if ( result <> accepted ) then
if find_at( at_ix, addr( send.macro, at_mic ) ) then
with at_db( at_ix ) do
begin
with ts_db( ts_indx ) do
ports_used:= ports_used - (.lam_port.);
init_at_db_e( at_ix );
no_of_at:= no_of_at - 1
end
else
write_error( 2, 4, no_of_at )
end;
\f
(* 06.03 *) #h3:
lock inref as m63: mess_62_type do
with m63, a_label do
begin
outstring( 3, txt_at );
outstring( 3, txt_ok );
outstring( 10, txt_delivered );
writeaddress( ch_lt, at_adr, ch_gt );
writeresult( result )
end;
\f
(* 06.04 *) #h4:
lock inref as m64: mess_62_type do
with m64, a_label do
begin
if find_at( at_ix, at_adr ) then
with at_db( at_ix ) do
begin
write_at_activity( update );
outstring( 2, txt_of );
writeaddress( sp, at_adr, sp );
if ( result = accepted ) then
begin
ac_request:= update;
\f
if ( ac_request =
( dc_request - ord( dc_request = service_code ) ) ) then
begin (* send 09.00 to atc *)
outstring( 7, txt_granted );
lock tsc_listen_ref as m90: mess_90_type do
with m90 do
begin
trans_err:= 0;
poll_int:= poll_delay
end;
build_alarm_label( 4 * ord( update <> stop_code ),
at_adr, netc_route, #h90, dc_request );
dc_request:= no_request;
ac_request:= no_request
end
else
begin
outstring( 4, txt_star );
outstring( 12, txt_request )
end
end
else
writeresult( result )
end
else
write_error( 2, 4, no_of_at )
end;
\f
(* 06.07 *) #h7: (* receipt for remove request from ac *)
lock inref as m67: mess_62_type do
with m67, a_label do
begin
outstring( 6, txt_remove );
outstring( 3, txt_at );
writeaddress( ch_lt, at_adr, ch_gt );
if ( result = accepted ) then
if find_at( at_ix, at_adr ) then
with at_db( at_ix ) do
begin
outstring( 7, txt_granted );
ac_request:= removing;
if ( ac_request = dc_request ) then
begin
lock tsc_listen_ref as m68: mess_60_type do
with m68 do
begin
at_mic:= at_addr.micro;
lam_num:= 0;
port_num:= lam_port;
if find_sac_entry( ac_ix, ts_indx, ac_db( ac_indxs( 1 ) ).ac_addr ) then
sac_rac_index:= ac_ix
else
write_error( 3, 4, ts_indx )
end;
build_alarm_label( 8,
addr( at_addr.macro, ath_mic_addr ), netc_route, #h68, remove_code )
end
else
begin
outstring( 4, txt_star );
outstring( 12, txt_request )
end
end
else
write_error( 2, 4, no_of_at )
else
writeresult( result )
end;
\f
(* 06.09 *) #h9: (* receipt for at removal from at handler *)
lock inref as m69: mess_60_type do
with m69, a_label do
begin
outstring( 6, txt_remove );
outstring( 3, txt_at );
writeaddress( ch_lt, addr( send.macro, at_mic ), ch_gt );
writeresult( result );
if ( result = accepted ) then
if find_at( at_ix, addr( send.macro, at_mic ) ) then
with at_db( at_ix ) do
begin
for ac_ix:= 1 to no_ac_e do
begin (* remove at from at address table of all ac's *)
lock tsc_listen_ref as m102: mess_102_type do
with m102 do
begin
at_addr_tab.at_addr:= at_addr;
at_addr_tab.addr_code:= at_code
end;
build_alarm_label( 5, ac_db( ac_indxs( ac_ix ) ).ac_addr,
netc_route, #ha2, remove_code )
end;
with ts_db( ts_indx ) do
ports_used:= ports_used - (.lam_port.);
init_at_db_e( at_ix );
no_of_at:= no_of_at - 1
end
else
write_error( 2, 4, no_of_at )
end;
\f
otherwise
unknown_msg( inref )
end;
\f
#h7: case ( opr_code mod 16 ) of
(* 07.01 *) #h1 :
lock inref as m: mess_70_type do
with m, a_label do
begin
outstring( 6, txt_create );
outstring( 3, txt_ac );
outchar( ch_lt );
outinteger( sp, ac_mic, 3 );
outchar( ch_slash );
outinteger( sp, ord( ac_typ ), 3 );
outchar( ch_slash );
outinteger( sp, lam_num, 3 );
outchar( ch_slash );
outinteger( sp, port_num, 3 );
outchar( ch_gt );
writeresult( result );
if ( result <> accepted ) then
if find_ac( ac_ix, addr( send.macro, ac_mic ) ) then
with ac_db( ac_ix ) do
begin
with ts_db( ts_indx ) do
ports_used:= ports_used - (.lam_port.);
init_ac_db_e( ac_ix );
no_of_ac:= no_of_ac - 1
end
else
write_error( 1, 4, no_of_ac )
end;
\f
(* 07.03 *) #h3:
lock inref as m73: mess_70_type do
with m73, a_label do
begin
outstring( 6, txt_remove );
outstring( 3, txt_ac );
if ( result = accepted ) then
if find_ac( ac_ix, send ) then
with ac_db( ac_ix ) do
begin
ac_request:= removing;
if ( dc_request = ac_request ) then
begin
outstring( 7, txt_granted );
lock tsc_listen_ref as m74: mess_70_type do
with m74 do
ac_mic:= m73.a_label.send.micro;
build_alarm_label( 2, addr( m73.a_label.send.macro, vch_mic_addr ),
netc_route, #h74, remove_code )
end
else
begin
outstring( 4, txt_star );
outstring( 12, txt_request )
end
end
else
write_error( 1, 4, no_of_ac )
else
writeresult( result )
end;
\f
(* 07.05 *) #h5:
lock inref as m75: mess_70_type do
with m75, a_label do
begin
outstring( 6, txt_remove );
outstring( 3, txt_ac );
writeaddress( ch_lt, addr( send.macro, ac_mic ), ch_gt );
writeresult( result );
if ( result = accepted ) then
if find_ac( ac_ix, addr( send.macro, ac_mic ) ) then
with ac_db( ac_ix ) do
begin
with ts_db( ts_indx ) do
ports_used:= ports_used - (.lam_port.);
init_ac_db_e( ac_ix );
no_of_ac:= no_of_ac - 1
end
else
write_error( 1, 4, no_of_ac )
end;
otherwise
unknown_msg( inref )
end;
\f
#h8: case ( opr_code mod 16 ) of
(* 08.01 *)
(* 08.03 *) #h1, #h3 : (* receipt for internal test *)
lock inref as receipt: alarmmesstype do
with receipt, a_label do
begin
outstring( 4, txt_test );
case opr_code of
#h81 : outstring( 9, "1: atprm" );
#h83 : outstring( 9, "2: atpam" );
otherwise
end;
if ( a_label.result = accepted ) then
begin
case a_code of
#h06: outstring( 2, txt_ok );
#h16: outstring( 4, txt_error );
otherwise
outstring( 10, txt_undef )
end
end
else
writeresult( result )
end;
otherwise
unknown_msg( inref )
end;
\f
#h9: case ( opr_code mod 16 ) of
(* 09.01 *) #h1: (* receipt for start-stop poll *)
lock inref as m: mess_90_type do
with m, a_label do
begin
write_at_activity( update );
if update in (.start_code, service_code.) then
write_param( poll_int, 3 )
else
space( 3 );
writeresult( result );
\f
if send.micro > 255 then
begin
if find_at( at_ix, send ) then
with at_db( at_ix ) do
begin
if ( result = accepted ) then
begin
activity:= update;
at_state:= (..)
end
end
else
write_error( 2, 4, no_of_at )
end
else
begin
if find_ac( ac_ix, send ) then
with ac_db( ac_ix ) do
begin
ac_state:= (..);
activity:= update;
dc_request:= no_request
end
else
write_error( 1, 4, no_of_ac )
end
end;
\f
(* 09.03 *) #h3: (* receipt for test of at-ac connection *)
lock inref as m: mess_119_type do
with m, a_label do
begin
writeaddress( sp, send, sp );
outstring( 10, txt_connected );
outstring( 3, txt_to );
writeaddress( sp, act_rac, sp )
end;
\f
(* 09.08 *) #h8: (* general message *)
lock inref as m98: alarmmesstype do
with m98, a_label do
begin
outstring( 11, txt_msg );
write_param( a_code, 3 )
end;
otherwise
unknown_msg( inref )
end;
\f
#ha: case ( opr_code mod 16 ) of
(* 10.01 *) #h1 :
lock inref as receipt: receipt_101_type do
with receipt, a_label, ac_addr_tab do
begin
outstring( 3, txt_ac );
write_table_update( update );
outchar( ch_lt );
outinteger( sp, addr_code, 3 );
outchar( ch_slash );
outinteger( sp, vc_index, 3 );
outchar( ch_slash );
outinteger( sp, block, 3 );
outchar( ch_slash );
outinteger( sp, ord( steering ), 3 );
outchar( ch_gt );
writeresult( result );
if find_at( at_ix, send ) then
with at_db( at_ix ) do
begin
if ( dc_request = creating ) then
begin
dc_request:= no_request;
outchar( sp );
outstring( 4, txt_star );
outstring( 6, txt_create );
outstring( 3, txt_at );
outstring( 9, txt_finish )
end
end
else
write_error( 2, 4, no_of_at )
end;
\f
(* 10.03 *) #h3: (* receipt for update at-addr-table *)
lock inref as receipt: receipt_103_type do
with receipt, r_label, at_addr_tab do
begin
(*q if test_b then
testout( opzone,"10.3 receivd", result); q*)
outstring( 3, txt_at );
write_table_update( update );
writeaddress( ch_lt, at_addr, ch_slash );
outinteger( sp, addr_code, 3 );
outchar( ch_gt );
writeresult( result )
end;
\f
(* 10.05 *) #h5:
lock inref as m105: mess_104_type do
with m105, a_label, ts_e do
begin
outstring( 3, txt_ts );
write_table_update( update );
writeaddress( ch_lt, addr( ts_addr , 0 ), ch_slash );
outinteger( sp, ord( ts_type ), 3 );
outchar( ch_slash );
outinteger( sp, index, 3 );
outchar( ch_gt );
writeresult( result )
end;
\f
(* 10.07 *) #h7:
lock inref as m107: mess_106_type do
with m107, a_label, vcm_at_e do
begin
outstring( 3, txt_ac );
outstring( 7, txt_group );
write_table_update( update );
outchar( ch_lt );
outinteger( sp, vc_code, 3 );
writeaddress( ch_slash, vc_addr, ch_slash );
outinteger( sp, vc_arrange, 3 );
outchar( ch_slash );
outinteger( sp, ord( vc_relief ), 3 );
outchar( ch_gt );
writeresult( result )
end;
\f
(* 10.11 *) #hb: (* receipt for update sac-rac-table *)
lock inref as r: receipt_1011_type do
with r, a_label, sac_rac_tab do
begin
outstring( 4, txt_rac );
write_table_update( update );
outchar( ch_lt );
outinteger( sp, ac_index, 3 );
writeaddress( ch_slash, vca_addr, ch_slash );
writeaddress( sp, vcm_addr, ch_gt );
writeresult( result );
end;
\f
(* 10.13 *) #hd:
lock inref as m1013: mess_1012_type do
with m1013, a_label do
begin
outstring( 4, txt_pax );
write_table_update( update );
outchar( ch_lt );
outinteger( sp, pax_tbl_ix, 3 );
writeaddress( ch_slash, addr( al_mac_addr, 0 ), sp );
for noofparams:= 1 to 14 do
begin
outchar( ch_slash );
outinteger( sp, ext_pax_address( noofparams ), 2 )
end;
outchar( ch_slash );
outinteger( sp, stream_no, 3 );
outchar( ch_slash );
outinteger( sp, max_retrans, 3 );
outchar( ch_gt );
writeresult( result )
end;
otherwise
unknown_msg( inref )
end;
\f
#hb: case ( opr_code mod 16 ) of
(* 11.01 *) #h1: (* receipt for update tss-var *)
lock inref as m: mess_110_type do
with m, a_label do
begin
outstring( 6, txt_create );
outstring( 3, txt_ts );
writeaddress( ch_lt, addr( tss_macro, 0 ), ch_gt );
writeresult( result );
if ( result <> accepted ) then
begin
init_ts_db_e( no_of_ts );
no_of_ts:= no_of_ts - 1
end
end;
\f
(* 11.03 *)
(* 11.05 *)
(* 11.07 *)
(* 11.11 *)
(* 11.13 *) #h3, #h5, #h7, #hb, #hd:
(* receipt for read/write limits *)
lock inref as m: mess_11x_type do
with m, a_label do
begin
write_param_update( update );
case opr_code of
#hb5: outstring( 5, txt_package );
#hb7:
outstring( 7, txt_service );
#hbb:
begin
outstring( 4, txt_stop );
outstring( 4, txt_poll )
end;
#hb3, #hbd:
outstring( 4, txt_error );
otherwise
end;
if opr_code in (.#hb3, #hb5.) then
outstring( 7, txt_counter )
else
outstring( 7, txt_limit );
writeresult( result );
write_param( counter, 5 )
end;
\f
(* 11.09 *) #h9:
lock inref as m: mess_119_type do
with m, a_label do
begin
write_param_update( update );
outstring( 7, txt_actual );
outstring( 3, txt_ac );
writeresult( result );
writeaddress( ch_lt, act_rac, ch_gt )
end;
otherwise
unknown_msg( inref )
end;
\f
#hc: case ( opr_code mod 16 ) of
(* 12.01 *) #h1: (* receipt for node test *)
lock inref as m1201: mess_12_00_type do
with m1201, a_label do
if find_ts( ts_ix, send.macro ) then
with ts_db( ts_ix ) do
begin
nt_receipt:= true;
if disconnected then
begin
disconnected:= false;
broadcast( send, #h25 )
end
end
else
write_error( 3, 4, no_of_ts )
;
\f
(* 12.02 *) #h2: (* node test interval time out *)
begin
for ts_ix:= 1 to no_of_ts do
with ts_db( ts_ix ) do
if ( ts_address <> macroaddr( 0, 0, 0 ) ) then
begin
if not nt_receipt then
if not disconnected then
begin
disconnected:= true;
broadcast( addr( ts_address, tss_mic_addr ), #h24 )
end;
nt_receipt:= false;
lock tsc_listen_ref as m1200: mess_12_00_type do
with m1200 do
begin
counter:= 0;
nt_freq:= ( nt_time * 10 ) div 9
end;
build_alarm_label( 4, addr( ts_address, tss_mic_addr ),
netc_route, #hc0, modify_code )
end;
if nt_on then
timerbook( book_up_msg, inref, nt_time, 0,
timeout_sem^, timeout_answer_sem.s^ )
else
timeout_msg :=: inref
end
;
otherwise
unknown_msg( inref )
end;
\f
otherwise
unknown_msg( inref )
end; (* case opr_code div 16 *)
start_com_line
end;
return( inref)
end; (* output_buf - else *)
\f
my_dc_route: (* from dc *)
case inref^.u2 of
0 : (* successfully read *)
begin
getinput;
writetime( gettime );
(*q
if test_b then
begin
testout( opzone,"kommando ", ord( command));
testout( opzone,"param0(2) ", ord(command1(2)));
testout( opzone,"param1(1) ", ord(command2(1)));
end;
q*)
\f
case command1( 1 ) of
"a": (* afl{s *)
if ( command2( 1 ) in (."a", "m", "p", "t".) ) or
( ( command2( 1 ) = "s" ) and ( command2( 2 ) in (."e", "t".) ) ) then
if params_ok( 4 ) then
if addr_ok( 1 ) then
begin
case command2(1) of
"a":
opr_code:= #hb8;
"m":
opr_code:= #hbc;
"p":
opr_code:= #hb4;
"s":
if command2( 2 ) = "e" then
opr_code:= #hb6
else
opr_code:= #hba;
"t":
opr_code:= #hb2;
otherwise
end;
build_alarm_label( 0,
packaddr( 1 ), netc_route, opr_code, read_code )
end
else
else
else
write_error( 7, 5, 2 )
;
\f
"b": (* broadcast *)
if command2( 1 ) in (."n", "o".) then
begin
case noofparams of
1:
broadcast( addr( packmacro( params( 1 ), 0, 0 ), 0 ),
( #h20 + ord( command2( 1 ) <> "n" ) ) )
;
2:
broadcast( addr( packmacro( params( 1 ), params( 2 ), 0 ) , 0 ),
( #h22 + ord( command2( 1 ) <> "n" ) ) )
;
3:
broadcast( addr( packmacro( params( 1 ), params( 2 ), params( 3 ) ), 0 ),
( #h24 + ord( command2( 1 ) <> "n" ) ) )
;
4:
broadcast( addr( packmacro( params( 1 ), params( 2 ), params( 3 ) ), params( 4 ) ),
( #h26 + ord( command2( 1 ) <> "n" ) ) )
;
otherwise
write_error( 6, 7, 4 )
end
end
else
write_error( 7, 5, 2 )
;
\f
"d": (* districtcenter number *)
if update_px_db( 0 ) then
begin
if ( no_of_dc = 0 ) then
begin
start_new_line;
outstring( 6, txt_create );
outstring( 2, txt_ts );
newline
end;
no_of_dc:= no_of_dc + 1;
dc_macro:= packmacro( params( 1 ), params( 2 ), params( 3 ) );
update_pax_table( netc_route1, macroaddr( 0, 0, 0), 0, px_db( 0 ).fe_ix, modify_code )
end
else
outstring( 5, txt_range )
;
\f
"f" :
(*------------------ remove aac -------------------------
. 1. find <ac-address> in database
. 2. if <ac-address> is not in database
. write a message on dc-console
. 3. if <ac-address> is in database do the following :
. 4. find an entry with both <ac-address> and <at-address>
. and where pac-or-aac is aac.
. 5. if there is no such entry write a message on dc-console
. 6. in this entry see how many aac-codes are in use
. 7. if <aac-code> is not in this entry, write on dc-console
. 8. if <aac-code> is the last one in use, remove the databaseentry
. 9. send a 10.0 to atc
. 10. send a 10.2 to <ac-address> if at-code in a removed entry
. is not elsewhere in the database
. 11. send a 10.10 to ath if this <ac-address> no longer has an
. at-address with the same macro-addr as <at-address>
--------------------------------------------------------------*)
if params_ok( 9 ) then
if (ac_addr_ok( 1 ) and at_addr_ok( 5 ))
and aac_code_ok(params(9)) then
if find_ac( ac_ix, packaddr( 1 ) ) then
if find_at( at_ix, packaddr( 5 ) ) then
with ac_db( ac_ix ), at_db( at_ix ) do
begin
outstring( 10, txt_undef )
end
else
write_error( 2, 2, no_of_at )
else
write_error( 1, 2, no_of_ac )
else
outstring( 5, txt_param )
;
\f
"g": (* generel message *)
if params_ok( 4 ) then
if addr_ok( 1 ) then
if find_ac( ac_ix, packaddr( 1 ) ) then
with ac_db( ac_ix ) do
begin
lock tsc_listen_ref as m98: mess_98_type do
with m98 do
msg_text:= command2;
build_alarm_label( alfalength,
ac_addr, netc_route, #h98, 0 )
end
else
outstring( 6, txt_unknown )
;
\f
"h" : (* help *)
begin
(*q if test_b then
testout( opzone, "help command", 0); q*)
outstring( 9, txt_undef )
end
;
\f
"i" :
(*-------------------- insert aac --------------------------
.
. 1. find <ac-address> in database.
. 2. if <ac-address> is not in database
. write a message on dc-console
. 3. if <ac-address> is in database do the following :
. 4. find an entry where <at-address> and <ac-address>
. are in the same entry and where pac-or-avs = aac
. 5. if there is no such entry, make an entry i.e.
. find an entry with <ac-address> and where <at-address>
. is empty and fill <at-address> into this or make a new entry
. 6. a 10.10 is send to ath if there is no <ac-address> in database,
. where at-address.macro is equal to <at-address>.macro
. 7. send a 10.0 to atc
. 8. a 10.2 is send to <ac-address> if at-code is a new one
. this is not send if 4. is true
.--------------------------------------------------------------*)
if params_ok( 10 ) then
if ac_addr_ok( 1 ) and at_addr_ok( 5 ) and aac_code_ok( params( 9 ) )
and ( params( 10 ) in (.0..1.) ) then
begin
(*q if test_b then
testout( opzone, "insert aac ", 0); q*)
if find_ac( ac_ix, packaddr( 1 ) ) then
if find_at( at_ix, packaddr( 5 ) ) then
with at_db( at_ix ) do
if ( no_ac_e < max_no_ac ) then
begin
no_ac_e:= no_ac_e + 1;
ac_indxs( no_ac_e ):= ac_ix;
ac_codes( no_ac_e ):= params( 9 );
if not find_sac_entry( sac_rac_ix, ts_indx,
ac_db( ac_ix ).ac_addr ) then
if find_sac_entry( sac_rac_ix, ts_indx, empty_addr ) then
begin
(* send 10.10 to athandler and update ts data base *)
with ac_db( ac_ix ), ts_db( ts_indx ) do
begin
lock tsc_listen_ref as m: mess_1010_type do
with m, a_label do
begin
no_sac_e:= no_sac_e + 1;
with sac_rac_s( sac_rac_ix ) do
begin
vca_addr:= ac_addr;
vcm_addr:= alarmnetaddr( macroaddr( 0, 0, 0 ), 0 );
sac_rac_index:= sac_rac_ix;
sac_addr:= vca_addr;
rac_addr:= vcm_addr
end
end;
build_alarm_label( 10, addr( at_addr.macro, ath_mic_addr ),
netc_route, #haa, insert_code )
end;
lock tsc_listen_ref as m102: mess_102_type do
with m102 do
begin
at_addr_tab.at_addr:= at_addr;
at_addr_tab.addr_code:= at_code
end;
build_alarm_label( 5, ac_db( ac_ix ).ac_addr,
netc_route, #ha2, insert_code )
end
else
write_error( 3, 4, ts_db( ts_indx ).no_sac_e )
;
\f
lock tsc_listen_ref as l: receipt_101_type do
with l do
begin
ac_addr_tab.addr_code:= params( 9 );
ac_addr_tab.vc_index:= sac_rac_ix;
ac_addr_tab.block:= 1;
ac_addr_tab.steering:= ( params( 10 ) = 1 )
end;
build_alarm_label( 6, at_db( at_ix ).at_addr,
netc_route, #ha0, insert_code )
end
else
write_error( 0, 3, max_no_ac )
else
write_error( 2, 2, no_of_at )
else
write_error( 1, 2, no_of_ac )
end
else
outstring( 5, txt_param )
;
\f
"k" :
if params_ok( 2 ) then
if ( params( 1 ) in (.0..23.) ) and ( params( 2 ) in (.0..59.) ) then
begin
(*q if test_b then
testout( opzone, "klokken er ", 0); q*)
settime( params( 1 ), params( 2 ) );
writetime( gettime )
end
else
outstring( 5, txt_range )
;
\f
"l" : log_off:= ( command2( 1 ) = "n" );
"n" : (* close *)
if params_ok( 4 ) then
if addr_ok( 1 ) then
case command2( 1 ) of
"a" : (* alarm terminal *)
if find_at( at_ix, packaddr( 1 ) ) then
with at_db( at_ix ) do
if ( activity <> start_code ) then
begin
dc_request:= removing;
if ( dc_request <> ac_request ) then
begin
lock tsc_listen_ref as m: mess_62_type do
with m do
at_adr:= at_addr;
build_alarm_label( 4, ac_db( ac_indxs( 1 ) ).ac_addr,
netc_route, #h66, remove_code )
end
else
begin
lock tsc_listen_ref as m68: mess_60_type do
with m68 do
begin
at_mic:= at_addr.micro;
lam_num:= 0;
port_num:= lam_port;
if find_sac_entry( ac_ix, ts_indx, ac_db( ac_indxs( 1 ) ).ac_addr ) then
sac_rac_index:= ac_ix
else
write_error( 3, 4, ts_indx )
end;
build_alarm_label( 8, addr( at_addr.macro, ath_mic_addr ),
netc_route, #h68, remove_code )
end
end
else
outstring( 4, txt_busy )
else
outstring( 6, txt_unknown )
;
\f
<*
"d" : (* district center *)
begin
lock tsc_listen_ref as m: mess_110_type do
with m do
begin
tss_macro:= macroaddr( 0, 0, 0 );
xx:= 0;
dc_ts_macro:= macroaddr( 0, 0, 0 )
end;
build_alarm_label( 6, addr( ts_db( 1 ).ts_address, 0 ),
netc_route, #hb0, insert_code );
restart_dc
end
;
*>
\f
"v" : (* alarm center *)
if find_ac( ac_ix, packaddr( 1 ) ) then
with ac_db( ac_ix ) do
begin
dc_request:= removing;
if ( ac_request = dc_request ) then
begin
lock tsc_listen_ref as m: mess_70_type do
with m do
ac_mic:= ac_addr.micro;
build_alarm_label( 2, addr( ac_addr.macro, vch_mic_addr ),
netc_route, #h74, remove_code )
end
else
build_alarm_label( 0,
addr( ac_addr.macro, vch_mic_addr ), netc_route, #h72, remove_code )
end
else
outstring( 6, txt_unknown )
;
otherwise
write_error( 7, 5, 2 )
end
;
\f
"t" : (* internal test *)
(*----------------------------------------------
. 1. send mess 8.0 or 8.2 to at-connector or
. to ac-connector
. 2. write 8.1 or 8.3 when it comes
------------------------------------------------*)
case command2( 1 ) of
"a":
if params_ok( 5 ) then
if addr_ok( 1 ) then
if params( 5 ) in (.1..2.) then
begin
(*q if test_b then
testout( opzone, "test command", 0); q*)
case params( 5 ) of
1: (* internal test 1 *)
opr_code:= #h80;
2: (* internal test 2 *)
opr_code:= #h82;
otherwise;
end; (* case *)
build_alarm_label( 0,
packaddr( 1 ), netc_route, opr_code, 0 )
end
else
outstring( 5, txt_range )
;
\f
"f": (* test at_ac connection *)
if params_ok( 8 ) then
if at_addr_ok( 1 ) and ac_addr_ok( 5 ) then
begin
lock tsc_listen_ref as m: mess_119_type do
with m do
act_rac:= packaddr( 5 );
build_alarm_label( 4,
packaddr( 1 ), netc_route, #h92, 0 )
end
else
outstring( 5, txt_range )
;
otherwise
write_error( 7, 5, 2 )
end;
\f
"o":
(*----------------------------------------------
. 1. send 10.10 to at-handler
. if sac-rac-table should be updated
. else send 6.0
. 2. when 10.11 is received send 6.0 to ts-supervisor
. 3. when 6.1 is received it is written on dc-console
. 4. send 10.2 to all ac-connectors that belongs to
. this at
. 5. when 10.3 is received send a 6.2 to pac-connector
. 6. when 6.3 is received a 10.0 is send to at-connector
--------------------------------------------------*)
case command2( 1 ) of
"a": (* create at *)
if params_ok( 10 ) then
if at_addr_ok( 1 ) and ac_addr_ok( 7 ) and ( params( 6 ) in (.0..15.) )
and aac_code_ok( params( 5 ) ) then
if no_of_at < max_no_at then
if find_ts( ts_ix, packaddr( 1 ).macro ) and
( params( 6 ) in ts_db( ts_ix ).ports_used ) then
outstring( 4, txt_port )
else
begin
(*---------------- update --------------------------
.
.1. search for a ac-address which is equal to <pac-address>
.2. if ac-address does not exist write to dc-console
.3. else search for a at-macro-address equal to <at-address>.macro
.4. if such one does not exist snd a 10.10 to ath
.5. else send a 6.0 to atc
.6. go on as described above
------------------------------------------------------*)
if find_ac( ac_ix, packaddr( 7 ) ) then
begin
if find_at( at_ix, packaddr( 1 ) ) then
write_error( 2, 1, no_of_at )
else
\f
if find_at( at_ix, empty_addr ) then
with at_db( at_ix ), ts_db( ts_ix ) do
begin
no_of_at:= no_of_at + 1;
(* update at data base *)
at_addr:= packaddr( 1 );
at_code:= params( 5 );
lam_port:= params( 6 );
dc_request:= creating;
no_ac_e:= no_ac_e + 1;
ac_indxs( no_ac_e ):= ac_ix; (* pointer to ac_db *)
ac_codes( no_ac_e ):= 0; (* pac addr code *)
ts_indx:= ts_ix;
ports_used:= ports_used + (.lam_port.);
if not find_sac_entry( sac_rac_ix, ts_indx,
ac_db( ac_indxs( 1 ) ).ac_addr ) then
begin
if find_sac_entry( sac_rac_ix, ts_indx, empty_addr ) then
begin
(* ac isn't in sac_rac_table at this ts *)
no_sac_e:= no_sac_e + 1;
lock tsc_listen_ref as l: mess_1010_type do
with l, sac_rac_s( sac_rac_ix ) do
begin
sac_rac_index:= sac_rac_ix;
sac_addr:= packaddr( 7 );
rac_addr:= alarmnetaddr( macroaddr( 0, 0, 0 ), 0 );
vca_addr:= sac_addr;
vcm_addr:= rac_addr
end;
build_alarm_label( 10,
addr( ts_address, ath_mic_addr ),
netc_route, #haa, insert_code )
end
else
write_error( 3, 4, no_sac_e )
end;
\f
(**)
lock tsc_listen_ref as l: mess_60_type do
with l do
begin
at_mic:= params( 4 );
lam_num:= 0;
port_num:= params( 6 );
sac_rac_index:= sac_rac_ix
end;
build_alarm_label( 6, addr( at_addr.macro, ath_mic_addr ),
netc_route, #h60, 0 );
(**)
lock tsc_listen_ref as l: mess_102_type do
with l do
begin
at_addr_tab.at_addr:= at_addr;
at_addr_tab.addr_code:= at_code
end;
build_alarm_label( 5, ac_db( ac_ix ).ac_addr,
netc_route, #ha2, insert_code );
(**)
lock tsc_listen_ref as m104: mess_104_type do
with m104, ts_e do
begin
ts_addr:= at_addr.macro;
ts_type:= 0;
index:= sac_rac_ix
end;
build_alarm_label( 6, ac_db( ac_ix ).ac_addr,
netc_route, #ha4, insert_code );
\f
(**)
lock tsc_listen_ref as r: receipt_101_type do
with r, ac_addr_tab do
begin
addr_code:= ac_codes( no_ac_e ); (* pac addr code *)
vc_index:= sac_rac_ix;
block:= 1;
steering:= true
end;
build_alarm_label( 6,
at_addr, netc_route, #ha0, insert_code );
(**)
lock tsc_listen_ref as m62: mess_62_type do
m62.at_adr:= at_addr;
build_alarm_label( 4,
ac_db( ac_ix ).ac_addr, netc_route, #h62, 0 )
(**)
end
else
write_error( 2, 4, no_of_at )
end
else
write_error( 1, 2, no_of_ac )
end
else
write_error( 2, 3, max_no_at )
else
outstring( 5, txt_param )
;
\f
"v" : (* create ac *)
if params_ok( 6 ) then
if ac_addr_ok( 1 ) and aac_code_ok( params( 5 ) ) and
( params( 6 ) in (.0..15.) ) then
if no_of_ac < max_no_ac then
if find_ts( ts_ix, packaddr( 1 ).macro ) then
if not ( params( 6 ) in ts_db( ts_ix ).ports_used ) then
begin
(*--------------- update database -----------------
. 1. search for ac-address
. 2. if ac-address exist in database write to dc-console
. 3. else find first empty entry in database
. 4. initialize entry
. 5. put ac-address into databaseentry
-------------------------------------------------------*)
if find_ac( ac_ix, packaddr( 1 ) ) then
outstring( 5, txt_known )
else
if find_ac( ac_ix, empty_addr ) then
with ac_db( ac_ix ), ts_db( ts_ix ) do
begin
no_of_ac:= no_of_ac + 1;
(* update ac data base *)
ac_addr:= packaddr( 1 );
ac_code:= params( 5 );
lam_port:= params( 6 );
ts_indx:= ts_ix;
ports_used:= ports_used + (.lam_port.);
\f
lock tsc_listen_ref as l: mess_70_type do
with l do
begin
ac_mic:= params( 4 );
ac_typ:= vcat;
lam_num:= 0;
port_num:= params( 6 );
(*q
if test_b then
testout( opzone,"7.0 ready ", 0 );
q*)
end;
build_alarm_label( 5, addr( ac_addr.macro, vch_mic_addr ),
netc_route, #h70, 0 );
(**)
lock tsc_listen_ref as m106: mess_106_type do
with m106, vcm_at_e do
begin
vc_code:= 0;
vc_addr:= addr( dc_macro, 0 );
vc_arrange:= 0;
vc_relief:= false
end;
build_alarm_label( 7, ac_addr,
netc_route, #ha6, insert_code );
(**)
\f
for ac_ix:= 1 to max_no_ac do
with ac_db( ac_ix ) do
begin
if ( ac_addr <> empty_addr ) and
( ac_addr <> packaddr( 1 ) ) then
begin
(**)
lock tsc_listen_ref as m106: mess_106_type do
with m106, vcm_at_e do
begin
vc_code:= ac_code;
vc_addr:= ac_addr;
vc_arrange:= 0;
vc_relief:= false
end;
build_alarm_label( 7, packaddr( 1 ),
netc_route, #ha6, insert_code );
(**)
lock tsc_listen_ref as m106: mess_106_type do
with m106, vcm_at_e do
begin
vc_code:= params( 5 );
vc_addr:= packaddr( 1 );
vc_arrange:= 0;
vc_relief:= false
end;
build_alarm_label( 7, ac_addr,
netc_route, #ha6, insert_code )
end
(**)
end
\f
end
else
write_error( 1, 4, no_of_ac )
end
else
outstring( 4, txt_port )
else
write_error( 3, 2, no_of_ts )
else
write_error( 1, 3, max_no_ac )
else
outstring( 5, txt_param )
;
\f
"t" : (* terminalstation *)
if ( no_of_ts < max_no_ts ) then
if find_ts( ts_ix, macroaddr( 0, 0, 0 ) ) then
begin
px_ix:= ts_ix;
if update_px_db( px_ix ) then
with px_db( px_ix ) do
if find_ts( ts_ix, mac_address ) then
outstring( 5, txt_known )
else
if find_ts( ts_ix, macroaddr( 0, 0, 0 ) ) then
with ts_db( ts_ix ) do
begin
no_of_ts:= no_of_ts + 1;
ts_address:= mac_address;
if no_of_ts = 1 then
ports_used:= ports_used + (.1.); (* dcs port number *)
update_pax_table( netc_route1, dc_macro,
px_ix, fe_ix, modify_code );
if ( fe_ix > max_locals ) then
begin (* ... update PAX-table at remote TS ... *)
update_pax_table( netc_route, mac_address,
px_ix, 1, modify_code );
for w_px_ix:= 0 to no_of_ts do
with px_db( w_px_ix ) do
if ( mac_address <> ts_address ) then
update_pax_table( netc_route, ts_address,
w_px_ix, max_locals + 1 + w_px_ix, modify_code )
end;
for w_px_ix:= 1 to no_of_ts do
with px_db( w_px_ix ) do
if ( mac_address <> ts_address ) and ( fe_ix > max_locals ) then
(* ... update PAX tables at existing remote TS's ... *)
update_pax_table( netc_route, mac_address,
px_ix, max_locals + 1 + px_ix, modify_code );
if nt_on and not nil( timeout_msg ) then
timerbook( book_up_msg, timeout_msg, nt_time, 0,
timeout_sem^, timeout_answer_sem.w^ );
lock tsc_listen_ref as m1100: mess_110_type do
with m1100 do
begin
tss_macro:= ts_address;
xx:= 0;
dc_ts_macro:= dc_macro
end;
build_alarm_label( 6, addr( ts_address, tss_mic_addr ),
netc_route, #hb0, insert_code )
end
end
else
write_error( 3, 3, max_no_ts )
else
outstring( 5, txt_param )
;
\f
otherwise
write_error( 7, 5, 2 )
end; (* case command2(1) *)
\f
"s":
(*-------------------------------------------------
. 1. if <address> = ac-address then send 9.0 to ac-connector
. 2. if <address> = at-address then do the following
. 3. send 6.4 to pac-connector
. 4. when 6.5 is received it is written at dc-console
. 5. if 6.5 is a pos. receipt a 9.0 is send to at-connector
. 6. when 9.1 is received it is written at dc-console
---------------------------------------------------*)
case command1( 3 ) of
"a", "o", "r":
case command2( 1 ) of
"p":
if params_ok( 5 - ord( command1( 3 ) = "o" ) ) then
if addr_ok( 1 ) then
if params( 4 ) <= 255 then
begin
if find_ac( ac_ix, packaddr( 1 ) ) then
with ac_db( ac_ix ) do
begin
(* start poll ac *)
if ( noofparams = 5 ) then
lock tsc_listen_ref as l: mess_90_type do
with l do
begin
trans_err:= 0;
poll_int:= params( 5 );
poll_delay:= poll_int
end;
\f
case command1( 3 ) of
"a" :
dc_request:= start_code;
"o" :
dc_request:= stop_code;
"r" :
dc_request:= service_code;
otherwise
end;
build_alarm_label( 4 * ord( noofparams = 5 ),
packaddr( 1 ), netc_route, #h90, dc_request - ord( dc_request = service_code ) )
end
else
outstring( 6, txt_unknown )
end
\f
else
(* start- stop- or service-poll at *)
if find_at( at_ix, packaddr( 1 ) ) then
with at_db( at_ix ) do
if ( dc_request = creating ) then
write_error( 2, 9, ord( dc_request ) )
else
begin
case command1( 3 ) of
"a" :
dc_request:= start_code;
"o" :
dc_request:= stop_code;
"r" :
dc_request:= service_code;
otherwise
end;
\f
if ( ( dc_request - ord( dc_request = service_code ) ) = ac_request ) then
begin (* send 9.0 to atc *)
if ( noofparams = 5 ) then
lock tsc_listen_ref as m: mess_90_type do
with m do
begin
trans_err:= 0;
poll_delay:= params( 5 );
poll_int:= poll_delay
end;
build_alarm_label( 4 * ord( noofparams = 5 ),
at_addr, netc_route, #h90, dc_request );
dc_request:= no_request;
ac_request:= no_request
end
else
begin (* send request to ac and update delay *)
lock tsc_listen_ref as m: mess_62_type do
with m, a_label do
at_adr:= at_addr;
build_alarm_label( 4, ac_db( ac_indxs( 1 ) ).ac_addr,
netc_route, #h64, dc_request - ord( dc_request = service_code ) );
if ( noofparams = 5 ) then
poll_delay:= params( 5 )
end
end
;
\f
"k":
case command1( 3 ) of
"a":
if params_ok( 1 ) then
begin
nt_on:= true;
nt_time:= params( 1 );
if not nil( timeout_msg ) then
timerbook( book_up_msg, timeout_msg, nt_time, 0, timeout_sem^, timeout_answer_sem.s^ )
end
;
"o":
nt_on:= false
;
otherwise
end
;
otherwise
write_error( 6, 5, 2 )
end
;
\f
"t":
if ( command2( 1 ) in (."m", "s", "t".) ) then
begin
lock tsc_listen_ref as l: mess_11x_type do
with l do
begin
case command2(1) of
"m":
opr_code:= #hbc;
"s":
if command2( 2 ) = "e" then
opr_code:= #hb6
else
opr_code:= #hba;
"t":
opr_code:= #hb2;
otherwise
end;
counter:= params( 5 )
end;
build_alarm_label( 2,
packaddr( 1 ), netc_route, opr_code, modify_code )
end
else
write_error( 7, 5, 2 )
;
otherwise
write_error( 7, 5, 1 )
end
;
\f
cr, esc, dc3:
start_com_line
;
otherwise
write_error( 7, 5, 1 )
end; (* case command1( 1 ) *)
read_at_dc
end; (* case route *)
1..4: (* transient error *)
begin
testout( opzone, "lam error ", inref^.u2 );
read_at_dc
end;
5: (* timeout *)
begin
(*q if test_b then
testout( opzone, "dc-lam-timud", 5 ); q*)
inref^.u2:= dcm_in_port;
lock inref as dcbuf: dcbuftype do
dcbuf.next:= firstindex;
signal( inref, lam_sem^ )
end;
otherwise
begin
testout( opzone, "ill dcbuffer", inref^.u2 );
read_at_dc
end;
end; (* case u2 *)
\f
otherwise
begin
testout( opzone, "ill tsbuffer", inref^.u3 );
return( inref )
end;
end (* case routes *)
until false
end.
«eof»