(****************************************************************************)
(*                    Die Programmanalyse                                   *)
(****************************************************************************)

PROCEDURE Analyse;
 VAR Zustand, von : (BezLesen,ZeichenLesen,StringLesen,Kommentar1,
                     CheckFName,Kommentar2,CompBefehl,FNameLesen,CheckFun);
     ref, RefBaum : Baum;
     ZeilenNr, MainZNr : integer;
     Incl : text;
     c,l : char;
     Bez : str127;
     NFlag, CFlag, FFlag, IFLAG : boolean;
     LastProz : CheckedWords;
     AnwStack, DeklStack : ProgStack;

  PROCEDURE CheckRef;
    VAR temp : Baum;

    PROCEDURE NeuListe(VAR L : RefListe);
      VAR p : RefListe; i : integer;
      BEGIN
        p:=NIL;
        FOR i:=V DOWNTO 0 DO
          BEGIN
            getmem(L,SizeOf(RefListe)+succ(length(ProzListe[i].Name)));
            L^.naechster:=p; L^.Name:=ProzListe[i].Name; p:=L
          END
      END; (* NeuListe *)

  PROCEDURE VergleicheListe(VAR L : RefListe);
    VAR i : integer; p,q : RefListe; g : boolean;
    BEGIN
      i:=0; p:=L; q:=p; g:=false;
      REPEAT
        IF (i>V) OR (q=NIL) THEN g:=true ELSE
        IF q^.Name<>ProzListe[i].Name THEN g:=true
        ELSE BEGIN i:=succ(i); p:=q; q:=q^.naechster END
      UNTIL g;
      IF p<>NIL THEN p^.Naechster:=NIL; LoescheListe(q)
     END; (* VergleicheListe *)

  BEGIN (* CheckRef *)
    suche(RefBaum,Bez,temp);
    IF temp=NIL THEN
      BEGIN
        SchreibRef(Bez); Einfuegen(RefBaum,Bez,NIL);
        WITH ref^ DO IF von=NIL THEN NeuListe(von) ELSE VergleicheListe(von)
      END
  END; (* CheckRef *)

  PROCEDURE CheckBezeichner;
    VAR Top, Checked : CheckedWords;

    FUNCTION bekannt : boolean;
      VAR g : boolean; Vcomp : integer;
      BEGIN
        Vcomp:=V; g:=false;
        WHILE (Vcomp>=0) AND (NOT g) DO
          BEGIN
            suche(ProzListe[Vcomp].Routinen,Bez,ref); g:=ref<>NIL;
            IF NOT g THEN Vcomp:=pred(Vcomp)
          END;
        bekannt:=g;
      END; (* bekannt *)

    FUNCTION Bezeichner : CheckedWords;
      VAR von, bis, mitte : CheckedWords;
      BEGIN
        von:=pBezeichner; bis:=pUNTIL;
        REPEAT
          mitte:=CheckedWords((ord(von)+ord(bis))DIV 2);
          IF BezNamen[mitte]<Bez THEN von:=succ(mitte) ELSE bis:=mitte
        UNTIL von=bis;
        IF BezNamen[von]=Bez THEN Bezeichner:=von ELSE Bezeichner:=pBezeichner
      END;

    BEGIN (* CheckBezeichner *)
      checked:=Bezeichner;
      CASE checked OF
        pPROGRAM, pPROCEDURE, pFUNCTION :
          BEGIN
            IF NOT (leer(AnwStack) AND leer(DeklStack)) THEN Fehler(ZeilenNr);
            NFlag:=true; LastProz:=Checked;
          END;
        pRECORD : IF NOT leer(AnwStack)
                     THEN Fehler(ZeilenNr)
                     ELSE push(DeklStack,checked);
        pCASE : IF leer(DeklStack)
                     THEN IF leer(AnwStack)
                             THEN Fehler(ZeilenNr)
                             ELSE push(AnwStack,checked);
        pBEGIN : IF NOT leer(DeklStack)
                    THEN Fehler(ZeilenNr)
                    ELSE push(AnwStack,checked);
        pREPEAT : IF NOT leer(DeklStack)
                     THEN Fehler(ZeilenNr)
                     ELSE push(AnwStack,checked);
        pEXTERNAL, pFORWARD :
           IF NOT(leer(AnwStack) AND leer(DeklStack))
             THEN Fehler(ZeilenNr)
             ELSE BEGIN write(ZielDatei,' '); Markiere(Bez ); V:=pred(V) END;
        pEND : IF NOT leer(DeklStack)
                 THEN pop(DeklStack,Top)
                 ELSE IF leer(AnwStack)
                        THEN Fehler(ZeilenNr)
                        ELSE BEGIN
                               Pop(AnwStack,Top);
                               IF (Top<>pBEGIN) AND (Top<>pCASE)
                                 THEN Fehler(ZeilenNr);
                               IF leer(AnwStack) THEN
                                 BEGIN
                                   LoeschBaum(ProzListe[V].Routinen,true);
                                   V:=pred(V); LoeschBaum(RefBaum,false)
                                 END
                             END;
        pUNTIL : IF NOT leer(DeklStack) THEN Fehler(ZeilenNr) ELSE
                 IF leer(AnwStack) THEN Fehler(ZeilenNr)
                 ELSE BEGIN
                        pop(AnwStack,Top);
                        IF Top<>pREPEAT THEN Fehler(ZeilenNr)
                      END;
        pBezeichner : IF NFlag
                        THEN BEGIN
                               Einfuegen(ProzListe[V].Routinen,Bez,NIL);
                               NFlag:=false; V:=succ(V);
                               WITH ProzListe[V] DO
                                 BEGIN
                                   Name:=Bez; Art:=LastProz; Routinen:=NIL
                                 END;
                               SchreibProz(V)
                             END
                        ELSE IF bekannt
                               THEN IF ProzListe[V].Art=pfunction
                                       THEN Zustand:=CheckFun
                                       ELSE CheckRef
      END (* CASE checked of *)
    END; (* CheckBezeichner *)

  PROCEDURE ChecklnclFile;
    BEGIN
      IFlag:=false;
      assign(Incl,Bez); (*$I-*) reset(Incl) (*$I+*); InclFlag:=IOResult=0;
      IF NOT InclFlag
        THEN print('Datei: '+Bez+' nicht gefunden')
        ELSE BEGIN
               QuellName:=Bez; InclName:=Bez; MainZNr:=ZeilenNr; ZeilenNr:=1
             END
    END; (* ChecklnclFile *)

  BEGIN
    QuellName:=MainName; Zustand:=ZeichenLesen; RefBaum:=NIL; ZeilenNr:=1;
    ProzListe[0].Routinen:=NIL; ProzListe[0].Name:='';
    l:=' '; V:=0; NeuStack(AnwStack); NeuStack(DeklStack);
    NFlag:=false; InclFlag:=false; IFlag:=false; Seite:=0; NeueSeite(0);
    WHILE NOT eof(Main) DO BEGIN
      IF InclFlag THEN
        IF EOF(Incl) THEN
          BEGIN
            InclFlag:=false; close(Incl);
            QuellName:=MainName; ZeilenNr:=MainZNr
          END;
      IF InclFlag THEN read(Incl,c) ELSE read(Main,c); c:=upcase(c);
      CASE Zustand OF
        ZeichenLesen : CASE c OF
                         'A'..'Z' : BEGIN Bez:=c; Zustand:=BezLesen END;
                         '{'      : BEGIN CFlag:=true; Zustand:=Kommentar1 END;
                         '*'      : IF l='(' THEN
                                      BEGIN CFlag:=true; Zustand:=Kommentar2 END;
                         ''''     : Zustand:=StringLesen;
                         ^J       : ZeilenNr:=succ(ZeilenNr);
                       END;
        BezLesen     : CASE c OF
                         'A'..'Z','0'..'9','_': Bez:=Bez+c
                         ELSE BEGIN
                                CASE c OF
                                  '''' : Zustand:=StringLesen;
                                  '{'  : Zustand:=Kommentar1
                                  ELSE Zustand:=ZeichenLesen
                                END;
                                CheckBezeichner;
                              END;
                       END;
        StringLesen  : IF c='''' THEN Zustand:=ZeichenLesen;
        Kommentar1   : CASE c OF
                         '}' : BEGIN
                                 Zustand:=ZeichenLesen;
                                 IF IFlag THEN ChecklnclFile
                               END;
                         '$' : IF CFlag THEN
                                 BEGIN von:=Zustand; Zustand:=CompBefehl END;
                         ELSE CFlag:=false
                       END;
        Kommentar2   : CASE c OF
                         ')' : IF l='*' THEN
                                 BEGIN
                                   Zustand:=ZeichenLesen;
                                   IF IFlag THEN ChecklnclFile
                                 END;
                         '$' : IF CFlag THEN
                                 BEGIN von:=Zustand; Zustand:=CompBefehl END;
                         ELSE CFlag:=false
                       END;
        CompBefehl   : BEGIN
                         CFlag:=false;
                         CASE c OF
                           '}' : Zustand:=ZeichenLesen;
                           'I' : BEGIN Bez:=''; Zustand:=CheckFName END
                           ELSE Zustand:=von
                         END
                       END;
        CheckFName   : CASE c OF
                         '+','-' : Zustand:=von;
                         ' ' : ;
                         ELSE BEGIN Bez:=c; Zustand:=FNameLesen END
                       END;
        FNameLesen   : CASE c OF
                         'A'..'Z','0'..'9','.','-' : Bez:=Bez+c
                         ELSE BEGIN
                                IFlag:=true;
                                IF c = '}' THEN BEGIN
                                                  Zustand:=ZeichenLesen;
                                                  ChecklnclFile
                                                END
                                           ELSE Zustand:=von
                              END
                       END;
        CheckFun     : IF NOT (c in [' ',^M,^J] AND ((c<>'=') OR (l<>':') THEN Zustand:=ZeichenLesen
                         ELSE BEGIN
                                CheckRef;
                                CASE c OF
                                 'A'..'Z',
                                  '_'  : BEGIN Bez:=c; Zustand:=BezLesen END;
                                  '''' : Zustand:=StringLesen;
                                  '{'  : Zustand:=Kommentar1
                                  ELSE Zustand:=ZeichenLesen
                                END
                              END
      END; (* CASE *)
      l:=c
    END; (* WHILE *)
    print('' ); LoeschBaum(ProzListe[0].Routinen,false)
  END; (* Analyse *)