|
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: 13056 (0x3300)
Types: TextFile
Names: »tapescantx«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦0f6e8048b⟧ »preditfile«
└─⟦this⟧
comment tapescantx * page 1 26 03 80, 14.12;
comment case 11, tapescan;
_________________________
comment GI reg. no. 75007
written 1975 and updated 1979-80 by E. Hjortenberg;
begin
comment abbreviations used as names:
p=print, nbe=not block end,
it=total number of blocks read, ib=block number(in file),
bl=block length(bytes), blold=previous block length,
s=status word, sold=previous status word, ch=character,
sf=skipfiles, pf=printfiles, sb=skipblocks, pb=printblocks,
se=skipelements, pe=printelements, fl=feet limit,
f=feet from load point, pa=parity errors allowed,
pt=parity errors found, bi=block interval, bbi=boolean bi,
inrange=fileno and blockno is within print range,
p=print this block,
ebcp=every block change printed,
pe54= 5 parity errors at block no 4( fifth block);
zone z(1280, 1, printb); <* max 10 segments per block*>
integer array param, ia(1:6);
boolean p, nbe, bbi, inrange, change, ebcp, first,
endsearch, tm, tmold, test, nrz, pe54, alarm;
array name, a, b(1:2);
real f, fl;
integer it, ib,
_ file, rest, oldfile, blold, sf, pf, sb, pb, se, pe,
ch, i, j, k, n, word, line, istart, eb, pa, pt, bi, blim, llimit,
sold, blmax, iparam, t2, t3;
procedure printb(z, s, bl); zone z; integer s, bl;
begin
if bl=0 and it>=0 then
begin
if s shift (-14) extract 1=1 and -, nrz then
begin
close(z, false);
it:=-1;
i:=1;
open(z, 4 shift 12 add 18 , string name(increase(i)), -1);
nrz:=true;
end
else
begin
endsearch:=true;
alarm:=true;
end;
end;
getposition(z, file, ib);
if s shift (-16) extract 1=1 then tm:=true
_ else tm:=false;
f:=f+bl/(if nrz then 6400 else 12800)+0.05;
comment record gap 0.05 feet assumed;
if f>fl then
endsearch:=true;
inrange:=file <sf+pf and file>=sf
and ib<sb+pb and ib>=sb;
change:=s<>sold or (bl<>blold and ebcp)or bl>blmax;
bbi:=it mod bi=0 and it>0;
p:=inrange or change or bbi or bl<4 or endsearch
or s shift (-20) extract 3 > 0
or s shift (-16) extract 3 > 0;
\f
comment tapescantx * page 2 26 03 80, 14.12
0 1 2 3 4 5 6 7 8 9 ;
if p then
begin
if it<0 or ib<0 then
write(out, nl, 1,
_ <<-dddd>, it, <<-dd>, file, <<-dddd>, ib, bl)
else
write(out,
nl, 1, <<ddddd>, it, <<ddd>, file, <<ddddd>, ib, bl);
if -, bbi then
begin write(out, sp, 2);
for i:=-20 step 4 until 0 do
begin ch:=s shift i extract 4;
if ch<10 then ch:=ch+48 else ch:=ch+87;
comment ch contain sextodecimal (hexadecimal) digit;
write(out, false add ch, 1);
end; write(out, sp, 2);
end else write(out, sp, 1, <<dddd>, f,
<:feet :>); comment end of sedecimal status;
llimit:=(pe-1)//2;
if -, inrange then llimit:=0;
if pe=0 then llimit:=-1;
if bl=0 then llimit:=-2;
if llimit*8>bl then llimit:=1+bl//8;
for line:=0 step 1 until llimit do
begin
if line>0 then write(out, nl, 1, sp, 28);
istart:= line*2+se+1;
for i:=istart, istart+1 do
begin
for j:=0, 1 do
begin
word:=z(i)shift((j-1)*24)extract 24;
for k:=-20 step 4 until 0 do
begin
ch:=word shift k extract 4;
if ch<10 then ch:=ch+48 else ch:=ch+87;
nbe:=(i-1)*4+j*2+(k+20)//12<bl;
if nbe then write(out, false add ch, 1)
else write(out, sp, 1);
end char;
write(out, sp, 1);
end word;
write(out, sp, 1);
end element;
for i:=istart, istart+1 do
for j:=-40 step 8 until 0 do
begin ch:=z(i)shift j extract 8;
if ch<32 or ch>126 then ch:=32;
nbe:=i*4+(j+48)//12<bl+2;
if nbe then write(out, false add ch, 1);
end char, element;
end line;
\f
comment tapescantx * page 3 26 03 80, 14.12
0 1 2 3 4 5 6 7 8 9 ;
if llimit=-1 then
begin
for i:=0 step 1 until 23 do
begin
if i mod 4=0 then write(out, sp, 1);
if i mod 12 =0 then write(out, sp, 1);
write(out, <<d>, s shift (i-23) extract 1);
end;
if tm then write(out, <: tapemark:>);
if s
shift (-22) extract 1=1 then write(out, <:parity error:>);
if s
shift (-17) extract 1=1 then write(out, <: load point:>);
end;
end print;
if s shift (-22) extract 1 = 1 then pt:=pt+1;
if pt>pa then
begin
write(out, nl, 1, <:parity errors exceeded:>, nl, 1);
endsearch:=true;
end;
if pt=1 and s shift (-22) extract 1=1 then
write(out, nl, 1, <:first parity error:>, nl, 1);
if pt=5 and it=4 then pe54:=endsearch:=true;
if s shift(-21)extract 1=1
or s shift (-18) extract 1=1
or s shift (-14) extract 1=1
or s shift (-6) extract 1=1
or s shift (-3) extract 1=1
then
begin
endsearch:=true;
if s shift (-14) extract 1=1 then
begin
if it>-1 then
write(out, nl, 1, <:mode error nrz-pe:>, nl, 1)
else endsearch:=false;
end;
if s shift (-21) extract 1=1 then
write(out, nl, 1,
_ <:timer, ie blank or wrong density tape found:>, nl, 1);
if s shift (-18) extract 1=1 then
write(out,
nl, 1, <:end document, i. e. physical end of tape:>, nl, 1);
if s shift (-6) extract 1=1 then
write(out, nl, 1, <:unintelligible:>, nl, 1);
if s shift (-3) extract 1=1 then
write(out, nl, 1, <:position error:>, nl, 1);
end status 0306141821;
if file>sf+pf-1
or (file=sf+pf-1 and ib>sb+pb-1)
then
begin
if ib=sb+pb then
write(out, nl, 1, <:last requested block printed:>, nl, 1);
if file=sf+pf then
write(out, nl, 1, <:last requested file printed:>, nl, 1);
endsearch:=true;
end;
\f
comment tapescantx * page 4 26 03 80, 14.12
0 1 2 3 4 5 6 7 8 9 ;
if tmold and tm then
begin
write(out, nl, 1, <:zero length file found:>, nl, 1);
if pa mod 3 =0 then
begin
endsearch:=true;
write(out, <: end of tape data assumed:>);
end;
end;
oldfile:=file;
sold:=s;
blold:=bl;
tmold:=tm;
if bl>blmax then blmax:=bl;
if ib=-1 or bbi then blmax:=0;
if endsearch then
begin
write(out, nl, 2, <<-dddd>, round f,
<: feet total at the end of search:>, nl, 1,
<<-d>, <:at file no.:>, file, <: and block no.:>, ib,
<: with block length:>, bl, <: 12 bit bytes:>,
nl, 1, <:total no. of blocks with start at zero was:>,
it, nl, 2);
if -, test then
begin
write(out,
<:status listed above is sedecimal (hexadecimal):>, nl, 1);
write(out, <:last binary status::>, sp, 4);
for i:=0 step 1 until 23 do
begin
if i mod 4 =0 then write(out, sp, 1);
if i mod 12 =0 then write(out, sp, 1);
write(out, <<d>, s shift (i-23) extract 1);
end loop;
write(out, nl, 2);
end nottest;
if pt>0 then
write(out, nl, 2, pt, <: parity error(s) found:>, nl, 2);
end endsearch;
it:=it+1;
if alarm then system(9, 0*write(out, nl, 1,
<:perhaps operator error pe-nrz<10>assumed mode is :>,
if nrz then <:nrz:> else <:pe:>, nl, 1), <::>);
end printb;
integer procedure findparamno(i); integer i;
begin
own integer k;
if k=0 then
begin integer s, p, f, b, e;
s:=115; p:=112; f:=102; b:=98; e:=101;
ia(1):=s*256+f; ia(2):=p*256+f;
ia(3):=s*256+b; ia(4):=p*256+b;
ia(5):=s*256+e; ia(6):=p*256+e;
end assign;
findparamno:=7;
for k:=1 step 1 until 6 do
if ia(k)=i then findparamno:=k;
end findparamno;
procedure stop;
begin
write(out,
nl, 1, <:error at tapescan parameter no.:>, iparam, nl, 1);
system(9, 0, <:<10>system9:>);
end;
\f
comment tapescantx * page 5 26 03 80, 14.12
0 1 2 3 4 5 6 7 8 9 ;
for i:=1, 3, 5 do param(i):=0;
param(2):=1000; param(4):=5; param(6):=2;
iparam:=1;
if readparam(name)<>2 then stop;
j:=readparam(a);
iparam:=iparam+1;
t2:=t3:=-1;
if j<>3 then stop;
fl:=a(1);
j:= readparam(a);
iparam:=iparam+1;
if j<>3 and j<>2 and j<>0 then stop;
if j=3 then pa:=t2:=a(1) else t2:=-1;
if j=3 then
begin j:=readparam(a); iparam:=iparam+1; end;
if j=3 then bi:=t3:=a(1) else t3:=-1;
if j<>3 and j<>0 and j<>2 then stop;
if j=3 then
begin j:=readparam(a); iparam:=iparam+1; end;
if j<>2 and j<>0 then stop;
first:=true;
if a(1)=real <:test:> then test:=true else test:=false;
if test then
begin
readparam(b);
if b(1)=real <:yes:> then test:=true else test:=false;
j:=readparam(a);
iparam:=iparam+2;
if j<>2 and j<>0 then stop;
param(4):=2;
end;
for j:=j while j<>0 do
begin
if -, first then
begin
j:=readparam(a);
iparam:=iparam+1;
end
else first:=false;
k:=readparam(b);
if j<>2 and j<>0 then stop;
iparam:=iparam+1;
if k<>3 and j<>0 and k<>0 then stop; comment not.<integer>;
n:=findparamno(a(1)shift(-32)extract 16);
iparam:=iparam -1;
if n=7 and j<>0 then stop; comment illegal letters;
iparam:=iparam+1;
if n<7 and j<>0 then param(n):=b(1);
end findparams;
if test then
begin
if t2=-1 then pa:=301;
if t3=-1 then bi:=200;
param(5):=param(6):=0;
end
else
begin
if t2=-1 then pa:=300;
if t3=-1 then bi:=200
end;
if round fl mod 2 = 0 then ebcp:=true else ebcp:=false;
\f
comment tapescantx * page 6 26 03 80, 14.12
0 1 2 3 4 5 6 7 8 9 ;
sf:=param(1); pf:=param(2);
sb:=param(3); pb:=param(4);
se:=param(5); pe:=param(6);
i:=1;
begin
if ebcp then write(out, nl, 1,
<:every change of block length printed:>, nl, 1);
write(out, nl, 1, <:tapescan parameters:>);
write(out, sp, 1, string name(increase(i)));
write(out, <:, feet limit=:>, <<ddddd>, fl);
write(out, <:, parity errors allowed:>, <<dddd>, pa, nl, 1);
write(out, <: block interval=:>, <<dddd>, bi);
write(out, <: skipfiles=:>, <<dddddd>, sf);
write(out, <:, printfiles=:>, <<dddddd>, pf);
write(out, nl, 1, sp, 30, <:skipblocks=:>, <<ddddd>, sb);
write(out, <:, printblocks=:>, <<ddddd>, pb);
write(out, nl, 1, sp, 30, <:skipelements=:>, <<ddd>, se);
write(out, <:, printelements=:>, <<ddd>, pe);
write(out, nl, 3);
write(out, <:total file block:>);
write(out, nl, 1, <: no. no. length:>);
write(out, nl, 1, <: of block:>);
write(out, nl, 1, <:blocks number status:>);
if pe<>0 then
begin
write(out, sp, 4, <:sedecimal (hexadecimal) dump:>);
write(out, sp, 3, <:iso dump:>, nl, 1);
end else write(out, sp, 10, <:binary status:>, nl, 1);
end heading;
i:=1;
alarm:=pe54:=nrz:=endsearch:=false;
open(z, 18, string name(increase(i)), -1);
setposition(z, 0, 0);
it:=blold:=-1; sold:=0;
oldfile:=-1; f:=0; pt:=0;
tm:=tmold:=false;
for rest:=inrec6(z, 0) while -, endsearch do
inrec6(z, rest);
close(z, true);
if pe54 then
write(out, nl, 1, <:first 5 blocks all with parity errors:>,
nl, 1, <:possibly :>, if nrz then <:1600:> else <:800:>,
_ <: named by operator with tapestation:>,
_ if nrz then <:botton=800 ( lights off):>
_ else <:botton=1600 (light on):>, nl, 1)
else
begin
if -, nrz then write(out, nl, 1,
_ <:this magtape is pe, i. e. phase encoded 1600 bpi:>
_ , nl, 1)
else
write(out, nl, 1,
_ <:this magtape is nrz, i. e. 800 bpi:>, nl, 1);
end;
end case 11, tapescan;
▶EOF◀