|
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: 14592 (0x3900)
Types: TextFile
Names: »testout«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦0b92c64d5⟧ »ctb«
└─⟦this⟧
; btj 30.08.74 bossout and last ...1...
(bossout=set 15 disc
bossout=algol
scope user bossout
)
external procedure bossout(fkind, ftime, fcoruno, fthird, frecord, move, print);
integer fkind, ftime, fcoruno, fthird;
integer array frecord; comment must be declared integer array frecord(0:256);
boolean move, print;
message bossout version id: 76 10 28, 25;
begin comment standard declarations for analysis of boss testoutput;
integer kind, length, time, third, coruno, cyclestart,
cycleend, file; boolean changed;
zone z(128*2,2,eof);
own boolean stopfound, artifistop;
procedure eof(z,s,b); zone z; integer s,b;
begin own boolean eot; integer array zonedescr(1:20);
if s extract 1 = 1 and s shift (-14) extract 1 = 0 then stderror(z,s,b) else
if file >= 0 then
begin if s shift(-18) extract 1 = 1 then eot:= true;
if s shift (-14) extract 1=1 then
begin comment mode error;
getposition(z, 0, b); comment destroy b;
getzone6(z, zonedescr);
if zonedescr(1) = 4 shift 12 + 18 or b > 1 then
stderror(z, s, 0); comment called recursive, or not at start;
zonedescr(1) := 4 shift 12 + 18; comment nrz-mode;
setzone6(z, zonedescr);
for b := zonedescr(18) step -1 until 1 do
begin comment change mode in shares;
getshare6(z, zonedescr, b);
zonedescr(4) := 4;
setshare6(z, zonedescr, b);
end;
setposition(z, 0, 0); setposition(z, 0, 0); comment set mode;
setposition(z, file, 0); comment restart same file in nrz mode;
s := b := 0; comment repeat block, and skip rest of status;
end else
if eot and s shift(-16) extract 1 = 1 and b > 0 then
begin setposition(z, -1, -1); setposition(z, 0, 0);
file:= 0; b:= 0; eot:= false;
end else
if s shift (-16) extract 1=1 and b>0 then goto teststop;
end else
begin comment end of backing store;
teststop:
getposition(z,0,cycleend); setposition(z,file,cyclestart);
if -, stopfound then
begin
getzone6(z,zonedescr);
zonedescr(16) := 512; comment recordlength;
setzone6(z,zonedescr);
z(1) := real <::> add 9 shift 24;
z(2) := real <::>;
zonedescr(16) := 0;
setzone6(z,zonedescr);
b := 512;
artifistop := true;
end else artifistop := false;
end;
end;
\f
comment btj 30.08.74 testout ...2...
;
procedure nextrecord;
begin integer field f,s,t,i,k; own integer state;
own boolean after_installation_ident;
long field lf; real r;
f:=2; s:=4; t:=6;
rep: i:=inrec6(z,6); kind:=k:=z.f extract 6;
if k=0 then begin inrec6(z,i); goto rep end;
length:=z.f shift(-6); time:=z.s; third:=z.t;
if length>i then
begin comment trouble;
k:=10; write(out,<:<10>trou:>,<<-ddddddd>,z.f,time,third);
rep1: i:= inrec6(z,2);
if k<10 then k:=k+1 else
begin k:=1; write(out,<:<10>trou:>) end;
write(out,<<-ddddddd>, z.f);
if i>1 then goto rep1;
goto rep;
end;
inrec6(z,length);
if k>4 then
begin changed:= third<>coruno; coruno:=third end
else changed:=false;
if state<3 then
begin if kind=14 then state:=1 else
if kind=13 and state=0 then
begin comment ident record from pass 1;
if z(1)=real<:bos:> then
begin lf:=12; r:=z.lf/10000;
write(out,<:<10><10>start-up::>,
<< dd dd dd>,systime(2,r,r),r);
end;
i:=1; i:=write(out,<:<10>ident: :>,string z(increase(i)));
if after_installation_ident then
begin
write(out,false add 32,18-i);
for i:=10 step 2 until length do
write(out,<<-ddddddd>, z.i);
end else
after_installation_ident := true;
end else
if state=1 then
begin comment first record after ext table;
if kind=13 then state:=3 else
begin getposition(z,0,cyclestart); state:=2; goto rep;
end end;
if state=2 then
begin if kind<>9 then goto rep;
getposition(z,0,k);
if artifistop then
begin comment artificial end-record;
k := cyclestart -1;
end
else stopfound := true;
setposition(z,file,k+1);
state:=3; goto rep;
end;
end state<3;
end nextrecord;
\f
comment btj 30.08.74 testout ...3...
;
procedure bosshead(head); string head;
begin integer i, j, kind; real r; array ra(1:2);
coruno:=-1; cycleend:=cyclestart:=0; i:=1;
systime(1,0,r); system(4,1,ra);
write(out,<:<12><10>:>, head,<< dd dd dd>,systime(2,r,r),r,
<: file: :>, string ra(increase(i)) );
if system(4,2,ra) extract 12 = 4 then
begin comment file number;
file:=ra(1); kind:=18; write(out,<:.:>,<<d>,file);
end else
begin comment name, bs assumed;
file:=-1; kind:=4; write(out,<:.bs:>);
end;
j := 3;
for i := system(4,j,ra) while i <> 0 do
begin
j := j + 1;
write(out, if i shift (-12) = 4 then <: :> else <:.:>);
if i extract 12 = 4 then
begin i := ra(1);
write(out, <<d>, i)
end
else
begin
i := 1; write(out, string ra(increase(i)));
end;
end;
system(4,1,ra); i:=1;
open(z,kind,string ra(increase(i)), 1 shift 14 + 1 shift 16 + 1 shift 18);
setposition(z,file,0);
end bosshead;
comment end standard declarations;
integer field i,i2,i4,b,e; array ra(1:2);
array field name; integer k;
name:= 6;
bosshead(<:bossout:>); cycleend:= e:=1000 000;
i:=system(4,3,ra); if i shift(-12) <> 8 then goto rep;
e:=ra(1); comment e=number of blocks from end of output;
rep1: nextrecord; if kind<>9 then goto rep1;
scan: getposition(z,file,b);
b:= if e>= cycleend - cyclestart or artifistop then 0 else
if b-cyclestart < e then
(if cyclestart =0 then 0 else cycleend-cyclestart+b-e) else b-e;
setposition(z,file,b);
\f
comment btj 30.08.74 testout ...4...
;
rep: nextrecord; fkind:=kind; ftime:=time; fcoruno:=coruno; fthird := third; frecord(0) := length;
if move then for i:=2 step 2 until length do frecord.i := z.i;
if print or kind=9 then
begin if changed then write(out,<:<10>:>);
if kind=19 then
begin comment skip empty entries in tape table;
for i:=2 step 2 until 18 do
if z.i<>0 then goto exitloop;
goto rep;
end; exitloop:
if kind<10 then
write(out, case kind of(<:<10>send:>,<:<10>lock:>,
<:<10>opch:>,<:<10>open:>,<:<10>exit:>,<:<10>mess:>,
<:<10>answ:>,<:<10>jd-1:>,<:<10>stop:>))
else write(out,<:<10>:>,<<dddd>, kind);
write(out,<<-ddddddd>, time,third);
if kind<>13 and kind<15 or kind > 20 then
begin
k:=20;
if kind=5 then length:=length-2 else
if kind=9 and length > 6 then length:=length-6;
for i:=2 step 2 until length do
begin write(out,<<-ddddddd>,z.i);
if i mod k = 0 then
write(out,false add 10,1,false add 32,20);
end;
i2:=i+2; i4:=i+4;
comment last word in kind 5 record is: page ident<12 + rel exit;
if kind=5 then write(out,<<-dddd>,z.i shift (-12),z.i extract 12);
comment last 3 words in kind 9 records are:
base of corunocodepage <2 + exception reg
instruction counter
fault cause < 12 + page ident
if fault is caused by bossfault 2 - 199 then fault cause is
negative otherwise it is non-negative (i.e. interrupt cause);
if kind=9 and length > 6 then write(out,<<-ddddddd>,z.i shift (-2),z.i extract 2,
z.i2,<<-dddd>,z.i4 shift (-12) shift 12 // 4096,
z.i4 extract 12);
end else begin
if kind = 16 then
begin comment bytes, bsadjust;
for i:= 2 step 2 until 8 do
begin if i mod 14 = 0 then
write(out, false add 10, 1, false add 32, 20);
write(out, <<-ddddddd>, z.i shift(-12), z.i extract 12);
end;
if length > 8 then
begin
i:=3;
if length > 10 then write(out,<: :>,string z(increase(i)));
i:=length;
if length > 10 then write(out,z.i) else
write(out,<<-ddddddd>, z.i shift (-12), z.i extract 12);
end;
\f
comment btj 30.08.74 testout ...5...
;
end else
if kind = 17 then
begin comment catalog entry;
k:= 1; i:= 2;
write(out, <: :>, false add 32, 16-write(out,
<: :>, if k>2 then <:*:> else string z.name(increase(k))),
<<dddd>, z.i shift(-12), z.i shift(-3) extract 9,
z.i extract 3);
for i:= 4, 6 do write(out, <: :>, <<-ddddddd>, z.i);
i:= 16;
if z.i >= 0 then write(out, <<ddddd>, z.i)
else write(out, <<ddddd>, z.i shift(-12), <:.:>,
<<d>, z.i extract 12);
i:= 18; k:= 5;
write(out, <: :>, if z.i = 0 then <:0:> else if k>6 then <:*:> else
string z(increase(k)));
for i:= 26 step 2 until length do
begin write(out, <: :>);
if z.i shift(-12) <> 0 then
write(out, <<d>, z.i shift(-12), <:.:>);
write(out, <<d>, z.i extract 12);
end;
end else
if kind = 18 then
begin comment station entry in mount table;
write(out, <: :>);
for i:= 2, 4 do
write(out, <<-ddddddd>, z.i shift(-12), z.i extract 12);
for i:= 6, 8 do
write(out, <<-ddddddd>, z.i);
i:= 10;
write(out, <<-ddddddd>, z.i shift(-12), z.i extract 12);
for i:= 12 step 2 until 18 do
write(out, <<-ddddddd>, z.i);
end else
if kind = 19 then
begin comment tape entry in mount table;
write(out, <: :>);
i:= 2; k:= 3;
write(out, <<-ddddddd>, z.i shift(-12), z.i extract 12 - 4096);
for i:= 4, 6 do
write(out, <<-ddddddd>, z.i);
i:= 8;
write(out, <<-ddddddd>, z.i shift(-12), z.i extract 12);
write(out, <: :>, if k>4 then <:*:> else string z(increase(k)));
i:= 18;
write(out, <: :>, <<-ddddddd>, z.i);
end else
if kind = 20 then
begin comment terminate and prepare access;
write(out, <: :>);
for i:= 2 step 2 until 10 do
write(out, <<-ddddddd>, z.i);
k:= 2;
write(out, <: :>, if k>3 then <:*:> else string z.name(increase(k)));
end else
if kind = 15 then
begin write(out,<: :>);
for i:=2 step 2 until length do
write(out, false add (z.i shift(-16)), 1,
false add (z.i shift(-8) extract 8), 1,
false add (z.i extract 8), 1);
end end;
end;
if kind<>9 then goto rep;
stop: end; end;
\f
; btj 30.08.74 last ...7...
; call of last:
; last docname.file_or_bs.blocks_at_end first_coruno.last_coruno <any legal parameters>
(last=set 30 disc
last=algol
scope user last
)
begin integer k,c,f,j,i,l; array ra(1:2);
integer array record(0:0);
f:=0; l:=1000; i:= if system(4, 3, ra) shift(-12) = 8 then 4 else 3;
comment if the next two parameters are integers, separated by a point,
then use them as lower and upper limit of corutine numbers;
c := system(4,i+2,ra); comment separator after limits;
j := system(4,i ,ra); comment separator before limits;
k := system(4,i+1,ra); comment separator between limits;
comment evt ra(1) =last_coronu;
if j shift (-12) = 8 then write(out, <:***last param<10>:>)
else begin
if j extract 12 = 4 and k extract 12 = 4
and k shift (-12) = 8
and (c = 0 or c shift (-12) = 4 ) then
begin l:=ra(1); system(4,i,ra); f:=ra(1) end;
bossout(k,0,c,0,record,false,(f<=c and c<=l) or k=14);
comment jensens device:
the parameters k and c are set by the procedure and the last
parameter evaluated with these values;
end
end
\f
▶EOF◀