|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 70656 (0x11400)
Types: TextFile
Names: »tsdcsjob1«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »tsdcsjob1«
\f
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.16 /";
(*---------------------------------------------------------------------
- -
- 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_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;
state_set = SET OF state_range;
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";
txt_package = "pakke";
txt_counter = "tæller";
txt_limit = "grænse";
\f
\f
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;
receiver : alarmnetaddr;
sender : alarmnetaddr;
opc : byte;
func_res : byte;
ts_add : ts_time;
data : ARRAY (1..2) OF byte;
END;
logstatustype
= RECORD
a_label : alarmlabel;
receiver : alarmnetaddr;
sender : alarmnetaddr;
opc : byte;
func_res : byte;
ts_add : ts_time;
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 : PACKED ARRAY( 1..14 ) OF 0..15;
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;
\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;
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;
END;
\f
(*--------- pools ---------------------------------*)
VAR
timeout_pool : pool 1 OF ts_time;
lam_buf_pool : pool max_lam_bufs OF dcbuftype;
(*--------- references -----------------------------*)
timeout_buf_ref,
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;
(*--------- others ---------------------------------*)
opr_code : byte;
\f
(*--------- integers -------------------------------*)
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;
(*--------- booleans -------------------------------*)
(*q test_b : boolean := true; q*)
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;
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;
dc_number : 0..15 := 0;
\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 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 )
\f
;
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 range_ok( first, last: param_range; min, max: integer ): boolean;
VAR
ok : boolean;
ix : param_range;
BEGIN
ix:= first;
WHILE ok AND ( ix <= last ) DO
BEGIN
ok:= ok AND ( min <= params( ix ) ) AND ( params( ix ) <= max );
ix:= ( ix + 1 ) MOD max_params
END;
range_ok:= ok;
IF NOT ok THEN
outstring( 5, txt_range )
END; (* function range_ok *)
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;
\f
\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
\f
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
timeout_buf_ref^.u1:=5;
LOCK timeout_buf_ref AS buf: ts_time DO
BEGIN
buf( 0 ):= hh;
buf( 1 ):= 100 * mm
END;
signal (timeout_buf_ref, timeout_sem^);
REPEAT
wait( timeout_buf_ref, timeout_answer_sem.w^);
IF ( timeout_buf_ref^.u3 = dummy_route ) THEN
return( timeout_buf_ref )
UNTIL NOT nil( timeout_buf_ref );
timeout_buf_ref^.u1:= 2
END;
\f
FUNCTION gettime : ts_time;
(***********************************************
* gets the actual time at timeout-module *
************************************************)
BEGIN
signal( timeout_buf_ref, timeout_sem^);
REPEAT
wait( timeout_buf_ref, timeout_answer_sem.w^);
IF ( timeout_buf_ref^.u3 = dummy_route ) THEN
return( timeout_buf_ref )
UNTIL NOT nil( timeout_buf_ref );
LOCK timeout_buf_ref 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;
receive_adr : alarmnetaddr;
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:= receive_adr;
send.macro.dc_addr:= dc_number;
send.macro.nc_addr:= 0;
send.macro.ts_addr:= 0;
send.micro:= 0;
op_code:= opr_code;
update:= upd_code;
result:= 0
END;
WITH tsc_listen_ref^ DO
BEGIN
u3:= dc_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;
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;
dc_number:= 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( p1, p2, p3, p4: integer; opcode: byte; op_add: char );
BEGIN
IF macro_ok( p1, p2, p3 ) AND ( p4 >= 0 ) THEN
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:= addr( packmacro( p1, p2, p3 ), p4 );
build_alarm_label( 4,
addr( ts_db( ts_ix ).ts_address, 0 ), opcode + ord( op_add <> "n" ), 0 )
END
END
ELSE
outstring( 5, txt_range )
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
PROCEDURE update_pax_table(
receiver_macro : macroaddr;
tbl_ix : integer;
new_macro : macroaddr;
update_kind : update_range
);
VAR
ix : param_range;
BEGIN
LOCK tsc_listen_ref AS m1012: mess_1012_type DO
WITH m1012 DO
BEGIN
pax_tbl_ix:= tbl_ix;
al_mac_addr:= new_macro;
FOR ix:= 1 TO 14 DO
ext_pax_address( ix ):= params( ix + 2 );
stream_no:= params( 17 );
max_retrans:= params( 18 )
END;
build_alarm_label( 11, addr( receiver_macro, netc_mic_addr ), #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;
\f
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;
alloc( timeout_buf_ref, timeout_pool, timeout_answer_sem.s^);
timeout_buf_ref^.u1:=2;
timeout_buf_ref^.u3:=1;
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 : (* from ts-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 );
\f
#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 DO
BEGIN
opr_code:= logmess.opc;
write_to_from( receiver, sender )
END;
IF ( opr_code <> #h32 ) THEN
LOCK inref AS logmess: logmesstype DO
WITH logmess DO
BEGIN
CASE opc 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
\f
outstring( 7, txt_connected );
outstring( 5, txt_test );
END
;
OTHERWISE
write_op_code( opr_code )
END;
IF NOT ( opc IN (.#h30, #h31.) ) THEN
BEGIN
IF ( ( opc MOD 2 ) = 0 ) THEN
outstring( 6, txt_send )
ELSE
outstring( 9, txt_receipt )
END
ELSE
outstring( 6, txt_alarm );
IF NOT ( opc IN (.#hc8, #hc9.) ) THEN
BEGIN
IF ( opc <> #h31 ) THEN
write_param( data( 1 ), 3 )
ELSE
write_line_state( data( 1 ) )
END;
IF ( func_res MOD 16 ) <> accepted THEN
writeresult( func_res MOD 32 )
END (* with *)
\f
ELSE
(* statusalarm from at *)
LOCK inref AS l: logstatustype DO
WITH l DO
BEGIN
IF find_at( at_ix, sender ) 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, #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 ), #h68, remove_code )
END
ELSE
BEGIN
outstring( 4, txt_star );
outstring( 12, txt_request )
\f
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, #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 ), #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 )
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
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 ), 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( params( 1 ), 0, 0, 0,
#h20, "n" )
;
2:
broadcast( params( 1 ), params( 2 ), 0, 0 ,
#h22, "n" )
;
3:
broadcast( params( 1 ), params( 2 ), params( 3 ), 0,
#h24, "n" )
;
4:
broadcast( params( 1 ), params( 2 ), params( 3 ), params( 4 ),
#h26 + 2 * ord( params( 4 ) > max_byte ), "n" )
;
OTHERWISE
write_error( 6, 7, 4 )
END
END
ELSE
write_error( 7, 5, 2 )
;
*>
\f
"d": (* districtcenter number *)
IF params_ok( 1 ) THEN
IF macro_ok( params( 1 ), 0, 0 ) THEN
BEGIN
IF ( no_of_dc = 0 ) THEN
BEGIN
dc_number:=params( 1 );
start_new_line;
outstring( 6, txt_create );
outstring( 2, txt_ts );
newline
END
ELSE
outstring( 5, txt_known )
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, #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
\f
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 ), #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, #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, #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, #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 ), #h68, remove_code )
\f
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 ) ), #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 ), #h74, remove_code )
END
ELSE
build_alarm_label( 0,
addr( ac_addr.macro, vch_mic_addr ), #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 ), 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 ), #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 ),
#haa, insert_code )
END
ELSE
write_error( 3, 4, no_sac_e )
\f
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 ), #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, #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, #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, #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, #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 ) AND
( params( 6 ) IN ts_db( ts_ix ).ports_used ) THEN
outstring( 4, txt_port )
ELSE
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), #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( packmacro( dc_number, 0, 0 ), 0 );
vc_arrange:= 0;
vc_relief:= false
END;
build_alarm_label( 7,
ac_addr, #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 ), #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, #ha6, insert_code )
END
(**)
END
\f
END
ELSE
write_error( 1, 4, no_of_ac )
END
ELSE
write_error( 1, 3, max_no_ac )
ELSE
outstring( 5, txt_param )
;
\f
"t" : (* terminalstation *)
IF params_ok( 18 ) THEN
IF macro_ok( dc_number, params( 1 ), params( 2 ) ) AND
range_ok( 3, 16, 0, 15 ) AND range_ok( 16, 17, 0, max_byte ) THEN
IF no_of_ts < max_no_ts THEN
BEGIN
IF find_ts( ts_ix,
packmacro( dc_number, params( 1 ), params( 2 ) ) ) THEN
outstring( 5, txt_known )
ELSE
IF find_ts( ts_ix, macroaddr( 0, 0, 0 ) ) THEN
BEGIN
no_of_ts:= no_of_ts + 1;
WITH ts_db( ts_ix ) DO
BEGIN
ts_address:= packmacro( dc_number, params( 1 ), params( 2 ) );
IF no_of_ts = 1 THEN
BEGIN
ports_used:= ports_used + (.1.); (* dcs port number *)
update_pax_table( empty_addr.macro, 1, ts_address, insert_code );
update_pax_table( ts_address, 2, packmacro( dc_number, 0, 0 ), insert_code )
END
ELSE
BEGIN
LOCK tsc_listen_ref AS m:mess_110_type DO
WITH m DO
BEGIN
tss_macro:=ts_address;
xx:=0;
dc_ts_macro:= ts_db( 1 ).ts_address
END;
build_alarm_label( 6,
\f
empty_addr, #hb0, insert_code )
END
END;
FOR ts_ix:= 1 TO no_of_ts DO
WITH ts_db( ts_ix ) DO
IF ( ts_address <> packmacro( dc_number, params( 1 ), params( 2 ) ) ) THEN
update_pax_table( ts_address, ( 6 + no_of_ts ),
(**) packmacro( dc_number, params( 1 ), params( 2 ) ), insert_code );
END
ELSE
write_error( 3, 4, no_of_ts )
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
---------------------------------------------------*)
IF params_ok( 5 - ord( command1( 3 ) = "o" ) ) THEN
IF addr_ok( 1 ) THEN
CASE command1( 3 ) OF
"a", "o", "r":
IF ( command2( 1 ) = "p" ) 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 ), #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
BEGIN
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, #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, #h64, dc_request - ord( dc_request = service_code ) );
IF ( noofparams = 5 ) THEN
poll_delay:= params( 5 )
END
END
END
ELSE
outstring( 6, txt_unknown )
ELSE
write_error( 6, 5, 2 )
;
\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 ), 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◀