|
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: 46080 (0xb400)
Types: TextFile
Names: »vcatctxt«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »vcatctxt«
(* vc(at)-connector alarmsystem *)
(**** short decription of process *****
PROCESS vcatc ( param );
declarations;
procedures;
functions;
BEGIN
start of lam-driver;
alloc of buffers;
initialiser variables;
REPEAT
read buffer to mess_ref;
rute , func , types := depend of u3 and u4;
*** classify buffer ***
CASE rute of
CASE types of
: buftype:=
END
END
action:= acttable ( vcatc_state , buftype );
*** make action ***
CASE action of
1 :
2 :
8 : lamspeak;
16 :
END
*** send buffer ***
CASE buftype of
END
UNTIL FALSE
END.
***)
\f
process vcatc(
name : alfa; (*name of this connector*)
sem_vector : system_vector; (**)
var
messem , (*input to connector*)
vchsem , (*output to vc-handler*)
lamsem , (*message to lam-driver*)
timeoutsem : semaphore; (*for booking and update*)
dc_address : macroaddr; (*macro addresse own dc*)
micadr : integer; (*micro adr for this vc(at)*)
canno : byte); (*cannel number to lamdriver*)
\f
const
version = "vers 1.15 /";
max_lbuf_needed = 5; (*------ consts used by LAMSPEAK ------*)
max_info_bytes = 2;
vcc_vch_ltime = -1;
max_int = 32767;
type
mask_unknown = record
fix : alarmlabel;
data: alarmlabel;
end;
mask_service = record
fix : alarmlabel;
data: integer;
end;
mask_poll = record
fix : alarmlabel;
error_count : integer;
poll_rate : integer;
end;
mask_vcm = record
fix : alarmlabel;
data : alarmnetaddr;
end;
mask_atvcdc = record
fix : alarmlabel;
at : alarmnetaddr;
vc : alarmnetaddr;
dc : alarmnetaddr;
end;
mask_atadr = record
fix : alarmlabel;
entry: at_addr_e;
end;
mask_atts = record
fix : alarmlabel;
entry: at_ts_e;
end;
mask_test = record
fix : alarmlabel;
data : array(1..5) of integer;
end;
ch_format = packed record
cntl_inf : byte;
time_inf : byte;
end;
state_type = (not_ready, (* initially table *)
passive, (* waiting start poll *)
active, (* polling state *)
lam_talk, (* lamspeak active *)
lam_need_buf, (* lamspeak waiting listenbuf *)
vcatc_need_buf, (* vcatc waiting listenbuf *)
wait_shorttime, (* waiting shorttime from vcath *)
stop_poll); (* send stop poll mess *)
buf_type = (unknown, (*unknown buffer*)
alarm , (*alarmbuffer*)
listen , (*listen buffer*)
table , (*buffer for update tables*)
report , (*buffer to vc(at)*)
service, (*buffer to vc(at)-connector*)
testat , (*testbuffer to vc(at)*)
operate, (*vc,dc operations*)
clock , (*poll pulse*)
ltime , (*longtime timeout*)
stime , (*shorttime timeout*)
lam , (*answer from lam-driver*)
used , (*current buffer on inner semaphore*)
empty , (*empty buffer to return*)
permiss); (* dc to vc ask buffer *)
input_type = (from_sem ,
from_listen_ref,
nothing );
(*------------- Types only used by the LAMSPEAK procedure ---------*)
to_telegram_type = packed record
to_data : 0..255; (* 8 bits *)
to_opcode : 0.. 3; (* 2 bits *)
to_serial_no : 0.. 1; (* 1 bit *)
to_check : 0.. 31 (* 5 bits *)
end;
lbuf_kind_type = (log, norm);
lbuf_record = record
kind : lbuf_kind_type;
noob : integer;
reci : alarmnetaddr;
opco : byte;
upda : 0..15;
resu : 0..15;
dta1 : byte;
dta2 : byte;
addr : alarmnetaddr
end;
oknok_type = (ok , nok); (* state of transmitter line *)
\f
var
test : boolean := true;
buftype : buf_type; (* type of current buffer *)
vcatc_state : state_type;
old_state : state_type;
input : input_type;
line : oknok_type; (* transmitter line state *)
lamspeak_state : (nottele, lettertovc, polling, letterfromvc, testi);
(* no of record's in tables *)
noatadr,
noatts ,
novcm ,
novce : integer := 0;
(*tables*)
atadrtable: array(1..vc_addr_l) of at_addr_e;(*atadrcode <=> netadr*)
attstable : array(1..at_ts_l ) of at_ts_e; (*ts addresse for at*)
vcmtable : array(1..vcmat_l ) of vcmat_e; (*vc addresse for potentiel guard transfer*)
vcetable : array(1..vce_l ) of vce_e; (*vc addresse with guardtransfer to this connector*)
rute : byte;
func,
types : func_grp;
found : boolean; (* auxiliary *)
action, (* auxiliary *)
intg_aux, (* auxiliary *)
next : integer; (* auxiliary *)
adr_code: byte;
own_dc ,
cur_vcm ,
zero_addr,
work : alarmnetaddr;
listen_ref, (* unused listenbufs *)
bookup_ref, (*booking or update timeout module*)
clock_ref, (*unused clockbuffer*)
timeout_ref, (*unused timeoutbuffer*)
tolam_ref, (* unused lambuffer *)
fromlam_ref, (* buffer from lamdriver *)
mess_ref : reference; (* current buffer *)
timeout_answer, (* immediately answer from timeout modul *)
quesem : semaphore; (* que of not processed bufs *)
lam_pool : pool 1 of integer; (* rettes til integer *)
tim_pool : pool no_vcc_tim of timers; (* rettes til timers *)
book_pool : pool no_vcc_upd of updates; (* rettes til updates *)
(* counters *)
pack_counter, (* no of mess to vch *)
trans_ok , (* succession of ok telegram *)
line_error_count, (* total number of transmiterror *)
no_of_listen, (* no of bufs on listensem *)
no_of_returned, (* no of received returned bufs *)
no_of_released, (* no of needless bufs released *)
no_of_unknown : integer:= 0; (* no of unknown messages received *)
index,object: integer; (*param to book and update*)
(* limits *)
serve_limit : integer := service_lim;
stoppoll_limit : integer := stop_poll_lim;
max_succ_errors : integer := max_succ_lin_err;
fix_incr_on_err : integer := trans_err_rate;
poll_delay : integer := poll_delay_time;
zout : zone; (* testoutput from modul *)
(*--------- Vars only used by the LAMSPEAK procedure ----------*)
speak_action : integer := 8; (* as p_ack in polling state *)
keep_the_telegram : to_telegram_type;
area_to_lam ,
area_from_lam : array (1..3) of byte;
lbuf_info : array (1..max_lbuf_needed) of lbuf_record;
keep_the_opcode : byte;
teletxt : alfa;
at_table_addr : alarmnetaddr;
atts_table_index : integer;
serial_no ,
succ_line_errors,
area_pointer ,
lbuf_needed : integer := 0;
below_serve_limit ,
below_stoppoll_limit,
lamtest,
boo : boolean := true;
\f
type
row = array(buf_type) of integer;
col = array(state_type) of row;
const
acttable = col (
(* u s o p *)
(* n l r e t p e *)
(* k a i t e r e e c l s e r *)
(* n l s a p v s r l t t u m m *)
(* o a t b o i t a o i i l s p i *)
(* w r e l r c a t c m m a e t s *)
(* n m n e t e t e k e e m d y s *)
(*not_ready *)row( 1, 2, 4, 5, 2, 2, 2, 2, 6, 6, 6, 6, 0,18, 2),
(*passive *)row( 1, 3, 4, 5, 3, 7, 3,15, 6,11,12, 6, 0,18, 3),
(*active *)row( 1, 8, 4, 5, 8, 7, 8,15, 8,11,12, 6, 0,18, 8),
(*lam_talk *)row( 1, 9, 4, 9, 9, 7, 9,15,10,11,12, 8, 0,18, 9),
(*lam_need_buf *)row( 1, 9, 8, 9, 9, 7, 9,15,10,11,12,17, 0,18, 9),
(*vcatc_need_buf*)row( 1, 9,13, 9, 9, 7, 9, 9,10, 6,14,17, 0,18, 9),
(*wait_shorttime*)row( 1, 9,16, 9, 9, 9, 9, 9,10, 6,14,17, 0,18, 9),
(*stop_poll *)row( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0));
\f
procedure update(ticks: integer);
(* update the booked timeoutbuffer *)
begin
bookup_ref^.u1:= update_req;
bookup_ref^.u4:= #hc4;
lock bookup_ref as buf: updates do
begin
buf.index := index;
buf.count := ticks;
buf.object:= object
end;
signal(bookup_ref,timeoutsem);
wait (bookup_ref,timeout_answer);
(*q if test then testout(zout,"update ",ticks*10+bookup_ref^.u2); q*)
end;
procedure book(ticks: integer);
(* booking of one modultimeout *)
begin
if not nil( timeout_ref ) then
begin
bookup_ref^.u1:= book_req;
bookup_ref^.u4:= #hc3;
lock bookup_ref as buf: updates do
begin
buf.count:= ticks;
buf.object:= ticks
end;
lock timeout_ref as buf: timers do
buf.object:= ticks;
push(timeout_ref,bookup_ref);
signal(bookup_ref,timeoutsem);
wait(bookup_ref,timeout_answer);
(*q if test then testout(zout,"book ",ticks*10+bookup_ref^.u2); q*)
lock bookup_ref as buf: updates do
begin
index := buf.index;
object:= buf.object
end
end
end;
\f
function get_adr_code(atadr: alarmnetaddr; var code: byte): boolean;
var
found: boolean;
begin
next:= 1;
found:= false;
while (not found) and (next<=noatadr) do
if atadr=atadrtable(next).at_addr then
begin
found:= true;
code := atadrtable(next).addr_code
end else next:= next+1;
get_adr_code:= found;
end;
function get_net_addr(var atadr: alarmnetaddr; code: byte): boolean;
var
found: boolean;
begin
next:= 1;
found:= false;
while (not found) and (next<=noatadr) do
if code = atadrtable(next).addr_code then
begin
found:= true;
atadr:= atadrtable(next).at_addr
end else next:= next+1;
get_net_addr:= found;
end;
function get_atts_index(tsadr: macroaddr; var index: integer): boolean;
var
found: boolean;
begin
next := 1;
found:= false;
while (not found) and (next<=noatts) do
if tsadr = attstable(next).ts_addr then
begin
found:= true;
index:= attstable(next).index
end else next:= next+1;
get_atts_index:= found;
end;
\f
procedure unknown_buf(error: byte);
(* returning of one unknown buffer *)
begin
buftype:= unknown;
mess_ref^.u4:= #h10;
lock mess_ref as buf: mask_unknown do
with buf do
begin
data:= fix;
fix.rec := own_dc;
fix.send.micro:= micadr;
fix.no_of_by := 2*label_size+2;
fix.result := error
end;
if no_of_unknown = max_int then no_of_unknown := 1
else
no_of_unknown:= no_of_unknown + 1;
end;
procedure return_buf( error: byte );
(* returned buffer to sender with error *)
begin
lock mess_ref as buf: alarmlabel do
with buf do
if send.micro < at_addr_limit then
begin (* receipt with error *)
buftype:= unknown;
mess_ref^.u4:= mess_ref^.u4 + 1;
rec := send;
send.micro := micadr;
result := error
end;
if buftype <> unknown then unknown_buf( error);
end;
procedure send_to_vch;
begin
if vcatc_state<vcatc_need_buf then
update(vcc_vch_ltime);
case mess_ref^.u4 div 16 of
4,8 : pack_counter:= (pack_counter+1) mod max_int;
otherwise
end;
signal(mess_ref,vchsem);
end;
\f
function get_listen_buf: boolean;
(* serving out one listenbuf from listen_ref *)
begin
if no_of_listen>0 then
begin
pop(mess_ref,listen_ref);
mess_ref^.u2:= 1;
buftype:= listen;
no_of_listen:= no_of_listen - 1;
(*q if test then testout(zout," no of li : ",no_of_listen); q*)
get_listen_buf:= true;
end else
get_listen_buf:= false
end;
procedure save_listen_buf;
(* save listenbuf from mess_ref to listen_ref *)
begin
push(mess_ref,listen_ref);
buftype:= used;
no_of_listen:= no_of_listen + 1;
(*q if test then testout(zout," no of li : ", no_of_listen); q*)
end;
\f
procedure lamspeak;
(***************************************************************
* *
* Function: Lamspeak is responsible for the communication *
* with VC(AT) via lamdriver, that is the protocol *
* for telegram communication is administrated by *
* lamspeak. *
* The VC(AT)-Conn is in state LAM_TALK. Lamspeak *
* can change vcatc_state to either ACTIVE or *
* LAM_NEED_BUF, else vcatc_state is unchanged *
* LAM_TALK. *
* *
* Externals: *
* *
* Parameters: None.
* *
* Semaphores: None.
* *
* Programmed june 1980 by SRS
* *
***************************************************************)
\f
const
p_ack = 0; data = 1; opr = 2;
status = 3; d_ack = 4; t_ack = 5;
nak = 6; free = 7;
type
from_telegram_type = packed record
from_data : 0..255; (* 8 bits *)
from_opcode : 0.. 7; (* 3 bits *)
from_check : 0.. 31 (* 5 bits *)
end;
mask_norm_lbuf = packed record
fix_label : alarmlabel;
norm_inf : byte
end;
mask_log_lbuf = packed record
fix_label : alarmlabel;
log_addr : alarmnetaddr;
log_opc : byte;
log_alarm : byte
end;
var
slave_opcode : integer;
slave_data : byte;
numb_of_bytes : integer := label_size;
lam_timeout : boolean := false;
boo : boolean := true;
\f
procedure calltest(var r : reference);
begin
(*x lock r as telegram : to_telegram_type do
begin
if serial_no=0 then
case telegram.to_opcode of
0: teletxt := " * POLL 0 ";
1: teletxt := " * DATA 0 ";
2: teletxt := " * TESTI 0 ";
3: teletxt := " * OPR 0 "
end
else
case telegram.to_opcode of
0: teletxt := " * POLL 1 ";
1: teletxt := " * DATA 1 ";
2: teletxt := " * TESTI 1 ";
3: teletxt := " * OPR 1 "
end;
testout(zout, teletxt, telegram.to_data);
end; x*)
end;
\f
procedure build_same_telegram( var r: reference );
begin
r^.u2 := canno;
lock r as telegram : to_telegram_type do
telegram := keep_the_telegram;
if lamtest then calltest( r );
end (* of procedure build_same_telegram *);
procedure build_serial_changed_telegram( var r: reference );
begin (* build the same telegram, but change serial_no *)
r^.u2 := canno;
serial_no := 1 - serial_no;
lock r as telegram: to_telegram_type do
begin
telegram := keep_the_telegram;
telegram.to_serial_no := serial_no
end (* of lock statement *);
boo := check5( r, generate);
lock r as telegram: to_telegram_type do
keep_the_telegram := telegram;
end (* of procedure build_serial_changed_telegram *);
\f
procedure build_a_poll_telegram( var r: reference );
begin
r^.u2 := canno;
lock r as telegram : to_telegram_type do
begin
(*----------------------------------- build up the buffer *)
serial_no := 1 - serial_no;
with telegram do
begin
(*------------------------------ build the telegram *)
to_opcode := 0;
to_serial_no:= serial_no;
to_data := 0;
if serial_no = 0 then
to_check := 10 (* as bits 01010 *)
else
to_check := 19; (* as bits 10011 *)
end;
(*---------------------------------- keep the telegram *)
keep_the_telegram := telegram;
end (* of lock statement *);
if lamtest then calltest( r );
end (* of procedure build_a_poll_telegram *);
\f
procedure build_a_letter_telegram( var r: reference );
begin
serial_no := 1 - serial_no;
r^.u2 := canno;
lock r as telegram : to_telegram_type do
begin (* build up the buffer *)
with telegram do
begin
if area_pointer = 1 then
to_opcode := 3 (* OPR master opcode *)
else
to_opcode := 1; (* DATA master opcode *)
to_serial_no := serial_no;
to_data := area_to_lam( area_pointer );
end;
end (* of lock statement *);
if lamtest then calltest( r );
boo := check5( r, generate ); (* complete the telegram *)
(*---------------------------- keep the telegram *)
lock r as telegram : to_telegram_type do
keep_the_telegram := telegram;
end (* of procedure build_a_letter_telegram *);
\f
procedure build_line_dep_telegram(
var r : reference;
line_was: oknok_type
);
(* Maybe the serial number at VC(AT) has been changed *
* of some unknown reason. Line_was = nok indicates *
* that the serial_no must be changed. *)
begin
if line_was = ok then
build_same_telegram( r )
else (* line was not ok *)
build_serial_changed_telegram( r);
end (* of procedure build_line_dep_telegram *);
\f
procedure build_an_lbuf(
var r : reference;
x : lbuf_record
);
begin
r^.u4 := x.opco;
case x.kind of
norm:
lock r as buf : mask_norm_lbuf do
begin
with buf.fix_label do
begin
no_of_by := x.noob;
rec := x.reci;
op_code := x.opco;
update := x.upda;
result := x.resu
end;
buf.norm_inf := x.dta1;
end;
log:
lock r as buf : mask_log_lbuf do
begin
with buf.fix_label do
begin
no_of_by := x.noob;
rec := x.reci;
op_code := x.opco;
update := x.upda;
result := x.resu
end;
buf.log_addr := x.addr;
buf.log_opc := x.dta1;
buf.log_alarm := x.dta2;
end
end (* of case on x.kind *);
end (* of procedure build_an_lbuf *);
\f
procedure demand_lbuf(
d_kind : lbuf_kind_type;
d_noob : integer;
d_reci : alarmnetaddr;
d_opco : byte;
d_upda : 0..15;
d_resu : 0..15;
d_dta1 : byte;
d_dta2 : byte;
d_addr : alarmnetaddr
);
begin
lbuf_needed := lbuf_needed + 1;
with lbuf_info( lbuf_needed ) do
begin
kind := d_kind;
noob := label_size + d_noob;
reci := d_reci;
opco := d_opco;
upda := d_upda;
resu := d_resu;
dta1 := d_dta1;
dta2 := d_dta2;
addr := d_addr
end;
end (* of procedure demand_lbuf *);
\f
procedure fault_at_line;
begin
if succ_line_errors <> max_int then
succ_line_errors := succ_line_errors + 1;
if succ_line_errors = max_succ_errors then
begin (*------ line alarm *)
if lam_timeout then (* timeout *)
demand_lbuf( norm, 1, own_dc, #h31, 0, 0,
at_tim_excess, 0, own_dc)
else (* not timeout *)
demand_lbuf( norm, 1, own_dc, #h31, 0, 0,
call, 0, own_dc );
lam_timeout := false;
end;
if line_error_count <= (max_int - fix_incr_on_err) then
line_error_count := line_error_count + fix_incr_on_err
else
line_error_count := max_int;
if (line_error_count >= serve_limit) and below_serve_limit then
begin (*------service alarm *)
(* high counter *)
demand_lbuf( norm, 1, own_dc, #h34, 0, 0,
call, 0, own_dc );
below_serve_limit := false;
end;
if (line_error_count >= stoppoll_limit) and below_stoppoll_limit then
begin (*------ stoppoll alarm *)
(* high counter *)
demand_lbuf( norm, 1, own_dc, #h35, 0, 0,
call, 0, own_dc );
below_stoppoll_limit := false;
end;
line := nok;
end (* of fault_at_line *);
\f
procedure ok_at_line;
begin
line_error_count := line_error_count - 1;
if line_error_count < 0 then
line_error_count := 0; (* Must not be negative *)
if (line_error_count < serve_limit) and not(below_serve_limit) then
begin (*------ recall service alarm *)
(* low counter *)
demand_lbuf( norm, 1, own_dc, #h34, 0, 0,
recall, 0, own_dc );
below_serve_limit := true;
end;
if (line_error_count < stoppoll_limit) and not(below_stoppoll_limit) then
begin (*------ recall stoppoll alarm *)
(* low counter *)
demand_lbuf( norm, 1, own_dc, #h35, 0, 0,
recall, 0, own_dc );
below_stoppoll_limit := true;
end;
if succ_line_errors >= max_succ_errors then
begin (*------recall line alarm *)
demand_lbuf( norm, 1, own_dc, #h31, 0, 0,
recall, 0, own_dc );
end;
succ_line_errors := 0;
line := ok;
(*q if test then
begin
testout(zout,"line state: ",ord(line));
testout(zout,"succ lineerr",succ_line_errors);
testout(zout,"lineerrcount",line_error_count);
end; q*)
end (* of ok_at_line *);
\f
procedure to_lam_driver;
(***********************************************************
* The buftype is alarm, report or testat. *
* Send a letter to VC(AT). A letter is always 3 telegrams *
* The reference to the message buffer is mess_ref and this *
* buffer will be released, ie buftype = empty. *
* The reference to the unused lam buffer is tolam_ref. *
* The letter is stored in the area_to_lam array *
************************************************************)
begin
keep_the_opcode := func * 16 + types;
case buftype of
testat : (* Send TESTI telegram by order of own DC *)
begin (* opcode 8,0 or 8,2 *)
serial_no := 1 - serial_no;
tolam_ref^.u2 := canno;
(*----------------------- build the telegram of TESTI *)
lock tolam_ref as telegram : to_telegram_type do
begin
with telegram do
begin
to_opcode := 2;
to_serial_no := serial_no;
if keep_the_opcode = #h80 then
to_data := 0
else
to_data := 1;
end;
end (* of lock statement *);
if lamtest then calltest( tolam_ref );
(*----------------------- complete the telegram *)
boo := check5( tolam_ref, generate );
(*----------------------- keep the telegram *)
lock tolam_ref as telegram : to_telegram_type do
keep_the_telegram := telegram;
lamspeak_state := testi;
signal( tolam_ref, lamsem );
end (* of testat *);
alarm,
report : (* Send a letter by order of an AT-CONNECTOR *)
begin
area_pointer := 1;
area_to_lam( 1 ) := keep_the_opcode;
area_to_lam( 2 ) := adr_code; (* a lookup in the AT-addr_table *
* is made outside lamspeak *)
lock mess_ref as buf : mask_norm_lbuf do
begin
numb_of_bytes := buf.fix_label.no_of_by;
if numb_of_bytes = label_size then
area_to_lam( 3 ) := 0
else (* nbbbbb numb_of_bytes must be label_size + 1 here *)
area_to_lam( 3 ) := buf.norm_inf;
if (keep_the_opcode=#h41) or (keep_the_opcode=#h85) then
case buf.fix_label.result of
0: area_to_lam(1) := keep_the_opcode (* accepted *)
otherwise area_to_lam(1) := keep_the_opcode+1 (* rejected *)
end (* of case *);
end (* of lock statement *);
build_a_letter_telegram( tolam_ref );
lamspeak_state := lettertovc;
signal( tolam_ref, lamsem );
end; (* of alarm, report *)
permiss : (* send a letter by order of own dc, opcode 6.4 *)
begin
area_pointer := 1;
area_to_lam(1) := keep_the_opcode;
lock mess_ref as buf: mask_vcm do
begin
boo := get_adr_code( buf.data, adr_code );
area_to_lam(2) := adr_code;
area_to_lam(3) := buf.fix.update; (* 0: says start at, 1: stop at *)
end; (* of lock statement *)
build_a_letter_telegram( tolam_ref );
lamspeak_state := lettertovc;
signal( tolam_ref, lamsem );
end (* of permiss *)
end (* of case *);
end (* of to_lam_driver *);
\f
procedure from_lam_driver;
var
hlp, i: integer;
begin
case lamspeak_state of
lettertovc : (* master telegram is opr or data ================*)
case slave_opcode of
p_ack,
data ,
opr : (* non expected answer on opr or data *)
speak_action := 1;
status:
speak_action := 14;
d_ack:
case area_pointer of
1: (* non expected answer on opr *)
speak_action := 1;
2: (* data sended for the first time *)
speak_action := 3
otherwise (* data sended for the third time *)
speak_action := 4
end (* of case on area_pointer *);
t_ack:
case area_pointer of
1: (* expected answer on opr *)
speak_action := 3
otherwise (* non expected answer on data *)
speak_action := 1
end (* of case on area_pointer *);
nak ,
free:
speak_action := 2;
end (* of case in lettertovc *);
letterfromvc: (* master telegram is poll =====================*)
case slave_opcode of
p_ack:
speak_action := 5;
data :
case area_pointer of
1:
speak_action := 1;
2:
speak_action := 6;
3:
speak_action := 7
end (* of case *);
opr ,
d_ack,
t_ack: (* non expected answer on poll *)
speak_action := 1;
status:
speak_action := 14;
nak ,
free :
speak_action := 2;
end (* of case in letterfromvc *);
polling: (* master telegram is poll ===========================*)
case slave_opcode of
p_ack:
speak_action := 8;
data ,
d_ack,
t_ack: (* non expected answer on poll *)
speak_action := 9;
opr :
speak_action := 10;
status:
speak_action := 14;
nak ,
free :
speak_action := 11;
end (* of case in polling *);
testi : (* master telegram is testi =============================*)
case slave_opcode of
p_ack ,
data ,
opr ,
d_ack : (* non expected answer on testi *)
speak_action := 1;
status:
speak_action := 14;
t_ack :
speak_action := 12;
nak ,
free :
speak_action := 2;
end (* of case in testi *)
end (* of case on lamspeak_state *);
case speak_action of (* the treatment of: "speak_actions" =======*)
1: (* non expected answers *)
begin
build_line_dep_telegram( tolam_ref, line );
fault_at_line;
signal( tolam_ref, lamsem )
end;
2: (* nak and free answers only *)
begin
fault_at_line;
build_same_telegram( tolam_ref );
signal( tolam_ref, lamsem )
end;
3: (* letter not finished *)
begin
ok_at_line;
area_pointer := area_pointer + 1;
build_a_letter_telegram( tolam_ref );
signal( tolam_ref, lamsem )
end;
4: (* letter finished, make receipt *)
begin
ok_at_line;
area_pointer := 1;
case area_to_lam(1) of
#h30, #h31, #h32 : (* make receipt of delivered alarm *)
begin
boo := get_net_addr( at_table_addr, area_to_lam(2) );
demand_lbuf( log, 6, own_dc, #h2, 0, 0,
area_to_lam(1), area_to_lam(3), at_table_addr )
end
otherwise (* nothing *)
end (* of case *);
(* make master poll to handle response from vc *)
build_a_poll_telegram( tolam_ref );
lamspeak_state := polling;
signal( tolam_ref, lamsem )
end;
5: (* poll answers leading to poll sending *)
begin
ok_at_line;
build_a_poll_telegram( tolam_ref );
signal( tolam_ref, lamsem )
end;
6:
begin
area_from_lam(area_pointer) := slave_data;
area_pointer := area_pointer + 1;
ok_at_line;
build_a_poll_telegram( tolam_ref );
signal( tolam_ref, lamsem )
end;
7: (* three gathered telegrams, make lbuf *)
begin
area_from_lam(area_pointer) := slave_data;
ok_at_line;
area_pointer := 1;
lamspeak_state := nottele;
(* send the letter via lbuf *)
hlp := area_from_lam(1);
case get_net_addr( at_table_addr, area_from_lam(2)) of
true :
begin
if (hlp = #h40) or (hlp = #h84) then (* "styr" or "test" *)
demand_lbuf( norm, 1, at_table_addr, hlp, 0, 0,
area_from_lam(3), 0, own_dc )
else
if (0 < hlp) and (hlp < 5) then (* "start at", "stop at" "-start at" -*)
begin
case hlp of
1, 3: i := 0; (* permission was "start at" *)
2, 4: i := 1 (* permission was "stop at" *)
end (* of case *);
demand_lbuf( log, 4, own_dc, #h65, i, area_from_lam(3),
0, 0, at_table_addr );
end
else
begin (* refuse command *)
area_to_lam(1) := #h10;
area_to_lam(2) := area_from_lam(2);
area_to_lam(3) := area_from_lam(3);
lamspeak_state := lettertovc;
build_a_letter_telegram( tolam_ref );
signal( tolam_ref, lamsem );
end;
end;
false:
begin
if (hlp = #h40) or (hlp = #h84) then
area_to_lam(1) := hlp + 3
else
if (0<hlp) and (hlp<5) then
area_to_lam(1) := #h65
else
area_to_lam(1) := #h10;
area_to_lam(2) := area_from_lam(2);
area_to_lam(3) := area_from_lam(3);
lamspeak_state := lettertovc;
build_a_letter_telegram( tolam_ref );
signal( tolam_ref, lamsem );
end (* of false *)
end (* of case on check *);
end (* of action 7 *);
8: (* a single poll caused by a clockpulse *)
begin
ok_at_line;
buftype := used;
lamspeak_state := nottele
end (* of action 8 *);
9: (* non expected answers caused by a single poll *)
begin
fault_at_line;
buftype := used;
lamspeak_state := nottele
end (* of action 9 *);
10: (* first telegram of a letter is comming *)
begin
ok_at_line;;
area_from_lam(1) := slave_data;
area_pointer := 2;
build_a_poll_telegram( tolam_ref );
lamspeak_state := letterfromvc;
signal ( tolam_ref, lamsem )
end (* of action 10 *);
11: (* nak and free answers in polling state only *)
begin
fault_at_line;
buftype := used;
lamspeak_state := nottele
end;
12: (* usable answers on master testi *)
begin
case slave_data of
21 : (*------ test=nok, line=ok *)
begin
ok_at_line;
demand_lbuf( norm, 0, own_dc, keep_the_opcode+1, 0, rejected,
0, 0, own_dc );
(*------ 8.1 or 8.3 demanded *)
buftype := used;
lamspeak_state := nottele;
end;
6 : (*------ test=ok, line=ok *)
begin
ok_at_line;
demand_lbuf( norm, 0, own_dc, keep_the_opcode+1, 0, accepted,
0, 0, own_dc );
(*------ 8.1 or 8.3 demanded *)
buftype := used;
lamspeak_state := nottele;
end
otherwise
begin
fault_at_line;
build_same_telegram( tolam_ref );
signal( tolam_ref, lamsem );
end;
end (* of case on slave_data *);
end (* of action 12 *);
13: (* empty *);
14: (* status answers *)
begin
demand_lbuf( norm, 1, own_dc, #h32, 0, 0,
slave_data, 0, own_dc );
ok_at_line;
build_serial_changed_telegram( tolam_ref);
signal( tolam_ref, lamsem )
end (* of action 14 *);
end (* of case on speak_action *);
end (* of from_lam_driver procedure *);
\f
begin
(*******************************************
**** the body of the lamspeak procedure ****
********************************************)
(*q if test then testout(zout,"speak st in ",ord(lamspeak_state)); q*)
case buftype of
clock : (* <--------<< *)
(* ------ No nessage buffer is involved. *
* ------ The lam buffer is idle at tolam_ref. *)
begin
build_a_poll_telegram( tolam_ref );
lamspeak_state := polling;
signal( tolam_ref, lamsem );
end;
permiss,
alarm, (* <--------<< *)
report,
testat:
(* the message buffer is involved at mess_ref. *
* return this buffer, ie buftype := empty. *
* The lam buffer is idle at tolam_ref. *)
begin
to_lam_driver;
buftype := empty;
end;
lam :
(* The message buffer is a lam buffer, that is *
* the lam buffer is not idle. *
* Transfer the reference, ie tolam_ref :=: mess_ref. *)
begin
tolam_ref :=: mess_ref;
lock tolam_ref as telegram : from_telegram_type do
begin (*----- get all the information needed *)
slave_opcode := telegram.from_opcode;
slave_data := telegram.from_data;
end;
(*x if lamtest then
begin
case slave_opcode of
0: teletxt := " P-ACK ";
1: teletxt := " DATA ";
2: teletxt := " OPR ";
3: teletxt := " STATUS ";
4: teletxt := " D-ACK ";
5: teletxt := " T-ACK ";
6: teletxt := " NAK ";
7: teletxt := " FREE "
end;
testout(zout, teletxt, slave_data);
end; x*)
if check5( tolam_ref, check ) = false then
begin
slave_opcode := free;
if lamtest then testout(zout,"CHEHK5FAULT ",slave_opcode);
end;
if tolam_ref^.u2 <> 0 then
begin
slave_opcode := free;
if tolam_ref^.u2 = 5 then
begin
lam_timeout := true;
(*x if lamtest then testout(zout,"LAMTIMEOUT ",slave_opcode); x*)
end;
(*x if lamtest then testout(zout,"LAMFAULT ",tolam_ref^.u2); x*)
end;
from_lam_driver;
end;
listen : (* <--------<< *)
(* The listen buffer is refered to by mess_ref. *)
begin
(*---- Nb ---- if lbuf_needed < 1 the program fault *)
build_an_lbuf( mess_ref, lbuf_info( lbuf_needed ) );
lbuf_needed := lbuf_needed - 1;
buftype := listen;
end
otherwise
(*-------- Nb --- program fault *);
end (* of case on buftype *);
if lamspeak_state = nottele then
vcatc_state := active;
if lbuf_needed > 0 then
begin
(*q if test then testout(zout,"lbuf needed:",lbuf_needed); q*)
vcatc_state := lam_need_buf;
if no_of_listen > 0 then
input := from_listen_ref; (* There is a lbuf *)
end;
(*q if test then testout(zout,"speak st out",ord(lamspeak_state)); q*)
end (* of lamspeak procedure *);
\f
begin (***** main program *****)
(* initier module *)
own.incname := name;
testopen(zout,name,sem_vector(operatorsem));
testout(zout, version, al_env_version);
testout (zout, "chann/addr ", canno*1000+micadr);
alloc(mess_ref,lam_pool,messem);
with mess_ref^ do
begin
u1:= create_at_ch;
u2:= canno;
u3:= lam_route
end;
lock mess_ref as buf : ch_format do
with buf do
begin
cntl_inf:= at_control;
time_inf:= con_lam_time
end;
signal(mess_ref,lamsem);
(* initier timeout buffers *)
alloc(bookup_ref,book_pool,timeout_answer);
bookup_ref^.u3:= tim_route1;
alloc(clock_ref,tim_pool,messem);
with clock_ref^ do
begin
u1:= delay_req;
u3:= tim_route;
u4:= #hc1
end;
lock clock_ref as buf: timers do
buf.object:= poll_delay;
alloc(timeout_ref,tim_pool,messem);
with timeout_ref^ do
begin
u1:= book_req;
u3:= tim_route1;
u4:= #hc2
end;
\f
line := ok;
input := from_sem;
vcatc_state := not_ready; (* <--------<< *)
old_state := not_ready;
lamspeak_state := nottele;
zero_addr := alarmnetaddr(macroaddr(0,0,0),0);
cur_vcm := zero_addr;
own_dc.macro := dc_address;
own_dc.micro := 0;
\f
repeat
(* read one new buffer *)
(*q if test then
begin
testout(zout," input : ",ord(input));
testout(zout," vcatc st : ",ord(vcatc_state));
end; q*)
case input of
from_sem :
case vcatc_state of
not_ready..active : if not nil(fromlam_ref) then
mess_ref :=: fromlam_ref else
if open(quesem) then
wait(mess_ref,quesem) else
wait(mess_ref,messem);
lam_talk : if not nil(fromlam_ref) then
mess_ref :=: fromlam_ref else
wait(mess_ref,messem);
otherwise wait(mess_ref,messem)
end;
from_listen_ref :
begin
found:= get_listen_buf;
input:= from_sem
end;
nothing : input:= from_sem
otherwise
end;
(* classify buffer *)
rute := mess_ref^.u3;
func := mess_ref^.u4 div 16;
types:= mess_ref^.u4 mod 16;
(*q if test then
begin
testout(zout," route : ",rute);
testout(zout," functype : ",func*100+types);
end; q*)
case rute of
tim_route : (* delay from timeoutmodule *)
case types of
1 : buftype:= clock
otherwise buftype:= empty
end;
tim_route1 : (* timeout answer and longtimeout *)
case types of
2 : lock mess_ref as buf : timers do
if buf.object = vcc_vch_ltime then
buftype:= ltime else
if buf.object = vcc_vch_stime then
buftype:= stime else buftype:= empty
otherwise buftype:= empty
end;
netc_route : (*buffer from vch*)
case func of
1 : case types of
0 : buftype:= empty
otherwise unknown_buf(unknown_opcode)
end;
3 : case types of
0,1,2 : buftype:= alarm (* at --> vcat *)
otherwise unknown_buf(unknown_opcode)
end;
4 : case types of
1 : buftype:= report (* at --> vcat *)
otherwise unknown_buf(unknown_opcode)
end;
6 : case types of
2 : return_buf( accepted); (* dc --> dc *)
4 : buftype := permiss (* dc --> vc *)
otherwise unknown_buf( unknown_opcode )
end;
8 : case types of
0,2 : buftype:= testat; (* dc --> vcat *)
5 : buftype:= report (* at --> vcat *)
otherwise unknown_buf(unknown_opcode)
end;
9 : case types of
0 : buftype:= operate
otherwise unknown_buf(unknown_opcode)
end;
10 : case types of
2,4 : buftype:= table
otherwise unknown_buf(unknown_opcode)
end;
11 : case types of
2,4,6,8,10,12,14 : buftype:= service
otherwise unknown_buf(unknown_opcode)
end;
12 : case types of
5 : buftype:= listen
otherwise unknown_buf(unknown_opcode)
end
otherwise unknown_buf(unknown_opcode)
end;
lam_route : (* buffer from lamdriver *)
buftype:= lam
otherwise unknown_buf(unknown_route)
end;
\f
(* make action *)
action:= acttable(vcatc_state,buftype);
(*q if test then
begin
testout(zout," buftype : ",ord(buftype));
testout(zout," action : ",action);
end; q*)
case action of
1 : (* no action, has been taken *);
2 : (* not ready *)
return_buf(modul_not_ready);
3 : (* passive , alarm/report/testat received *)
if cur_vcm <> zero_addr then
(* send to current vcm *)
lock mess_ref as buf: alarmlabel do
buf.rec:= cur_vcm
else
return_buf(modul_passive);
4 : (* save listenbuf *)
save_listen_buf;
5 : (* update table *)
begin
case types of
2 : (* at_addr *)
lock mess_ref as buf : mask_atadr do
with buf do
if fix.update = remove_code then
begin (* delete *)
if get_adr_code(entry.at_addr,adr_code) then
begin (* found *)
atadrtable(next):= atadrtable(noatadr);
noatadr:= noatadr - 1;
fix.result:= accepted;
end else
begin (* not found *)
fix.result:= not_found;
end;
end else
if fix.update = insert_code then
begin (* insert *)
if noatadr < at_addr_l then
begin (* ok *)
noatadr:= noatadr + 1;
(*q if test then testout(zout," noatadr : ",noatadr); q*)
atadrtable(noatadr):= entry;
fix.result:= accepted;
end else
begin (* no room *)
fix.result:= no_room;
end;
end else
fix.result:= update_error;
4 : (* at-ts *)
lock mess_ref as buf: mask_atts do
with buf do
if fix.update = remove_code then
begin (* delete *)
if get_atts_index(entry.ts_addr,intg_aux) then
begin (* found *)
attstable(next):= attstable(noatts);
noatts:= noatts-1;
fix.result:= accepted;
end else
begin (* not found *)
fix.result:= not_found;
end
end else
if fix.update = insert_code then
begin (* insert *)
if noatts < at_ts_l then
begin (* ok *)
noatts:= noatts+1;
attstable(noatts):= entry;
fix.result:= accepted;
end else
begin (* no room *)
fix.result:= no_room;
end;
end else
fix.result:= update_error;
otherwise (* nothing *)
end;
end;
6 : (* save received buffer *)
begin
case buftype of
clock : clock_ref :=: mess_ref;
ltime,
stime : timeout_ref :=: mess_ref;
lam :
begin
mess_ref^.u1:= write_read_at;
tolam_ref :=: mess_ref;
if vcatc_state=not_ready then
begin
book(vcc_vch_ltime);
vcatc_state:= passive (* <--------<< *)
end
end
otherwise (* nothing *)
end;
buftype:= used
end;
7 : (* service on variable limit and counters *)
begin
lock mess_ref as buf: alarmlabel do
buf.result:= accepted;
case types of
2 : (* read line error count *)
lock mess_ref as buf: mask_service do
with buf do
case fix.update of
read_code : data:= line_error_count;
insert_code: line_error_count:= data
otherwise fix.result:= update_error
end;
4 : (* read pack counter *)
lock mess_ref as buf: mask_service do
with buf do
case fix.update of
read_code : data:= pack_counter
otherwise fix.result:= update_error
end;
6 : (* update service limit *)
lock mess_ref as buf: mask_service do
with buf do
case fix.update of
read_code : data:= serve_limit;
insert_code : serve_limit:= data
otherwise fix.result:= update_error
end;
8 : (* read current vcm *)
lock mess_ref as buf: mask_vcm do
with buf do
case fix.update of
read_code : data:= cur_vcm
otherwise fix.result:= update_error
end;
10 : (* update stoppoll limit *)
lock mess_ref as buf: mask_service do
with buf do
case fix.update of
read_code : data:= stoppoll_limit;
insert_code : stoppoll_limit:= data
otherwise fix.result:= update_error
end;
12 : (* update max succ errors *)
lock mess_ref as buf: mask_service do
with buf do
case fix.update of
read_code : data:= max_succ_errors;
insert_code : max_succ_errors:= data
otherwise fix.result:= update_error
end;
14 : (* intern tests *)
lock mess_ref as buf: mask_test do
with buf do
case fix.update of
0 : (* test off *)
test:= false;
1 : (* test on *)
test:= true;
2 : (* lamtest off *)
lamtest := false;
3 : (* lamtest on *)
lamtest := true;
4 : (* get variable *)
begin
data(1):= no_of_listen;
data(2):= no_of_returned;
data(3):= no_of_released;
data(4):= no_of_unknown;
end;
5 : (* get states *)
begin
data(1):= ord(vcatc_state);
data(2):= ord(lamspeak_state);
data(3):= ord(input);
data(4):= poll_delay mod 256;
end;
otherwise fix.result:= update_error;
end;
otherwise (* nothing *)
end
end;
8 : (* call lamspeak *)
begin
found:= true;
case buftype of
report,
alarm : lock mess_ref as buf: alarmlabel do
begin
work:= buf.send;
found:= get_adr_code(work,adr_code);
buf.op_code:= adr_code
end;
clock : signal(mess_ref,timeoutsem)
otherwise (* nothing *)
end;
if found then
begin
vcatc_state:= lam_talk; (* <--------<< *)
lamspeak
end else unknown_buf(sender_error)
end;
9 : (* save mess_ref *)
begin
signal(mess_ref,quesem);
buftype:= used
end;
10 : (* restart clock *)
signal(mess_ref,timeoutsem);
11 : (* long timeout *)
begin
timeout_ref :=: mess_ref;
buftype:= used;
old_state:= vcatc_state;
if get_listen_buf then
begin (* listenbuf found *)
mess_ref^.u2:= 0; (* empty databuffer *)
book(vcc_vch_stime);
vcatc_state:= wait_shorttime; (* <--------<< *)
end else
begin (* listenbuf not found *)
vcatc_state:= vcatc_need_buf; (* <--------<< *)
end
end;
12 : (* book longtime *)
begin
timeout_ref :=: mess_ref;
book(vcc_vch_ltime)
end;
13 : (* listenbuf ready to vcatc *)
begin
mess_ref^.u2:= 0; (* empty databuffer *)
book(vcc_vch_stime);
vcatc_state:= wait_shorttime (* <--------<< *)
end;
14 : (* modul error *)
(* temporary solution *)
begin
timeout_ref :=: mess_ref;
testout(zout,"timeout vch ",ord(vcatc_state));
vcatc_state := passive;
book(vcc_vch_ltime)
end;
15 : (* dc or vc operations *)
case types of
0 : (* order to start or stop polling *)
lock mess_ref as buf: mask_poll do
with buf do
case fix.update of
stop_code : (* stop poll *)
if vcatc_state <> passive then
begin
area_pointer := 1;
lamspeak_state := nottele; (* lamspeak is initialized *)
vcatc_state:= passive; (* <--------<< *)
fix.result:= accepted;
end else
fix.result:= rejected;
start_code : (* start poll *)
if (vcatc_state=passive) and (not nil(tolam_ref)) and (not nil(clock_ref)) then
begin
vcatc_state:= active; (* <--------<< *)
poll_delay:= poll_rate;
lock clock_ref as cbuf: timers do
cbuf.object:= poll_delay;
signal(clock_ref,timeoutsem); (* start clock timeout *)
fix.result:= accepted;
line_error_count:= error_count;
end else
fix.result:= rejected;
otherwise fix.result:= update_error;
end;
2 : (* at-vc control *)
begin
lock mess_ref as buf: mask_atvcdc do
with buf do
begin
buftype:= alarm;
if fix.send = at then
begin
fix.send:= fix.rec;
fix.rec := dc;
fix.result:= accepted;
end else
if fix.send = dc then
begin
fix.send:= fix.rec;
fix.rec := at;
fix.result:= accepted;
end else
buftype := unknown;
end;
if buftype = unknown then unknown_buf( sender_error);
end
otherwise (* nothing *)
end;
16 : (* one listenbuf arrived before shorttimeout *)
begin
save_listen_buf;
input:= from_listen_ref;
vcatc_state:= old_state (* <--------<< *)
end;
17 : (* lambuf arrived before lamspeak ready *)
fromlam_ref :=: mess_ref;
18 : (* returned buffer with opcode 1.0 *)
if no_of_returned = max_int then
no_of_returned := 1
else
no_of_returned:= no_of_returned + 1
otherwise unknown_buf(rejected)
end (* case *);
\f
(* send buffer *)
(*q if test then
testout(zout,"buftype out:",ord(buftype)); q*)
case buftype of
operate,
table ,
service:
begin (* receipt in current buffer , back to sender *)
mess_ref^.u3:= 6;
mess_ref^.u4:= mess_ref^.u4 + 1;
lock mess_ref as buf: alarmlabel do
begin
buf.rec:= buf.send;
buf.send.micro:= micadr;
end;
send_to_vch
end;
unknown:
begin (* send buffer to own dc or sender *)
mess_ref^.u3:= 6;
send_to_vch
end;
listen:
begin (* new listenbuffer are used *)
mess_ref^.u3:= 7; (* request listenbuffer *)
lock mess_ref as buf: alarmlabel do
buf.send.micro:= micadr;
send_to_vch
end;
report,
testat,
alarm:
begin (* send to other receiver *)
mess_ref^.u3:= 6;
send_to_vch
end;
empty:
begin (* buffer is empty, release to pool *)
mess_ref^.u2:= 0;
mess_ref^.u3:= 6;
return(mess_ref)
end
otherwise (* nothing *)
end (* send buffer *);
if input <> nothing then
if not nil(mess_ref) then
begin (* needless buffer , possible program error *)
(*q if test then testout(zout,"released : ",mess_ref^.u4); q*)
if no_of_released=max_int then
no_of_released:= 1 else
no_of_released:= no_of_released + 1;
return(mess_ref);
end;
until false;
end.
▶EOF◀