DataMuseum.dk

top - metrics - download

    Length: 7680 (0x1e00)
    Types: TextFileVerbose
    Names: »stoptest«

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

TextFileVerbose

process stoptest(incname: alfa; sem: system_vector);
const
version='800910 1712';  (*size 503*)
(*    ************)
shadows=10;
prsize=201;
ppsize=145;
consolesize=282;
base=6+alfalength;
shl=base+8-1;
lgl=base+80;
inputlevel=8;
obufs=9;

createerr=1;
ready=2;
lev=3;
fe=4;
pri=5;
minsetbit=6;
pnt=minsetbit-1;
maxbit=pnt+12;

type
short=array (base..shl) of char;
long= array (base..lgl) of char;

outbuf=record
first,last,next: integer;
name: alfa;
c1,c2: char;
c: short;
end;

inbuf=record
first,last,next: integer;
name: alfa;
c: long;
end;

masktype=packed array (0..maxbit) of boolean;
txttype=array (1..maxbit) of short;

var
mp,inp,out,m,mw: reference;
wt,i,f,e,p,pos,state: integer;
sh: array(1..shadows) of shadow;
shr,sht: shadow;
si,s,aw,a,ina,outa,sp,ap: semaphore;
b,r: boolean;
line: pool 1+obufs of inbuf;
head: pool 2+shadows;
mask: masktype:=masktype(pnt+6***true,false,true,false,true,false,true,
false);
txt: txttype:=txttype(
'create  ',
'ready   ',
'param l ',
'param fe',
'param p ',
'point  1',
'point  2',
'point  3',
'point  4',
'point  5',
'point  6',
'point  7',
'point  8',
'point  9',
'point 10',
'point 11',
'point 12');

(************************************************************************)

process pr(var s: semaphore);
var
m,ch: reference;
l,d,t: integer;

procedure controleclr(w: integer; var ch: reference); external;

procedure delay(d: integer);
var i,j,k: integer;
begin
j:=1;
for i:=1 to d do begin
for k:=2 to j do; j:=j*2;
end;
end;

begin
repeat
wait(m,s);
with m^ do begin
l:=u1; d:=u2; t:=u3
end;
if l=0 then begin
return(m); delay(d); wait(m,s);
end else if reservech(ch,0,l,-1)=1 then begin
channel ch do begin
return(m); delay(d); if t>0 then begin own.timer:=t; controleclr(0,ch) end;
wait(m,s);
end;
release(ch);
end else begin m^.u1:=255; return(m); wait(m,s); end;
return(m);
until false;
end;

(************************************************************************)

process pp(var s: semaphore);
var m: reference;
begin repeat wait(m,s); return(m) until false end;

(***********************************************************************)

process console(var s: semaphore; level: integer);
const size=512;  ok=0;
base=6+alfalength; top=base+79;

type line=record
first,last,next: integer;
name: alfa;
c: array (base..top) of byte;
end;

var
shi,sho: shadow;
inp,out,ans: semaphore;
m,md: reference;
head: pool 1;
i: integer;

process debugin(var s: semaphore; pu,level: integer); external;
process debugout(var s: semaphore; pu,level: integer); external;

begin
link('debugin     ',debugin);
i:=create(debugin(inp,0,level),shi,size,0);
start(shi,maxpriority);
link('debugout    ',debugout);
i:=create(debugout(out,0,level+1),sho,size,0);
start(sho,maxpriority);
alloc(md,head,ans);
repeat
wait(m,s);
lock m as a: line do with a do begin
if m^.u1=2 then begin next:=first; while next <= last do begin
md^.u4:=c(next); signal(md,out); wait(md,ans);
next:=next+1;
end
end else begin
next:=first;
repeat
signal(md,inp); wait(md,ans);
if (md^.u2=ok) then begin
i:=md^.u4; signal(md,out);
if i=ord(bs) then begin if next > first then next:=next-1 end else
if i <> ord(cr) then begin c(next):=i; next:=next+1 end;
wait(md,ans);
end else i:=0;
until (next>last) or (i=ord(cr));
end;
end; (*lock*)
return(m);
until false;
end;

(***********************************************************************)

procedure op(i: integer);
begin
if i>0 then begin
lock out as a: outbuf do a.c:=txt(i);
signal(out,si);
sensesem(out,outa);
end
end;

procedure opw(i: integer);
begin
if mask(i) then begin
op(i); signal(inp,si); wait(inp,ina);
end
end;

procedure opb(i: integer);
begin
if mask(i) then begin
op(i); signal(inp,si);
repeat sensesem(inp,ina) until not nil(inp);
end
end;

function read(var c: long): integer;
var v: integer;
begin
while(c(pos) < '-') or (c(pos) > '9') do pos:=pos+1;
v:=0;
if c(pos)='-' then begin
pos:=pos+1;
while (c(pos) >= '0') and (c(pos) <= '9') do begin
 v:=v*10-ord(c(pos))+48; pos:=pos+1;
end;
end else
while (c(pos) >= '0') and (c(pos) <= '9') do begin
v:=v*10+ord(c(pos))-48; pos:=pos+1;
end;
read:=v;
end;

(********************************************************************)

begin
alloc(m,head,a); alloc(mw,head,aw);
alloc(inp,line,ina);
lock inp as a: inbuf do with a do begin
inp^.u1:=1; first:=base; last:=lgl-1; name:=incname;
end;
for i:=1 to obufs do begin
alloc(out,line,outa);
lock out as a: outbuf do with a do begin
out^.u1:=2; first:=base; last:= shl+2; name:=incname;
c1:=nl; c2:=cr;
end;
return(out);
end;
wait(out,outa);

f:=create(console(si,inputlevel),shr,consolesize,0);
start(shr,maxpriority);

f:=create(pr(s),sht,prsize,0);
for i := 1 to shadows do if f=0 then begin
f:=create(pp(sp),sh(i),ppsize,0);
if f=0 then begin
start(sh(i),0); alloc(mp,head,ap); return(mp);
end;
end;
if f<>0 then begin
txt(1,shl):=chr(f+ord('0')); op(createerr);
end else begin
state:=ready;
with m^ do begin u1:=0; u2:=0; u3:=0 end;
wt:=0; f:=0; e:=0; p:=0; b:=false;

repeat
r:=false;
repeat
opw(state); state:=0;
lock inp as a: inbuf do with a do begin
c(next):='/';
for pos:=first to next-1 do
case c(pos) of
'L','l': m^.u1:=read(c);
'D','d': m^.u2:=read(c);
'T','t': m^.u3:=read(c);
'W','w': begin
wt:=read(c); if c(pos)="'" then mw^.u4:=read(c) else mw^.u4:=0;
end;
'F','f': f:=read(c);
'E','e': e:=read(c);
'P','p': p:=read(c);
'A','a': b:=false;
'B','b': b:=true;
'S','s': mask(pnt+read(c)):=true;
'C','c': mask(pnt+read(c)):=false;
'R','r': r:=true;
otherwise
end; (*case*)
end; (*lock*)
until r;

if m^.u1>127 then state:=lev else
if f+e>shadows then state:=fe else
if (maxpriority<p) or (minpriority>p) then state:=pri else
begin
state:=ready;
mw^.u3:=20; sendtimer(mw); wait(mw,aw);
start(sht,p);
signal(m,s);
if wt>0 then begin mw^.u3:=wt; sendtimer(mw); wait(mw,aw) end;
(*******************************************************) opb(pnt+1);
if f>0 then begin
stop(sht);
(***************************************************) opb(pnt+2);
for i:=1 to f do begin
repeat sensesem(mp,ap) until not nil(mp); signal(mp,sp);
end;
start(sht,p);
(***************************************************) opb(pnt+3);
end;
for i:=1 to e do begin
repeat sensesem(mp,ap) until not nil(mp); signal(mp,sp);
end;
(*******************************************************) opb(pnt+4);
stop(sht);
(*******************************************) opb(pnt+5); opw(pnt+6);
sensesem(m,a); r:=not b or nil(m);
if r then begin
start(sht,p);
(***************************************) opb(pnt+7); opw(pnt+8);
end;
if nil(m) then wait(m,a);
signal(m,s);
(*******************************************) opb(pnt+9); opw(pnt+10);
if not r then begin
start(sht,p);
(**************************************) opb(pnt+11); opw(pnt+12);
end;
wait(m,a); stop(sht);
if m^.u1=255 then state:=lev;
end;
until false;
end;
end
.
«eof»