PROGRAM Parse;
(*$U-,C+,A-*)

CONST
      (*$I SCCONST.INC *)
      Test : BOOLEAN = TRUE;

TYPE
     (*$I SCTYPE.INC *)
     STR10 = STRING(.Identifierlaenge.);

     ObjektKlasse = (Nix,           (* fuer Fehlerfall     *)
                     CharacterCon,  (* Character-Konstante *)
                     IntegerCon,    (* Integer-Konstante   *)
                     Prozedur,
                     CharVar,       (* Character-Variable  *)
                     IntVar,        (* Integer-Variable    *)
                     Header);       (* Kopf der aktuallen  *)
                                    (* Symboltabelle       *)

(* Dies ist die Liste der verfuegbaren Typen. Wenn Sie     *)
(* weitere Typen haben wollen, z.B: Realzahl, Pointer      *)
(* o.ae., dann muessen Sie diese hier eintragen            *)
(* (definieren).                                           *)

     ObjPtr = ^Objekt;
     Objekt = RECORD
                Name : STR10;
                next : ObjPtr;
                CASE kind : ObjektKlasse OF
                     Nix          : ();
                     CharacterCon : (CWert : CHAR);
                     IntegerCon   : (IWert : INTEGER);
                     Prozedur     : (StartAdresse : INTEGER);
                     CharVar, IntVar
                                  : (DatenAdresse : INTEGER);
                     Header       : (Last, Down : ObjPtr);
                END;

VAR
     (*$I SCVAR.INC *)
     TopScope, Bottom : ObjPtr;
     ProgrammName     : T_Name;
     level            : Integer;

(*      Prozeduren und Funktionen von Scanner und Parser     *)
(*      ------------------------------------------------     *)
(*$I PARS-001.INC *)   (* Alle Scannerprozeduren.            *)
(*$I PARS-002. INC *)  (* Prozeduren Testausgabe, ProcCall,  *)
                       (* MakeData, NewObj, Find, TestSym,   *)
                       (* TestSemicolon.                     *)
(*$I PARS-003.INC *)   (* Prozeduren Expression, Statement.  *)
(*$I PARS-004.INC *)   (* Prozedur Block.                    *)

PROCEDURE Parse;
VAR str, sbl : STRING(.32.);
BEGIN
(* --- Begruessung, Initialisierung des Parsers. ----------- *)
  str := '--------------------------------';
  sbl := '>                              <';
  ClrScr;
  WRITELN (str); WRITELN (sbl);
  WRITELN ('>        Programm PARSE        <');
  WRITELN (sbl); WRITELN (str);
  neu      := FALSE;
  noerr    := TRUE;
  TopScope := NIL;
  InitScanner;
  GetSym;
  TestAusgabe('Parse : nach erstem GetSym');

(* --- Analyse des Programmkopfes -------------------------- *)
  IF sym = MODULEsy THEN
     BEGIN GetSym;
       IF sym = Identifier THEN
          BEGIN
            ProgrammName := idname;
            GetSym; TestSemicolon;
          END
       ELSE Error (4,'Parse : Identifier erwartet');
     END
  ELSE Error (1,'Parse : "MODULE" erwartet');

(* --- Analyse des Programmrumpfes ------------------------- *)
  level := 0;
  Block;

(* --- Analyse beendet. Auf Punkt testen. ------------------ *)
  IF sym <> period THEN Error(10,'Parse : "." erwartet');
  WRITELN (str); WRITELN (sbl);
  WRITELN ('>            PARSE             <');
  WRITELN (sbl);
  IF noerr THEN WRITELN ('> Programm fehlerfrei! <')
           ELSE WRITELN ('> Programm fehlerhaft! <');
  WRITELN (sbl);
  WRITELN ('>     Fehler: ', errcount :3,'           <' );
  WRITELN (sbl);
  WRITELN ('>         Press ENTER            <' );
  WRITELN (sbl); WRITELN (str);
  ch := ' ' ;
  WHILE ORD(ch) <> 13 DO READ(KBD,ch)
END (* Parse *);

BEGIN  (* Testhauptprogramm *)
  Parse;
END.

PROCEDURE TestAusgabe(s:STR255); (* PARS-002.INC *)
BEGIN
  IF Test   THEN WRITELN(    '+++ ',s);
  IF ListOn THEN WRITELN(LST,'+++',s);
END (* TestAusgabe *);

PROCEDURE DumpObjekt (p:ObjPtr);
VAR ch : CHAR;
    i  : INTEGER;
BEGIN
  WRITELN('Dump des Symboltabellenelementes ',idname,' erwunscht? (y/n)');
  READ(KBD,ch);
  IF ch IN ['y','Y','j','J'] THEN BEGIN
     ClrScr;
     WRITELN('*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*');
     WRITELN('*        DumpObjekt:          *');
     WRITELN('*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*');
     WRITELN('*                             *');
     WITH p^ DO BEGIN
     WRITELN('* Name =                      *');
     WRITE('* ',Name);
     FOR i := 31 DOWNTO Length(Name) + 4 DO WRITE(' ');
     WRITELN('*');
     WRITELN('*                             *');
     WRITELN('* next ist nicht druckbar.    *');
     WRITELN('*                             *');
     WRITELN('* Kind =                      *');
     CASE Kind OF
          Nix          : WRITE('* Nix                 ');
          CharacterCon : WRITE('* CharacterCon : ',CWert:5);
          IntegerCon   : WRITE('* IntegerCon   : ',IWert:5);
          Prozedur     : WRITE('* Prozedur     : ',StartAdresse:5);
          CharVar      : WRITE('* CharVal      : ',DatenAdresse:5);
          IntVar       : WRITE('* IntVal       : ',DatenAdresse:5);
     END;
  END;
  WRITELN('        *');
  WRITELN('*                              *');
  WRITELN('*          Press key           *');
  WRITELN('*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*');
  WHILE NOT KeyPressed DO;
  END;
END (* DumpObjekt *);

PROCEDURE ProcCall;
BEGIN
  Testausgabe('ProcCall : noch nicht fertig');
END (* ProcCall *);

PROCEDURE MakeData(VAR adr:Integer; Laenge:Integer);
BEGIN
  Testausgabe('MakeData : noch nicht fertig');
  adr := 0;
END (* MakeData *);

FUNCTION NewObjtk : ObjektKlasse) : ObjPtr;
(* Neues Objekt in die (Symboltabelle) Liste einfuegen *)
LABEL 99;
VAR Obj : ObjPtr;
BEGIN
  TestAusgabe(Concat('NewObj : Start - Name = ',idname));
  (* Pruefen, ob Identifier schon deklariert ist *)
  Obj := TopScope^.next;
  WHILE Obj <> NIL DO BEGIN
        TestAusgabe('NewObj : prufen - ' + idname + ' - ' + Obj^.name);
        IF Idname = Obj^.Name THEN BEGIN
           (* Ja. Fehler melden und NICHT doppelt anlegen, da die
           Symboltabelle immer sequenziell vom Anfang her durch-
           sucht wird. Man faende daher sowieso immer den ersten
           Eintrag. *)
           TestAusgabe('NewObj: Identifier doppelt deklariert');
           Error(25,'Identifier doppelt deklariert');
           GOTO 99;
         END;
  Obj := Obj^.next;
  END;
  (* Neues Element anlegen *)
  NEW(Obj);
  WITH Obj^ DO BEGIN
       Name := idname;
       next := NIL;
       kind := k;
       CASE Kind OF
            Nix          : ;
            CharacterCon : CWert := CharVal;
            IntegerCon   : IWert := IntVal;
            Prozedur     : StartAdresse := 0;
            CharVar      : MakeData(DatenAdresse, 1);
            IntVar       : MakeData(DatenAdresse, 2);
       END;
  END;
  TopScope^.Last^.next := Obj;
  TopScope^.Last := Obj;
  NewObj := Obj;
END (* NewObj *);

FUNCTION Find (id:STR10) :Ob jPtr;
LABEL 99;
VAR Hd, Obj : ObjPtr;
(* Symboltabelle vom Anfang der aktuellen Symboltabelle an
   (Zeiger auf Anfang der in diesem Block gueltigen Symbol-
   Tabelle ist "TopScope") nach Identifier sequenziell durch-
   suchen (entspricht "Lokalen Daten", gegebenenfalls die
   aktuelle Tabelle verlassen and in der naechst hoheren
   (entspricht "Globalen Daten") weitersuchen                *)
BEGIN
  TestAusgabe(Concat('Find : Name = ',id));
  Find := NIL;
  (* Symboltabelle anwaehlen. Zunachst die in diesem Block
     gueltige. *)
  Hd := TopScope;
  WHILE Hd <> NIL DO BEGIN
        Obj := Hd^.next;
        WHILE Obj <> NIL DO BEGIN
              TestAusgabe(Obj^.Name) ;
              IF Obj^.Name = id THEN
                 BEGIN
                   Find := Obj;
                   Testausgabe('Find : Identifier gefunden : ' + idname);
                   GOTO 99;
                 END
              ELSE
                 Obj := Obj^.next;
              END;
(* In diesem Block war der Identifier nicht deklariert.
   Eine Ebene hoher gehen (zum Hauptprogramm)                *)
    Hd := Hd^.down;
END;
(* Der Identifier war nicht deklariert.
   Fehlermeldung ausgeben und Identifier mit dem Type
   NIX eintragen. Da die Codegenerierung in ERROR ab-
   gebrochen wird, kann kein Schaden entstehen.              *)
   Error(24,'Find : Identifier nicht deklariert, Name = ' + idname)
   Obj := NewObj(Nix);
   Find := Obj;
   DumpObjekt(Obj);
END (* Find *);

PROCEDURE TestSym (s:Symbol;n:Cardinal);
BEGIN
  IF sym < s THEN BEGIN
     Error(n,'Dieses Symbol ist hier nicht erlaubt');
     REPEAT
       GetSym;
     UNTIL sym >= s;
  END;
END (* TestSym *) ;

PROCEDURE TestSemicolon;
BEGIN
  IF sym = semicolon THEN
     BEGIN
       WRITELN('Testsemicolon: sym = semicolon');
       GetSym;
     END
  ELSE Error (5,'Testsemicolon: "; " erwartet');
END (* TestSemicolon *);

PROCEDURE Expression;  (* PARS-003.INC            *)
(* Evaluation von arithmetischen Ausdruecken      *)
(* Verfahren siehe c't-Reihe "Softwarebaustellen" *)
(* Hinweis:                                       *)
(* Am Ende von Expression liegt das naechste      *)
(* Symbol schon vor. Es wird in Factor geholt.    *)

  PROCEDURE factor;
  VAR Obj: ObjPtr;
      ch1: CHAR;
  BEGIN
    TestAusgabe ('Factor gestartet');
    TestAusgabe (Satz);
    IF Test THEN BEGIN
       Symname(ORD(sym));
       WRITELN;
    END;
    TestSym(Lparent,95);
    IF sym = identifier THEN
       BEGIN
         TestAusgabe('Factor : Identifier vorgefunden');
         Obj := Find(idname);
         WITH Obj^ DO
              CASE kind OF
                   Nix                      : ; (* spaeter *)
                   CharacterCon, IntegerCon : ; (*    "    *)
                   CharVar, IntVar          : ; (*    "    *)
                   Header                   : ; (*    "    *)
                   Prozedur : Error(21,'Prozeduren hier nicht erlaubt');
              END;
         GetSym;
       END
    ELSE IF sym = Intcon  THEN GetSym
    ELSE IF sym = Charcon THEN GetSym
    ELSE IF sym = Hexcon  THEN GetSym
    ELSE IF sym = Lparent THEN BEGIN
       GetSym;
       Expression;
       IF sym= Rparent THEN GetSym ELSE Error(7,'")" erwartet')
    END ELSE Error (18,'Ausdruck erwartet');
    TestAusgabe ('Factor beendet');
  END (* Factor *);

  PROCEDURE Term;
  BEGIN
    TestAusgabe ('Term gestartet');
    TestAusgabe(Satz) ;
    IF Test THEN BEGIN
       Symname(ORD(sym));
       WRITELN;
    END;
    Factor;
    WHILE (times <= sym) AND (sym <= modsy) DO BEGIN
          TestAusgabe('Term : OP zwischen TIMES und MOD gefunden');
          GetSym;
          Factor;
    END;
    TestAusgabe ('Term beendet');
  END (* Term *);

BEGIN  (* Expression *)
  TestAusgabe('Expression gestartet');
  IF (plus <= sym) AND (sym <= minus) THEN
     BEGIN
       (* Vorzeichen da?                                     *)
       TestAusgabe('Expression: Vorzeichenbehandlung');
       GetSym;
       Term;
     END
  ELSE Term;
  WHILE (plus <= sym) AND (sym <= minus) DO BEGIN
        GetSym;
        Term;
  END;
  TestAusgabe ('Expression beendet');
END (* Expression *);

PROCEDURE Condition;
BEGIN
  TestAusgabe('Condition gestartet');
  IF sym = odd THEN
     BEGIN
       Test Ausgabe ('Condition: ODD gefunden');
       GetSym;
       Expression;
     END
  ELSE BEGIN
     TestAusgabe('Condition: Kein ODD und VOR erstem Expression');
     Expression;
     TestAusgabe('Condition: Kein ODD und NACH erstem Expression')
     IF (eq1 <= sym) AND (sym (= geq) THEN
        BEGIN
          TestAusgabe('Condition: Operatoren zw. eql und geq');
          GetSym;
          Expression;
        END
     ELSE Error(20,'Relation erwartet');
  END;
  TestAusgabe('Condition beendet');
END (* Condition *);

PROCEDURE Statement;
(* Bearbeitung aller Statements der Sprache DOIT.            *)
VAR Obj : ObjPtr;
    Folgesymbole : SET OF symbol;

  PROCEDURE IFstatement;
  (* Spezialprozedur zur Bearbeitung des IF - Statements     *)
  LABEL 99;
  BEGIN
    TestAusgabe('IFstatement gestartet');
    TestAusgabe(Satz);
    (* "IF" ist schon gelesen worden. Nun muB eine Bedingung *)
    (* folgen                                                *)
    GetSym;
    Condition;
    (* Das naechste Symbol wurde in Condition bzw. Expression *)
    (* bereits geholt.                                        *)
    IF sym = THENsy THEN
       BEGIN
         TestAusgabe('IFstatement: THEN gefunden');
         TestAusgabe(Satz);
         (* Menge der Folgesymbole des THEN-Zweiges festlegen *)
         Folgesymbole := (.ELSEsy, FIsy, ENDsy, period, Eofsy.);
         GetSym;
         REPEAT
           Statement;
           (* TestSemicolon wird bereits in statement gemacht. *)
         UNTIL sym in Folgesymbole;
         (* Menge der Folgesymbole des ELSE-Zweiges festlegen *)
         Folgesymbole := (.FIsy, ENDsy, period, eofsy.);
         (* Nur zur Verdeutlichung. Einfacher:               *)
         (* Folgesymbole := Folgesymbole - (.ELSEsy.);       *)
         IF sym = ELSEsy THEN BEGIN
            TestAusgabe('IFstatement: ELSE gefunden');
            TestAusgabe(Satz);
            GetSym;
            REPEAT
              Statement;
              IF sym = ELSEsy THEN BEGIN
                 Error(16,'FI erwartet');
                 TestAusgabe('IFstatement wegen FI-Fehler verlassen')
                 GOTO 99;
              END;
            UNTIL sym in Folgesymbole;
         END;
         IF sym = FIsy THEN
            BEGIN
              (* IF-THEN-ELSE-FI Konstrukt richtig beendet.  *)
              TestAusgabe('IFstatement: FI gefunden');
              TestAusgabe(Satz);
              GetSym;
            END
         ELSE Error(16,'FI erwartet');
       END
    ELSE Error(15,'THEN erwartet');
    TestAusgabe('IFstatement beendet');
    99:
  END (* IFstatement *);

BEGIN  (* Statement *)
  TestAusgabe('Statement gestartet');
  IF Test THEN BEGIN
     symname(ORD(sym));
     WRITELN;
  END;
  (* --- Falls falsches Symbol vorliegt - neu aufsetzen ---- *)
  TestSym(semicolon,98);
  IF sym = Identifier THEN
     BEGIN
       TestAusgabe('Statement: Identifier gefunden, Name = ' + idname);
       Obj := Find(idname);
       IF Obj^.kind = Nix THEN TestAusgabe('Statement: Identifier mit Typ
NIX');d
       IF Obj^.kind = Prozedur THEN
          BEGIN
            TestAusgabe('Statement: Prozeduraufruf gefunden');
            ProcCall;
            GetSym;
          END
       ELSE IF Obj^.kind <> Nix THEN
          BEGIN  (* Identifier deklariert *)
            GetSym;
            IF sym = becomes THEN GetSym ELSE Error(11,' := erwartet');
            TestAusgabe('Statement: gueltige Zuweisung gefunden');
            Expression;
          END
       ELSE BEGIN  (* Identifier nicht deklariert   *)
          GetSym;  (* Variablenname oder Prozedur ? *)
          IF sym = Semicolon THEN
             BEGIN
               TestAusgabe('Statement: illegalen Prozeduraufruf gefunden');
               ProcCall;
             END
          ELSE BEGIN  (* Variablenname / Zuweisung *)
             TestAusgabe ('Statement: illegale Zuweisung gefunden');
             IF sym = becomes THEN GetSym ELSE Error(11,' := erwartet);
             Expression;
          END;
       END;
     END (* IF sym = identifier *)
  ELSE IF sym = DOsy THEN
     BEGIN
       TestAusgabe('Statement: DO..OD gefunden');
       TestAusgabe(Satz);
       (* Menge der Folgesymbole des DO...OD festlegen.      *)
       Folgesymbole := (.ODsy, ENDsy, period, eofsy.);
       GetSym;
       REPEAT
         Statement;
         (* TestSemicolon wird bereits in statement gemacht. *)
       UNTIL sym in Folgesymbole;
       IF sym= ODsy THEN GetSym ELSE Error(17,'OD erwartet');
     END
  ELSE IF sym = IFsy THEN
     BEGIN
       TestAusgabe('Statement: IF gefunden');
       IFstatement;
     END
  ELSE IF sym = EXITsy THEN
     BEGIN
       TestAusgabe('Statement: EXIT gefunden');
       GetSym;
     END
  ELSE IF sym = READsy THEN
     BEGIN
       TestAusgabe('Statement: READ gefunden');
       GetSym;
       IF sym = Identifier THEN
          BEGIN
            Obj := Find(idname);
            GetSym;
          END
       ELSE Error(14,'Nach READ muB Identifier folgen');
     END
  ELSE IF sym = WRITEsy THEN
     BEGIN
       TestAusgabe('Statement: WRITE gefunden');
       GetSym;
       IF sym = semicolon THEN (* spaeter *)
          ELSE expression;
     END
     (* auf "leeres" statement testen:                       *)
  ELSE IF sym <> semicolon THEN Error(6,'Statement erwartet');
  TestSemicolon;
  TestAusgabe('Statement beendet');
END (* Statement *);

PROCEDURE Block;  (* PARS-004.INC *)
LABEL 99;
VAR Hd, obj : ObjPtr;
    HeapTop : ^INTEGER; (* fuer MARK/RELEASE *)
    s       : str255;
    adr     : REAL;

   PROCEDURE ConstDeclaration;
   Var Obj  : ObjPtr;
       Name : T_Name;

   BEGIN
     IF Test THEN BEGIN
        WRITELN('ConstDeclaration : Name = ',idname);
        WRITELN(Satz);
        Symname(ORD(sym));
        WRITELN;
     END;
     Name := '' ;
     IF sym = Identifier THEN
        (* Konstrukt : CONST x = 6; oder CONST x = 'z';      *)
        BEGIN
          Name := Idname;
          GetSym;
          IF sym = eql THEN
             BEGIN
               GetSym;
               IF sym IN (.intcon, charcon, hexcon.) THEN
                  IF (sym = intcon) THEN
                     BEGIN
                       Idname := Name;
                       Obj := NewObj(IntegerCon);
                       GetSym;
                     END
                  ELSE BEGIN
                     (* sym = charcon oder sym = hexcon      *)
                     Idname := Name;
                     Obj := NewObj(CharacterCon);
                     GetSym;
                  END
               ELSE BEGIN
                  s := 'Integer- oder Characterkonstante erwartet';
                  Error(2,s);
                END;
             END
          ELSE Error(3,'= erwartet' )
        END
     ELSE BEGIN
        s := 'Nach CONST, VAR oder PROC muB ein Identifier folgen'
        Error(4,s);
     END;
   END (* ConstDeclaration *);

   PROCEDURE VarDeclaration;
   VAR Obj  : ObjPtr;
       Name : T_Name;

   BEGIN
     IF Test THEN BEGIN
        WRITELN('VarDeclaration : Name = ',idname);
        WRITELN(Satz);
        Symname(ORD(sym));
        WRITELN;
     END;
     Name := '';
     IF sym = Identifier THEN
        (* Konstrukt : VAR x : INT; oder VAR x : CHAR;       *)
        BEGIN
          Name := Idname;
          GetSym;
          IF sym = null THEN
             BEGIN
               GetSym;
               IF sym = Charsy THEN
                  BEGIN
                    WRITELN('VarDeclaration : Character-Variable');
                    Idname := Name;
                    Obj := NewObj(CharVar);
                    GetSym;
                  END
               ELSE IF sym = Intsy THEN
                  BEGIN
                    WRITELN('VarDeclaration : Integer-Variable');
                    Idname := Name;
                    obj := NewObj(IntVar);
                    GetSym;
                  END
               ELSE Error(33,'Nach ":" INT oder CHAR erwartet')
             END
          ELSE Error(34,'":" erwartet')
       END
     ELSE Error(4,'Identifier erwartet');
   END (* VarDeclaration *);

BEGIN  (* Block *)
(* --- Bearbeitung der Deklarationen, falls vorhanden    --- *)
  TestAusgabe('Block : Block gestartet');

(* --- Test auf geschachtelte Prozeduren ------------------- *)
  IF level > 1 THEN BEGIN
     Error(22,'Keine "nested procedures" erlaubt');
     GOTO 99;
  END;

(* -- Neue Symboltabelle fuer die lokalen Daten anlegen   -- *)
(* -- und einen Kopf (Header) vorschalten.                -- *)
  MARK(HeapTop);
  New(Hd);
  WITH Hd^ DO BEGIN
       kind := header;
       Name := '#';
       next := NIL;
       last := Hd;
       down := TopScope;
  END;
  TopScope := Hd;
  IF level = 0 THEN Bottom := hd;
  symname(ORD(sym)); WRITELN;
  (* --- Bearbeitung der Konstantendeklarationen ----------- *)
  IF sym = CONSTsy THEN BEGIN
     TestAusgabe('Block : Konstantendeklarationen gefunden');
     WHILE (sym = CONSTsy) OR (sym = identifier) DO BEGIN
           IF sym = CONSTsy THEN Get Sym;
           ConstDeclaration;
           TestSemicolon;
     END;
  END;
  TestAusgabe('Block : Nach ConstDeclaration');

  (* --- Bearbeitung der Variablendeklarationen ------------ *)
  IF sym = VARsy THEN BEGIN
     TestAusgabe('Block : Variablendeklarationen gefunden');
     WHILE (sym = VARsy) OR (sym = identifier) DO BEGIN
           IF sym = VARsy THEN GetSym;
           VarDeclaration;
           TestSemicolon;
     END;
  END;
  TestAusgabe('Block : Nach VarDeclaration');

  (* --- Bearbeitung der Prozedurndeklarationen ------------ *)
  WHILE sym = PROCsy DO BEGIN
        TestAusgabe('Block : Prozedurdeklarationen');
        GetSym;
        IF sym = identifier THEN GetSym
           ELSE Error(4,'Identifier erwartet');
        obj := NewObj(Prozedur);
        TestSemicolon;
        level := level + 1;
        Block;
        level := level - 1;
        TestSemicolon;
  END;
  TestAusgabe('Block : Nach ProcDeclaration');

  (* --- Beginn der Bearbeitung des eigentlichen Blocks ---- *)
  TestAusgabe('Block : Deklarationen bearbeitet');
  IF sym = BEGINsy THEN GetSym
  ELSE Error(8,'BEGIN erwartet');

  (* --- Analyse des Rumpfes ------------------------------- *)
  WHILE (sym <> ENDsy) AND (sym <> eofsy) DO BEGIN
        TestAusgabe('Block : Beginn von neuem Statement');
        Statement;
  END;

  (* --- Pruefung, ob END-Statement vorhanden -------------- *)
  IF sym = ENDsy THEN GetSym
  ELSE Error(9,'END erwartet');

  (* --- Naechst hoehere Symboltabelle anwaehlen, ---------- *)
  (* --- Speicherplatz der alten freigeben. ---------------- *)
  TopScope := TopScope^.down;
  RELEASE(HeapTop);
  TestAusgabe('Block : Ende von Block');
  99:
END (* Block *);