{****************************************************************************}
{*               PSTAT 2.0  copyright 1984 by Ulrich Kern                   *}
{****************************************************************************}

PROGRAM PSTAT; {Gibt die statische Struktur eines Programms wieder}
 {V-}   {Kein range-checking bei string-Uebergabe}

   TYPE  line            = STRING[128];
         linelengt       = 0..128;
         filetype        = (main,include);
         PufferZeiger    = ^Puffer;
         Puffer          = RECORD
                              Eintrag   : line;
                              Naechster : PufferZeiger
                           END;

   VAR   wort,
         zeile           : line;
         MainFile,
         InclFile        : text;
         MainFilename,
         FileName,
         InclFileName    : STRING[14];
         qq,
         PufferGroesse,
         Iter            : integer;
         IncludeFlag,
         NamenFlag,
         KommFlag, StrFlag,
         PufferVoll      : boolean;
         Anfang, p, q    : PufferZeiger;
         i               : integer;
         a,b             : line;

(*$I PSTAT-1.INC *)
(*$I PSTAT-2.INC *)
(*$I PSTAT-3.INC *)
{****************************************************************************}
{*                        Das Hauptprogramm                                 *}
{****************************************************************************}

BEGIN {Hauptprogramm}

  IncludeFlag:=false;  StrFlag:=false;  Anfang:=NIL;
  PufferVoll:=false;   KommFlag:=false; NamenFlag:=false;
  Iter:=0;             qq:=0;
  writeln('PSTAT vers. 2.0');writeln;
  REPEAT
    write('Geben Sie den Programm-Namen ein oder RETURN fuer Ende: ');
    LiesFileName;

   IF (MainFilename<>'') AND FileExists(main)
    THEN BEGIN
      writeln(LST,'Statische Struktur von ',MainFilename); writeln(LST);
      WHILE NOT(EOF(MainFile)) OR PufferVoll DO
      BEGIN
        IF NOT PufferVoll THEN BEGIN LiesPuffer; p:=Anfang END;
        zeile:=p^.Eintrag+' '; p:=p^.Naechster;
        IF p^.Naechster=NIL THEN ClearPuffer;
        IF NOT Sonderzeile(zeile)
          THEN BEGIN
             a:='';
             FOR i:=1 TO length(zeile) DO BEGIN
              IF zeile[i] in [#39,'0'..'9','A'..'Z','a'..'z']
               THEN a:=a+zeile[i]
               ELSE IF a<>''
                 THEN
                   BEGIN b:=gross(a);
                    IF (qq>0) AND NOT(StrFlag) AND NOT(KommFlag)
                     THEN
                      BEGIN
                       IF (b='CASE') OR (b='BEGIN') THEN qq:=qq+1;
                       IF b='END' THEN BEGIN
                                        qq:=qq-1;
                                        IF qq=0 THEN Iter:=Iter-1
                                       END
                      END
                     ELSE IF (qq=0) AND NOT(StrFlag) AND NOT(KommFlag)
                      THEN
                       BEGIN
                         IF (b='FORWARD') OR (b='EXTERN') THEN
                            BEGIN write(LST,'; ',b); Iter:=Iter-1 END;
                         IF NamenFlag THEN write(LST,a);
                         NamenFlag:=false;
                         IF (b='PROCEDURE') or(b='FUNCTION')
                            THEN BEGIN
                                   writeln(LST);
                                   Print(b);
                                   Iter:=succ(Iter);
                                   NamenFlag:=true
                                 END;
                         IF (b='PROGRAM')
                            THEN BEGIN
                                   writeln(LST);
                                   Print(b);
                                   Iter:=1;
                                   NamenFlag:=true
                                 END;
                         IF (b='BEGIN') THEN qq:=1
                       END;
                    a:=''
                   END; {else}
                   IF NOT(StrFlag) AND (zeile[i]='{') THEN KommFlag:=true;
                   IF NOT(StrFlag) AND (zeile[i]='}') THEN KommFlag:=false;
                   IF NOT(KommFlag) AND (zeile[i]=chr(39)) THEN StrFlag:=NOT(StrFlag)
             END {for}

          END {if not SonderZeile}
      END; {while}
     close(MainFile); writeln(LST); writeln(LST);
   END {if not EOF...}
   ELSE IF MainFilename<>'' THEN  writeln('File existiert nicht.');

  UNTIL MainFilename=''

END.