  (*$p**************************************************************************)
  (*                                                                           *)
  (*                          File: DECL.TEXT                                  *)
  (*                                                                           *)
  (*              (C) Copyright 1981 Silicon Valley Software, Inc.             *)
  (*                            1983, 1984 Apple Computer, Inc.                *)
  (*                                                                           *)
  (*                            All rights reserved.               11-Aug-81   *)
  (*                                                                           *)
  (* 2-12-82 fixed nil ptr bug in fieldlist (ref to tagtypept)                 *)
  (* 2-14-83 Classlist: Proc params node class                                 *)
  (* 2-18-83 Declaration: Function result of methods can't be in register      *)
  (* 3-09-83 Declaration: Make sure that classwide etc. code is right          *)
  (* 3-30-83 Typ: result type never set to nil                                 *)
  (* 4-05-83 Classlist: fix nil ptr refs in Clascal                            *)
  (* 4-14-83 Classlist: fix nil ptr refs in Clascal                            *)
  (* 5-11-83 Declaration: Procs imported by USES are external not forward      *)
  (* 5-11-83 Declaration: keep count of forward-declared procs                 *)
  (* 5-27-83 Simpletype: fix nil ptr refs in Clascal                           *)
  (* 6-13-83 Calcsize: check for types >32K in size                            *)
  (* 6-13-83 Vardecl:  check for >32K of variables                             *)
  (* 6-16-83 Parameterlist: reduce legal syms after typeid to [semic,rparen]   *)
  (* 6-17-83 Parameterlist: check for too many params (>= 32K)                 *)
  (* 6-23-83 Typ: array bounds must be integer-ranged; sets check more rigorous*)
  (* 6-23-83 Declaration: error(54) if intrinsic unit uses regular unit        *)
  (* 7-15-83 Calcsize: kludge around 32K error message (special compiler only) *)
  (* 8-31-83 Simpletype: init result ptr to nil to avoid dangling ptr          *)
  (* 9-01-83 Classlist: change syntax Subclass of Object to Subclass of NIL    *)
  (*10-05-83 Declaration: add SUPERSELF                                        *)
  (*10-11-83 Typedecl: Add space for superclass ptr under meth tbl record      *)
  (*10-13-83 Method 'NEW' changed to 'CREATE                                   *)
  (*10-25-83 Declaration: allow USES procs to be FORWARD for R. Perkins quirk  *)
  (*12-14-83 Declaration, ClassList, PFHead changes to avoid duping method list*)
  (*12-14-83 Typ: get 1st explicitly declared class in interface               *)
  (*12-14-83 ClassList: eliminate duplicating of superclasses procs            *)
  (*12-18-83 ClassList: eliminate duplicating of superclasses fields           *)
  (*12-20-83 Typ: error (817) check on sublass declarations                    *)
  (*12-27-83 ClassList: CLASSWIDE taken out of existence!                      *)
  (*12-27-83 Classes declarations changed to extensibility                     *)
  (*01-01-84 Declarations: CREATION syntax changed to simple BEGIN/END block   *)
  (*01-03-84 ClassList: Methods split into two groups                          *)
  (*01-05-84 UsesDecl: set HasClasses field and UnitsToInit switch             *)
  (*01-06-84 Typ: param added to pass current class name                       *)
  (*01-06-84 PFHead: parameter list allowed to be repeated on forward decls    *)
  (*01-06-84 ClassList: Override attribute added, optional two-part proc names *)
  (*01-21-84 Declarations: changed to support arbitrary declaration order      *)
  (*04-14-84 ParameterList: UNIV added                                         *)
  (*****************************************************************************)
  {[j=0/0/80!,@=10,i=1]}

  {$S DECL}

  PROCEDURE Declarations(FSys: SetOfSys; fSymbol: Symbol; VAR FpN: pN;
                         VAR HeapMark: PBoolean; ClasspT: pT);                {!C}

    VAR
      i, N: Integer;
      ExitFlag: Boolean;
      lToken: Symbol;
      lpN: pN;
      TempStr: String150;

    PROCEDURE PFHead(FSys: SetOfSys; fToken: Symbol; VAR FpN: pN;
                     FormalFlag, EnterIt: Boolean; ClasspT: pT);              {!C}
      FORWARD;

    PROCEDURE InsertMethod(lFpN: pN; N: Integer; ClasspT: pT);                {!01-03-84}

      VAR
        lpN, prev: pN;

      BEGIN {InsertMethod - adds method lFpN to the list of methods already
             associated with the class pointed to by ClasspT.  Methods are
             maintained in an ascending order determined by a key made from
             a method's MethodLevel and MethodNo (MethodLevel*256+MethodNo).
             For the method lFpN with key N (its MethodLevel*256+MethodNo),
             InsertMethod will insert lFpN in the proper place in the list to
             maintain the ascending order. The reason for all of this is to
             make life easier for the method table initialization
             (AddMethodInfo).}
        lpN := ClasspT^.ClFstMethod;
        prev := NIL;

        WHILE lpN <> NIL DO
          IF N <= (lpN^.MethodLevel * 256 + lpN^.MethodNo) THEN
            lpN := NIL
          ELSE
            BEGIN
            prev := lpN;
            lpN := lpN^.Next;
            END;

        IF prev=NIL THEN
          BEGIN
          lFpN^.Next := ClasspT^.ClFstMethod; ClasspT^.ClFstMethod := lFpN;
          END
        ELSE
          BEGIN
          lFpN^.Next := prev^.Next; prev^.Next := lFpN;
          END;
      END; {InsertMethod}

    PROCEDURE Typ(FSys: SetOfSys; VAR FpT: pT; ClassAllowed: Boolean;         {!C}
                  ThisClass: pN);                                             {!C}

      VAR
        ExitFlag, PackedFlag, FileFlag: Boolean;
        lValu: Valu;
        lpT, lpT2, lpT3: pT;
        lpN, lpN2: pN;
        Min, Max, OldTop: Integer;

      FUNCTION NrOfBits(fVal: LongInt): Integer;

        VAR
          Count: Integer;

        BEGIN {NrOfBits - number of bits to store 0..fval}
          Count := 0;
          REPEAT
            fVal := fVal DIV 2;
            Count := Count + 1;
          UNTIL fVal = 0;
          NrOfBits := Count;
        END; {NrOfBits}

      PROCEDURE CalcSize(fT: pT);

        LABEL 10;                                                              {!C}

        VAR
          BitCnt, lMin, lMax, DisplBytes, DisplBits, NumEls: Integer;
          LPckdRec: Boolean;
          lBytes, lNumEls: LongInt;

        FUNCTION TotalBits(FpT: pT): Integer;

          BEGIN {TotalBits}
            IF FpT <> NIL THEN
              TotalBits := (FpT^.Bytes * 8) + FpT^.Bits
            ELSE
              TotalBits := 32;
          END; {TotalBits}

        PROCEDURE LByteCalc(N: Integer);                                       {!6-13-83}

          VAR
            lBytes: LongInt;

          BEGIN {LByteCalc}
            IF N > 1 THEN
              lBytes := ((lNumEls - 1) DIV N) + 1
            ELSE
              lBytes := lNumEls;
            WITH fT^ DO
              IF lBytes > 32768 THEN
                Bytes := - 1 {flag}
              ELSE
                Bytes := lBytes;
          END; {LByteCalc}

        FUNCTION RecEvenLength: Boolean;

          BEGIN {RecEvenLength - Tells if the record will be an even number of
                 bytes}
            RecEvenLength := ((DisplBits <> 0) AND (DisplBytes <> 0)) OR
                             (DisplBytes > 1);
          END; {RecEvenLength}

        PROCEDURE CalcFieldAddrs(FfldList: pN; NoVariant: Boolean);

          VAR
            lTotalBits, FieldFullBytes: Integer;
            lFldList, Prevfield: pN;

          PROCEDURE PackTightly;

            BEGIN {PackTightly}
              lFldList := FfldList;
              WHILE lFldList <> NIL DO
                WITH lFldList^ DO
                  BEGIN
                  FieldFullBytes := FullBytes(IdType);
                  IF (FieldFullBytes < 1000) AND (IdType^.Form <= SUBRANGE) THEN
                    lTotalBits := TotalBits(IdType)
                  ELSE
                    lTotalBits := 32;
                  IF LPckdRec THEN
                    BEGIN
                    FOff := DisplBytes; BitOff := DisplBits; {Assume current disp}
                    IF (lTotalBits + DisplBits) < 8 THEN
                      BEGIN
                      IF Odd(DisplBytes) THEN
                        BEGIN
                        FOff := FOff - 1; BitOff := BitOff + 8;
                        END;
                      PckdField := True; DisplBits := DisplBits + lTotalBits;
                      END
                    ELSE IF (lTotalBits + DisplBits) = 8 THEN
                      BEGIN
                      PckdField := (lTotalBits <> 8) {Shares a byte}
                                   OR (FieldFullBytes > 1); {Unsigned 8 bits}
                      IF Odd(DisplBytes) AND PckdField THEN
                        BEGIN
                        FOff := FOff - 1; BitOff := BitOff + 8;
                        END;
                      DisplBits := 0; DisplBytes := DisplBytes + 1;
                      END
                    ELSE IF ((lTotalBits + DisplBits) < 16) AND
                            (NOT Odd(DisplBytes)) THEN
                      BEGIN
                      PckdField := True; DisplBytes := DisplBytes + 1;
                      DisplBits := DisplBits + lTotalBits - 8;
                      END
                    ELSE IF ((lTotalBits + DisplBits) = 16) AND
                            (NOT Odd(DisplBytes)) THEN
                      BEGIN
                      PckdField := lTotalBits <> 16; DisplBits := 0;
                      DisplBytes := DisplBytes + 2;
                      END
                    ELSE
                      BEGIN {No hope for current disp}
                      IF Odd(DisplBytes) THEN
                        BEGIN
                        DisplBytes := DisplBytes + 1; DisplBits := 0;
                        END;
                      IF DisplBits <> 0 THEN
                        BEGIN
                        DisplBits := 0; DisplBytes := DisplBytes + 2;
                        END;
                      FOff := DisplBytes; BitOff := DisplBits; {New disp}
                      IF lTotalBits < 16 THEN
                        BEGIN
                        PckdField := (lTotalBits <> 8) {Packable}
                                     OR (FieldFullBytes > 1); {Possible unsigned}
                        DisplBits := lTotalBits MOD 8;
                        DisplBytes := DisplBytes + (lTotalBits DIV 8);
                        END
                      ELSE
                        BEGIN
                        PckdField := False;
                        DisplBytes := DisplBytes + FieldFullBytes;
                        END;
                      END;
                    END
                  ELSE
                    BEGIN {not LPckdRec}
                    IF Odd(DisplBytes) AND (FieldFullBytes > 1) THEN
                      DisplBytes := DisplBytes + 1;
                    FOff := DisplBytes; PckdField := False; BitOff := 0;
                    DisplBytes := DisplBytes + FieldFullBytes;
                    END;
                  IF DisplBytes < 0 {overflowed} THEN
                    BEGIN
                    Error(309); DisplBytes := 2
                    END;                                                       {!6-13-83A.H.}
                  lFldList := Next;
                  END;
            END;

          BEGIN {CalcFieldAddrs - Assign FOff, PckdField, and BitOff for list of
                 fields starting at DisplBytes and DisplBits. Only called on
                 correct programs.}
            PackTightly; {First pack fields tightly}

            IF LPckdRec THEN
              BEGIN {Look for fields which straddle a byte boundary and are
                     followed by a hole which fit into the odd byte.}
              lFldList := FfldList; Prevfield := NIL;
              WHILE lFldList <> NIL DO
                WITH lFldList^ DO
                  BEGIN
                  IF Prevfield <> NIL THEN
                    IF Prevfield^.PckdField AND ((Prevfield^.FOff + 2) = FOff) AND
                       (Prevfield^.BitOff <> 0) THEN
                      IF (Prevfield^.BitOff <= 8) {prevfld doesnt slop into odd}
                         AND (TotalBits(Prevfield^.IdType) <= 8) THEN {prev fits
                           in odd}
                        Prevfield^.BitOff := 8;
                  Prevfield := lFldList; lFldList := Next;
                  END;
              IF NoVariant AND RecEvenLength THEN {Last field of record will
                                                   expand to an even number of
                                                   bytes}
                IF Prevfield <> NIL THEN
                  IF Prevfield^.PckdField AND (Prevfield^.BitOff <> 0) AND
                     (Prevfield^.BitOff <= 8) {prevfield doesn't slop into odd}
                     AND (TotalBits(Prevfield^.IdType) <= 8) THEN
                    Prevfield^.BitOff := 8; {prevfield fits in odd}

              {Look for fields which are "packed" but alone in bytes}

              Prevfield := NIL;
              lFldList := FfldList;
              WHILE lFldList <> NIL DO
                WITH lFldList^ DO
                  BEGIN
                  IF Prevfield <> NIL THEN
                    BEGIN {There is a previous field}
                    IF Prevfield^.PckdField AND (Prevfield^.BitOff = 0) AND (
                       (Prevfield^.FOff <> FOff) OR (BitOff = 8)) THEN {Can safely
                         expand into a byte}
                      Prevfield^.PckdField := FullBytes(Prevfield^.IdType) > 1;
                    IF Prevfield^.PckdField AND (Prevfield^.BitOff = 0) AND (
                       (Prevfield^.FOff + 2) = FOff) THEN {Can safely expand into
                                                           even/odd bytes}
                      Prevfield^.PckdField := False;
                    IF Prevfield^.PckdField AND (Prevfield^.BitOff = 8) AND
                       (Prevfield^.FOff <> FOff) THEN
                      BEGIN
                      Prevfield^.PckdField := FullBytes(Prevfield^.IdType) > 1;
                      IF NOT Prevfield^.PckdField THEN
                        BEGIN
                        Prevfield^.FOff := Prevfield^.FOff + 1;
                        Prevfield^.BitOff := 0;
                        END;
                      END;

                    {Attempt to right justify any fields still packed}

                    IF Prevfield^.PckdField AND ((Prevfield^.FOff + 2) = FOff) AND
                       (Prevfield^.BitOff <> 0) THEN
                      Prevfield^.BitOff := 16 - TotalBits(Prevfield^.IdType);
                    IF Prevfield^.PckdField AND ((Prevfield^.FOff + 1) = FOff) AND
                       (Prevfield^.BitOff <> 0) THEN
                      Prevfield^.BitOff := 8 - TotalBits(Prevfield^.IdType);
                    IF Prevfield^.PckdField AND (Prevfield^.FOff = FOff) AND
                       (BitOff = 8) AND (Prevfield^.BitOff <> 0) THEN
                      Prevfield^.BitOff := 8 - TotalBits(Prevfield^.IdType);
                    END;

                  Prevfield := lFldList; lFldList := Next;
                  END;
              IF (Prevfield <> NIL) AND NoVariant THEN {Last byte of record}
                WITH Prevfield^ DO
                  IF PckdField THEN
                    BEGIN
                    IF (BitOff = 0) AND (RecEvenLength OR (DisplBits <> 0)) THEN
                      PckdField := False;
                    IF BitOff = 8 THEN
                      BEGIN
                      PckdField := (TotalBits(IdType) = 8) AND
                                   (FullBytes(IdType) = 2);
                      IF NOT PckdField THEN
                        BEGIN
                        FOff := FOff + 1; BitOff := 0;
                        END;
                      END;

                    {Attempt to right justify final field if still packed}

                    IF RecEvenLength THEN
                      BEGIN
                      IF PckdField AND (BitOff <> 0) THEN
                        BitOff := 16 - TotalBits(IdType);
                      END
                    ELSE IF PckdField AND (BitOff <> 0) THEN
                      BitOff := 8 - TotalBits(IdType);
                    END;
              END;
          END; {CalcFieldAddrs}

        PROCEDURE CalcVarPart(fTagField: pT);

          VAR
            InitBytes, InitBits, MaxBytes, MaxBits: Integer;
            lT: pT;

          BEGIN {CalcVarPart - Call CalcVarPart on a pt of form TAGFIELD which may
                 be NIL}
            IF fTagField <> NIL THEN
              BEGIN
              InitBytes := DisplBytes; InitBits := DisplBits;
              MaxBytes := DisplBytes; MaxBits := DisplBits;
              lT := fTagField^.Variants;
              WHILE lT <> NIL DO
                BEGIN
                DisplBytes := InitBytes; DisplBits := InitBits;
                CalcFieldAddrs(lT^.VarFldLst, lT^.SubVar = NIL);
                CalcVarPart(lT^.SubVar);
                lT^.Bytes := DisplBytes + Ord(DisplBits <> 0);
                IF Odd(lT^.Bytes) THEN lT^.Bytes := lT^.Bytes + 1;
                IF lT^.Bytes < 2 THEN lT^.Bytes := 2;
                lT^.Bits := 0;
                IF (DisplBytes > MaxBytes) OR ((DisplBytes = MaxBytes) AND
                   (DisplBits > MaxBits)) THEN
                  BEGIN
                  MaxBytes := DisplBytes; MaxBits := DisplBits;
                  END;
                lT := lT^.NextVar;
                END;
              DisplBytes := MaxBytes; DisplBits := MaxBits;
              END;
          END; {CalcVarPart}

        BEGIN {CalcSize}
          IF fT <> NIL THEN
            WITH fT^ DO
              BEGIN
              Bytes := 0;
              Bits := 0;
              CASE Form OF
                SCALAR:   IF MaxConst <> NIL THEN
                            WITH MaxConst^.ValueOf DO
                              BEGIN
                              IF Ivalu <= 127 THEN
                                Bits := NrOfBits(Ivalu)
                              ELSE
                                BEGIN
                                Bytes := 1;
                                Bits := NrOfBits(Ivalu) - 8;
                                END;
                              END;
                SUBRANGE: IF Min >= 0 THEN {Positive minimum}
                            IF Max <= 127 THEN
                              Bits := NrOfBits(Max)
                            ELSE IF Max <= 32767 THEN
                              BEGIN
                              Bytes := 1;
                              Bits := NrOfBits(Max) - 8;
                              END
                            ELSE
                              Bytes := 4
                          ELSE
                            BEGIN {Negative minimum}
                            IF ( - (Min + 1)) > Max THEN
                              BitCnt := NrOfBits( - (Min + 1)) + 1
                            ELSE
                              BitCnt := NrOfBits(Max) + 1;
                            IF BitCnt < 8 THEN
                              Bits := BitCnt
                            ELSE IF BitCnt < 16 THEN
                              BEGIN
                              Bits := BitCnt - 8;
                              Bytes := 1;
                              END
                            ELSE
                              Bytes := ((BitCnt - 1) DIV 8) + 1;
                            END;
                RECORDS:  BEGIN
                          LPckdRec := PckdRec; DisplBytes := 0;
                          DisplBits := 0;
                          IF Errors = 0 THEN
                            BEGIN
                            CalcFieldAddrs(FstField, VarPart = NIL);
                            CalcVarPart(VarPart);
                            END;
                          Bytes := DisplBytes + Ord(DisplBits <> 0);
                          IF Bytes <= 1 THEN Bytes := 2;
                          IF Bytes < 0 {overflowed} THEN Error(309);           {!6-13-83A.H.}
                          END;
                CLASSES:  BEGIN {The trick to inherit the super class fields w/o
                                 change and to append the new fields on the end.
                                 New fields have foff = -1}
                          Bytes := 4;
                          Bits := 0;
                          DisplBytes := 4;
                          DisplBits := 0;
                          IF Errors = 0 THEN
                            BEGIN
                            DisplBytes := SuperClass^.SizeInstance;
                            DisplBits := 0;
                            lpN := ClFstField;
                            WHILE lpN <> NIL DO
                              BEGIN
                              IF lpN^.FOff < 0 THEN
                                BEGIN
                                LPckdRec := False;
                                CalcFieldAddrs(lpN, True);
                                GOTO 10;
                                END;
                              lpN := lpN^.Next;
                              END;
                          10:
                            END;
                          SizeInstance := DisplBytes + Ord(DisplBits <> 0);
                          IF Odd(SizeInstance) THEN
                            SizeInstance := SizeInstance + 1;
                          IF SizeInstance < 0 {overflowed} THEN Error(309);    {!6-13-83A.H.}
                          END;
                VARIANT, TAGFIELD, SCONST:
                          Error(3001);
                POINTERS: Bytes := 4;
                SETS:     BEGIN
                          GetBounds(SetOf, lMin, lMax);
                          Bits := 0; Bytes := (lMax DIV 8) + 1;
                          END;
                ARRAYS:   IF (ArrayOf <> NIL) AND (IndexedBy <> NIL) THEN
                            BEGIN
                            GetBounds(IndexedBy, lMin, lMax);
                            Bits := 0;
                            lNumEls := Ord4(lMax) - Ord4(lMin) + 1; {longint
                              value}
                            NumEls := lNumEls; {integer value, may ovflow}
                            Bytes := FullBytes(ArrayOf);
                            IF (Bytes > 128) OR (lNumEls > 128) THEN
                              BEGIN
                              lBytes := Bytes * lNumEls;
                              {-we allow 32768 bytes (bytes:=-32768) as a kludge-}
                              IF lBytes > 32768 THEN
                                Bytes := - 1 {flag}
                              ELSE
                                Bytes := lBytes;
                              END
                            ELSE
                              BEGIN
                              Bytes := Bytes * NumEls;
                              IF Bytes < 0 THEN Bytes := - 1; {flag}
                              END;
                            IF PckdArr THEN
                              IF (ArrayOf^.Bits = 0) AND (ArrayOf^.Bytes <>
                                 FullBytes(ArrayOf)) THEN
                                BEGIN {Unsigned 8 bits}
                                IF lNumEls >= 32768 THEN
                                  LByteCalc(1)
                                ELSE
                                  Bytes := NumEls;
                                BitPacked := True; BitsPerEl := 8;
                                END
                              ELSE IF ArrayOf^.Bytes = 0 THEN
                                IF ArrayOf^.Bits = 1 THEN
                                  BEGIN
                                  IF lNumEls >= 32768 THEN
                                    LByteCalc(8)
                                  ELSE
                                    Bytes := ((NumEls - 1) DIV 8) + 1;
                                  BitPacked := True; BitsPerEl := 1;
                                  END
                                ELSE IF ArrayOf^.Bits = 2 THEN
                                  BEGIN
                                  IF lNumEls >= 32768 THEN
                                    LByteCalc(4)
                                  ELSE
                                    Bytes := ((NumEls - 1) DIV 4) + 1;
                                  BitPacked := True; BitsPerEl := 2;
                                  END
                                ELSE IF (ArrayOf^.Bits = 3) OR (ArrayOf^.Bits =
                                        4) THEN
                                  BEGIN
                                  IF lNumEls >= 32768 THEN
                                    LByteCalc(2)
                                  ELSE
                                    Bytes := ((NumEls - 1) DIV 2) + 1;
                                  BitPacked := True; BitsPerEl := 4;
                                  END;
                            IF Bytes = - 1 THEN
                              BEGIN
                              Error(309);                                      {!6-13-83A.H.}
                              Bytes := 1;
                              END;
                            END;
                FILES:    IF FileOf <> NIL THEN
                            BEGIN
                            Bytes := 600 + FullBytes(FileOf);
                            IF Bytes < 0 {overflowed} THEN Error(309);         {!6-13-83A.H.}
                            END
                          ELSE
                            Bytes := 80; {T = file;}
                STRINGS:  Bytes := StringLen + 1;
              END; {case}
              IF (Bytes <> 1) AND Odd(Bytes) THEN Bytes := Bytes + 1;
              END;
        END; {CalcSize}

      PROCEDURE SimpleType(FSys: SetOfSys; VAR FpT: pT);

        LABEL 10;                                                              {!C}

        VAR
          lValu: Valu;
          lpT: pT;
          lpN, lpN2: pN;
          N, OldTop: Integer;
          lName: Alfa;

        BEGIN {SimpleType}
          FpT := NIL;                                                          {!8-31A.H.}
          IF NOT (Token IN SimpTypeBegSys) THEN Skip(21, FSys + SimpTypeBegSys);
          IF Token IN SimpTypeBegSys THEN
            BEGIN
            IF Token = LPARENSY THEN
              BEGIN
              lpN := NIL; N := 0;
              New(FpT, SCALAR, DECLARED);
              WITH FpT^ DO
                BEGIN
                FType := False; Form := SCALAR; ScalKind := DECLARED;
                END;
              OldTop := Top;
              WHILE Display[Top].Occur = REC DO Top := Top - 1;
              REPEAT
                Scan;
                IF Token = IDENTSY THEN
                  BEGIN
                  New(lpN2, IDENTNODE, CONSTS);
                  WITH lpN2^ DO
                    BEGIN
                    Name := Ident; Next := lpN; IdType := FpT;
                    Class := CONSTS; ValueOf.Ivalu := N;
                    Node := IDENTNODE;
                    END;
                  lpN := lpN2; EnterId(lpN); N := N + 1; Scan;
                  END
                ELSE
                  Error(29);
                IF NOT (Token IN FSys + [COMMASY, RPARENSY]) THEN
                  Skip(20, FSys + [COMMASY, RPARENSY]);
              UNTIL Token <> COMMASY;
              Top := OldTop;
              FpT^.MaxConst := lpN;
              CalcSize(FpT);
              IF Token = RPARENSY THEN
                Scan
              ELSE
                Error(32);
              END
            ELSE IF Token = IDENTSY THEN
              BEGIN
              lName := Ident; Scan;
              IF Token = COLONSY THEN
                BEGIN
                lpN := SearchAll([CONSTS]);
                WITH lpN^ DO
                  IF IdType <> NIL THEN
                    IF IdType^.Form > SUBRANGE THEN
                      Error(143)
                    ELSE IF CompTypes(IdType, RealPtr) THEN Error(108);
                Scan;
                Constant(FSys, lValu, lpT);
                IF lpT <> NIL THEN
                  IF lpT^.Form > SUBRANGE THEN
                    Error(143)
                  ELSE IF CompTypes(lpT, RealPtr) THEN Error(108);
                IF NOT CompTypes(lpT, lpN^.IdType) THEN Error(106);
                New(FpT, SUBRANGE);
                WITH FpT^ DO
                  BEGIN
                  FType := False; Form := SUBRANGE; RangeOf := lpT;
                  Min := lpN^.ValueOf.Ivalu; Max := lValu.Ivalu;
                  IF Min > Max THEN Error(105);
                  END;
                CalcSize(FpT);
                END
              ELSE
                BEGIN
                Ident := lName;
                PrintErrors := False;
                lpN := SearchAll([TYPES]);
                PrintErrors := True;

                {We assume forward references are to classes.  First we check the
                 forward list to see if we already have a forward reference to this
                 type.  if so, we use the dummy type attached, if not we make a dummy
                 identnode and type node for a CLASS}                          {!C}

                IF lpN = NIL THEN
                  BEGIN
                  lpN := ForwCList;
                  WHILE lpN <> NIL DO
                    BEGIN
                    IF Ident = lpN^.Name THEN
                      BEGIN
                      FpT := lpN^.IdType;
                      GOTO 10;
                      END;
                    lpN := lpN^.Next;
                    END;

                  {no dummy declaration yet}

                  New(FpT, CLASSES);
                  New(lpN, IDENTNODE, TYPES);

                  WITH FpT^ DO
                    BEGIN
                    Bytes := 4; Bits := 0;
                    Form := CLASSES; FType := False; ItsId := NIL;
                    ClFields := NIL; ClFstField := NIL; ClFstMethod := NIL;
                    SuperClass := NilClassPtr;                                 {!5-27-83}
                    END;

                  WITH lpN^ DO
                    BEGIN
                    Name := Ident;
                    Next := ForwCList;
                    Class := TYPES; Node := IDENTNODE;
                    IdType := FpT;
                    END;
                  ForwCList := lpN;
                10:
                  END
                ELSE
                  BEGIN
                  IF lpN^.IdType <> NIL THEN                                   {!3-30-83ah}
                    FpT := lpN^.IdType;
                  END;
                                                                               {!C}
                END;
              END
            ELSE
              BEGIN
              New(FpT, SUBRANGE);
              WITH FpT^ DO
                BEGIN
                FType := False; Form := SUBRANGE;
                END;
              Constant(FSys + [COLONSY], lValu, lpT);
              FpT^.Min := lValu.Ivalu; FpT^.RangeOf := lpT;
              IF lpT <> NIL THEN
                IF lpT^.Form > SUBRANGE THEN
                  Error(143)
                ELSE IF CompTypes(lpT, RealPtr) THEN Error(108);
              IF Token = COLONSY THEN
                Scan
              ELSE
                Error(35);
              Constant(FSys, lValu, lpT);
              WITH FpT^ DO
                BEGIN
                Max := lValu.Ivalu;
                IF Max < Min THEN Error(105);
                IF NOT CompTypes(RangeOf, lpT) THEN Error(106);
                END;
              IF lpT <> NIL THEN
                IF lpT^.Form > SUBRANGE THEN
                  Error(143)
                ELSE IF CompTypes(lpT, RealPtr) THEN Error(108);
              CalcSize(FpT);
              END;
            IF NOT (Token IN FSys) THEN Skip(20, FSys);
            END;
        END; {SimpleType}

      PROCEDURE FieldList(FSys: SetOfSys; VAR FfldList: pN; VAR fTagFld: pT);

        VAR
          ExitFlag, Exit2Flag: Boolean;
          lValu: Valu;
          iList, iList2: pIntList;
          lpT, TagPt, VarPt, VarPt2, TagTypePt, VarList: pT;
          lpN, LastpN, GrouppN, TagNamepN: pN;
          lName: Alfa;

        BEGIN {FieldList}
          fTagFld := NIL; FfldList := NIL; GrouppN := NIL; TagTypePt := NIL;
          IF NOT (Token IN FSys + [IDENTSY, CASESY]) THEN
            Skip(26, FSys + [IDENTSY, CASESY]);
          WHILE Token = IDENTSY DO
            BEGIN
            ExitFlag := False;
            REPEAT
              IF Token = IDENTSY THEN
                BEGIN
                New(lpN, IDENTNODE, FIELD);
                IF FfldList = NIL THEN
                  FfldList := lpN
                ELSE
                  LastpN^.Next := lpN;
                IF GrouppN = NIL THEN GrouppN := lpN;
                LastpN := lpN;
                WITH lpN^ DO
                  BEGIN
                  Name := Ident; Next := NIL;
                  Class := FIELD; Node := IDENTNODE;
                  END;
                EnterId(lpN); Scan;
                END
              ELSE
                Error(29);
              IF (Token <> COMMASY) AND (Token <> COLONSY) THEN
                Skip(20, FSys + [COMMASY, COLONSY, SEMISY, CASESY]);
              IF Token = COMMASY THEN
                Scan
              ELSE
                ExitFlag := True;
            UNTIL ExitFlag;
            IF Token = COLONSY THEN
              Scan
            ELSE
              Error(35);
            Typ(FSys + [CASESY, SEMISY], lpT, False, NIL);
            WHILE GrouppN <> NIL DO
              WITH GrouppN^ DO
                BEGIN
                IdType := lpT; GrouppN := Next;
                END;
            IF lpT <> NIL THEN FileFlag := FileFlag OR lpT^.FType;
            IF Token = SEMISY THEN
              BEGIN
              Scan;
              IF NOT (Token IN FSys + [IDENTSY, CASESY]) THEN
                Skip(26, FSys + [IDENTSY, CASESY]);
              END;
            END;
          IF Token = CASESY THEN
            BEGIN
            Scan; New(TagNamepN, IDENTNODE, FIELD); New(TagPt, TAGFIELD);
            WITH TagNamepN^ DO
              BEGIN
              Name := '        '; Next := NIL; Llink := NIL; Rlink := NIL;
              Class := FIELD; IdType := NIL; PckdField := False;
              Node := IDENTNODE;
              END;
            WITH TagPt^ DO
              BEGIN
              FType := False; Form := TAGFIELD;
              TagName := TagNamepN; Variants := NIL;
              END;
            fTagFld := TagPt;
            IF Token = IDENTSY THEN
              BEGIN
              lName := Ident; Scan;
              IF Token = COLONSY THEN
                BEGIN
                Scan;
                IF Token = IDENTSY THEN
                  BEGIN
                  lpN := SearchAll([TYPES]); TagTypePt := lpN^.IdType;
                  WITH TagNamepN^ DO
                    BEGIN
                    IdType := TagTypePt; Name := lName;
                    END;
                  IF FfldList = NIL THEN
                    FfldList := TagNamepN
                  ELSE
                    LastpN^.Next := TagNamepN;
                  EnterId(TagNamepN);
                  Scan;
                  END
                ELSE
                  Skip(29, FSys + [OFSY, LPARENSY]);
                END
              ELSE
                BEGIN
                Ident := lName; lpN := SearchAll([TYPES]);
                TagTypePt := lpN^.IdType; TagNamepN^.IdType := TagTypePt;
                END;
              END
            ELSE
              Skip(29, FSys + [OFSY, LPARENSY]);
            IF TagTypePt <> NIL THEN
              BEGIN
              IF TagTypePt^.Form > SUBRANGE THEN
                Error(109)
              ELSE IF CompTypes(RealPtr, TagTypePt) THEN Error(108);
              FileFlag := FileFlag OR TagTypePt^.FType;
              END;
            IF Token = OFSY THEN
              Scan
            ELSE
              Error(42);
            ExitFlag := False; VarList := NIL;
            REPEAT
              IF NOT (Token IN FSys + [SEMISY] - [IDENTSY]) THEN
                BEGIN
                Exit2Flag := False; iList := NIL;
                REPEAT
                  Constant(FSys + [COMMASY, COLONSY, LPARENSY], lValu, lpT);
                  IF NOT CompTypes(TagTypePt, lpT) THEN
                    Error(110)
                  ELSE
                    BEGIN
                    New(iList2);
                    WITH iList2^ DO
                      BEGIN
                      NextInt := iList; IntVal := lValu.Ivalu;
                      END;
                    iList := iList2;
                    iList2 := iList^.NextInt;
                    WHILE iList2 <> NIL DO
                      BEGIN
                      IF lValu.Ivalu = iList2^.IntVal THEN Error(160);
                      iList2 := iList2^.NextInt;
                      END;
                    VarPt := VarList;
                    WHILE VarPt <> NIL DO
                      BEGIN
                      iList2 := VarPt^.VarValus;
                      WHILE iList2 <> NIL DO
                        BEGIN
                        IF lValu.Ivalu = iList2^.IntVal THEN Error(160);
                        iList2 := iList2^.NextInt;
                        END;
                      VarPt := VarPt^.NextVar;
                      END;
                    END;
                  IF Token = COMMASY THEN
                    Scan
                  ELSE
                    Exit2Flag := True;
                UNTIL Exit2Flag;
                IF Token = COLONSY THEN
                  Scan
                ELSE
                  Error(35);
                IF Token = LPARENSY THEN
                  Scan
                ELSE
                  Error(31);
                FieldList(FSys + [RPARENSY, SEMISY], lpN, VarPt2);
                New(VarPt, VARIANT);
                WITH VarPt^ DO
                  BEGIN
                  FType := False; Form := VARIANT; VarFldLst := lpN;
                  SubVar := VarPt2; VarValus := iList; NextVar := VarList;
                  END;
                VarList := VarPt;
                IF Token = RPARENSY THEN
                  BEGIN
                  Scan;
                  IF NOT (Token IN FSys + [SEMISY]) THEN
                    Skip(20, FSys + [SEMISY]);
                  END
                ELSE
                  Error(32);
                END;
              IF Token = SEMISY THEN
                Scan
              ELSE
                ExitFlag := True;
            UNTIL ExitFlag;
            TagPt^.Variants := VarList;
            END;
        END; {FieldList}

       {!C                          ClassList

        Parses the class type declaration.  Classes are only allowed in the
        interface type declaration section.

                  Id = SUBCLASS OF SuperId
                       [id [, id ]* : type;]*
                       [[PROCEDURE | FUNCTION] id parameterlist ; ]*
                       END;
       !C}

      PROCEDURE ClassList(FSys: SetOfSys; FpT: pT; ThisClass: pN);

        VAR
          npN, lpN, lpN1, LastpN, lFpN, SuperpN, GrouppN, CFields: pN;
          ForwCLst, ForwPLst: pN;
          EvenMethodNumber, OddMethodNumber, KlassLevel, Errs: Integer;
          SuperC, lpT: pT;
          lToken: Symbol;
          ExitFlag, SeenCreate, HigherLevel, Even, EnterIt: Boolean;
          Heap: PBoolean;
          SaveIdent: Alfa;

        BEGIN {ClassList}
          InClassDecl := True;

          IF Token <> OFSY THEN
            Skip(800, FSys + [IDENTSY])
          ELSE
            Scan;

          {Determine superclass pointer}

          IF (Token <> IDENTSY) AND (Token <> NILSY) THEN                      {!9-1A.H.}
            BEGIN
            Skip(801, FSys + [IDENTSY, FUNCTSY, PROCSY]);
            SuperC := NilClassPtr;
            END
          ELSE
            BEGIN
            IF Token = NILSY THEN                                              {!9-1A.H.}
              BEGIN
              SuperpN := NIL;
              SuperC := NilClassPtr;
              END
            ELSE
              BEGIN
              SuperpN := SearchAll([TYPES]);
              IF SuperpN = NIL THEN
                SuperC := NilClassPtr
              ELSE
                BEGIN
                SuperC := SuperpN^.IdType;
                IF SuperC = NIL THEN
                  SuperC := NilClassPtr                                        {!4-5-83}
                ELSE IF SuperC^.Form <> CLASSES THEN                           {!4-5-83}
                  BEGIN
                  Error(807);
                  SuperC := NilClassPtr;
                  END;
                END;
              END;
            Scan;
            END;
                                                                               {!12-27-83 Copy-down deleted}
          {Parse the fields}

          IF NOT (Token IN FSys + [IDENTSY, FUNCTSY, PROCSY]) THEN
            Skip(26, FSys + [IDENTSY, FUNCTSY, PROCSY]);

          GrouppN := NIL;
          CFields := NIL;
          WHILE Token = IDENTSY DO
            BEGIN
            ExitFlag := False;

            REPEAT
              IF Token = IDENTSY THEN
                BEGIN
                New(lpN, IDENTNODE, FIELD);
                IF CFields = NIL THEN
                  CFields := lpN
                ELSE
                  LastpN^.Next := lpN;
                IF GrouppN = NIL THEN GrouppN := lpN;
                LastpN := lpN;
                WITH lpN^ DO
                  BEGIN
                  Name := Ident; Next := NIL;
                  Class := FIELD; Node := IDENTNODE;
                  FOff := - 1;
                  END;
                Errs := Errors;                                                {!C 12-18-83}
                EnterId(lpN);
                IF Errs = Errors THEN                                          {!C 12-18-83}
                  IF SearchClasses(SuperC, HigherLevel, True) <> NIL THEN      {!C 12-27-83}
                    Error(100);                                                {!C 12-18-83}
                Scan;
                END
              ELSE
                Error(29);
              IF (Token <> COMMASY) AND (Token <> COLONSY) THEN
                Skip(20, FSys + [COMMASY, COLONSY, SEMISY, FUNCTSY, PROCSY]);
              IF Token = COMMASY THEN
                Scan
              ELSE
                ExitFlag := True;
            UNTIL ExitFlag;

            IF Token = COLONSY THEN
              Scan
            ELSE
              Error(35);

            Typ(FSys + [FUNCTSY, PROCSY, SEMISY], lpT, False, NIL);
            WHILE GrouppN <> NIL DO
              WITH GrouppN^ DO
                BEGIN
                IdType := lpT; GrouppN := Next;
                END;

            IF Token = SEMISY THEN
              BEGIN
              Scan;
              IF NOT (Token IN FSys + [IDENTSY, FUNCTSY, PROCSY]) THEN
                Skip(26, FSys + [IDENTSY, FUNCTSY, PROCSY]);
              END;
            END;

          {Parse the method heads}

          EvenMethodNumber := 0; OddMethodNumber := 0;                         {!01-03-84}
          KlassLevel := SuperC^.ClassLevel + 2;                                {!12-27-83}
          SeenCreate := False;
          FpT^.ClFstMethod := NIL;                                             {!01-03-84}

          WHILE (Token = PROCSY) OR (Token = FUNCTSY) DO
            BEGIN
            lToken := Token;
            Scan;
            IF Token = IDENTSY THEN                                            {!01-06-84}
              IF ThisClass <> NIL THEN
                IF ThisClass^.Name = Ident THEN
                  BEGIN
                  Scan;
                  IF Token = PERIODSY THEN
                    Scan
                  ELSE
                    Error(51);
                  END;                                                         {!01-06-84}

            Mark(Heap); ForwCLst := ForwCList; ForwPLst := ForwPList;
            EnterIt := False;
            PFHead(FSys + [ENDSY, IDENTSY], lToken, lpN, False, EnterIt,  NIL); {!01-05-84}
            EnterIt := True;

            WITH lpN^ DO
              BEGIN
              PFdecl := FORWMETHDECL;
              IF Token <> IDENTSY THEN
                Even := True                                                   {!01-03-84}
              ELSE
                BEGIN
                Even := False;                                                 {!01-03-84}
                IF Ident = 'ABSTRACT' THEN
                  BEGIN                                                        {!12-27-83}
                  RtnNo := 0; {0 reserved to mean ABSTRACT}
                  PFdecl := METHDECL;
                  END
                ELSE IF Ident = 'OVERRIDE' THEN                                {!01-06-84}
                  BEGIN
                  Ident := Name;
                  lpN1 := SearchClasses(SuperC, HigherLevel, True);
                  IF lpN1 = NIL THEN
                    Error(818)
                  ELSE
                    BEGIN
                    IF NOT CompFormals(lpN1^.PFargList, lpN^.PFargList, True) THEN
                      Error(116);
                    IF lpN1^.IdType <> lpN^.IdType THEN Error(117);
                    ForwCList := ForwCLst; ForwPList := ForwPLst;
                    Release(Heap); {as if declaration wasn't there..I hope!}
                    EnterIt := False;
                    END;
                  END
                ELSE IF Ident <> 'DEFAULT ' THEN
                  Error(20);
                Scan;
                IF Token = SEMISY THEN Scan;
                END;

              IF EnterIt THEN
                BEGIN
                SaveIdent := Ident;
                Ident := Name;
                IF SearchClasses(SuperC, HigherLevel, True) <> NIL THEN
                  Error(100)
                ELSE
                  EnterId(lpN);
                Ident := SaveIdent;
                IF Name = 'CREATE  ' THEN
                  BEGIN
                  SeenCreate := True;
                  MethodNo := 0; MethodLevel := 0;
                  END
                ELSE                                                             {!12-27-83}
                  BEGIN
                  IF Even THEN                                                   {!01-03-84}
                    BEGIN                                                        {!01-03-84}
                    EvenMethodNumber := EvenMethodNumber + 1;                    {!01-03-84}
                    MethodNo := EvenMethodNumber;                                {!01-03-84}
                    MethodLevel := KlassLevel;                                   {!01-03-84}
                    END                                                          {!01-03-84}
                  ELSE                                                           {!01-03-84}
                    BEGIN                                                        {!01-03-84}
                    OddMethodNumber := OddMethodNumber + 1;                      {!01-03-84}
                    MethodNo := OddMethodNumber;                                 {!01-03-84}
                    MethodLevel := KlassLevel+1;                                 {!01-03-84}
                    END;                                                         {!01-03-84}
                  ParmBytes := ParmBytes + 4;
                  lpN1 := PFargList; {reserve space for SELF}
                  WHILE lpN1 <> NIL DO
                    WITH lpN1^ DO
                      BEGIN
                      IF Class = VARS THEN
                        BEGIN {not large value params}
                        IF Voff >= 0 THEN Voff := Voff + 4;
                        END
                      ELSE
                        PFOff := PFOff + 4;
                      lpN1 := Next;
                      END;
                  END;

                Next := NIL;
                InsertMethod(lpN, MethodLevel * 256 + MethodNo, FpT);            {!01-03-84}
                END; {IF EnterIt}
              END; {with lpN^}
            END; {while}

          IF NOT SeenCreate THEN Error(802);

          WITH FpT^ DO
            BEGIN
            Bytes := 0; Bits := 0;
            Form := CLASSES;
            FType := False;
            WasDeclared := (Level < - 1);
            NeedsInit := NOT WasDeclared;
            ClassesToInit := ClassesToInit OR NeedsInit;
            ItsId := NIL;
            ClFields := Display[Top].NameTree;
            ClFstField := CFields;
            {ClFstMethod := <built by InsertMethod above>}
            SuperClass := SuperC;
            TotalOrder := NIL;
            LastEvenMethod := EvenMethodNumber; LastOddMethod := OddMethodNumber;
            ClassLevel := KlassLevel; {0, 2, 4 ... }                           {!12-27-83}
            CrProc := NIL;                                                     {!12-27-83}
            MethodLev := - 1; MethodOff := -1;                                 {!12-27-83}
            END;

          FileFlag := False;
          InClassDecl := False;
        END; {ClassList}

      BEGIN {Typ}
        FpT := IntPtr; {in case of error, type is defaulted to integer (cheap)} {!3-30-83ah}
        IF NOT (Token IN TypeBegSys) THEN Skip(25, FSys + TypeBegSys);
        ClassAllowed := ClassAllowed AND (Token = SUBCLSY);                    {!C}
        IF Token IN TypeBegSys THEN
          BEGIN
          IF Token IN SimpTypeBegSys THEN
            SimpleType(FSys, FpT)
          ELSE IF Token = UPARROWSY THEN
            BEGIN { ^ }
            Scan;
            IF Token = IDENTSY THEN
              BEGIN
              New(FpT, POINTERS);
              WITH FpT^ DO
                BEGIN
                Form := POINTERS; PointerTo := NIL; FType := False;
                END;
              PrintErrors := False;
              lpN := SearchAll([TYPES]);
              PrintErrors := True;
              IF lpN = NIL THEN
                BEGIN
                New(lpN, IDENTNODE, TYPES);
                WITH lpN^ DO
                  BEGIN
                  Name := Ident; IdType := FpT;
                  Class := TYPES; Next := ForwPList;
                  Node := IDENTNODE;
                  END;
                ForwPList := lpN;
                END
              ELSE
                FpT^.PointerTo := lpN^.IdType;
              CalcSize(FpT);
              Scan;
              END
            ELSE
              Error(29);
            END { ^ }
          ELSE
            BEGIN
            PackedFlag := Token = PACKEDSY;
            IF PackedFlag THEN Scan;
            IF Token = ARRAYSY THEN
              BEGIN {ARRAY}
              Scan;
              New(FpT, ARRAYS);
              WITH FpT^ DO
                BEGIN
                Form := ARRAYS; ArrayOf := NIL;
                PckdArr := PackedFlag; BitPacked := False;
                END;
              lpT := FpT;
              IF Token = LBRACKSY THEN
                Scan
              ELSE
                Error(33);
              ExitFlag := False;
              REPEAT
                SimpleType(FSys + [COMMASY, RBRACKSY, OFSY], lpT2);
                IF lpT2 <> NIL THEN
                  IF lpT2^.Form > SUBRANGE THEN
                    Error(112)
                  ELSE IF CompTypes(lpT2, RealPtr) THEN
                    Error(111)
                  ELSE IF (lpT2 = IntPtr) OR (lpT2 = LIntPtr) THEN             {!6-23-83}
                    Error(113)
                  ELSE IF lpT2^.Form = SUBRANGE THEN
                    IF (lpT2^.Max - lpT2^.Min) > 32768 THEN Error(311);        {!6-23-83}
                lpT^.IndexedBy := lpT2;
                IF Token = COMMASY THEN
                  BEGIN
                  New(lpT3, ARRAYS); lpT3^.ArrayOf := lpT; lpT := lpT3;
                  WITH lpT^ DO
                    BEGIN
                    Form := ARRAYS; PckdArr := PackedFlag; BitPacked := False;
                    END;
                  Scan;
                  END
                ELSE
                  ExitFlag := True;
              UNTIL ExitFlag;
              IF Token = RBRACKSY THEN
                Scan
              ELSE
                Error(34);
              IF Token = OFSY THEN
                Scan
              ELSE
                Error(42);
              Typ(FSys, lpT2, False, NIL);
              REPEAT
                lpT3 := lpT^.ArrayOf; lpT^.ArrayOf := lpT2;
                IF lpT2 <> NIL THEN lpT^.FType := lpT2^.FType;
                lpT2 := lpT; lpT := lpT3;
                CalcSize(lpT2);
              UNTIL lpT = NIL;
              END {ARRAY}
            ELSE IF Token = FILESY THEN
              BEGIN {FILE}
              New(FpT, FILES);
              WITH FpT^ DO
                BEGIN
                FType := True; Form := FILES; PckdFile := PackedFlag;
                END;
              Scan;
              IF Token IN FSys THEN
                FpT^.FileOf := NIL
              ELSE
                BEGIN
                IF Token = OFSY THEN
                  Scan
                ELSE
                  Error(42);
                Typ(FSys, lpT, False, NIL); FpT^.FileOf := lpT;
                END;
              CalcSize(FpT);
              END {FILE}
            ELSE IF Token = RECORDSY THEN
              BEGIN {RECORD}
              OldTop := Top;
              IF Top < MAXDISPLAY THEN
                BEGIN
                Top := Top + 1;
                WITH Display[Top] DO
                  BEGIN
                  NameTree := NIL; Occur := REC;
                  END;
                END
              ELSE
                Error(300);
              Scan; FileFlag := False;
              FieldList(FSys - [SEMISY] + [ENDSY], lpN, lpT2);
              New(FpT, RECORDS);
              WITH FpT^ DO
                BEGIN
                Form := RECORDS; FType := FileFlag; PckdRec := PackedFlag;
                Fields := Display[Top].NameTree; VarPart := lpT2;
                FstField := lpN;
                END;
              Top := OldTop;
              IF Token = ENDSY THEN
                Scan
              ELSE
                Error(44);
              CalcSize(FpT);
              END {RECORD}
            ELSE IF Token = SETSY THEN
              BEGIN {SET}
              Scan;
              IF Token = OFSY THEN
                Scan
              ELSE
                Error(42);
              SimpleType(FSys, lpT);
              New(FpT, SETS);
              WITH FpT^ DO
                BEGIN
                Form := SETS; FType := False; SetOf := lpT;
                END;
              IF lpT <> NIL THEN
                IF lpT^.Form > SUBRANGE THEN
                  Error(109)
                ELSE IF lpT = LIntPtr THEN
                  Error(301)
                ELSE IF CompTypes(lpT, RealPtr) THEN
                  Error(108)
                ELSE
                  BEGIN
                  IF lpT^.Form = SUBRANGE THEN
                    BEGIN
                    IF (lpT^.Min < 0) OR (lpT^.Max > 4087) THEN                {!6-23-83}
                      Error(301);
                    END
                  ELSE
                    BEGIN
                    GetBounds(lpT, Min, Max);
                    IF Max > 4087 THEN Error(301);
                    END;
                  END;
              CalcSize(FpT);
              END {SET}
            ELSE IF Token = STRINGSY THEN
              BEGIN {STRING}
              Scan;
              IF Token = LBRACKSY THEN
                Scan
              ELSE
                Error(33);
              Constant(FSys + [RBRACKSY], lValu, lpT);
              IF lpT <> IntPtr THEN
                Error(107)
              ELSE IF (lValu.Ivalu <= 0) OR (lValu.Ivalu > 255) THEN Error(302);
              New(FpT, STRINGS);
              WITH FpT^ DO
                BEGIN
                FType := False; Form := STRINGS;
                StringLen := lValu.Ivalu;
                END;
              IF Token = RBRACKSY THEN
                Scan
              ELSE
                Error(34);
              CalcSize(FpT);
              END {STRING}
            ELSE IF Token = SUBCLSY THEN                                       {!C}
              BEGIN {SUBCLASS}
              IF NOT ClassAllowed THEN Error(803);
              ClassAllowed := False;

              OldTop := Top;
              IF Top < MAXDISPLAY THEN
                BEGIN
                Top := Top + 1;
                WITH Display[Top] DO
                  BEGIN
                  NameTree := NIL; Occur := KLASS; KType := NIL;
                  WVar := NIL;                                                 {!C 12-14-83}
                  END;
                END
              ELSE
                Error(300);
              Scan;
              FileFlag := False;
              New(FpT, CLASSES);
              ClassList(FSys - [SEMISY] + [ENDSY], FpT, ThisClass);            {!01-06-84}
              Top := OldTop;
              IF Token = ENDSY THEN
                Scan
              ELSE
                Error(44);
              CalcSize(FpT);
              END {SUBCLASS}                                                   {!C}
            ELSE
              Skip(25, FSys);
            END;
          IF NOT (Token IN FSys) THEN Skip(20, FSys);
          END; {Token IN TypeBegSys}
      END; {Typ}

    PROCEDURE IntriDecl;                                                       {!IU begin!}

      BEGIN {IntriDecl}
        FpN^.Ukind := INTRUNIT;
        IF Token = IDENTSY THEN
          BEGIN
          IF Ident = 'CODE    ' THEN
            BEGIN
            Scan; Scan; {skip 'CODE' and integer}
            END;
          END;
        IF (Token = IDENTSY) AND (Ident = 'SHARED  ') THEN
          BEGIN
          FpN^.Ukind := SHARUNIT;
          Scan;
          END;
        IF Token = IDENTSY THEN
          BEGIN
          IF Ident = 'DATA    ' THEN
            BEGIN
            Scan; Scan; {skip 'DATA' and integer}
            END;
          END;
        IF Token = SEMISY THEN
          Scan
        ELSE
          Error(36);
        IF Token = INTERSY THEN
          Scan
        ELSE
          Error(53);
      END; {IntriDecl}                                                         {!IU end}

    PROCEDURE UsesDecl(FSys: SetOfSys);

      LABEL 9;

      VAR
        ExitFlag, LibFound: Boolean;
        lpN: pN;
        DummyHeap: PBoolean;
        OldLevel, i, pCurL, EndOfLine: Integer;
        lNameTree: pN;                                                         {!DBG!}
        lCh: Char;
        lToken: Symbol;
        lIdent: Alfa;
        lIntVal: LongInt;
        lRealVal: Real;
        lStrVal: StrValType;

      FUNCTION FindUnit(FName: Alfa; Start: LongInt): Boolean;

        LABEL 5;

        VAR
          lBlock, lByte, Junk, i, Size, TextAddr: Integer;
          FoundIt: Boolean;
          lBuff: PACKED ARRAY [0..511] OF Char;
          lCh: Char;
          sBlock: Integer; (* save for setting pointers *)

        FUNCTION NextByte: Integer;

          VAR
            i: Integer;

          BEGIN {NextByte}
            IF lByte > 511 THEN
              BEGIN
              lBlock := lBlock + lByte DIV 512; lByte := lByte MOD 512;
              IF BlockRead(OpenFileStack[TopOfOpenFileStack].SrcFile, lBuff, 1,
                           lBlock) <> 1 THEN
                Error(404);
              END;
            i := Ord(lBuff[lByte]); lByte := lByte + 1;
            IF i < 0 THEN i := i + 256;
            NextByte := i;
          END; {NextByte}

        FUNCTION NextInt(N: Integer): Integer;

          VAR
            i, k: Integer;

          BEGIN {NextInt}
            k := 0;
            FOR i := 1 TO N DO k := k * 256 + NextByte;
            NextInt := k;
          END; {NextInt}

        BEGIN {FindUnit}
          IF Start = 0 THEN
            BEGIN
            lBlock := - 1; lByte := 512; i := NextByte;
            END
          ELSE
            BEGIN
            lBlock := Start DIV 512; lByte := Start MOD 512;
            IF BlockRead(OpenFileStack[TopOfOpenFileStack].SrcFile, lBuff, 1,
                         lBlock) <> 1 THEN
              Error(404);
            sBlock := lBlock;
            i := NextByte;
            END;
          IF i = 144 THEN {Library file}
            WHILE i = 144 DO
              BEGIN
              Size := NextInt(3); FoundIt := True;
              FOR i := 1 TO 8 DO
                IF FName[i] <> Chr(NextByte) THEN FoundIt := False;
              IF FoundIt THEN
                BEGIN
                Junk := NextInt(4); Junk := NextInt(4);
                TextAddr := NextInt(3) DIV 2; {pick up 3 of 4 bytes and divide by
                                               2 to convert bytes to blocks}
                FileSeek(TextAddr); FillInbuf;
                IF Ord(Inbuf[InbufP]) > 127 THEN                               {!01-05-84}
                  BEGIN
                  lpN^.HasClasses := True;
                  Inbuf[InbufP] := Chr(Ord(Inbuf[InbufP]) - 128);
                  END;
                Ch := ' '; EolSource := True; Scan;
                GOTO 5;
                END;
              lByte := lByte + Size - 12; i := NextByte;
              END {while}
          ELSE IF (i = 146) AND (Start = 0) THEN
            BEGIN {unlinked Unit file}
            Junk := NextInt(3); FoundIt := True;
            FOR i := 1 TO 8 DO IF FName[i] <> Chr(NextByte) THEN FoundIt := False;
            IF FoundIt THEN
              BEGIN
              Junk := NextInt(4); TextAddr := NextInt(3) DIV 2;
              FileSeek(TextAddr); FillInbuf;
              IF Ord(Inbuf[InbufP]) > 127 THEN                                 {!01-05-84}
                BEGIN
                lpN^.HasClasses := True;
                Inbuf[InbufP] := Chr(Ord(Inbuf[InbufP]) - 128);
                END;
              Ch := ' '; EolSource := True; Scan;
              END;
            END {if}
          ELSE IF (i = $99) {named in source} OR (i = $92) {*intrinsic.lib
                                                            indirect} THEN
            BEGIN {I.U. Library file}
            FoundIt := False;
            REPEAT
              Size := NextInt(3);
              IF i = $92 THEN
                BEGIN
                FoundIt := True;
                FOR i := 1 TO 8 DO
                  BEGIN
                  lCh := Chr(NextByte);
                  IF FName[i] <> lCh THEN FoundIt := False;
                  END;
                IF FoundIt THEN
                  IF Size > 30 THEN
                    BEGIN {is there an interface}
                    Junk := NextInt(4); Junk := NextInt(4);
                    Junk := NextInt(4); Junk := NextInt(4); Junk := NextInt(2);
                    FileSeek(sBlock); FillInbuf;
                    IF lBlock = sBlock THEN
                      InbufP := lByte
                    ELSE
                      InbufP := lByte + 512;
                    IF Ord(Inbuf[InbufP]) > 127 THEN                           {!01-05-84}
                      BEGIN
                      lpN^.HasClasses := True;
                      Inbuf[InbufP] := Chr(Ord(Inbuf[InbufP]) - 128);
                      END;
                    Ch := ' '; EolSource := True; Scan;
                    GOTO 5;
                    END
                  ELSE
                    BEGIN {No Interface in Unit Block}
                    FoundIt := False;
                    GOTO 5;
                    END;
                Size := Size - 8;
                END; {if i = $92}
              lByte := lByte + Size - 4;
              i := NextByte; {always word aligned, so can't cross blocks}
              sBlock := lBlock;
            UNTIL FoundIt OR (i = $00); {EOFMark}
            END
          ELSE
            FoundIt := False;
        5:
          FindUnit := FoundIt;
        END; {FindUnit}

      {$ifc IULIB}

      PROCEDURE ReadInterface(FName: Str80; fLoc: LongInt);

        BEGIN {ReadInterface}
          IF OpenNewFile(FName, USED) THEN
            BEGIN
            IF FindUnit(lpN^.Name, fLoc) THEN
              BEGIN
              Declarations(FSys + [IMPLESY], USESSY, lpN, DummyHeap, NIL);
              LibFound := True;
              END;
            PreviousFile;
            END;
        END; {ReadInterface}

      {$endc}

      BEGIN {UsesDecl - the following code is written the way it is to get the
             line containing the USES to precede the included source}
        OldLevel := Level;
        ExitFlag := False;

        REPEAT
          IF Token = IDENTSY THEN
            IF NOT Using THEN
              BEGIN {have use name identifier here}
              lpN := SearchLocal(Display[1].NameTree);
              IF lpN = NIL THEN
                BEGIN
                IF NumUnits < MAXUNITS THEN
                  NumUnits := NumUnits + 1
                ELSE
                  Error(307);
                Level := - NumUnits;
                New(lpN, IDENTNODE, UNITS);
                WITH lpN^ DO
                  BEGIN
                  Node := IDENTNODE; Name := Ident; Next := UnitList;
                  Class := UNITS; Ulev := Level; ULc := 0;
                  Ukind := REGUNIT; HasClasses := False;
                  END;
                lNameTree := Display[Top].NameTree;
                Display[Top].NameTree := NIL;
                EnterId(lpN);
                UnitList := lpN;

                Scan; {should get COMMASY or SEMISY}
                lCh := Ch; lToken := Token; lIdent := Ident;
                lIntVal := IntVal; lRealVal := RealVal; lStrVal := StrVal;
                pCurL := pCurLine;
                IF NOT EolSource THEN
                  BEGIN {collect rest of line for listing and for errors}
                  i := InbufP;
                  WHILE Inbuf[i] <> Chr(13) DO
                    BEGIN
                    pCurLine := pCurLine + 1; CurLine[pCurLine] := Inbuf[i];
                    i := i + 1;
                    END;
                  END; {collecting line}
                EndOfLine := pCurLine;

                IF Listing THEN
                  ListLine(TotalLines)
                ELSE
                  BEGIN
                  TotalLines := TotalLines + 1; LinePrinted := True;
                  END;
                pCurLine := pCurL; {to get errors to point right!}

                Using := True;
                LibFound := False;

                (*$IFC IULIB *)
                IF SearchLibrary THEN
                  IntrinIndirect(IULibIn, FpN^.Name, ReadInterface, lpN^.Name);
                (*$ENDC *)

                IF NOT LibFound THEN
                  IF OpenNewFile(UFname, USED) THEN
                    BEGIN
                    IF FindUnit(lpN^.Name, 0) THEN
                      Declarations(FSys + [IMPLESY], USESSY, lpN, DummyHeap, NIL)
                    ELSE
                      Error(190);
                    PreviousFile;
                    END
                  ELSE
                    BEGIN {OpenNewFile failed}
                    IF IOResult > 0 THEN
                      BEGIN
                      Error(403);
                      GOTO 9;
                      END;{other errors handled by OpenNewFile}
                    END;
                Display[Top].NameTree := lNameTree;
                UnitsToInit := UnitsToInit OR lpN^.HasClasses;                 {!01-05-84}
              9:
                Mark(DummyHeap);
                lpN^.Utop := DummyHeap;
                Ch := lCh; Token := lToken; Ident := lIdent;
                IntVal := lIntVal; RealVal := lRealVal; StrVal := lStrVal;
                pCurLine := EndOfLine; CurLine[0] := Chr(pCurLine);
                IF ErrIndex > 0 THEN ListErrors;
                pCurLine := pCurL;
               END; {IF lpN = NIL ...}

              Using := False;
              IF NOT (Token IN FSys + [COMMASY, SEMISY]) THEN
                Skip(20, FSys + [COMMASY, SEMISY]);
              END {NOT Using}
            ELSE
              Scan
          ELSE
            Skip(29, FSys + [COMMASY, SEMISY]);

          IF Token = COMMASY THEN
            Scan
          ELSE
            ExitFlag := True;
        UNTIL ExitFlag;

        IF Token = SEMISY THEN
          Scan
        ELSE
          ExitFlag := True;
        Level := OldLevel;
      END; {UsesDecl}

    PROCEDURE LabelDecl(FSys: SetOfSys);

      VAR
        ExitFlag: Boolean;
        lpLabRec: pLabRec;

      BEGIN {LabelDecl}
        ExitFlag := False;
        REPEAT
          IF Token = ICONSTSY THEN
            BEGIN
            IF IntVal >= 10000 THEN Error(173);
            lpLabRec := Display[Level].Labels;
            WHILE lpLabRec <> NIL DO
              WITH lpLabRec^ DO
                BEGIN
                IF IntVal = LabelNo THEN Error(156);
                lpLabRec := NextLabel;
                END;
            New(lpLabRec);
            WITH lpLabRec^ DO
              BEGIN
              NextLabel := Display[Level].Labels;
              LabelNo := IntVal; Defined := False; GlobRefNo := - 1;
              END;
            Display[Level].Labels := lpLabRec;
            Scan;
            END
          ELSE
            Error(30);
          IF NOT (Token IN FSys + [COMMASY, SEMISY]) THEN
            Skip(20, FSys + [COMMASY, SEMISY]);
          IF Token = COMMASY THEN
            Scan
          ELSE
            ExitFlag := True;
        UNTIL ExitFlag;
        IF Token = SEMISY THEN
          Scan
        ELSE
          Error(36);
      END; {LabelDecl}

    PROCEDURE ConstDecl(FSys: SetOfSys);

      VAR
        lpN: pN;
        lpT: pT;
        lValu: Valu;

      BEGIN {ConstDecl}
        IF Token <> IDENTSY THEN Skip(29, FSys + [IDENTSY]);
        WHILE Token = IDENTSY DO
          BEGIN
          New(lpN, IDENTNODE, CONSTS);
          WITH lpN^ DO
            BEGIN
            Name := Ident; Next := NIL; Class := CONSTS; Node := IDENTNODE;
            END;
          Scan;
          IF Token = EQSY THEN
            Scan
          ELSE
            Error(37);
          Constant(FSys + [SEMISY], lValu, lpT);
          WITH lpN^ DO
            BEGIN
            IdType := lpT; ValueOf := lValu;
            END;
          EnterId(lpN);
          IF Token = SEMISY THEN
            BEGIN
            Scan;
            IF NOT (Token IN FSys + [IDENTSY]) THEN Skip(20, FSys + [IDENTSY]);
            END
          ELSE
            Error(36);
          END;
      END; {ConstDecl}

    PROCEDURE TypeDecl(FSys: SetOfSys);

      LABEL 10;                                                                {!C}

      VAR
        lpN, lpN2, lpN3: pN;
        lpT: pT;
                                                                               {!C}
        OrderPt: pT;
        NotEquate, BadCreate: Boolean;
                                                                               {!C}

      BEGIN {TypeDecl}
        IF Token <> IDENTSY THEN Skip(29, FSys + [IDENTSY]);
        WHILE Token = IDENTSY DO
          BEGIN
          New(lpN, IDENTNODE, TYPES);
          WITH lpN^ DO
            BEGIN
            Name := Ident; Next := NIL; Class := TYPES; Node := IDENTNODE;
            END;
          Scan;
          IF Token = EQSY THEN
            Scan
          ELSE
            Error(37);
          NotEquate := Token <> IDENTSY;                                       {!C}
          Typ(FSys + [SEMISY], lpT, InterFlag OR InUses, lpN);                 {!C}
          lpN^.IdType := lpT;

          {Check for forward class reference. On the first such reference, we
           create a dummy class identnode and type node.  Since all variables will
           point to this type node, we must copy in the info from the CLASSES type
           node just built by Typ.}

          IF lpT^.Form = CLASSES THEN                                          {!C}
            BEGIN
            lpN2 := ForwCList;
            WHILE lpN2 <> NIL DO
              BEGIN
              IF lpN^.Name = lpN2^.Name THEN
                BEGIN
                IF lpN2 = ForwCList THEN
                  ForwCList := ForwCList^.Next
                ELSE
                  lpN3^.Next := lpN2^.Next;
                WITH lpN2^.IdType^ DO
                  BEGIN
                  Marked := lpT^.Marked;
                  FType := lpT^.FType;
                  Form := lpT^.Form;
                  WasDeclared := lpT^.WasDeclared; NeedsInit := lpT^.NeedsInit;
                  SuperClass := lpT^.SuperClass;
                  LastEvenMethod := lpT^.LastEvenMethod;
                  LastOddMethod := lpT^.LastOddMethod;
                  ClFields := lpT^.ClFields;
                  ClFstField := lpT^.ClFstField;
                  ClFstMethod := lpT^.ClFstMethod;
                  MethodOff := lpT^.MethodOff;
                  MethodLev := lpT^.MethodLev;
                  SizeInstance := lpT^.SizeInstance;
                  ClassLevel := lpT^.ClassLevel;                               {!12-27-83}
                  CrProc := lpT^.CrProc;                                       {!12-27-83}
                  MethodLev := lpT^.MethodLev;                                 {!12-27-83}
                  MethodOff := lpT^.MethodOff;                                 {!12-27-83}
                  lpT := lpN2^.IdType;
                  END;
                GOTO 10;
                END
              ELSE
                lpN3 := lpN2;
              lpN2 := lpN2^.Next;
              END;
          10:
            lpN^.IdType := lpT;

            IF NotEquate THEN
              BEGIN
              lpT^.ItsId := lpN;
              WITH lpT^.SuperClass^ DO
                BEGIN
                lpT^.TotalOrder := TotalOrder;
                TotalOrder := lpT;
                END;
              END;
            END
          ELSE
            BEGIN
            lpN2 := ForwPList;
            WHILE lpN2 <> NIL DO
              BEGIN
              IF lpN2^.Name = lpN^.Name THEN
                BEGIN
                lpN2^.IdType^.PointerTo := lpN^.IdType;
                IF lpN2 = ForwPList THEN
                  ForwPList := ForwPList^.Next
                ELSE
                  lpN3^.Next := lpN2^.Next;
                END
              ELSE
                lpN3 := lpN2;
              lpN2 := lpN2^.Next;
              END;
            END;
          EnterId(lpN);

          IF (lpT^.Form = CLASSES) AND NotEquate THEN
            BEGIN
            Ident := 'CREATE  ';
            lpN := SearchLocal(lpT^.ClFields);
            BadCreate := False;
            IF lpN <> NIL THEN {check out 'CREATE'}
              WITH lpN^ DO
                BEGIN
                BadCreate := True;
                IF Class = FUNC THEN
                  IF IdType <> NIL THEN BadCreate := IdType <> lpT;
                END;
            IF BadCreate THEN Error(811);
            END;
                                                                               {!C}
          IF Token = SEMISY THEN
            BEGIN
            Scan;
            IF NOT (Token IN FSys + [IDENTSY]) THEN Skip(20, FSys + [IDENTSY]);
            END
          ELSE
            Error(36);
          END; {while}

        IF ForwPList <> NIL THEN
          WHILE ForwPList <> NIL DO
            BEGIN
            NError(114, ForwPList^.Name); ForwPList := ForwPlist^.Next;
            END;

        IF ForwCList <> NIL THEN                                               {!C}
          WHILE ForwCList <> NIL DO
            BEGIN
            NError(114, ForwCList^.Name); ForwCList := ForwClist^.Next;
            END;
      END; {TypeDecl}

    PROCEDURE VarDecl(FSys: SetOfSys);

      VAR
        ExitFlag: Boolean;
        lpN, lpN2: pN;
        lpT: pT;
        lLc: Integer;
        lpTSize: Integer;

      BEGIN {VarDecl}
        IF FpN^.Class = UNITS THEN
          lLc := - FpN^.ULc
        ELSE
          lLc := - FpN^.Lc;
        REPEAT
          ExitFlag := False; lpN2 := NIL;
          REPEAT
            IF Token = IDENTSY THEN
              BEGIN
              New(lpN, IDENTNODE, VARS);
              WITH lpN^ DO
                BEGIN
                InRegister := - 1;                                             {!OPT!}
                Name := Ident; Next := lpN2; Class := VARS; IdType := NIL;
                Vlev := Level; Voff := 0; Vkind := DRCT; Node := IDENTNODE;
                IsSELF := False;                                               {!C}
                UNIVflag := False;                                             {!04-14-84}
                END;
              EnterId(lpN); lpN2 := lpN; Scan;
              END
            ELSE
              Error(29);
            IF NOT (Token IN FSys + [COMMASY, COLONSY] + TypeDels) THEN
              Skip(20, FSys + [COMMASY, COLONSY, SEMISY] + TypeDels);
            IF Token = COMMASY THEN
              Scan
            ELSE
              ExitFlag := True;
          UNTIL ExitFlag;
          IF Token = COLONSY THEN
            Scan
          ELSE
            Error(35);
          Typ(FSys + [SEMISY] + TypeDels, lpT, False, NIL);                    {!C}
          IF lpT <> NIL THEN
            BEGIN
            lpTSize := FullBytes(lpT);
            WHILE lpN2 <> NIL DO
              WITH lpN2^ DO
                BEGIN
                IdType := lpT;
                IF lpTSize <> 1 THEN IF Odd(lLc) THEN lLc := lLc - 1;
                lLc := lLc - lpTSize; Voff := lLc;
                IF lLc >= 0 {wraparound in 32K space} THEN
                  BEGIN                                                        {!6-13-83A.H.}
                  IF Level > 1 THEN
                    Error(312)
                  ELSE
                    Error(313);
                  lLc := 0;
                  END;
                lpN2 := Next;
                END;
            END;
          IF Token = SEMISY THEN
            BEGIN
            Scan;
            IF NOT (Token IN FSys + [IDENTSY]) THEN Skip(20, FSys + [IDENTSY]);
            END
          ELSE
            Error(36);
        UNTIL (Token <> IDENTSY) AND NOT (Token IN TypeDels);
        IF Odd(lLc) THEN lLc := lLc - 1;
        IF FpN^.Class = UNITS THEN
          FpN^.ULc := - lLc
        ELSE
          FpN^.Lc := - lLc;

        IF ForwPList <> NIL THEN
          WHILE ForwPList <> NIL DO
            BEGIN
            NError(115, ForwPList^.Name); ForwPList := ForwPlist^.Next;
            END;

        IF ForwCList <> NIL THEN                                               {!C}
          WHILE ForwCList <> NIL DO
            BEGIN
            NError(115, ForwCList^.Name); ForwCList := ForwClist^.Next;
            END;
      END; {VarDecl}

    PROCEDURE PFHead{fsys: setofsys; ftoken: symbol; var fpn: pn;
                     FormalFlag, EnterIt: Boolean; ClasspT: pT};               {!C}

      VAR
        lpN: pN;
        ForwFlag, HigherLevel, lUNIVflag: Boolean;                             {!04-14-84}
        OldTop, OldLevel: LevRange;
        pList: pN;
        FuncType: pT;
        pBytes, Errs: Integer;
        lSys: SetOfSys;
        Heap: PBoolean;

      PROCEDURE Override(VAR FpN: pN);                                         {!C 12-14-83}

        VAR
          OldTop, OldLevel, Errs: Integer;
          lpN, lFpN, LastApN, npN: pN;

        BEGIN {Override - have a overridden proc so add it to current class chain}
          OldTop := Top;
          OldLevel := Level;
          IF (Top + 1) < MAXDISPLAY THEN
            BEGIN
            Top := Top + 1;
            WITH Display[Top] DO
              BEGIN
              NameTree := ClasspT^.ClFields;
              Occur := KLASS; KType := NIL; WVar := NIL;
              END;
            END
          ELSE
            Error(303);
          New(lFpN, IDENTNODE, PROC, DECLARED);
          InsertMethod(lFpN, FpN^.MethodLevel * 256 + FpN^.MethodNo, ClasspT);
          WITH lFpN^ DO
            BEGIN
            Name := FpN^.Name;
            Class := FpN^.Class; IdType := FpN^.IdType;
            PFdeclKind := FpN^.PFdeclKind; PFdecl := FORWMETHDECL;
            PFargList := NIL; PFlev := FpN^.PFlev;                             {!4-14-83}
            Node := IDENTNODE;
            RtnNo := LocProcNo; LocProcNo := LocProcNo + 1;
            MethodNo := FpN^.MethodNo; MethodLevel := FpN^.MethodLevel;
            Lc := FpN^.Lc; ParmBytes := FpN^.ParmBytes;
            END;
          Errs := Errors; {we must know if EnterId reports an error}
          EnterId(lFpN);
          IF Errors = Errs THEN ClasspT^.ClFields := Display[Top].NameTree;
          IF Level <= 0 THEN
            Level := 2
          ELSE IF Level < MAXLEVEL THEN
            Level := Level + 1
          ELSE
            Error(303);
          Top := Top + 1;
          WITH Display[Top] DO
            BEGIN
            NameTree := NIL;
            Occur := PARAMS;
            END;
          lpN := FpN^.PFargList;
          LastApN := NIL;
          WHILE lpN <> NIL DO
            BEGIN
            IF lpN^.Class = VARS THEN
              BEGIN
              New(npN, IDENTNODE, VARS);
              WITH npN^ DO
                BEGIN
                IsSELF := False;
                UNIVflag := False;                                             {!04-14-84}
                Vkind := lpN^.Vkind;
                InRegister := - 1;
                Vlev := lpN^.Vlev;
                Voff := lpN^.Voff;
                END;
              END
            ELSE {formal proc or func parameter}
              BEGIN
              New(npN, IDENTNODE, PROC);
              WITH npN^ DO
                BEGIN
                PFdeclKind := lpN^.PFdeclKind;
                PFlev := lpN^.PFlev;
                PFargList := lpN^.PFargList;
                PFdecl := lpN^.PFdecl;
                PFOff := lpN^.PFOff;
                END;
              END;
            WITH npN^ DO
              BEGIN
              Node := IDENTNODE;
              Name := lpN^.Name;
              IdType := lpN^.IdType;
              Class := lpN^.Class;                                             {!2-14-83}
              Next := NIL;
              IF LastApN <> NIL THEN LastApN^.Next := npN;
              LastApN := npN;
              END;
            EnterId(npN);
            lpN := lpN^.Next;
            END;
          lFpN^.PFargList := Display[Top].NameTree;
          Top := OldTop;
          Level := OldLevel;
          FpN := lFpN;
        END; {Override}                                                        {!C 12-14-83}

      FUNCTION GetAType: pT;                                                   {!C}

        LABEL 10;

        VAR
          lpN: pN;
          FpT: pT;

        BEGIN {GetAType}
          IF InClassDecl THEN PrintErrors := False;
          lpN := SearchAll([TYPES]);
          IF InClassDecl THEN PrintErrors := True;

          {We assume forward references are to classes, so we make a dummy
           IDENTNODE and type node for a CLASS}

          IF lpN = NIL THEN
            BEGIN
            lpN := ForwCList;
            WHILE lpN <> NIL DO
              BEGIN
              IF Ident = lpN^.Name THEN
                BEGIN
                FpT := lpN^.IdType;
                GOTO 10;
                END;
              lpN := lpN^.Next;
              END;

            {No dummy declaration yet}

            New(FpT, CLASSES);
            WITH FpT^ DO
              BEGIN
              Bytes := 4; Bits := 0;
              Form := CLASSES;
              FType := False;
              ClFields := NIL;
              ClFstField := NIL;
              ClFstMethod := NIL;
              SuperClass := NIL;
              END;
            New(lpN, IDENTNODE, TYPES);
            WITH lpN^ DO
              BEGIN
              Name := Ident;
              Next := ForwCList;
              Class := TYPES; Node := IDENTNODE;
              IdType := FpT;
              END;
            ForwCList := lpN;
          10:
            END
          ELSE
            FpT := lpN^.IdType;

          GetAType := FpT;
        END; {GetAType}

      PROCEDURE ParameterList(FSys, fSy: SetOfSys; VAR PARAMS: pN;
                              VAR pBytes: Integer);

        VAR
          ExitFlag, LargeValue: Boolean;
          lKind: AccessKind;
          lToken: Symbol;
          OldLastpN, LastpN, lLpN: pN;
          FrameLLc, lLc, lpTSize: Integer;
          lpT: pT;

        BEGIN {ParameterList}
          PARAMS := NIL; LastpN := NIL; lLc := 0; FrameLLc := 0;
          IF NOT (Token IN fSy + [LPARENSY]) THEN
            Skip(23, FSys + fSy + [LPARENSY]);
          IF Token = LPARENSY THEN
            BEGIN
            {IF ForwFlag THEN Error(116);}                                     {!01-06-84}
            Scan;
            IF (Token <> IDENTSY) AND (Token <> VARSY) AND (Token <> FUNCTSY) AND
               (Token <> PROCSY) THEN
              Skip(23, FSys + [IDENTSY, RPARENSY, VARSY, FUNCTSY, PROCSY]);
            WHILE (Token = IDENTSY) OR (Token = VARSY) OR (Token = FUNCTSY) OR
                  (Token = PROCSY) DO
              BEGIN
              OldLastpN := LastpN; lpT := NIL; lUNIVflag := False;             {!04-14-84}
              IF (Token = FUNCTSY) OR (Token = PROCSY) THEN
                BEGIN
                lToken := Token; Scan;
                PFHead(FSys + [RPARENSY, SEMISY], lToken, lLpN, True, True, NIL);
                lLpN^.PFdecl := FORMAL; lpT := lLpN^.IdType;
                IF LastpN = NIL THEN
                  PARAMS := lLpN
                ELSE
                  LastpN^.Next := lLpN;
                LastpN := lLpN;
                END
              ELSE
                BEGIN
                IF Token = VARSY THEN
                  BEGIN
                  lKind := INDRCT; Scan;
                  END
                ELSE
                  lKind := DRCT;
                ExitFlag := False;
                REPEAT
                  IF Token = IDENTSY THEN
                    BEGIN
                    New(lLpN, IDENTNODE, VARS);
                    WITH lLpN^ DO
                      BEGIN
                      InRegister := - 1;                                       {!OPT!}
                      IdType := NIL;                                           {!OPT!}
                      IsSELF := False;                                         {!C}
                      Name := Ident; Next := NIL; Node := IDENTNODE;
                      Class := VARS;
                      Vkind := lKind; Vlev := Level;
                      END;
                    IF LastpN = NIL THEN
                      PARAMS := lLpN
                    ELSE
                      LastpN^.Next := lLpN;
                    EnterId(lLpN); LastpN := lLpN; Scan;
                    END
                  ELSE
                    Error(21);
                  IF NOT (Token IN FSys + [COMMASY, COLONSY]) THEN
                    Skip(23, FSys + [COMMASY, SEMISY, RPARENSY, COLONSY]);
                  IF Token = COMMASY THEN
                    Scan
                  ELSE
                    ExitFlag := True;
                UNTIL ExitFlag;
                IF Token = COLONSY THEN
                  BEGIN
                  Scan;
                  IF Token = IDENTSY THEN
                    BEGIN
                    IF Ident = 'UNIV    ' THEN                                 {!04-14-84}
                      BEGIN                                                    {!04-14-84}
                      lUNIVflag := True; Scan;                                 {!04-14-84}
                      END;                                                     {!04-14-84}
                    lpT := GetAType;                                           {!C}
                    IF lUNIVflag THEN                                          {!04-14-84}
                      BEGIN                                                    {!04-14-84}
                      lUNIVflag := (Token = IDENTSY);                          {!04-14-84}
                      IF lUNIVflag THEN Scan;                                  {!04-14-84}
                      END                                                      {!04-14-84}
                    ELSE                                                       {!04-14-84}
                      Scan;                                                    {!04-14-84}
                    END
                  ELSE
                    Error(29);
                  IF lpT <> NIL THEN
                    IF (lKind = DRCT) AND lpT^.FType THEN Error(119);
                  IF NOT (Token IN [SEMISY, RPARENSY]) THEN {6-16-83 A.H. Was fsys+[..]}
                    Skip(23, FSys + [SEMISY, RPARENSY]);
                  END
                ELSE
                  Error(35);
                END;
              IF OldLastpN = NIL THEN
                lLpN := PARAMS
              ELSE
                lLpN := OldLastpN^.Next;
              WHILE lLpN <> NIL DO
                BEGIN
                lLpN^.IdType := lpT; LargeValue := False;
                IF lLpN^.Class = VARS THEN
                  BEGIN
                  lLpN^.UNIVflag := lUNIVflag;                                 {!04-14-84}
                  IF lKind = INDRCT THEN
                    lpTSize := 4
                  ELSE IF lpT <> NIL THEN
                    BEGIN
                    lpTSize := FullBytes(lpT);
                    IF (lpTSize > 4) AND (lpT^.Form <> SETS) THEN
                      BEGIN
                      FrameLLc := FrameLLc + lpTSize;
                      LargeValue := True; lpTSize := 4;
                      END;
                    END
                  ELSE
                    lpTSize := 2;
                  END
                ELSE
                  BEGIN
                  lpTSize := 8; lpT := NIL;
                  END;
                lLc := lLc - lpTSize;
                IF Odd(lLc) THEN lLc := lLc - 1;
                IF lLc - 1 >= 0 THEN {overflow}
                  BEGIN
                  Error(310); lLc := 0
                  END;                                                         {!6-17-83}
                IF lLpN^.Class = VARS THEN
                  IF LargeValue THEN
                    lLpN^.Voff := - FrameLLc
                  ELSE
                    BEGIN
                    lLpN^.Voff := lLc;
                    IF lpT <> NIL THEN
                      IF (lpT^.Form = SETS) AND (lpTSize = 1) THEN
                        lLpN^.Voff := lLpN^.Voff + 1;
                    END
                ELSE
                  lLpN^.PFOff := lLc;
                lLpN := lLpN^.Next;
                END;
              IF Token = SEMISY THEN
                BEGIN
                Scan;
                IF NOT (Token IN FSys + [IDENTSY, VARSY]) THEN
                  Skip(23, FSys + [IDENTSY, RPARENSY, PROCSY, FUNCTSY, VARSY]);
                END;
              END;
            IF NOT ForwFlag THEN lpN^.Lc := FrameLLc; {lpN is PFHead's}        {!01-05-84}
            IF Token = RPARENSY THEN
              BEGIN
              Scan;
              IF NOT (Token IN FSys + fSy) THEN Skip(20, fSy + FSys);
              END
            ELSE
              Error(32);
            END;
          IF lpN^.PFlev <> 1 THEN lLc := lLc - 4;
          lLc := lLc - 8; lLpN := PARAMS;
          WHILE lLpN <> NIL DO
            WITH lLpN^ DO
              BEGIN
              IF Class = VARS THEN
                BEGIN
                IF (Vkind = DRCT) AND (IdType <> NIL) THEN
                  LargeValue := (FullBytes(IdType) > 4) AND (IdType^.Form <> SETS)
                ELSE
                  LargeValue := False;
                IF NOT LargeValue THEN Voff := Voff - lLc;
                END
              ELSE
                PFOff := PFOff - lLc;
              lLpN := Next;
              END;
          pBytes := - lLc;
        END; {ParameterList}

      BEGIN {PFHead}
        ForwFlag := False;
        IF Top < MAXDISPLAY THEN
          Mark(Display[Top + 1].ProcBase)
        ELSE
          Error(303);                                                          {!DBG!}
                                                                               {!C}
        IF Token = IDENTSY THEN
          BEGIN
          HigherLevel := False;                                                {!C 12-14-83}
          IF ClasspT <> NIL THEN                                               {!C 12-14-83}
            IF ClasspT^.ClFields <> NIL THEN {See if it's a method body}       {!C 12-14-83}
              BEGIN
              lpN := SearchClasses(ClasspT, HigherLevel, False);               {!C 12-14-83}
              IF lpN <> NIL THEN
                BEGIN
                WITH lpN^ DO
                  BEGIN
                  IF Class = PROC THEN
                    BEGIN
                    ForwFlag := (PFdeclKind = DECLARED) AND (fToken = PROCSY) AND
                                (HigherLevel OR (PFdecl = FORWMETHDECL));      {!C 12-14-83}
                    IF NOT ForwFlag THEN Error(100);
                    END
                  ELSE IF Class = FUNC THEN
                    BEGIN
                    ForwFlag := (PFdeclKind = DECLARED) AND (fToken = FUNCTSY) AND
                                (HigherLevel OR (PFdecl = FORWMETHDECL));
                    IF NOT ForwFlag THEN Error(100);
                    END
                  ELSE
                    Error(153);
                  IF HigherLevel THEN                                          {!C 12-14-83}
                    BEGIN
                    IF ForwFlag THEN Override(lpN); {lpN will point to new proc}
                    END
                  ELSE IF ForwFlag AND (lpN^.MethodNo <> 0 {CREATE} ) THEN
                    BEGIN
                    RtnNo := LocProcNo;
                    LocProcNo := LocProcNo + 1;
                    END;
                  END;
                END;
              END;

          IF NOT ForwFlag THEN
            BEGIN
            lpN := SearchLocal(Display[Top].NameTree);
            IF lpN <> NIL THEN
              WITH lpN^ DO
                IF Class = PROC THEN
                  ForwFlag := (PFdeclKind = DECLARED) AND (PFdecl = FORWDECL) AND
                              (fToken = PROCSY)
                ELSE IF Class = FUNC THEN
                  ForwFlag := (PFdeclKind = DECLARED) AND (PFdecl = FORWDECL) AND
                              (fToken = FUNCTSY)
                ELSE
                  Error(153);
            END;
                                                                               {!C}
          IF NOT ForwFlag THEN
            BEGIN
            New(lpN, IDENTNODE, PROC, DECLARED);
            WITH lpN^ DO
              BEGIN
              IF fToken = PROCSY THEN                                          {!C}
                BEGIN                                                          {!C}
                Class := PROC;                                                 {!C}
                IdType := ProcPtr;                                             {!C}
                END                                                            {!C}
              ELSE                                                             {!C}
                BEGIN                                                          {!C}
                Class := FUNC;                                                 {!C}
                IdType := NIL;                                                 {!C}
                END;                                                           {!C}
              Node := IDENTNODE; Name := Ident; Next := NIL;                   {!C}
              PFdeclKind := DECLARED; PFdecl := DECL; Lc := 0;
              ParmBytes := 0; InlineCode := NIL;                               {!02-06-84}
              IF Level > 1 THEN
                PFlev := Level
              ELSE
                PFlev := 1;
              IF (Level > 1) OR (InUnit AND NOT InterFlag) THEN
                BEGIN
                RtnNo := LocProcNo; LocProcNo := LocProcNo + 1;
                END
              ELSE
                RtnNo := - 1;
              END;
            IF EnterIt THEN EnterId(lpN);                                      {!01-06-84}
            END;
          Scan;
          IF Token = PERIODSY THEN
            BEGIN
            Error(23);
            Scan;
            IF Token = IDENTSY THEN Scan;
            END;
          END
        ELSE {token <> IDENTSY}
          BEGIN
          Error(29); New(lpN, IDENTNODE);
          IF fToken = FUNCTSY THEN
            lpN^ := uFctPtr^
          ELSE
            lpN^ := uPrcPtr^;
          END;

        OldTop := Top; OldLevel := Level;
        IF Top < MAXDISPLAY THEN
          BEGIN
          IF Level <= 0 THEN
            Level := 2
          ELSE IF Level < MAXLEVEL THEN
            Level := Level + 1
          ELSE
            Error(303);
          Top := Top + 1;
          WITH Display[Top] DO
            BEGIN
            NameTree := NIL; Occur := PARAMS;
            END;
          END
        ELSE
          Error(303);
        lSys := [SEMISY];
        IF FormalFlag THEN lSys := lSys + [RPARENSY];
        IF fToken = FUNCTSY THEN lSys := lSys + [COLONSY];
        Mark(Heap);                                                            {!01-06-84}
        ParameterList(FSys, lSys, pList, pBytes);
        IF ForwFlag THEN                                                       {!01-06-84}
          BEGIN                                                                {!01-06-84}
          IF pList <> NIL THEN                                                 {!01-06-84}
            IF NOT CompFormals(lpN^.PFArgList, pList, True) THEN               {!01-06-84}
              Error(116);                                                      {!01-06-84}
          Release(Heap);                                                       {!01-06-84}
          END                                                                  {!01-06-84}
        ELSE                                                                   {!01-06-84}
          BEGIN
          lpN^.PFargList := pList; lpN^.ParmBytes := pBytes;
          END;
        IF fToken = FUNCTSY THEN
          BEGIN
          IF Token = COLONSY THEN
            BEGIN
            Scan;
            IF Token = IDENTSY THEN
              BEGIN
              {IF ForwFlag THEN Error(117);}                                   {!01-06-84}
              WITH lpN^ DO
                BEGIN
                FuncType := GetAType;                                          {!C 01-05-84}
                IF ForwFlag THEN                                               {!01-06-84}
                   IF IdType <> FuncType THEN Error(117);                      {!01-06-84}
                IdType := FuncType;                                            {!01-06-84}
                IF IdType <> NIL THEN
                  IF IdType^.Form > POINTERS THEN
                    BEGIN
                    Error(118); IdType := NIL;
                    END;
                END;
              Scan;
              END
            ELSE
              Skip(29, FSys + [SEMISY]);
            END
          ELSE IF NOT ForwFlag OR (pList <> NIL) THEN Error(120);              {!01-06-84}
          END;
        IF NOT FormalFlag THEN
          IF Token = SEMISY THEN
            Scan
          ELSE
            Error(36);
        IF NOT (Token IN FSys) THEN Skip(20, FSys);
        Top := OldTop; Level := OldLevel;
        FpN := lpN;
      END; {PFHead}

    FUNCTION GetExitLabel: pLabRec;

      VAR
        lLab: pLabRec;

      BEGIN {GetExitLabel}
        New(lLab);
        WITH lLab^ DO
          BEGIN
          NextLabel := NIL; LabelNo := 10000 + Level;
          GlobRefNo := - 1; Defined := True;
          END;
        GetExitLabel := lLab;
      END; {GetExitLabel}

    PROCEDURE DclMasterTbl(FpN: pN);                                           {!C 12-27-83}

      VAR
        CurClass: pT;

      BEGIN {DclMasterTbl - declate the "master" method table. This is done at
             the start of a unit's IMPLEMENTATION section after all INTERFACE
             variables. For each class explicitly declared in this unit, the
             number of 4-byte slots reserved in the master table is the class
             level (in the class tree) plus 2 (since levels start at 0 and there
             are 2 sublevels for each level) plus 1 (for the superclass pointer).}
        WITH FpN^ DO
          BEGIN
          CurClass := NilClassPtr^.TotalOrder;
          IF Ukind = SHARUNIT THEN
            IF ULc = 0 THEN ULc := 4; {leave 1st 4 bytes alone in Shared Intrinsic}

          WHILE CurClass <> NIL DO
            BEGIN
            IF CurClass^.NeedsInit THEN
              BEGIN
              ULc := ULc + (CurClass^.ClassLevel + 3) * 4;
              CurClass^.MethodOff := - ULc + 4; {MethodLev was set by ClassList}
              END;

            CurClass := CurClass^.TotalOrder;
            END;
          END;
      END; {DclMasterTbl}                                                      {!C 12-27-83}

    BEGIN {Declarations}
      CASE fSymbol OF                                                          {!}{[@=11]}
        PROGRAMSY: BEGIN
                   WITH Display[Top] DO
                     BEGIN
                     NameTree := FpN; Occur := BLK; Labels := NIL;
                     ExitLabel := GetExitLabel; RootLink := FpN;
                     END;
                   {EnterId(FpN) deleted from here}                            {!DBG!}

                   IF Token = USESSY THEN
                     BEGIN
                     Scan; UsesDecl(FSys);
                     END;

                   REPEAT                                                      {!01-21-84}
                     ExitFlag := True;
                     ForwPList := NIL;
                     ForwCList := NIL;                                         {!C}
                     IF Token = LABELSY THEN
                       BEGIN
                       Scan; LabelDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = CONSTSY THEN
                       BEGIN
                       Scan; ConstDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = TYPESY THEN
                       BEGIN
                       Scan; TypeDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = VARSY THEN
                       BEGIN
                       Scan; VarDecl(FSys); ExitFlag := False;
                       END;
                   UNTIL ExitFlag;                                             {!01-21-84}
                   END;
                                                                               {!C}
        BEGINSY, ENDSY:                                                        {!01-01-84}
                   BEGIN
                   New(FpN, IDENTNODE, PROC, DECLARED);                        {!12-27-83 start}
                   WITH FpN^ DO
                     BEGIN
                     Node := IDENTNODE; Class := PROC; PFdeclKind := DECLARED;
                     PFdecl := METHDECL; {force debugger to see as class.%_CRxxxx}
                     IdType := NIL; Next := NIL;
                     PFlev := 1;
                     RtnNo := LocProcNo; LocProcNo := LocProcNo + 1;
                     PFargList := NIL; ParmBytes := 0; Lc := 0;
                     NextCrNbr := NextCrNbr + 1; N := NextCrNbr;
                     Name := '%_CR0000';
                     FOR i := 5 TO 8 DO
                       BEGIN
                       Name[i] := Chr(Ord('0') + N MOD 10);
                       N := N DIV 10;
                       END;
                     END;                                                      {!12-27-83 end}

                   Mark(HeapMark);
                   Level := 2;
                   IF Top < MAXDISPLAY THEN
                     BEGIN
                     Top := Top + 1;
                     WITH Display[Top] DO
                       BEGIN
                       NameTree := NIL; Occur := BLK; Labels := NIL;
                       ExitLabel := GetExitLabel; RootLink := FpN;
                       END;
                     END
                   ELSE
                     Error(303);
                   END;                                                        {!01-01-84}
                                                                               {!C}
        PROCSY, FUNCTSY:
                   BEGIN
                   PFHead(FSys, fSymbol, FpN, False, True, ClasspT);
                   Mark(HeapMark);
                   IF Level <= 0 THEN
                     Level := 2
                   ELSE IF Level < MAXLEVEL THEN
                     Level := Level + 1
                   ELSE
                     Error(303);
                   IF Top < MAXDISPLAY THEN
                     BEGIN
                     Top := Top + 1;
                     WITH Display[Top] DO
                       BEGIN
                       NameTree := FpN^.PFargList; Occur := BLK;
                       Labels := NIL;
                       ExitLabel := GetExitLabel; RootLink := FpN;
                       END;
                     END
                   ELSE
                     Error(303);
                                                                               {!3-9-83 Begin consistency chk}
                   WITH FpN^ DO                                                {!C}
                     IF PFdecl = FORWMETHDECL THEN                             {!12-21-82}
                       BEGIN {install SELF}
                       New(lpN, IDENTNODE, VARS);
                       WITH lpN^ DO
                         BEGIN
                         InRegister := - 1;                                    {!OPT!}
                         IdType := ClasspT;
                         Name := 'SELF    ';
                         Next := NIL;
                         Node := IDENTNODE; Class := VARS; Vkind := DRCT;
                         IsSELF := True;
                         UNIVflag := False;                                    {!04-14-84}
                         Vlev := Level;
                         IF FpN^.Name = 'CREATE  ' THEN
                           Voff := FpN^.ParmBytes
                         ELSE
                           Voff := 8;
                         END;
                       EnterId(lpN);

                       New(lpN, IDENTNODE, TYPES); {and install SUPERSELF}     {!10-5-83}
                       WITH lpN^ DO
                         BEGIN
                         IdType := ClasspT^.SuperClass;
                         Name := 'SUPERSEL';
                         Next := NIL; Node := IDENTNODE; Class := TYPES;
                         END;
                       EnterId(lpN);

                       IF Class = FUNC THEN
                         BEGIN {install return result}
                         New(lpN, IDENTNODE, VARS);
                         WITH lpN^ DO
                           BEGIN
                           InRegister := - 2; {2-18-83 force into memory}      {!OPT!}
                           IdType := FpN^.IdType;
                           Name := FpN^.Name;
                           Next := NIL;
                           Node := IDENTNODE;  Class := VARS; Vkind := DRCT;
                           IsSELF := False;
                           UNIVflag := False;                                  {!04-14-84}
                           Vlev := Level;
                           Voff := FpN^.ParmBytes;
                           END;
                         EnterId(lpN);
                         END;
                       END;                                                    {!3-9-83 End consistency chk}

                   REPEAT                                                      {!01-21-84}
                     ExitFlag := True;
                     ForwCList := NIL;                                         {!C}
                     ForwPList := NIL;
                     IF Token = LABELSY THEN
                       BEGIN
                       Scan; LabelDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = CONSTSY THEN
                       BEGIN
                       Scan; ConstDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = TYPESY THEN
                       BEGIN
                       Scan; TypeDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = VARSY THEN
                       BEGIN
                       Scan; VarDecl(FSys); ExitFlag := False;
                       END;
                   UNTIL ExitFlag;                                             {!01-21-84}
                   END;

        UNITSY:    BEGIN
                   InterFlag := True;
                   WITH Display[Top] DO
                     BEGIN
                     NameTree := FpN; Occur := BLK; Labels := NIL;
                     ExitLabel := NIL; RootLink := NIL;
                     END;

                   IF Token = INTRINSY THEN
                     BEGIN
                     Scan; IntriDecl; InIU := True;
                     END;                                                      {!IU!}
                   FSys := FSys + [IMPLESY];

                   IF Token = USESSY THEN
                     BEGIN
                     Scan; UsesDecl(FSys);
                     END;

                   REPEAT                                                      {!01-21-84}
                     ExitFlag := True;
                     ForwCList := NIL;                                         {!C}
                     ForwPList := NIL;
                     IF Token = CONSTSY THEN
                       BEGIN
                       Scan; ConstDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = TYPESY THEN
                       BEGIN
                       Scan; TypeDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = VARSY THEN
                       BEGIN
                       Scan; VarDecl(FSys); ExitFlag := False;
                       END;
                     IF  (Token = FUNCTSY) OR (Token = PROCSY) THEN
                       BEGIN
                       lToken := Token; Scan;
                       PFHead(FSys + [IDENTSY, IMPLESY], lToken, lpN, False, True, NIL);
                       IF HasBody(FSys + [IMPLESY], lpN, HeapMark) THEN
                         BEGIN
                         lpN^.PFdecl := FORWDECL;
                         Forwcount := Forwcount + 1;
                         END;
                       ExitFlag := False;
                       END;
                   UNTIL ExitFlag;                                             {!01-21-84}

                   LastUBlock := OpenFileStack[TopOfOpenFileStack].LastRelBlkRead
                                 + 2 * (InbufP DIV 1024);
                   LastUByte := InbufP MOD 1024;
                   InterFlag := False;
                   FSys := FSys - [IMPLESY];

                   IF ClassesToInit THEN DclMasterTbl(FpN);                    {!12-27-83}

                   IF Token = IMPLESY THEN
                     Scan
                   ELSE
                     Skip(52, FSys);

                   REPEAT                                                      {!01-21-84}
                     ExitFlag := True;
                     ForwCList := NIL;                                         {!C}
                     ForwPList := NIL;
                     IF Token = CONSTSY THEN
                       BEGIN
                       Scan; ConstDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = TYPESY THEN
                       BEGIN
                       Scan; TypeDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = VARSY THEN
                       BEGIN
                       Scan; VarDecl(FSys); ExitFlag := False;
                       END;
                   UNTIL ExitFlag;                                             {!01-21-84}
                   END;

        USESSY:    BEGIN
                   IF Token = INTRINSY THEN
                     BEGIN
                     Scan; IntriDecl;
                     END                                                       {!IU!}
                   ELSE
                     BEGIN                                                     {!IU!}
                     IF InIU THEN Error(54);                                   {!6-23-83}
                     IF Token = INTERSY THEN
                       Scan
                     ELSE
                       Skip(53, FSys);
                     END;

                   IF Token = USESSY THEN
                     BEGIN
                     Scan; UsesDecl(FSys);
                     END;

                   REPEAT                                                      {!01-21-84}
                     ExitFlag := True;
                     ForwCList := NIL;                                         {!C}
                     ForwPList := NIL;
                     InUses := True;                                           {!C}
                     IF Token = CONSTSY THEN
                       BEGIN
                       Scan; ConstDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = TYPESY THEN
                       BEGIN
                       Scan; TypeDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = VARSY THEN
                       BEGIN
                       Scan; VarDecl(FSys); ExitFlag := False;
                       END;
                     IF (Token = FUNCTSY) OR (Token = PROCSY) THEN
                       BEGIN
                       lToken := Token; Scan;
                       PFHead(FSys + [IDENTSY, IMPLESY], lToken, lpN, False, True, NIL);
                       IF HasBody(FSys + [IMPLESY], lpN, HeapMark) THEN
                         IF RodFlag THEN
                           lpN^.PFdecl := FORWDECL                               {!10-25-83}
                         ELSE
                           lpN^.PFdecl := EXTDECL;
                       ExitFlag := False;
                       END;
                   UNTIL ExitFlag;                                             {!01-21-84}

                   IF Token <> IMPLESY THEN Error(52);
                   InUses := False;                                            {!C}
                   IF NOT LinePrinted THEN
                     BEGIN
                     CurLine[0] := Chr(pCurLine);
                     TempStr := CurLine; SUUpStr(@TempStr);
                     i := Pos('IMPLEMEN', TempStr);
                     IF i>0 THEN
                       BEGIN
                       CurLine[0] := Chr(i - 1); SUTrimBlanks(@CurLine);
                       pCurLine := Length(CurLine);
                       LinePrinted := (pCurLine = 0);
                       END;
                     END;
                   EolSource := True; InbufP := 0; Inbuf[0] := ' ';
                   InbufLastValidByte := 1;
                   NextCh; {make sure all errors are out and last line printed}
                   END;

        LABELSY, CONSTSY, TYPESY, VARSY:                                       {!01-21-84}
                   REPEAT
                     ExitFlag := True;
                     ForwCList := NIL;                                         {!C}
                     ForwPList := NIL;
                     IF Token = LABELSY THEN
                       BEGIN
                       Scan; LabelDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = CONSTSY THEN
                       BEGIN
                       Scan; ConstDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = TYPESY THEN
                       BEGIN
                       Scan; TypeDecl(FSys); ExitFlag := False;
                       END;
                     IF Token = VARSY THEN
                       BEGIN
                       Scan; VarDecl(FSys); ExitFlag := False;
                       END;
                   UNTIL ExitFlag;                                             {!01-21-84}
      END;
    END; {Declarations}

