Listing of PSTAT.PAS                                               PAGE 1


    1:  0  {****************************************************************************}
    2:  0  {*               PSTAT 2.0  copyright 1984 by Ulrich Kern                   *}
    3:  0  {****************************************************************************}
    4:  0  
    5:  0  PROGRAM PSTAT; {Gibt die statische Struktur eines Programms wieder}
    6:  0   {V-}   {Kein range-checking bei string-Uebergabe}
    7:  0  
    8:  0     TYPE  line            = STRING[128];
    9:  0           linelengt       = 0..128;
   10:  0           filetype        = (main,include);
   11:  0           PufferZeiger    = ^Puffer;
   12:  0           Puffer          = RECORD
   13:  1                                Eintrag   : line;
   14:  1                                Naechster : PufferZeiger
   15:  1                             END;
   16:  0  
   17:  0     VAR   wort,
   18:  0           zeile           : line;
   19:  0           MainFile,
   20:  0           InclFile        : text;
   21:  0           MainFilename,
   22:  0           FileName,
   23:  0           InclFileName    : STRING[14];
   24:  0           qq,
   25:  0           PufferGroesse,
   26:  0           Iter            : integer;
   27:  0           IncludeFlag,
   28:  0           NamenFlag,
   29:  0           KommFlag, StrFlag,
   30:  0           PufferVoll      : boolean;
   31:  0           Anfang, p, q    : PufferZeiger;
   32:  0           i               : integer;
   33:  0           a,b             : line;
   34:  0  
   35:  0  {****************************************************************************}
   36:  0  {*                      Utility-Prozeduren                                  *}
   37:  0  {****************************************************************************}
   38:  0  
   39:  0     FUNCTION gross ( x : line ) : line;
   40:  0       VAR i : integer;
   41:  0       BEGIN FOR i:=1 TO length(x) DO x[i]:=upcase(x[i]); gross:=x; END;
   42:  0  
   43:  0     PROCEDURE LiesFileName;
   44:  0       VAR n : STRING[14];
   45:  0       BEGIN
   46:  1         readln(n);
   47:  1         MainFilename:=gross(n);
   48:  1         writeln
   49:  1       END;
   50:  0  
   51:  0      FUNCTION FileExists ( x : filetype ) : boolean;
   52:  0       {Falls das File existiert, wird es zugleich eroeffnet.}
   53:  0       BEGIN
   54:  1       CASE x OF
   55:  2         main    : BEGIN assign(MainFile,MainFilename);
   56:  3                         {$I-}; reset(MainFile); {$I+};
   57:  3                   END;
   58:  2         include : BEGIN assign(InclFile,InclFileName);
   59:  3                         {$I-}; reset(InclFile); {$I+};
   60:  3                   END;
   61:  2       END;
   62:  1       FileExists:=(ioresult=0)
   63:  1     END;
   64:  0  
   65:  0     PROCEDURE SchliesseIncludeFile;
   66:  0       BEGIN
   67:  1       close(InclFile);
   68:  1       IncludeFlag:=false
   69:  1     END;
   70:  0  
   71:  0  {****************************************************************************}
   72:  0  {*              Entschluesselung der Include-Anweisungen                    *}
   73:  0  {****************************************************************************}
   74:  0  
   75:  0     FUNCTION Sonder( VAR x : line) : boolean;
   76:  0     BEGIN
   77:  1       Sonder:=(pos(chr(39),x)=0) AND
   78:  1          (((pos('{$I',x)>0) OR (pos('(*$I',x)>0))
   79:  1           AND (pos('{$I+',x)=0) AND (pos('{$I-',x)=0)
   80:  1           AND (pos('(*$I+',x)=0) AND (pos('(*$I-',x)=0))
   81:  1      END;
   82:  0  


Listing of PSTAT.PAS                                               PAGE 2


   83:  0     FUNCTION Sonderzeile ( VAR x : line) : boolean;
   84:  0       VAR h   : boolean;
   85:  0           i   : integer;
   86:  0       BEGIN
   87:  1         h:=Sonder(x);
   88:  1         IF h THEN BEGIN
   89:  2           i:=pos('{$I',x)+3; IF i=3 THEN i:=pos('(*$I',x)+4;
   90:  2           IF i>3 THEN BEGIN
   91:  3              InclFileName:='';
   92:  3              WHILE x[i]=' ' DO i:=i+1;
   93:  3              WHILE (i<length(x)) AND
   94:  3                     (x[i] in['-','.',':','0'..'9','A'..'Z','a'..'z']) DO
   95:  3                    BEGIN InclFileName:=InclFileName+gross(x[i]); i:=i+1 END;
   96:  3              IF MainFilename[2]=':' THEN
   97:  3                IF InclFileName[2]=':' THEN InclFileName[1]:=MainFilename[1]
   98:  3                          ELSE InclFileName:=MainFilename[1]+':'+InclFileName;
   99:  3              IncludeFlag:=FileExists(Include); h:=IncludeFlag;
  100:  3           END
  101:  2         END;
  102:  1         Sonderzeile:=h
  103:  1       END;
  104:  0  
  105:  0  {****************************************************************************}
  106:  0  {*                         Puffer-Operationen                               *}
  107:  0  {****************************************************************************}
  108:  0     FUNCTION EndOfBlock : boolean;
  109:  0       VAR h : boolean;
  110:  0       BEGIN
  111:  1         h:=EOF(MainFile);
  112:  1         IF IncludeFlag THEN IF EOF(InclFile) THEN BEGIN h:=true;
  113:  2                                                         IncludeFlag:=false;
  114:  2                                                         SchliesseIncludeFile
  115:  2                                                   END;
  116:  1         IF NOT(h) THEN h:=Sonder(zeile);
  117:  1         IF abs(MaxAvail)<500 THEN h:=true;
  118:  1         EndOfBlock:=h
  119:  1      END;
  120:  0  
  121:  0     PROCEDURE ClearPuffer;
  122:  0       BEGIN
  123:  1         p:=Anfang;
  124:  1         WHILE p^.Naechster<>NIL DO BEGIN
  125:  2         q:=p; dispose(p); p:=q^.Naechster;
  126:  2         END;  dispose(p);
  127:  1         PufferVoll:=false
  128:  1       END;
  129:  0  
  130:  0     PROCEDURE LiesPuffer; VAR h:boolean;
  131:  0       BEGIN PufferGroesse:=0;
  132:  1         new(q); Anfang:=q; q^.Naechster:=NIL;
  133:  1         REPEAT
  134:  2           IF IncludeFlag THEN BEGIN readln(InclFile,zeile);
  135:  3                                     FileName:=InclFileName END
  136:  2                          ELSE BEGIN readln(MainFile,zeile);
  137:  3                                     FileName:=MainFilename END;
  138:  2           q^.Eintrag:=zeile;
  139:  2           PufferGroesse:=PufferGroesse+1;
  140:  2           new(p);
  141:  2           q^.Naechster:=p;
  142:  2           p^.Naechster:=NIL;
  143:  2           q:=p;
  144:  2         UNTIL EndOfBlock;
  145:  1         PufferVoll:=true
  146:  1       END;
  147:  0  
  148:  0     PROCEDURE Print(a:line);
  149:  0       VAR i : integer;
  150:  0       BEGIN
  151:  1         IF FileName[2]=':' THEN FileName:=copy(FileName,3,length(FileName)-2);
  152:  1         write(LST,FileName,': ':14-length(FileName));
  153:  1         FOR i:=1 TO Iter DO write(LST,'   ');
  154:  1         write(LST,a,' ')
  155:  1       END;
  156:  0  


Listing of PSTAT.PAS                                               PAGE 3


  157:  0  {****************************************************************************}
  158:  0  {*                        Das Hauptprogramm                                 *}
  159:  0  {****************************************************************************}
  160:  0  
  161:  0  BEGIN {Hauptprogramm}
  162:  1  
  163:  1    IncludeFlag:=false;  StrFlag:=false;  Anfang:=NIL;
  164:  1    PufferVoll:=false;   KommFlag:=false; NamenFlag:=false;
  165:  1    Iter:=0;             qq:=0;
  166:  1    writeln('PSTAT vers. 2.0');writeln;
  167:  1    REPEAT
  168:  2      write('Geben Sie den Programm-Namen ein oder RETURN fuer Ende: ');
  169:  2      LiesFileName;
  170:  2  
  171:  2     IF (MainFilename<>'') AND FileExists(main)
  172:  2      THEN BEGIN
  173:  3        writeln(LST,'Statische Struktur von ',MainFilename); writeln(LST);
  174:  3        WHILE NOT(EOF(MainFile)) OR PufferVoll DO
  175:  3        BEGIN
  176:  4          IF NOT PufferVoll THEN BEGIN LiesPuffer; p:=Anfang END;
  177:  4          zeile:=p^.Eintrag+' '; p:=p^.Naechster;
  178:  4          IF p^.Naechster=NIL THEN ClearPuffer;
  179:  4          IF NOT Sonderzeile(zeile)
  180:  4            THEN BEGIN
  181:  5               a:='';
  182:  5               FOR i:=1 TO length(zeile) DO BEGIN
  183:  6                IF zeile[i] in [#39,'0'..'9','A'..'Z','a'..'z']
  184:  6                 THEN a:=a+zeile[i]
  185:  6                 ELSE IF a<>''
  186:  6                   THEN
  187:  6                     BEGIN b:=gross(a);
  188:  7                      IF (qq>0) AND NOT(StrFlag) AND NOT(KommFlag)
  189:  7                       THEN
  190:  7                        BEGIN
  191:  8                         IF (b='CASE') OR (b='BEGIN') THEN qq:=qq+1;
  192:  8                         IF b='END' THEN BEGIN
  193:  9                                          qq:=qq-1;
  194:  9                                          IF qq=0 THEN Iter:=Iter-1
  195:  9                                         END
  196:  8                        END
  197:  7                       ELSE IF (qq=0) AND NOT(StrFlag) AND NOT(KommFlag)
  198:  7                        THEN
  199:  7                         BEGIN
  200:  8                           IF (b='FORWARD') OR (b='EXTERN') THEN
  201:  8                              BEGIN write(LST,'; ',b); Iter:=Iter-1 END;
  202:  8                           IF NamenFlag THEN write(LST,a);
  203:  8                           NamenFlag:=false;
  204:  8                           IF (b='PROCEDURE') or(b='FUNCTION')
  205:  8                              THEN BEGIN
  206:  9                                     writeln(LST);
  207:  9                                     Print(b);
  208:  9                                     Iter:=succ(Iter);
  209:  9                                     NamenFlag:=true
  210:  9                                   END;
  211:  8                           IF (b='PROGRAM')
  212:  8                              THEN BEGIN
  213:  9                                     writeln(LST);
  214:  9                                     Print(b);
  215:  9                                     Iter:=1;
  216:  9                                     NamenFlag:=true
  217:  9                                   END;
  218:  8                           IF (b='BEGIN') THEN qq:=1
  219:  8                         END;
  220:  7                      a:=''
  221:  7                     END; {else}
  222:  6                     IF NOT(StrFlag) AND (zeile[i]='{') THEN KommFlag:=true;
  223:  6                     IF NOT(StrFlag) AND (zeile[i]='}') THEN KommFlag:=false;
  224:  6                     IF NOT(KommFlag) AND (zeile[i]=chr(39)) THEN StrFlag:=NOT(StrFlag)
  225:  6               END {for}
  226:  5  
  227:  5            END {if not SonderZeile}
  228:  4        END; {while}
  229:  3       close(MainFile); writeln(LST); writeln(LST);
  230:  3     END {if not EOF...}
  231:  2     ELSE IF MainFilename<>'' THEN  writeln('File existiert nicht.');
  232:  2  
  233:  2    UNTIL MainFilename=''
  234:  1  
  235:  1  END.