DataMuseum.dk

top - metrics - download

    Length: 22272 (0x5700)
    Types: TextFile
    Names: »ttest«

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

TextFile

process s(var syst:system_vector);
const
hdlcsize=1024;
datasize=4096;
pri=0;
datapri=-1;
levelq=24;
levelr=26;

testmax=30;
maxevent=10;
opoolsize=10;

process hdlcdata(var op,sem1,sem2:semaphore; reclev1,reclev2:integer);
const
maxans=28;
maxnesting=5;
maxbuf=256+5;

<****************************************************************>
<*                      hdlcdata                                *>
<*                                                              *>

type
iline=record
first,last,next:integer;
name:alfa;
line:array (18..98) of char;
end;

oline1=record
f,l,n: integer;
name: alfa;
line: array(18..97) of char;
end;

tx2=array(1..2) of char;

dbuf=record
first,last,next:integer;
no: tx2;
txti:char;
inf:array (9..maxbuf) of char;
end;

dbuf1=record
first,last,next: integer;
inf: array(6..maxbuf) of char;
end;

ansbuf=record
f1,f2,f3,f4:byte;
f5: tx2;
f6: char;
f7: reference;
end;

tx5=array(1..5) of char;
ciftype=array('0'..'9') of byte;
modetype=record all,test,data :boolean end;

oelem= record
t1:char;
t2,t3:tx2;
t4,t5:tx5;
t6: array (1..3) of char;
end;

oline=record
first,last,next:integer;
name:alfa;
inf:array(1..4) of oelem;
e1,e2,e3,e4,e5,e6,e7,e8,e9: char;
end;

const
cif=ciftype(0,1,2,3,4,5,6,7,8,9);
spelem=oelem(' ','  ','  ','     ','     ',' ! ');
mode0=modetype(false,false,false);

var
mw,mw1,r,m,comi,como,ack: reference;
testa,asem,qs,opa,outa:semaphore;
c2,c1,c:char:=nl;
i0,v,i,j,xmtlev1,xmtlev2:integer;
l: integer:=0;
cnt: tx2:='00';
mode: modetype:=modetype(true,true,false);
dpool:pool maxans of dbuf;
tab: array (18..98) of tx2;
s: array('n'..'r') of ^semaphore;
sl: array(8..127) of char;
b,err,esc: boolean;
ans: array(1..maxans) of ansbuf;
ipool:pool 6 of iline;
opool:pool 1 of oline;
data: array('a'..'z') of dbuf;
x: integer:=0;
a: array(1..maxnesting) of record p: byte; c: char end;

procedure out5(var t:tx5; v:integer);
var i:integer;
begin
for i:=5 downto 1 do if v>0 then begin
t(i):=chr(v mod 10 + 48);  v:=v div 10;
end else if i=5 then t(i):='0' else t(i):=sp;
end;

procedure listq;
var i,l: integer;
begin
l:=1;
while l<j do begin
i:=1;  wait(como,opa);
lock como as d:oline do begin
d.e1:=nl; d.last:=d.first+72;
repeat
if l<j then with d.inf(i) do
begin
with ans(l) do begin 
d.inf(i):=spelem;
t1:=sl(f3); t2:=f5;
t3(2):=f6;
out5(t4,f4); out5(t5,f2);
if not nil(f7) then for i:=i+1 to 4 do d.inf(i):=spelem;
end;
l:=l+1;
end else d.inf(i):=spelem;
i:=i+1;
until i>4;
end;
como^.u2:=7; signal(como,op);
with ans(l-1) do if not nil(f7) then begin
lock f7 as d1: dbuf1 do with d1 do begin
i:=first;
repeat
wait(como,opa);
lock como as d: oline1 do with d do begin
l:=f-1;
repeat
l:=l+1; line(l):=inf(i); i:=i+1;
until (l=f+79) or (i=next);
if l<f+79 then begin l:=l+1; line(l):=nl end;
end;
como^.u2:=7; signal(como,op);
until i=next;
end;
release(f7);
end;
end;
j:=1;
end;

begin
trace(0);
for i:=1 to 2 do begin
alloc(r,ipool,asem);
r^.u1:=1; r^.u4:=0;
lock r as d:iline do with d do begin
first:=18; last:=97;
name:='data'
end;
r:=:comi;
end;

alloc(ack,ipool,outa);
ack^.u1:=2;
lock ack as d: iline do with d do begin
first:=18; name:='data';
end;

for i:=1 to 3 do begin
alloc(m,ipool,testa);
lock m as l: iline do l.name:='data';
return(m);
end;

alloc(como,opool,opa);
como^.u1:=2;
lock como as d:oline do with d do begin
first:=18;
name:='data';
end;
return(como);

cnt:='00';  j:=1;
xmtlev1:=reclev1+1;
xmtlev2:=reclev2+1;

for i:=8 to 127 do sl(i):='n';
sl(xmtlev1):='o';
sl(xmtlev2):='p';
sl(reclev1):='q';
sl(reclev2):='r';

s('n'):=ref(asem);
s('o'):=ref(sem1);
s('p'):=ref(sem2);
s('q'):=ref(sem1);
s('r'):=ref(sem2);

for c:='a' to 'z' do with data(c) do begin
first:=6; last:=first+20;
txti:=c; inf:='  buffer'; inf(10):=c;
end;
data('z').last:=maxbuf;

r^.u2:=7; signal(r,op); wait(r,asem);
repeat
esc:=false; err:=false;
comi^.u2:=7; signal(comi,op);
r:=:comi;
lock comi as lbuf:iline do with lbuf do
begin
if nil(ack) then
wait(ack,outa);
lock ack as b: iline do with b do begin
if comi^.u2=0 then begin
last:=19; line(first):=':';
end else begin
last:=first+29; lbuf.next:=lbuf.first;
line:=' command skipped; cause=';
line(first):=nl;
line(last-1):=chr(comi^.u2+48);
end;
line(last):=nl;
end;
ack^.u2:=7; signal(ack,op);
i:=first; x:=0;
line(next):=nl;
repeat
c:=line(i);
case c of
'm': begin <*set mode*>
mode:=mode0; b:=true;
while b do begin
i:=i+1;
with mode do case line(i) of
'a': all:=true;
't': test:=true;
'd': data:=true;
otherwise i:=i-1; b:=false;
end;
end;
end;
'o','p':
begin
i0:=i; v:=cif(line(i+1));
repeat
alloc(mw,dpool,asem); push(mw,m);
lock m as d:dbuf do begin
i:=i+2; d:=data(line(i)); d.no:=cnt;
end;
until line(i+1)<>'.';
with m^ do begin u1:=2; u2:=7; u3:=v; u4:=i0 end;
tab(i0):=cnt;
if cnt(2) < '9' then cnt(2):=succ(cnt(2)) else begin
cnt(2):='0';
if cnt(1) < '9' then cnt(1):=succ(cnt(1)) else cnt(1):='0';
end;
signal(m,qs);
end;
'q','r':
begin
i0:=i;
if line(i+1)='.' then begin
repeat
i:=i+2; alloc(mw,dpool,asem); push(mw,m);
lock m as d: dbuf do d:=data(line(i));
until line(i+1)<>'.';
end else begin
alloc(m,dpool,asem);
lock m as d:dbuf do d:=data('z');
end;
with m^ do begin u1:=1; u2:=7; u4:=i0 end;
signal(m,qs);
end;
'w','x','y',nl:
begin
while open(qs) do begin
wait(r,qs); signal(r,s(line(r^.u4))^);
end;
if c=nl then begin
c2:=c1; l:=0;
end else begin
c2:=c; c1:=c; l:=cif(line(i+1));
end;
repeat
wait(r,asem);
if r^.u4=0 then esc:=true else
with r^ do with ans(j) do begin
f1:=u1; f2:=u2; f3:=u3; f4:=u4;
if u2=0 then begin
if u1=1 then begin
repeat
pop(mw,r);
lock mw as d:dbuf do with d do if next>first then begin
f5:=no; f6:=txti;
v:=first+3;
if mode.test then begin
if (f6 >= 'a') and (f6 <= 'z') then
if next=data(f6).last+1 then with data(f6) do
begin
while (d.inf(v)=inf(v)) and (v<last) do
v:=v+1;
if d.inf(v)=inf(v) then v:=0;
end;
if v<>0 then f2:=f2+100;
end else if not mode.data then v:=0;
if v<>0 then begin
if not openpool(dpool) then listq;
alloc(f7,dpool,asem);
lock f7 as d1: dbuf do d1:=d;
end else v:=1;
end;
push(mw,mw1);
until nil(r) or (v<>0);
if c2<>'w' then begin
while not nil(mw1) do begin pop(mw,mw1); push(mw,r) end;
r^.u2:=7; signal(r,s(sl(r^.u3))^);
if c2='y' then l:=l+1;
end else r:=:mw1;
end else begin f5:=tab(u4); f6:='*' end;
l:=l-1;
end else begin f5:='**'; f6:='*' end;
while not nil(r) do begin pop(mw,r); release(mw) end;
if mode.all or not nil(f7) then j:=j+1;
if j>maxans then listq;
end;
until (l=0) or esc;
if c<>nl then i:=i+1;
end;
'l': listq;
'(': begin
if x<maxnesting then x:=x+1 else for v:=2 to maxnesting do a(v-1):=a(v);
with a(x) do begin p:=i; c:='1' end;
end;
')': if x>0 then  with a(x) do begin
if (line(i+1)>c) and (line(i+1)<='9') then begin
c:=succ(c); i:=p;
end else if line(i+1)='0' then i:=p else begin
if line(i+1)=c then i:=i+1;
x:=x-1;
end;
end else if (line(i+1)>'0') and (line(i+1)<='9') then i:=i+1;
'c','d':
with data(line(i+1)) do begin
if c='d' then last:=8;
c:=line(i+2); i:=i+3;
if (c>='0') and (c<='9') then begin
v:=cif(c);
while (line(i)>='0') and (line(i)<='9') do begin
v:=v*10+cif(line(i)); i:=i+1;
end;
last:=first+v-1; i:=i-1;
end else begin
while (line(i)<>c) and (line(i-1)<>nl) do begin
if last<maxbuf then begin
last:=last+1; inf(last):=line(i);
end;
i:=i+1;
end;
if line(i-1)=nl then i:=i-1;
end;
end;
't': begin
wait(m,testa);
lock m as b: iline do begin
i:=i+1; b:=lbuf; b.first:=i;
while (line(i)<>',') and (line(i)<>nl) do i:=i+1;
b.next:=i;
end;
m^.u1:=5; m^.u2:=0; signal(m,op);
end;
sp: ;
otherwise
repeat if not nil(m) then release(m); sensesem(m,qs) until passive(qs);
comi^.u1:=2; line:='error in datacommand'; line(last):=nl;
err:=true;
end;
if line(i)<>nl then i:=i+1;
until esc or err;
listq;
end;
if err then begin
comi^.u2:=7; signal(comi,op); wait(comi,asem); wait(r,asem);
if r^.u1=1 then comi^.u1:=1 else begin r^.u1:=1; r:=:comi end;
end;
until false;
end;

<*                                                      *>
<*                      end hdlcdata                    *>
<********************************************************>
\f


<*process s(var syst: system_vector);*>

type
conmode=packed record na: 0..3; s,p,i,r,fa,a: bit end;
contype=record
xxx1,xxx2,xxx3:integer;
mode: conmode;
inf: array (2..5) of integer;
end;

telem=packed record
aux,kind: byte;
t:integer;
a:byte;
nr:0..7;
p:bit;
ns:0..7;
i:bit;
s:packed array(0..3) of 0..15;
(* extended testoutput *********************************************
*)
b         : 0..4;
r,x       : 0..15;
y         : 0..2;
jt        : 0..7;

vt,tnt    : 0..7;
t0t       : 0..63;
m,snd,sif,ab: bit;
p0,p1,p2,p3,p4,p5,p6,p7: 0..15;
(********************************************************************)
end;

testtype=record
first,last,next:integer;
d:array (0..testmax) of telem;
end;

txt=array (18..98) of char;
digtype=array (0..15) of char;
ciftype=array ('0'..'9') of byte;
bt4=array (1..4) of byte;

cline=record
f,l,n:integer;
name:alfa;
d:txt;
end;

modetype=packed record
t6,t5,t4,t3,t2,t1: bit;
func:0..3;
end;

modetab=array ('q'..'r') of modetype;

const
dig=digtype('0','1','2','3','4','5','6','7','8','9','A','B','C','D',
'E','F');
bool=digtype('.','I',14***'E');
cif=ciftype(0,1,2,3,4,5,6,7,8,9);
testoff=modetype(0,0,0,0,0,0,0);
mode0=conmode(0,0,0,0,0,0,0);

var
mode,state: modetab;
ln:array (8..127) of char;
c,c1,c2: char;
m,r,con,stat,out:reference;
lc,v,i,n:integer:=0;
nc: integer:=10;
etop,ecnt: array('q'..'r') of integer;
era,oque,cona,opool,a,outa:semaphore;
sem:array('q'..'r') of semaphore;
op:^semaphore;
cpool:pool 3 of cline;
conpool:pool 1 of contype;
opool1:pool opoolsize of testtype;
hpool: pool maxevent;
statpool: pool 1 of array(1..30) of integer;
hdlcq,hdlcr,data: shadow;
skip,b,err,finis,empty: boolean:=false;
print: boolean :=true;
levq: integer:=levelq;
levr: integer:=levelr;
w: modetype;

const
teston=modetab(2***modetype(1,1,1,1,1,1,0));
head  =modetab(2***modetype(1,0,0,0,0,0,1));

procedure setmode=stvsb0(var r:byte; var s:modetype); external;
process hdlc(var sem:semaphore; reclev:integer); external;

procedure outi(var d:txt; var l:integer; t,n:integer);
var i:integer;
begin
i:=t mod 10;
if t<0 then begin
if i<6 then begin t:=t div 10 + 6552; d(l+n):=dig(i+16) end
else begin t:=t div 10 + 6553; d(l+n):=dig(i+6) end;
end else begin t:=t div 10; d(l+n):=dig(i) end;
i:=n;
while (t>0) and (n>1) do begin
n:=n-1; d(l+n):=dig(t mod 10); t:=t div 10;
end;
l:=l+i;
end;

procedure dout(var d: txt; var l: integer; v: bt4; n: integer);
var i,j,k,w: integer;
begin
k:=1; i:=-1; l:=l+n;
while (v(k)=0) and (k<4) do k:=k+1;
repeat
j:=k; w:=v(k);
if w<10 then k:=k+1 else v(k):=w div 10;
while j<4 do begin
j:=j+1; w:=w mod 10 *256 + v(j);  v(j):=w div 10;
end;
i:=i+1; d(l-i):=dig(w mod 10);
until (k>4) or (i=n);
end;

procedure testo(e:telem);
type
stp=array(0..7) of char;
utp=array(0..4,1..4) of char;
ntp=array(0..7) of byte;
ptp=array(0..1) of char;
const
scom=stp('R',sp,'N','R','E','J','3','?');
ucom=utp('  DM','SABM','DISC','  UA','CMDR');
nst=ntp(7,7,1,1,3,8,8,8);
pbit=ptp(sp,'*');
begin
wait(out,outa);
lock out as line:cline do with line do with e do begin
d:='  ';
l:=f-1; outi(d,l,t,4);
d(l+2):=c; d(l+3):=dig(kind);
case kind of
0:l:=f+24; 1:l:=f+18; 2:l:=f+6; 3:l:=f+12; otherwise l:=f+7 end;
case kind of
0,1,3,6: begin
outi(d,l,a,3);
d(l+4):=dig(nr); d(l+5):=pbit(p);
if i=0 then begin
d(l+1):='I'; d(l+2):=dig(ns);
end else if ns and 1 = 0 then begin
d(l+1):='R'; d(l+2):=scom(ns); d(l+3):=scom(ns+1);
end else if ns=nst(nr) then
for v:=1 to 4 do d(l+v):=ucom(nr,v)
else begin d(l+2):='?'; d(l+3):=dig(ns) end;
end;
2,4,8: outi(d,l,a,3);
5: if i=0 then begin
d(l+5):=dig(nr); d(l+6):=dig(p); d(l+7):=dig(ns);
end else d(l+5):='?';
7: begin d(l+5):=dig(a div 16); d(l+6):=dig(a mod 16) end;
end;
l:=f+34;
for v:=0 to 3 do d(l+v):=dig(s(v));
l:=l+4; outi(d,l,aux,3);
(* extended testoutput ***********************************************
*)
d(l+2):=dig(b); l:=l+3; outi(d,l,r,2); outi(d,l,x,3);
d(l+2):=dig(y); d(l+3):=bool(m); d(l+4):=dig(jt); d(l+5):=dig(vt);
d(l+7):=dig(tnt); l:=l+8; outi(d,l,t0t,3);
d(l+2):=bool(snd); d(l+3):=bool(sif); d(l+4):=bool(ab);
d(l+6):=dig(p0); d(l+7):=dig(p1); d(l+8):=dig(p2); d(l+9):=dig(p3);
d(l+11):=dig(p4); d(l+12):=dig(p5); d(l+13):=dig(p6); d(l+14):=dig(p7);
l:=l+11;
(***********************************************************************)
l:=l+4; d(l):=nl;
end;
signal(out,op^);
end;

procedure list;
begin
if open(oque) or not nil(r) then
repeat
if nil(r) then begin
wait(r,oque); wait(out,outa);
lock out as line: cline do with line do begin
d:=
' time            send   xmt   rec status    b  r  x ymji n   t sia';
d(f):=nl; l:=f+67; d(l):=nl;
end;
signal(out,op^);
lc:=lc-1;
end;
if lc>0 then begin
c:=ln(r^.u3);
lock r as td:testtype do with td do begin
i:=r^.u4;
if i>=next then begin
while (lc>0) and (i<=last) do begin
if i=next then begin
wait(out,outa);
lock out as line: cline do with line do begin
d:='           mod     testoutputlines lost';
d(f+5):=c; l:=f+6; outi(d,l,next,3);
l:=f+14; outi(d,l,testmax+1,3); l:=f+39; d(l):=nl;
end;
signal(out,op^);
lc:=lc-1;
end;
testo(d(i));  i:=i+1; lc:=lc-1;
end;
if i>last then i:=first;
end;
while (lc>0) and (i<next) do begin
testo(d(i));  i:=i+1; lc:=lc-1;
end;
r^.u4:=i; empty:=(i=next);
end;
if empty then signal(r,opool);
end;
until (lc<=0) or (passive(oque) and nil(r));
end;

<***********************************************************>
<*               hdlctest                                  *>
<*               initialize                                *>

begin
op:=syst(operatorsem);
i:=link('hdlc',hdlc);  if i<>0 then exception(40+i);

alloc(m,cpool,a);
lock m as h:cline do begin
m^.u1:=1; h.f:=18; h.l:=97; h.name:='test';
end;
signal(m,op^);

alloc(m,cpool,outa);
lock m as h:cline do begin
m^.u1:=2; h.f:=18; h.l:=18; h.name:='test';
end;
return(m);

alloc(m,cpool,era);
lock m as h:cline do begin
m^.u1:=2; h.f:=18; h.l:=34; h.name:='test'; h.d:='***command error';
h.d(34):=nl;
end;
return(m);

etop('q'):=0; etop('r'):=0;

repeat
repeat
wait(out,outa);
lock out as line: cline do with line do begin
d:='levelq=   ; levelr=';
l:=f+6;  outi(d,l,levq,3);
l:=f+18; outi(d,l,levr,3);
l:=l+1; d(l):=nl;
end;
signal(out,op^);

repeat
wait(m,a); if (m^.u1<>1) or (m^.u2=7) then release(m);
until not nil(m);
b:=true;
with m^ do if (u2=0) and (u1=1) then
lock m as l: cline do with l do begin
d(n):=nl;
repeat
c:=d(f); v:=0; f:=f+1;
if c<>nl then begin
b:=false;
while (d(f)>='0') and (d(f)<='9') do
if v<13 then begin
v:=v*10+cif(d(f)); f:=f+1;
end else c:=nl;
end;
if v<128 then case c of
'q': levq:=v;
'r': levr:=v;
otherwise
end;
until c=nl;
f:=18;
end;
signal(m,op^);
until b;

trace(0);

if openpool(conpool) then begin
alloc(con,conpool,cona);
lock con as b: contype do b.mode:=mode0;
end;
if openpool(statpool) then alloc(stat,statpool,cona);

while openpool(opool1) do begin
alloc(m,opool1,a); m^.u1:=44;  signal(m,opool);
end;

ln(levq):='q'; ln(levq+1):='q';
ln(levr):='r'; ln(levr+1):='r';

i:=create('hdlcq',hdlc(sem('q'),levq),hdlcq,hdlcsize);
if i<>0 then exception(50+i);

i:=create('hdlcr',hdlc(sem('r'),levr),hdlcr,hdlcsize);
if i<>0 then exception(50+i);

start(hdlcq,pri); start(hdlcr,pri);

i:=create('data',hdlcdata(a,sem('q'),sem('r'),levq,levr),data,datasize);
if i<>0 then exception(50+i);
start(data,datapri);

ecnt('q'):=0; ecnt('r'):=0;
mode:=teston; state:=teston;

repeat
if print then
while (lc<=0) and passive(a) do begin lc:=nc; list end;
wait(m,a);
if m^.u2=7 then signal(m,op^) else
if m^.u1 and 3=1 then begin <* console command *>
if m^.u2=0 then begin
lock m as inl:cline do with inl do begin
d(n):=nl;
case d(f) of
't','m': begin <* set testmode *>
c1:=d(f+1);
if (c1='q') or (c1='r') then begin
i:=f+2; c2:=c1;
end else begin
i:=f+1; c1:='q'; c2:='r';
end;
w:=testoff;
if d(i)='4' then begin
if not nil(r) then signal(r,opool);
w.func:=0;
end else begin
if d(i)='5' then begin
if not nil(r) then signal(r,opool);
while open(oque) do begin
wait(r,oque); signal(r,opool);
end;
w.func:=1; skip:=true;
end else if (d(i)<'0') or (d(i)>'3') then err:=true
else w.func:=cif(d(i));
end;
if not err then with w do begin
if d(f)='m' then begin
b:=false;
repeat
i:=i+1;
case d(i) of
'0','e':      ; '1','a': t2:=1; '2','m': t3:=1;
'3','s': t4:=1; '4'    : t5:=1; '5','f': t6:=1;
otherwise b:=true;
end;
if not b then t1:=1;
until b;
for c:=c1 to c2 do mode(c):=w;
end else for c:=c1 to c2 do mode(c).func:=func;
end;
end;
'h': mode:=head;
'l','p': begin <* list testoutput *>
print:=d(f)='p'; i:=f+1; lc:=0;
while (d(i)>='0') and (d(i)<='9') do begin
lc:=lc*10+cif(d(i)); i:=i+1;
if lc>3000 then d(i):=nl;
end;
if lc>3000 then err:=true else
if lc>0 then nc:=lc else lc:=nc;
list;
end;
'c': begin <* connect *>
f:=f+1; c:=d(f);
lock con as buf: contype do with buf do begin
b:=false; if d(f+1)>'9' then mode:=mode0;
with mode do repeat
f:=f+1;
case d(f) of
's': s:=1;
'p': p:=1;
'i': i:=1;
'r': r:=1;
'f': fa:=1;
'a': a:=1;
otherwise b:=true;
end;
until b;
for i:=2 to 5 do begin
while ((d(f)<'0') or (d(f)>'9')) and (d(f)<>nl) do f:=f+1;
if d(f)<>nl then inf(i):=0;
while (d(f)>='0') and (d(f)<='9') do
if inf(i)>3000 then c:='a' else begin
inf(i):=inf(i)*10+cif(d(f));  f:=f+1;
end;
end;
end;
con^.u1:=4;  con^.u2:=7;
if (c='q') or (c='r') then begin
signal(con,sem(c));
wait(con,cona);
end else err:=true;
end;
'd': begin <* disconnect *>
con^.u1:=8;  con^.u2:=7;
if (d(f+1)='q') or (d(f+1)='r') then begin
signal(con,sem(d(f+1)));
wait(con,cona);
end else err:=true;
end;
's':
if (d(f+1)='q') or (d(f+1)='r') then begin
if d(f+2)='c' then stat^.u1:=32 else stat^.u1:=28;
stat^.u2:=7; signal(stat,sem(d(f+1))); wait(stat,cona);
lock stat as b: record
n1,n2,n3: integer;
c1: array(1..4) of bt4;
c2: array(1..9) of integer;
c3: packed array(1..6) of 0..15;
c4: array(1..5) of integer;
end do with b do begin
wait(out,outa);
lock out as line: cline do begin
line.l:=97; line.d:=
' time    rec.inf   trmt.inf     skiped    retrmt. last rec.cmdr';
end;
out^.u2:=7; signal(out,op^); wait(out,outa);
lock out as line: cline do with line do begin
l:=f-1; d:='  '; outi(d,l,c4(4),6); d(f+1):=inl.d(inl.f+1);
for i:=1 to 4 do dout(d,l,c1(i),11);
i:=1; l:=l+4;
repeat
l:=l+3; d(l-1):=dig(c3(i)); d(l):=dig(c3(i+1)); i:=i+2;
until i>6;
outi(d,l,c4(5),7);
l:=l+1; d(l):=nl; d(f):=nl;
end;
out^.u2:=7; signal(out,op^); wait(out,outa);
lock out as line: cline do begin
line.l:=97; line.d:=
'rec-rnr-trm rec-rej-trm timer   dsr   dcd   sqd    ci ovr-run-und abort';
end;
out^.u2:=7; signal(out,op^); wait(out,outa);
lock out as line: cline do with line do begin
l:=f-1; d:='  ';
for i:=1 to 9 do outi(d,l,c2(i),6);
for i:=1 to 3 do outi(d,l,c4(i),6);
l:=l+1; d(l):=nl; d(f):=nl;
end;
out^.u2:=7; signal(out,op^);
end;
end else err:=true;
'v':
begin
c:=d(f+1);
if (c='q') or (c='r') then begin
con^.u1:=36; con^.u2:=7;
con^.u3:=((ord(d(f+2)) mod 87) and 15)*16
+((ord(d(f+3)) mod 87) and 15);
signal(con,sem(c)); wait(con,cona); wait(out,outa);
lock out as line: cline do with line do begin
d:='  linespeed';
d(f):=c; l:=f+12;
outi(d,l,con^.u2 div 8,2); outi(d,l,con^.u2 and 7, 2);
d(l-1):='.'; l:=l+1; d(l):=nl;
end;
out^.u2:=7; signal(out,op^);
end else err:=true;
end;
'u': begin <* set modem and sense *>
c:=d(f+1);
if (c='q') or (c='r') then begin
lock stat as buf: record
n1,n2,n3: integer;
urts,rts,udtr,dtr:bit;
end do with buf do begin
urts:=0; udtr:=0; b:=false;
repeat
f:=f+2;
if d(f)='s' then begin
udtr:=1; dtr:=ord(d(f+1)) and 1;
end else if d(f)='r' then begin
udtr:=1; dtr:=ord(d(f+1)) and 1; 
end else b:=true;
until b;
end;
stat^.u1:=24; stat^.u2:=7; signal(stat,sem(c)); wait(stat,cona);
stat^.u1:= 0; stat^.u2:=7; signal(stat,sem(c)); wait(stat,cona);
wait(out,outa);
lock out as line: cline do with line do with stat^ do begin
d:=' -status=      result=';
d(f):=c; l:=f+23;
d(l):=nl; d(l-1):=dig(u2 and 7); u2:=u2 div 8;
for i:=10 to 14 do
begin d(l-i):=bool(u2 and 1); u2:=u2 div 2 end;
end;
out^.u2:=7; signal(out,op^);
end else err:=true;
end;
'r':
begin
if d(f+1)='a' then con^.u1:=12 else
if d(f+1)='u' then con^.u1:=16 else err:=true;
if not err then begin
if (d(f+2)='q') or(d(f+2)='r') then begin
c1:=d(f+2); c2:=c1;
end else begin
c1:='q'; c2:='r';
end;
for c:=c1 to c2 do begin
con^.u2:=7; signal(con,sem(c)); wait(con,cona);
end;
end;
end;
'e': begin
c:=d(f+1);
if ((c='q') or (c='r')) and (d(f+2)>='0') and (d(f+2)<='9') then begin
etop(c):=cif(d(f+2));
while openpool(hpool) and (etop(c)>ecnt(c)) do begin
alloc(out,hpool,a);
out^.u1:=40; out^.u2:=7; signal(out,sem(c));
ecnt(c):=ecnt(c)+1;
end;
end else err:=true;
end;
'f': finis:=(d(f+1)='i') and (d(f+2)='n');
nl : ;
otherwise
err:=true;
end;
f:=18;
end;
end;
if m^.u1=1 then signal(m,op^) else return(m);
end else with m^ do
if u1=40 then begin <* event answer *>
if u2 mod 8=0 then begin
wait(out,outa);
lock out as line: cline do with line do begin
c:=ln(u3); d:='event'; l:=f+8; d(f+6):=c; outi(d,l,m^.u2 div 8,2);
l:=l+1; d(l):=nl;
end;
signal(out,op^);
if m^.u2>=8 then mode(c).func:=1;
if m^.u2=15 then etop(c):=0;
end;
if etop(c)<ecnt(c) then begin ecnt(c):=ecnt(c)-1; release(m) end else 
begin u2:=7; signal(m,sem(c)) end;
end else begin <* testoutput answ *>
if (u2=0) and (u4 <> 0) then begin
if (u4=2) then mode(ln(u3)).func:=2;
lock m as td:testtype do u4:=td.next;
signal(m,oque);
if print then begin lc:=nc; list end;
end else signal(m,opool);
end;
if err then begin
err:=false; wait(m,era); signal(m,op^);
end else
for c:='q' to 'r' do if mode(c)<>state(c) then
if open(opool) then begin
wait(m,opool);
setmode(m^.u3,mode(c)); m^.u2:=7;
if skip then m^.u4:=0 else m^.u4:=mode(c).func;
signal(m,sem(c));
mode(c).func:=0;  state(c):=mode(c);
end;
skip:=false;
until finis;
stop(hdlcq); stop(hdlcr); stop(data);
remove(hdlcq); remove(hdlcr); remove(data);
finis:=false;
until false;
end
.

▶EOF◀