|
DataMuseum.dkPresents historical artifacts from the history of: RC3500 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC3500 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 25344 (0x6300)
Types: TextFileVerbose
Names: »tssjob«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »tssjob«
job hj 3 200 time 11 0 area 10 size 100000
( message ts supervisor
source = copy 25.1
tssuperlst = set 1 disc1
tssuperlst = indent source mark lc
listc = cross tssuperlst
o errors
message ts supervisor
pascal80 spacing.12000 codesize.12000 alarmenvc source
o c
lookup pass6code
if ok.yes
( tssuperbin = set 1 disc1
tssuperbin = move pass6code
scope user tssuperbin
; if ok.yes
; newjob linktssjob
)
tssuperlst = copy listc errors
scope user tssuperlst
convert errors
finis
)
\f
(*----------------------------------------------------*)
(* *)
(* ts supervisor *)
(* *)
(*----------------------------------------------------*)
process tssupervisor (
procname: alfa; (* process ident *)
opsem: sempointer; (* allocator, operator *)
var sem : !ts_pointer_vector (* ts semaphores *)
);
const
version= "vers 2.00 /";
(*---------------------- externals -------------------------------*)
process timeout ( pn: alfa; opsem: sempointer;
var tim: !ts_pointer; t, m: integer );
external;
process tsconnector ( pn:alfa; opsem: sempointer;
var tss, dc, lam, tim, com : !sempointer;
var net, s1, s2, s3, s4, s5: !ts_pointer );
external;
process at_handler ( pn: alfa; opsem: sempointer;
var dca : !alarmnetaddr;
var sem : !ts_pointer_vector );
external;
process vc_handler ( pn: alfa; opsem: sempointer;
var dca : !alarmnetaddr;
var sem : !ts_pointer_vector );
external;
process lam ( pn: alfa; opsem: sempointer;
pu, level: integer;
var main_sem: !ts_pointer
);
external;
\f
const
maxroute = 12; (* for u3 routing *)
type (*----------------- options ------------------------------*)
grouptable = array (func_grp) of integer;
modulref = ( netc, vch, ath, traffic, nc, dc, tss, dummy, empty );
modulident = array (netc..ath) of byte;
modultable = array (modulref) of integer;
modulstate = array (modulref) of boolean;
modulroute = array (0..maxroute) of modulref;
const (*-------------- options -------------------------------*)
traffic_id = 24; (* for time_out *)
nc_ident = 25;
dc_ident = 26;
microadr = modultable ( netc_mic_addr, vch_mic_addr, ath_mic_addr,
traffic_id, nc_ident, dc_ident, 0, 0, 0 );
book_id = modulident(1,2,3);
interval = modultable(tss_netc_time,tss_vch_time,tss_ath_time,
tss_nc_ltime,tss_nc_stime,tss_dc_stime,-1,-1,-1);
from = modulroute(tss,tss,netc,netc,ath,ath,4***vch,3***tss);
u3val= modulident(netc_route1, netc_route, netc_route);
(*-------------------- op codes ---------------------------------*)
log_code = #h00; (* 0.0 *)
addr_error = #h11; (* 1.1 *)
dc_down = #h20; (* 2.0 *)
dc_up = #h21; (* 2.1 *)
nc_down = #h22; (* 2.2 *)
nc_up = #h23; (* 2.3 *)
vc_down = #h24; (* 2.4 *)
vc_up = #h25; (* 2.5 *)
at_down = #h26; (* 2.6 *)
at_up = #h27; (* 2.7 *)
newlam_code= #h9c; (* 9.12 *)
anslam_code= #h9d; (* 9.13 *)
new_addr_code= #hb0; (* 11.0 *)
new_ans_code = #hb1; (* 11.1 *)
nodetest_code= #hc0; (* 12.0 *)
nodeans_code= #hc1; (* 12.1 *)
input_code = #hc5; (* 12.5 *)
(*---------------------- other constants -------------------------*)
maxno = 2*2*2*2; (* 4 bits *)
readdata = 2;
write = 4;
by_father = 3; (* break parameter *)
forever = false;
label_length = label_size; (* size in words, length in bytes *)
testlength = label_length+2; (* length of testshape *)
free_sem_no = com_pool; (* free listen buffers are here *)
supp_sem_no = tssup_int3; (* log buffers *)
(*------------------------ message formats --------------------------*)
type
testshape = packed record (* for nodetest *)
head: alarmlabel;
data: array (1..5) of integer
end;
note = packed record (* for broadcast *)
head: alarmlabel;
component: alarmnetaddr
end;
lammess = packed record (* for new lam *)
head: alarmlabel;
lam_num,
lam_level : integer
end;
\f
(*----------------------------------------------------------
variables section
----------------------------------------------------------*)
var
here : alarmnetaddr; (* my own addr updated by 11.00 *)
debug : integer:= 1; (* controls testoutput *)
cv, (* value of create *)
books, (* numb of buffer bookings *)
nodetest_cnt : integer:=0; (* numb of nodetests send *)
group : func_grp; (* func group of arrived mess *)
running : modulstate := modulstate(5***true, false, 3***true);
ms : reference; (* mess arrived *)
console : zone; (**debug for output **)
(*----------------- for ts modules ----------------------*)
no : array (netc..ath) of integer;
suppool: pool no_req_supp of array (1..size_supp) of integer;
proc_lam : array(0..max_lam) of shadow;
proc_timeout,
proc_netcon,
proc_vchan,
proc_athan : shadow;
(*----------------- for timing ---------------------------*)
cnt : integer;
netaddr: array (nc..dc) of alarmnetaddr;
module: modulref;
t_out, (* module timeouts *)
t_up : array (netc..dc) of reference; (* book and update *)
u_pool: pool no_tss_tim of updates;
t_pool: pool no_tss_tim of timers;
done: semaphore;
clockpool: pool 1 of ts_time; (**demo **)
clock_ans: semaphore;
clock_msg: reference;
(*---------------- end of data section -----------------------*)
\f
<*q q*>
(*------------------------ display -----------------------------*)
procedure display ( var msg: reference); (* write contents *)
const
lastword = 16;
type
abuf = record w: array(1..lastword) of integer end;
var
i,m : integer;
begin
lock msg as buf: abuf do
with buf do
begin
m:= (w(1)+1) div 2;
if m<7 then m:= 7;
if m>lastword then m:=lastword;
for i:= 1 to m do testout ( console," data ", w(i));
end;
end;
<*q q*>
\f
(*------------------------ gettime -----------------------------*)
function gettime : ts_time;
type
clock_form = record time: ts_time end;
begin
signal ( clock_msg, sem(timeout_sem_no).s^);
wait ( clock_msg, clock_ans);
lock clock_msg as buf : clock_form do gettime:= buf.time
end;
\f
(*--------------------- odd ------------------------------------*)
function odd ( number: integer ) : boolean;
begin
odd:= number mod 2 = 1
end;
\f
(*---------------------- send up ---------------------------*)
procedure send_up ( (* signals to net-con *)
var msg : reference; (* mess to be send *)
operation : byte ); (* op code *)
begin
msg^.u1:= write;
msg^.u3:= tss_route;
msg^.u4:= operation;
if ( debug mod 16 ) >= 8 then display ( msg);
signal ( msg, sem(netc_sem_no).s^ );
end;
\f
(*---------------------- nodetest --------------------------*)
procedure nodetest (
node : modulref ); (* node to be tested *)
var
try : reference; (* node test message *)
begin
if open ( sem(free_sem_no).w^) then
begin
wait ( try, sem(free_sem_no).w^);
nodetest_cnt:= nodetest_cnt+1;
lock try as buf : testshape do
begin
with buf, head do
begin
no_of_by:= testlength;
rec:= netaddr(node);
send:= here;
result:= 0;
ts_add:= gettime;
end;
buf.data(1):= nodetest_cnt;
end;
send_up ( try, nodetest_code);
timerupdate ( t_up(node), interval(node), sem(timeout_sem_no).s^, done )
end
end;
\f
(*---------------------- broadcast -------------------------*)
procedure broadcast ( (* send a broadcast message *)
element : alarmnetaddr; (* unit in question *)
operation: byte; (* op code *)
recip : modulref); (* reveiver *)
const
broadlength = label_length+4;
var
msg : reference;
begin
(* if open ( sem(free_sem_no)) then
begin *)
wait ( msg, sem(free_sem_no).w^);
lock msg as buf : note do
with buf, head do
begin
no_of_by:= broadlength;
if recip = netc then rec:= netaddr(nc) else rec:= here;
send:= here;
result:= operation mod 1;
op_code:= operation;
ts_add:= gettime;
buf.component:= element
end;
msg^.u1:= write;
if recip = netc then msg^.u3:= tss_route else msg^.u3:= netc_route;
msg^.u4:= operation;
signal ( msg, sem(no(recip)).s^ )
(* end *)
end;
\f
(*--------------------- start timeout -------------------------*)
procedure start_timeout;
begin
if nil ( proc_timeout ) then
begin
link ("timeout ", timeout );
cv:= create (
timeout ("timeout ", opsem, sem(timeout_sem_no), time_out_unit, timeout_l),
proc_timeout, tim_size, pu_no);
if cv = 0 then start ( proc_timeout, tim_pri)
else
begin
testout ( console,"timeoutstart", cv);
unlink ( timeout)
end
end
end;
\f
(*------------------- start lam --------------------------------*)
procedure start_lam ( nr, level: integer );
begin
if nil ( proc_lam(nr)) then
begin
cv:= create (
lam ("lam ", opsem, pu_no, level,
sem(lam_sem_no+nr) ),
proc_lam(nr), lam_size, pu_no);
if cv = 0 then start ( proc_lam(nr), lam_pri)
else testout ( console,"lam start ", cv);
end;
end;
\f
(*------------------- start netcon ----------------------------*)
procedure start_netcon;
begin
if nil ( proc_netcon ) then
begin
(*
link ("netconnector", netconnector );
*)
link ("tsconnector ", tsconnector);
cv:= create (
tsconnector (
(** "netconnector", (**routine **)
"tsconnector ", (**demo **)
opsem, (**debug **)
sem(tssup_sem_no).s,
sem(dc_sem_no).s,
sem(lam_sem_no).s,
sem(timeout_sem_no).s,
sem(com_pool).w,
sem(netc_sem_no),
sem(net_int1), sem(net_int2), sem(net_int3),
sem(net_int4), sem(net_int5)
),
proc_netcon, netc_size, pu_no);
if cv = 0 then start ( proc_netcon, netc_pri)
else
begin
testout ( console,"netcon start", cv );
unlink ( tsconnector)
end;
end
end;
\f
(*----------------------- start vchandler ---------------------*)
procedure start_vchan;
begin
if nil ( proc_vchan ) then
begin
link ( "vc_handler ", vc_handler);
cv:= create (
vc_handler ("vc_handler ", opsem,
netaddr(dc),
sem
),
proc_vchan, vch_size, pu_no);
if cv = 0 then start ( proc_vchan, vch_pri)
else
begin
testout ( console, "vc_han start", cv);
unlink ( vc_handler)
end
end
end;
\f
(*------------------------ start athandler -----------------------*)
procedure start_athan;
begin
if nil ( proc_athan ) then
begin
link ( "at_handler ", at_handler);
cv:= create (
at_handler ("at_handler ", opsem,
netaddr(dc),
sem
),
proc_athan, ath_size, pu_no);
if cv = 0 then start ( proc_athan, ath_pri )
else
begin
testout ( console, "at_han start", cv);
unlink ( at_handler )
end
end
end;
\f
(*---------------------- module timeout --------------------*)
procedure module_timeout (
var msg : reference; (* received mess *)
var res : modulref); (* becomes dummy *)
var
cnt,
who : integer;
elem : alarmnetaddr;
begin
lock msg as buf : timers do who:= buf.object;
elem.macro:= here.macro;
elem.micro:= who;
case who of
netc_mic_addr:
begin (* net-connector stopped, so remove it
and start a new one *)
break ( proc_netcon, by_father);
unlink ( tsconnector);
remove ( proc_netcon);
(* get released buffers. *)
start_netcon;
nodetest ( nc);
timerbook ( t_up(netc), msg, interval(netc), who, sem(timeout_sem_no).s^, done)
end;
ath_mic_addr:
begin
if running(ath) then
begin
broadcast ( elem, at_down, netc);
broadcast ( elem, at_down, vch )
end;
running(ath):= false;
timerbook ( t_up(ath), msg, -1, who, sem(timeout_sem_no).s^, done)
end;
vch_mic_addr:
begin
if running(vch) then
begin
broadcast ( elem, vc_down, netc);
broadcast ( elem, vc_down, ath );
running(vch):= false
end;
timerbook ( t_up(vch), msg, -1, who, sem(timeout_sem_no).s^, done)
end;
traffic_id:
begin (* nc or paxnet stopped *)
nodetest ( nc);
timerupdate ( t_up(nc), interval(nc), sem(timeout_sem_no).s^, done );
timerbook ( t_up(traffic), msg, -1, who, sem(timeout_sem_no).s^, done)
end;
nc_ident:
begin (* nc down *)
if running(nc) then
begin
broadcast ( elem, nc_down, ath);
broadcast ( elem, nc_down, vch);
nodetest ( dc );
running(nc):= false
end;
timerbook ( t_up(nc), msg, -1, who, sem(timeout_sem_no).s^, done)
end;
dc_ident:
begin (* dc down *)
if running(dc) then
begin
broadcast ( elem, dc_down, ath);
broadcast ( elem, dc_down, vch);
running(dc):= false
end;
timerbook ( t_up(dc), msg, -1, who, sem(timeout_sem_no).s^, done);
end;
otherwise
end;
res:= dummy
end;
\f
(*--------------------- route ---------------------------*)
function route (
microadr : integer (* addr of local module *)
) : modulref; (* the selected module *)
begin
if microadr >= at_addr_limit then route:= ath else
if microadr >= vc_addr_limit then route:= vch else
if microadr = vch_mic_addr then route:= vch else
if microadr = ath_mic_addr then route:= ath else
route:= tss
end;
\f
(*----------------------- waitlog ----------------------------------*)
procedure waitlog ( (* fetch a free logbuffer *)
var msg : reference ); (* a msg for log *)
begin
(* allocator may be used later ! *)
wait ( msg, sem(supp_sem_no).w^ );
while msg^.u3 = dummy_route do
begin
return ( msg);
wait ( msg, sem(supp_sem_no).w^ )
end;
end;
\f
(*---------------------- make log --------------------------*)
procedure make_log ( var msg : reference );
(* makes a copy of msg.data and send to dc. *)
const
logleng = 2*size_supp - ( 2+label_length);
rawleng = 2*size_listen-2;
type
logshape = packed record
head : alarmlabel;
data : array (1..logleng) of byte;
end;
rawshape = packed record
bytes : integer;
rawdata : array (1..rawleng) of byte;
end;
var
cnt : 1..rawleng;
length : integer;
logm : reference;
begin
lock msg as head : alarmlabel do head.op_code:= msg^.u4;
waitlog ( logm );
lock logm as log : logshape do
lock msg as buf : rawshape do
begin
length:= label_length;
if ( buf.bytes > label_length )
and ( buf.bytes <= rawleng )
and ( buf.bytes <= logleng ) then length:= buf.bytes;
with log, head do
begin
no_of_by:= label_length+length;
rec.macro:= netaddr(dc).macro;
rec.micro:= dc_log_mic_addr;
send:= here;
result:= accepted;
ts_add:= gettime;
end;
for cnt:= 1 to length do log.data(cnt):= buf.rawdata(cnt);
end;
send_up ( logm, log_code)
end;
\f
(*--------------------- make addr error -----------------*)
procedure make_addr_error ( var msg : reference; error_code: byte );
(* send opcode 1.1 to dc *)
const
newleng = 2*size_listen - ( 2+label_length);
rawleng = 2*size_listen-2;
type
alarmshape = packed record
head : alarmlabel;
data : array (1..newleng) of byte;
end;
rawshape = packed record
bytes : integer;
rawdata : array (1..rawleng) of byte
end;
var
cnt : 1..rawleng;
length : integer;
newm : reference;
begin
lock msg as head : alarmlabel do head.op_code:= msg^.u4;
wait ( newm, sem(free_sem_no).w^);
lock newm as new : alarmshape do
lock msg as buf : rawshape do
begin
length:= label_length;
if ( buf.bytes > label_length )
and ( buf.bytes <= rawleng ) then length:= buf.bytes;
if length > newleng then length:= newleng;
with new, head do
begin
no_of_by:= label_length+length;
rec.macro:= netaddr(dc).macro;
rec.micro:= dc_erh_mic_addr;
send:= here;
result:= rejected;
ts_add:= gettime
end;
for cnt:= 1 to length do new.data(cnt):= buf.rawdata(cnt)
end;
send_up ( newm, error_code)
end;
\f
(*---------------- downwards ----------------------------*)
procedure downwards (
var msg : reference; (* a msg from net *)
var modul : modulref); (* tells what to do later *)
var
receiver : macroaddr;
xmt_dc : 0..15;
who : integer;
begin
lock msg as head : alarmlabel do
begin
receiver:= head.rec.macro;
who := head.rec.micro;
xmt_dc := head.send.macro.dc_addr;
end;
if ( debug mod 32 ) >= 16 then display ( msg);
if receiver <> here.macro then (* not for me *)
if msg^.u4 = addr_error then modul:= empty else
begin
make_addr_error ( msg, addr_error );
modul:= netc
end
else
begin (* addr ok *)
if (xmt_dc <> here.macro.dc_addr) and
running(dc) then make_log ( msg );
msg^.u3:= netc_route;
modul:= route ( who )
end
end; (* of downwards *)
\f
(*---------------- upwards -------------------------*)
procedure upwards (
var msg : reference; (* a msg from ath or vch *)
var modul : modulref); (* tells what to do later *)
var
receiver : macroaddr;
who : integer;
begin
lock msg as head : alarmlabel do
begin
if msg^.u4 in (. #h10 .. #h14 .) then head.rec:= netaddr(dc);
head.send.macro:= here.macro;
receiver:= head.rec.macro;
who:= head.rec.micro
end;
if receiver = netaddr(dc).macro then (* insert time *)
lock msg as head: alarmlabel do head.ts_add:= gettime else
if running(dc) then make_log ( msg );
if receiver = here.macro then
begin
msg^.u3:= netc_route;
modul:= route ( who )
end
else modul:= netc
end;
\f
(*----------------------- rec broadcast ---------------------------*)
procedure rec_broadcast ( var msg : reference );
(* handle received broadcast *)
type
ncaddr = record
dcpart : 0..15;
ncpart : 0..63
end;
var
unit : alarmnetaddr;
own_dc, unit_dc : 0..15;
own_nc, unit_nc : ncaddr;
begin
<* demo
lock msg as buf : note do unit:= buf.component;
own_dc:= here.macro.dc_addr;
own_nc.dcpart:= own_dc;
own_nc.ncpart:= here.macro.nc_addr;
unit_dc:= unit.macro.dc_addr;
unit_nc.dcpart:= unit_dc;
unit_nc.ncpart:= unit.macro.nc_addr;
case msg^.u4 of
dc_down: if unit_dc = own_dc then running(dc):= false;
dc_up: if unit_dc = own_dc then running(dc):= true;
nc_down: if unit_nc = own_nc then running(nc):= false;
nc_up: if unit_nc = own_nc then running(nc):= true
otherwise
end;
case msg^.u3 of
netc_route,
netc_route1: begin (* from net *)
broadcast ( unit, msg^.u4, vch);
broadcast ( unit, msg^.u4, ath)
end;
at_route,
at_route1: begin (* from at *)
broadcast ( unit, msg^.u4, netc);
broadcast ( unit, msg^.u4, vch)
end;
vca_route,
vca_route1,
vci_route,
vci_route1: begin (* from vc *)
broadcast ( unit, msg^.u4, netc);
broadcast ( unit, msg^.u4, ath)
end
otherwise
end; (* case *)
*>
return ( msg )
end; (* of rec broadcast *)
\f
(*------------------------ new lam ---------------------------------*)
procedure new_lam ( var msg : reference );
(* start or check lam driver incarnation *)
var nr, level: integer;
begin
if msg^.u4 = newlam_code then
begin
(*q if debug >= 1 then testout ( console,"new lam ", msg^.u4); q*)
lock msg as buf: lammess do with buf, head do
begin
nr:= lam_num;
level:= lam_level;
if update = start_code then (* start lam driver *)
begin
start_lam ( nr, level)
end else
begin (* stop lam driver *)
end;
rec:= send;
send:= here;
ts_add:= gettime;
result:= accepted;
end;
send_up ( msg, anslam_code)
end else return ( msg)
end;
\f
(*----------------------- rec returned ----------------------------*)
procedure rec_returned ( var msg : reference );
(* handle op codes 1.0 1.1 1.2 *)
begin
(* not yet specified *)
(*q if debug >= 1 then testout ( console, "returned ", msg^.u4); q*)
return ( msg )
end;
\f
(*----------------------- tss var update ----------------------------*)
procedure var_update ( var msg : reference );
(* the buffer contains a new ts-macro-address *)
type
table = packed record
head : alarmlabel;
adr : macroaddr;
cn: integer
end;
begin
if msg^.u4 = new_addr_code then
begin
lock msg as buf : table do with buf, head do
begin
here.macro:= adr;
netaddr(dc).macro.dc_addr:= here.macro.dc_addr;
netaddr(nc).macro.dc_addr:= here.macro.dc_addr;
netaddr(nc).macro.nc_addr:= here.macro.nc_addr;
debug:= cn;
(* generate answer *)
rec:= send;
send:= here;
ts_add:= gettime;
result:= accepted;
end;
(*
if debug>=3 then display ( msg);
*)
send_up ( msg, new_ans_code);
running(dc):= true;
(* tell ath, no *)
end else return ( msg)
end; (* of table update *)
\f
(*----------------------- watch -----------------------------------*)
procedure watch ( var msg : reference );
(* nodetest received, so send node test answer *)
var
node : modulref;
node_up : byte;
begin
if msg^.u4 = nodetest_code then (* node test *)
begin
lock msg as buf : testshape do
with buf, head do
begin
rec:= send;
send:= here;
result:= accepted;
ts_add:= gettime;
data(2):= books;
data(3):= debug;
end;
send_up ( msg, nodeans_code)
<**demo
end else
if msg^.u4 = nodeans_code then (* node test answer *)
begin
lock msg as buf: testshape do
if buf.head.send.macro.na_addr = 0 then
begin node_up:= dc_up; node:= dc end else
begin node_up:= nc_up; node:= nc end;
timerupdate ( t_up(node), -1, sem(timeou_sem_no), done);
return ( msg);
if not running(node) then (* node running again *)
begin
broadcast ( netaddr(node), node_up, ath);
broadcast ( netaddr(node), node_up, vch);
running(node):= true
end
**>
end else return ( msg)
end; (* of watch *)
\f
(*------------------------- tss function --------------------------*)
procedure tss_function ( var msg : reference );
(* msg : received message for ts-supervisor *)
var
group : func_grp;
begin
(*q if debug>= 3 then testout ( console,"tss gets ", msg^.u4); q*)
group:= msg^.u4 div maxno;
(* f_count(group):= f_count(group)+1; overflow and not used *)
case group of
0: (* returned log *) begin nodetest ( dc ); return ( msg) end;
1: (* returns *) rec_returned ( msg );
2: (* broadcast *) rec_broadcast( msg );
9: (* new lam *) new_lam ( msg );
11: (* new addr *) var_update ( msg );
12: (* watch *) watch ( msg )
otherwise (* ignore *) return ( msg)
end;
end; (* of tss function *)
\f
(*---------------------------------------------------------------*)
(* *)
(* main program *)
(* *)
(*---------------------------------------------------------------*)
begin
own.incname:= procname;
testopen ( console, procname, opsem);
if debug>=0 then testout ( console, version, al_env_version);
here.macro:= macroaddr(0,0,0);
here.micro:= tss_mic_addr;
netaddr(dc):= here;
netaddr(nc):= here;
(**demo get buffers for log and clock **)
for cnt:= 1 to no_req_supp do
begin
alloc ( ms, suppool, sem(supp_sem_no).s^);
signal ( ms, sem(supp_sem_no).s^ )
end;
alloc ( clock_msg, clockpool, clock_ans);
clock_msg^.u1:= readdata;
clock_msg^.u3:= tss_route;
no(netc):= netc_sem_no;
no( vch):= vch_sem_no;
no( ath):= ath_sem_no;
link ("lam ", lam);
start_timeout;
(*q if debug>=1 then testout ( console,"timermodul ", 800 ); q*)
for module:= netc to dc do
begin
alloc ( t_out(module), t_pool, sem(tssup_sem_no).s^ );
alloc ( t_up(module), u_pool, done);
t_up(module)^.u3:= tss_route;
timerbook ( t_up(module), t_out(module), -1, microadr(module), sem(timeout_sem_no).s^, done)
end;
start_netcon;
start_vchan;
start_athan;
(*q if debug>=1 then testout ( console,"init ok ", 820 ); q*)
\f
(*------------------ main loop -------------------------*)
repeat (* until forever *)
(*q if (debug mod 8)>=4 then testout ( console,"wait mysem ", 960 ); q*)
wait ( ms, sem(tssup_sem_no).w^ );
(*q if (debug mod 8)>=4 then testout ( console,"handle ", msg_ready); q*)
case ms^.u3 of
dummy_route: module:= empty;
tim_route,
tim_route1: module_timeout ( ms, module );
netc_route,
netc_route1: downwards ( ms, module );
otherwise upwards ( ms, module );
end;
case module of
dummy: ; (* no action *)
empty: return ( ms ); (* no data *)
tss: tss_function ( ms );
vch: signal ( ms, sem(vch_sem_no).s^ );
ath: signal ( ms, sem(ath_sem_no).s^ );
netc: begin
if ( debug mod 16 ) >= 8 then display ( ms);
signal ( ms, sem(netc_sem_no).s^ );
timerupdate ( t_up(traffic), interval(traffic),sem(timeout_sem_no).s^, done )
end
end; (* case *)
until forever
end (* of ts supervisor program *) .
«eof»