Turbo Toolbox/Turbo_Toolbox.iso/spezial/02/declare.pas

Pascal/Delphi Source File | 1988-02-08 | 32.0 KB | 894 lines

    PROCEDURE Typ (ESets: Symbolmenge;
                   VAR St: StP;
                   VAR SizeOfT: AddressRange;
                   VAR Stop: BOOLEAN);


    VAR
      SavSp,SavSP1,SavSP2: StP;
      OldDispIndex: DispRange;
      locc: KonstP;
      ActSize, OffS: AddressRange;
      LMIN,LMAX: INTEGER;


      PROCEDURE FieldList (ESets: Symbolmenge;
                           VAR RVars: StP;
                           VAR Stop: BOOLEAN;
                           VAR OffS: AddressRange);

      VAR
        locc,locc1,Nxt,nxt1: KonstP;
        SavSp,SavSP1,SavSP2,SavSP3,SavSP4: StP;
        MinSize,MaxSize,ActSize: AddressRange;
        SavValu: Value;

      BEGIN
        nxt1 := NIL;  SavSp := NIL;
        IF NOT(Symb IN (ESets+[Bezeich,CaseSymb])) THEN BEGIN
          Error(19);  Recover(ESets+[Bezeich,CaseSymb])
        END;
        WHILE Symb = Bezeich DO BEGIN
          Nxt := nxt1;
          REPEAT
            IF Symb = Bezeich THEN BEGIN
              New(locc);
              WITH locc^ DO BEGIN
                Name := Bez;  BezType := NIL;  Next := Nxt;
                Klass := FieldClass
              END;
              Nxt := locc;
              InsertId(locc);
              GetSymbol
            END
            ELSE Error(2);
            IF NOT (Symb IN [CommaSymb,ColonSymb]) THEN BEGIN
              Error(6);
              Recover(ESets+[CommaSymb,ColonSymb,Semicolon,CaseSymb])
            END;
            Stop := Symb <> CommaSymb;
            IF NOT Stop THEN GetSymbol
          UNTIL Stop;
          IF Symb = ColonSymb THEN GetSymbol ELSE Error(5);
          Typ(ESets+[CaseSymb,Semicolon],SavSp,ActSize,Stop);
          WHILE Nxt <> nxt1 DO
            WITH Nxt^ DO BEGIN
              BezType := SavSp; FieldAddress := OffS;
              Nxt := Next; OffS := OffS+ActSize
            END;
            nxt1 := locc;
            WHILE Symb = Semicolon DO BEGIN
              GetSymbol;
              IF NOT (Symb IN ESets+[Bezeich,CaseSymb,Semicolon]) THEN BEGIN
                Error(19);  Recover(ESets+[Bezeich,CaseSymb])
              END
            END
          END;
          Nxt := NIL;
          WHILE nxt1 <> NIL DO
            WITH Nxt1^ DO BEGIN
              locc := Next;  Next := Nxt;  Nxt := nxt1;  nxt1 := locc
            END;
          IF Symb = CaseSymb THEN BEGIN
            New(SavSp);
            WITH SavSp^ DO BEGIN
              TagFieldP := NIL;  FirstVar := NIL;  Form := TagFld
            END;
            RVars := SavSp;
            GetSymbol;
            IF Symb = Bezeich THEN BEGIN
              New(locc);
              WITH locc^ DO BEGIN
                Name := Bez;  BezType := NIL;  Klass := FieldClass;
                Next := NIL;  FieldAddress := OffS
              END;
              InsertId(locc);
              GetSymbol;
              IF Symb = ColonSymb THEN GetSymbol ELSE Error(5);
              IF Symb = Bezeich THEN BEGIN
                FindeBez([TypeClass],locc1);
                SavSP1 := locc1^.BezType;
                IF SavSP1 <> NIL THEN BEGIN
                  locc^.FieldAddress := OffS;
                  OffS := OffS+SavSP1^.Size;
                  IF (SavSP1^.Form <= SubRange) OR Strng(SavSP1) THEN BEGIN
                    IF IsCompatible(RealPtr,SavSP1) THEN Error(109)
                    ELSE IF Strng(SavSP1) THEN Error(399);
                    locc^.BezType := SavSP1;  SavSp^.TagFieldP := locc
                  END
                  ELSE Error(110);
                END;
                GetSymbol;
              END
              ELSE BEGIN
                Error(2);  Recover(ESets+[OfSymb,lBraces])
              END
            END
            ELSE BEGIN
              Error(2);  Recover(ESets+[OfSymb,lBraces])
            END;
            SavSp^.Size := OffS;
            IF Symb = OfSymb THEN GetSymbol ELSE Error(8);
            SavSP1 := NIL;  MinSize := OffS;  MaxSize := OffS;
              REPEAT
              SavSP2 := NIL;
              IF NOT(Symb IN ESets+[Semicolon]) THEN BEGIN
                REPEAT
                  GConstant(ESets+[CommaSymb,ColonSymb,lBraces],SavSP3,SavValu);
                  IF SavSp^.TagFieldP <> NIL THEN
                    IF NOT IsCompatible(SavSp^.TagFieldP^.BezType,SavSP3) THEN
                      Error(111);
                  New(SavSP3);
                  WITH SavSP3^ DO BEGIN
                    NxtVar := SavSP1;  VarTVar := SavSP2;  VarWert := SavValu;
                    Form := Variant
                  END;
                  SavSP4 := SavSP1;
                  WHILE SavSP4 <> NIL DO
                    WITH SavSP4^ DO BEGIN
                      IF VarWert.GanzeZahl = SavValu.GanzeZahl THEN Error(178);
                      SavSP4 := NxtVar
                    END;
                  SavSP1 := SavSP3;  SavSP2 := SavSP3;
                  Stop := Symb <> CommaSymb;
                  IF NOT Stop THEN GetSymbol
                UNTIL Stop;
                IF Symb = ColonSymb THEN GetSymbol ELSE Error(5);
                IF Symb = lBraces THEN GetSymbol ELSE Error(9);
                FieldList(ESets+[rBrace,Semicolon],SavSP2,Stop,OffS);
                IF OffS > MaxSize THEN MaxSize := OffS;
                WHILE SavSP3 <> NIL DO BEGIN
                  SavSP4 := SavSP3^.VarTVar;  SavSP3^.VarTVar := SavSP2;
                  SavSP3^.Size := OffS;  SavSP3 := SavSP4
                END;
                IF Symb = rBrace THEN BEGIN
                  GetSymbol;
                  IF NOT (Symb IN ESets+[Semicolon]) THEN BEGIN
                    Error(6);  Recover(ESets+[Semicolon])
                  END
                END
                ELSE Error(4);
              END;
              Stop := Symb <> Semicolon;
              IF NOT Stop THEN BEGIN
                OffS := MinSize;
                GetSymbol
              END
            UNTIL Stop;
            OffS := MaxSize;
            SavSp^.FirstVar := SavSP1;
          END
          ELSE RVars := NIL;
      END; (* FieldList *)


      PROCEDURE SimpleType (ESets: Symbolmenge;
                            VAR St: StP;
                            VAR SizeOfT: AddressRange);

      VAR SavSp,SavSP1: StP;
          locc,locc1: KonstP;
          SaveTop: DispRange;
          HasOrd: INTEGER;
          SavValu: Value;

      BEGIN
        SizeOfT := 1;
        IF NOT (Symb IN SimpleStartSymb) THEN BEGIN
          Error(1);  Recover(ESets+SimpleStartSymb)
        END;
        IF Symb IN SimpleStartSymb THEN BEGIN
          IF Symb=lBraces THEN BEGIN
            SaveTop := DispTop;
            WHILE DispVec[DispTop].OccursIn <> IsBlock DO DispTop := DispTop-1;
            New(SavSp);
            WITH SavSp^ DO BEGIN
              Size := IntSize; Form := Scalar;
              ScalKind := Declared
            END;
            locc1 := NIL;  HasOrd := 0;
            REPEAT
              GetSymbol;
              IF Symb = Bezeich THEN BEGIN
                New(locc);
                WITH locc^ DO BEGIN
                  Name := Bez;  BezType := SavSp;  Next := locc1;
                  Values.GanzeZahl := HasOrd;  Klass := KonstKlasse
                END;
                InsertId(locc);
                HasOrd := HasOrd+1;
                locc1 := locc;  GetSymbol
              END
              ELSE Error(2);
              IF NOT (Symb IN ESets + [CommaSymb,rBrace]) THEN BEGIN
                Error(6); Recover(ESets+[CommaSymb,rBrace])
              END
            UNTIL Symb <> CommaSymb;
            SavSp^.ScalConst := locc1;  DispTop := SaveTop;
            IF Symb=rBrace THEN GetSymbol ELSE Error(4)
          END
          ELSE BEGIN
            IF Symb = Bezeich THEN BEGIN
              FindeBez([TypeClass,KonstKlasse],locc);
              GetSymbol;
              IF locc^.Klass = KonstKlasse THEN BEGIN
                New(SavSp);
                WITH SavSp^,locc^ DO BEGIN
                  RangeType := BezType;  Form := SubRange;
                  IF Strng(RangeType) THEN BEGIN
                    Error(148);  RangeType := NIL
                  END;
                  Min := Values;  Size := IntSize
                END;
                IF Symb = ColonSymb THEN GetSymbol ELSE Error(5);
                GConstant(ESets,SavSP1,SavValu);
                SavSp^.Max := SavValu;
                IF SavSp^.RangeType <> SavSP1 THEN Error(107)
              END
              ELSE BEGIN
                SavSp := locc^.BezType;
                IF SavSp <> NIL THEN SizeOfT := SavSp^.Size
              END
            END
            ELSE BEGIN
              New(SavSp);  SavSp^.Form := SubRange;
              GConstant(ESets+[ColonSymb],SavSP1,SavValu);
              IF Strng(SavSP1) THEN BEGIN
                Error(148);  SavSP1 := NIL
              END;
              WITH SavSp^ DO BEGIN
                RangeType := SavSP1;  Min := SavValu;  Size := IntSize
              END;
              IF Symb = ColonSymb THEN GetSymbol ELSE Error(5);
              GConstant(ESets,SavSP1,SavValu);
              SavSp^.Max := SavValu;
              IF SavSp^.RangeType <> SavSP1 THEN Error(107)
            END;
            IF SavSp <> NIL THEN
               WITH SavSp^ DO
                 IF Form = SubRange THEN
                   IF RangeType <> NIL THEN
                     IF RangeType = RealPtr THEN Error(399)
                     ELSE IF Min.GanzeZahl > Max.GanzeZahl THEN Error(102)
          END;
          St := SavSp;
          IF NOT (Symb IN ESets) THEN BEGIN
            Error(6);  Recover(ESets)
          END
        END
        ELSE St := NIL;
      END; (* SimpleTyp *)


    BEGIN (* Typ *)
      IF NOT (Symb IN TypeStartSymb) THEN BEGIN
        Error(10);  Recover(ESets+TypeStartSymb)
      END;
      IF Symb IN TypeStartSymb THEN BEGIN
        IF Symb IN SimpleStartSymb THEN SimpleType(ESets,St,SizeOfT)
        ELSE IF Symb = Pointer THEN BEGIN
          New(SavSp);  St := SavSp;
          WITH SavSp^ DO BEGIN
            ElType := NIL;  Size := PtrSize;  Form := Pointers
          END;
          GetSymbol;
          IF Symb = Bezeich THEN BEGIN
            AllowsErrors := FALSE;
            FindeBez([TypeClass],locc);  AllowsErrors := TRUE;
            IF locc = NIL THEN BEGIN
              New(locc);
              WITH locc^ DO BEGIN
                Name := Bez;  BezType := SavSp;
                Next := ForwDeclType;  Klass := TypeClass
              END;
              ForwDeclType := locc
            END
            ELSE BEGIN
              IF locc^.BezType <> NIL THEN
                IF locc^.BEZTYPE^.Form=Files THEN Error(108)
                ELSE SavSp^.ElType := locc^.BezType
            END;
            GetSymbol;
          END
          ELSE Error(2);
        END
        ELSE BEGIN
          IF Symb = PackedSymb THEN BEGIN
            GetSymbol;
            IF NOT (Symb IN TypeDels) THEN BEGIN
              Error(10);  Recover(ESets+TypeDels)
            END
          END;
          IF Symb = ArraySymb THEN BEGIN
            GetSymbol;
            IF Symb=lBrack THEN GetSymbol ELSE Error(11);
            SavSP1 := NIL;
            REPEAT
              New(SavSp);
              WITH SavSp^ DO BEGIN
                ElemType := SavSP1;  IndexType := NIL;  Form := Arrays
              END;
              SavSP1 := SavSp;
              SimpleType(ESets+[CommaSymb,rBrack,OfSymb],SavSP2,ActSize);
              SavSP1^.Size := ActSize;
              IF SavSP2 <> NIL THEN
                IF SAVSP2^.Form <= SubRange THEN BEGIN
                  IF SavSP2 = RealPtr THEN BEGIN
                    Error(109);  SavSP2 := NIL
                  END
                  ELSE IF SavSP2 = IntPtr THEN BEGIN
                    Error(149);  SavSP2 := NIL
                  END;
                  SavSp^.IndexType := SavSP2
                END
                ELSE BEGIN
                  Error(113);  SavSP2 := NIL
                END;
                Stop := Symb <> CommaSymb;
                IF NOT Stop THEN GetSymbol
            UNTIL Stop;
            IF Symb = rBrack THEN GetSymbol ELSE Error(12);
            IF Symb = OfSymb THEN GetSymbol ELSE Error(8);
            Typ(ESets,SavSp,ActSize,Stop);
            REPEAT
              WITH SavSP1^ DO BEGIN
                SavSP2 := ElemType;  ElemType := SavSp;
                IF IndexType <> NIL THEN BEGIN
                  GetBounds(IndexType,LMIN,LMAX);
                  ActSize := ActSize*(LMAX-LMIN+1);
                  Size := ActSize
                END
              END;
              SavSp := SavSP1;  SavSP1 := SavSP2
            UNTIL SavSP1 = NIL
          END
          ELSE IF Symb = RecordSymb THEN BEGIN
            GetSymbol;
            OldDispIndex := DispTop;
            IF DispTop < MaxDispVec THEN BEGIN
              DispTop := DispTop+1;
              WITH DispVec[DispTop] DO BEGIN
                FirstDeclID := NIL;
                FirstLab := NIL;
                OccursIn := InRec
              END
            END
            ELSE Error(250);
            OffS := 0;
            FieldList(ESets-[Semicolon]+[EndSymb],SavSP1,Stop,OffS);
            New(SavSp);
            WITH SavSp^ DO BEGIN
              FirstField := DispVec[DispTop].FirstDeclID;
              RecVar := SavSP1;  Size := OffS;  Form := Records
            END;
            DispTop := OldDispIndex;
            IF Symb = EndSymb THEN GetSymbol ELSE Error(13)
          END
          ELSE IF Symb = SetSymb THEN BEGIN
            GetSymbol;
            IF Symb = OfSymb THEN GetSymbol ELSE Error(8);
            SimpleType(ESets,SavSP1,ActSize);
            IF SavSP1 <> NIL THEN
              IF SavSP1^.Form > SubRange THEN BEGIN
                Error(115);  SavSP1 := NIL
              END
              ELSE IF SavSP1 = RealPtr THEN BEGIN
                Error(114);  SavSP1 := NIL
              END
              ELSE IF SavSP1 = IntPtr THEN BEGIN
                Error(169);  SavSP1 := NIL
              END
              ELSE BEGIN
                GetBounds(SavSP1,LMIN,LMAX);
                IF (LMIN < SetMin) OR (LMAX > SetMax) THEN Error(169);
              END;
            New(SavSp);
            WITH SavSp^ DO BEGIN
              ElemSet := SavSP1;  Size := SetSize;  Form := Power
            END;
          END
          ELSE IF Symb = FileSymb THEN BEGIN
            GetSymbol;
            IF Symb = OfSymb THEN GetSymbol ELSE Error(8);
            Typ(ESets,SavSP1,ActSize,Stop);
            IF IsFileOfFile(SavSP1) THEN BEGIN
              Error(108);  Recover(ESets);  SavSp := NIL
            END
            ELSE BEGIN
              New(SavSp);
              WITH SavSp^ DO BEGIN
                FileType := SavSP1;
                Size := SavSP1^.Size+1;  Form := Files
              END;
            END;
          END;
          St := SavSp
        END;
        IF NOT (Symb IN ESets) THEN BEGIN
          Error(6);  Recover(ESets)
        END
      END
      ELSE St := NIL;
      IF St = NIL THEN SizeOfT := 1 ELSE SizeOfT := ST^.Size;
    END; (* Typ *)


    PROCEDURE LabelDeclaration (VAR Stop: BOOLEAN; VAR ESets: Symbolmenge);

    VAR ActLab: LabPointer;  MultDeclLab: BOOLEAN;  LabName:INTEGER;

    BEGIN
      REPEAT
        IF Symb = IntConst THEN
          WITH DispVec[DispTop] DO BEGIN
            ActLab := FirstLab;  MultDeclLab := FALSE;
            WHILE (ActLab <> NIL) AND NOT MultDeclLab DO
              IF ActLab^.LabValue <> LastConstVal.GanzeZahl THEN
                ActLab := ActLab^.NextLab
              ELSE BEGIN
                MultDeclLab := TRUE;  Error(166)
              END;
            IF NOT MultDeclLab THEN BEGIN
              New(ActLab);
              WITH ActLab^ DO BEGIN
                LabValue := LastConstVal.GanzeZahl;  GLab(LabName);
                Defined := FALSE;  NextLab := FirstLab;  LabName := LabName
              END;
              FirstLab := ActLab
            END;
            GetSymbol
          END
        ELSE Error(15);
        IF NOT (Symb IN ESets+[CommaSymb,Semicolon]) THEN BEGIN
          Error(6);  Recover(ESets+[CommaSymb,Semicolon])
        END;
        Stop := Symb <> CommaSymb;
        IF NOT Stop THEN GetSymbol
      UNTIL Stop;
      IF Symb = Semicolon THEN GetSymbol ELSE Error(14);
    END; (* LabelDeclaration *)


    PROCEDURE ConstDeclaration (VAR ESets: Symbolmenge);

    VAR locc: KonstP;  SavSp: StP;  SavValu: Value;

    BEGIN
      IF Symb <> Bezeich THEN BEGIN
        Error(2);  Recover(ESets+[Bezeich])
      END;
      WHILE Symb = Bezeich DO BEGIN
        New(locc);
        WITH locc^ DO BEGIN
          Name := Bez;  BezType := NIL;  Next := NIL;  Klass := KonstKlasse
        END;
        GetSymbol;
        IF (Symb = VergleichOp) AND (Oper = EqualOp) THEN GetSymbol
        ELSE Error(16);
        GConstant(ESets+[Semicolon],SavSp,SavValu);
        InsertId(locc);
        locc^.BezType := SavSp;  locc^.Values := SavValu;
        IF Symb = Semicolon THEN BEGIN
          GetSymbol;
          IF NOT (Symb IN ESets+[Bezeich]) THEN BEGIN
            Error(6);  Recover(ESets+[Bezeich])
          END
        END
        ELSE Error(14)
      END;
    END; (* ConstDeclaration *)


    PROCEDURE TypeDeclaration (VAR Stop: BOOLEAN; VAR ESets: Symbolmenge);

    VAR
      locc,locc1,Locc2: KonstP;
      SavSp: StP;
      ActSize: AddressRange;

    BEGIN
      IF Symb <> Bezeich THEN BEGIN
        Error(2);  Recover(ESets+[Bezeich])
      END;
      WHILE Symb = Bezeich DO BEGIN
        New(locc);
        WITH locc^ DO BEGIN
          Name := Bez;  BezType := NIL;  Klass := TypeClass
        END;
        GetSymbol;
        IF (Symb = VergleichOp) AND (Oper = EqualOp) THEN GetSymbol
        ELSE Error(16);
        Typ(ESets+[Semicolon],SavSp,ActSize,Stop);
        InsertId(locc);
        locc^.BezType := SavSp;
        locc1 := ForwDeclType;
        WHILE locc1 <> NIL DO BEGIN
          IF locc1^.Name=locc^.Name THEN BEGIN
            locc1^.BEZTYPE^.ElType := locc^.BezType;
            IF locc1 <> ForwDeclType THEN locc2^.Next := locc1^.Next
            ELSE ForwDeclType := locc1^.Next
          END
          ELSE Locc2 := locc1;
          locc1 := locc1^.Next
        END;
        IF Symb = Semicolon THEN BEGIN
          GetSymbol;
          IF NOT (Symb IN ESets+[Bezeich]) THEN BEGIN
            Error(6);  Recover(ESets+[Bezeich])
          END
        END
        ELSE Error(14)
      END;
      IF ForwDeclType <> NIL THEN Error(117);
    END; (* TypeDeclaration *)


    PROCEDURE VarDeclaration (VAR Stop: BOOLEAN; VAR ESets: Symbolmenge);

    VAR locc,Nxt: KonstP;  SavSp: StP;  ActSize: AddressRange;

    BEGIN
      Nxt := NIL;
      REPEAT
        REPEAT
          IF Symb = Bezeich THEN BEGIN
            New(locc);
            WITH locc^ DO BEGIN
              Name := Bez;  Next := Nxt;  Klass := VarClass;
              BezType := NIL;  VarKind := Actual;  VarsBSt := Bst
            END;
            InsertId(locc);
            Nxt := locc;
            GetSymbol;
          END
          ELSE Error(2);
          IF NOT (Symb IN ESets+[CommaSymb,ColonSymb]+TypeDels) THEN BEGIN
            Error(6);
            Recover(ESets+[CommaSymb,ColonSymb,Semicolon]+TypeDels)
          END;
          Stop := Symb <> CommaSymb;
          IF NOT Stop THEN GetSymbol
        UNTIL Stop;
        IF Symb = ColonSymb THEN GetSymbol ELSE Error(5);
        Typ(ESets+[Semicolon]+TypeDels,SavSp,ActSize,Stop);
        WHILE Nxt <> NIL DO
          WITH Nxt^ DO BEGIN
            BezType := SavSp;  VarAddr := LocStk;  LocStk := LocStk+ActSize;
            IF SavSp^.Form=Files THEN BEGIN
              NoOfFiles := NoOfFiles+1;
              IF NoOfFiles>MaxFiles THEN BEGIN
                Error(258);  Next := NIL
              END;
            END;
            Nxt := Next
          END;
        IF Symb = Semicolon THEN BEGIN
          GetSymbol;
          IF NOT (Symb IN ESets+[Bezeich]) THEN BEGIN
            Error(6);  Recover(ESets+[Bezeich])
          END
        END
        ELSE Error(14)
      UNTIL (Symb <> Bezeich) AND NOT (Symb IN TypeDels);
      IF ForwDeclType <> NIL THEN Error(117);
    END; (* VarDeclaration *)


    PROCEDURE Anbindung (VAR locc: KonstP);
    BEGIN
      WITH locc^ DO BEGIN
        Extern := TRUE;
        CASE Symb OF
          GemDosSy : ProcLabel := 24;
          BiosSy   : ProcLabel := 25;
          XBiosSy  : ProcLabel := 26;
          VdiAesSy : ProcLabel := 27;
        END;
        GetSymbol;
        IF Symb = lBraces THEN GetSymbol ELSE Error(9);
        IF Symb = IntConst THEN Zahl := LastConstVal.GanzeZahl
        ELSE Error(15);
        GetSymbol;
        IF Symb <> rBrace THEN Error(4);
      END;
    END; (* Anbindung *)


    PROCEDURE ProcDeclaration (ESet: Symbol;
                               VAR Stop: BOOLEAN;
                               VAR ESets: Symbolmenge);

    VAR oldBSt: 0..MaxBSt;
        LastSymb: Symbol;
        locc, locc1: KonstP;
        SavSP: StP;
        isForward: BOOLEAN;
        oldDispIndex: DispRange;
        ParCnt: INTEGER;
        SavLocStk, TempLC: AddressRange;
        LabName: INTEGER;
        MarkP: ^INTEGER;


      PROCEDURE ParameterList (ESet: Symbolmenge;
                               VAR Paramlist: KonstP;
                               VAR Stop: BOOLEAN;
                               VAR ESets: Symbolmenge;
                               VAR isForward: BOOLEAN);

      VAR locc, locc1, locc2, locc3: KonstP;
          SavSp: StP;
          LBezArt: BezArt;
          SavLocStk: AddressRange;
          NoOfParams, ActSize: INTEGER;

      BEGIN
        locc1 := NIL;
        IF NOT (Symb IN ESet+[lBraces]) THEN BEGIN
          Error(7);  Recover(ESets+ESet+[lBraces])
        END;
        IF Symb = lBraces THEN BEGIN
          IF isForward THEN Error(119);
          GetSymbol;
          IF NOT (Symb IN [Bezeich,VarSymb,ProcSymb,FuncSymb]) THEN BEGIN
            Error(7); Recover(ESets+[Bezeich,rBrace])
          END;
          WHILE Symb IN [Bezeich,VarSymb,ProcSymb,FuncSymb] DO BEGIN
            IF Symb = ProcSymb THEN BEGIN
              Error(399);
              REPEAT
                GetSymbol;
                IF Symb = Bezeich THEN BEGIN
                  New(locc);
                  WITH locc^ DO BEGIN
                    Name := Bez;  BezType := NIL;  Next := locc1;
                    ProcBSt := Bst;  Klass := ProcClass;
                    IsDecldAs := Declared;  IsKind := Formal;
                  END;
                  InsertID(locc);
                  locc1:=locc;
                  GetSymbol;
                END
                ELSE Error(2);
                IF NOT (Symb IN ESets+[CommaSymb,Semicolon,rBrace]) THEN BEGIN
                  Error(7);  Recover(ESets+[CommaSymb,Semicolon,rBrace]);
                END;
              UNTIL Symb <> CommaSymb;
            END
            ELSE BEGIN
              IF Symb = FuncSymb THEN BEGIN
                Error(399);  locc2 := NIL;
                REPEAT
                  GetSymbol;
                  IF Symb = Bezeich THEN BEGIN
                    New(locc);
                    WITH locc^ DO BEGIN
                      Name := Bez;  BezType := NIL;  Next := locc2;
                      ProcBSt := Bst;  Klass := FuncClass;
                      IsDecldAs := Declared;  IsKind := Formal;
                    END;
                    InsertID(locc);  locc2 := locc;  GetSymbol;
                  END;
                  IF NOT (Symb IN [CommaSymb,ColonSymb]+ESets) THEN BEGIN
                    Error(7);  Recover(ESets+[CommaSymb,Semicolon,rBrace])
                  END
                UNTIL Symb<>CommaSymb;
                IF Symb = ColonSymb THEN BEGIN
                  GetSymbol;
                  IF Symb = Bezeich THEN BEGIN
                    FindeBez([TypeClass],locc);  SavSp := locc^.BezType;
                    IF SavSp <> NIL THEN
                      IF NOT(SavSp^.Form IN [Scalar,SubRange,Pointers]) THEN BEGIN
                        Error(120);  SavSp := NIL
                      END;
                    locc3 := locc2;
                    WHILE locc2 <> NIL DO BEGIN
                      locc2^.BezType := SavSp;  locc := locc2;
                      locc2 := locc2^.Next
                    END;
                    locc^.Next := locc1;  locc1 := locc3;
                    GetSymbol;
                  END
                  ELSE Error(2);
                  IF NOT (Symb IN ESets+[Semicolon,rBrace]) THEN BEGIN
                    Error(7);  Recover(ESets+[Semicolon,rBrace])
                  END
                END
                ELSE Error(5)
              END (* Symb = FuncSymb *)
              ELSE BEGIN
                IF Symb = VarSymb THEN BEGIN
                  LBezArt := Formal;  GetSymbol
                END
                ELSE LBezArt := Actual;
                locc2 := NIL;  NoOfParams := 0;
                REPEAT
                  IF Symb = Bezeich THEN BEGIN
                    New(locc);
                    WITH locc^ DO BEGIN
                      Name := Bez;  BezType := NIL;  Klass := VarClass;
                      VarKind := LBezArt;  Next := locc2;  VarsBSt := Bst;
                    END;
                    InsertID(locc);
                    locc2 := locc;  NoOfParams := NoOfParams+1;  GetSymbol;
                  END;
                  IF NOT (Symb IN [CommaSymb,ColonSymb]+ESets) THEN BEGIN
                    Error(7);  Recover(ESets+[CommaSymb,Semicolon,rBrace])
                  END;
                  Stop := Symb <> CommaSymb;
                  IF NOT Stop THEN GetSymbol;
                UNTIL Stop;
                IF Symb = ColonSymb THEN BEGIN
                  GetSymbol;
                  IF Symb = Bezeich THEN BEGIN
                    FindeBez([TypeClass],locc);
                    SavSp := locc^.BezType;
                    ActSize := PtrSize;
                    IF SavSp <> NIL THEN
                      IF LBezArt = Actual THEN
                        IF SavSp^.Form <= Power THEN ActSize := SavSp^.Size
                        ELSE IF SavSp^.Form = Files THEN Error(121);
                    locc3 := locc2;
                    LocStk := LocStk + NoOfParams * ActSize;
                    SavLocStk := LocStk;
                    WHILE locc2<>NIL DO BEGIN
                      locc := locc2;
                      WITH locc2^ DO BEGIN
                        BezType := SavSp;
                        SavLocStk := SavLocStk-ActSize;
                        VarAddr := SavLocStk;
                      END;
                      locc2 := locc2^.Next
                    END;
                    locc^.Next := locc1;  locc1 := locc3;
                    GetSymbol
                  END
                  ELSE Error(2);
                  IF NOT (Symb IN ESets+[Semicolon,rBrace]) THEN BEGIN
                    Error(7); Recover(ESets+[Semicolon,rBrace])
                  END
                END
                ELSE Error(5);
              END
            END;
            IF Symb = Semicolon THEN BEGIN
              GetSymbol;
              IF NOT (Symb IN ESets+[Bezeich,VarSymb,ProcSymb,FuncSymb]) THEN BEGIN
                Error(7); Recover(ESets+[Bezeich,rBrace])
              END
            END
          END;
          IF Symb = rBrace THEN BEGIN
            GetSymbol;
            IF NOT (Symb IN ESet+ESets) THEN BEGIN
              Error(6); Recover(ESet+ESets)
            END
          END
          ELSE Error(4);
          locc3 := NIL;
          WHILE locc1<>NIL DO
            WITH locc1^ DO BEGIN
              locc2 := Next;  Next := locc3;
              IF Klass = VarClass THEN
                IF BezType <> NIL THEN
                  IF (VarKind = Actual) AND (BezType^.Form > Power) THEN BEGIN
                    VarAddr := LocStk;
                    LocStk := LocStk + BezType^.Size;
                  END;
              locc3 := locc1;  locc1 := locc2;
            END;
            Paramlist := locc3
          END
        ELSE Paramlist := NIL;
      END; (* ParameterList *)


    BEGIN (* ProcDeclaration *)
      SavLocStk := LocStk;  LocStk := VirginLocStk;  isForward := FALSE;
      IF Symb = Bezeich THEN BEGIN
        FindRecFields(DispVec[DispTop].FirstDeclID,locc);
        IF locc <> NIL THEN BEGIN
          IF locc^.Klass = ProcClass THEN
            isForward := locc^.IsForwDecl AND (ESet = ProcSymb)
                                          AND (locc^.IsKind = Actual)
          ELSE IF locc^.Klass = FuncClass THEN
            isForward := locc^.IsForwDecl AND (ESet = FuncSymb)
                                          AND (locc^.IsKind = Actual)
          ELSE isForward := FALSE;
          IF NOT isForward THEN Error(160)
        END;
        IF NOT isForward THEN BEGIN
          IF ESet = ProcSymb THEN New(locc)
          ELSE New(locc);
          WITH locc^ DO BEGIN
            Name := Bez;  BezType := NIL;
            Extern := FALSE;  ProcBSt := Bst;  GLab(LabName);
            IsDecldAs := Declared;  IsKind := Actual;  ProcLabel := LabName;
            IF ESet = ProcSymb THEN Klass := ProcClass
            ELSE Klass := FuncClass
          END;
          InsertId(locc)
        END
        ELSE BEGIN
          locc1 := locc^.Next;
          WHILE locc1 <> NIL DO BEGIN
            WITH locc1^ DO
             IF Klass = VarClass THEN
               IF BezType <> NIL THEN BEGIN
                 TempLC := VarAddr+BezType^.Size;
                 IF TempLC > LocStk THEN LocStk := TempLC
               END;
            locc1 := locc1^.Next
          END
        END;
        GetSymbol
      END
      ELSE BEGIN
        Error(2);  locc := UFctPtr
      END;
      oldBSt := Bst;  oldDispIndex := DispTop;
      IF Bst < MaxBSt THEN Bst := Bst+1 ELSE Error(251);
      IF DispTop < MaxDispVec THEN BEGIN
        DispTop := DispTop+1;
        WITH DispVec[DispTop] DO BEGIN
          IF isForward THEN FirstDeclID := locc^.Next
          ELSE FirstDeclID := NIL;
          FirstLab := NIL;
          OccursIn := IsBlock
        END
      END
      ELSE Error(250);
      IF ESet = ProcSymb THEN BEGIN
        ParameterList([Semicolon],locc1,Stop,ESets,isForward);
        IF NOT isForward THEN locc^.Next := locc1
      END
      ELSE BEGIN
        ParameterList([Semicolon,ColonSymb],locc1,Stop,ESets,isForward);
        IF NOT isForward THEN locc^.Next := locc1;
        IF Symb = ColonSymb THEN BEGIN
          GetSymbol;
          IF Symb = Bezeich THEN BEGIN
            IF isForward THEN Error(122);
            FindeBez([TypeClass],locc1);
            SavSP := locc1^.BezType;
            locc^.BezType := SavSP;
            IF SavSP <> NIL THEN
              IF NOT (SavSP^.Form IN [Scalar,SubRange,Pointers]) THEN BEGIN
                Error(120);  locc^.BezType := NIL
              END;
            GetSymbol
          END
          ELSE BEGIN
            Error(2); Recover(ESets+[Semicolon])
          END
        END
        ELSE IF NOT isForward THEN Error(123)
      END;
      IF Symb = Semicolon THEN GetSymbol ELSE Error(14);
      IF Symb IN [ForwardSymb,GemDosSy,BiosSy,XBiosSy,VdiAesSy] THEN BEGIN
        IF isForward THEN Error(161)
        ELSE locc^.IsForwDecl := TRUE;
        IF Symb <> ForwardSymb THEN Anbindung(locc);
        GetSymbol;
        IF Symb = Semicolon THEN GetSymbol ELSE Error(14);
        IF NOT (Symb IN ESets) THEN BEGIN
          Error(6);  Recover(ESets)
        END
      END
      ELSE BEGIN
        locc^.IsForwDecl := FALSE;  Mark(MarkP);
        REPEAT
          Block(ESets,Semicolon,locc);
          IF Symb = Semicolon THEN BEGIN
            GetSymbol;
            IF NOT (Symb IN [BeginSymb,ProcSymb,FuncSymb]) THEN BEGIN
              Error(6);  Recover(ESets)
            END
          END
          ELSE Error(14)
        UNTIL (Symb IN [BeginSymb,ProcSymb,FuncSymb]) OR Eof(Source);
        Release(MarkP);
      END;
      Bst := oldBSt;  DispTop := oldDispIndex;  LocStk := SavLocStk;
    END; (* ProcDeclaration *)