DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦d3146265a⟧ TextFile

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »ttestout«

Derivation

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

TextFile

process hdlctestout(var oque,op,answ: semaphore);
const
testmax=30;

type
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;
booltype=array (0..1) of char;

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

const
dig=digtype('0','1','2','3','4','5','6','7','8','9','A','B','C','D',
'E','F');
bool=booltype('.','I');
var
i,v: integer;
out,r: reference;
outa: semaphore;
opool: pool 1 of cline;

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 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+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;

begin
alloc(out,opool,outa);
lock out as line: cline do with line do begin
out^.u1:=2; f:=18; name:='hdlctestout';
end;
return(out);

repeat
wait(r,oque); wait(out,outa);
lock out as line: cline do with line do begin
d:=
' dev    time            send   xmt   rec status    b  r  x ymji n   t sia';
d(f):=nl; l:=f+3; outi(d,l,r^.u3,3);
d(l+1):=nl; l:=l+68; d(l):=nl;
end;
signal(out,op);
lock r as td:testtype do with td do begin
if (next>=0) and (next<=testmax+1) and (last>=0) and (last<=testmax) then
begin
i:=next;
while 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';
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);
end;
testo(d(i));  i:=i+1;
end;
i:=first;
while i<next do begin
testo(d(i));  i:=i+1;
end;
end;
end;
signal(r,answ);
until false;
end;
.
▶EOF◀