OS/2 Professional/OS2PRO194.ISO/os2/prgramer/pascal2c/cref.p

Text File | 1992-08-03 | 11.4 KB | 360 lines

$debug$
$ sysprog, partial_eval $

program crefprog(input, output);


const
 {  linesperpage = 139;  }
   maxnamelen = 30;


type
   str255 = string[255];

   occurptr = ^occur;
   occur =
      record
         next : occurptr;
         lnum : integer;
         fnum : integer;
         defn : boolean;
      end;

   kinds = (k_normal, k_proc, k_var, k_const, k_type, k_strlit, k_extproc,
            k_kw, k_prockw, k_varkw, k_constkw, k_typekw, k_beginkw);

   nodeptr = ^node;
   node =
      record
         left, right : nodeptr;
         name : string[maxnamelen];
         first : occurptr;
         kind : kinds;
      end;


var
   f : text;
   fn : string[120];
   fnum : integer;
   buf, name : str255;
   good : boolean;
   i, j : integer;
   lnum : integer;
   np, base : nodeptr;
   op : occurptr;
   curkind, section : kinds;
   paren : integer;
   brace : integer;



procedure lookup(var name : str255; var np : nodeptr);
   var
      npp : ^nodeptr;
   begin
      if strlen(name) > maxnamelen then
         setstrlen(name, maxnamelen);
      npp := addr(base);
      while (npp^ <> nil) and (npp^^.name <> name) do
         begin
            if name < npp^^.name then
               npp := addr(npp^^.left)
            else
               npp := addr(npp^^.right);
         end;
      if (npp^ = nil) then
         begin
            new(np);
            npp^ := np;
            np^.name := name;
            np^.first := nil;
            np^.left := nil;
            np^.right := nil;
            np^.kind := k_normal;
         end
      else
         np := npp^;
   end;


procedure kw(name : str255; kind : kinds);
   var
      np : nodeptr;
   begin
      lookup(name, np);
      np^.kind := kind;
   end;


procedure cref(np : nodeptr; kind : kinds);
   var
      op : occurptr;
   begin
      new(op);
      op^.next := np^.first;
      np^.first := op;
      op^.lnum := lnum;
      op^.fnum := fnum;
      op^.defn := (kind in [k_var, k_type, k_const, k_proc]);
      if op^.defn or (kind = k_strlit) or
         ((kind = k_extproc) and (np^.kind = k_normal)) then
         np^.kind := kind;
   end;



procedure traverse(np : nodeptr);
   var
      op : occurptr;
      i : integer;
   begin
      if (np <> nil) then
         begin
            traverse(np^.left);
            if np^.kind < k_kw then
               begin
                  case np^.kind of
                     k_var:
                        write(f, 'V:');
                     k_type:
                        write(f, 'T:');
                     k_const:
                        write(f, 'C:');
                     k_proc:
                        write(f, 'P:');
                     k_strlit:
                        write(f, 'S:');
                     k_extproc:
                        write(f, 'E:');
                     k_normal:
                        write(f, 'X:');
                  end;
                  write(f, np^.name);
                  i := 0;
                  op := np^.first;
                  while op <> nil do
                     begin
                        if i = 0 then
                           begin
                              writeln(f);
                              write(f, '   ');
                              i := 5;
                           end;
                        write(f, ' ', op^.lnum:1, '/', op^.fnum:1);
                        if op^.defn then
                           write(f, '*');
                        i := i - 1;
                        op := op^.next;
                     end;
                  writeln(f);
               end;
            traverse(np^.right);
         end;
   end;



begin
   base := nil;
   fnum := 0;
   kw('procedure', k_prockw);
   kw('function', k_prockw);
   kw('var', k_varkw);
   kw('record', k_varkw);
   kw('type', k_typekw);
   kw('const', k_constkw);
   kw('begin', k_beginkw);
   kw('end', k_kw);
   kw('do', k_kw);
   kw('for', k_kw);
   kw('to', k_kw);
   kw('while', k_kw);
   kw('repeat', k_kw);
   kw('until', k_kw);
   kw('if', k_kw);
   kw('then', k_kw);
   kw('else', k_kw);
   kw('case', k_kw);
   kw('of', k_kw);
   kw('div', k_kw);
   kw('mod', k_kw);
   kw('nil', k_kw);
   kw('not', k_kw);
   kw('and', k_kw);
   kw('or', k_kw);
   kw('with', k_kw);
   kw('array', k_kw);
   kw('integer', k_kw);
   kw('char', k_kw);
   kw('boolean', k_kw);
   kw('true', k_kw);
   kw('false', k_kw);
   writeln;
   writeln('Pascal Cross Reference Utility');
   writeln;
   repeat
      fnum := fnum + 1;
      write('Name of cross-reference file #', fnum:1, '? ');
      readln(fn);
      good := true;
      if (fn <> '') then
         begin
            try
               reset(f, fn);
            recover
               if escapecode <> -10 then
                  escape(escapecode)
               else
                  begin
                     good := false;
                     writeln('Can''t read file!');
                  end;
         end
      else
         good := false;
      if good then
         begin
            lnum := 0;
            section := k_normal;
            curkind := k_normal;
            paren := 0;
            while not eof(f) do
               begin
                  lnum := lnum + 1;
                  readln(f, buf);
                  strappend(buf, #0);
                  i := 1;
                  while (buf[i] = ' ') do
                     i := i + 1;
                  repeat
                     while not (buf[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_', #0]) do
                        begin
                           case buf[i] of
                              ':', '=':
                                 if brace = 0 then
                                    curkind := k_normal;
                              ';':
                                 if brace = 0 then
                                    curkind := section;
                              '''':
                                 if brace = 0 then
                                    begin
                                       i := i + 1;
                                       j := i;
                                       while ((buf[i] <> '''') or (buf[i+1] = '''')) and
                                             (buf[i] <> #0) do
                                          begin
                                             if (buf[i] = '''') then
                                                i := i + 2
                                             else
                                                i := i + 1;
                                          end;
                                       if (buf[i] = #0) then
                                          i := i - 1;
                                       name := '''' + str(buf, j, i-j) + '''';
                                       lookup(name, np);
                                       cref(np, k_strlit);
                                    end;
                              '(':
                                 if brace = 0 then
                                    if (buf[i+1] = '*') then
                                       begin
                                          brace := 1;
                                          i := i + 1;
                                       end
                                    else
                                       begin
                                          paren := paren + 1;
                                          curkind := k_normal;
                                       end;
                              ')':
                                 if brace = 0 then
                                    paren := paren - 1;
                              '*':
                                 if (buf[i+1] = ')') then
                                    begin
                                       brace := 0;
                                       i := i + 1;
                                    end;
                              '{': brace := 1;
                              '}': brace := 0;
                              otherwise ;
                           end;
                           i := i + 1;
                        end;
                     if (buf[i] <> #0) then
                        begin
                           j := i;
                           if (buf[i] in ['0'..'9']) and (i > 1) and (buf[i-1] = '-') then
                              j := j - 1;
                           while (buf[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) do
                              i := i + 1;
                           if brace = 0 then
                              begin
                                 name := str(buf, j, i-j);
                                 for j := 1 to strlen(name) do
                                    if (buf[j] in ['A'..'Z']) then
                                       buf[j] := chr(ord(buf[j]) + 32);
                                 while (buf[i] = ' ') do
                                    i := i + 1;
                                 lookup(name, np);
                                 case np^.kind of
                                    k_varkw:
                                       if paren = 0 then
                                          begin
                                             section := k_var;
                                             curkind := section;
                                          end;
                                    k_typekw:
                                       begin
                                          section := k_type;
                                          curkind := section;
                                       end;
                                    k_constkw:
                                       begin
                                          section := k_const;
                                          curkind := section;
                                       end;
                                    k_prockw:
                                       begin
                                          section := k_normal;
                                          curkind := k_proc;
                                       end;
                                    k_beginkw:
                                       begin
                                          section := k_normal;
                                          curkind := k_normal;
                                       end;
                                    k_kw: ;
                                    otherwise
                                       if (curkind = k_normal) and (buf[i] = '(') then
                                          cref(np, k_extproc)
                                       else
                                          cref(np, curkind);
                                 end;
                              end;
                        end;
                  until buf[i] = #0;
               end;
            if paren <> 0 then
               writeln('Warning: ending paren count = ', paren:1);
            close(f);
         end;
   until fn = '';
   writeln;
   repeat
      write('Output file name: ');
      readln(fn);
   until fn <> '';
   rewrite(f, fn);
   traverse(base);
   close(f, 'save');
end.