  (*$p**************************************************************************)
  (*                                                                           *)
  (*                          File: BODY.TEXT                                  *)
  (*                                                                           *)
  (*              (C) Copyright 1981 Silicon Valley Software, Inc.             *)
  (*                            1983, 1984 Apple Computer, Inc.                *)
  (*                                                                           *)
  (*                            All rights reserved.               11-Aug-81   *)
  (*                                                                           *)
  (*  12-2-82 fixed nil ptr bug in xconcat (ref to stringlen)                  *)
  (*  3-30-83 xread: err #148 on any other than text files                     *)
  (*  3-30-83 xwrite: err #123 on any other than text files                    *)
  (*  5-11-83 Selector: range checking on string indexing                      *)
  (*  5-15-83 Makescsize: overflow checking on integer truncations             *)
  (*  5-15-83 Expression: add TRAPV nodes after integer add,multiply,etc       *)
  (*  5-15-83 Abssqr: overflow checking                                        *)
  (*  5-23-83 assign: string assign copies minimum of the 2 string lengths     *)
  (*  5-24-83 Selector: allow pointer-valued function call dereferencing       *)
  (*  5-24-83 Selector: part of Selector becomes Dereference (for Factor)      *)
  (*  5-24-83 Factor: allow pointer-valued function dereferencing              *)
  (*  5-24-83 Variable: allow functions as var params                          *)
  (*  5-24-83 withstatement: allow func^ in a with statement                   *)
  (*  5-27-83 Makescsize: overflow checking on OflowFlag                       *)
  (*  5-27-83 Expression: add OflowFlag                                        *)
  (*  5-27-83 Abssqr: add v                                                    *)
  (*  6-13-83 Makescsize: range checking on constant conversions               *)
  (*  6-13-83 Xchr: add range checking on CHR()                                *)
  (*  6-17-83 Simpleexpression: check for nil typtr in arith. factor           *)
  (*  6-22-83 Resetwrite: re-allow INTERACTIVE files (Paslib converts to TEXT) *)
  (*  6-23-83 InsertRangeCheck: new proc formed from code moved from Assignment*)
  (*  6-23-83 Callnonstandard: range checking on parameters                    *)
  (*  6-23-83 assign: no range-checking on longints                            *)
  (*  6-23-83 assign: range-checking code moved to insertrangecheck            *)
  (* 10-06-83 Factor: include type conversion function, <typeid>(expr)         *)
  (* 10-13-83 Method 'NEW' changed to 'CREATE'                                 *)
  (* 10-13-83 Typeconvert: add CheckSubClass which range-cks class conversion  *)
  (* 10-13-83 Variable:type conversion of var params using syntax <typeid>(var)*)
  (* 10-18-83 Selector: adjust so that caller must set up initial GATTR        *)
  (* 10-18-83 Factor: adjust calls to selector                                 *)
  (* 10-18-83 Variable: adjust call to selector                                *)
  (* 10-18-83 assign,withst: adjust call to selector                           *)
  (* 10-18-83 withstatement: include typeid(var) as legal with-expr            *)
  (* 12-05-83 Selector: new proc SELECT.  add selection after func & meth calls*)
  (* 12-05-83 Variable: eliminate superfluous handle checking                  *)
  (* 12-05-83 Factor: permit arbitrary selection after function call           *)
  (* 12-05-83 Expression: make class comparisons commutative (fix)             *)
  (* 12-05-83 assign: permit SELF to be assigned to any superclass             *)
  (* 12-14-83 Body: 2nd MemAvail display deleted                               *)
  (* 12-14-83 Select: call to SearchClasses for class field id's               *)
  (* 01-01-84 TypeConvert: change in runtime calls                             *)
  (* 01-05-84 WithStatement: file With class(v) do processing                  *)
  (* 01-07-84 ThisClass and InClass standard functions added to CallStdFunc    *)
  (* 01-20-84 Expression: changed to support set constants (in Factor)         *)
  (* 01-22-84 CaseStatement: enhanced to support case label ranges             *)
  (* 03-29-84 CallNonStandard: changes for C calls                             *)
  (* 04-14-84 CallNonStandard: UNIV added for proc params                      *)
  (*****************************************************************************)
  {[j=0/0/80!,@=4,i=1]}

  {$S }

  PROCEDURE Body(FSys: SetOfSys; PFName: Alfa; VAR BodyStmt: pStmt);

    VAR
      lStmt, LastStmt: pStmt;
      Lab: pLabRec;
      i: Integer;
      LabName: Alfa;
      LabStr: String[8];

    PROCEDURE Statement(FSys: SetOfSys; VAR fStmt: pStmt);

      LABEL 1;

      VAR
        lpN: pN;
        Lab: pLabRec;
        lStmt: pStmt;

      FUNCTION NewBinNode(fBinOp: Integer; fLeftArg, FrightArg: pN): pN;

        VAR
          lpN: pN;

        BEGIN {NewBinNode}
          New(lpN, BINNODE);
          WITH lpN^ DO
            BEGIN
            Node := BINNODE; BinOp := fBinOp; BinSubOp := 0;
            LeftArg := fLeftArg; RightArg := FrightArg;
            END;
          NewBinNode := lpN;
        END; {NewBinNode}

      FUNCTION NewUnNode(fUnOp: Integer; fUnArg: pN): pN;

        VAR
          lpN: pN;

        BEGIN {NewUnNode}
          New(lpN, UNNODE);
          WITH lpN^ DO
            BEGIN
            Node := UNNODE; UnOp := fUnOp; UnSubOp := 0; UnArg := fUnArg;
            END;
          NewUnNode := lpN;
        END; {NewUnNode}

      PROCEDURE MakeScSize(VAR FAttr: Attr; ToSize: Integer);

        VAR
          lSize, Op: Integer;
          lpT: pT;

        BEGIN {MakeScSize}
          lSize := FAttr.ASize;
          IF lSize <> ToSize THEN
            BEGIN
            CASE ToSize OF
              1:  BEGIN
                  lpT := SIntPtr;
                  IF lSize = 2 THEN
                    Op := 51 {INT21}
                  ELSE
                    Op := 53; {INT41}
                  END;
              2:  BEGIN
                  lpT := IntPtr;
                  IF lSize = 1 THEN
                    Op := 48 {INT12}
                  ELSE
                    Op := 52; {INT42}
                  END;
              4:  BEGIN
                  lpT := LIntPtr;
                  IF lSize = 1 THEN
                    Op := 50 {INT14}
                  ELSE
                    Op := 49; {INT24}
                  END;
            END;
            IF FAttr.TreePtr <> NIL THEN
              IF FAttr.TreePtr^.Node = CSTNODE THEN
                WITH FAttr.TreePtr^ DO
                  BEGIN
                  CstType := lpT;
                  IF (Op = 52) THEN
                    BEGIN                                                      {!6-13-83A.H.}
                    IF (CstValu.Ivalu < - 32768) OR (CstValu.Ivalu > 32767) THEN
                      Error(169);
                    END
                  ELSE IF (Op = 51) OR (Op = 53) THEN
                    BEGIN
                    IF (CstValu.Ivalu < - 128) OR (CstValu.Ivalu > 127) THEN
                      Error(169)
                    END;
                  END
              ELSE
                BEGIN
                FAttr.TreePtr := NewUnNode(Op, FAttr.TreePtr);
                IF OflowFlag THEN
                  IF (Op >= 51) AND (Op <= 53) THEN
                    FAttr.TreePtr := NewUnNode($8C {TRAPV} , FAttr.TreePtr);
                END;
            FAttr.ASize := ToSize;
            END;
        END; {MakeScSize}

      PROCEDURE MatchISizes(VAR AAttr, BAttr: Attr);

        VAR
          ASize, BSize: Integer;

        BEGIN {MatchISizes}
          ASize := AAttr.ASize; BSize := BAttr.ASize;
          IF ASize <> BSize THEN
            IF ASize < BSize THEN
              MakeScSize(AAttr, BSize)
            ELSE
              MakeScSize(BAttr, ASize);
        END; {MatchISizes}

      PROCEDURE MinSize2(VAR FAttr: Attr);

        BEGIN {MinSize2}
          IF FAttr.ASize < 2 THEN MakeScSize(FAttr, 2);
        END; {MinSize2}

      PROCEDURE MakeSetSize(VAR FAttr: Attr; fSize: Integer);

        BEGIN {MakeSetSize}
          WITH FAttr DO
            BEGIN
            TreePtr := NewUnNode(170 {ADJSET} , TreePtr);
            TreePtr^.UnSubOp := fSize * 256 + ASize;
            ASize := fSize;
            END;
        END; {MakeSetSize}

      PROCEDURE MatchSetSizes(VAR AAttr, BAttr: Attr);

        BEGIN {MatchSetSizes}
          IF AAttr.ASize <> BAttr.ASize THEN
            IF AAttr.ASize = 0 THEN
              MakeSetSize(BAttr, 0)
            ELSE IF BAttr.ASize = 0 THEN
              MakeSetSize(AAttr, 0)
            ELSE IF AAttr.ASize > BAttr.ASize THEN
              MakeSetSize(BAttr, AAttr.ASize)
            ELSE
              MakeSetSize(AAttr, BAttr.ASize);
        END; {MatchSetSizes}

      PROCEDURE Float(VAR FAttr: Attr);

        BEGIN {Float}
          MakeScSize(FAttr, 4);
          FAttr.TreePtr := NewUnNode(56 {FLOAT44} , FAttr.TreePtr);
          FAttr.Typtr := RealPtr; FAttr.ASize := 4;
        END; {Float}

      FUNCTION PAoC(FpT: pT): Boolean;

        VAR
          Lo, Hi: Integer;

        BEGIN {PAoC}
          PAoC := False;
          IF FpT <> NIL THEN
            IF (FpT^.Form = ARRAYS) AND (FpT^.ArrayOf = CharPtr) AND
               FpT^.PckdArr THEN
              IF CompTypes(FpT^.IndexedBy, IntPtr) THEN
                BEGIN
                GetBounds(FpT^.IndexedBy, Lo, Hi);
                PAoC := Lo = 1;
                END;
        END; {PAoC}

      PROCEDURE InsertRangeCheck(MatchType: pT; VAR gAttr: Attr);

        VAR
          Lo, Hi: Integer;

        BEGIN {InsertRangeCheck}
          IF MatchType^.Form = SUBRANGE THEN
            IF (MatchType <> SIntPtr) AND (MatchType <> IntPtr) AND
               (gAttr.ASize <= 2) AND (FullBytes(MatchType) <= 2) THEN
              BEGIN
              GetBounds(MatchType, Lo, Hi);
              IF gAttr.TreePtr^.Node = CSTNODE THEN
                BEGIN
                IF (gAttr.TreePtr^.CstValu.Ivalu < Lo) OR
                   (gAttr.TreePtr^.CstValu.Ivalu > Hi) THEN
                  Error(169);
                END
              ELSE
                BEGIN
                MakeScSize(gAttr, 2);
                gAttr.TreePtr := NewBinNode(46 {RCHECK} , NIL, gAttr.TreePtr);
                gAttr.TreePtr^.LeftPt := MatchType;
                END;
              END;
        END; {InsertRangeCheck}

      PROCEDURE TypeConvert(FSys: SetOfSys; PROCEDURE
                            GetArg(FSys: SetOfSys); VAR FpN: pN);

        VAR
          lSize: Integer;

        PROCEDURE CheckSubClass(FIdType: pT; VAR ToClass: Alfa);               {!01-01-84}

          VAR
            lpN, lTreePtr, Funct: pN;

          BEGIN {Appends a call to %_CkObCn(X: LongInt; ToClass: Alfa): LongInt;
                 or a call to %_CkObCp(X, ToClass: LongInt): LongInt; where X is
                 the subclass variable being coerced and ToClass is the coersion
                 type. The calls are to supplied functions that returns A if the
                 coercion is ok, else bombs.  %_CkObCp is used when ToClass is
                 declared within this compilation, otherwise we don't know the
                 location of the class, so all we can pass is the name. Hence, the
                 routine %_CkObCn which takes ToClass as a Alfa string.  The two
                 routines are provided for efficiency.  Although %_CkObCn would
                 always work, %_CkObCp is more efficient in both time and space,
                 and it is the more common case! By the way...$CkObC stands for
                 "Check Object Class".}
            lTreePtr := gAttr.TreePtr; {x in ToClass(x), 1st arg of %_CSUBCK}

            IF FIdType^.NeedsInit THEN
              BEGIN {ToClass declared in this compilation}
              Funct := CkObCpPtr; {%_CkObCp}
              New(lpN, IDENTNODE, VARS);
              WITH lpN^ DO
                BEGIN
                IdType := LIntPtr; Next := NIL;
                Node := IDENTNODE; Class := VARS; Vkind := DRCT;
                InRegister := - 1;
                Vlev := Fidtype^.MethodLev;
                Voff := Fidtype^.MethodOff;
                END;
              END
            ELSE
              BEGIN {ToClass declared in another unit}
              Funct := CkObCnPtr; {%_CkObCn}
              New(lpN, CSTNODE);
              WITH lpN^ DO
                BEGIN
                Node := CSTNODE;
                CstValu.SvaluLen := 8;
                New(CstValu.Svalu);
                CstValu.Svalu^.StrPart := ToClass;
                CstValu.Svalu^.Next := NIL;
                New(CstType, SCONST);
                WITH CstType^ DO
                  BEGIN
                  FType := False; Form := SCONST; Bits := 0; Bytes := 8;
                  StringLen := 8;
                  END;
                END;
              END;

            gAttr.TreePtr := NewBinNode(0, lpN, NIL);
            gAttr.TreePtr := NewBinNode(0, lTreePtr, gAttr.TreePtr);
            gAttr.TreePtr := NewBinNode(176 {USRFUNC} , Funct, gAttr.TreePtr);
          END; {CheckSubClass}

        BEGIN {TypeConvert}
          Scan;
          GetArg(FSys + [RPARENSY]); {a call to expression or variable}
          WITH FpN^ DO
            IF IdType <> NIL THEN
              BEGIN
              lSize := FullBytes(IdType);
              IF (gAttr.ASize = lSize) THEN
                gAttr.Typtr := IdType
              ELSE IF gAttr.Typtr <> NIL THEN
                IF (gAttr.Typtr^.Form <= POINTERS) AND NOT CompTypes(gAttr.Typtr,
                   RealPtr) AND ((lSize = 1) OR (lSize = 2) OR (lSize = 4)) THEN
                  BEGIN
                  MakeScSize(gAttr, lSize);
                  gAttr.Typtr := IdType;
                  END
                ELSE
                  Error(178); {types don't match in size}
              IF RangeFlag THEN
                IF IdType^.Form = CLASSES THEN CheckSubClass(IdType, Name);    {!01-01-84}
              END;
          FpN := gAttr.TreePtr;
          IF Token = RPARENSY THEN
            Scan
          ELSE
            Error(32);
        END; {TypeConvert}

      PROCEDURE Expression(FSys: SetOfSys);
        FORWARD;

      PROCEDURE Call(FSys: SetOfSys; FpN: pN);
        FORWARD;

      FUNCTION SuperStar(Super, Sub: pT): pT;                                  {!C}

        LABEL 10;

        BEGIN {SuperStar - returns super iff super is a (possibly many times
               removed) super class of sub, else it returns NIL}
          IF Sub = Super THEN
            BEGIN
            SuperStar := Super;
            GOTO 10;
            END;
          SuperStar := NIL;
          WHILE Sub <> NIL DO
            BEGIN
            IF Sub^.SuperClass = Super THEN
              BEGIN
              SuperStar := Super;
              GOTO 10;
              END;
            Sub := Sub^.SuperClass;
            END;
        10:
        END; {SuperStar}

      PROCEDURE Select(FSys: SetOfSys; VAR FAttr: Attr; VAR Pckd,              {!12-05-83}
                       PckdStorage: Boolean; VAR SawClassId: Boolean);

        VAR
          lpN2, lpN, tpN, MpN: pN;
          Lo, Hi, NumBits, MyRightBit, Op: Integer;
          HigherLevel: Boolean;
          lpT, SuperpT: pT;

        BEGIN {Select}
          SuperpT := NIL;                                                      {!C}
          IF NOT (Token IN SelectSys + FSys) THEN Skip(28, SelectSys + FSys);
          WITH FAttr DO
            WHILE Token IN SelectSys DO
              BEGIN
              IF Token = LBRACKSY THEN
                BEGIN
                REPEAT
                  IF Typtr <> NIL THEN
                    IF (Typtr^.Form <> ARRAYS) AND (Typtr^.Form <> STRINGS) THEN
                      BEGIN
                      Error(135); Typtr := NIL;
                      END;
                  Scan;
                  Expression(FSys + [COMMASY, RBRACKSY]);
                  lpT := gAttr.Typtr;
                  MakeScSize(gAttr, 2);
                  New(lpN, TRINODE);
                  WITH lpN^ DO
                    BEGIN
                    Node := TRINODE; TriOp := 16 {INDEX} ; TriPt := FAttr.Typtr;
                    Tri1 := FAttr.TreePtr; OrigTri1 := Tri1;
                    Tri2 := gAttr.TreePtr;
                    END;
                  FAttr.TreePtr := lpN;
                  IF Typtr <> NIL THEN
                    WITH Typtr^ DO
                      IF Form = ARRAYS THEN
                        BEGIN
                        IF NOT CompTypes(IndexedBy, lpT) THEN Error(136);
                        GetBounds(IndexedBy, Lo, Hi);
                        IF RangeFlag AND (gAttr.TreePtr <> NIL) THEN
                          IF gAttr.TreePtr^.Node = CSTNODE THEN
                            BEGIN
                            IF (gAttr.TreePtr^.CstValu.Ivalu < Lo) OR
                               (gAttr.TreePtr^.CstValu.Ivalu > Hi) THEN
                              Error(169);
                            END
                          ELSE
                            BEGIN
                            TreePtr^.Tri2 := NewBinNode(46 {RCHECK} , NIL,
                                                        TreePtr^.Tri2);
                            TreePtr^.Tri2^.LeftPt := IndexedBy;
                            END;
                        PckdStorage := BitPacked; Pckd := PckdArr;
                        Typtr := ArrayOf;
                        IF PckdStorage THEN
                          ASize := 2
                        ELSE
                          ASize := FullBytes(Typtr);
                        END
                      ELSE {form = STRINGS}
                        BEGIN
                        IF NOT CompTypes(lpT, IntPtr) THEN Error(136);
                        IF RangeFlag AND (gAttr.TreePtr <> NIL) THEN {a simple
                             check against maximum string length - A.H. 5/11/83}
                          IF gAttr.TreePtr^.Node = CSTNODE THEN
                            BEGIN
                            IF (gAttr.TreePtr^.CstValu.Ivalu < 0) OR
                               (gAttr.TreePtr^.CstValu.Ivalu > StringLen) THEN
                              Error(169);
                            END
                          ELSE
                            BEGIN
                            TreePtr^.Tri2 := NewBinNode(46 {RCHECK} , NIL,
                                                        TreePtr^.Tri2);
                            TreePtr^.Tri2^.LeftPt := Typtr;
                            END;
                        Pckd := True; PckdStorage := True;
                        Typtr := CharPtr; ASize := 2;
                        END;
                UNTIL Token <> COMMASY;
                IF Token = RBRACKSY THEN
                  Scan
                ELSE
                  Error(34);
                END {left bracket}
              ELSE IF Token = PERIODSY THEN
                BEGIN                                                          {!C}
                IF Typtr <> NIL THEN
                  IF (Typtr^.Form <> RECORDS) AND (Typtr^.Form <> CLASSES) THEN
                    BEGIN
                    Error(137); Typtr := NIL;
                    END;
                Scan;
                IF Token = IDENTSY THEN
                  BEGIN
                  IF Typtr <> NIL THEN
                    BEGIN
                    IF Typtr^.Form = RECORDS THEN
                      BEGIN
                      Pckd := Typtr^.PckdRec;
                      lpN := SearchLocal(Typtr^.Fields);
                      Scan;
                      TreePtr := NewBinNode(15 {FIELD} , TreePtr, lpN);
                      IF lpN <> NIL THEN
                        BEGIN
                        Typtr := lpN^.IdType;
                        PckdStorage := lpN^.PckdField;
                        IF PckdStorage THEN
                          BEGIN
                          GetBounds(lpN^.IdType, Lo, Hi);
                          ASize := 2;
                          FAttr.TreePtr := NewUnNode(62 {EXTUSFLD} + Ord(Lo < 0),
                                                     FAttr.TreePtr);
                          NumBits := lpN^.IdType^.Bytes * 8 + lpN^.IdType^.Bits;
                          MyRightBit := 16 - lpN^.BitOff - NumBits;
                          FAttr.TreePtr^.UnSubOp := NumBits * 16 + MyRightBit;
                          END
                        ELSE
                          ASize := FullBytes(Typtr);
                        END
                      ELSE
                        BEGIN
                        Error(147); Typtr := NIL;
                        END;
                      END {records}
                    ELSE {a CLASSES field}
                      BEGIN
                      Pckd := False;
                      lpN := SearchClasses(Typtr, HigherLevel, False);         {!C 12-14-83}
                      Scan;

                      IF lpN <> NIL THEN
                        BEGIN
                        IF lpN^.Class = FIELD THEN
                          BEGIN
                          ExprDHandle := ExprDHandle + 1;
                          IF SawClassId THEN
                            BEGIN
                            Error(809); Typtr := NIL; TreePtr := NIL;
                            END
                          ELSE
                            BEGIN
                            Typtr := lpN^.IdType;
                            TreePtr := NewBinNode(15 {FIELD} ,
                                                  NewUnNode(12 {POINTERS} ,
                                                  NewUnNode(12 {POINTERS} ,
                                                            TreePtr)), lpN);
                            ASize := FullBytes(Typtr);
                            END;
                          END {field}
                        ELSE {METHOD}
                          BEGIN
                          IF (lpN^.MethodNo = 0) { 'CREATE' } THEN
                            BEGIN
                            IF SawClassId THEN
                              SuperpT := Typtr
                            ELSE
                              Error(809);
                            MpN := NIL;
                            END
                          ELSE
                            BEGIN
                            IF SawClassId THEN
                              BEGIN {verify target class is in the heirchy}
                              Ident := 'SELF    ';
                              lpN2 := SearchAll([VARS]);
                              TreePtr := lpN2;
                              IF lpN2^.IsSELF THEN
                                SuperpT := SuperStar(Typtr, lpN2^.IdType);
                              IF SuperpT = NIL THEN Error(810);
                              END; {SuperpT should be same as Typtr}
                            MpN := TreePtr;
                            END;
                          Call(FSys, lpN);
                          New(tpN, TRINODE);
                          WITH tpN^ DO
                            BEGIN
                            Node := TRINODE;
                            TriOp := 184 {METHODCALL} ;
                            TripN := lpN; {paroc to be called}
                            Tri1 := MpN; {local SELF, NIL if Create}
                            OrigTri1 := Tri1; {optimizer leaves this one alone!}{!C 12-27-83}
                            Tri2 := gAttr.TreePtr; {called proc's args}
                            TriSuper := SuperpT; {target class}
                            END;
                          TreePtr := tpN;
                          ASize := gAttr.ASize;
                          Typtr := gAttr.Typtr;
                          SawClassId := False;
                          END; {method}                                        {!12-05-83}
                        END {lpN<>NIL}
                      ELSE
                        BEGIN
                        Error(147); Typtr := NIL; TreePtr := NIL;              {!1-29-83}
                        END;
                      END; {classes field}
                    END; {token=IDENT}                                         {!C}
                  END
                ELSE
                  Error(29);
                END {period}
              ELSE IF Token = UPARROWSY THEN
                BEGIN
                IF Typtr <> NIL THEN
                  IF Typtr^.Form = FILES THEN
                    BEGIN
                    Typtr := Typtr^.FileOf;
                    IF Typtr = CharPtr THEN
                      Op := 14 {TEXT}
                    ELSE
                      Op := 13; {FILUP}
                    TreePtr := NewUnNode(Op, TreePtr);
                    ASize := FullBytes(Typtr);
                    IF Op = 14 THEN
                      BEGIN
                      TreePtr := NewUnNode(62 {EXTUFLD} , TreePtr);
                      TreePtr^.UnSubOp := 8 * 16 + 8;
                      END;
                    END
                  ELSE IF Typtr^.Form = POINTERS THEN
                    BEGIN
                    Typtr := Typtr^.PointerTo;
                    IF Typtr = NIL THEN Error(184);                            {!02-02-84}
                    TreePtr := NewUnNode(12 {POINTERS} , TreePtr);
                    ASize := FullBytes(Typtr);
                    END
                  ELSE
                    BEGIN
                    Error(138); Typtr := NIL;
                    END;
                Scan;
                END; {uparrow}
              IF NOT (Token IN FSys + SelectSy) THEN Skip(20, FSys + SelectSy);
              SuperpT := NIL;                                                  {!C}
              END; {while Token IN SelectSys}
        END; {Select}

      PROCEDURE Selector(FSys: SetOfSys; FpN: pN; VAR Pckd, PckdStorage: Boolean);

        VAR
          lAttr: Attr;
          lpN: pN;
          Lo, Hi, NumBits, MyRightBit, i, lOp: Integer;
          InFunc: Boolean;
          tpN, MpN: pN;                                                        {!C}
          SawClassId: Boolean;                                                 {!C}

        PROCEDURE Variable(FSys: SetOfSys); {copy of same proc in procedure CALL}

          VAR
            lpN: pN;
            PckdFlag, PckdStorage: Boolean;

          BEGIN {Variable}
            IF Token = IDENTSY THEN
              BEGIN
              lpN := SearchAll([VARS, FIELD, FUNC, TYPES]); Scan;
              END
            ELSE
              BEGIN
              Error(29); lpN := uVarPtr;
              END;
            WITH gAttr DO
              BEGIN                                                            {!10-18}
              Typtr := lpN^.IdType; TreePtr := lpN; ASize := FullBytes(Typtr);
              END;
            Selector(FSys, lpN, PckdFlag, PckdStorage);
            IF PckdFlag THEN Error(165);
          END; {Variable}

        BEGIN {Selector}
          PckdStorage := False;
          Pckd := False;
          SawClassId := False;                                                 {!C}
          lAttr := gAttr; {gAttr is now set up by caller}                      {!10-18}
          WITH lAttr DO
            BEGIN
            IF FpN^.Node = IDENTNODE THEN
              BEGIN
              IF Display[Disx].Occur = KLASS THEN
                BEGIN {WITH'ed class field or method}
                IF FpN^.Class = FIELD THEN
                  BEGIN
                  lpN := NewUnNode(43 {WITHREC} , NIL);
                  IF Level <= 1 THEN
                    lpN^.UnSubOp := Disx - 1
                  ELSE
                    lpN^.UnSubOp := Disx - Level;
                  TreePtr := NewBinNode(15 {FIELD} , lpN, FpN);
                  END {field}
                ELSE {METHOD}
                  BEGIN
                  IF FpN^.MethodNo = 0 { 'CREATE' } THEN
                    BEGIN
                    Error(809);
                    MpN := NIL;
                    END
                  ELSE
                    BEGIN
                    MpN := Display[Disx].WVar;
                    IF MpN = NIL THEN
                      BEGIN
                      MpN := NewUnNode(43 {WITHREC} , NIL);
                      IF Level <= 1 THEN
                        MpN^.UnSubOp := Disx - 2
                      ELSE
                        MpN^.UnSubOp := Disx - 1 - Level;
                      END;
                    END;
                  Call(FSys, FpN);
                  New(tpN, TRINODE);
                  WITH tpN^ DO
                    BEGIN
                    Node := TRINODE;
                    TriOp := 184 {METHODCALL} ;
                    TripN := FpN;
                    Tri1 := MpN;
                    OrigTri1 := Tri1; {optimizer leaves this one alone!}
                    Tri2 := gAttr.TreePtr;
                    TriSuper := NIL;
                    END;
                  TreePtr := tpN;
                  ASize := gAttr.ASize;                                        {!12-05-83}
                  END; {METHOD}
                END {WITH'ed class field or method}
              ELSE
                BEGIN
                IF FpN^.Class = TYPES THEN                                     {!C}
                  BEGIN
                  IF Token = PERIODSY THEN { lets see if it's a CLASS }
                    BEGIN
                    IF Typtr <> NIL THEN
                      IF Typtr^.Form <> CLASSES THEN
                        BEGIN
                        Error(808); Typtr := NIL;
                        END;
                    TreePtr := NIL;
                    SawClassId := True;
                    END
                  ELSE IF Token = LPARENSY THEN {type conversion}
                    BEGIN
                    TypeConvert(FSys, Variable, FpN);
                    lAttr := gAttr;
                    END
                  ELSE
                    Skip(56, FSys);
                  END {TYPES}
                ELSE IF FpN^.Class = FIELD THEN                                {!C}
                  BEGIN
                  IF Display[Disx].Occur = REC THEN Pckd := Display[Disx].RecPckd;
                  lpN := NewUnNode(43 {WITHREC} , NIL);
                  IF Level <= 1 THEN
                    lpN^.UnSubOp := Disx - 1
                  ELSE
                    lpN^.UnSubOp := Disx - Level;
                  TreePtr := NewBinNode(15 {FIELD} , lpN, TreePtr);
                  PckdStorage := FpN^.PckdField;
                  IF PckdStorage THEN
                    BEGIN
                    GetBounds(Typtr, Lo, Hi); ASize := 2;
                    TreePtr := NewUnNode(62 {EXTUSFLD} + Ord(Lo < 0), TreePtr);
                    NumBits := Typtr^.Bytes * 8 + Typtr^.Bits;
                    MyRightBit := 16 - FpN^.BitOff - NumBits;
                    TreePtr^.UnSubOp := NumBits * 16 + MyRightBit;
                    END;
                  END {FIELD}
                ELSE IF FpN^.Class = FUNC THEN
                  BEGIN
                  InFunc := False;
                  FOR i := Top DOWNTO 1 DO
                    WITH Display[i] DO
                      IF Occur = BLK THEN IF RootLink = FpN THEN InFunc := True;
                  IF (NOT InFunc) OR (Token IN SelectSys + [LPARENSY]) THEN    {!12-05-83}
                    BEGIN {this is a function call followed by a selection}
                    gAttr.TreePtr := NIL;
                    Call(FSys + [UPARROWSY], FpN);
                    IF FpN^.PFdeclKind = STANDARD THEN
                      lOp := 178 {STDFUNC}
                    ELSE
                      lOp := 176; {USRFUNC}
                    TreePtr := NewBinNode(lOp, FpN, gAttr.TreePtr);
                    IF NOT (Token IN SelectSys) THEN Error(28);
                    END
                  ELSE IF FpN^.PFdeclKind = STANDARD THEN Error(145);
                  END; {FUNC}
                END;                                                           {!C}
              END;

            Select(FSys, lAttr, Pckd, PckdStorage, SawClassId);

            IF SawClassId THEN Error(812); {check for just baldly including a
                                            class name}                        {!C}

            gAttr := lAttr;
            END;
        END; {Selector}

      {$S BODY1 }

      PROCEDURE Expression{fsys: setofsys};

        VAR
          lToken: Symbol;
          lAttr: Attr;
          Op, Lo, Hi, m, SubOp: Integer;
          lCompTypes: Boolean;

        PROCEDURE SimpleExpression(FSys: SetOfSys);

          VAR
            lToken: Symbol;
            lAttr: Attr;
            Signed, Negative: Boolean;
            Op: Integer;

          PROCEDURE Term(FSys: SetOfSys);

            VAR
              lToken: Symbol;
              lAttr: Attr;
              Op: Integer;

            PROCEDURE Factor(FSys: SetOfSys);

              VAR
                PckdFlag, PckdStorage, SawClassId: Boolean;
                lpN: pN;
                lpT: pT;
                lOp: Integer;

              PROCEDURE BuildSet;

                VAR
                  ExitFlag: Boolean;
                  lpN, SetTree, SetCstPart: pN;
                  lpT, SetType: pT;

                BEGIN {BuildSet}
                  WITH gAttr DO
                    BEGIN
                    Scan;
                    SetType := NIL; SetTree := NIL; SetCstPart := NIL;
                    IF Token <> RBRACKSY THEN
                      BEGIN
                      ExitFlag := False;
                      REPEAT
                        Expression(FSys + [COMMASY, COLONSY, RBRACKSY]);
                        IF SetType = NIL THEN
                          SetType := Typtr
                        ELSE IF NOT CompTypes(SetType, Typtr) THEN Error(134);
                        MakeScSize(gAttr, 2);
                        IF Token = COLONSY THEN
                          BEGIN {Double set element}
                          Scan;
                          lpN := TreePtr;
                          Expression(FSys + [COMMASY, RBRACKSY]);
                          IF SetType = NIL THEN
                            SetType := Typtr
                          ELSE IF NOT CompTypes(SetType, Typtr) THEN Error(134);
                          MakeScSize(gAttr, 2);
                          IF (lpN <> NIL) AND (TreePtr <> NIL) THEN
                            IF (lpN^.Node = CSTNODE) AND (TreePtr^.Node =
                               CSTNODE) THEN
                              BEGIN
                              UpdateSetConst(lpN^.CstValu.Ivalu,
                                             TreePtr^.CstValu.Ivalu, SetCstPart);
                              lpN := NIL;
                              END
                            ELSE
                              lpN := NewBinNode(169 {SETR} , lpN, TreePtr)
                          ELSE
                            lpN := NewBinNode(169 {SETR} , lpN, TreePtr);
                          END
                        ELSE IF TreePtr <> NIL THEN
                          IF TreePtr^.Node = CSTNODE THEN
                            BEGIN
                            UpdateSetConst(TreePtr^.CstValu.Ivalu,
                                           TreePtr^.CstValu.Ivalu, SetCstPart);
                            lpN := NIL;
                            END
                          ELSE
                            lpN := NewUnNode(168 {SSET} , TreePtr)
                        ELSE
                          lpN := NewUnNode(168 {SSET} , TreePtr);
                        IF SetTree = NIL THEN
                          SetTree := lpN
                        ELSE IF lpN <> NIL THEN
                          SetTree := NewBinNode(160 {UNION} , SetTree, lpN);
                        IF Token = COMMASY THEN
                          Scan
                        ELSE
                          ExitFlag := True;
                      UNTIL ExitFlag;
                      IF SetType <> NIL THEN
                        IF SetType^.Form > SUBRANGE THEN
                          Error(133)
                        ELSE IF CompTypes(SetType, RealPtr) THEN Error(164);
                      END;
                    New(lpT, SETS);
                    WITH lpT^ DO
                      BEGIN
                      FType := False; Form := SETS;
                      SetOf := SetType; Bytes := 0; Bits := 0;
                      END;
                    Typtr := lpT;
                    IF SetCstPart = NIL THEN
                      IF SetTree = NIL THEN
                        BEGIN
                        TreePtr := NewUnNode(31 {NULLSET} , NIL);
                        ASize := 1;
                        END
                      ELSE
                        BEGIN
                        TreePtr := SetTree; ASize := 0;
                        END
                    ELSE
                      BEGIN
                      SetCstPart^.CstType := lpT;
                      WITH lpT^ DO
                        BEGIN
                        Bytes := (SetCstPart^.CstValu.MaxSetEl DIV 8) + 1;
                        IF (Bytes > 1) AND Odd(Bytes) THEN Bytes := Bytes + 1;
                        END;
                      IF SetTree = NIL THEN
                        BEGIN
                        TreePtr := SetCstPart; ASize := lpT^.Bytes;
                        END
                      ELSE
                        BEGIN
                        SetCstPart := NewUnNode(170 {ADJUST} , SetCstPart);
                        SetCstPart^.UnSubOp := lpT^.Bytes;
                        TreePtr := NewBinNode(160 {UNION} , SetTree, SetCstPart);
                        ASize := 0;
                        END;
                      END;
                    IF Token = RBRACKSY THEN
                      Scan
                    ELSE
                      Error(34);
                    END;
                END; {BuildSet}

              FUNCTION SetConstant(FpN: pN): Boolean;                          {!01-20-84}

                BEGIN {SetConstant}
                  SetConstant := False;

                  WITH FpN^, gAttr DO
                    IF IdType <> NIL THEN
                      IF IdType^.Form = SETS THEN
                        BEGIN
                        Typtr := IdType;
                        IF ValueOf.MaxSetEl = -1 THEN
                          BEGIN {Null set constant, []}
                          TreePtr := NewUnNode(31 {NULLSET} , NIL);
                          ASize := 1;
                          END
                        ELSE
                          BEGIN {non-null set constant}
                          New(TreePtr, CSTNODE);
                          TreePtr^.Node := CSTNODE;
                          TreePtr^.CstType := IdType;
                          TreePtr^.CstValu := ValueOf;
                          ASize := IdType^.Bytes;
                          END;

                        SetConstant := True;
                        END;
                END; {SetConstant}

              FUNCTION NumBytes(fVal: LongInt): Integer;

                BEGIN {NumBytes}
                  IF (fVal > 127) OR (fVal < - 128) THEN
                    IF (fVal > 32767) OR (fVal < - 32768) THEN
                      NumBytes := 4
                    ELSE
                      NumBytes := 2
                  ELSE
                    NumBytes := 1;
                END; {NumBytes}

              FUNCTION IntType(fSize: Integer): pT;

                BEGIN {IntType}
                  IF fSize = 1 THEN
                    IntType := SIntPtr
                  ELSE IF fSize = 2 THEN
                    IntType := IntPtr
                  ELSE
                    IntType := LIntPtr;
                END; {IntType}

              BEGIN {Factor}
                WITH gAttr DO
                  BEGIN
                  TreePtr := NIL; PckdFlag := False;
                  IF NOT (Token IN FacBegSys) THEN
                    BEGIN
                    Skip(27, FSys + FacBegSys); Typtr := NIL;
                    END;
                  REPEAT
                    IF Token IN FacBegSys THEN
                      BEGIN
                      CASE Token OF                                            {!}{[@=10]}
                        IDENTSY:  BEGIN
                                  lpN := SearchAll([VARS, FIELD, FUNC, CONSTS,
                                                   TYPES]);                    {!C}
                                  Scan;
                                  CASE lpN^.Class OF
                                    CONSTS:   IF NOT SetConstant(lpN) THEN     {!01-20-84}
                                                WITH lpN^ DO
                                                  BEGIN
                                                  Typtr := IdType;
                                                  New(TreePtr, CSTNODE);
                                                  TreePtr^.Node := CSTNODE;
                                                  TreePtr^.CstValu := ValueOf;
                                                  IF CompTypes(IdType, IntPtr) THEN
                                                    BEGIN
                                                    ASize := NumBytes(ValueOf.Ivalu);
                                                    TreePtr^.CstType := IntType(ASize);
                                                    END
                                                  ELSE
                                                    BEGIN
                                                    ASize := FullBytes(IdType);
                                                    TreePtr^.CstType := IdType;
                                                    END;
                                                  END;

                                    VARS, FIELD:
                                              BEGIN
                                              WITH gAttr DO
                                                BEGIN                          {!10-18}
                                                Typtr := lpN^.IdType;
                                                TreePtr := lpN;
                                                ASize := FullBytes(Typtr);
                                                END;
                                              Selector(FSys, lpN, PckdFlag,
                                                       PckdStorage);
                                              END;

                                    TYPES:    BEGIN
                                              IF Token = LPARENSY THEN         {!10-6-83}
                                                TypeConvert(FSys, Expression, lpN)
                                              ELSE
                                                WITH gAttr DO
                                                  BEGIN                        {!10-18}
                                                  Typtr := lpN^.IdType;
                                                  TreePtr := lpN;
                                                  ASize := FullBytes(Typtr);
                                                  END;
                                              IF lpN <> NIL THEN
                                                Selector(FSys, lpN, PckdFlag,
                                                         PckdStorage);         {!C}
                                              END;

                                    FUNC:     BEGIN
                                              IF Display[Disx].Occur = KLASS THEN
                                                BEGIN
                                                WITH gAttr DO
                                                  BEGIN                        {!10-18}
                                                  Typtr := lpN^.IdType;
                                                  TreePtr := lpN;
                                                  ASize := FullBytes(Typtr);
                                                  END;
                                                Selector(FSys, lpN, PckdFlag,
                                                         PckdStorage)
                                                END
                                              ELSE
                                                BEGIN
                                                Call(FSys, lpN);
                                                IF lpN^.PFdeclKind = STANDARD THEN
                                                  lOp := 178 {STDFUNC}
                                                ELSE
                                                  lOp := 176; {USRFUNC}
                                                TreePtr := NewBinNode(lOp, lpN,
                                                           TreePtr);
                                                IF Token IN SelectSys THEN     {!12-05-83}
                                                  BEGIN
                                                  SawClassId := False;
                                                  Select(FSys, gAttr, PckdFlag,
                                                         PckdStorage, SawClassId);
                                                  END;
                                                END;
                                              END;
                                  END;
                                  END;

                        ICONSTSY: BEGIN
                                  ASize := NumBytes(IntVal);
                                  Typtr := IntType(ASize);
                                  New(TreePtr, CSTNODE);
                                  WITH TreePtr^ DO
                                    BEGIN
                                    Node := CSTNODE; CstType := Typtr;
                                    CstValu.Ivalu := IntVal;
                                    END;
                                  Scan;
                                  END;

                        RCONSTSY: BEGIN
                                  Typtr := RealPtr; ASize := 4;
                                  New(TreePtr, CSTNODE);
                                  WITH TreePtr^ DO
                                    BEGIN
                                    Node := CSTNODE; CstType := RealPtr;
                                    CstValu.Rvalu := RealVal;
                                    END;
                                  Scan;
                                  END;

                        CCONSTSY: BEGIN
                                  Typtr := CharPtr; ASize := 2;
                                  New(TreePtr, CSTNODE);
                                  WITH TreePtr^ DO
                                    BEGIN
                                    Node := CSTNODE; CstType := CharPtr;
                                    CstValu.Ivalu := IntVal;
                                    END;
                                  Scan;
                                  END;

                        SCONSTSY: BEGIN
                                  IF IntVal > 0 THEN
                                    BEGIN
                                    New(lpT, SCONST);
                                    WITH lpT^ DO
                                      BEGIN
                                      FType := False; Form := SCONST;
                                      StringLen := IntVal; Bits := 0;
                                      Bytes := IntVal;
                                      IF (Bytes <> 1) AND Odd(Bytes) THEN
                                        Bytes := Bytes + 1;
                                      END;
                                    END
                                  ELSE
                                    lpT := Str0Ptr;
                                  Typtr := lpT; ASize := lpT^.StringLen;
                                  New(TreePtr, CSTNODE);
                                  WITH TreePtr^ DO
                                    BEGIN
                                    Node := CSTNODE; CstType := lpT;
                                    CstValu.Svalu := StrVal;
                                    CstValu.SvaluLen := IntVal;
                                    END;
                                  Scan;
                                  END;

                        LPARENSY: BEGIN
                                  Scan; Expression(FSys + [RPARENSY]);
                                  IF Token = RPARENSY THEN
                                    Scan
                                  ELSE
                                    Error(32);
                                  END;

                        NOTSY:    BEGIN
                                  Scan; Factor(FSys); ASize := 1;
                                  TreePtr := NewUnNode(110 {NOT} , TreePtr);
                                  IF NOT CompTypes(Typtr, BoolPtr) THEN
                                    BEGIN
                                    Error(132); Typtr := NIL;
                                    END;
                                  END;

                        NILSY:    BEGIN
                                  Scan;
                                  Typtr := NilPtr; ASize := 4;
                                  TreePtr := NewUnNode(23 {NIL} , NIL);
                                  END;

                        LBRACKSY: BuildSet;

                        ATSIGNSY: BEGIN
                                  Scan;
                                  IF Token = IDENTSY THEN
                                    BEGIN
                                    lpN := SearchAll([VARS, FIELD, FUNC, PROC]);
                                    Scan;
                                    IF lpN^.Class <= FIELD THEN
                                      BEGIN
                                      WITH gAttr DO
                                        BEGIN                                  {!10-18}
                                        Typtr := lpN^.IdType;
                                        TreePtr := lpN;
                                        ASize := FullBytes(Typtr);
                                        END;
                                      Selector(FSys, lpN, PckdFlag, PckdStorage);
                                      IF PckdFlag THEN Error(163);
                                      TreePtr := NewUnNode(22 {ADDR} , TreePtr);
                                      END
                                    ELSE
                                      BEGIN
                                      TreePtr := NewUnNode(22 {ADDR} , lpN);
                                      IF lpN^.PFdeclKind = DECLARED THEN
                                        IF lpN^.Class = PROC THEN
                                          TreePtr^.UnSubOp := 177 {PROC}
                                        ELSE
                                          TreePtr^.UnSubOp := 176 {FUNC}
                                      ELSE
                                        Error(170);
                                      END;
                                    Typtr := NilPtr;
                                    END
                                  ELSE
                                    BEGIN
                                    Error(29); Typtr := NIL;
                                    END;
                                  ASize := 4;
                                  END;
                      END;
                      IF NOT (Token IN FSys) THEN Skip(20, FSys + FacBegSys);
                      END;
                  UNTIL Token IN FSys;
                  END;
              END; {Factor}

            BEGIN {Term}
              Factor(FSys + [DIVSY, STARSY, MODSY, ANDSY, SLASHSY]);

              WHILE Token IN [DIVSY, STARSY, MODSY, ANDSY, SLASHSY] DO
                BEGIN
                lAttr := gAttr; lToken := Token; Scan;
                Factor(FSys + [DIVSY, STARSY, MODSY, ANDSY, SLASHSY]);
                IF (lAttr.Typtr <> NIL) AND (gAttr.Typtr <> NIL) THEN
                  WITH gAttr DO
                    CASE lToken OF
                      ANDSY:    IF CompTypes(lAttr.Typtr, BoolPtr) AND
                                   CompTypes(Typtr, BoolPtr) THEN
                                  TreePtr := NewBinNode(80 {AND} , lAttr.TreePtr,
                                                        TreePtr)
                                ELSE
                                  BEGIN
                                  Error(132); Typtr := NIL;
                                  END;

                      DIVSY, MODSY:
                                IF CompTypes(lAttr.Typtr, IntPtr) AND
                                   CompTypes(Typtr, IntPtr) THEN
                                  BEGIN
                                  MinSize2(lAttr); MinSize2(gAttr);
                                  MatchISizes(lAttr, gAttr);
                                  Op := Ord(lAttr.ASize > 2);
                                  IF lToken = DIVSY THEN
                                    BEGIN
                                    TreePtr := NewBinNode(70 {IDIV} + Op,
                                                          lAttr.TreePtr,
                                               TreePtr);
                                    IF OflowFlag AND (Op = 0) THEN
                                      TreePtr := NewUnNode($8C {TRAPV} , TreePtr);
                                    END
                                  ELSE
                                    TreePtr := NewBinNode(72 {MOD} + Op,
                                                          lAttr.TreePtr,
                                               TreePtr);
                                  END
                                ELSE
                                  BEGIN
                                  Error(131); Typtr := NIL;
                                  END;

                      SLASHSY:  BEGIN
                                IF CompTypes(lAttr.Typtr, IntPtr) THEN
                                  Float(lAttr);
                                IF CompTypes(Typtr, IntPtr) THEN Float(gAttr);
                                IF CompTypes(Typtr, RealPtr) AND
                                   CompTypes(lAttr.Typtr, RealPtr) THEN
                                  TreePtr := NewBinNode(118 {RDIV} ,
                                                        lAttr.TreePtr, TreePtr)
                                ELSE
                                  BEGIN
                                  Error(131); Typtr := NIL;
                                  END;
                                END;

                      STARSY:   IF CompTypes(lAttr.Typtr, IntPtr) AND
                                   CompTypes(Typtr, IntPtr) THEN
                                  BEGIN
                                  MinSize2(lAttr); MinSize2(gAttr);
                                  MatchISizes(lAttr, gAttr);
                                  Op := Ord(lAttr.ASize > 2);
                                  TreePtr := NewBinNode(68 {IMULT} + Op,
                                                        lAttr.TreePtr, TreePtr);
                                  IF OflowFlag THEN
                                    TreePtr := NewUnNode($8C {TRAPV} , TreePtr);
                                  END
                                ELSE
                                  BEGIN
                                  IF CompTypes(lAttr.Typtr, IntPtr) THEN
                                    Float(lAttr);
                                  IF CompTypes(Typtr, IntPtr) THEN Float(gAttr);
                                  IF CompTypes(lAttr.Typtr, RealPtr) AND
                                     CompTypes(Typtr, RealPtr) THEN
                                    TreePtr := NewBinNode(116 {RMULT} ,
                                                          lAttr.TreePtr, TreePtr)
                                  ELSE IF CompTypes(Typtr, lAttr.Typtr) AND
                                          (Typtr^.Form = SETS) THEN
                                    BEGIN
                                    MatchSetSizes(gAttr, lAttr);
                                    TreePtr := NewBinNode(162 {INTER} ,
                                                          lAttr.TreePtr,
                                               TreePtr);
                                    TreePtr^.BinSubOp := gAttr.ASize;
                                    END
                                  ELSE
                                    BEGIN
                                    Error(131); Typtr := NIL;
                                    END;
                                  END;
                    END;
                END;
            END; {Term}

          BEGIN {SimpleExpression}
            Negative := Token = MINUSSY;
            Signed := (Token = PLUSSY) OR Negative;
            IF Signed THEN Scan;
            Term(FSys + [PLUSSY, MINUSSY, ORSY]);
            IF gAttr.Typtr <> NIL THEN                                         {!6-17-83}
              IF Signed THEN
                IF CompTypes(gAttr.Typtr, IntPtr) THEN
                  BEGIN
                  IF Negative THEN
                    IF gAttr.TreePtr^.Node = CSTNODE THEN
                      gAttr.TreePtr^.CstValu.Ivalu := - gAttr.TreePtr^.CstValu.
                                                      Ivalu
                    ELSE
                      BEGIN
                      MinSize2(gAttr); Op := Ord(gAttr.ASize > 2);
                      gAttr.TreePtr := NewUnNode(74 {INEG} + Op, gAttr.TreePtr);
                      IF OflowFlag THEN
                        gAttr.TreePtr := NewUnNode($8C {TRAPV} , gAttr.TreePtr);
                      END;
                  END
                ELSE IF CompTypes(gAttr.Typtr, RealPtr) THEN
                  BEGIN
                  IF Negative THEN
                    IF gAttr.TreePtr^.Node = CSTNODE THEN
                      gAttr.TreePtr^.CstValu.Rvalu := - gAttr.TreePtr^.CstValu.
                                                      Rvalu
                    ELSE
                      gAttr.TreePtr := NewUnNode(134 {RNEG} , gAttr.TreePtr);
                  END
                ELSE
                  Error(140);

            WHILE Token IN [PLUSSY, MINUSSY, ORSY] DO
              BEGIN
              lToken := Token; lAttr := gAttr; Scan;
              Term(FSys + [PLUSSY, MINUSSY, ORSY]);
              IF (lAttr.Typtr <> NIL) AND (gAttr.Typtr <> NIL) THEN
                CASE lToken OF
                  MINUSSY, PLUSSY:
                            IF CompTypes(lAttr.Typtr, IntPtr) AND
                               CompTypes(gAttr.Typtr, IntPtr) THEN
                              BEGIN
                              MinSize2(lAttr); MinSize2(gAttr);
                              MatchISizes(lAttr, gAttr);
                              Op := Ord(lAttr.ASize > 2);
                              IF lToken = PLUSSY THEN
                                gAttr.TreePtr := NewBinNode(64 {IADD} + Op,
                                                            lAttr.TreePtr,
                                                            gAttr.TreePtr)
                              ELSE
                                gAttr.TreePtr := NewBinNode(66 {ISUB} + Op,
                                                            lAttr.TreePtr,
                                                            gAttr.TreePtr);
                              IF OflowFlag THEN
                                gAttr.TreePtr := NewUnNode($8C {TRAPV} ,
                                                           gAttr.TreePtr);
                              END
                            ELSE
                              BEGIN
                              IF CompTypes(lAttr.Typtr, IntPtr) THEN Float(lAttr);
                              IF CompTypes(gAttr.Typtr, IntPtr) THEN Float(gAttr);
                              IF CompTypes(lAttr.Typtr, RealPtr) AND
                                 CompTypes(gAttr.Typtr, RealPtr) THEN
                                IF lToken = PLUSSY THEN
                                  gAttr.TreePtr := NewBinNode(112 {RADD} ,
                                                   lAttr.TreePtr, gAttr.TreePtr)
                                ELSE
                                  gAttr.TreePtr := NewBinNode(114 {RSUB} ,
                                                   lAttr.TreePtr, gAttr.TreePtr)
                              ELSE IF CompTypes(lAttr.Typtr, gAttr.Typtr) AND
                                      (lAttr.Typtr^.Form = SETS) THEN
                                BEGIN
                                MatchSetSizes(gAttr, lAttr);
                                IF lToken = PLUSSY THEN
                                  gAttr.TreePtr := NewBinNode(160 {UNION} ,
                                                   lAttr.TreePtr, gAttr.TreePtr)
                                ELSE
                                  gAttr.TreePtr := NewBinNode(161 {DIFF} ,
                                                   lAttr.TreePtr, gAttr.TreePtr);
                                gAttr.TreePtr^.BinSubOp := gAttr.ASize;
                                END
                              ELSE
                                BEGIN
                                Error(131); gAttr.Typtr := NIL;
                                END;
                              END;

                  ORSY:     IF CompTypes(lAttr.Typtr, BoolPtr) AND
                               CompTypes(gAttr.Typtr, BoolPtr) THEN
                              gAttr.TreePtr := NewBinNode(83 {OR} , lAttr.TreePtr,
                                                          gAttr.TreePtr)
                            ELSE
                              BEGIN
                              Error(132); gAttr.Typtr := NIL;
                              END;
                END;
              END;
          END; {SimpleExpression}

        BEGIN {expression}
          SimpleExpression(FSys + [LTSY, GTSY, LESY, GESY, EQSY, NESY, INSY]);
          IF Token IN [LTSY, GTSY, LESY, GESY, EQSY, NESY, INSY] THEN
            BEGIN
            lToken := Token; lAttr := gAttr; Scan;
            SimpleExpression(FSys);
            IF (lAttr.Typtr <> NIL) AND (gAttr.Typtr <> NIL) THEN
              CASE lToken OF
                LTSY, GTSY, LESY, GESY, EQSY, NESY:
                          BEGIN
                          IF NOT CompTypes(lAttr.Typtr, gAttr.Typtr) AND
                             (lAttr.Typtr^.Form <> CLASSES) THEN              {!C}{!12-05-83}
                            BEGIN
                            IF CompTypes(lAttr.Typtr, IntPtr) THEN
                              Float(lAttr)
                            ELSE IF CompTypes(gAttr.Typtr, IntPtr) THEN
                              Float(gAttr)
                            ELSE IF PAoC(lAttr.Typtr) AND (gAttr.Typtr^.Form =
                                    SCONST) THEN
                              BEGIN
                              GetBounds(lAttr.Typtr^.IndexedBy, Lo, Hi);
                              IF Hi - Lo + 1 <> gAttr.Typtr^.StringLen THEN
                                Error(167);
                              gAttr.Typtr := lAttr.Typtr;
                              gAttr.TreePtr^.CstType := lAttr.Typtr;
                              END
                            ELSE IF PAoC(gAttr.Typtr) AND (lAttr.Typtr^.Form =
                                    SCONST) THEN
                              BEGIN
                              GetBounds(gAttr.Typtr^.IndexedBy, Lo, Hi);
                              IF Hi - Lo + 1 <> lAttr.Typtr^.StringLen THEN
                                Error(167);
                              lAttr.Typtr := gAttr.Typtr;
                              lAttr.TreePtr^.CstType := gAttr.Typtr;
                              END
                            ELSE IF ((lAttr.Typtr^.Form = SCONST) OR
                                    (lAttr.Typtr^.Form = STRINGS)) AND (
                                    (gAttr.Typtr = CharPtr) AND
                                    (gAttr.TreePtr^.Node = CSTNODE)) THEN
                              ChToString(gAttr)
                            ELSE IF ((lAttr.Typtr^.Form = SCONST) OR
                                    (lAttr.Typtr^.Form = STRINGS)) AND (
                                    (gAttr.Typtr = CharPtr) AND
                                    (gAttr.TreePtr^.Node = CSTNODE)) THEN
                              ChToString(lAttr);
                            END;
                          {Check CompTypes both ways because classes are
                           not commutative. }
                          lCompTypes := CompTypes(lAttr.Typtr, gAttr.Typtr);   {!C}{!12-05-83}
                          IF NOT lCompTypes THEN
                            lCompTypes := CompTypes(gAttr.Typtr, lAttr.Typtr);
                          IF lCompTypes THEN
                            BEGIN
                            Op := 0; m := 1; SubOp := 0;
                            CASE gAttr.Typtr^.Form OF
                              SCALAR, SUBRANGE:
                                        BEGIN
                                        IF CompTypes(gAttr.Typtr, RealPtr) THEN
                                          BEGIN
                                          Op := 122; {RLT} m := 2;
                                          END
                                        ELSE
                                          BEGIN
                                          MatchISizes(lAttr, gAttr);
                                          Op := 92 {ILT} ; m := 3;
                                          IF lAttr.ASize > 1 THEN
                                            IF lAttr.ASize > 2 THEN
                                              Op := Op + 2
                                            ELSE
                                              Op := Op + 1;
                                          END;
                                        END;

                              CLASSES, POINTERS:
                                        BEGIN
                                        IF (lToken <> EQSY) AND (lToken <>
                                           NESY) THEN
                                          Error(128);
                                        Op := 94; m := 3;
                                        END;

                              SETS:     BEGIN
                                        IF (lToken = LTSY) OR (lToken = GTSY) THEN
                                          Error(129);
                                        MatchSetSizes(gAttr, lAttr);
                                        Op := 162; SubOp := gAttr.ASize;
                                        END;

                              ARRAYS:   BEGIN
                                        IF NOT StringType(gAttr.Typtr) THEN
                                          Error(131);
                                        GetBounds(gAttr.Typtr^.IndexedBy, Lo, Hi);
                                        Op := 150 {PACLT} ; SubOp := Hi;
                                        END;

                              RECORDS:  Error(131);

                              FILES:    Error(130);

                              SCONST, STRINGS:
                                        Op := 144 {STRLT} ;
                            END;

                            gAttr.TreePtr := NewBinNode(Op + (Ord(lToken) -
                                                        Ord(LTSY)) * m,
                                                        lAttr.TreePtr,
                                                        gAttr.TreePtr);
                            gAttr.TreePtr^.BinSubOp := SubOp;
                            gAttr.Typtr := BoolPtr; gAttr.ASize := 1;
                            END
                          ELSE
                            BEGIN
                            Error(144); gAttr.Typtr := NIL;
                            END;
                          END;

                INSY:     IF gAttr.Typtr^.Form = SETS THEN
                            IF CompTypes(lAttr.Typtr, gAttr.Typtr^.SetOf) THEN
                              BEGIN
                              MakeScSize(lAttr, 2);
                              gAttr.TreePtr := NewBinNode(163 {IN} ,
                                                          lAttr.TreePtr,
                                                          gAttr.TreePtr);
                              gAttr.TreePtr^.BinSubOp := gAttr.ASize;
                              gAttr.Typtr := BoolPtr; gAttr.ASize := 1;
                              END
                            ELSE
                              BEGIN
                              Error(127); gAttr.Typtr := NIL;
                              END
                          ELSE
                            BEGIN
                            Error(131); gAttr.Typtr := NIL;
                            END;
              END
            ELSE
              gAttr.Typtr := NIL;
            END;
        END; {Expression}

      FUNCTION StringAss(ToType: pT; VAR FAttr: Attr): Boolean;

        VAR
          StringFlag: Boolean;
          Min, Max, lSize: Integer;

        BEGIN {StringAss}
          StringFlag := False;
          IF (ToType <> NIL) AND (FAttr.Typtr <> NIL) THEN
            BEGIN
            IF ToType^.Form = ARRAYS THEN
              BEGIN
              GetBounds(ToType^.IndexedBy, Min, lSize);
              IF PAoC(ToType) THEN
                IF FAttr.Typtr^.Form = ARRAYS THEN
                  BEGIN
                  GetBounds(FAttr.Typtr^.IndexedBy, Min, Max);
                  IF lSize <> Max THEN Error(167);
                  StringFlag := True;
                  END
                ELSE IF FAttr.Typtr^.Form = SCONST THEN
                  BEGIN
                  IF FAttr.Typtr^.StringLen <> lSize THEN Error(167);
                  FAttr.TreePtr^.CstType := ToType; StringFlag := True;
                  END;
              END {form = ARRAYS}
            ELSE IF ToType^.Form = STRINGS THEN
              BEGIN
              IF (FAttr.Typtr = CharPtr) AND (FAttr.TreePtr <> NIL) THEN
                BEGIN
                IF FAttr.TreePtr^.Node = CSTNODE THEN
                  BEGIN
                  StringFlag := True; ChToString(FAttr);
                  END;
                END
              ELSE IF FAttr.Typtr^.Form = STRINGS THEN
                BEGIN
                IF RangeFlag THEN
                  BEGIN
                  FAttr.TreePtr := NewBinNode(47 {SRNGCHK} , NIL, FAttr.TreePtr);
                  FAttr.TreePtr^.BinSubOp := ToType^.StringLen;
                  END;
                StringFlag := True;
                END
              ELSE IF FAttr.Typtr^.Form = SCONST THEN
                BEGIN
                StringFlag := True;
                IF FAttr.Typtr^.StringLen > ToType^.StringLen THEN Error(168);
                END;
              END;
            END; {<> nil}
          StringAss := StringFlag;
        END; {StringAss}

      {$S BODY2}

      PROCEDURE Call{fsys: setofsys; fpn: pn};

        PROCEDURE Variable(FSys: SetOfSys); {copy in Selector}

          VAR
            lpN: pN;
            PckdFlag, PckdStorage: Boolean;
            OldExprDHandle: Integer;                                           {!C}

          BEGIN {Variable}
            OldExprDHandle := ExprDHandle;                                     {!C}
            IF Token = IDENTSY THEN
              BEGIN
              lpN := SearchAll([VARS, FIELD, FUNC, TYPES]); Scan;              {!5-24,!10-13-83}
              END
            ELSE
              BEGIN
              Error(29); lpN := uVarPtr;
              END;
            WITH gAttr DO
              BEGIN                                                            {!10-18}
              Typtr := lpN^.IdType; TreePtr := lpN; ASize := FullBytes(Typtr);
              END;
            Selector(FSys, lpN, PckdFlag, PckdStorage);
            IF PckdFlag THEN Error(165);
            IF HandleCheck AND (ExprDHandle <> OldExprDHandle) THEN Error(815); {!C}
          END; {Variable}

        FUNCTION IsConsTree(FpN: pN): Boolean;

          BEGIN {IsConsTree}
            IF FpN <> NIL THEN
              IsConsTree := FpN^.Node = CSTNODE
            ELSE
              IsConsTree := False;
          END; {IsConsTree}

        FUNCTION RealString(VAR FAttr: Attr): Boolean;

          VAR
            lpT: pT;

          BEGIN {RealString}
            lpT := FAttr.Typtr;
            IF lpT <> NIL THEN
              IF (lpT^.Form = STRINGS) OR (lpT^.Form = SCONST) THEN
                RealString := True
              ELSE IF (lpT = CharPtr) AND IsConsTree(FAttr.TreePtr) THEN
                BEGIN
                RealString := True; ChToString(FAttr);
                END
              ELSE
                RealString := False
            ELSE
              RealString := True;
          END; {RealString}

        PROCEDURE NewArg(VAR FpN: pN; fOp: Integer);

          VAR
            lpN, lpN2: pN;

          BEGIN {NewArg}
            lpN := NewBinNode(fOp, gAttr.TreePtr, NIL);
            IF FpN = NIL THEN
              FpN := lpN
            ELSE
              BEGIN
              lpN2 := FpN;
              WHILE lpN2^.RightArg <> NIL DO lpN2 := lpN2^.RightArg;
              lpN2^.RightArg := lpN;
              END;
          END; {NewArg}

        PROCEDURE LeftParen;

          BEGIN {LeftParen}
            IF Token = LPARENSY THEN
              Scan
            ELSE
              Error(31);
          END; {LeftParen}

        PROCEDURE RightParen;

          BEGIN {RightParen}
            IF Token = RPARENSY THEN
              Scan
            ELSE
              Error(32);
          END; {RightParen}

        PROCEDURE Comma;

          BEGIN {Comma}
            IF Token = COMMASY THEN
              Scan
            ELSE
              Error(38);
          END; {Comma}

        PROCEDURE CallNonStandard;

          VAR
            FormArgList, ActArgList, lpN: pN;
            lVKind: AccessKind;
            lSize: Integer;
            NormalParam, lUNIVflag: Boolean;                                   {!04-14-84}

          FUNCTION PListError(ActArgs, FormArgs: pN): Boolean;

            BEGIN {PListError}
              PListError := False;
              WHILE (ActArgs <> NIL) AND (FormArgs <> NIL) DO
                BEGIN
                IF ActArgs^.Class <> FormArgs^.Class THEN
                  PListError := True
                ELSE IF ActArgs^.Class = VARS THEN
                  BEGIN
                  IF NOT EqTypes(ActArgs^.IdType, FormArgs^.IdType) OR         {!C}
                     (ActArgs^.Vkind <> FormArgs^.Vkind) THEN
                    PListError := True;
                  END
                ELSE
                  BEGIN { actargs^.class = FUNC or PROC }
                  IF PListError(ActArgs^.PFargList, FormArgs^.PFargList) THEN
                    PListError := True;
                  IF ActArgs^.Class = FUNC THEN
                    IF ActArgs^.IdType <> FormArgs^.IdType THEN
                      PListError := True;
                  END;
                ActArgs := ActArgs^.Next; FormArgs := FormArgs^.Next;
                END;
              IF (ActArgs <> NIL) OR (FormArgs <> NIL) THEN PListError := True;
            END; {PListError}

          BEGIN {CallNonStandard}
            FSys := FSys + [COMMASY, RPARENSY];
            FormArgList := FpN^.PFargList; ActArgList := NIL;
            IF Token = LPARENSY THEN
              BEGIN
              REPEAT
                Scan;
                IF FormArgList <> NIL THEN
                  BEGIN
                  NormalParam := FormArgList^.Class = VARS;
                  IF NormalParam THEN lVKind := FormArgList^.Vkind;
                  END
                ELSE
                  BEGIN
                  lVKind := DRCT; NormalParam := True;
                  END;
                IF NormalParam THEN
                  IF lVKind = DRCT THEN
                    Expression(FSys)
                  ELSE
                    Variable(FSys)
                ELSE IF Token = IDENTSY THEN
                  BEGIN
                  lpN := SearchAll([PROC, FUNC]);
                  IF lpN^.PFdeclKind = STANDARD THEN
                    Error(154)
                  ELSE
                    BEGIN
                    IF PListError(lpN^.PFargList, FormArgList^.PFargList) THEN
                      Error(159);
                    END;
                  IF lpN^.Class = FUNC THEN
                    IF lpN^.IdType <> FormArgList^.IdType THEN Error(126);
                  Scan; gAttr.TreePtr := lpN;
                  END
                ELSE
                  Skip(29, FSys);
                IF FormArgList <> NIL THEN
                  WITH FormArgList^ DO
                    BEGIN
                    IF (gAttr.Typtr <> NIL) AND (IdType <> NIL) AND NormalParam THEN
                      BEGIN
                      lSize := FullBytes(IdType);                              {!04-14-84}
                      IF Class = VARS THEN                                     {!04-14-84}
                        lUNIVflag := UNIVflag                                  {!04-14-84}
                      ELSE                                                     {!04-14-84}
                        lUNIVflag := False;                                    {!04-14-84}
                      IF lVKind = INDRCT THEN
                        BEGIN
                        IF NOT lUNIVflag THEN                                   {!04-14-84}
                          IF NOT EqTypes(gAttr.Typtr, IdType) THEN Error(125); {!C}
                        END
                      ELSE { lVKind = DRCT }
                        BEGIN
                        IF NOT lUNIVflag THEN                                  {!04-14-84}
                          IF (IdType = RealPtr) AND CompTypes(gAttr.Typtr, IntPtr) THEN
                            Float(gAttr);
                        IF StringAss(IdType, gAttr) OR CompTypes(IdType, gAttr.Typtr) OR
                           lUNIVflag  THEN                                     {!04-14-84}
                          BEGIN
                          IF IdType^.FType THEN Error(141);
                          IF RangeFlag THEN InsertRangeCheck(IdType, gAttr);   {!6-23-83}
                          IF IdType^.Form <= SUBRANGE THEN
                            BEGIN
                            IF FpN^.PFdecl <> CDECL THEN                       {!03-29-84}
                              MakeScSize(gAttr, lSize)
                            ELSE IF CompTypes(gAttr.Typtr, IntPtr) THEN                                        {!03-29-84}
                              MakeScSize(gAttr, 4) {C wants all LongInt integers}
                            ELSE IF IdType = RealPtr THEN
                              BEGIN {C wants all Double Precesion reals}
                              gAttr.TreePtr := NewUnNode(54 {REAL48}, gAttr.TreePtr);
                              gAttr.ASize := 8;
                              END;
                            END
                          ELSE IF IdType^.Form = SETS THEN
                            MakeSetSize(gAttr, lSize);
                          END
                        ELSE
                          Error(144);
                        END;
                      IF lUNIVflag THEN                                         {!04-14-84}
                        IF FpN^.PFdecl <> CDECL THEN                           {!04-14-84}
                          IF lSize <> FullBytes(gAttr.Typtr) THEN Error(125);  {!04-14-84}
                      END;
                    FormArgList := Next;
                    END
                ELSE
                  Error(124);
                NewArg(ActArgList, 0);
              UNTIL Token <> COMMASY;
              RightParen;
              END;
            IF FormArgList <> NIL THEN Error(124);
            gAttr.TreePtr := ActArgList; gAttr.Typtr := FpN^.IdType;
            IF FpN^.Class = FUNC THEN
              BEGIN                                                            {!C}
              gAttr.ASize := FullBytes(gAttr.Typtr);
              IF (LHSDHandle > 0) AND HandleCheck THEN Error(813);
              END;
            IF (WithDHandle > 0) AND HandleCheck THEN Error(814);              {!C}
          END; {CallNonStandard}

        PROCEDURE CallStdProc;

          PROCEDURE xNewDispose;

            VAR
              ActArgList, lpN: pN;
              TagPt, lpT: pT;
              FoundIt: Boolean;
              lIntVal: pIntList;
              N: Integer;
              lValu: Valu;

            BEGIN {xNewDispose - NEW and DISPOSE}
              ActArgList := NIL; TagPt := NIL; LeftParen;
              Variable(FSys + [RPARENSY, COMMASY]); NewArg(ActArgList, 0);
              IF gAttr.Typtr <> NIL THEN
                IF gAttr.Typtr^.Form <> POINTERS THEN
                  Error(123)
                ELSE IF gAttr.Typtr^.PointerTo <> NIL THEN
                  BEGIN
                  New(lpN, CSTNODE);
                  WITH lpN^ DO
                    BEGIN
                    Node := CSTNODE; CstType := IntPtr;
                    CstValu.Ivalu := FullBytes(gAttr.Typtr^.PointerTo);
                    END;
                  gAttr.TreePtr := lpN; NewArg(ActArgList, 0);
                  IF gAttr.Typtr^.PointerTo^.Form = RECORDS THEN
                    TagPt := gAttr.Typtr^.PointerTo^.VarPart;
                  END;
              WHILE Token = COMMASY DO
                BEGIN
                Scan; Constant(FSys + [RPARENSY, COMMASY], lValu, lpT);
                IF TagPt <> NIL THEN
                  BEGIN
                  IF TagPt^.TagName <> NIL THEN
                    IF NOT CompTypes(TagPt^.TagName^.IdType, lpT) THEN Error(123);
                  N := lValu.Ivalu; FoundIt := False; TagPt := TagPt^.Variants;
                  WHILE (TagPt <> NIL) AND NOT FoundIt DO
                    BEGIN
                    lIntVal := TagPt^.VarValus;
                    WHILE (lIntVal <> NIL) AND NOT FoundIt DO
                      IF lIntVal^.IntVal = N THEN
                        FoundIt := True
                      ELSE
                        lIntVal := lIntVal^.NextInt;
                    IF FoundIt THEN
                      BEGIN
                      lpN^.CstValu.Ivalu := FullBytes(TagPt);
                      TagPt := TagPt^.SubVar;
                      END
                    ELSE
                      TagPt := TagPt^.NextVar;
                    END;
                  END
                ELSE
                  Error(151);
                END;
              RightParen; gAttr.TreePtr := ActArgList;
            END; {xNewDispose}

          PROCEDURE MarkRelease;

            BEGIN {MarkRelease - MARK and RELEASE}
              LeftParen; Variable(FSys + [RPARENSY]);
              gAttr.TreePtr := NewBinNode(0 {???ARGS} , gAttr.TreePtr, NIL);
              IF gAttr.Typtr <> NIL THEN
                IF gAttr.Typtr^.Form <> POINTERS THEN Error(123);
              RightParen;
            END; {MarkRelease}

          PROCEDURE ResetWrite;

            VAR
              ArgList: pN;
              SubOp: Integer;

            BEGIN {ResetWrite - RESET and REWRITE}
              ArgList := NIL; LeftParen;
              Variable(FSys + [RPARENSY, COMMASY]);
              NewArg(ArgList, 0);
              IF gAttr.Typtr <> NIL THEN
                IF gAttr.Typtr^.Form = FILES THEN
                  BEGIN
                  IF gAttr.Typtr = TextPtr THEN
                    SubOp := - 2
                  ELSE IF gAttr.Typtr^.FileOf = NIL THEN
                    SubOp := - 1
                  ELSE IF gAttr.Typtr = InterPtr THEN
                    SubOp := 0
                  ELSE
                    SubOp := FullBytes(gAttr.Typtr^.FileOf);
                  ArgList^.BinSubOp := SubOp;
                  END
                ELSE
                  Error(123);
              Comma; Expression(FSys + [RPARENSY]); NewArg(ArgList, 0);
              IF gAttr.Typtr <> NIL THEN IF NOT RealString(gAttr) THEN Error(123);
              RightParen; gAttr.TreePtr := ArgList;
            END; {ResetWrite}

          PROCEDURE xRead(fKey: Integer);

            VAR
              ActArgList, FileArg, lpN: pN;
              TextFlag, DoneFlag: Boolean;
              FileType: pT;
              Op, SubOp, Lo, Hi, lSize: Integer;

            BEGIN {xRead - READ}
              ActArgList := NIL; FileArg := NIL; TextFlag := True;
              DoneFlag := False;
              IF Token = LPARENSY THEN
                BEGIN
                Scan; Variable(FSys + [COMMASY, RPARENSY]);
                IF gAttr.Typtr <> NIL THEN
                  WITH gAttr.Typtr^ DO
                    IF Form = FILES THEN
                      BEGIN
                      FileType := FileOf;
                      TextFlag := (FileOf = CharPtr) AND PckdFile;
                      IF NOT TextFlag THEN Error(148);                         {!3-30-83ah}
                      NewArg(FileArg, 0);
                      IF Token = COMMASY THEN
                        BEGIN
                        Scan; Variable(FSys + [COMMASY, RPARENSY]);
                        END
                      ELSE
                        DoneFlag := True;
                      END;
                WHILE NOT DoneFlag DO
                  BEGIN
                  IF TextFlag THEN
                    BEGIN
                    IF CompTypes(gAttr.Typtr, IntPtr) THEN
                      BEGIN
                      Op := 1;
                      lSize := FullBytes(gAttr.Typtr);
                      IF lSize = 1 THEN
                        SubOp := 32 {ASS1}
                      ELSE IF lSize = 2 THEN
                        SubOp := 33 {ASS2}
                      ELSE
                        SubOp := 34; {ASS4}
                      END
                    ELSE IF CompTypes(gAttr.Typtr, RealPtr) THEN
                      BEGIN
                      Op := 2; SubOp := 34; {ASS4}
                      END
                    ELSE IF CompTypes(gAttr.Typtr, CharPtr) THEN
                      BEGIN
                      Op := 0; SubOp := 33; {ASS2}
                      END
                    ELSE IF RealString(gAttr) THEN
                      BEGIN
                      Op := 3; SubOp := gAttr.Typtr^.StringLen;
                      END
                    ELSE IF PAoC(gAttr.Typtr) THEN
                      BEGIN
                      GetBounds(gAttr.Typtr^.IndexedBy, Lo, Hi);
                      Op := 4; SubOp := Hi;
                      END
                    ELSE
                      Error(148);
                    END
                  ELSE
                    BEGIN                                                      {!03-30-83 ah}
                    Op := 0; SubOp := 0;
                    END;
                  NewArg(ActArgList, Op);
                  lpN := ActArgList;
                  WHILE lpN^.RightArg <> NIL DO lpN := lpN^.RightArg;
                  lpN^.BinSubOp := SubOp;
                  IF Token = COMMASY THEN
                    BEGIN
                    Scan; Variable(FSys + [RPARENSY, COMMASY]);
                    END
                  ELSE
                    DoneFlag := True;
                  END;
                RightParen;
                END;
              IF (fKey = 9) { READLN } AND NOT TextFlag THEN Error(148);
              IF (fKey = 8) { READ } AND (ActArgList = NIL) THEN Error(148);
              IF FileArg = NIL THEN
                FileArg := NewBinNode(0 {???ARGS} , InputPtr, NIL);
              FileArg^.RightArg := ActArgList; gAttr.TreePtr := FileArg;
            END; {xRead}

          PROCEDURE xWrite(fKey: Integer);

            VAR
              ActArgList, FileArg, lpN: pN;
              TextFlag, DoneFlag: Boolean;
              FileType: pT;
              lAttr: Attr;
              Op, Lo, Hi: Integer;

            BEGIN {xWrite - WRITE}
              ActArgList := NIL; FileArg := NIL; TextFlag := True;
              DoneFlag := False;
              IF Token = LPARENSY THEN
                BEGIN
                Scan; Expression(FSys + [COMMASY, RPARENSY, COLONSY]);
                IF gAttr.Typtr <> NIL THEN
                  WITH gAttr.Typtr^ DO
                    IF Form = FILES THEN
                      BEGIN
                      FileType := FileOf;
                      TextFlag := (FileOf = CharPtr) AND PckdFile;
                      IF NOT TextFlag THEN Error(123);                         {!3-30-83ah}
                      NewArg(FileArg, 0);
                      IF Token = COMMASY THEN
                        BEGIN
                        Scan; Expression(FSys + [COMMASY, RPARENSY, COLONSY]);
                        END
                      ELSE
                        DoneFlag := True;
                      END;
                WHILE NOT DoneFlag DO
                  BEGIN
                  IF TextFlag THEN
                    BEGIN
                    IF CompTypes(gAttr.Typtr, IntPtr) THEN
                      BEGIN
                      Op := 2; MakeScSize(gAttr, 4);
                      END
                    ELSE IF CompTypes(gAttr.Typtr, CharPtr) THEN
                      BEGIN
                      Op := 0; MakeScSize(gAttr, 1);
                      END
                    ELSE IF CompTypes(gAttr.Typtr, BoolPtr) THEN
                      BEGIN
                      Op := 1; MakeScSize(gAttr, 1);
                      END
                    ELSE IF CompTypes(gAttr.Typtr, RealPtr) THEN
                      Op := 3
                    ELSE IF RealString(gAttr) THEN
                      Op := 5
                    ELSE IF PAoC(gAttr.Typtr) THEN
                      BEGIN
                      Op := 6; New(lpN, CSTNODE);
                      WITH lpN^ DO
                        BEGIN
                        Node := CSTNODE; CstType := IntPtr;
                        GetBounds(gAttr.Typtr^.IndexedBy, Lo, Hi);
                        CstValu.Ivalu := Hi;
                        END;
                      gAttr.TreePtr := NewBinNode(0 {COLON} , gAttr.TreePtr, lpN);
                      END
                    ELSE
                      Error(123);
                    IF Token = COLONSY THEN
                      BEGIN
                      lAttr := gAttr; Scan;
                      Expression(FSys + [COMMASY, COLONSY, RPARENSY]);
                      IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN
                        Error(123)
                      ELSE
                        MakeScSize(gAttr, 2);
                      lAttr.TreePtr := NewBinNode(0 {COLON} , lAttr.TreePtr,
                                                  gAttr.TreePtr);
                      IF Token = COLONSY THEN
                        BEGIN
                        IF Op <> 3 THEN Error(121);
                        Op := 4; Scan; Expression(FSys + [COMMASY, RPARENSY]);
                        IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN
                          Error(123)
                        ELSE
                          MakeScSize(gAttr, 2);
                        lAttr.TreePtr := NewBinNode(0 {COLON} , lAttr.TreePtr,
                                                    gAttr.TreePtr);
                        END;
                      gAttr := lAttr;
                      END;
                    NewArg(ActArgList, Op);
                    END
                  ELSE {not TextFlag}
                    NewArg(ActArgList, 0);                                     {!3-30-83 ah}
                  IF Token = COMMASY THEN
                    BEGIN
                    Scan; Expression(FSys + [RPARENSY, COMMASY, COLONSY]);
                    END
                  ELSE
                    DoneFlag := True;
                  END;
                RightParen;
                END;
              IF (fKey = 11) {WRITELN} AND NOT TextFlag THEN Error(123);
              IF (fKey = 10) {WRITE} AND (ActArgList = NIL) THEN Error(123);
              IF FileArg = NIL THEN
                FileArg := NewBinNode(0 {???ARGS} , OutputPtr, NIL);
              FileArg^.RightArg := ActArgList; gAttr.TreePtr := FileArg;
            END; {xWrite}

          PROCEDURE xClose;

            VAR
              ArgList, lpN: pN;
              N: Integer;

            BEGIN {xClose - CLOSE}
              ArgList := NIL; N := 0; LeftParen;
              Variable(FSys + [RPARENSY, COMMASY]); NewArg(ArgList, 0);
              IF gAttr.Typtr <> NIL THEN
                IF gAttr.Typtr^.Form <> FILES THEN Error(123);
              IF Token = COMMASY THEN
                BEGIN
                Scan;
                IF Token = IDENTSY THEN
                  BEGIN
                  IF Ident = 'NORMAL  ' THEN
                    N := 0
                  ELSE IF Ident = 'LOCK    ' THEN
                    N := 1
                  ELSE IF Ident = 'PURGE   ' THEN
                    N := 2
                  ELSE IF Ident = 'CRUNCH  ' THEN
                    N := 3
                  ELSE
                    Error(123);
                  Scan;
                  END
                ELSE
                  Error(123);
                END;
              New(lpN, CSTNODE);
              WITH lpN^ DO
                BEGIN
                Node := CSTNODE; CstType := IntPtr; CstValu.Ivalu := N;
                END;
              gAttr.TreePtr := lpN; NewArg(ArgList, 0);
              RightParen; gAttr.TreePtr := ArgList;
            END; {xClose}

          PROCEDURE GetPutPage(fKey: Integer);

            BEGIN {GetPutPage - GET, PUT, and PAGE}
              LeftParen; Variable(FSys + [RPARENSY]);
              gAttr.TreePtr := NewBinNode(0 {???ARGS} , gAttr.TreePtr, NIL);
              IF gAttr.Typtr <> NIL THEN
                WITH gAttr.Typtr^ DO
                  IF Form <> FILES THEN
                    Error(123)
                  ELSE IF fKey = 12 {PAGE} THEN
                    IF (FileOf <> CharPtr) OR NOT PckdFile THEN Error(123);
              RightParen;
            END; {GetPutPage}

          PROCEDURE PackUnpack(fKey: Integer);

            BEGIN {PackUnpack - PACK and UNPACK}
              Error(306);
              IF Token = LPARENSY THEN
                BEGIN
                REPEAT
                  Scan;
                  Expression(FSys + [COMMASY, RPARENSY]);
                UNTIL Token <> COMMASY;
                RightParen;
                END;
            END; {PackUnpack}

          PROCEDURE InsrtDel(fKey: Integer);

            VAR
              ArgList: pN;

            BEGIN {InsrtDel - INSERT and DELETE}
              ArgList := NIL; LeftParen;
              IF fKey = 17 {INSERT} THEN
                BEGIN
                Expression(FSys + [COMMASY, RPARENSY]); NewArg(ArgList, 0);
                IF gAttr.Typtr <> NIL THEN
                  IF NOT RealString(gAttr) THEN Error(123);
                Comma;
                END;
              Variable(FSys + [COMMASY, RPARENSY]); NewArg(ArgList, 0);
              IF gAttr.Typtr <> NIL THEN
                IF gAttr.Typtr^.Form <> STRINGS THEN Error(123);
              Comma; Expression(FSys + [COMMASY, RPARENSY]);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(123);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF fKey = 16 {DELETE} THEN
                BEGIN
                Comma; Expression(FSys + [RPARENSY]);
                IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(123);
                MakeScSize(gAttr, 2); NewArg(ArgList, 0);
                END;
              RightParen; gAttr.TreePtr := ArgList;
            END; {InsrtDel}

          PROCEDURE UnitRWs(fKey: Integer);

            VAR
              ArgList: pN;
              Count: Integer;

            BEGIN {UnitRWs - UNITREAD and UNITWRITE}
              ArgList := NIL; LeftParen;
              Expression(FSys + [COMMASY, RPARENSY]);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(123);
              Comma; Variable(FSys + [COMMASY, RPARENSY]); NewArg(ArgList, 0);
              Count := 0;
              WHILE Token = COMMASY DO
                BEGIN
                Scan; Count := Count + 1;
                Expression(FSys + [COMMASY, RPARENSY]);
                MakeScSize(gAttr, 2); NewArg(ArgList, 0);
                IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(123);
                END;
              IF (Count = 0) OR (Count > 3) OR ((Count > 1) AND (fKey =
                 28 {UNITSTATUS} )) THEN
                Error(124);
              RightParen; gAttr.TreePtr := ArgList;
            END; {UnitRWs}

          PROCEDURE xSeek;

            VAR
              ArgList: pN;

            BEGIN {xSeek - SEEK}
              ArgList := NIL; LeftParen;
              Variable(FSys + [COMMASY, RPARENSY]); NewArg(ArgList, 0);
              IF gAttr.Typtr <> NIL THEN
                IF gAttr.Typtr^.Form <> FILES THEN Error(123);
              Comma; Expression(FSys + [COMMASY, RPARENSY]);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(123);
              RightParen; gAttr.TreePtr := ArgList;
            END; {xSeek}

          PROCEDURE MoveLR;

            VAR
              ArgList: pN;

            BEGIN {MoveLR - MOVELEFT and MOVERIGHT}
              ArgList := NIL;
              LeftParen; Variable(FSys + [COMMASY, RPARENSY]);
              NewArg(ArgList, 0);
              Comma; Variable(FSys + [COMMASY, RPARENSY]); NewArg(ArgList, 0);
              Comma; Expression(FSys + [COMMASY, RPARENSY]);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(123);
              RightParen; gAttr.TreePtr := ArgList;
            END; {MoveLR}

          PROCEDURE xFill;

            VAR
              ArgList: pN;

            BEGIN {xFill - FILLCHAR}
              ArgList := NIL; LeftParen;
              Variable(FSys + [COMMASY, RPARENSY]); NewArg(ArgList, 0);
              IF gAttr.Typtr <> NIL THEN
                WITH gAttr.Typtr^ DO
                  IF Form = ARRAYS THEN
                    BEGIN
                    IF (ArrayOf <> CharPtr) OR NOT PckdArr THEN Error(123);
                    END
                  ELSE IF gAttr.Typtr <> CharPtr THEN Error(123);
              Comma; Expression(FSys + [COMMASY, RPARENSY]);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(123);
              Comma; Expression(FSys + [COMMASY, RPARENSY]);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, CharPtr) THEN Error(123);
              RightParen; gAttr.TreePtr := ArgList;
            END; {xFill}

          PROCEDURE UClear;

            VAR
              ArgList: pN;

            BEGIN {UClear - UNITCLEAR}
              ArgList := NIL; LeftParen;
              Expression(FSys + [RPARENSY]);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(123);
              RightParen; gAttr.TreePtr := ArgList;
            END; {UClear}

          PROCEDURE xGotoXY;

            VAR
              ArgList: pN;

            BEGIN {xGotoXY - GOTOXY}
              ArgList := NIL;
              LeftParen; Expression(FSys + [RPARENSY, COMMASY]);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(123);
              Comma; Expression(FSys + [RPARENSY]);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(123);
              RightParen; gAttr.TreePtr := ArgList;
            END; {xGotoXY}

          PROCEDURE xExit;

            LABEL 1;

            VAR
              ArgList, lpN: pN;
              i: Integer;

            BEGIN {xExit - EXIT}
              LeftParen; ArgList := NIL;
              IF Token = IDENTSY THEN                                          {!C}
                BEGIN
                {lpN := SearchAll([PROC,FUNC]); Scan;
                 ArgList := NewBinNode(0, lpN, NIL);
                 FOR i := Top DOWNTO 1 DO
                   WITH Display[i] do
                     IF Occur = BLK THEN
                       IF lpN = RootLink THEN
                         GOTO 1; }

                FOR i := Top DOWNTO 1 DO
                  WITH Display[i] DO
                    BEGIN
                    IF Occur = BLK THEN
                      BEGIN
                      lpN := RootLink;
                      IF lpN <> NIL THEN
                        IF Ident = lpN^.Name THEN
                          IF (lpN^.Class = PROC) OR (lpN^.Class = FUNC) THEN
                            GOTO 1;
                      END;
                    END;
                lpN := uPrcPtr;
                Error(174);
              1:
                Scan;
                ArgList := NewBinNode(0, lpN, NIL);
                END                                                            {!C}
              ELSE
                Error(29);
              RightParen; gAttr.TreePtr := ArgList;
            END; {xExit}

          BEGIN {CallStdProc}
            WITH FpN^ DO
              CASE Key OF                                                      {!}{[f-]}
                01: { NEW      } xNewDispose;
                02, { MARK     }
                03: { RELEASE  } MarkRelease;
                04, { GET      }
                05: { PUT      } GetPutPage(Key);
                06, { RESET    }
                07: { REWRITE  } ResetWrite;
                08, { READ     }
                09: { READLN   } xRead(Key);
                10, { WRITE    }
                11: { WRITELN  } xWrite(Key);
                12: { PAGE     } GetPutPage(Key);
                13, { PACK     }
                14: { UNPACK   } PackUnpack(Key);
                15: { CLOSE    } xClose;
                16, { DELETE   }
                17: { INSERT   } InsrtDel(Key);
                18, { UNITREAD }
                19: { UNITWRIT } UnitRWs(Key);
                20: { SEEK     } xSeek;
                21: { HALT     } ;
                22, { MOVELEFT }
                23: { MOVERIGH } MoveLR;
                24: { FILLCHAR } xFill;
                25: { UNITCLEA } Uclear;
                26: { GOTOXY   } xGotoXY;
                27: { DISPOSE  } xNewDispose;
                28: { UNITSTAT } UnitRWs(Key);
                29: { EXIT     } xExit;
              END;                                                             {!}{[f+]}
          END; {CallStdProc}

        PROCEDURE CallStdFunc;

          PROCEDURE NewTemp(VAR FpN: pN; FpT: pT);

            VAR
              lLc, lSize: Integer;

            BEGIN {NewTemp}
              lSize := FullBytes(FpT); lLc := - CurrentProc^.Lc;
              IF Odd(lLc) THEN lLc := lLc - 1;
              IF Odd(lSize) THEN lSize := lSize + 1;
              lLc := lLc - lSize; CurrentProc^.Lc := - lLc;
              New(FpN, IDENTNODE, VARS);
              WITH FpN^ DO
                BEGIN
                Node := IDENTNODE; Class := VARS;
                IdType := NIL;                                                 {!OPT!}
                Vkind := DRCT; Vlev := Level; Voff := lLc;
                END;
            END; {NewTemp}

          PROCEDURE Math;

            BEGIN {Math}
              LeftParen; Expression(FSys + [RPARENSY]);
              IF CompTypes(gAttr.Typtr, IntPtr) THEN Float(gAttr);
              gAttr.TreePtr := NewBinNode(0 {???ARGS} , gAttr.TreePtr, NIL);
              IF NOT CompTypes(gAttr.Typtr, RealPtr) THEN Error(122);
              RightParen; gAttr.ASize := 4;
            END; {Math}

          PROCEDURE xChr;

            BEGIN {xChr - CHR}
              LeftParen; Expression(FSys + [RPARENSY]); MakeScSize(gAttr, 2);
              IF RangeFlag THEN                                                {!6-13-83A.H.}
                BEGIN
                gAttr.TreePtr := NewBinNode(46 {RCHECK} , NIL, gAttr.TreePtr);
                gAttr.TreePtr^.LeftPt := CharPtr;
                END;
              gAttr.TreePtr := NewBinNode(0 {???ARGS} , gAttr.TreePtr, NIL);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(122);
              RightParen; gAttr.Typtr := CharPtr; gAttr.ASize := 2;
            END; {xChr}

          PROCEDURE xOdd;

            BEGIN {xOdd - ODD}
              LeftParen; Expression(FSys + [RPARENSY]); MakeScSize(gAttr, 1);
              gAttr.TreePtr := NewBinNode(0 {???ARGS} , gAttr.TreePtr, NIL);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(122);
              RightParen; gAttr.Typtr := BoolPtr; gAttr.ASize := 1;
            END; {xOdd}

          PROCEDURE xOrd(Ord4Flag: Boolean);

            BEGIN {xOrd - ORD and ORD4}
              LeftParen; Expression(FSys + [RPARENSY]);
              IF gAttr.Typtr <> NIL THEN
                IF (gAttr.Typtr^.Form > POINTERS) OR CompTypes(gAttr.Typtr,
                   RealPtr) THEN
                  Error(122);
              IF gAttr.ASize <= 1 THEN
                gAttr.Typtr := SIntPtr
              ELSE IF gAttr.ASize = 2 THEN
                gAttr.Typtr := IntPtr
              ELSE
                gAttr.Typtr := LIntPtr;
              IF Ord4Flag THEN MakeScSize(gAttr, 4);
              gAttr.TreePtr := NewBinNode(0 {???ARGS} , gAttr.TreePtr, NIL);
              RightParen;
            END; {xOrd}

          PROCEDURE PredSucc;

            BEGIN {PredSucc - PRED and SUCC}
              LeftParen; Expression(FSys + [RPARENSY]); MinSize2(gAttr);
              gAttr.TreePtr := NewBinNode(0 {???ARGS} , gAttr.TreePtr, NIL);
              gAttr.TreePtr^.BinSubOp := gAttr.ASize;
              IF gAttr.Typtr <> NIL THEN
                IF (gAttr.Typtr^.Form > SUBRANGE) OR CompTypes(gAttr.Typtr,
                   RealPtr) THEN
                  Error(122);
              RightParen;
            END; {PredSucc}

          PROCEDURE AbsSqr(fKey: Integer);

            VAR
              lOp: Integer;

            BEGIN {AbsSqr - ABS and SQR}
              LeftParen; Expression(FSys + [RPARENSY]);
              IF CompTypes(gAttr.Typtr, IntPtr) THEN
                BEGIN
                MinSize2(gAttr);
                IF gAttr.ASize <= 2 THEN
                  lOp := 76 {ABS2}
                ELSE
                  lOp := 77 {ABS4} ;
                END
              ELSE IF CompTypes(gAttr.Typtr, RealPtr) THEN
                lOp := 136 {FABS4}
              ELSE
                BEGIN
                Error(122); lOp := 76;
                END;
              IF fKey = 14 {SQR} THEN lOp := lOp + 2; {ABS-->SQR}
              gAttr.TreePtr := NewBinNode(lOp, gAttr.TreePtr, NIL);
              IF OflowFlag THEN
                IF lOp <= 79 THEN
                  gAttr.TreePtr := NewUnNode($8C {TRAPV} , gAttr.TreePtr);
              RightParen;
            END; {AbsSqr}

          PROCEDURE EofEolnKeypress(fKey: Integer);

            BEGIN {EofEolnKeypress - EOF, EOLN, and KEYPRESS}
              IF Token = LPARENSY THEN
                BEGIN
                Scan; Variable(FSys + [RPARENSY]);
                gAttr.TreePtr := NewBinNode(0 {???ARGS} , gAttr.TreePtr, NIL);
                IF gAttr.Typtr <> NIL THEN
                  WITH gAttr.Typtr^ DO
                    IF Form <> FILES THEN
                      Error(122)
                    ELSE IF (fKey = 6) OR (fKey = 34) {EOLN or KEYPRESS}
                            THEN
                      IF NOT CompTypes(FileOf, CharPtr) THEN Error(122);
                RightParen;
                END
              ELSE
                gAttr.TreePtr := NewBinNode(0 {???ARGS} , InputPtr, NIL);
              gAttr.Typtr := BoolPtr; gAttr.ASize := 1;
            END; {EofEolnKeypress}

          PROCEDURE RoundTrunc;

            BEGIN {RoundTrunc - ROUND and TRUNC}
              LeftParen; Expression(FSys + [RPARENSY]);
              gAttr.TreePtr := NewBinNode(0 {???ARGS} , gAttr.TreePtr, NIL);
              IF NOT CompTypes(gAttr.Typtr, RealPtr) THEN Error(122);
              RightParen; gAttr.Typtr := LIntPtr; gAttr.ASize := 4;
            END; {RoundTrunc}

          PROCEDURE xPointer;

            BEGIN {xPointer - POINTER}
              LeftParen; Expression(FSys + [RPARENSY]); MakeScSize(gAttr, 4);
              gAttr.TreePtr := NewBinNode(0 {???ARGS} , gAttr.TreePtr, NIL);
              IF gAttr.Typtr <> NIL THEN                                       {!C}
                IF gAttr.Typtr^.Form = CLASSES THEN                            {!C}
                  IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(122);       {!C}
              RightParen; gAttr.Typtr := NilPtr; gAttr.ASize := 4;
            END; {xPointer}

          PROCEDURE LenPos(fKey: Integer);

            VAR
              ArgList: pN;

            BEGIN {LenPos - LENGTH and POS}
              ArgList := NIL;
              LeftParen; Expression(FSys + [RPARENSY, COMMASY]);
              NewArg(ArgList, 0);
              IF NOT RealString(gAttr) THEN Error(122);
              IF fKey = 20 {POS} THEN
                BEGIN
                Comma; Expression(FSys + [RPARENSY]); NewArg(ArgList, 0);
                IF NOT RealString(gAttr) THEN Error(122);
                END;
              RightParen;
              gAttr.TreePtr := ArgList; gAttr.Typtr := IntPtr;
              gAttr.ASize := 2;
            END; {LenPos}

          PROCEDURE xConcat;

            VAR
              ArgList: pN;
              ExitFlag: Boolean;
              lpT: pT;
              MaxSize: Integer;

            BEGIN {xConcat - CONCAT}
              ArgList := NIL; ExitFlag := False; MaxSize := 0;
              LeftParen;
              REPEAT
                Expression(FSys + [RPARENSY, COMMASY]); NewArg(ArgList, 0);
                IF RealString(gAttr) THEN
                  BEGIN
                  IF gAttr.Typtr <> NIL THEN
                    MaxSize := MaxSize + gAttr.Typtr^.StringLen;
                  END
                ELSE
                  Error(122);
                IF Token = COMMASY THEN
                  Scan
                ELSE
                  ExitFlag := True;
              UNTIL ExitFlag;
              RightParen;
              IF MaxSize > 255 THEN MaxSize := 255;
              New(lpT, STRINGS);
              WITH lpT^ DO
                BEGIN
                Bytes := ((MaxSize + 2) DIV 2) * 2; Bits := 0;
                FType := False; Form := STRINGS; StringLen := MaxSize;
                END;
              NewTemp(gAttr.TreePtr, lpT); NewArg(ArgList, 0);
              gAttr.TreePtr := ArgList; gAttr.Typtr := lpT;
            END; {xConcat}

          PROCEDURE xCopy;

            VAR
              ArgList: pN;
              lpT: pT;

            BEGIN {xCopy - COPY}
              ArgList := NIL;
              LeftParen; Expression(FSys + [RPARENSY, COMMASY]);
              NewArg(ArgList, 0);
              IF NOT RealString(gAttr) THEN Error(122);
              lpT := gAttr.Typtr;
              Comma; Expression(FSys + [COMMASY, RPARENSY]);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(122);
              Comma; Expression(FSys + [RPARENSY]);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(122);
              RightParen; NewTemp(gAttr.TreePtr, lpT); NewArg(ArgList, 0);
              gAttr.TreePtr := ArgList; gAttr.Typtr := lpT;
            END; {xCopy}

          PROCEDURE BlockRW;

            VAR
              ArgList: pN;

            BEGIN {BlockRW - BLOCKREAD and BLOCKWRITE}
              ArgList := NIL;
              LeftParen; Variable(FSys + [RPARENSY, COMMASY]);
              NewArg(ArgList, 0);
              IF gAttr.Typtr <> NIL THEN
                IF gAttr.Typtr^.Form <> FILES THEN
                  Error(122)
                ELSE IF gAttr.Typtr^.FileOf <> NIL THEN Error(122);
              Comma; Variable(FSys + [RPARENSY, COMMASY]); NewArg(ArgList, 0);
              Comma; Expression(FSys + [RPARENSY, COMMASY]);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(122);
              IF Token = COMMASY THEN
                BEGIN
                Scan;
                Expression(FSys + [RPARENSY, COMMASY]);
                MakeScSize(gAttr, 2); NewArg(ArgList, 0);
                IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(122);
                END;
              RightParen; gAttr.TreePtr := ArgList;
              gAttr.Typtr := IntPtr; gAttr.ASize := 2;
            END; {BlockRW}

          PROCEDURE xIOResMem(fKey: Integer);

            BEGIN {xIOResMem - IORESULT and MEMAVAIL}
              gAttr.TreePtr := NIL;
              IF (fKey = 25) {IORESULT} OR (fKey = 33) { HEAPRESULT } THEN
                BEGIN
                gAttr.Typtr := IntPtr; gAttr.ASize := 2;
                END
              ELSE { MEMAVAIL}
                BEGIN
                gAttr.Typtr := LIntPtr; gAttr.ASize := 4;
                END;
            END; {xIOResMem}

          PROCEDURE xSizeOf;

            VAR
              lpN, ArgList: pN;
              TypeFlag: Boolean;
              lpT: pT;

            BEGIN {xSizeOf - SIZEOF}
              ArgList := NIL; LeftParen;
              IF Token = IDENTSY THEN
                BEGIN
                PrintErrors := False; lpN := SearchAll([TYPES]);
                PrintErrors := True;
                TypeFlag := lpN <> NIL;
                END;
              IF TypeFlag THEN
                BEGIN
                lpT := lpN^.IdType; Scan;
                END
              ELSE
                BEGIN
                Variable(FSys + [RPARENSY]); lpT := gAttr.Typtr;
                END;
              New(lpN, CSTNODE);
              WITH lpN^ DO
                BEGIN
                Node := CSTNODE; CstType := IntPtr;
                IF lpT = NIL THEN
                  CstValu.Ivalu := 0                                           {!1-31-83}{!C}
                ELSE IF lpT^.Form = CLASSES THEN                               {!1-31-83}{!C}
                  CstValu.Ivalu := lpT^.SizeInstance                           {!1-31-83}{!C}
                ELSE
                  CstValu.Ivalu := FullBytes(lpT);                             {!C}
                END;
              gAttr.TreePtr := lpN; gAttr.Typtr := IntPtr; NewArg(ArgList, 0);
              RightParen; gAttr.TreePtr := ArgList; gAttr.ASize := 2;
            END; {xSizeOf}

          PROCEDURE xPwrOf;

            VAR
              ArgList: pN;

            BEGIN {xPwrOf - PWROFTEN}
              ArgList := NIL;
              LeftParen; Expression(FSys + [RPARENSY]);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(122);
              RightParen; gAttr.TreePtr := ArgList;
              gAttr.Typtr := RealPtr; gAttr.ASize := 4;
            END; {xPwrOf}

          PROCEDURE ScanEqNe;

            VAR
              ArgList: pN;

            BEGIN {ScanEqNe - SCANEQ and SCANNE}
              ArgList := NIL;
              LeftParen; Expression(FSys + [RPARENSY, COMMASY]);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(122);
              Comma; Expression(FSys + [RPARENSY, COMMASY]); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, CharPtr) THEN Error(122);
              Comma; Variable(FSys + [RPARENSY]); NewArg(ArgList, 0);
              IF gAttr.Typtr <> NIL THEN
                WITH gAttr.Typtr^ DO
                  IF Form = ARRAYS THEN
                    BEGIN
                    IF (ArrayOf <> CharPtr) OR NOT PckdArr THEN Error(122);
                    END
                  ELSE IF gAttr.Typtr <> CharPtr THEN Error(122);
              RightParen; gAttr.TreePtr := ArgList;
              gAttr.Typtr := IntPtr; gAttr.ASize := 2;
            END; {ScanEqNe}

          PROCEDURE UBusy;

            VAR
              ArgList: pN;

            BEGIN {UBusy - UNITBUSY}
              ArgList := NIL;
              LeftParen; Expression(FSys + [RPARENSY]);
              MakeScSize(gAttr, 2); NewArg(ArgList, 0);
              IF NOT CompTypes(gAttr.Typtr, IntPtr) THEN Error(122);
              RightParen; gAttr.TreePtr := ArgList;
              gAttr.Typtr := BoolPtr; gAttr.ASize := 1;
            END; {UBusy}

          PROCEDURE xThisClass;                                                {!01-07-84}

            VAR
              ArgList, lpN: pN;

            BEGIN {xThisClass - THISCLASS}
              IF ThisClass = NIL THEN
                Error(819)
              ELSE
                BEGIN
                New(lpN, IDENTNODE, VARS);
                WITH lpN^ DO
                  BEGIN
                  Node := IDENTNODE; Class := VARS; Vkind := DRCT;
                  Next := NIL; IdType := LIntPtr; InRegister := -1;
                  Vlev := ThisClass^.MethodLev;
                  Voff := ThisClass^.MethodOff;
                  END;
                gAttr.TreePtr := NewUnNode(22 {ADDR}, lpN);
                ArgList := NIL; NewArg(ArgList, 0);
                gAttr.TreePtr := ArgList;
                gAttr.Typtr := NilPtr;
                gAttr.ASize := 4;
                END;
            END; {xThisClass}

          PROCEDURE xInClass;                                                  {!01-07-84}

            VAR
              SubOp: Integer;
              ArgList, lpN: pN;

            BEGIN {xInClass - INCLASS}
              ArgList := NIL;
              LeftParen; Expression(FSYS + [RPARENSY, COMMASY]);
              NewArg(ArgList, 0);
              IF gAttr.Typtr <> NIL THEN
                IF gAttr.Typtr^.Form <> CLASSES THEN Error(122);
              Comma;
              gAttr.TreePtr := NIL;
              SubOp := - 1; {-1 ==> error}
              IF Token = IDENTSY THEN
                BEGIN
                lpN := SearchAll([TYPES]); Scan;
                END
              ELSE
                BEGIN
                Error(29); lpN := NIL;
                END;
              IF lpN <> NIL THEN
                IF lpN^.IdType <> NIL THEN
                  IF lpN^.IdType^.Form <> CLASSES THEN
                    Error(122)
                  ELSE IF lpN^.IdType^.NeedsInit THEN
                    BEGIN
                    SubOp := Ord(IDENTNODE);
                    New(gAttr.TreePtr, IDENTNODE, VARS);
                    WITH gAttr.TreePtr^ DO
                      BEGIN
                      IdType := LIntPtr; Next := NIL;
                      Node := IDENTNODE; Class := VARS; Vkind := DRCT;
                      InRegister := - 1;
                      Vlev := lpN^.IdType^.MethodLev;
                      Voff := lpN^.IdType^.MethodOff;
                      END;
                    END
                  ELSE
                    BEGIN
                    SubOp := Ord(CSTNODE);
                    New(gAttr.TreePtr, CSTNODE);
                    WITH gAttr.TreePtr^ DO
                      BEGIN
                      Node := CSTNODE;
                      CstValu.SvaluLen := 8;
                      New(CstValu.Svalu);
                      CstValu.Svalu^.StrPart := lpN^.Name;
                      CstValu.Svalu^.Next := NIL;
                      New(CstType, SCONST);
                      WITH CstType^ DO
                        BEGIN
                        FType := False; Form := SCONST; Bits := 0; Bytes := 8;
                        StringLen := 8;
                        END;
                      END;
                    END;
              NewArg(ArgList, 0);
              ArgList^.RightArg^.BinSubOp := SubOp;
              RightParen;
              gAttr.TreePtr := ArgList;
              gAttr.Typtr := BoolPtr;
              gAttr.ASize := 1;
            END; {xInClass}

          BEGIN {CallStdFunc}
            WITH FpN^ DO
              CASE Key OF                                                      {!}{[f-]}
                 1: {ABS     } AbsSqr(Key);
                 2: {ARCTAN  } Math;
                 3: {CHR     } xChr;
                 4: {COS     } Math;
                 5: {EOF     } EofEolnKeypress(Key);
                 6: {EOLN    } eofeolnkeypress(Key);
                 7: {EXP     } Math;
                 8: {LN      } Math;
                 9: {ODD     } xOdd;
                10: {ORD     } xOrd(False);
                11: {PRED    } PredSucc;
                12: {ROUND   } RoundTrunc;
                13: {SIN     } Math;
                14: {SQR     } AbsSqr(key);
                15: {SQRT    } Math;
                16: {SUCC    } PredSucc;
                17: {TRUNC   } RoundTrunc;
                18: {POINTER } xPointer;
                19, {LENGTH  }
                20: {POS     } LenPos(Key);
                21: {CONCAT  } xConcat;
                22: {COPY    } xCopy;
                23, {BLOCKREA}
                24: {BLOCKWRI} BlockRW;
                25: {IORESULT} xIOResMem(Key);
                26: {SIZEOF  } xSizeOf;
                27: {PWROFTEN} xPwrOf;
                28, {SCANEQ  }
                29: {SCANNE  } ScanEqNe;
                30: {UNITBUSY} Ubusy;
                31: {MEMAVAIL} xIOResMem(Key);
                32: {ORD4    } xOrd(True);
                33: {HEAPRESU} xIOResMem(Key);
                34: {KEYPRESS} EofEolnKeypress(Key);
                35: {THISCLAS} xThisClass;                                     {!01-07-84}
                36: {INCLASS } xInClass;                                       {!01-07-84}
               END;                                                            {!}{[f+]}
          END; {CallStdFunc}

        BEGIN {Call}
          WITH FpN^ DO
            IF PFdeclKind = STANDARD THEN
              IF Class = PROC THEN
                CallStdProc
              ELSE
                CallStdFunc
            ELSE
              CallNonStandard;
        END; {Call}

      {$S BODY1}

      PROCEDURE Assignment(FpN: pN; VAR fStmt: pStmt);

        LABEL 1;                                                               {!C}

        VAR
          lAttr: Attr;
          PckdFlag, PckdStorage: Boolean;
          lStmt: pStmt;
          Lo, Hi, Op, SubOp, lNumbr: Integer;
          TStmt: pStmt;                                                        {!C}
          lpN, AVar: pN;
          NotNilAss: Boolean;
          Ok: Boolean;

        BEGIN {Assignment}
          lNumbr := TotalLines;
          New(lStmt, ASSIGNST); fStmt := lStmt; Op := 0; SubOp := 0;
          WITH lStmt^ DO
            BEGIN
            NextStmt := NIL; StmtOp := ASSIGNST; AssExpr := NIL;
            Flippable := False;                                                {!OPT!}
            ExprDHandle := 0;                                                  {!C}
            LHSDHandle := 0;                                                   {!C}
            WITH gAttr DO
              BEGIN                                                            {!10-18}
              Typtr := FpN^.IdType; TreePtr := FpN; ASize := FullBytes(Typtr);
              END;
            Selector(FSys + [ASSIGNSY], FpN, PckdFlag, PckdStorage);
            AssVar := gAttr.TreePtr;
                                                                               {!C}
            IF AssVar = NIL THEN GOTO 1; {bail out on error}                   {!1-29-83}
            IF AssVar^.Node = TRINODE THEN
              IF AssVar^.TriOp = 184 { METHODCALL } THEN
                BEGIN
                IF AssVar^.TripN^.Class = FUNC THEN Error(804);
                StmtOp := METHODCALL;
                GOTO 1; { no more to do }
                END;                                                           {!C}
            END;

          LHSDHandle := ExprDHandle;                                           {!C}
          IF Token = ASSIGNSY THEN
            BEGIN
            lAttr := gAttr;
            Scan; Expression(FSys);
            IF (gAttr.Typtr <> NIL) AND (lAttr.Typtr <> NIL) THEN
              BEGIN
              IF CompTypes(lAttr.Typtr, RealPtr) AND CompTypes(gAttr.Typtr,
                 IntPtr) THEN
                Float(gAttr);
              Ok := CompTypes(lAttr.Typtr, gAttr.Typtr);
              IF NOT Ok THEN Ok := StringAss(lAttr.Typtr, gAttr);
              IF NOT Ok THEN                                                   {!12-05-83}
                WITH lStmt^ DO {'SELF :=' is compatible with any superclass}
                  IF AssVar <> NIL THEN
                    WITH AssVar^ DO
                      IF Node = IDENTNODE THEN
                        IF IdType <> NIL THEN
                          IF Class = VARS THEN
                            IF IsSELF THEN
                              Ok := CompTypes(gAttr.Typtr, lAttr.Typtr);
              IF Ok THEN
                BEGIN
                IF lAttr.Typtr^.FType THEN Error(141);
                IF RangeFlag THEN InsertRangeCheck(lAttr.Typtr, gAttr);        {!6-23-83}
                IF (lAttr.Typtr^.Form <= SUBRANGE) AND NOT CompTypes(lAttr.Typtr,
                   RealPtr) THEN
                  IF lAttr.ASize <> gAttr.ASize THEN
                    MakeScSize(gAttr, lAttr.ASize);
                IF lAttr.Typtr^.Form = SETS THEN
                  BEGIN
                  Op := 37; SubOp := lAttr.ASize;
                  IF gAttr.ASize <> lAttr.ASize THEN
                    MakeSetSize(gAttr, lAttr.ASize);
                  END
                ELSE IF lAttr.Typtr^.Form = STRINGS THEN
                  BEGIN
                  Op := 39; SubOp := lAttr.Typtr^.StringLen;
                  IF (gAttr.Typtr^.Form = SCONST) OR (SubOp >
                     gAttr.Typtr^.StringLen) THEN                             {!5-23-83AH}
                    SubOp := gAttr.Typtr^.StringLen;
                  END
                ELSE IF PAoC(lAttr.Typtr) THEN
                  BEGIN
                  GetBounds(lAttr.Typtr^.IndexedBy, Lo, Hi);
                  Op := 40; SubOp := Hi;
                  END
                ELSE IF PckdStorage THEN
                  BEGIN
                  Op := 38 {PCKDASS} ;
                  IF lAttr.TreePtr <> NIL THEN
                    IF lAttr.TreePtr^.Node = TRINODE {--> Packed Array} THEN
                      MakeScSize(gAttr, 1);
                  END
                ELSE IF lAttr.ASize <= 4 THEN
                  IF lAttr.ASize = 1 THEN
                    Op := 32
                  ELSE
                    Op := 33 + Ord(lAttr.ASize > 2)
                ELSE
                  BEGIN
                  Op := 36; SubOp := lAttr.ASize;
                  END;
                END
              ELSE
                Error(144);
              END;

            WITH lStmt^ DO
              BEGIN
              AssExpr := gAttr.TreePtr;
              AssOp := Op;
              AssSubOp := SubOp;
              END;
            END
          ELSE
            Error(40);
                                                                                {!C}
        1:
          fStmt^.StmtNumb := lNumbr;
        END; {assignment}

      PROCEDURE CompoundStatement(VAR fStmt: pStmt);

        VAR
          lStmt, LastStmt: pStmt;
          lNumbr: Integer;

        BEGIN {CompoundStatement}
          lNumbr := TotalLines;
          REPEAT
            Statement(FSys + [SEMISY, ENDSY], LastStmt); fStmt := LastStmt;
            IF Token IN StatBegSys THEN Error(36);
          UNTIL NOT (Token IN StatBegSys);
          WHILE Token = SEMISY DO
            BEGIN
            Scan;
            REPEAT
              Statement(FSys + [SEMISY, ENDSY], lStmt);
              IF LastStmt = NIL THEN
                BEGIN
                LastStmt := lStmt; fStmt := lStmt
                END
              ELSE IF lStmt <> NIL THEN
                BEGIN
                LastStmt^.NextStmt := lStmt; LastStmt := lStmt;
                END;
              IF Token IN StatBegSys THEN Error(36);
            UNTIL NOT (Token IN StatBegSys);
            END;

          IF Token = ENDSY THEN
            BEGIN
            RightCheck; Scan;
            END
          ELSE
            Error(44);

          New(lStmt, BEGINST);
          WITH lStmt^ DO
            BEGIN
            NextStmt := NIL; StmtOp := BEGINST; SubSt := fStmt;
            END;
          fStmt := lStmt;
          fStmt^.StmtNumb := lNumbr;
        END; {CompoundStatement}

      PROCEDURE CaseStatement(VAR fStmt: pStmt);

        LABEL 1;

        VAR
          ExitFlag, Exit2Flag: Boolean;
          lValu: Valu;
          CaseType, ConsTyp1, ConsTyp2: pT;
          CaseStmt, LastCStmt, ThisCStmt, lStmt: pStmt;
          ThisCons, LastCons: pIntList;
          lNumbr, Low, Hi, CaseLabel: Integer;                                 {!01-22-84}

        BEGIN {CaseStatement}
          lNumbr := TotalLines;
          New(CaseStmt, CASEST); fStmt := CaseStmt; LastCStmt := NIL;
          WITH CaseStmt^ DO
            BEGIN
            NextStmt := NIL; StmtOp := CASEST; CStmtList := NIL;
            OtherStmt := NIL;
            LHSDHandle := 0;                                                   {!C}
            ExprDHandle := 0;                                                  {!C}
            Expression(FSys + [OFSY, COMMASY, COLONSY]);
            CaseType := gAttr.Typtr;
            MakeScSize(gAttr, 2); CaseExpr := gAttr.TreePtr;
            END;

          IF CaseType <> NIL THEN
            IF (CaseType^.Form > SUBRANGE) OR (CompTypes(CaseType, RealPtr)) THEN
              BEGIN
              Error(166); CaseType := NIL;
              END;

          IF Token = OFSY THEN
            Scan
          ELSE
            Error(42);

          ExitFlag := False;
          REPEAT
            IF (Token <> SEMISY) AND (Token <> ENDSY) AND (Token <> OTHERSY) THEN
              BEGIN
              Exit2Flag := False; LastCons := NIL;
              REPEAT
                Constant(FSys + [COMMASY, COLONSY], lValu, ConsTyp1);          {!01-22-84 start}
                IF ConsTyp1 <> NIL THEN
                  IF CompTypes(CaseType, ConsTyp1) THEN
                    Low := lValu.Ivalu
                  ELSE
                    BEGIN
                    Error(142); Low := 0; ConsTyp1 := NIL;
                    END;

                IF (Token = COLONSY) AND DotDot THEN
                  BEGIN
                  Scan;
                  Constant(FSys + [COMMASY, COLONSY], lValu, ConsTyp2);
                  IF CompTypes(CaseType, ConsTyp2) THEN
                    BEGIN
                    Hi := lValu.Ivalu;
                    IF Low > Hi THEN
                      BEGIN
                      Error(105); Hi := Low; Low := Hi;
                      END;
                    END
                  ELSE
                    BEGIN
                    Error(142); ConsTyp2 := NIL;
                    END;
                  END
                ELSE
                  BEGIN
                  ConsTyp2 := ConsTyp1; Hi := Low;
                  END;

                IF (ConsTyp1 <> NIL) AND (ConsTyp2 <> NIL) THEN                {!01-22-84 end}
                  BEGIN
                  lStmt := CaseStmt^.CStmtList;
                  WHILE lStmt <> NIL DO
                    BEGIN {check for duplicate labels}
                    ThisCons := lStmt^.CaseVals;
                    WHILE ThisCons <> NIL DO
                      IF (ThisCons^.IntVal >= Low) AND (ThisCons^.IntVal <= Hi) THEN
                        BEGIN
                        Error(150);
                        GOTO 1;
                        END
                      ELSE
                        ThisCons := ThisCons^.NextInt;
                    lStmt := lStmt^.NextStmt;
                    END; {checking for duplicate labels}

                  FOR CaseLabel := Low TO Hi DO                                {!01-22-84}
                    BEGIN
                    New(ThisCons);
                    ThisCons^.NextInt := NIL; ThisCons^.IntVal := CaseLabel;   {!01-22-84}
                    IF LastCons = NIL THEN
                      BEGIN
                      New(ThisCStmt, CSTMTST);
                      WITH ThisCStmt^ DO
                        BEGIN
                        StmtNumb := 0;
                        NextStmt := NIL; StmtOp := CSTMTST;
                        CaseVals := ThisCons; ThisCase := NIL;
                        END;
                      IF LastCStmt = NIL THEN
                        CaseStmt^.CStmtList := ThisCStmt
                      ELSE
                        LastCStmt^.NextStmt := ThisCStmt;
                      LastCStmt := ThisCStmt;
                      END
                    ELSE
                      LastCons^.NextInt := ThisCons;
                    LastCons := ThisCons;
                    END;
                  END;
              1:
                IF Token = COMMASY THEN
                  Scan
                ELSE
                  Exit2Flag := True;
              UNTIL Exit2Flag;

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

              REPEAT
                Statement(FSys + [SEMISY], lStmt);
                IF LastCStmt <> NIL THEN LastCStmt^.ThisCase := lStmt;
                IF Token IN StatBegSys THEN Error(36);
              UNTIL NOT (Token IN StatBegSys);
              END;

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

          IF Token = OTHERSY THEN
            BEGIN
            Scan;
            {IF Token = COLONSY THEN Scan ELSE Error(35); }
            Statement(FSys + [SEMISY, ENDSY], lStmt);
            CaseStmt^.OtherStmt := lStmt;
            IF Token = SEMISY THEN Scan;
            END;

          IF Token = ENDSY THEN
            BEGIN
            RightCheck; Scan;
            END
          ELSE
            Error(44);

          fStmt^.StmtNumb := lNumbr;
        END; {CaseStatement}

      PROCEDURE ForStatement(VAR fStmt: pStmt);

        VAR
          forn: pN;
          fort: pT;
          lStmt: pStmt;
          lForSize, lNumbr: Integer;

        BEGIN {ForStatement}
          lNumbr := TotalLines;
          fort := NIL;
          New(fStmt, FORTOST);
          WITH fStmt^ DO
            BEGIN
            NextStmt := NIL; StmtOp := FORTOST;
            ForVar := NIL; ForInit := NIL; ForLimit := NIL; lForSize := 2;

            IF Token = IDENTSY THEN
              BEGIN
              forn := SearchAll([VARS]); ForVar := forn;
              fort := forn^.IdType; lForSize := FullBytes(fort);
              IF fort <> NIL THEN
                IF (fort^.Form > SUBRANGE) OR CompTypes(fort, RealPtr) THEN
                  BEGIN
                  Error(139); fort := NIL;
                  END
                ELSE IF (forn^.Vlev <> Level) OR (forn^.Vkind <> DRCT) THEN
                  Error(172);
              Scan;
              END
            ELSE
              Skip(29, FSys + [ASSIGNSY, TOSY, DOWNTOSY, DOSY]);

            IF Token = ASSIGNSY THEN
              BEGIN
              Scan;
              LHSDHandle := 0;                                                 {!C}
              ExprDHandle := 0;                                                {!C}
              Expression(FSys + [TOSY, DOWNTOSY, DOSY]);
              MakeScSize(gAttr, lForSize); ForInit := gAttr.TreePtr;
              IF gAttr.Typtr <> NIL THEN
                IF NOT CompTypes(fort, gAttr.Typtr) THEN Error(140);
              END
            ELSE
              Skip(40, FSys + [TOSY, DOWNTOSY, DOSY]);

            IF (Token = TOSY) OR (Token = DOWNTOSY) THEN
              BEGIN
              IF Token = DOWNTOSY THEN StmtOp := FORDOWNST;
              Scan;
              LHSDHandle := 0;                                                 {!C}
              ExprDHandle := 0;                                                {!C}
              Expression(FSys + [DOSY]); MakeScSize(gAttr, lForSize);
              ForLimit := gAttr.TreePtr;
              IF gAttr.Typtr <> NIL THEN
                IF NOT CompTypes(fort, gAttr.Typtr) THEN Error(140);
              END
            ELSE
              Skip(48, FSys + [DOSY]);

            IF Token = DOSY THEN
              Scan
            ELSE
              Error(47);

            Statement(FSys, lStmt); ForSt := lStmt; ForSize := lForSize;
            END;
          fStmt^.StmtNumb := lNumbr;
        END; {ForStatement}

      PROCEDURE GotoStatement(VAR fStmt: pStmt);

        LABEL 1;

        VAR
          lLevel: LevRange;
          Lab: pLabRec;
          lStmt: pStmt;
          lNumbr: Integer;

        BEGIN {GotoStatement}
          lNumbr := TotalLines;
          New(lStmt, GOTOST); fStmt := lStmt;
          WITH lStmt^ DO
            BEGIN
            NextStmt := NIL; StmtOp := GOTOST; LabLev := Level;
            GotoLab := NIL;
            END;

          IF Token = ICONSTSY THEN
            BEGIN
            FOR lLevel := Level DOWNTO 1 DO
              BEGIN
              Lab := Display[lLevel].Labels;
              WHILE Lab <> NIL DO
                IF Lab^.LabelNo = IntVal THEN
                  GOTO 1
                ELSE
                  Lab := Lab^.NextLabel;
              END;
            Error(158);
          1:
            Scan;
            lStmt^.LabLev := lLevel; lStmt^.GotoLab := Lab;
            END
          ELSE
            Error(30);
          fStmt^.StmtNumb := lNumbr;
        END; {GotoStatement}

      PROCEDURE IfStatement(VAR fStmt: pStmt);

        VAR
          lStmt, ThenStmt, ElseStmt: pStmt;
          IfStExpr: pN;
          lNumbr: Integer;

        PROCEDURE DoIfStmt;

          BEGIN {DoIfStmt}
            New(fStmt, IFST);
            WITH fStmt^ DO
              BEGIN
              StmtNumb := lNumbr; NextStmt := NIL; StmtOp := IFST;
              IfExpr := IfStExpr; ThenSt := ThenStmt; ElseSt := ElseStmt;
              END;
          END; {DoIfStmt}

        PROCEDURE DoFalse;

          VAR
            lStmt: pStmt;

          BEGIN {DoFalse}
            New(lStmt, BEGINST);
            WITH lStmt^ DO
              BEGIN
              StmtNumb := lNumbr; NextStmt := NIL; StmtOp := BEGINST;
              SubSt := ElseStmt;
              END;
            fStmt := lStmt;
          END; {DoFalse}

        PROCEDURE DoTrue;

          VAR
            lStmt: pStmt;

          BEGIN {DoTrue}
            New(lStmt, BEGINST);
            WITH lStmt^ DO
              BEGIN
              StmtNumb := lNumbr; NextStmt := NIL; StmtOp := BEGINST;
              SubSt := ThenStmt;
              END;
            fStmt := lStmt;
          END; {DoTrue}

        BEGIN {IfStatement}
          lNumbr := TotalLines;
          LHSDHandle := 0;                                                     {!C}
          ExprDHandle := 0;                                                    {!C}
          Expression(FSys + [THENSY]); IfStExpr := gAttr.TreePtr;
          IF NOT CompTypes(gAttr.Typtr, BoolPtr) THEN Error(132);

          IF Token = THENSY THEN
            Scan
          ELSE
            Error(45);

          Statement(FSys + [ELSESY], lStmt); ThenStmt := lStmt;

          IF Token = ELSESY THEN
            BEGIN
            Scan;
            Statement(FSys, lStmt); ElseStmt := lStmt;
            END
          ELSE
            ElseStmt := NIL;

          IF IfStExpr = NIL THEN
            DoIfStmt
          ELSE IF IfStExpr^.Node <> CSTNODE THEN
            DoIfStmt
          ELSE IF IfStExpr^.CstValu.Ivalu = 0 THEN
            DoFalse
          ELSE
            DoTrue;
        END; {IfStatement}

      PROCEDURE RepeatStatement(VAR fStmt: pStmt);

        VAR
          lStmt, LastStmt: pStmt;
          lNumbr: Integer;

        BEGIN {RepeatStatement}
          lNumbr := TotalLines;
          New(fStmt, REPST);
          WITH fStmt^ DO
            BEGIN
            NextStmt := NIL; StmtOp := REPST; CondExpr := NIL;

            REPEAT
              Statement(FSys + [UNTILSY, SEMISY], lStmt);
              LoopStmt := lStmt; LastStmt := lStmt;
              IF Token IN StatBegSys THEN Error(36);
            UNTIL NOT (Token IN StatBegSys);
            WHILE Token = SEMISY DO
              BEGIN
              Scan;
              REPEAT
                Statement(FSys + [UNTILSY, SEMISY], lStmt);
                IF LastStmt = NIL THEN
                  BEGIN
                  LastStmt := lStmt; LoopStmt := lStmt
                  END
                ELSE IF lStmt <> NIL THEN
                  BEGIN
                  LastStmt^.NextStmt := lStmt; LastStmt := lStmt;
                  END;
                IF Token IN StatBegSys THEN Error(36);
              UNTIL NOT (Token IN StatBegSys);
              END;

            IF Token = UNTILSY THEN
              BEGIN
              RightCheck; Scan;
              LHSDHandle := 0;                                                 {!C}
              ExprDHandle := 0;                                                {!C}
              Expression(FSys); CondExpr := gAttr.TreePtr;
              IF NOT CompTypes(gAttr.Typtr, BoolPtr) THEN Error(132);
              END
            ELSE
              Error(46);
            END;
          fStmt^.StmtNumb := lNumbr;
        END; {RepeatStatement}

      PROCEDURE WhileStatement(VAR fStmt: pStmt);

        VAR
          lStmt: pStmt;
          lNumbr: Integer;

        BEGIN {WhileStatement}
          lNumbr := TotalLines;
          New(fStmt, WHILEST);
          WITH fStmt^ DO
            BEGIN
            NextStmt := NIL; StmtOp := WHILEST;
            LHSDHandle := 0;                                                   {!C}
            ExprDHandle := 0;                                                  {!C}
            Expression(FSys + [DOSY]); CondExpr := gAttr.TreePtr;
            IF NOT CompTypes(gAttr.Typtr, BoolPtr) THEN Error(132);

            IF Token = DOSY THEN
              Scan
            ELSE
              Error(47);

            Statement(FSys, lStmt); LoopStmt := lStmt;
            StmtNumb := lNumbr;
            END;
        END; {WhileStatement}

      PROCEDURE WithStatement(VAR fStmt: pStmt);

        VAR
          PckdFlag, ExitFlag, PckdStorage, Kluge: Boolean;
          OldTop: DispRange;
          lpN: pN;
          lStmt, LastStmt: pStmt;
          lNumbr: Integer;
          SaveWDHandle: Integer;                                               {!C}

        BEGIN {WithStatement}
          SaveWDHandle := WithDHandle;                                         {!C}
          lNumbr := TotalLines;
          LastStmt := NIL; ExitFlag := False;
          OldTop := Top;

          REPEAT
            PckdFlag := False;
            IF Token = IDENTSY THEN
              BEGIN
              lpN := SearchAll([VARS, FIELD, FUNC, TYPES]); Scan;              {!5-24,!10-18}
              END
            ELSE
              BEGIN
              Error(29); lpN := uVarPtr;
              END;
            LHSDHandle := 0;                                                   {!C}
            ExprDHandle := 0;                                                  {!C}
            WITH gAttr DO
              BEGIN
              Typtr := lpN^.IdType; TreePtr := lpN; ASize := FullBytes(Typtr);
              END;
            Selector(FSys + [COMMASY, DOSY], lpN, PckdFlag, PckdStorage);
            New(lStmt, WITHST);
            WITH lStmt^ DO
              BEGIN
              NextStmt := NIL; StmtOp := WITHST; StmtNumb := lNumbr;
              WithVar := gAttr.TreePtr; WithBody := NIL;
              END;
            IF LastStmt = NIL THEN
              fStmt := lStmt
            ELSE
              LastStmt^.WithBody := lStmt;
            LastStmt := lStmt;
            IF gAttr.Typtr <> NIL THEN
              WITH gAttr.Typtr^ DO
                IF Form = RECORDS THEN
                  IF Top < MAXDISPLAY THEN
                    BEGIN
                    Top := Top + 1;
                    WITH Display[Top] DO
                      BEGIN
                      NameTree := Fields; Occur := REC; RecPckd := PckdRec;
                      END;
                    END
                  ELSE
                    Error(300)
                ELSE IF Form = CLASSES THEN                                    {!C}
                  BEGIN
                  ExprDHandle := 1;
                  IF (Top + 1) < MAXDISPLAY THEN
                    BEGIN
                    Top := Top + 1;
                    WITH Display[Top] DO
                      BEGIN
                      NameTree := ClFields;
                      Occur := KLASS;
                      KType := gAttr.Typtr;
                      WVar := NIL;
                      Kluge := False;                                          {!01-05-84}
                      IF lStmt^.WithVar <> NIL THEN
                        WITH lStmt^.WithVar^ DO
                          IF Node = IDENTNODE THEN
                            BEGIN
                            IF Class = VARS THEN
                              IF (Vlev = Level) AND (Vlev > 1) THEN
                                WVar := lStmt^.WithVar;
                            END
                          ELSE IF Node = BINNODE THEN                          {!01-05-84}
                            Kluge := BinOp = 176; {FUNC - type cast????}
                            {Note, method calls with a function with selection are
                                   not currently handled properly. I think there
                                   are other problems too!}
                      END;
                    IF (Display[Top].WVar = NIL) AND NOT Kluge THEN
                      BEGIN {need another with}
                      Top := Top + 1;
                      WITH Display[Top] DO
                        BEGIN
                        NameTree := ClFields;
                        Occur := KLASS;
                        KType := gAttr.Typtr;
                        WVar := NIL;
                        END;
                      New(lStmt, WITHST);
                      WITH lStmt^ DO
                        BEGIN
                        NextStmt := NIL; StmtNumb := lNumbr;
                        StmtOp := WITHST;
                        lpN := NewUnNode(43 {WITHREC} , NIL);
                        IF Level <= 1 THEN
                          lpN^.UnSubOp := Top - 2
                        ELSE
                          lpN^.UnSubOp := Top - 1 - Level;
                        WithVar := NewUnNode(12 {POINTERS} ,
                                             NewUnNode(12 {POINTERS} , lpN));
                        WithBody := NIL;
                        END;
                      LastStmt^.WithBody := lStmt;
                      LastStmt := lStmt;
                      END
                    ELSE {the class var is a local or funct, so just with var^^}
                      lStmt^.WithVar := NewUnNode(12 {POINTERS} ,
                                                  NewUnNode(12 {POINTERS} ,
                                                  lStmt^.WithVar));
                    END
                  ELSE
                    Error(300);
                  END                                                          {!C}
                ELSE
                  Error(137);

            IF Token = COMMASY THEN
              Scan
            ELSE
              ExitFlag := True;
            WithDHandle := WithDHandle + ExprDHandle;                          {!C}
          UNTIL ExitFlag;

          IF Token = DOSY THEN
            Scan
          ELSE
            Error(47);

          Statement(FSys, lStmt); LastStmt^.WithBody := lStmt;

          Top := OldTop;
          {IF lStmt <> NIL THEN lStmt^.StmtNumb := lNumbr;}
          WithDHandle := SaveWDHandle;                                         {!C}
        END; {WithStatement}

      BEGIN {Statement}
        fStmt := NIL; lStmt := NIL;

        IF Token = ICONSTSY THEN
          BEGIN
          IF IntVal <= 9999 THEN
            BEGIN
            Lab := Display[Level].Labels;
            WHILE Lab <> NIL DO
              IF Lab^.LabelNo = IntVal THEN
                BEGIN
                IF Lab^.Defined THEN
                  Error(155)
                ELSE
                  Lab^.Defined := True;
                GOTO 1;
                END
              ELSE
                Lab := Lab^.NextLabel;
            Error(158);
          1:
            New(fStmt, LABEDST);
            WITH fStmt^ DO
              BEGIN
              StmtNumb := TotalLines;
              NextStmt := NIL; StmtOp := LABEDST; StLab := Lab; LabStmt := NIL;
              END;
            END
          ELSE
            Error(173);
          Scan;
          IF Token = COLONSY THEN
            Scan
          ELSE
            Error(35);
          END;

        IF NOT (Token IN FSys + [IDENTSY]) THEN Skip(20, FSys);
        IF Token IN StatBegSys + [IDENTSY] THEN
          BEGIN
          CASE Token OF                                                        {!}{[@=10]}
            IDENTSY:  BEGIN
                      LHSDHandle := 0;                                         {!C}
                      ExprDHandle := 0;                                        {!C}
                      lpN := SearchAll([VARS, FIELD, PROC, FUNC, TYPES]);      {!C}
                      Scan;
                      CASE lpN^.Class OF
                        TYPES,                                                 {!C}
                        VARS, FIELD, FUNC:
                                  Assignment(lpN, lStmt);

                        PROC:     BEGIN
                                  IF Display[Disx].Occur = KLASS THEN          {!C}
                                    Assignment(lpN, lStmt)
                                  ELSE
                                    BEGIN
                                    Call(FSys, lpN);
                                    New(lStmt, CALLST);
                                    WITH lStmt^ DO
                                      BEGIN
                                      StmtNumb := TotalLines;
                                      NextStmt := NIL; StmtOp := CALLST;
                                      ProcpN := lpN; pArgList := gAttr.TreePtr;
                                      END;
                                    END;                                       {!C}
                                  END;
                      END;
                      END;

            BEGINSY:  BEGIN
                      LeftCheck; Scan; CompoundStatement(lStmt);
                      END;

            CASESY:   BEGIN
                      LeftCheck; Scan; CaseStatement(lStmt);
                      END;

            FORSY:    BEGIN
                      Scan; ForStatement(lStmt);
                      END;

            GOTOSY:   BEGIN
                      Scan; GotoStatement(lStmt);
                      END;

            IFSY:     BEGIN
                      Scan; IfStatement(lStmt);
                      END;

            REPEATSY: BEGIN
                      LeftCheck; Scan; RepeatStatement(lStmt);
                      END;

            WHILESY:  BEGIN
                      Scan; WhileStatement(lStmt);

                      END;
            WITHSY:   BEGIN
                      Scan; WithStatement(lStmt);
                      END;
          END;

          IF NOT (Token IN FSys) THEN Skip(20, FSys);
          END;

        IF fStmt = NIL THEN
          fStmt := lStmt
        ELSE
          fStmt^.LabStmt := lStmt;
      END; {Statement}

    BEGIN {Body}
      IF NOT ConsListing OR NOT Listing THEN
        WriteLn(ShowProcName(CurrClass, PFName, Level)^);

      WithDHandle := 0;                                                        {!C}
      REPEAT
        Statement(FSys + [SEMISY, ENDSY], LastStmt); BodyStmt := LastStmt;
        IF Token IN StatBegSys THEN Error(36);
      UNTIL NOT (Token IN StatBegSys);
      WHILE Token = SEMISY DO
        BEGIN
        Scan;
        REPEAT
          Statement(FSys + [SEMISY, ENDSY], lStmt);
          IF LastStmt = NIL THEN
            BEGIN
            LastStmt := lStmt; BodyStmt := lStmt;
            END
          ELSE IF lStmt <> NIL THEN
            BEGIN
            LastStmt^.NextStmt := lStmt; LastStmt := lStmt;
            END;
          IF Token IN StatBegSys THEN Error(36);
        UNTIL NOT (Token IN StatBegSys);
        END;

      IF Token = ENDSY THEN
        BEGIN
        RightCheck;
        IF Level>1 THEN ProcLev := Chr(Ord('A') + Level - 2);
        Scan;
        END
      ELSE
        Error(44);

      { Define the hidden EXIT label }

      New(lStmt, LABEDST);
      WITH lStmt^ DO
        BEGIN
        StmtNumb := TotalLines; NextStmt := NIL; StmtOp := LABEDST;
        StLab := Display[Level].ExitLabel; LabStmt := NIL;
        END;

      IF BodyStmt = NIL THEN
        BodyStmt := lStmt
      ELSE
        LastStmt^.NextStmt := lStmt;

      Lab := Display[Level].Labels;
      WHILE Lab <> NIL DO
        BEGIN
        IF NOT Lab^.Defined THEN
          BEGIN
          SUIntToStr(Lab^.LabelNo, @LabStr);
          LabName := '        ';
          FOR i := 1 TO Length(LabStr) DO LabName[i] := LabStr[i];
          NError(157, LabName);
          END;
        Lab := Lab^.NextLabel;
        END;
    END; {Body}

