DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »clocktest«

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

TextFile

process clocktest(var clock,delay: semaphore; sem: system_vector);
const
version=' 800717 1409';
  (*      ***********)

bfbs=6+alfalength;  bfsz=bfbs+80;
antal=100;
minint=-#h8000;

type
buffdata=array(bfbs..bfsz) of char;

buffer=record
frst,last,nxt: integer;
name: alfa;
c:buffdata
end;

const blank=buffdata(bfsz-bfbs+1 *** ' ');

var
opmess: pool 2 of buffer;
delaymess: pool antal;
inp,out,m,m1: reference;
answ,opansw: semaphore;
n: char:='z';
t0,t1,t2: integer:=0;
a: integer;

procedure outhex(var o: buffer; v,n: integer);
var x,i: integer;
begin
if v<0 then begin x:=(v-minint) div #h1000+8; v:=(v-minint) mod #h1000
end else begin x:=v div #h1000; v:=v mod #h1000 end;
with o do for i:=1 to 4 do begin
if (x=0) and (n<4) then n:=n+1 else begin
n:=4; last:=last+1; c(last):=chr(48+x + x div 10 * 39);
end;
x:= v div 256; v:= v mod 256 *16;
end
end;

procedure outchar(var o: buffer; a: char);
begin with o do begin
last:=last+1; c(last):=a
end end;

function inhex(var data: buffer): integer;
var v: integer;
begin with data do begin
while (c(frst)<'/') or (c(frst)>'f') do frst:=frst+1;
v:=0;
while (c(frst)>='0') and (c(frst)<='f') do begin
v:=v*16+ord(c(frst))-48-ord(c(frst)) div 97 * 39;
frst:=frst+1;
end;
inhex:=v;
end end;

begin
platoninit;
printnl; printtext('clocktest   '); printtext(version); printnl;

wait(m1,clock);
alloc(inp,opmess,opansw);  inp^.u1:=1;
lock inp as i: buffer do begin
i.name:='p           ';  i.frst:=bfbs; i.last:=bfsz-1; i.nxt:=bfbs;
end;

alloc(out,opmess,opansw);  out^.u1:=2;
lock out as o: buffer do begin o.frst:=bfbs; o.name:='p           'end;

repeat
lock inp as data: buffer do with data do
lock out as o: buffer do begin
o.c:=blank;  c(nxt):='/';  o.last:=bfbs-1;
while frst<nxt do
case c(frst) of
'w': if not openpool(delaymess) then frst:=frst+1 else begin
alloc(m,delaymess,answ);
m^.u3:=inhex(data);  m^.u4:=inhex(data);
case n of 'z': n:='0'; '9': n:='A'; 'Z': n:='a' otherwise n:=succ(n) end;
m^.u1:=ord(n); signal(m,delay);
o.c(frst-1):=n; o.last:=frst-1;
end;
's': begin
a:=inhex(data);  t1:=t1+a;
while a>0 do begin
m1^.u2:=255; return(m1); wait(m1,clock); a:=a-1;
end;
a:=inhex(data);  t0:=t0+a;
if t0>255 then begin t1:=t0 div 256 +t1; t0:=t0 mod 256 end;
if t1>255 then begin t2:=t1 div 256 +t2; t1:=t1 mod 256 end;
if a>0 then begin
m1^.u2:=a-1; return(m1); wait(m1,clock);
end;
frst:=nxt
end
otherwise frst:=frst+1;
end;
frst:=bfbs;
a:=o.last;
end;
repeat
if a>=bfbs then begin
signal(out,sem(operatorsem)^); wait(out,opansw);
end;
if a<bfsz then lock out as o: buffer do with o do begin
last:=bfbs-1;
if a<bfbs then a:=bfsz-10 else begin a:=bfsz-9; outchar(o,nl) end;
while open(answ) and (last<bfsz-1) do begin
wait(m,answ); outchar(o,chr(m^.u1)); release(m);
end;
if last<=a then begin
repeat outchar(o,'.') until last=a+1;
outhex(o,t2,4); outhex(o,t1,2); outhex(o,t0,2); a:=bfsz+1;
end;
end else a:=0;
until a=0;
signal(inp,sem(operatorsem)^);  wait(inp,opansw);
until false;
end
.
▶EOF◀