DataMuseum.dk

top - metrics - download

    Length: 7680 (0x1e00)
    Types: TextFile
    Names: »wrindextxt«

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦720b7e52e⟧ »calprog« 
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦720b7e52e⟧ »calprog« 
            └─⟦this⟧ 

TextFile

;rc4000 5 time.180
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,entries,catkey,content,seg,maxkey,ck,
    page,lines;
boolean init,describe,manual,test;
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;
real array output,descat,sname(1:3);
zone cat(128,1,stderror);

procedure findnameanddes(name,f,print);
value print; boolean print;
array f,name;
begin
integer dnr,type,page;
array field namepart;
integer field nf1,nf2,n,ns;
integer di;
boolean search;
n:=2;
nf1:=0;
nf2:=(entries-1)*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
    search:=true;
    n:=n+2;
    di:=di+2;
    end else search:=nf1+12<nf2;
  end;
if di=10 then begin
  n:=nf1+10; dnr:=f.n;
  type:=dnr extract 12;
  dnr:=dnr shift (-12);
  n:=n+2;
  page:=f.n;
  if test then write(out,<:<10>dnr,type,page :>,dnr,type,page);
  if print then describedin(dnr,type,page);
  end;
end find name and describe;

procedure describedin(dnr,type,page);
value dnr,type,page;
integer dnr,type,page;
if dnr>=0 and dnr<3 then begin
  write(out,<:<10>:>);
  if dnr>0 then write(out,<:described in: :>);
write(out,case dnr+1 of(
    <:not described:>,
    <:algol 6 users manual:>,
    <:fortran manual:>,
    <:external slang coded procedures:>,
    <:plotting manual:>));
  if page>0 then write(out,<:  page.:>,<<d>,page);
  if type>0 then begin lines:=lines+1;
    write(out,<:<10>:>,case type of(
    <:monitor procedure:>,
    <:file handling procedure:>,
    <:numeric:>,
    <:input/output procedure (character):>,
    <:input/output procedure (block):>,
    <:mini- or microcomputer handling procedure:>));
    end;
  lines:=lines+1;
end described in;

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);
    if lines>55 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;
  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;
  test:=false;
  readbfp(<:test:>,test);
  init:=false;
  readbfp(<:init:>,init);
  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 entries>0 then sort(sname,entries,64,ia);
  close(cat,true);


if describe or init then begin
  array f(1:if init or manual then 3*entries else 1);
  if init 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(f);
    cleararray(descat);
    packtext(descat,case content+1 of(
      <:dtextdes:>,<:dpunchdes:>,<:dfpdes:>,<:dsysdes:>,
      <:dalgdes:>));
    i:=lookuptail(descat,tail);
    if i<>0 and manual 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;
         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);
    if init then begin
    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);
    end else if manual then begin
    setposition(cat,0,0);
    for j:=1 step 1 until entries 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);
  end;
  if describe then begin
  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,:=1000*stxb;
  stxe:=1000*stxe+1000;
  stxs:=1000*stxs;
  for extype:=stxb+1000 step stxs until stxe do begin
  nyR:=first:=true; <* bery(R,n1,n2,l1,l2); rydiag(n1,n2,l1,l2); *> end;
  goto ENDP
  end;
  r:=100*R;
  for extype:=extype step 1 until noex do begin
  for scfc:=1 step 1 until scfitr do begin
  connectprim;
  write(out,nl,1,<:iteration  :>,scfc,<:  extype  :>,extype);
  DATO;
  endprim;
  nyR:=first:=true;
<*
  bery(R,n1,n2,l1,l2);
  rydiag(n1,n2,l1,l2);
*>
  extype:=extype+10;
  end iteration;
  extype:=extype mod 10;
end exchange loop;
ENDP:
writestat;
func:=true;
if next then begin
  next:=false;
  inparam;
  goto NEXTJOB;
  end;
if ostack and -,catch then closeout;
removeentry(<:rydwhere:>);
removeentry(peff);
removeentry(ryp);
removeentry(<:r