DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦f434eefb3⟧ TextFile

    Length: 21504 (0x5400)
    Types: TextFile
    Names: »twritestd«

Derivation

└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦162d2eb5b⟧ »talgprog« 
            └─⟦this⟧ 

TextFile

;ali time 3 0
mode list.yes
lookup stdlist
if ok.yes
mode listing.yes
writestdent=set 1
global writestdent
writestdent=algol
writestdent
1980-10-06
external integer procedure writestdent(t,options);
integer array t; boolean array options;
begin
comment copyright Anders Lindgård, october 1978,1980;
integer array ct,st(-6:10),t32,t33(1:10);
boolean field bval;
integer field ival,time1,time2;
real field rval;
long field lval;
long field ctype,type;
integer i,j,k,l,entrytype,rsentry,content,lastp,lastabs,
  noofext,noinit,startext,address,segmkind,exsegm,exaux,
  ext,char,extc,desc,descmode,pda,spda,lines,segm0,maxRS,
  cursegm,lastsegm,acontent;
boolean f,segmf,details,test,var,externals,
  abswords,points,survey,printsegm,
  version,printnoofext,printprocess;
integer array field segm;
array field nf;
array lname,auxname,sname,name(1:2);

boolean procedure printtranslated(name,size);
value size; integer size;
array name;
begin
boolean w;
integer i,j,p,res,word,relsegm,reladdr;
integer array field rec;

rec:=0;
printtranslated:=false;
res:=connectcuri(name);
if res>0 or size<8 then
begin
  unstackcuri;
end
else
begin
setposition(in,0,0);
inrec6(in,512);
if in.rec(1)=4 then
begin
  comment algol or fortran;
  w:=false;
  i:=49;
  for i:=i+1 while -,w and i<=100 do
  begin
    j:=in.rec(i);
    if j=0 then
    begin
      w:=in.rec(i+1)=-8388608 and in.rec(i+2)=511;
      p:=i+3;
    end j=0;
   end loop;
  if w then
  begin
    printtranslated:=true;
    word:=in.rec(p);
    write(out,"nl",1,if word=0 then <:FORTRAN:> else <:ALGOL:>);
    j:=0;
    write(out,"sp",2,<:program :>,string name(increase(j)));
    if word=0 then word:=in.rec(p+6);
    relsegm:=word shift (-12) extract 12;
    reladdr:=word extract 12;
    if relsegm<6 or relsegm>size or reladdr<4 or reladdr>510 then
      write(out,"nl",1,"*",2,<:date not found:>) else
    begin
      setposition(in,0,relsegm);
      inrec6(in,512);
      p:=reladdr//2;
      write(out,"nl",1,<:translated:>,<<  dd dd dd>,in.rec(p-1),in.rec(p),"nl",1);
    end date;
  end w;
end 4;
end connect;
end printtranslated;

procedure writename(txt,name);
string txt; array name;
begin
integer i,j,char;
boolean bad;
integer array ch(1:12);
for i:=1,2 do
for j:=1 step 1 until 6 do 
  ch((i-1)*6+j):=name(i) shift ((j-6)*8) extract 8;
bad:=false;
for i:=1 step 1 until 12 do begin
  bad:=bad or (ch(i)<32 and ch(i)>0) or
  ch(i)>127;
  end;
bad:=bad or ch(1)<64;
if bad then write(out,<:<10>:>,txt,<: nonsense:>) else
  begin
  write(out,<:<10>:>,txt,<:  :>);
  for i:=1,i+1 while i<12 and ch(i)>0 do write(out,
    false add ch(i),1);
  end;
end writename;

procedure writeRS(no);
value no; integer no;
if no>0 and no<maxRS then
  write(out,<: :>,case no of (
  <:** real:>,<:**integer:>,<:reserve in stack:>,
  <:take expression:>,<:goto point:>,<:end register expression:>,
  <:end UV expression:>,<:end address expression:>,<:init zones:>,
  <:release zones:>,<:goto computed:>,<:UV:>,
  <:last used:>,<:last of program:>,<:first of program:>,
  <:segment table base:>,<:index alarm:>,<:zone alarm:>,
  <:case alarm:>,<:syntax stop:>,<:general alarm:>,
  <:underflows:>,<:youngest zone:>,<:blocksread:>,
  <:mult alarm:>,<:in:>,<:out:>,
  <:reserve array:>,<:param alarm:>,<:saved stack ref, saved w3:>,
  <:end program conditions:>,<:stderror:>,<:check:>,
  <:inblock:>,<:outblock:>,<:parent message:>,
  <:overflows:>,<:console:>,<:trap base:>,
  <:program name:>,<:parent process:>,<:victim:>,
  <:long round:>,<:long mod:>,<:stop fortran:>,
  <:long to real:>,<:cut real:>,<:take expression fortran:>,
  <:dr1:>,<:dr2:>,<:UV0:>,
  <:label alarm:>,<:go to point fortran:>,<:field alarm:>,
  <:long multiply:>,<:long divide:>,<:RC8000:>,
  <:errorbits:>,<:cattail for lookup:>,<:last of segm table:>,
  <:(CSR,CZA):>,<:no of program segments:>,<:no of owns:>,
  <:name of virtual file:>,<:load words from virtual store:>,<:store words from virtual store:>,
  <:check save:>,<:name of program:>,<:alarmcause:>,
  <:trapmode:>,<:progmode:>,<:blocksout:>,
  <:first of segments:>,
  <:max last used:>,<:limit last used:>,<:temp last used:>,
  <:current activity:>,<:no of activities:>,<:base activity table:>,
  <:aref=sref activity block:>,<:abs address(top program):>,
  <:(sref,segtable) return activate/init act:>,
  <:rel return return activate/init  act:>,
  <:entry check passivate:>,<:current activity no:>,
  <:current stack bottom:>,<:temp stack bottom:>,
  <:call passivate2:>,<:disable activity:>,
  <:enable activity:>,<:trapchain:>,
  <:alarm record:>,<:end action:>,
  <:continue:>,<:exit:>,<:dummy boolean in repeat:>,
  <:dummy integer in while:>,<:dummy zone (context):>,<:init context:>,
  <:RS own bytes:>,<:RS entries:>,<:RS segments:>,<:message address:>,
  <:own base:>,
  <:  :>));

boolean procedure writetype(entrytype,name);
value entrytype; integer entrytype;
array name;
begin
boolean var;
integer i,j,k,l;
var:=entrytype>7;
i:=k:=1;
char:=char+( if entrytype<1 then 
  write(out,<:**type :>,entrytype,<:  :>) else
  if entrytype>=32 then write(out,<:FORTRAN :>,case entrytype-32+1 of (
    <:32:>,<:SUBROUTINE :>,<:LOGICAL FUNCTION :>,
    <:INTEGER FUNCTION :>,<:FUNCTION :>,<:LONG FUNCTION :>,
    <:COMPLEX FUNCTION :>,<:DOUBLE PRECISION FUNCTION :>)) else
  if entrytype>14 then
  write(out,<:FORTRAN type :>,entrytype,<: :>) else
  write(out,case if var then entrytype-6 else entrytype of
  (<::>,<:boolean:>,<:integer:>,<:real:>,<:long:>,<:long real:>,
   <:complex:>,<:zone:>),if entrytype<>1 then <: :> else <::>,
   if var then <::> else <:procedure :>));
char:=char+write(out,string name(increase(i)));
writetype:=-,var;
end;

procedure writepar(par);
value par; long par;
begin
integer j,k,l;
par:=par shift 6 shift (-6);
if par<>0 then char:=char+write(out,<:(:>);
for j:=0,-6,-12,-18,-24,-30,-36 do begin
k:=par shift j extract 6;
if k>0 then begin
char:=char+write(out,if k<11 then <::> else
      if k<18 then <:value :> else
      if k<24 then <:address :> else
      if k=38 then <:switch :> else 
      if k=39 then <:general :> else
      if k=40 then <:general address:> else
      if k=41 then <:undef:> else <::>);
if k<38 then begin
l:=(if k<11 then k else
      if k<18 then k-10 else
      if k<24 then k-16 else
      if k<31 then k-22 else
      k-30);
char:=char+write(out,case l of(<::>,<:boolean:>,<:integer:>,
  <:real:>,<:long:>,<:long real:>,<:complex:>,
  <:zone:>,<:string:>,<:label:>));
if k>23 and k<31 then char:=char+write(out,
  if k>23 then <: :> else <::>,<:array:>);
if k>30 then char:=char+write(out,
  if k>31 then <: :> else <::>,<:procedure:>);
end;
if j>-36 then begin
  char:=char+write(out,<:,:>);
if char>50 then begin
  char:=write(out,<:<10>      :>);
  lines:=lines+1;
  end;
  end;
end k>0;
end for;
if par<>0 then write(out,<:);:>);
end;

cleararray(name);
test:=false;
points:=segmf:=f:=false;
maxRS:=93+12;
ctype:=type:=16;
nf:=-8; for i:=1,2 do name(i):=t.nf(i);
details:=options(1);
survey:=options(2);
test:=options(3);
externals:=options(4);
abswords:=options(6);
points:=options(7);
printsegm:=options(8);
printnoofext:=options(10);
printprocess:=options(11);
details:=details or test;
if details then survey:=points:=abswords:=externals:=true;
printsegm:=printsegm or survey;
printnoofext:=printnoofext or survey;
printprocess:=printprocess or survey ;
nf:=2;
lastsegm:=if t(1)<0 then 0 else t(1);
desc:=if t(1)>0 then 4 else t(1) extract 12;
descmode:=if t(1)>0 then 0 else t(1) shift (-12) extract 11;
content:=t(9) shift (-12);
entrytype:=t(7) shift (-18);
rsentry:=if entrytype>7 then t(7) extract 17 else 0;
write(out,<:<10>:>);
lines:=1;
if t(1)<=0 and t(2)<>0 and rsentry=0 then begin
  for i:=1,2 do sname(i):=t.nf(i);
  i:=headandtail(sname,st);
  if i=0 and st(1)>0 then lastsegm:=st(1);
  spda:=description(sname);
  j:=1;
  if i<>0 and spda=0 then begin lines:=lines+1;
    write(out,<:**auxillary name not found :>,
   string sname(increase(j)),<:<10>:>)  end else 
  if content=4 or content>32  then segmf:=true;
  end else if t(1)<=0 then
  segmf:=rsentry=0 else begin
  segmf:=true;
  for i:=1,2 do sname(i):=name(i);
  for i:=-6 step 1 until 10 do st(i):=t(i);
  end;
if  content<>4 and content<=32 then begin
comment file or filedescriptor;
  pda:=description(name);
  i:=1;
  if t(1)<=0 and content<>2 then write(out,<:filedescriptor :>);
  if content=2 or content=3 then 
  begin
   if content=3 or -,printtranslated(sname,t(1)) then write(out,<:program :>);
  end  else
  write(out,case content+1 of (<:text file:>,<:not used (reserved):>,
      <::>,<::>,<::>,
      <:stacked zone:>,<:program with logical blocks:>,
      <:dumped store area:>,<:program self contained:>,
      <:virtual store ALGOL:>,<:contract file:>,
      <:COBOL object program:>,<:undefined 12.:>,<:COBOL data file:>,
      <:undefined 14.:>,<:RC8000 paging system:>,
      <:undefined 16.:>,<:GIER simulator:>,
      <:undefined 18.:>,<:undefined 19.:>,
      <:bs-system file:>,<:sq-system file:>,
      <:isq-system file:>,<:system 80 file:>,
      <:undefined 24.:>,<:undefined 25.:>,
      <:undefined 26.:>,<:undefined 27.:>,
      <:undefined 28.:>,<:undefined 29.:>,
      <:free 30.:>,<:free 31.:>));
  write(out,"sp",1,string name(increase(i)));
  if pda>0 and printprocess then write(out,<: ; process :>,pda);
  if content=3 or content=6 then begin
    lines:=lines+1;
    write(out,<:<10>entry :>,t(9) extract 12, 
    <:, bytes to load :>,t(10)) end;
   if t(1)<=0 then begin
   lines:=lines+1;
   if content=2 and t(1)<0 then write(out,<:<10>entry in :>) else
   if content=2 and t(1)=0 then write(out,<:<10>doc :>) else
   if desc>20 then write(out,<:<10>:>,desc) else
   write(out,<:<10>:>,case desc//2+1 of(<:ip:>,<:2:>,<:bs:>,<:6:>,
    <:tw:>,<:tr:>,<:tp:>,<:lp:>,<:cr:>,<:mt:>,<:pl:>));
   if desc=16 then write(out,
     case descmode//2+1 of(
     <:b:>,<:d:>,<:h:>,<:.6:>,<:.8:>,<:c:>,<:.12:>,<:.14:>))  else
   if descmode>8 then write(out,<:.:>,<<d>,descmode) else
   if desc=18 or (desc>8 and desc<14) then begin
     if descmode<12 then write(out,
      case descmode//2+1 of(<:o:>,<:e:>,<:n:>,<:f:>,<:t:>)) else
    write(out,<:.:>,<<d>,descmode);
  end;
   j:=1;
   if t(2)>0 then begin
    write(out,<: :>,string sname(increase(j)));
    if spda<>0 and printprocess then write(out,<: ; process :>,spda);
    if pda=0  and lookupentry(sname)>0 then
       write(out,<: ; does not exist :>);
    if content<>2 then begin
    lines:=lines+2;
    write(out,<:<10>file  :>,t(7),
    <:<10>block :>,t(8));
    end;
    end;
   end;
   end else
if content=4 or content>=32 then begin
comment algol procedure or variable;
segm0:=if content=4 then 0 else content-32;
var:=entrytype>7 and entrytype<15;
char:=1;
writetype(entrytype,name);
if var then begin
comment variable;
  write(out,"sp",10,<<-dddddddd>,t(-5),<:::>,
        <<d>,t(-4),<: key=:>,t(-6) extract (3));
  for i:=1,2 do auxname(i):=t.nf(i);
  lookuptail(auxname,t32);
  j:=i:=1;
  lines:=lines+1;
  write(out,<:<10>entry :>);
  if rsentry=0 then write(out,<:in :>,
  string t.nf(increase(i)),<: on :>,
  string t32.nf(increase(j)),<: byte :>,t(6)) else
  if rsentry<maxRS and rsentry>0 then
  write(out,rsentry,<: in running system :>);
end else begin
comment procedure;
writepar(t.type);
write(out,"sp",3,<<-dddddddd>,t(-5),<:::>,<<d>,t(-4),
       <: key=:>,t(-6)extract 3);
if t(2)<>0 then begin
 lines:=lines+1;
 for i:=1,2 do auxname(i):=t.nf(i);
 j:=lookuptail(auxname,t32);
 i:=1;
 acontent:= if j=0 and t32(1)<0 then t32(9) shift (-12) extract 12 else 0;
 if j>0 or (j=0 and t32(1)<0) then
 write(out,if t(1)>=0 then <:<10>doc :> else
     <:<10>entry in :>,string t.nf(increase(i)));
 if acontent>0 then segm0:=acontent-32;
 if content>=32 or (j=0 and acontent>=32) then 
 begin
  if j=0 and t32(1)<0 then
  begin
   for i:=1,2 do auxname(i):=t32.nf(i);
   j:=lookuptail(auxname,t32);
  end;
  lastsegm:=0;
  i:=1;
  if j>0 then write(out,"*",3,<:main entry :>,
    string auxname(increase(i)),<: not present:>) else
  begin
  for i:=1,2 do sname(i):=auxname(i);
  lastsegm:=t32(1);
  j:=i:=1;
  write(out,"nl",1,if acontent>0 then <:main entry :> else
       <:entry in :>,string auxname(increase(i)),
    "sp",1,<:, :>,<<d>,t32(1),<: segments on :>,string t32.nf(increase(j)));
  end;
 end;
 end;
if t(1)>0 and printsegm then begin
 lines:=lines+1;
 write(out,<:<10>segments :>,t(1)); end;
if  survey and t(1)>0 and t(1)<>t(10) shift (-12) then begin
   lines:=lines+1;
   write(out,<:<10>segments used for code :>,t(10) shift (-12));
   end;
if  survey and t(10) extract 12>0 then begin
  lines:=lines+1;
  write(out,<:<10>total own bytes :>,
   t(10) extract 12);
  end;
  if survey then begin lines:=lines+1;
  write(out,<:<10>entry segment :>,<<d>,
    t(6) shift (-12) extract 11,<:+:>,segm0,<: relative :>,t(6) extract 12);
  end;
end;
if segmf and lastsegm>0 then
begin
  comment search on segment;
  i:=connectcuri(sname);
  j:=1;
  if i<>0 then alarm(<:***connect segment :>,
    string sname(increase(j)));
  setposition(in,0,segm0);
  if test then write(out,"nl",1,"*",1,<:segment 0 :>,segm0);
  inrec(in,128);
  cursegm:=segm0+1;
  segm:=0;
  lastp:=in.segm(1) shift (-12);
  lastabs:=in.segm(1) extract 12;
  startext:=(if var then st(9) else t(9)) extract 12;
  if startext>500 then write(out,"nl",1,"*",2,<:procedure inconsistent:>)
  else
  begin
  if details then begin lines:=lines+2;
    write(out,<:<10>last point, last abs :>,lastp,lastabs);
    if startext=0 then write(out,"nl",1,<:no externals:>) else
         write(out,<:<10>start external :>,startext);
    end;
  noofext:=if startext=0 then 0 else in.segm(startext//2+1);
  if startext=500 and cursegm<lastsegm then begin
    inrec(in,128);
    startext:=in.segm(startext//2+2) extract 12;
    startext:=startext-2;
    cursegm:=cursegm+1;
    end;
  if startext>=500 then write(out,"nl",1,"*",2,<:procedure inconsistent:>)
  else 
  begin
  exaux:=noofext shift (-12);
  noofext:=noofext extract 12;
  noinit:=in.segm(startext//2+2) extract 12;
  if noinit> 1 shift 12 -1 then begin
    end;
   if survey and startext>0 then begin lines:=lines+2;
    write(out,<:<10>no. of externals :>,noofext,
   <:<10>own bytes to initialize :>,noinit);
   end;
  if var and entrytype<12 then begin
    address:=t(6)+startext+4;
    i:=1;
    write(out,<:  = :>);
    if t(6)>noinit then write(out,0) else
    case entrytype-7 of begin
      begin comment boolean;
      ival:=bval:=address;
      write(out,if in.bval then <:true:> else <:false:>);
      if -,in.bval and in.ival extract 12 >0 then
         write(out,<: add :>,in.ival extract 12);
      end;
      begin
      comment integer;
      ival:=address;
      write(out,in.ival);
      end;
      begin
      comment real;
      rval:=address;
      write(out,<< d.ddd ddd ddd>,in.rval);
      end;
      begin
      comment long;
      lval:=address;
      write(out,in.lval);
      end;
   end;
  end write out variable value;
    if abswords then begin
      lines:=lines+1;
      write(out,<:<10>abs words::>);
    for j:=2 step 1 until lastabs//2+1 do
     begin
     i:=in.segm(j) shift (-12);
     k:=in.segm(j) extract 12;
     lines:=lines+1;
     write(out,<:<10>:>);
     if i=0 then write(out,<: own byte :>,k) else
     if i>noofext and i<2048 then
       begin
       write(out,<: RS-entry:>,<< dd>,i-noofext);
       writeRS(i-noofext);
       end else
     if i<=noofext then 
       write(out,<: ext segment :>,i,<: chain :>,k) else
     if i>=2048 then write(out,<: own segment :>,i extract 11);
     end;
   end;
   if points and lastabs<lastp then begin
    lines:=lines+1;
    write(out,<:<10>points::>);
    for i:=lastabs//2+2 step 1 until lastp//2+1 do
      begin
      j:=in.segm(i);
      if j<>0 and j<>1 shift 23 then
      begin
      lines:=lines+1;
      write(out,<:<10>:>,if j>0 then <:external no :> 
        else <:rel segm :>,
         j shift (-12) extract 11);
      j:=j extract 12;
      if j>0 then write(out,<: relative :>,j);
      end;
      end;
    end;
    nf:=startext+noinit+4+exaux*2-12;
    type:=nf+12;
    exsegm:=segm0;
    for ext:=1 step 1 until noofext do begin
    nf:=nf+12;
    if nf>=512-10-12 then begin
     extc:=512-10-nf;
     address:=in.segm(256-4) extract 12;;
     exsegm:=exsegm+1;
     if extc>0 then lname(1):=in.nf(1);
     if extc>4 then lname(2):=in.nf(2);
     if extc>8 then k:=in.segm(256-5);
     if test then write(out,<:<10>next address:>,address,
      "nl",1,<:next segment external :>,exsegm);
     setposition(in,0,exsegm);
     inrec(in,128);
     nf:=address-extc;
     if extc>0 then in.nf(1):=lname(1);
     if extc>4 then in.nf(2):=lname(2);
     if extc>8 then in.segm(nf//2+5):=k;
     end;
    type:=nf+12;
    address:=firstaddr(in)+nf-2;
    i:=headandtail(address,ct);
    j:=1;
  version:=false;
  if (i<>0 or ct.ctype<>in.type)  then begin
    lines:=lines+1;
    version:= in.nf(1)=real <:*vers:> add 105 and
             in.nf(2)=real <:on:>;
    if version then
    begin
     i:=1;
     write(out,"nl",1,string in.nf(increase(i)),
              in.type shift (-24) extract 24);
    end else
    write(out,<:<10>**external error :>,
     string in.nf(increase(j)),<: :>,<<b>,i,"sp",2,in.type);
     if i=0 and -,version then begin
       write(out,<:  declared :>); 
       if writetype(round(ct.ctype shift (-42)),in.nf) then
        writepar(ct.ctype);
       end;
     end;
  if externals and -,version then begin
    lines:=lines+1;
    char:=write(out,<:<10>external:>,<< dd>,ext,<: = :>);
    if writetype(round(in.type shift (-42)),in.nf) then
        writepar(in.type);
    end;
  end;
  comment time1:=startext+noinit+noofext*12+6+exaux*2;
  time1:=type+2;
  exsegm:=time1//512;
  if exsegm>0 then begin
   if test then write(out,"nl",1,"*",1,<:translated segment :>,exsegm);
   setposition(in,0,exsegm);
   inrec(in,128);
   time1:=time1 mod 512;
   end;
  time2:=time1+2;
  lines:=lines+1;
  write(out,<:<10>translated :>,<<  dd dd dd>,in.time1,in.time2);
  if printsegm then begin
  nf:=512-8;
  segmkind:=in.segm(256) extract 2;
  i:=1;
 lines:=lines+1;
  if segmkind=1 and entrytype>=32 then segmkind:=4;
  if segmkind=0 then writename(<:alarm address:>,in.nf) else
     write(out,<:<10>:>,case segmkind of (
       <:external algol coded procedure:>,
     <:main algol segment:>,<:running system segment:>,
     <:external FORTRAN SUBROUTNE or FUNCTION:>));
  end;
   end;
   end;
  unstackcuri;
  end;
end algol variable or procedure;
writestdent:=lines;
if test then write(out,<:<10>lines :>,lines);
end;
end;

lookup stdlist
if ok.yes
mode list.yes

writestd=set 20
global writestd
writestd=algol connect.no
writestd
1980-10-01
begin
comment copyright Anders Lindgård, february 1977;
integer i,j,k,l,m,pda,noofdesc;
boolean f,iarea;
integer array t(-6:10),tail(1:10);
boolean array options(1:20);
array inp,outp,name(1:3);

cleararray(name);
cleararray(options);
f:=false;
noofdesc:=1;
initfp;
connectlso;
  f:=readsfp(<:name:>,name,<::>)or readinfp(name,1);
for i:=8 step 1 until 20 do options(i):=true;
options(3):=false;
iarea:=readsfp(<:input:>,inp,<::>);
if iarea then
begin
  i:=lookuptail(inp,tail);
  m:=1;
  if i<>0 then alarm(<:***input area :>,string inp(increase(m)),<: unknown:>);
  for i:=8 step 1 until 20 do options(i):=false;
  f:=true;
  noofdesc:=tail(10);
  end;
if fpbooleans>0 then begin
  readbfp(<:details:>,options(1),-,iarea);
  readbfp(<:survey:>,options(2),-,iarea);
  readbfp(<:test:>,options(3),false);
  readbfp(<:externals:>,options(4),-,iarea);
  readbfp(<:abswords:>,options(6),-,iarea);
  readbfp(<:points:>,options(7),-,iarea);
  readbfp(<:segments:>,options(8),-,iarea);
  end;
if -,f then reads(<:name:>,name);
if -,iarea then
begin
repeat
  readinfp(name,noofdesc);
  i:=headandtail(name,t);
  j:=1;
  pda:=description(name);
  if pda>0 and i>0 then begin
    write(out,<:<10>:>,string name(increase(j)),
    <: ; process :>,pda);
    end;
  if i<>0 then write(out,"nl",1,<:***:>,string name(increase(j)),
     <: unknown:>,i) else
  writestdent(t,options);
  noofdesc:=noofdesc+1;
until noofdesc>fpinareas;
outendcur(10);
if fpout then closeout;
end else begin
integer array field entry;
zone get(128,1,stderror);
entry:=0;
m:=1;
open(get,4,string inp(increase(m)),0);
setposition(get,0,0);
for i:=1 step 1 until noofdesc do begin
  inrec6(get,64);
  for i:=1 step 1 until 17 do t(i-7):=get.entry(i);
  write(out,<:<10>:>);
  writestdent(t,options);
  end;
close(get,true);
end;
outendcur(10);
end;
if warning.yes
(mode list.no
end)
mode list.no
lookup stdtest
if ok.no
end
mode list.yes
writestd name.plotform
writestd name.fp
writestd name.out
writestd name.underflows
writestd name.outchar
writestd name.e
writestd name.o
writestd name.lookup
writestd name.tpf
writestd name.p
writestd name.printer
writestd name.write survey.yes
writestd name.plottext details.yes
writestd name.writeplot details.yes
writestd name.cleararea test.yes
writestd name.tpt
writestd name.aimag
writestd name.sin test.yes
writestd name.externaladp test.yes
mode list.no
▶EOF◀