DataMuseum.dk

top - metrics - download

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

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

TextFile

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

type
delaytype = record
prev: packed record
year  : 0..99;
month : 0..15;
day   : 0..31;
hour  : 0..31;
min   : 0..63;
sec   : 0..63;
msec  : 0..1023;
end;
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, inc do
begin
p(u3); p(u4); n;
p(year); p(month); p(day); n;
p(hour); p(min); 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, inc do
begin
u3    := 0;
u4    := r;
year  := r;
month := r;
day   := r;
hour  := r;
min   := 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 msg1^, t, prev, inc do
begin
secs := r;
end;
f;

rep;
until false;
end.
▶EOF◀