|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 10752 (0x2a00)
Types: TextFile
Names: »stastudtxt «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦40b1eb8cd⟧
└─⟦this⟧ »stastudtxt «
begin
integer field i,t,s,c,f,j,ver1,ver2;
integer type,l,time,coru,fourth,old,e,file,block,rest,segno,top_seg,low_seg,
lno,maxno,p,q,last_rec,first_rec,x,y,masker;
long field st,tim;
integer array tail(1:10),m_val(1:30,1:30);
long min_time;
boolean ch,stk,eb,stop,outfile;
boolean array maske(1:30,1:30);
long array foname,finame(1:3);
real r,v;
real array txt(1:300);
zone z(128,1,stderror);
procedure initmaske;
begin
boolean end_init,end_felt,end_maske;
integer c,i,j,mno,fno,p;
end_init:=false;
repeat
write(out,<:<10>(l,c,m,g,f) -> :>); setposition(out,0,0);
skip_sp(c);
i:=c; while i<>10 do readchar(in,i); <* skip resten af linien *>
if c = 'l' then begin <* list masker *>
if masker=0 then
write(out,<:ingen masker <10>:>)
else begin
write(out,<: :>,
<: type, coru, fourth, p1, p2, p3, p4<10>:>);
for i:=1 step 1 until masker do begin
write(out,<:<10>maske :>,<< dd>,i,<: : :>);
for j:=1 step 1 until 7 do
if maske(i,j) then
write(out,<< ddddd>,m_val(i,j),<:, :>)
else
write(out,<: , :>);
end;
end;
end
else
if c = 'c' then begin <* clear maske *>
for i:=1 step 1 until 30 do
for j:=1 step 1 until 30 do maske(i,j):=false;
masker:=0;
end
else
if c = 'm' then begin <* sæt maske *>
mno:=0;
write(out,<: :>,
<: type, coru, fourth, p1, p2, p3, p4<10>:>);
end_maske:=false;
repeat <* et gennemløb for hver maske *>
fno:=0;
mno:=mno+1;
write(out,<:maske :>,<< d>,mno,<: - :>); setposition(out,0,0);
end_felt:=false;
repeat <* et gennemløb for hvert felt *>
skip_sp(c);
if c<>10 then repeatchar(in);
if c = 10 then begin
if mno-1>masker then masker:=mno-1;
if fno=0 then
end_maske:=end_felt:=true
else
end_felt:=true;
end
else
if c = '*' then begin <* tom felt *>
fno:=fno+1;
maske(mno,fno):=false;
end
else
if c<'0' or c>'9' then begin
write(out,<:*** forkert felt<10>:>);
mno:=mno-1;
end
else
begin
read(in,p); repeatchar(in);
fno:=fno+1;
maske(mno,fno):=true;
m_val(mno,fno):=p;
end;
until end_felt;
until end_maske;
end
else
if c = 'g' then
end_init:=true
else
if c = 'f' then
goto FIN;
until end_init;
end;
procedure skip_sp(c); integer c;
begin
repeat
readchar(in,c);
until c<>32;
end;
procedure skip(no); value no; integer no;
begin
integer i;
setposition(z,0,0);
rest:=inrec6(z,4);
segno:=0;
lno:=0;
for i:=1 step 1 until no do next(false);
end;
procedure skriv(zout); zone zout;
begin
integer field i;
write(zout,<<dddd>,lno,<:. :>);
if type<221 then write(zout,string txt(type))
else write(zout,<: :>);
write(zout,<<dddd>,type,<: - :>);
write(zout,<<ddddddd>,time);
write(zout,<< ddd>,coru extract 12,<:/:>);
i:=coru shift (-12);
if i < 7 then
write(zout, case i+1 of
( <:C,:>, <:D,:>, <:T,:>, <:M,:>, <:W,:>, <:P,:>, <:R,:> ) )
else write(zout,<< d>,i);
write(zout, << dddddd>,fourth,<: : :>);
for i:=2 step 2 until l do begin
write(zout,<< -ddddddd>,z.i);
if i mod 8=0 and i<l then write(zout,<:<10>:>,false add 32,45);
end;
outchar(zout,10);
end;
procedure next(prt);
value prt; boolean prt;
begin
rep:
<* write(out,<:<10>** rest = :>,<< d>,rest,<:<10>:>); *>
if rest = 0 then begin
if segno = 0 then
segno:=low_seg
else begin
segno:=segno+1;
if segno=top_seg then segno:=1;
if segno=low_seg then goto FIN;
end;
<* write(out,<:<10>** seg = :>,<< d>,segno,<:<10>:>); *>
setposition(z,0,segno);
rest:=inrec6(z,4);
if z.tim = 0 then begin
rest:=inrec6(z,rest);
goto rep;
end;
end;
if rest<8 then i:=rest else i:=8;
rest:=inrec6(z,i);
type := z.t extract 12;
if type = 0 then
begin
if rest=0 then goto rep;
rest:=inrec6(z,rest);
goto rep
end;
l:=z.t shift (-12);
time:=z.s;
coru:=z.c;
fourth:=z.f;
if l>rest then begin
write(out,<:<10>trouble :>,l,rest,<:<10>:>);
inrec6(z,rest);
goto rep;
end;
rest:=inrec6(z,l);
if type=1 then begin
if prt then begin
r:=z.st/10000;
write(out,<:<10>start - up :>,
<< dd dd dd>,systime(2,r,r),r,
<:<10>version :>,z.ver1,z.ver2);
i:=2; write(out,<:<10>first code = :>,<< ddddddd>,z.i);
i:=12; write(out,<:<10>first proc = :>,<< ddddddd>,z.i);
i:=14; write(out,<:<10>last proc = :>,<< ddddddd>,z.i);
write(out,false add 10,2);
end;
goto rep
end;
lno:=lno+1;
end next;
t:=2; s:=4; c:=6; f:=8;
st:=6; ver1:=8; ver2:=10; old:=0;
tim:=4; maxno:=1; outfile:=false;
stop:=false;
for x:=1 step 1 until 30 do
for y:=1 step 1 until 30 do maske(x,y):=false;
masker:=0;
for i:=1 step 1 until 220 do txt(i):=real( case i of (
<* 1 *> <:start-up:>,<:start-co:>,<:start :>,<:wait :>,<:pass :>,
<* 6 *> <:inspect :>,<:csendmes:>,<:cwaitans:>,<:exit cwa:>,<:cregret :>,
<* 11 *> <:signal :>,<:wait sem:>,<:exit ws :>,<:send let:>,<:inspectm:>,
<* 16 *> <:wait let:>,<:exit wl :>,<:send mes:>,<:wait buf:>,<:exit wb :>,
<* 21 *> <:rel buf :>,<:exit :>,<:answer :>,<:answer a:>,<:message :>,
<* 26 *> <:timer sc:>,<:mes arri:>,<:att answ:>,<:tem mess:>,<:rem ans :>,
<* 31 *> <:creat co:>,<:remov co:>,<:g open :>,<:g lock :>,<:exit gl :>,
<* 36 *> <:wait sle:>,<:exit wsl:>,<:get buf :>,<: :>,<: :>,
<* 41 *> <: :>,<: :>,<: :>,<: :>,<: :>,
<* 46 *> <: :>,<: :>,<: :>,<: :>,<:crt link:>,
<* 51 *> <:rem link:>,<:adj link:>,<:put op :>,<:check op:>,<:releasop:>,
<* 56 *> <:get spoo:>,<:get free:>,<:adjust :>,<:rel_cte :>,<:seg io :>,
<* 61 *> <:look nam:>,<:in mcl n:>,<:rem mcln:>,<:get mseg:>,<: :>,
<* 66 *> <:next :>,<:c spoola:>,<:r spoola:>,<:seg ispo:>,<:ext spoo:>,
<* 71 *> <:cut area:>,<:move :>,<:w-error :>,<: :>,<:new term:>,
<* 76 *> <:searchth:>,<:in sess :>,<:out sess:>,<:unlink s:>,<:get tdat:>,
<* 81 *> <:link th :>,<:ulink th:>,<:link ph :>,<:ulink ph:>,<: :>,
<* 86 *> <: :>,<: :>,<: :>,<: :>,<: :>,
<* 91 *> <: :>,<: :>,<: :>,<: :>,<: :>,
<* 96 *> <: :>,<: :>,<: :>,<:get abs :>,<: :>,
<* 101*> <: :>,<:push :>,<:pop :>,<:crt mcl :>,<:var addr:>,
<* 106*> <:alloc va:>,<:del var :>,<:set var :>,<:wait :>,<:wait op :>,
<* 111*> <:wait ter:>,<:tasc mes:>,<:s-att :>,<:rem ph :>,<:rem th l:>,
<* 116*> <:crt user:>,<:crt ph :>,<:mcl exit:>,<:term th :>,<:direct :>,
<* 121*> <:input op:>,<:output o:>,<:sim in :>,<:ctrl op :>,<:cont mcl:>,
<* 126*> <:answer i:>,<:f8000 in:>,<:send f8 :>,<:f8 read :>,<:term s-w:>,
<* 131*> <:signon :>,<:to_from :>,<: :>,<: :>,<: :>,
<* 136*> <: :>,<: :>,<: :>,<: :>,<:init_td :>,
<* 141*> <:c_read :>,<:c_write :>,<:get t ad:>,<:comp txt:>,<:move txt:>,
<* 146*> <:outtext :>,<:c_outtxt:>,<:write :>,<:erase :>,<:cursor :>,
<* 151*> <:in_text :>,<:rd_char :>,<:rd pass :>,<:strip nl:>,<:strip sp:>,
<* 156*> <: :>,<: :>,<: :>,<: :>,<:run mcl :>,
<* 161*> <:end_th :>,<:ex err 1:>,<:ex err 2:>,<:ex err 3:>,<: :>,
<* 166*> <: :>,<: :>,<: :>,<: :>,<:next op :>,
<* 171*> <: :>,<: :>,<: :>,<: :>,<: :>,
<* 176*> <: :>,<: :>,<: :>,<: :>,<: :>,
<* 181*> <:lette.th:>,<:sear.th :>,<:op_mes :>,<:crt ph :>,<: :>,
<* 186*> <: :>,<:start rm:>,<: :>,<: :>,<: :>,
<* 191*> <: :>,<: :>,<: :>,<: :>,<: :>,
<* 196*> <: :>,<: :>,<: :>,<: :>,<:i sysm :>,
<* 201*> <:in strg :>,<:in point:>,<:gen sysm:>,<:w sysm :>,<:find ses:>,
<* 206*> <:search p:>,<:new pass:>,<:new ses :>,<:rem ses :>,<:brk ses :>,
<* 211*> <:kill out:>,<:send att:>,<:get char:>,<: :>,<: :>,
<* 216*> <: :>,<: :>,<: :>,<:start sm:>,<:goto ac :>));
write(out,<:fil navn : :>);
setposition(out,0,0);
readstring(in,foname,1);
open(z,4,foname,0);
monitor(42,z,i,tail);
top_seg:=tail(1);
min_time:= (extend (-1)) shift (-1);
setposition(z,0,1);
for i:=1 step 1 until top_seg-1 do begin
inrec6(z,512);
if min_time > z.tim and z.tim<>0 then begin
low_seg:=i;
min_time:=z.tim;
end;
end;
<* tæl antal test records *>
setposition(z,0,0);
rest:=inrec6(z,4);
segno:=0;
count:
next(false);
maxno:=maxno+1;
if type<>1023 then goto count;
setposition(z,0,0);
rest:=inrec6(z,4);
segno:=0;
next(true);
write(out,<:<10>Antal test records = :>,<< ddd>,maxno,<:<10>:>);
repeat
initmaske;
write(out,<:Fra :>); setposition(out,0,0);
read(in,first_rec);
if first_rec<1 then first_rec:=1;
write(out,<:Til :>); setposition(out,0,0);
read(in,last_rec);
skip(first_rec-1);
for q:=first_rec step 1 until last_rec do begin
next(false);
if masker = 0 then
skriv(out)
else
for x:=1 step 1 until masker do begin
if maske(x,1) then begin
if m_val(x,1) <> type then goto skrv;
end;
if maske(x,2) then begin
if m_val(x,2) <> coru extract 12 then goto skrv;
end;
if maske(x,3) then begin
if m_val(x,3) <> fourth then goto skrv;
end;
i:=0;
for p:=4 step 1 until 10 do begin
i:=i+2;
if maske(x,p) then begin
if (m_val(x,p) <> z.i) then goto skrv;
end;
end;
skriv(out);
skrv:
end;
if type = 1023 then goto try_next;
end;
try_next:
until false;
FIN:
end;
▶EOF◀