DataMuseum.dk

top - metrics - download

    Length: 2304 (0x900)
    Types: TextFile
    Names: »ttimertst«

└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
    └─⟦6b41451d2⟧ 
        └─⟦this⟧ »ttimertst« 

TextFile

job btj 1 600 time 5 0 size 110000 ,
  perm disc 100 2
(
btimertst = set 1
scope user btimertst
scope project btimertst
if ok.no
  finis
btimertst = pascal80 codesize.12000,
  stack.512,
  debugenvir ioenvir
finis
)
process timertest(var sems: system_vector);

type
delaytype = record
prev_date : coded_date;
prev_time : coded_time;
prev_secs : coded_secs;
inc : packed record
days  : 0..63;
hours : 0..31;
mins  : 0..63;
secs  : 0..63;
msecs : 0..1023;
end;
end;

var
zin, zout : zone;
poolin,poolout: pool 1 of opbuffer;
timepool  : pool 10 of delaytype;
i,j,k : integer;
msg1, msg2, msg3: reference;
answ : semaphore;
timeansw : semaphore;

procedure n;
begin
outchar (zout, nl); outend(zout);
end;

procedure p(i: integer);
begin outinteger(zout, i, 5) end;

procedure w;
begin opwait (zin, poolin);
end;

procedure f;
var c: char;
begin
repeat inchar(zin, c) until c=nl;
opin (zin);
end;

function r: integer;
var i: integer;
begin
ininteger (zin, i);
r := i;
end;

procedure printtime (var msg: reference);
begin
lock msg as t: delaytype do
with msg^, t, prev_date, prev_time, prev_secs, inc do
begin
p(u3); p(u4); n;
p(year_after_1900); p(month); p(day); n;
p(hour); p(minute); p(sec); p(msec); n;
p(days); p(mins); p(secs); p(msecs); n;
n;
end;
end;

procedure rep;
begin
repeat
sendtimer (msg1);
wait (msg1, timeansw);
printtime (msg1);
until open (answ);
end;

begin

openopzone (zin , sems(operatorsem), ref(answ), 1, poolin, 1,0,0,7);
openopzone (zout, sems(operatorsem), ref(zout.free), 1, poolout,2,0,0,7);

f; w;

alloc (msg1, timepool, timeansw);
lock msg1 as t: delaytype do
with msg1^, t, prev_date, prev_time, prev_secs, inc do
begin
u3    := 0;
u4    := r;
year_after_1900 := r;
month := r;
day   := r;
hour  := r;
minute:= r;
sec   := r;
msec  := r;
days  := 0;
hours := 0;
mins  := 0;
secs  := 0;
msecs := 0;
end;
f;

repeat
w;
lock msg1 as t: delaytype do
with t, inc do
begin
secs := r;
end;
f;

rep;
until false;
end.
▶EOF◀