  (*$p**************************************************************************)
  (*                                                                           *)
  (*                          File: OPT.1.TEXT                                 *)
  (*                                                                           *)
  (*              (C) Copyright 1981 Silicon Valley Software, Inc.             *)
  (*                            1983, 1984 Apple Computer, Inc.                *)
  (*                                                                           *)
  (*                            All rights reserved.               12-Oct-82   *)
  (*                                                                           *)
  (* 12-10-82 Fixed NIL ptr bug in SameVar.  kf                                *)
  (*  5-24-83 BindSelector: bind arg of '^' with BindExpr (for func^)          *)
  (*  5-24-83 RefSelector: bind arg of '^' with RefExpr (for func^)            *)
  (* 10-13-83 Method 'NEW' changed to 'CREATE'                                 *)
  (*  1-13-84 BindSFCall: support for THISCLASS and INCLASS functions          *)
  (*  3-17-84 SameExpr: check for nil pointers                                 *)
  (*  3-17-84 BindRegisters: Bnd incremented in wrong direction (I think!)     *)
  (*****************************************************************************)
  {[j=0/0/80!,@=11,i=1]}

  {$S OPT1}

  PROCEDURE Optimize(fStmt: pStmt; FpN: pN);

    VAR
      IncDec: Integer;

    FUNCTION SameVar(ApN, BpN: pN): Boolean;
      FORWARD;

    FUNCTION SameExpr(ApN, BpN: pN): Boolean;

      BEGIN
        SameExpr := False;
        IF (BpN <> NIL) AND (ApN <> NIL) THEN                                  {!03-17-84}
          IF ApN^.Node = BpN^.Node THEN
            CASE ApN^.Node OF
              IDENTNODE: IF ApN = BpN THEN SameExpr := ApN^.Class <> FUNC;
              UNNODE:    IF (ApN^.UnOp = BpN^.UnOp) AND (ApN^.UnSubOp =
                            BpN^.UnSubOp) THEN
                           IF ApN^.UnOp IN [12 {^} , 15 {.} , 43 {WITHFLD} ] THEN
                             SameExpr := SameVar(ApN, BpN)
                           ELSE IF ApN^.UnOp IN [23 {NIL} , 31 {NULLSET} ] THEN
                             SameExpr := True
                           ELSE
                             SameExpr := SameExpr(ApN^.UnArg, BpN^.UnArg);
              BINNODE:   IF (ApN^.BinOp = BpN^.BinOp) AND (ApN^.BinSubOp =
                            BpN^.BinSubOp) THEN
                           IF ApN^.BinOp IN [46 {RNGCHK} , 47 {SRNGCHK} ] THEN
                             SameExpr := SameExpr(ApN^.RightArg, BpN^.RightArg)
                           ELSE
                             SameExpr := SameExpr(ApN^.LeftArg, BpN^.LeftArg) AND
                                         SameExpr(ApN^.RightArg, BpN^.RightArg);
              TRINODE:   SameExpr := SameVar(ApN, BpN);
              CSTNODE:   IF ApN = BpN THEN
                           SameExpr := True
                         ELSE IF CompTypes(ApN^.CstType, BpN^.CstType) THEN
                           CASE ApN^.CstType^.Form OF
                             SCALAR, SUBRANGE:
                                        BEGIN
                                        IF CompTypes(ApN^.CstType, RealPtr) THEN
                                          SameExpr := ApN^.CstValu.Rvalu =
                                                      BpN^.CstValu.Rvalu
                                        ELSE
                                          SameExpr := ApN^.CstValu.Ivalu =
                                                      BpN^.CstValu.Ivalu;
                                        END;
                           END; {case}
            END; {case}
      END; {SameExpr}

    FUNCTION SameVar{apn,bpn: pn): Boolean};

      VAR
        lKey: Integer;                                                         {!OPT!}

      BEGIN
        SameVar := False;
        IF (BpN <> NIL) AND (ApN <> NIL) THEN
          BEGIN                                                                {!OPT!BEGIN}
          IF BpN^.Node = BINNODE THEN
            IF BpN^.BinOp = 178 { sfcall } THEN
              BEGIN
              lKey := BpN^.LeftArg^.Key;
              IF (lKey = 10 { ORD } ) OR (lKey = 32 {ORD4} ) THEN
                BpN := BpN^.RightArg^.LeftArg;
              END;                                                             {!OPT!END}

          IF ApN^.Node = BpN^.Node THEN
            CASE ApN^.Node OF
              IDENTNODE: IF ApN = BpN THEN
                           SameVar := (ApN^.Class = VARS) OR (ApN^.Class = FIELD);
              UNNODE:    IF (ApN^.UnOp = BpN^.UnOp) AND (ApN^.UnSubOp =
                            BpN^.UnSubOp) THEN
                           IF ApN^.UnOp IN [12 {^} , 15 {.} , 43 {WITHFLD} ] THEN
                             SameVar := SameVar(ApN^.UnArg, BpN^.UnArg);
              BINNODE:   BEGIN
                         END;
              TRINODE:   IF ApN^.TriOp = BpN^.TriOp THEN
                           IF ApN^.TriOp = 16 THEN {INDEX}
                             SameVar := SameVar(ApN^.Tri1, BpN^.Tri1) AND
                                        SameExpr(ApN^.Tri2, BpN^.Tri2);
              CSTNODE:   BEGIN
                         END;
            END; {case}
          END; {if .. <> NIL}
      END; {SameVar}

    PROCEDURE WalkTree(fStmt: pStmt);

      VAR
        lBinOp, lSize: Integer;
        FoundIt: Boolean;
        lpN: pN;

      BEGIN
        WHILE fStmt <> NIL DO
          WITH fStmt^ DO
            BEGIN
            CASE StmtOp OF
              BEGINST:   WalkTree(SubSt);
              ASSIGNST:  IF AssExpr^.Node = BINNODE THEN
                           BEGIN
                           lBinOp := AssExpr^.BinOp; FoundIt := False;

                           IF lBinOp = 178 {sfcall} THEN                       {!OPT!}
                             IF AssExpr^.LeftArg^.Key = 18 { POINTER } THEN    {!OPT!}
                               BEGIN                                           {!OPT!}
                               AssExpr := AssExpr^.RightArg^.LeftArg;          {!OPT!}
                               lBinOp := AssExpr^.BinOp;                       {!OPT!}
                               END;                                            {!OPT!}

                           IF (lBinOp >= 64 {ADD2} ) AND (lBinOp <=
                              67 {SUB4} ) THEN
                             IF SameVar(AssVar, AssExpr^.LeftArg) THEN
                               FoundIt := True { V := V +/- <EXPR> }
                             ELSE IF lBinOp <= 65 {ADD4} THEN
                               IF SameVar(AssVar, AssExpr^.RightArg) THEN
                                 BEGIN { V := <EXPR> + V }
                                 lpN := AssExpr^.RightArg;
                                 AssExpr^.RightArg := AssExpr^.LeftArg;
                                 AssExpr^.LeftArg := lpN;
                                 FoundIt := True;
                                 END;
                           IF FoundIt THEN
                             BEGIN
                             IncDec := IncDec + 1;
                             IF lBinOp <= 65 THEN
                               AssOp := 41 {ADDTO}
                             ELSE
                               AssOp := 42; {SUBFROM}
                             IF Odd(lBinOp) THEN
                               AssSubOp := 4
                             ELSE
                               AssSubOp := 2;
                             AssExpr := AssExpr^.RightArg;
                             END;
                           END;
              FORTOST, FORDOWNST:
                         WalkTree(ForSt);
              IFST:      BEGIN
                         WalkTree(ThenSt); WalkTree(ElseSt);
                         END;
              WITHST:    WalkTree(WithBody);
              REPST, WHILEST:
                         WalkTree(LoopStmt);
              CALLST:    ;
              GOTOST:    ;
              CASEST:    BEGIN
                         WalkTree(CStmtList); WalkTree(OtherStmt);
                         END;
              CSTMTST:   WalkTree(ThisCase);
              LABEDST:   WalkTree(LabStmt);
            END; {case}
            fStmt := NextStmt;
            END; {with}
      END; {walktree}

    BEGIN {optimize}
      IncDec := 0;
      WalkTree(fStmt);
    END; {optimize}

{*******************************************************************************

                             RegLookup

        Searches the register descriptors for a variable or a GlobalBase.
        Returns -1 on failure.

        Input Parameters
                SContents - register contents type to look for
                PVarb - if looking for a variable, then this will be the
                    the pn for that variable
                SLevel - if searching for a GlobalBase, then this is the
                    the lexical level number

        Return Result - Register number on success; -1 on failure

********************************************************************************}

  FUNCTION RegLookup(SContents: RegContents; pVarb: pN; SLevel: Integer): Integer;

    LABEL 10;

    VAR
      i: Integer;

    BEGIN
      RegLookup := - 1;
      IF SContents = AVARIABLE THEN
        BEGIN
        FOR i := A1st TO Anth DO
          WITH CurRegisters[i] DO
            BEGIN
            IF Contents = AVARIABLE THEN
              IF PVar = pVarb THEN
                BEGIN
                RegLookup := i;
                GOTO 10;
                END;
            END;
        FOR i := D1st TO Dnth DO
          WITH CurRegisters[i] DO
            BEGIN
            IF Contents = AVARIABLE THEN
              IF PVar = pVarb THEN
                BEGIN
                RegLookup := i;
                GOTO 10;
                END;
            END;
        END
      ELSE { if SContents = GlobalBase then }
        BEGIN
        FOR i := A1st TO Anth DO
          WITH CurRegisters[i] DO
            BEGIN
            IF Contents = GLOBALBASE THEN
              IF RLevel = SLevel THEN
                BEGIN
                RegLookup := i;
                GOTO 10;
                END;
            END;
        END;
    10:
    END; { RegLookup }

{*******************************************************************************

                             BindStmt & BindExpr & BindSelector

        Recursively walk expression tree and substitute Register references
        wherever applicable.  Replace local variable and global frame pointer
        references with appropriate register references.

********************************************************************************}

  PROCEDURE BindExpr(VAR fExpr: pN);
    FORWARD;

  PROCEDURE BindUCall(fProc, FArgs: pN; VAR fClVar: pN);                       {!C}
    FORWARD;

  PROCEDURE Bindsfcall(fProc, pArgs: pN);
    FORWARD;

  PROCEDURE BindSelector(VAR fVarb: pN);

    VAR
      PReg, PU1, PU: pN;
      VReg, Op, lOff, lLev, lSize, Lo, Hi: Integer;
      Ch: Char;
      c: PACKED ARRAY [0..7] OF Char;

    BEGIN
      {writeln('Sel:',ord(fvarb^.node));}
      WITH fVarb^ DO
        CASE Node OF
          IDENTNODE:
                    CASE Class OF
                      FUNC, { For formal procedure and }
                      PROC, { function parameters only }
                      CONSTS: { null } ;
                      VARS:     BEGIN
                                lLev := Vlev;
                                lOff := Voff;
                                VReg := RegLookup(AVARIABLE, fVarb, 0);
                                IF VReg <> - 1 THEN
                                  BEGIN
                                  New(PReg, REGISTER);
                                  IF Vkind = INDRCT THEN { slip in a ^ }
                                    BEGIN
                                    New(PU, UNNODE);
                                    WITH PU^ DO
                                      BEGIN
                                      Node := UNNODE;
                                      UnOp := 12; { ^ }
                                      UnArg := PReg;
                                      END;
                                    fVarb := PU;
                                    END
                                  ELSE
                                    fVarb := PReg;
                                  WITH PReg^ DO
                                    BEGIN
                                    Node := REGISTER;
                                    Reg := VReg;
                                    Load := 0;
                                    LoadExpr := NIL;
                                    LoadSize := 0;
                                    END;
                                  END
                                ELSE IF (lLev < 0) OR ((lLev > 1) AND (lLev <>
                                        Level)) THEN
                                  BEGIN
                                  VReg := RegLookup(GLOBALBASE, NIL, lLev);
                                  IF VReg <> - 1 THEN { (voff+Reg)^ }
                                    BEGIN {we cheat and use rightarg to hold the
                                           variable that (voff+Reg)^ really is
                                           for DEF purposes}
                                    New(PU, BINNODE);
                                    New(PReg, REGISTER);
                                    WITH PU^ DO
                                      BEGIN
                                      Node := BINNODE;
                                      BinOp := 12; {BINARY ^ }
                                      BinSubOp := lOff;
                                      LeftArg := PReg;
                                      RightArg := NIL;
                                      END;
                                    WITH PReg^ DO
                                      BEGIN
                                      Node := REGISTER;
                                      Reg := VReg;
                                      Load := 0;
                                      LoadExpr := NIL;
                                      LoadSize := 0;
                                      END;
                                    IF Vkind = INDRCT THEN { slip in a ^ }
                                      BEGIN
                                      New(PU1, UNNODE);
                                      WITH PU1^ DO
                                        BEGIN
                                        Node := UNNODE;
                                        UnOp := 12; { ^ }
                                        UnArg := PU;
                                        END;
                                      fVarb := PU1;
                                      END
                                    ELSE
                                      fVarb := PU;
                                    END;
                                  END;
                                END;
                      FIELD: {Error!} ;
                    END; {case}
          UNNODE:   BEGIN
                    {writeln('unop:',unop);}
                    IF UnOp = 22 {ADDRESS} THEN
                      BEGIN
                      IF UnSubOp = 0 THEN BindSelector(UnArg)
                      END
                    ELSE IF UnOp <> 43 {WITHREC} THEN BindExpr(UnArg);         {!5-24-83ah}
                    END;
          BINNODE:  BEGIN
                    {writeln('binop:',binop);}
                    IF (BinOp = 15 {FIELD} ) OR (BinOp = 12 {Binary ^ } ) THEN
                      BindSelector(LeftArg);
                    END;
          TRINODE:  BEGIN
                    {writeln('triop:',triop);}
                    IF TriOp = 16 {INDEX} THEN
                      BEGIN
                      BindSelector(Tri1);
                      BindExpr(Tri2);
                      END
                    ELSE IF TriOp = 184 { METHODCALL } THEN                    {!C}
                      BEGIN
                      BindUCall(TripN, Tri2, Tri1);
                      END;                                                     {!C}
                    END;
          REGISTER: IF LoadExpr <> NIL THEN BindExpr(LoadExpr);
          CSTNODE: { null } ;
        END; {case}
    END; {BindSelector}

  PROCEDURE BindExpr{(var fexpr : pn)};

    VAR
      TemppN: pN;                                                              {!C}
      Lo, Hi: Integer;

    BEGIN
      {writeln('Exp:',ord(fexpr^.node));}
      WITH fExpr^ DO
        CASE Node OF
          REGISTER, IDENTNODE:
                    BindSelector(fExpr);
          UNNODE:   BEGIN
                    {writeln('unop:',unop);}
                    IF UnOp IN [12..14 {Up Arrows } , 22 {ADDRESS} ,
                       43 {WITHREC} , 62 {EXTUFLD} , 63 {EXTSFLD} ] THEN
                      BindSelector(fExpr)
                    ELSE
                      BEGIN
                      IF (UnOp <> 23 {NIL} ) AND (UnOp <> 31 {NULLSET} ) AND
                         (UnOp <> 4 {INTRINSIC GLOBAL BASE PTR} ) THEN
                        BEGIN
                        BindExpr(UnArg);
                        END;
                      END;
                    END;
          BINNODE:  BEGIN
                    {writeln('binop:',binop);}
                    IF BinOp IN [12 { Binary ^ } , 15 {RFIELD} , 16..21 {Array
                         Indexing} ] THEN
                      BindSelector(fExpr)
                    ELSE IF BinOp = 176 {UFCALL} THEN
                      BEGIN
                      TemppN := NIL;                                           {!C}
                      BindUCall(LeftArg, RightArg, TemppN);                    {!C}
                      END
                    ELSE IF BinOp = 178 {SFCALL} THEN
                      BEGIN
                      Bindsfcall(LeftArg, RightArg);
                      END
                    ELSE
                      BEGIN
                      IF (BinOp <> 46 {RNGCHK} ) AND (BinOp <> 47 {SRNGCHK} ) THEN
                        BindExpr(LeftArg);
                      BindExpr(RightArg);
                      END;
                    END;
          TRINODE:  BEGIN
                    {writeln('triop:',binop);}
                    BindSelector(fExpr);
                    END;
        END; {case}

    END; { BindExpr }

  PROCEDURE BindVarParm(VAR ArgList: pN);

    BEGIN
      IF ArgList <> NIL THEN
        BEGIN {probably want the thread to say this is a var. parm (so can treat
               like := ) }
        BindExpr(ArgList^.LeftArg);
        { Would be selector except for COPY and CONCAT! }
        ArgList := ArgList^.RightArg;
        END;
    END; {BindVarParm}

  PROCEDURE BindValParm(VAR ArgList: pN);

    BEGIN
      IF ArgList <> NIL THEN
        BEGIN
        BindExpr(ArgList^.LeftArg);
        ArgList := ArgList^.RightArg;
        END;
    END; {BindValParm}

  PROCEDURE Bindsfcall{fproc,pargs: pn};

    VAR
      Key, lSize, N, lOp: Integer;
      lpN: pN;

    BEGIN
      Key := fProc^.Key;
      CASE Key OF                                                              {!}{[@=4]}
        01, { ABS }
        14, { SQR }
        02, { ARCTAN }
        04, { COS }
        07, { EXP }
        08, { LN }
        12, { ROUND }
        13, { SIN }
        15, { SQRT }
        17: { TRUNC }
            BindValParm(pArgs);
        05, { EOF }
        06, { EOLN }
        34: { KEYPRESS }
            BindVarParm(pArgs);
        11, { PRED }
        16, { SUCC }
        09: { ODD }
            BindValParm(pArgs);
        03, { CHR }
        10, { ORD }
        18, { POINTER }
        26, { SIZEOF }
        32, { ORD4 }
        35: { THISCLASS }                                                      {!C 01-13-84}
            BindExpr(pArgs^.LeftArg);
        19: { LENGTH }
            BindValParm(pArgs);
        20: { POS }
            BEGIN
            BindVarParm(pArgs);
            BindVarParm(pArgs);
            END;
        21: { CONCAT }
            WHILE pArgs <> NIL DO BindVarParm(pArgs);
        22: { COPY }
            BEGIN
            BindVarParm(pArgs);
            BindValParm(pArgs);
            BindValParm(pArgs);
            BindVarParm(pArgs);
            END;
        23, { BLOCKREAD }
        24: { BLOCKWRITE }
            BEGIN
            BindVarParm(pArgs);
            BindVarParm(pArgs);
            BindValParm(pArgs);
            IF pArgs <> NIL THEN BindValParm(pArgs);
            END;
        25, { IORESULT }
        31, { MEMAVAIL }
        33: { HEAPRESULT }
            ;
        27: { PWROFTEN }
            BindValParm(pArgs);
        28, { SCANEQ }
        29: { SCANNE }
            BEGIN
            BindValParm(pArgs);
            BindValParm(pArgs);
            BindVarParm(pArgs);
            END;
        30: { UNITBUSY }
            BindValParm(pArgs);
        36: { INCLASS }
            BEGIN                                                              {!C 01-13-84}
            BindValParm(pArgs);
            IF pArgs <> NIL THEN
              IF pArgs^.BinOp = Ord(IDENTNODE) THEN
                BindVarParam(pArgs) {%_INOBCP, 2nd arg is VAR ptr}
              ELSE
                BindValParm(pArgs); {%_INOBCN, 2nd arg is string constant}
            END;                                                               {!C 01-13-84}
      END; {case}
    END; {BindSFCall}

  PROCEDURE BindUCall{ fproc,fargs : pn; var fClVar: pn};                      {!C}

    VAR
      Formals, Actuals: pN;
      N, lOp, lOff, lLen: Integer;

    BEGIN
      WITH fProc^ DO
        BEGIN
        Formals := PFargList;
        Actuals := FArgs;
        WHILE Formals <> NIL DO
          BEGIN
          IF Formals^.Class = VARS THEN
            BEGIN
            N := FullBytes(Formals^.IdType);
            IF Formals^.Vkind = DRCT THEN
              BEGIN
              IF (Formals^.IdType^.Form = SETS) OR (N > 4) THEN
                BindVarParm(Actuals)
              ELSE
                BindValParm(Actuals);
              END
            ELSE
              BindVarParm(Actuals);
            END
          ELSE
            Actuals := Actuals^.RightArg;
          Formals := Formals^.Next;
          END;
        IF (PFdecl = METHDECL) OR (PFdecl = FORWMETHDECL) THEN                 {!C}
          IF fClVar <> NIL THEN                                                {!C}
            BindExpression(fClVar);                                            {!C}
        END;
    END; {BindUcall}

  PROCEDURE BindCallStmt(fStmt: pStmt);

    VAR
      TemppN: pN;                                                              {!C}

    PROCEDURE ReadWrite(fStmt: pStmt);

      VAR
        pArgs: pN;
        FileArg, Colon1, Colon2, Arg: ^pN;
        lOp, lOp2, lSubOp, lSize: Integer;

      BEGIN
        WITH fStmt^, ProcpN^ DO
          BEGIN
          pArgs := pArgList;
          CASE Key OF
            08, {read}
            09: {readln}
                BEGIN
                FileArg := @pArgs^.LeftArg;
                pArgs := pArgs^.RightArg;
                WHILE pArgs <> NIL DO
                  BEGIN
                  lOp := pArgs^.BinOp;

                  { Binop Proc. Params: Res:
                    ----- ----- -------
                      0   $R_C  ------- Val2
                      1   $R_I  ------- Val4
                      2   $R_R  ------- Val4
                      3   $R_S  Adr Siz2
                      4   $R_P  Adr Siz2      }

                  BindExpr(FileArg^);

                   { note : for binop <= 2, the actual code generated is

                         var := $R_X

                     treating it as a reference parameter is overly conservative,
                     but saves modifying the tree and the dump routine }

                  BindExpr(pArgs^.LeftArg);
                  pArgs := pArgs^.RightArg;
                  END;
                IF Key = 9 THEN
                  BEGIN
                  BindExpr(FileArg^);
                  END;
                END;
            10, {write}
            11: {writeln}
                BEGIN
                FileArg := @pArgs^.LeftArg;
                pArgs := pArgs^.RightArg;
                WHILE pArgs <> NIL DO
                  BEGIN
                  BindExpr(FileArg^);

                 { Binop Proc. Kind Size
                   ----- ----- ---- ----
                     0   $W_C  Val.  1.
                     1   $W_B  Val.  1.
                     2   $W_I  Val.  4.
                     3   $W_E  Val.  4.
                     4   $W_F  Val.  4.
                     5   $W_S  Ref.  -
                     6   $W_P  Ref.  -    }

                  lOp := pArgs^.BinOp;
                  Colon1 := NIL;
                  Colon2 := NIL;
                  Arg := @pArgs^.LeftArg;
                  IF (Arg^^.Node = BINNODE) AND (Arg^^.BinOp = 0 {COLON} ) THEN
                    BEGIN
                    Colon1 := @Arg^^.RightArg;
                    Arg := @Arg^^.LeftArg;
                    IF (Arg^^.Node = BINNODE) AND (Arg^^.BinOp = 0 {COLON} ) THEN
                      BEGIN
                      Colon2 := Colon1;
                      Colon1 := @Arg^^.RightArg;
                      Arg := @Arg^^.LeftArg;
                      END;
                    END;
                  IF lOp <= 4 THEN
                    BindExpr(Arg^)
                  ELSE
                    BEGIN
                    BindExpr(Arg^);
                    { Would be selector except for COPY and CONCAT! }
                    lSize := 0;
                    IF lOp = 6 THEN
                      BEGIN
                      { For $W_PAOC colon1 is actual length }
                      BindExpr(Colon1^);
                      Colon1 := Colon2;
                      END;
                    END;
                  IF Colon1 <> NIL THEN BindExpr(Colon1^);
                  IF (lOp = 4) AND (Colon2 <> NIL) THEN BindExpr(Colon2^);
                  pArgs := pArgs^.RightArg;
                  END;
                IF Key = 11 THEN
                  BEGIN
                  BindExpr(FileArg^);
                  END;
                END;
          END;
          END; {with}
      END; {readwrite}

    PROCEDURE BindStdProc(fStmt: pStmt);

      VAR
        pArgs: pN;
        SubOp, lLev: Integer;

      BEGIN
        WITH fStmt^, ProcpN^ DO
          IF Key <> 29 { EXIT } THEN
            BEGIN
            pArgs := pArgList;
            CASE Key OF
              01, { NEW }
              15, { CLOSE }
              20, { SEEK }
              27: { DISPOSE }
                  BEGIN
                  BindVarParm(pArgs);
                  BindValParm(pArgs);
                  END;
              02, { MARK }
              03, { RELEASE }
              04, { GET }
              05, { PUT }
              12: { PAGE }
                  BindVarParm(pArgs);
              06, { RESET }
              07: { REWRITE }
                  BEGIN
                  BindVarParm(pArgs);
                  IF pArgs <> NIL THEN BindVarParm(pArgs);
                  END;
              16, { DELETE }
              24: { FILLCHAR }
                  BEGIN
                  BindVarParm(pArgs);
                  BindValParm(pArgs);
                  BindValParm(pArgs);
                  END;
              17, { INSERT }
              22, { MOVELEFT }
              23: { MOVERIGHT }
                  BEGIN
                  BindVarParm(pArgs);
                  BindVarParm(pArgs);
                  BindValParm(pArgs);
                  END;
              18, { UNITREAD }
              19, { UNITWRITE }
              28: { UNITSTATUS }
                  BEGIN
                  BindValParm(pArgs);
                  BindVarParm(pArgs);
                  BindValParm(pArgs);
                  IF Key <= 19 THEN
                    BEGIN
                    IF pArgs <> NIL THEN BindValParm(pArgs);
                    IF pArgs <> NIL THEN BindValParm(pArgs);
                    END;
                  END;
              21: { HALT }
                  ;
              25: { UNITCLEAR }
                  BindValParm(pArgs);
              26: { GOTOXY }
                  BEGIN
                  BindValParm(pArgs);
                  BindValParm(pArgs);
                  END;
            END; {case}
            END; { else }
      END; {Bindstdproc}

    BEGIN {BindCallStmt}
      WITH fStmt^, ProcpN^ DO
        IF PFdeclKind = STANDARD THEN
          IF (Key >= 8) AND (Key <= 11) THEN
            ReadWrite(fStmt)
          ELSE
            BindStdProc(fStmt)
        ELSE                                                                   {!C}
          BEGIN                                                                {!C}
          TemppN := NIL;                                                       {!C}
          BindUCall(ProcpN, pArgList, TemppN);                                 {!C}
          END;                                                                 {!C}
    END; {BindCallStmt}

  PROCEDURE BindStmt(fStmt: pStmt);

    LABEL 10;

    VAR
      WithReg, i: Integer;
      PReg, pAtSign, PVar, pActual: pN;

    BEGIN
      WHILE fStmt <> NIL DO
        WITH fStmt^ DO
          BEGIN
          {writeln('Stmt:',ord(stmtop));}
          CASE StmtOp OF                                                       {!}{[@=12]}
            BEGINST:    BindStmt(SubSt);
            ASSIGNST:   BEGIN
                        WITH AssVar^ DO
                          IF Node = REGISTER THEN
                            IF GlobalRegisters[Reg].Contents = GLOBALBASE THEN
                              GOTO 10;
                        BindExpr(AssVar);
                        BindExpr(AssExpr);
                        END;
            FORTOST, FORDOWNST:
                        BEGIN
                        BindExpr(ForInit);
                        BindExpr(ForLimit);
                        BindExpr(ForVar);
                        BindStmt(ForSt);
                        END;
            IFST:       BEGIN
                        BindExpr(IfExpr);
                        BindStmt(ThenSt);
                        BindStmt(ElseSt);
                        END;
            WITHST:     BEGIN
                        WithLevel := WithLevel + 1;
                        WithReg := - 1;

                        { check if with involves indirect and indicate in
                          WithRefs - watch out for with a.b.c - tough
                          luck if its more complicated like a[1].b  }

                        PVar := WithVar;
                        WHILE (PVar^.Node = BINNODE) AND (PVar^.BinOp =
                              15 {RFIELD} ) DO
                          PVar := PVar^.LeftArg;
                        WITH PVar^, WithRefs[WithLevel] DO
                          IF Node <> IDENTNODE THEN
                            Indirect := True
                          ELSE
                            Indirect := (Vkind <> DRCT) OR (Vlev <> Level);
                        BindExpr(WithVar);
                        IF WithRefs[WithLevel].Indirect THEN
                          BEGIN
                          FOR i := A1st TO Anth DO
                            WITH GlobalRegisters[i] DO
                              BEGIN
                              IF (Contents = WITHSEL) AND (RLevel =
                                 WithLevel) THEN
                                WithReg := i;
                              END;
                          IF WithReg <> - 1 THEN { WithReg := @WithVar }
                            BEGIN
                            CurRegisters[WithReg] := GlobalRegisters[WithReg];
                            New(PReg, REGISTER);
                            New(pAtSign, UNNODE);
                            WITH PReg^ DO
                              BEGIN
                              Node := REGISTER;
                              Reg := WithReg;
                              Load := 0;
                              LoadExpr := pAtSign;
                              LoadSize := LONG;
                              END;
                            WITH pAtSign^ DO
                              BEGIN
                              Node := UNNODE;
                              UnSubOp := 0;
                              UnOp := 22 { ADDRESS } ;
                              UnArg := WithVar;
                              END;
                            WithVar := PReg;
                            END;
                          END;
                        BindStmt(WithBody);
                        WithLevel := WithLevel - 1;
                        IF WithReg <> - 1 THEN
                          CurRegisters[WithReg].Contents := NADA;
                        END;
            REPST:      BEGIN
                        BindStmt(LoopStmt);
                        BindExpr(CondExpr);
                        END;
            WHILEST:    BEGIN
                        BindExpr(CondExpr);
                        BindStmt(LoopStmt);
                        END;
            CALLST:     BindCallStmt(fStmt);
            METHODCALL: BindUCall(AssVar^.TripN, AssVar^.Tri2, AssVar^.Tri1);  {!C}
            GOTOST:     ;
            CASEST:     BEGIN
                        BindExpr(CaseExpr);
                        BindStmt(CStmtList);
                        BindStmt(OtherStmt);
                        END;
            CSTMTST:    BindStmt(ThisCase);
            LABEDST:    BindStmt(LabStmt);
          END; {case}
        10:
          fStmt := NextStmt;
          END; {with}
    END; {BindStmt}

{**************************************************************************

                                initRefTable

        initializes the data structure used to record candidate local
        variables (for register allocation).  the table only contains
        local variables which need not be in memory (@ not taken, not
        passed as var. parameters and not referenced as an intermediate
        global) and which are scalars or pointers.

        hides the implementation of the data structure.  initially it's
        just a linear list.


*****************************************************************************}

  PROCEDURE InitRefTable;

    BEGIN
      CurRefs := - 1;
    END;

{*****************************************************************************

                                RefLocal

        keeps track of references to locals that don't have to be InMemory.  is
        given a pointer to a symbol table entry for a local variable.  if
        InMemory is false, the variable is not a parameter), the variable is a
        scalar (not long real) or pointer then an entry is kept for the
        variable in the VarRefs table (if it's not in the table already then
        its entered).  if subsequently a local is forced InMemory it is removed
        from the table.

        Input Parameter

                pvarb - ptr to symbol table entry for local variable

*******************************************************************************}

  PROCEDURE RefLocal(pVarb: pN);

    LABEL 10;

    VAR
      i: Integer;

    BEGIN
      WITH pVarb^ DO
        IF IdType <> NIL THEN
          WITH IdType^ DO
            BEGIN
            {writeln('RefLocal:',name:10,ord(pvarb):14,ord(idtype):14);}
            IF (Class = VARS) THEN
              IF (((Form <= POINTERS) AND (FullBytes(IdType) <= 4)) OR (Vkind =
                 INDRCT)) AND (NOT (InRegister = - 2)) THEN
                BEGIN
                FOR i := 0 TO CurRefs DO
                  WITH VarRefs[i] DO
                    IF PVar = pVarb THEN
                      BEGIN
                      {writeln('found');}
                      Refs := Refs + 1;
                      GOTO 10;
                      END;
                {writeln('not found');}
                IF CurRefs < MAXREFS THEN
                  BEGIN
                  CurRefs := CurRefs + 1;
                  WITH VarRefs[CurRefs] DO
                    BEGIN
                    PVar := pVarb;
                    IF Voff <= 0 THEN
                      Refs := 1
                    ELSE
                      Refs := - 1;
                    END;
                  END;
                END;
            END;
    10:
    END; { RefLocal }

{******************************************************************************

                                  PutInMemory

        is passed an expression tree.  if the tree is a simple variable, then
        that variable is forced to be in memory (by setting InMemory).  if the
        variable is already in the VarRefs table, it is removed.  PutInMemory
        is called when the address of a variable will be taken.

********************************************************************************}

  PROCEDURE PutInMemory(pVarb: pN);

    LABEL 10;

    VAR
      j, i: Integer;

    BEGIN
      {writeln('PutInMemory');}
      WITH pVarb^ DO
        BEGIN
        IF (Node = IDENTNODE) AND (Class = VARS) THEN
          BEGIN
          {writeln(name);}
          InRegister := - 2;
          IF Vlev = Level THEN { LOCAL }
            BEGIN
            FOR i := 0 TO CurRefs DO
              BEGIN
              IF VarRefs[i].PVar = pVarb THEN
                BEGIN
                {writeln('remove from table');}
                FOR j := i TO CurRefs - 1 DO VarRefs[j] := VarRefs[j + 1];
                CurRefs := CurRefs - 1;
                GOTO 10;
                END;
              END;
            END;
          END;
        END;
    10:
    END; { PutInMemory }

{*******************************************************************************

                             RefStmt & RefExpr & RefSelector

        Assign basic block numbers and gather reference statistics for with
        statements, intermediate global references, shared global references
        local references and global references.  These statistics are used in
        the global register assignment strategy.  Basic blocks are assigned
        on the fly by a post order (execution order) traversal of the
        abstract syntax tree.

********************************************************************************}

  PROCEDURE RefExpr(fExpr: pN);
    FORWARD;

  PROCEDURE RefUCall(fProc, FArgs, fClVar: pN);                                {!C}
    FORWARD;
                                                                               {!C}

  PROCEDURE RefSfCall(fProc, pArgs: pN);
    FORWARD;

  PROCEDURE RefSelector(fVarb: pN);

    LABEL 10;

    VAR
      UnitpN: pN;
      lLev, lOffset: Integer;

    BEGIN
      {writeln('Sel:',ord(fvarb^.node));}
      WITH fVarb^ DO
        CASE Node OF
          IDENTNODE: CASE Class OF
                       CONSTS: { null } ;
                       FUNC, { For formal procedure and }
                       PROC, { function parameters only }
                       VARS:      BEGIN
                                  IF Class = VARS THEN
                                    BEGIN
                                    lOffset := Voff;
                                    lLev := Vlev;
                                    END
                                  ELSE IF PFdecl = FORMAL THEN
                                    BEGIN
                                    lOffset := PFOff;
                                    lLev := PFlev;
                                    END
                                  ELSE
                                    BEGIN
                                    lOffset := ParmBytes;
                                    lLev := PFlev + 1;
                                    END;
                                  IF lLev = Level THEN
                                    RefLocal(fVarb) {LOCAL}
                                  ELSE IF lLev > 1 THEN
                                    BEGIN
                                    iGlobalRefs[lLev] := iGlobalRefs[lLev] +
                                                         (Level - lLev);
                                    PutInMemory(fVarb);
                                    END
                                  ELSE IF lLev < 0 THEN {look for intrinsic unit}
                                    BEGIN
                                    UnitpN := UnitList;
                                    WHILE UnitpN <> NIL DO
                                      BEGIN
                                      IF UnitpN^.Ulev = lLev THEN
                                        IF UnitpN^.Ukind <> REGUNIT THEN
                                          BEGIN
                                          sGlobalRefs[ - lLev] := sGlobalRefs[ -
                                           lLev] + 1;
                                          GOTO 10;
                                          END;
                                      UnitpN := UnitpN^.Next;
                                      END;
                                  10:
                                    END;
                                  END;
                       FIELD: {Error!} ;
                     END; {case}
          UNNODE:    BEGIN
                     {writeln('unop:',unop);}
                     IF UnOp = 22 {ADDRESS} THEN
                       BEGIN
                       PutInMemory(UnArg);
                       IF UnSubOp = 0 THEN RefSelector(UnArg);
                       END
                     ELSE IF UnOp <> 43 {WITHREC} THEN
                       RefExpr(UnArg)                                          {!5-24-83ah}
                     ELSE
                       WITH WithRefs[UnSubOp] DO
                         IF Indirect THEN Refs := Refs + 1;
                     END;
          BINNODE:   BEGIN
                     {writeln('binop:',binop);}
                     IF BinOp = 15 {FIELD} THEN RefSelector(LeftArg);
                     END;
          TRINODE:   BEGIN
                     {writeln('triop:',triop);}
                     IF TriOp = 16 {INDEX} THEN
                       BEGIN
                       RefSelector(Tri1);
                       RefExpr(Tri2);
                       END
                     ELSE IF TriOp = 184 { METHODCALL } THEN                   {!C}
                       BEGIN
                       GlobFlippable := False; { potential sideeffect }
                       RefUCall(TripN, Tri2, Tri1);
                       END;                                                    {!C}
                     END;
          CSTNODE: { null } ;
        END; {case}
    END; {RefSelector}

  PROCEDURE RefExpr{(fexpr : pn)};

    VAR
      BinopX: Integer;

    BEGIN
      {writeln('Exp:',ord(fexpr^.node));}
      WITH fExpr^ DO
        CASE Node OF
          IDENTNODE: RefSelector(fExpr);
          UNNODE:    BEGIN
                     {writeln('unop:',unop);}
                     IF UnOp IN [12..14 {Up Arrows} , 22 {ADDRESS} ,
                        43 {WITHREC} , 62 {EXTUFLD} , 63 {EXTSFLD} ] THEN
                       RefSelector(fExpr)
                     ELSE
                       BEGIN
                       IF (UnOp <> 23 {NIL} ) AND (UnOp <> 31 {NULLSET} ) THEN
                         RefExpr(UnArg);
                       END;
                     END;
          BINNODE:   BEGIN
                     {writeln('binop:',binop);}
                     BinopX := BinOp;
                     IF BinopX IN [15 {RFIELD} , 16..21 {Array Indexing} ] THEN
                       RefSelector(fExpr)
                     ELSE IF BinopX = 176 {UFCALL} THEN
                       BEGIN
                       GlobFlippable := False; { potential sideeffect }
                       RefUCall(LeftArg, RightArg, NIL);
                       END
                     ELSE IF BinopX = 178 {SFCALL} THEN
                       RefSfCall(LeftArg, RightArg)
                     ELSE
                       BEGIN
                       IF ((BinopX >= 92) AND (BinopX <= 109)) { integer } OR (
                          (BinopX >= 122) AND (BinopX <= 133)) { float } OR (
                          (BinopX >= 144) AND (BinopX <= 155)) { str/PAOC} OR (
                          (BinopX >= 163) AND (BinopX <= 167)) { set } THEN
                         GlobFlippable := False; { preserve condition codes }
                       IF (BinopX <> 46 {RNGCHK} ) AND (BinopX <>
                          47 {SRNGCHK} ) THEN
                         RefExpr(LeftArg);
                       RefExpr(RightArg);
                       END;
                     END;
          TRINODE:   BEGIN
                     {writeln('triop:',triop);}
                     RefSelector(fExpr);
                     END;
          CSTNODE: { null } ;
        END; {case}
    END; { RefExpr }

  PROCEDURE RefVarParm(VAR ArgList: pN);

    BEGIN
      IF ArgList <> NIL THEN
        BEGIN {probably want the thread to say this is a var. parm (so can treat
               like := ) }
        PutInMemory(ArgList^.LeftArg);
        RefExpr(ArgList^.LeftArg);
        { Would be selector except for COPY and CONCAT! }
        ArgList := ArgList^.RightArg;
        END;
    END; {RefVarParm}

  PROCEDURE RefValParm(VAR ArgList: pN);

    BEGIN
      IF ArgList <> NIL THEN
        BEGIN
        RefExpr(ArgList^.LeftArg);
        ArgList := ArgList^.RightArg;
        END;
    END; {RefValParm}

  PROCEDURE RefSfCall{fproc,pargs: pn};

    VAR
      Key, lSize, N, lOp: Integer;
      lpN: pN;

    BEGIN
      Key := fProc^.Key;
      CASE Key OF                                                              {!}{[@=4]}
        01, { ABS }
        14, { SQR }
        02, { ARCTAN }
        04, { COS }
        07, { EXP }
        08, { LN }
        12, { ROUND }
        13, { SIN }
        15, { SQRT }
        17: { TRUNC }
            RefValParm(pArgs);
        05, { EOF }
        06, { EOLN }
        34: { KEYPRESS }
            RefVarParm(pArgs);
        11, { PRED }
        16, { SUCC }
        09: { ODD }
            RefValParm(pArgs);
        03, { CHR }
        10, { ORD }
        18, { POINTER }
        26, { SIZEOF }
        32: { ORD4 }
            RefExpr(pArgs^.LeftArg);
        19: { LENGTH }
            RefValParm(pArgs);
        20: { POS }
            BEGIN
            RefVarParm(pArgs);
            RefVarParm(pArgs);
            END;
        21: { CONCAT }
            WHILE pArgs <> NIL DO RefVarParm(pArgs);
        22: { COPY }
            BEGIN
            RefVarParm(pArgs);
            RefValParm(pArgs);
            RefValParm(pArgs);
            RefVarParm(pArgs);
            END;
        23, { BLOCKREAD }
        24: { BLOCKWRITE }
            BEGIN
            RefVarParm(pArgs);
            RefVarParm(pArgs);
            RefValParm(pArgs);
            IF pArgs <> NIL THEN RefValParm(pArgs);
            END;
        25, { IORESULT }
        31, { MEMAVAIL }
        33: { HEAPRESULT }
            ;
        27: { PWROFTEN }
            RefValParm(pArgs);
        28, { SCANEQ }
        29: { SCANNE }
            BEGIN
            RefValParm(pArgs);
            RefValParm(pArgs);
            RefVarParm(pArgs);
            END;
        30: { UNITBUSY }
            RefValParm(pArgs);
      END; {case}
    END; {Refsfcall}

  PROCEDURE RefUCall{fproc,fargs,fClVar: pn};

    VAR
      Formals, Actuals: pN;
      N, lOp, lOff, lLen: Integer;

    BEGIN
      WITH fProc^ DO
        BEGIN
        Formals := PFargList;
        Actuals := FArgs;
        WHILE Formals <> NIL DO
          BEGIN
          IF Formals^.Class = VARS THEN
            BEGIN
            N := FullBytes(Formals^.IdType);
            IF Formals^.Vkind = DRCT THEN
              BEGIN
              IF (Formals^.IdType^.Form = SETS) OR (N > 4) THEN
                RefVarParm(Actuals)
              ELSE
                RefValParm(Actuals);
              END
            ELSE
              RefVarParm(Actuals);
            END
          ELSE
            Actuals := Actuals^.RightArg;
          Formals := Formals^.Next;
          END;
        IF (PFdecl = METHDECL) OR (PFdecl = FORWMETHDECL) THEN                 {!C}
          IF fClVar <> NIL THEN                                                {!C}
            RefExpr(fClVar);                                                   {!C}
        END;
    END; {RefUcall}

  PROCEDURE RefCallStmt(fStmt: pStmt);

    PROCEDURE ReadWrite(fStmt: pStmt);

      VAR
        pArgs, FileArg, Colon1, Colon2, Arg: pN;
        lOp, lOp2, lSubOp, lSize: Integer;

      BEGIN
        WITH fStmt^, ProcpN^ DO
          BEGIN
          pArgs := pArgList;
          CASE Key OF
            08, {read}
            09: {readln}
                BEGIN
                FileArg := pArgs^.LeftArg;
                PutInMemory(FileArg);
                pArgs := pArgs^.RightArg;
                WHILE pArgs <> NIL DO
                  BEGIN
                  lOp := pArgs^.BinOp;

                  { Binop Proc. Params: Res:
                    ----- ----- -------
                      0   $R_C  ------- Val2
                      1   $R_I  ------- Val4
                      2   $R_R  ------- Val4
                      3   $R_S  Adr Siz2
                      4   $R_P  Adr Siz2      }

                  RefExpr(FileArg);

                  { note : for binop <= 2, the actual code generated is

                        var := $R_X

                    treating it as a reference parameter is overly conservative,
                    but saves modifying the tree and the dump routine }

                  PutInMemory(pArgs^.LeftArg);
                  RefExpr(pArgs^.LeftArg);
                  pArgs := pArgs^.RightArg;
                  END;
                IF Key = 9 THEN
                  BEGIN
                  RefExpr(FileArg);
                  END;
                END;
            10, {write}
            11: {writeln}
                BEGIN
                FileArg := pArgs^.LeftArg;
                PutInMemory(FileArg);
                pArgs := pArgs^.RightArg;
                WHILE pArgs <> NIL DO
                  BEGIN
                  RefExpr(FileArg);

                  { Binop Proc. Kind Size
                    ----- ----- ---- ----
                      0   $W_C  Val.  1.
                      1   $W_B  Val.  1.
                      2   $W_I  Val.  4.
                      3   $W_E  Val.  4.
                      4   $W_F  Val.  4.
                      5   $W_S  Ref.  -
                      6   $W_P  Ref.  -    }

                  lOp := pArgs^.BinOp;
                  Colon1 := NIL;
                  Colon2 := NIL;
                  Arg := pArgs^.LeftArg;
                  IF (Arg^.Node = BINNODE) AND (Arg^.BinOp = 0 {COLON} ) THEN
                    BEGIN
                    Colon1 := Arg^.RightArg;
                    Arg := Arg^.LeftArg;
                    IF (Arg^.Node = BINNODE) AND (Arg^.BinOp = 0 {COLON} ) THEN
                      BEGIN
                      Colon2 := Colon1;
                      Colon1 := Arg^.RightArg;
                      Arg := Arg^.LeftArg;
                      END;
                    END;
                  IF lOp <= 4 THEN
                    RefExpr(Arg)
                  ELSE
                    BEGIN
                    PutInMemory(Arg);
                    RefExpr(Arg);
                    { Would be selector except for COPY and CONCAT! }
                    lSize := 0;
                    IF lOp = 6 THEN
                      BEGIN {For $W_PAOC colon1 is actual length}
                      RefExpr(Colon1);
                      Colon1 := Colon2;
                      END;
                    END;
                  IF Colon1 <> NIL THEN RefExpr(Colon1);
                  IF (lOp = 4) AND (Colon2 <> NIL) THEN RefExpr(Colon2);
                  pArgs := pArgs^.RightArg;
                  END;
                IF Key = 11 THEN RefExpr(FileArg);
                END;
          END;
          END; {with}
      END; {readwrite}

    PROCEDURE RefStdProc(fStmt: pStmt);

      VAR
        pArgs: pN;
        SubOp, lLev: Integer;

      BEGIN
        WITH fStmt^, ProcpN^ DO
          IF Key <> 29 { EXIT } THEN
            BEGIN
            pArgs := pArgList;
            CASE Key OF
              01, { NEW }
              15, { CLOSE }
              20, { SEEK }
              27: { DISPOSE }
                  BEGIN
                  RefVarParm(pArgs);
                  RefValParm(pArgs);
                  END;
              02, { MARK }
              03, { RELEASE }
              04, { GET }
              05, { PUT }
              12: { PAGE }
                  RefVarParm(pArgs);
              06, { RESET }
              07: { REWRITE }
                  BEGIN
                  RefVarParm(pArgs);
                  IF pArgs <> NIL THEN RefVarParm(pArgs);
                  END;
              16, { DELETE }
              24: { FILLCHAR }
                  BEGIN
                  RefVarParm(pArgs);
                  RefValParm(pArgs);
                  RefValParm(pArgs);
                  END;
              17, { INSERT }
              22, { MOVELEFT }
              23: { MOVERIGHT }
                  BEGIN
                  RefVarParm(pArgs);
                  RefVarParm(pArgs);
                  RefValParm(pArgs);
                  END;
              18, { UNITREAD }
              19, { UNITWRITE }
              28: { UNITSTATUS }
                  BEGIN
                  RefValParm(pArgs);
                  RefVarParm(pArgs);
                  RefValParm(pArgs);
                  IF Key <= 19 THEN
                    BEGIN
                    IF pArgs <> NIL THEN RefValParm(pArgs);
                    IF pArgs <> NIL THEN RefValParm(pArgs);
                    END;
                  END;
              21: { HALT } ;
              25: { UNITCLEAR }
                  RefValParm(pArgs);
              26: { GOTOXY }
                  BEGIN
                  RefValParm(pArgs);
                  RefValParm(pArgs);
                  END;
            END; {case}
            END; { else }
      END; {Refstdproc}

    BEGIN {RefCallStmt}
      WITH fStmt^, ProcpN^ DO
        IF PFdeclKind = STANDARD THEN
          IF (Key >= 8) AND (Key <= 11) THEN
            ReadWrite(fStmt)
          ELSE
            RefStdProc(fStmt)
        ELSE
          RefUCall(ProcpN, pArgList, NIL);                                     {!C}
    END; {RefCallStmt}

  PROCEDURE RefStmt(fStmt: pStmt);

    VAR
      PVar, pActual: pN;

    BEGIN
      WHILE fStmt <> NIL DO
        WITH fStmt^ DO
          BEGIN
          {writeln('Stmt:',ord(stmtop));}
          CASE StmtOp OF                                                       {!}{[@=12]}
            BEGINST:    RefStmt(SubSt);
            ASSIGNST:   BEGIN
                        GlobFlippable := True;
                        RefExpr(AssVar);
                        RefExpr(AssExpr);
                        Flippable := GlobFlippable AND (AssVar^.Node <>
                                     REGISTER) AND (AssOp >= 32) AND (AssOp <=
                                     35);
                        END;
            FORTOST, FORDOWNST:
                        BEGIN
                        RefExpr(ForInit);
                        RefExpr(ForLimit);

                        { loop variable used 3 times :
                               initialized
                               incremented
                               tested }

                        RefExpr(ForVar); RefExpr(ForVar); RefExpr(ForVar);
                        RefStmt(ForSt);
                        END;
            IFST:       BEGIN
                        RefExpr(IfExpr);
                        RefStmt(ThenSt);
                        RefStmt(ElseSt);
                        END;
            WITHST:     BEGIN
                        WithLevel := WithLevel + 1;

                        {  check if with involves indirect and indicate in
                           WithRefs - watch out for with a.b.c - tough
                           luck if its more complicated like a[1].b  }

                        PVar := WithVar;
                        WHILE (PVar^.Node = BINNODE) AND (PVar^.BinOp =
                              15 {RFIELD} ) DO
                          PVar := PVar^.LeftArg;

                        {  we want to be sure that a With p^ do doesn't mask out
                           the use of a local pointer and thus cause an unnecessary
                           use of an Areg for the with }

                        pActual := PVar;
                        WITH PVar^, WithRefs[WithLevel] DO
                          BEGIN
                          IF Node <> IDENTNODE THEN
                            BEGIN
                            Indirect := True;
                            IF Node = UNNODE THEN { check for With p^ }
                              IF (UnOp = 12 { ^ } ) THEN pActual := UnArg;
                            END
                          ELSE
                            Indirect := (Vkind <> DRCT) OR ((Vlev <> Level) AND
                                        (Vlev > 1));
                          IF PUpArrow <> NIL THEN
                            IF pActual <> PUpArrow THEN EverChange := True;
                          PUpArrow := pActual;
                          END;
                        RefExpr(WithVar);
                        RefStmt(WithBody);
                        WithLevel := WithLevel - 1;
                        END;
            REPST:      BEGIN
                        RefStmt(LoopStmt);
                        RefExpr(CondExpr);
                        END;
            WHILEST:    BEGIN
                        RefExpr(CondExpr);
                        RefStmt(LoopStmt);
                        END;
            CALLST:     RefCallStmt(fStmt);
            METHODCALL: RefUCall(AssVar^.TripN, AssVar^.Tri2, AssVar^.Tri1);   {!C}
            GOTOST:     ;
            CASEST:     BEGIN
                        RefExpr(CaseExpr);
                        RefStmt(CStmtList);
                        RefStmt(OtherStmt);
                        END;
            CSTMTST:    RefStmt(ThisCase);
            LABEDST:    BEGIN
                        IF StLab^.GlobRefNo >= 0 THEN HasGlobalLabel := True;
                        RefStmt(LabStmt);
                        END;
          END; {case}
          fStmt := NextStmt;
          END; {with}
    END; {RefStmt}

{*****************************************************************************

                             BindRegisters

        gathers reference counts, forms a strategy and then binds certain
        local variables, with statement selectors and intermediate level
        bases to registers.  modifies the tree to substitute register
        references in the place of the the bound variables.

*****************************************************************************}

  PROCEDURE BindRegisters(VAR ProcStmt: pStmt; ProcpN: pN);

    LABEL 1, 10, 20, 30;

    VAR
      IsMethodCreate,                                                          {!C}
      AFlag: Boolean;
      AltUses: ARRAY [GenRegister] OF Integer; { alternative uses for Aregs }
      PNewReg, PNewBase, PReg, PBase: pN;
      PAsgStmt: pStmt;
      LVarRef: VarRef;
      MaxIs: (AWith, AIGlobal, ASGlobal);
      lSaved, TotalRegs, DRegs, ARegs, MinReg, GReg, MinLevel, NewCurRefs, Saved,
      MAXREFS, MaxIdx, j, i, k, Bnd: Integer;

    PROCEDURE CleanRegs;

      VAR
        i: Integer;

      BEGIN
        FOR i := D1st TO Dnth DO
          BEGIN
          GlobalRegisters[i].Contents := NADA;
          CurRegisters[i].Contents := NADA;
          END;

        FOR i := A1st TO Anth DO
          BEGIN
          GlobalRegisters[i].Contents := NADA;
          CurRegisters[i].Contents := NADA;
          END;
      END; { cleanregs }

{*************************************************************************

                                AssignParameter

        generates an assignment statement to load a register with the
        parameter value from the stack frame.

*************************************************************************}

    PROCEDURE AssignParameter(RegI: Integer);

      VAR
        PLStmt,                                                                {!C}
        PAsgStmt: pStmt;
        pAtSign, PReg: pN;

      BEGIN
        WITH GlobalRegisters[RegI] DO
          IF Contents <> NADA THEN
            BEGIN
            RegMask.sMask := RegMask.sMask + [RegI];
            IF Contents = AVARIABLE THEN
              IF PVar^.Voff > 0 THEN { a parameter }
                BEGIN                                                          {!C}
                IF PVar^.IsSELF AND IsMethodCreate THEN
                  BEGIN { nope - it's 'SELF' in CREATE }
                  PLStmt := ProcStmt;
                  WHILE PLStmt^.NextStmt <> NIL DO PLStmt := PLStmt^.NextStmt;
                  New(PAsgStmt, ASSIGNST);
                  New(PReg, REGISTER);
                  WITH PAsgStmt^ DO
                    BEGIN
                    StmtNumb := 0; {was PLStmt^.StmtNumb + 1}
                    Flippable := False;
                    StmtOp := ASSIGNST;
                    AssExpr := PReg;
                    AssVar := PVar;
                    AssOp := 34; { 4 byte assignment }
                    AssSubOp := 0;
                    NextStmt := NIL;
                    END;
                  PLStmt^.NextStmt := PAsgStmt;
                  END
                ELSE
                  BEGIN
                  New(PAsgStmt, ASSIGNST);
                  New(PReg, REGISTER);
                  WITH PAsgStmt^ DO
                    BEGIN
                    StmtNumb := 0;
                    Flippable := False;
                    StmtOp := ASSIGNST;
                    WITH PVar^, IdType^ DO
                      BEGIN
                      AssOp := 34; { 4 byte assignment }
                      IF Vkind <> INDRCT THEN
                        BEGIN
                        IF FullBytes(IdType) <= 1 THEN
                          AssOp := 32 { 1 }
                        ELSE IF FullBytes(IdType) = 2 THEN AssOp := 33 { 2} ;
                        AssExpr := PVar;
                        END
                      ELSE
                        BEGIN
                        New(pAtSign, UNNODE);
                        pAtSign^.Node := UNNODE;
                        pAtSign^.UnSubOp := 0;
                        pAtSign^.UnOp := 22 { ADDRESS } ;
                        pAtSign^.UnArg := PVar;
                        AssExpr := pAtSign;
                        END;
                      END;
                    AssSubOp := 0;
                    AssVar := PReg;
                    NextStmt := ProcStmt;
                    ProcStmt := PAsgStmt;
                    END;
                  END;
                WITH PReg^ DO
                  BEGIN
                  Node := REGISTER;
                  Load := 0;
                  LoadExpr := NIL;
                  LoadSize := 0;
                  Reg := RegI;
                  END;
                END;                                                           {!C}
            END;
      END; { AssignParameter }

    BEGIN
      {writeln('Bind Register!');}

      WithLevel := 0;
      FOR i := 0 TO MAXDISPLAY DO
        BEGIN
        WITH WithRefs[i] DO
          BEGIN
          Refs := 0;
          EverChange := False;
          PUpArrow := NIL;
          END;
        iGlobalRefs[i] := - 1; { the first ref is break even for intermediate
                                global }
        END;

      FOR i := 0 TO NumUnits DO
        BEGIN
        sGlobalRefs[i] := - 1; { the first ref is break even for intrinsic unit
                                global }
        END;

      InitRefTable; { initialize local refcnt table }

      HasGlobalLabel := False; { bail out if they use global gotos}
      RefStmt(ProcStmt); { gather ye info while ye may }

      IF HasGlobalLabel THEN GOTO 1;

      {writeln('WithRefs':20);
      for i := 0 to MAXDISPLAY do
          begin
          writeln(WithRefs[i].Refs:20);
          end;

      writeln('iGlobalRefs':20);
      for i := 0 to MAXDISPLAY do
          begin
          writeln(iGlobalRefs[i]:20);
          end;

      writeln('sGlobalRefs':20);
      for i := 0 to numunits do
          begin
          writeln(sGlobalRefs[i]:20);
          end;

      writeRefTable;}

      {choose global register bindings

        1) set all registers to empty
        2) try to fill Anth to A1st with with selectors, intrinsic globals
           and/or i.globals
        3) try to pack the hot locals into Dnth to D1st and the remainder of the
           a regs
      }

      CleanRegs;
      Saved := 0;
      FOR i := 0 TO MAXDISPLAY DO
        BEGIN
        WITH WithRefs[i] DO
          BEGIN
          IF (PUpArrow <> NIL) AND (EverChange = False) THEN
            IF PUpArrow^.Node = IDENTNODE THEN
              WITH PUpArrow^ DO
                IF IdType <> NIL THEN
                  WITH IdType^ DO
                    BEGIN
                    IF (Class = VARS) THEN
                      IF (Form = POINTERS) THEN
                        FOR j := 0 TO CurRefs DO
                          WITH VarRefs[j] DO
                            IF PVar = PUpArrow THEN
                              BEGIN
                              Refs := Refs + WithRefs[i].Refs;
                              WithRefs[i].Refs := 0;
                              END;
                    END;
          END;
        END;

      {Compute the alternative uses for A registers (for pointer vars and
       var params.  This is necessary to avoid wrongly assigning an A reg to
       an infrequently used With selector, etc. }

      FOR i := Anth DOWNTO A1st DO AltUses[i] := 0;

      FOR i := 0 TO CurRefs DO
        WITH VarRefs[i] DO
          BEGIN
          AFlag := False;
          WITH PVar^ DO
            BEGIN
            IF Vkind = INDRCT THEN
              AFlag := True
            ELSE IF IdType <> NIL THEN
              AFlag := (IdType^.Form = POINTERS) OR (IdType^.Form = CLASSES);  {!C}
            END;
          IF AFlag THEN
            BEGIN
            FOR j := Anth DOWNTO A1st DO
              BEGIN
              IF Refs > AltUses[j] THEN
                BEGIN
                FOR k := A1st TO j - 1 DO AltUses[k] := AltUses[k + 1];
                AltUses[j] := Refs;
                GOTO 20;
                END;
              END;
          20:
            END;
          END;

      ARegs := Anth;
      Bnd := A1st;
      i := Anth;
      k := Anth;
      WHILE i >= Bnd DO
        BEGIN
        MAXREFS := 0;
        FOR j := 0 TO MAXDISPLAY DO
          BEGIN
          WITH WithRefs[j] DO
            BEGIN
            IF Refs > MAXREFS THEN
              BEGIN
              MaxIs := AWith;
              MaxIdx := j;
              MAXREFS := Refs;
              END;
            END;
          IF iGlobalRefs[j] > MAXREFS THEN
            BEGIN
            MaxIs := AIGlobal;
            MaxIdx := j;
            MAXREFS := iGlobalRefs[j];
            END;
          END;
        FOR j := 0 TO NumUnits DO
          BEGIN
          IF sGlobalRefs[j] > MAXREFS THEN
            BEGIN
            MaxIs := ASGlobal;
            MaxIdx := j;
            MAXREFS := sGlobalRefs[j];
            END;
          END;

        { make sure we don't disenfranchise some worthy pointer or var param }

        WHILE (MAXREFS * 2) < AltUses[k] DO
          BEGIN
          k := k - 1;
          Bnd := Bnd + 1; {or is it i := i - 1; ???? ILR}                       {!03-17-84}
          IF i < Bnd THEN GOTO 30;
          END;

        WITH GlobalRegisters[i] DO
          BEGIN
          IF MaxIs <> ASGlobal THEN
            RLevel := MaxIdx
          ELSE
            RLevel := - MaxIdx;
          IF MAXREFS <> 0 THEN
            BEGIN
            ARegs := i - 1;
            IF MaxIs = AWith THEN
              BEGIN
              Contents := WITHSEL;
              Saved := Saved + 4 * WithRefs[MaxIdx].Refs;
              WithRefs[MaxIdx].Refs := 0;
              CurRegisters[i].Contents := NADA;
              END
            ELSE IF MaxIs = AIGlobal THEN
              BEGIN
              Contents := GLOBALBASE;
              Saved := Saved + 4 * iGlobalRefs[MaxIdx];
              iGlobalRefs[MaxIdx] := 0;
              CurRegisters[i] := GlobalRegisters[i];
              END
            ELSE { Intrinsic Unit Global }
              BEGIN
              Contents := GLOBALBASE;
              Saved := Saved + 4 * sGlobalRefs[MaxIdx];
              sGlobalRefs[MaxIdx] := 0;
              CurRegisters[i] := GlobalRegisters[i];
              END;
            END;
          END;
        i := i - 1;
        END;
    30:

      {if listopen then
      writeln(listfile,'Bytes saved putting locals in A registers:',saved-8);}

      TotalRegs := (Anth - A1st + Dnth - D1st) + (ARegs - Anth) + 1;
      IF CurRefs < TotalRegs THEN
        NewCurRefs := CurRefs
      ELSE
        NewCurRefs := TotalRegs;
      FOR i := 0 TO NewCurRefs DO
        BEGIN
        MAXREFS := - 1;
        FOR j := i TO CurRefs DO
          WITH VarRefs[j] DO
            BEGIN
            IF Refs > MAXREFS THEN
              BEGIN
              MAXREFS := Refs;
              MaxIdx := j;
              END;
            END;
        IF MAXREFS <= 0 THEN
          BEGIN
          NewCurRefs := i - 1;
          GOTO 10;
          END;
        LVarRef := VarRefs[i];
        VarRefs[i] := VarRefs[MaxIdx];
        VarRefs[MaxIdx] := LVarRef;
        END;
    10:
      CurRefs := NewCurRefs;
      {writeRefTable;}

      DRegs := Dnth;
      FOR i := 0 TO CurRefs DO
        BEGIN
        j := - 1;
        WITH VarRefs[i], PVar^.IdType^ DO
          BEGIN
          lSaved := Refs * 2;
          IF (Form = POINTERS) OR (Form = CLASSES) OR (PVar^.Vkind = INDRCT) THEN
            BEGIN
            IF ARegs >= A1st THEN
              BEGIN
              j := ARegs;
              ARegs := ARegs - 1;
              lSaved := lSaved * 2;
              END
            ELSE
              BEGIN
              j := DRegs;
              DRegs := DRegs - 1;
              END;
            END
          ELSE IF DRegs >= D1st THEN
            BEGIN
            j := DRegs;
            DRegs := DRegs - 1;
            END;
          END;
        IF j <> - 1 THEN
          BEGIN
          WITH GlobalRegisters[j] DO
            BEGIN
            Contents := AVARIABLE;
            PVar := VarRefs[i].PVar;
            PVar^.InRegister := j;
            Saved := Saved + lSaved;
            END;
          CurRegisters[j] := GlobalRegisters[j];
          END;
        END;

      TotalRegs := TotalRegs + (DRegs - Dnth);
      IF TotalRegs = (Anth - A1st + Dnth - D1st) THEN { exactly one register }
        BEGIN
        IF Saved <= 4 THEN CleanRegs;
        END
      ELSE
        BEGIN
        IF Saved <= 8 THEN CleanRegs;
          {if listopen then
             writeln(listfile,'Total Bytes saved from Global Register Allocation:'
                     ,saved-8); }
        END;
      {writeRegisters;}

      { prepend assignment statement that loads the intermediate globals and
        shared unit globals

        1) Find the lowest intermediate level needed (and its register)
        2) Generate

                                   :=
                                   |
                      -------------------------
                      |                       |
                     Ai                  ($08+...)^
                                              |
                                             Aj
                                              |
                                             ...

            (We are carefull to choose the Aj's so as to load all the
            intermediate global registers).

        3) Set the Register Use Mask bit for every A reg used

        }

      MinLevel := MAXDISPLAY + 1;
      FOR i := A1st TO Anth DO
        WITH GlobalRegisters[i] DO
          BEGIN
          IF Contents <> NADA THEN
            BEGIN
            RegMask.sMask := RegMask.sMask + [i];
            IF (Contents = GLOBALBASE) THEN
              BEGIN
              IF RLevel < 0 THEN { Intrinsic Global }
                BEGIN

                    {   code to load Intrinsic Global Base into register:

                                   :=
                                   |
                      -------------------------
                      |                       |
                     Ai          INTRINSIC GLOBAL BASE PTR

                    }

                New(PAsgStmt, ASSIGNST);
                New(PBase, UNNODE);
                New(PReg, REGISTER);
                WITH PAsgStmt^ DO
                  BEGIN
                  StmtNumb := 0;
                  StmtOp := ASSIGNST;
                  Flippable := False;
                  AssOp := 34; { 4 byte assignment }
                  AssSubOp := 0;
                  AssVar := PReg;
                  AssExpr := PBase;
                  NextStmt := ProcStmt;
                  ProcStmt := PAsgStmt;
                  END;
                WITH PReg^ DO
                  BEGIN
                  Node := REGISTER;
                  Load := 0;
                  LoadSize := 0;
                  LoadExpr := NIL;
                  Reg := i;
                  END;
                WITH PBase^ DO
                  BEGIN
                  Node := UNNODE;
                  UnSubOp := - RLevel;
                  UnOp := 4 { INTRINSIC GLOBAL BASE PTR } ;
                  UnArg := NIL;
                  END;
                END
              ELSE IF RLevel < MinLevel THEN
                BEGIN
                MinLevel := RLevel;
                MinReg := i;
                END;
              END;
            END;
          END;

      IF MinLevel <= MAXDISPLAY THEN
        BEGIN
        New(PAsgStmt, ASSIGNST);
        New(PBase, BINNODE);
        New(PReg, REGISTER);
        WITH PAsgStmt^ DO
          BEGIN
          StmtNumb := 0;
          StmtOp := ASSIGNST;
          Flippable := False;
          AssOp := 34; { 4 byte assignment }
          AssSubOp := 0;
          AssVar := PReg;
          AssExpr := PBase;
          NextStmt := ProcStmt;
          ProcStmt := PAsgStmt;
          END;
        WITH PReg^ DO
          BEGIN
          Node := REGISTER;
          Load := 0;
          LoadSize := 0;
          LoadExpr := NIL;
          Reg := MinReg;
          END;
        New(PReg, REGISTER);
        FOR i := MinLevel TO Level - 1 DO
          BEGIN
          WITH PBase^ DO
            BEGIN
            Node := BINNODE;
            BinOp := 12; { Binary ^ }
            BinSubOp := SLinkOffset; { Offset for static link }
            LeftArg := PReg;
            RightArg := NIL;
            END;
          WITH PReg^ DO
            BEGIN
            Node := REGISTER;
            Load := 0;
            IF i = (Level - 1) THEN
              BEGIN
              Reg := A6;
              LoadExpr := NIL; LoadSize := 0;
              END
            ELSE
              BEGIN
              GReg := RegLookup(GLOBALBASE, NIL, i + 1);
              IF GReg <> - 1 THEN
                Reg := GReg
              ELSE
                Reg := MinReg;
              New(PNewBase, BINNODE);
              LoadExpr := PNewBase;
              LoadSize := LONG;
              New(PNewReg, REGISTER);
              END;
            END;
          PBase := PNewBase;
          PReg := PNewReg;
          END;
        END;

      BindStmt(ProcStmt);

      { prepend assignments that load any parameters that will be globally
        allocated to registers }

      IsMethodCreate := (ProcpN^.PFdecl = METHDECL) AND (ProcpN^.MethodNo = 0); {!C}
      FOR i := D1st TO Dnth DO AssignParameter(i);
      FOR i := A1st TO Anth DO AssignParameter(i);

      {PRTStmt(procstmt);}

    1:
    END; { bindRegisters }


