|
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: 6912 (0x1b00)
Types: TextFile
Names: »tstmojob«
└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
└─⟦72244f0ef⟧
└─⟦this⟧ »tstmojob«
job hj 2 200 time 11 0 area 10 size 100000
( mode list.yes
source = copy 25.1 ; all text after finis
tstmolst = set 1 disc1
tstmolst = indent source mark lc
liste = cross tstmolst
o errors
message timeout
pascal80 spacing.3000 codesize.3000 alarmenv source
o c
lookup pass6code
if ok.yes
( tstmobin = set 1 disc1
tstmobin = move pass6code
scope user tstmobin
message tstmobin ok
)
tstmolst = copy liste errors
scope user tstmolst
convert errors
finis
)
\f
process timeout (
opsem : ^semaphore; (* operator sem *)
var main_sem : !ts_pointer; (* main semaphore *)
(* var simtim : semaphore; (*** only when using sim timer prog ***)
ticklength, (* # msec per tick *)
max: integer); (* max # bookings simultan *)
(* the process receives bookings with moduletimeouts *)
(* and updates of tickcount. *)
(* tickcount is decreased by 1 for each tick of ticklength *)
(* m sec. when tickcount reaches zero the corresponding module- *)
(* timeout is returned. *)
(* date version init changes *)
(* 80.04.18 0 hej first edition *)
(* 80.06.02 1.2 hej new message formats, one sem. *)
(* 80.07.18 1.9 hej save function *)
(* 80.07.23 2.1 hej read function ( for demo ) *)
(* 80.08.06 2.4 hej object from book *)
(* 80.08.11 2.5 hej sender ident from book update *)
(* 80.08.25 2.6 hej date and version *)
(* 80.09.03 1.10 hej new lambda *)
(* 80.10.28 2.00 hej mainsem -> sempointer *)
(* 80.11.11 2.02 hej u3 = dummy_route (= 0 ) *)
const (* constant section *)
version = "vers 2.02 /" ;
(**sim sim= false; (* run with timer sim **)
first= 1;
cmax= timeout_l; (* max number of simultanious bookings, should be process param *)
(* other constants *)
inactive= -2; (* value in unused tickcounters *)
result_ok = 1;
result_full = 2;
result_wrong= 3;
result_obj = 4;
result_index= 5;
result_unknw= 6;
read= 2; (**demo **)
readstatus= 3;
write= 4;
writecontrol= 5;
readwrite= 6;
rwcontrol= 7;
forever= false;
dummy = dummy_route;
type (* type section *)
modules= first..cmax; (* should be first..max *)
params= record index, count, object: integer end;
identdata = record object: integer end;
savedata = record count: integer end;
var (* variables section *)
console: zone;
hour, min, sec : integer := 0; (**demo **)
delay: integer; (* # msec. in a tick *)
delay1, delay2: byte:= 0;
index, used: modules:= first;
tickcount,
objects : array(modules) of integer;
saved: array(modules) of reference;
msg, timer_msg: reference;
tickmess: pool 1; (* of header only *)
(* end of datasection *)\f
begin (* program section *)
testopen ( console, own.incname, opsem );
testout ( console, version, al_env_version );
delay:= ticklength;
while delay > 255 do
begin
delay:= delay div 2;
delay2:= delay2+1
end;
delay1:= delay;
alloc ( msg, tickmess, main_sem.s^);
msg^.u1:= readwrite;
msg^.u3:= delay1;
msg^.u4:= delay2;
(* if sim then signal ( msg, simtim ) else (**sim only with sim timer **)
sendtimer ( msg);
(* main loop *)
repeat
wait ( msg, main_sem.w^); (* answer from timer, save, booking, or update *)
if ownertest ( tickmess, msg ) then (* tick *)
begin
msg^.u3:= delay1;
msg^.u4:= delay2;
(* if sim then signal ( msg, simtim ) else (**sim **)
sendtimer ( msg);
(**demo only update hour, min, sec **)
sec:= sec+1;
if sec = 60 then
begin
sec:= 0;
min:= min+1;
if min = 60 then
begin
min:= 0;
hour:= hour+1;
if hour=24 then hour:= 0
end
end;
for index:= first to used do (* decrease tickcounters *)
begin
if tickcount(index) > 0 then
tickcount(index):= tickcount(index)-1 else
if tickcount(index) = 0 then
begin
if not nil ( saved(index)) then return ( saved(index));
tickcount(index):= inactive
end
end
end (* tick *)
else
if msg^.u3 = dummy then return ( msg)
else
case msg^.u1 of
read: (**demo only **)
begin
lock msg as buf: record hh, mm: integer end do
begin
buf.hh:= hour;
buf.mm:= min*100 + sec
end;
msg^.u2:= result_ok;
return ( msg)
end;
writecontrol: (**demo only **)
begin
lock msg as buf: record hh, mm: integer end do
begin
hour:= buf.hh;
min:= buf.mm div 100;
sec:= buf.mm mod 100
end;
msg^.u2:= result_ok;
return ( msg)
end;
readstatus: (* save *)
begin
index:= first;
while not nil ( saved(index) ) do index:= index+1;
if index = cmax then
begin
msg^.u2:= result_full;
return ( msg)
end else
begin
msg^.u2:= result_ok;
lock msg as buf: savedata do
begin
if buf.count < 1 then buf.count:= 1;
tickcount(index):= buf.count;
end;
objects(index):= index;
saved(index) :=: msg;
if index > used then used:= index
end
end; (* save *)
rwcontrol: (* booking *)
begin
pop ( timer_msg, msg );
timer_msg^.u3:= msg^.u3;
index:= first;
while not nil( saved(index)) do index:= index+1;
if index = cmax then
begin
timer_msg^.u2:= result_full;
return ( timer_msg);
msg^.u2:= result_full
end else
begin
timer_msg^.u2:= result_ok;
msg^.u2:= result_ok;
lock msg as buf: params do
begin
tickcount(index):= buf.count;
objects(index):= buf.object;
buf.index:= index;
end;
lock timer_msg as data:identdata do data.object:= objects(index);
saved(index) :=: timer_msg;
if index > used then used:= index
end;
return ( msg)
end; (* booking *)
write: (* update tickcount *)
begin
lock msg as buf:params do
begin
if ( first<=buf.index ) and ( buf.index<=cmax ) then
if nil( saved(buf.index)) then msg^.u2:= result_wrong else
if buf.object = objects(buf.index) then
begin
saved(buf.index)^.u3:= msg^.u3;
if buf.count = 0 then return ( saved(buf.index)) else
tickcount(buf.index):= buf.count;
msg^.u2:= result_ok
end else msg^.u2:= result_obj
else msg^.u2:= result_index
end;
return ( msg)
end;
otherwise (* all unknown functions *)
begin
msg^.u2:= result_unknw;
return ( msg )
end;
end; (* case *)
until forever
end . (* of time out process *)
▶EOF◀