|
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: 16128 (0x3f00)
Types: TextFile
Names: »tmanindex«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦162d2eb5b⟧ »talgprog«
└─⟦this⟧
; ali time 5 0
lookup indexlist
if ok.yes
mode list.yes
clear writeindex
writeindex=set 150
permanent writeindex.2
if list.yes
writeindex=algol list.yes
writeindex=algol
writeindex
14 2 77
begin
boolean array ba(1:12);
integer i,j,k,oldentries,entries,catkey,content,seg,maxkey,ck,
page,lines,res;
boolean init,describe,manual,test,update;
integer array ia(0:3),ot,tail(1:10),t(-6:10);
integer array field entry;
integer field ow8,key,cf,segm;
real array field name,desf;
real array output,descat,newcat,sname(1:3);
zone cat(128,1,stderror);
boolean procedure findnameanddes(name,f,print,entries,fbase);
value print,entries; boolean print;
integer entries,fbase;
array f,name;
begin
integer dnr,type,page;
array field namepart;
integer array field des;
integer field nf1,nf2,n,ns;
integer di;
boolean search;
findnameanddes:=false;
n:=2;
nf1:=-12;
nf2:=(entries)*12;
di:=2;
if test then begin
write(out,<:<10>name to search :>,string inc(name));
end;
search:=true;
for ns:=(nf2+nf1)//24*12+di while search and di<10 do begin
if test then begin
namepart:=ns-di;
write(out,<:<10>next name :>,string inc(f.namepart),
<: :>,nf1,<:<=:>,ns-di,<:<=:>,nf2,<: d :>,di);
end;
if f.ns<name.n then nf1:=ns-di;
if f.ns>name.n then nf2:=ns-di;
if f.ns=name.n then
begin
if ns>12 and name.n<>0 then begin
for nf1:=ns,nf1-12 while f.nf1=name.n and nf1>0 do;
nf1:=nf1-di;
end;
if ns<entries*12-12 and name.n<>0 then begin
for nf2:=ns,nf2+12 while f.nf2=name.n and nf2<entries*12 do;
nf2:=nf2-di;
end;
search:=true;
n:=n+2;
di:=di+2;
end else search:=nf1+12<nf2;
end;
if di=10 then begin
findnameanddes:=true;
des:=fbase:=ns-di;
dnr:=f.des(5);
page:=f.des(6);
type:=dnr extract 12;
dnr:=dnr shift (-12);
if test then write(out,<:<10>dnr,type,page :>,dnr,type,page);
if print then lines:=lines+describedin(dnr,type,page);
end else fbase:=-1;
end find name and describe;
procedure writeelement(inz,desc,wrdesc);
value wrdesc; boolean wrdesc;
zone inz; array desc;
begin
lines:=0;
page:=1;
write(out,<:<12><10>:>,false add 32,60,<:page 1:>);
setposition(inz,0,0);
for i:=1 step 1 until entries do
begin
inrec6(inz,64);
for j:=1 step 1 until 17 do
t(j-7):=inz.entry(j);
write(out,<:<10><10>:>); if inz.segm<0 then inz.segm:=0;
write(out,false add 32,12-write(out,string inc(inz.name)));
if catkey<0 then write(out,<:key =:>,
<< dd>,inz.key extract 12) else
write(out,<: :>);
if inz.segm>0 then write(out,<:, :>,<<dddd>,inz.segm,<: segment:>);
if inz.segm>1 then write(out,<:s:>);
lines:=lines+2+writestdent(t,ba);
if wrdesc then findnameanddes(inz.name,desc,true,entries,0);
if lines>55 and i<entries then begin
lines:=0; page:=page+1;
write(out,<:<12><10>:>,false add 32,60,<:page :>,<<d>,page);
end;
end;
end writeelement;
open(cat,4,<:catalog:>,0);
generaten(sname);
cleararray(tail); tail(1):=300;
createentry(sname,tail);
stackcuri;
i:=connectcuri(sname);
if i<>0 then alarm(<:***workarea :>,string inc(sname),i);
setposition(in,0,0);
for i:=1 step 1 until 12 do
ba(i):=false; name:=6;
entry:=seg:=0; segm:=16; cf:=34; ow8:=32; key:=2;
oldentries:=entries:=0;
fplist:=true;
initfp;
if readlsfp(output) then begin
stackcuro;
i:=connectcuro(output);
if i>0 then begin
unstackcuro;
cleararray(ot);
ot(1):=300;
createentry(output,ot);
i:=permentry(output,2);
i:=connectcuro(output);
if i<>0 then begin
unstackcuro;
alarm(<:***left side :>,string inc(output),<: unknown:>);
end;
end;
end;
test:=false;
readbfp(<:test:>,test);
init:=false;
readbfp(<:init:>,init);
update:=false;
readbfp(<:update:>,update);
init:=init and -,update;
describe:=true;
readbfp(<:describe:>,describe);
content:=4;
readifp(<:content:>,content);
manual:=false or test;
readbfp(<:manual:>,manual);
manual:=manual and content<=4;
describe:=describe or manual;
catkey:=-1;
readifp(<:catkey:>,catkey);
maxkey:=if catkey<0 then 5 else 24;
readifp(<:maxkey:>,maxkey);
ia(0):=6; ia(1):=8; ia(2):=10; ia(3):=12;
for i:=inrec(cat,0) while i<>0 do
begin
inrec6(cat,34);
if cat.ow8 shift (-12)=content and cat.key<>-1 then
begin
ck:=cat.key extract 12;
if ck>0 and ck<=maxkey and (ck=catkey or catkey<0) then
begin
outrec6(in,64);
for j:=1 step 1 until 8 do
in(j):=cat(j); in.cf:=cat.cf;
if cat.segm>0 then seg:=seg+cat.segm;
entries:=entries+1;
end;
end;
end;
setposition(in,0,0);
if test then write(out,<:<10>entries :>,entries);
if entries>0 then sort(sname,entries,64,ia);
close(cat,true);
if init or update or manual then begin
comment a description record is
12 bytes. 0-7 is name of procedure/variable. 8 is
the description number (dnr). 9 is type of procedure/
variable. 10-11 is the page number in the manual if any.;
cleararray(descat);
packtext(descat,case content+1 of(
<:dtextdes:>,<:dpunchdes:>,<:dfpdes:>,<:dsysdes:>,
<:dalgdes:>));
i:=lookuptail(descat,tail);
oldentries:=if init then entries else
if i<>0 then 0 else tail(10);
if test and oldentries>0 then write(out,
<:<10>oldentries :>,oldentries);
if i<>0 and (manual or update) and -,init then begin
alarm(<:***description catalog :>,
string inc(descat),<: unknown:>,i);
end else if i<>0 and init then begin
cleararray(tail);
tail(1):=entries//32+20;
tail(10):=entries;
i:=createentry(descat,tail);
i:=permentry(descat,2);
if i<>0 then alarm(<:***description catalog :>,
string inc(descat),<: cannot be created:>);
cleararea(string inc(descat));
end;
open(cat,4,string inc(descat),0);
setposition(in,0,0);
end init or update or manual;
j:=if entries>oldentries then entries else oldentries;
begin
array f(1:if init or manual or update then 3*j else 1);
cleararray(f);
if init then begin
if init then write(out,<:<10><10>initialize catalog:>);
setposition(cat,0,0);
for j:=1 step 1 until entries do begin
inrec6(in,64); outrec6(cat,12);
for i:=1,2 do cat(i):=f(3*(j-1)+i):=in.name(i);
cat(3):=0.0 shift (-48);
if test then write(out,<:<10>:>,j,<: :>,string inc(cat));
end;
setposition(cat,0,0);
tail(10):=entries;
i:=changeentry(descat,tail);
if i<>0 then alarm(<:***changeentry descat :>,string inc(descat),i);
end initialize else if update then begin
if test then write(out,<:<10><10>update catalog:>);
setposition(cat,0,0);
for j:=1 step 1 until oldentries do begin
inrec6(cat,12);
for i:=1,2,3 do f(3*(j-1)+i):=cat(i);
if test then write(out,<:<10>:>,j,<: :>,string inc(cat));
end;
close(cat,true);
cleararray(newcat);
generaten(newcat);
cleararray(tail);
tail(1):=entries//32+20; tail(10):=entries;
i:=createentry(newcat,tail);
if i<>0 then alarm(<:***update newcat impossible :>,
string inc(newcat),<: segments :>,tail(10),<: res :>,i);
i:=permentry(newcat,2);
if i<>0 then alarm(<:***update newcat impossible :>,
string inc(newcat),<: permanent :>,i);
open(cat,4,string inc(newcat),0);
setposition(cat,0,0);
setposition(in,0,0);
if test then write(out,<:<10><10>write new catalog to bs:>);
for j:=1 step 1 until entries do begin
inrec6(in,64); outrec6(cat,12);
if findnameanddes(in.name,f,test,oldentries,desf) then begin
cat(3):=f.desf(3);
end else cat(3):=0.0 shift (-48);
for i:=1,2 do cat(i):=in.name(i);
end make new newcat;
setposition(cat,0,0);
setposition(in,0,0);
removeentry(descat);
i:=renameentry(newcat,descat);
if i<>0 then alarm(<:***rename updated catalog :>,
string inc(newcat),<: to :>,string inc(descat),
<: impossible :>,i);
close(cat,true);
open(cat,4,string inc(descat),0);
end;
if manual then begin
if test then write(out,<:<10><10>generate list of manuals:>);
setposition(cat,0,0);
for j:=1 step 1 until oldentries do begin
inrec6(cat,12);
for i:=1,2,3 do f(3*(j-1)+i):=cat(i);
if test then write(out,<:<10>:>,j,<: :>,string inc(cat));
end read descat;
setposition(cat,0,0);
end manual;
close(cat,true);
if describe then begin
if test then write(out,<:<10><10>describe cataloged names:>);
if -,test then begin
write(out,<:<12>:>,false add 10,7,
false add 32,29,<:Index:>,false add 32,17);
writedate(out,5,0.0);
write(out,false add 10,7);
if content<5 then write(out,false add 32,20,
<:H. C. Ørsted Institute:>,false add 10,3,false add 32,24,
<:RC4000 software:>,false add 10,4,false add 32,case content+1 of
(25,20,22,25,10),
case content+1 of (<:text files:>,<:punched card files:>,
<:fp-utility programs:>,<:system programs:>,
<:algol 6/fortran procedures and variables:>));;
write(out,false add 10,20);
write(out,<:<10>segments =:>,seg,<:<10>catalog entries =:>,entries);
if catkey<0 then
write(out,<:<10>catalog keys 1 through :>,<<d>,maxkey) else
write(out,<:<10>catalog key = :>,<<d>,catkey);
end;
writeelement(in,f,manual);
end write descriptions;
end describe entries;
unstackcuri;
removeentry(sname);
outend(12);
if fpout then closeout;
end;
lookup indextest
if ok.yes
algind=writeindex key.2
lookup indexlist
if ok.yes
mode list.yes
clear updateindex
updateindex=set 150
permanent updateindex.2
if list.yes
updateindex=algol list.yes
updateindex=algol
updateindex
14 2 77
begin
boolean array ba(1:12);
integer i,j,k,dnr,type,entries,catkey,content,seg,ck,
page,lines,res,char;
boolean describe,test;
integer array ot,tail(1:10),t(-6:10);
integer array field entry;
integer field cf,segm;
real array field name,desf;
real array output,descat,sname(1:3);
boolean procedure findnameanddes(name,f,print,entries,fbase);
value print,entries; boolean print;
integer entries,fbase;
array f,name;
begin
integer dnr,type,page;
array field namepart;
integer array field des;
integer field nf1,nf2,n,ns;
integer di;
boolean search;
findnameanddes:=false;
n:=2;
nf1:=-12;
nf2:=(entries)*12;
di:=2;
if test then begin
write(out,<:<10>name to search :>,string inc(name));
end;
search:=true;
for ns:=(nf2+nf1)//24*12+di while search and di<10 do begin
if test then begin
namepart:=ns-di;
write(out,<:<10>next name :>,string inc(f.namepart),
<: :>,nf1,<:<=:>,ns-di,<:<=:>,nf2,<: d :>,di);
end;
if f.ns<name.n then nf1:=ns-di;
if f.ns>name.n then nf2:=ns-di;
if f.ns=name.n then
begin
if ns>12 and name.n<>0 then begin
for nf1:=ns,nf1-12 while f.nf1=name.n and nf1>0 do;
nf1:=nf1-di;
end;
if ns<entries*12-12 and name.n<>0 then begin
for nf2:=ns,nf2+12 while f.nf2=name.n and nf2<entries*12 do;
nf2:=nf2-di;
end;
search:=true;
n:=n+2;
di:=di+2;
end else search:=nf1+12<nf2;
end;
if di=10 then begin
findnameanddes:=true;
des:=fbase:=ns-di;
dnr:=f.des(5);
page:=f.des(6);
type:=dnr extract 12;
dnr:=dnr shift (-12);
if test then write(out,<:<10>dnr,type,page :>,dnr,type,page);
if print then lines:=lines+describedin(dnr,type,page);
end else fbase:=-1;
end find name and describe;
procedure writeelement(inz,desc,wrdesc);
value wrdesc; boolean wrdesc;
zone inz; array desc;
begin
integer field key;
key:=2;
lines:=0;
setposition(inz,0,0);
for i:=1 step 1 until entries do
begin
inrec6(inz,64);
for j:=1 step 1 until 17 do
t(j-7):=inz.entry(j);
write(out,<:<10><10>:>); if inz.segm<0 then inz.segm:=0;
write(out,false add 32,12-write(out,string inc(inz.name)));
if catkey<0 then write(out,<:key =:>,
<< dd>,inz.key extract 12) else
write(out,<: :>);
if inz.segm>0 then write(out,<:, :>,<<dddd>,inz.segm,<: segment:>);
if inz.segm>1 then write(out,<:s:>);
lines:=lines+2+writestdent(t,ba);
if wrdesc then findnameanddes(inz.name,desc,true,entries,0);
end;
end writeelement;
for i:=1 step 1 until 12 do
ba(i):=false; name:=6;
entry:=seg:=0; segm:=16; cf:=34;
entries:=0;
if readlsfp(output) then begin
stackcuro;
i:=connectcuro(output);
if i>0 then begin
unstackcuro;
cleararray(ot);
ot(1):=300;
createentry(output,ot);
i:=permentry(output,2);
i:=connectcuro(output);
if i<>0 then begin
unstackcuro;
alarm(<:***left side :>,string inc(output),<: unknown:>);
end;
end;
end;
fplist:=true;
initfp;
test:=false;
readbfp(<:test:>,test);
describe:=false;
readbfp(<:describe:>,describe);
describe:=describe or test;
content:=4;
readifp(<:content:>,content);
comment a description record is
12 bytes. 0-7 is name of procedure/variable. 8 is
the description number (dnr). 9 is type of procedure/
variable. 10-11 is the page number in the manual if any.;
cleararray(descat);
packtext(descat,case content+1 of(
<:dtextdes:>,<:dpunchdes:>,<:dfpdes:>,<:dsysdes:>,
<:dalgdes:>));
i:=lookuptail(descat,tail);
entries:=if i<>0 then 0 else tail(10);
if test and entries>0 then write(out,<:<10>entries :>,entries);
if i<>0 then
alarm(<:***description catalog :>,
string inc(descat),<: unknown:>,i);
stackcuri;
i:=connectcuri(descat);
setposition(in,0,0);
begin
array f(1:3*entries);
cleararray(f);
for j:=1 step 1 until entries do begin
inrec6(in,12);
for i:=1,2,3 do f(3*(j-1)+i):=in(i);
end;
setposition(in,0,0);
unstackcuri;
write(out,<:<10>Input name, description-, type-, and page numbers:>);
outend(10);
char:=0;
for char:=char while char<>25 do begin
cleararray(sname);
readstring(in,sname,1); repeatchar(in);
readchar(in,char);
dnr:=type:=page:=0;
if char<>25 and char<>10 then begin
read(in,dnr); repeatchar(in);
readchar(in,char);
if char<>25 and char<>10 then begin
read(in,type); repeatchar(in);
readchar(in,char);
if char<>25 and char<>10 then begin
read(in,page); repeatchar(in);
readchar(in,char);
end;
end;
end read parameters;
if dnr<=0 and type<=0 and page<=0 and char<>25 then begin
write(out,<:<10>:>,string inc(sname),<: not changed:>);
outend(10);
end else if test and char<>25 then begin
write(out,<:<10>new dnr, type, page :>,dnr,type,page);
end;
if char=25 then outend(10) else
if findnameanddes(sname,f,test,entries,entry) then begin
f.entry(5):=dnr shift 12 add type;
f.entry(6):=page;
if test then outend(10);
end else begin
write(out,<:<10>:>,string inc(sname),<: not in catalog:>);
outend(0);
end;
end;
stackcuri;
i:=connectcuri(descat);
if i<>0 then alarm(<:***update :>,string inc(descat));
setposition(in,0,0);
for j:=1 step 1 until entries do begin
outrec6(in,12);
for i:=1,2,3 do in(i):=f(3*(j-1)+i);
end;
setposition(in,0,0);
if describe then begin
setposition(in,0,0);
for j:=1 step 1 until entries do begin
inrec6(in,12);
for i:=1,2,3 do f(3*(j-1)+i):=in(i);
if test then
write(out,<:<10>:>,j,<: :>,string inc(in));
if findnameanddes(in,f,true,entries,entry) then ;
end read descat;
setposition(in,0,0);
end describe;
end array f;
unstackcuri;
outend(12);
if fpout then closeout;
end;
lookup indextest
if ok.yes
▶EOF◀