DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »tproccat«

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦this⟧ »tproccat« 

TextFile

begin
comment this program makes a list of all 
        the procedure heading from a program text.
        ;
integer array table(0:127);
integer searchindex1,
        searchindex2,
        index,
        lastitem;
boolean endoffile,
        typolwanted,
        onlydec,
        found;

long array line(1:132);
integer array kind(1:132);
algol copy.tcgproclib;

procedure writeall(z,line,kind,index);
value index;
integer index;
zone z;
long array line;
integer array kind;
begin
long array field laf;
repeat
  if kind(index) = 6 then
    begin
    laf := index*4-4;
    write(out,line.laf);
    for index := index+1 while kind(index) = 6 do;
    end
   else
  if kind(index) = 7 then
   begin
   outchar(out,line(index) extract 24);
   index := index+1;
   end
  else
 if kind(index) <> 8 then
  begin
  write(out,<:<10>*** kind error :>,line(index),kind(index),index);
  index := index+1;
  end;
until kind(index) = 8;
outchar(out,line(index) extract 24);
end writeall;

procedure nextline;
begin
lastitem := readall(in,line,kind,1);
for searchindex1 :=0,searchindex1+1 while 
   line(searchindex1) = 'sp' and searchindex1 < lastitem do;
if kind(searchindex1) <> 6 then
    searchindex1 := 0
   else
  begin
  for searchindex2 := searchindex1,searchindex2+1 while
     kind(searchindex2) <> 6 and searchindex2 < lastitem do;
  if kind(searchindex2) <> 6 then searchindex2 := searchindex1;
  end;
if line(lastitem) = 'em' then endoffile := true;
end nextline;


comment init of char table.
        makes all non letter char to delimiter char;
isotable(table);
for index := 32 step 1 until 57 do
  table(index) := 7 shift 12 + index;
intable(table);

endoffile := false;
comment init of arguments to program;
if getboolstring(<:typol:>,typolwanted) = 0 then typolwanted:= false;
if getboolstring(<:onlydec:>,onlydec) = 0 then onlydec := false;
if typolwanted then
  write(out,"nl",1,<:*se #*:>,"nl",1);
repeat <* end of file *>
  nextline;
  if searchindex1 <> 0 then
    begin
    if ((line(searchindex1) = long <:proce:> add 'd') and
         line(searchindex1+1) = long <:ure:>) or
      (((line(searchindex2) = long <:proce:> add 'd') and
         line(searchindex2+1) = long <:ure:>) and
         ((line(searchindex1) = long <:integ:> add 'e' and
           line(searchindex1+1) = long <:r:>) or
          (line(searchindex1) = long <:long:>) or
          (line(searchindex1) = long <:real:>) or
          (line(searchindex1) = long <:boole:> add 'a' and
           line(searchindex1+1) = long <:n:>))) then
       begin
       if typolwanted then
         write(out,<:#np#:>,"nl",1);
       found := false;
       repeat <*  until begin or end of file is met *>
         writeall(out,line,kind,1);
         if onlydec then
           begin
           found := true;
           end
          else
         begin
         if typolwanted then
           write(out,<:#nl#:>,"nl",1);
         nextline;
         if searchindex1 <> 0 then
           begin
           if kind(searchindex1) = 6 and
              line(searchindex1) = long <:begin:> then
           found := true;
           end;
         end;
       until endoffile or found;                         
       end;
    end seaarchindex <> 0;
until endoffile;
if typolwanted then
  write(out,<:#ef#:>,"nl",1);
end program procedure catalog;
▶EOF◀