{

                          MODULE 18


                    Expression Evaluation





 This chapter defines the procedures used to construct the tree  of
 stack nodes that represents an expression evaluation.

 17.1  Primary Operands

 The primary operands in expression trees are

 (a)  variable values obtained from variable accesses, and

 (b)  constant values appearing in the program text.

 The interface procedure DeReference represents the conversion of a
 variable  reference  to  the  corresponding  value.   In  building
 expressions trees, however, no explicit  conversion  is  involved,
 the  variable representation is merely added to the existing vari-
 able reference for use in subsequent delayed code generation.

 The procedure CAPDeReference represents the special case of  dere-
 ferencing  a conformant array for assignment to another conformant
 array of identical size and shape.  In this case an operation node
 is  created  with  the  references to the array and the associated
 bound pair block as parameters.

                                                                     }

program ExpressionEval;

#include "globals.x"
#include "varref.pf"
#include "datareps.pf"
#include "generator.pf"
#include "objvalues.pf"

procedure DeReference ( Representation: TypeRepresentation );
visible;

  var TopEntry: StackEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        Pop(TopEntry);
        TopEntry^.DataRep := Representation;
        Push(TopEntry)
      end
  end { dereference };

procedure CAPDeReference (PackedSchema: Boolean ;
                          LowBoundAddress,
                          HighBoundAddress: RuntimeAddress;
                          BoundPairRepresentation,
                          ComponentRepresentation: TypeRepresentation);
visible;

  var ValueEntry: StackEntry;
      ElementsPacked: Boolean;

  begin
    if CodeIsToBeGenerated
    then
      begin
        with ComponentRepresentation do
          if WordSize>1
          then ElementsPacked := false
          else ElementsPacked := PackedSchema and
                                 (BitSize<=MCBitsPerWord);
        GetEntry(ValueEntry);
        with ValueEntry^ do
          begin
            DataRep := ComponentRepresentation;
            Kind := Operation;
            OpForm := CAPLoad;
            Pop(CAPEntry);
            CAPEntry^.DataRep := BoundPairRepresentation;
            CAPPacked := ElementsPacked;
            BpAddress := LowBoundAddress
          end;
        Push(ValueEntry)
      end
  end { capdereference };

{

 Constant  operands  are  generated  by  the  interface   procedure
 StackConstant,  which  creates  a  constant stack node holding the
 constant's object value, together with a representation  appropri-
 ate to the value concerned.

                                                                     }

procedure StackConstant ( ConstValue : ObjectValue );
visible;

  var ConstEntry: StackEntry;
      ConstRep: TypeRepresentation;

  begin
    if CodeIsToBeGenerated
    then
      begin
        with ConstValue do
          begin
            ConstRep := DefaultRepresentation;
{            ConstRep.WordSize := WordSize;		}
            case Kind of
              IntValue, BoolValue, CharValue :
                with ConstRep do
                  begin
                    Kind := ForScalar;
                    Min := Ival;
                    Max := Ival
                  end;
              RealValue : ConstRep.Kind := ForReal;
              SetValue :
                begin
                  ConstRep.Kind := ForSet;
                  SetBaseLimits(ConstRep, ConstValue)
                end;
              StringValue : ConstRep.Kind := ForString;
              PntrValue : ConstRep.Kind := ForPnter
            end
          end;
        GetEntry(ConstEntry);
        with ConstEntry^ do
          begin
            Kind := AConstant;
            TheConst := ConstValue;
            DataRep := ConstRep
          end;
        Push(ConstEntry)
      end
  end { stackconstant };

{

 17.2  Operand Value Checks

 Primary, intermediate and final values in an expression  are  sub-
 ject  to  value  checks of various kinds, if requested.  These are
 implemented as follows.

 Undefined variable value checks are handled by the procedure Unde-
 finedVariableCheck.  For tag fields these are implemented using an
 access check which tests whether a variant  of  the  corresponding
 variant  part  is active, since the tag value itself may have been
 preset if created by the extended form of 'new', even  though  the
 tag  field  is  still  deemed  to  be  undefined.   For  all other
 variables the undefined value check is implicit in the  subsequent
 load  operation,  and  UndefinedVariableCheck  indicates  this  by
 recording the appropriate error code in the operand record.

 A dynamically accessed record occurring as an expression factor is
 subject  to  a  check that it has not been created by the extended
 form of 'new'.  This is handled by TailoredFactorCheck again using
 the access check mechanism.

 Ordinal values are subject to range checks in many contexts, which
 are   signalled  either  explicitly  by  the  interface  procedure
 RangeCheck, or implicitly from within other generative operations.
 To  reduce the number of checks involved, all other generators for
 ordinal operations perform range analysis to determine the implied
 range  of  the result value from the known ranges of the operands.
 The procedure CheckRange uses  this  implied  range  to  determine
 whether a run-time check is necessary, and if so adds an appropri-
 ate check operation to the operand tree, for subsequent code  gen-
 eration.

 The procedure SetCheck handles checks on the range of members in a
 set value in a similar manner, exploiting range analysis performed
 by set arithmetic generators.

                                                                     }

procedure UndefinedVariableCheck;
visible;

{  var Reference, RecordEntry: StackEntry;
      CheckEntry: AncillaryEntry;
}
  begin
{    if CodeIsToBeGenerated and (Checks in Requested)
    then
      begin
        Pop(Reference);
        if Reference^.Class = TagRef
        then
          begin
            RecordEntry := Reference^.AccessList;
            new(CheckEntry);
            with CheckEntry^ do
              begin
                Next := nil;
                WhichOp := CheckIfActive;
                SelectorLevel := Reference^.Level
              end;
            AppendEntry(RecordEntry^.CheckList, CheckEntry)
          end
        else Reference^.RunError := 43;
        Push(Reference)
      end							}
  end { undefinedvariablecheck };

procedure TailoredFactorCheck ( Representation: TypeRepresentation );
visible;

{  var RecordEntry: StackEntry;
      CheckEntry: AncillaryEntry;
}
  begin
{    if CodeIsToBeGenerated and (Checks in Requested)
    then
      begin
        Pop(RecordEntry);
        new(CheckEntry);
        with CheckEntry^ do
          begin
            Next := nil;
            WhichOp := CheckIfNew
          end;
        AppendEntry(RecordEntry^.CheckList, CheckEntry);
        PushNewAccess(RecordEntry, false);
        Push(RecordEntry)
      end							}
  end { tailoredfactorcheck };

procedure CheckRange ( Min, Max: MCIntegerForm; CheckNumber: Scalar );
visible;

  var Expression, CheckedEntry: StackEntry;
      CheckedRange: RangeEntry;
      ActualMin, ActualMax: MCIntegerForm;

  begin
    Pop(Expression);
    with Expression^ do
      begin
        ActualMin := DataRep.Min;
        ActualMax := DataRep.Max;
        if (Max < ActualMin) or (ActualMax < Min)
        then
          begin
            PredictedError(CheckNumber);
            if Kind = AConstant then TheConst.Ival := Min
          end
      end;
    if CodeIsToBeGenerated and (Checks in Requested) and
       ((ActualMin < Min) or (Max < ActualMax))
    then
      begin
        new(CheckedRange);
        with CheckedRange^ do
          begin
            Lower := Min;
            Upper := Max;
            CAPBounds := false
          end;
        GetEntry(CheckedEntry);
        with CheckedEntry^ do
          begin
            RunError := CheckNumber;
            if ActualMin > Min
            then DataRep.Min := ActualMin else DataRep.Min := Min;
            if ActualMax < Max
            then DataRep.Max := ActualMax else DataRep.Max := Max;
            Kind := Operation;
            OpGroup := AnInteger;
            OpForm := RangeChk;
            CheckKind := SubrangeChecks;
            RequiredRange := CheckedRange;
            EntryToCheck := Expression
          end;
        Push(CheckedEntry)
      end
    else Push(Expression)
  end { checkrange };

procedure RangeCheck ( Min, Max: ObjectValue );
visible;

  var CheckNumber: Scalar;

  begin
    if CodeIsToBeGenerated
    then
      begin
        case ContextOfCheck of
          IsSucc : CheckNumber := 38;
          IsPred : CheckNumber := 39;
          IsUnknown : CheckNumber := 49
        end;
        CheckRange(Min.Ival, Max.Ival, CheckNumber);
        ContextOfCheck := IsUnknown
      end
  end { rangecheck };

procedure CheckCAPRange ( LowBoundAddress,
                          HighBoundAddress: RuntimeAddress );
visible;

  var Expression, CheckedEntry: StackEntry;
      CheckedRange: RangeEntry;

  begin
    Pop(Expression);
    new(CheckedRange);
    with CheckedRange^ do
      begin
        CAPBounds := true;
        BpAddress := LowBoundAddress
      end;
    GetEntry(CheckedEntry);
    with CheckedEntry^ do
      begin
        RunError := 1;
        DataRep.Min := Expression^.DataRep.Min;
        DataRep.Max := Expression^.DataRep.Max;
        Kind := Operation;
        OpGroup := AnInteger;
        OpForm := RangeChk;
        CheckKind := SubrangeChecks;
        RequiredRange := CheckedRange;
        EntryToCheck := Expression
      end;
    Push(CheckedEntry)
  end { checkcaprange };

procedure SetCheck ( Min, Max: ObjectValue );
visible;

  var Expression, CheckedEntry: StackEntry;
      CheckedRange: RangeEntry;
      CheckIsNeeded: Boolean;
      ActualMin, ActualMax: MCIntegerForm;

  begin
    if CodeIsToBeGenerated
    then
      begin
        Pop(Expression);
        with Expression^ do
          begin
            ActualMin := DataRep.Min;
            ActualMax := DataRep.Max
          end;
        if (ActualMin < Min.Ival) or (Max.Ival < ActualMax)
        then
          begin
            CheckIsNeeded := true;
            with Expression^ do
              if Kind = AConstant
              then
                begin
                  if TheConst.Setval <> nil then PredictedError(50);
                  CheckIsNeeded := false;
                  DataRep.Min := Min.Ival;
                  DataRep.Max := Max.Ival
                end;
            if CheckIsNeeded and (Checks in Requested)
            then
              begin
                new(CheckedRange);
                with CheckedRange^ do
                  begin
                    Lower := Min.Ival;
                    Upper := Max.Ival
                  end;
                GetEntry(CheckedEntry);
                with CheckedEntry^ do
                  begin
                    RunError := 50;
                    if ActualMin > Min.Ival
                    then DataRep.Min := ActualMin
                    else DataRep.Min := Min.Ival;
                    if ActualMax < Max.Ival
                    then DataRep.Max := ActualMax
                    else DataRep.Max := Max.Ival;
                    Kind := Operation;
                    OpGroup := ASet;
                    OpForm := RangeChk;
                    CheckKind := MemberChecks;
                    RequiredRange := CheckedRange;
                    EntryToCheck := Expression
                  end;
                Push(CheckedEntry)
              end
            else Push(Expression)
          end
        else Push(Expression)
      end
  end { setcheck };

{

 17.3  Compile-time Arithmetic

 The generators used for arithmetic operations  have  a  number  of
 similar characteristics:

 (a)  as indicated above, all ordinal and set arithmetic generators
      perform  range  analysis to determine the range of the result
      from the known ranges of the operands;

 (b)  when the operands involved in ordinal and set operations  are
      constant  the  operation  is  'folded',  i.e.  carried out at
      compile-time, to avoid the use of any run-time code;

 (c)  in all other cases generation results in the  creation  of  a
      stack  node  of variant Operation, with subtrees representing
      the operands involved, for subsequent code generation.

 Range  analysis  and  the  folding  of  operations  with  constant
 operands  both  require the ability to perform safe object machine
 arithmetic at compile-time, i.e. without the risk of  host  arith-
 metic  overflow.   The following procedure enables such arithmetic
 to be performed:

                                                                     }

procedure ConstArith(Operator: OpType; Left, Right: MCIntegerForm;
                     var Result: MCIntegerForm);

  var StoredMod: 0..MCMaxint;

  begin
    with Overflow do
      begin
        Occurred := false;
        Positive := false
      end;
    case Operator of
      Plus, Minus :
        begin
          if Operator = Minus then Right := -Right;
          if (Left > 0) and (Right > 0)
          then Overflow.Occurred := (Left > MCMaxint - Right);
          if (Left < 0) and (Right < 0)
          then Overflow.Occurred := (Left < -MCMaxint - Right);
          if Overflow.Occurred
          then Overflow.Positive := (Left > 0)
          else Result := Left + Right
        end;
      Mul :
        if Right = 0
        then Result := 0
        else
          if abs(Left) > MCMaxint div abs(Right)
          then
            begin
              Overflow.Occurred := true;
              Overflow.Positive :=
                (Left > 0) and (Right > 0) or
                (Left < 0) and (Right < 0)
            end
          else Result := Left * Right;
      Idiv :
        if Right = 0
        then Overflow.Occurred := true else Result := Left div Right;
      Imod :
        if Right <= 0
        then Overflow.Occurred := true
        else
          begin
            StoredMod := abs(Left) mod Right;
            if (StoredMod = 0) or (Left > 0)
            then Result := StoredMod else Result := Right - StoredMod
          end
    end
  end { constarith };

{

 17.4  Generic procedures for negation and comparison

 The negation operators for integer, real, and Boolean values,  and
 the comparison operators for all values types, require common code
 generation patterns which  are  provided  by  the  following  pro-
 cedures.   Note  that  the  number of distinct cases dealt with in
 comparisons is reduced by operand interchange for > and  >=,  thus
 equivalencing them to < and <=.

                                                                     }

procedure Negate(Group: OperandKind);

  var Argument, ResultEntry: StackEntry;
      Result: ObjectValue;
      ResultRep: TypeRepresentation;

  begin
    if CodeIsToBeGenerated
    then
      begin
        Pop(Argument);
        if Argument^.Kind = AConstant
        then
          begin
            Result := Argument^.TheConst;
            NegateValue(Result);
            FreeEntry(Argument);
            StackConstant(Result)
          end
        else
          begin
            ResultRep := Argument^.DataRep;
            if Group = AnInteger
            then
              with Argument^.DataRep do
                begin
                  ResultRep.Min := -Max;
                  ResultRep.Max := -Min
                end;
            GetEntry(ResultEntry);
            with ResultEntry^ do
              begin
                DataRep := ResultRep;
                Kind := Operation;
                OpGroup := Group;
                OpForm := Unary;
                UnaryEntry := Argument;
                UnaryOp := NegateOp
              end;
            Push(ResultEntry)
          end
      end
  end { negate };

procedure Compare(Operator: OpType; Group: OperandKind);

  var ResultEntry: StackEntry;

  begin
    GetEntry(ResultEntry);
    with ResultEntry^ do
      begin
        DataRep := BooleanRepresentation;
        Kind := Operation;
        OpGroup := Group;
        OpForm := Binary;
        if Operator in [GtOp, GeOp]
        then
          begin
            Pop(LeftEntry);
            Pop(RightEntry);
            if Operator = GtOp
            then BinaryOp := LtOp else BinaryOp := LeOp
          end
        else
          begin
            Pop(RightEntry);
            Pop(LeftEntry);
            BinaryOp := Operator
          end
      end;
    Push(ResultEntry)
  end { compare };

{

 17.5  Integer/Ordinal Arithmetic

 Generation of integer or ordinal arithmetic operations is  handled
 by  the  following  procedures.   All  are  characterised by range
 analysis to determine result ranges, and folding of operators with
 constant operands.

                                                                     }

procedure SelectCheck(EntryToCheck: StackEntry; CheckNumber: Scalar);
visible;

  begin
    if EntryToCheck^.Kind = Operation
    then
      with EntryToCheck^ do
        if OpForm = RangeChk then RunError := CheckNumber
  end { selectcheck };

procedure IntFunction ( WhichFunc: StdProcFuncs );
visible;

  var Argument, ResultEntry: StackEntry;
      Result: ObjectValue;
      ResultRep: TypeRepresentation;

  procedure SetResultLimits(var OldRep, NewRep: TypeRepresentation);

    var NewMin, NewMax: MCIntegerForm;

    begin
      if WhichFunc in [Absf, Sqrf, Succf, Predf]
      then
        begin
          with OldRep do
            case WhichFunc of
              Absf, Sqrf :
                begin
                  if Min >= 0
                  then
                    begin
                      NewMin := Min;
                      NewMax := Max
                    end
                  else
                    if Max >= 0
                    then
                      begin
                        if -Min > Max then NewMax := -Min;
                        NewMin := 0
                      end
                    else
                      begin
                        NewMax := -Min;
                        NewMin := -Max
                      end;
                  if WhichFunc = Sqrf
                  then
                    begin
                      ConstArith(Mul, NewMin, NewMin, NewMin);
                      if Overflow.Occurred then PredictedError(32);
                      ConstArith(Mul, NewMax, NewMax, NewMax)
                    end
                end;
              Succf :
                begin
                  ConstArith(Plus, Min, 1, NewMin);
                  if Overflow.Occurred then NewMin := Min;
                  ConstArith(Plus, Max, 1, NewMax);
                  if Overflow.Occurred then NewMax := Max
                end;
              Predf :
                begin
                  ConstArith(Minus, Max, 1, NewMax);
                  if Overflow.Occurred then NewMax := Max;
                  ConstArith(Minus, Min, 1, NewMin);
                  if Overflow.Occurred then NewMin := Min
                end
            end;
          NewRep := OldRep;
          with NewRep do
            begin
              Min := NewMin;
              Max := NewMax
            end
        end
      else
        case WhichFunc of
          Oddf : NewRep := BooleanRepresentation;
          Ordf, Chrf : NewRep := OldRep
        end
    end { setresultlimits };

  begin
    if CodeIsToBeGenerated
    then
      begin
        Pop(Argument);
        if Checks in Requested
        then
          if WhichFunc in [Succf, Predf, Chrf]
          then
            case WhichFunc of
              Succf : ContextOfCheck := IsSucc;
              Predf : ContextOfCheck := IsPred;
              Chrf : SelectCheck(Argument, 37)
            end;
        if Argument^.Kind = AConstant
        then
          begin
            Result := Argument^.TheConst;
            with Result do
              case WhichFunc of
                Absf : Ival := abs(Ival);
                Sqrf :
                  begin
                    ConstArith(Mul, Ival, Ival, Ival);
                    if Overflow.Occurred then PredictedError(32)
                  end;
                Succf :
                  begin
                    ConstArith(Plus, Ival, 1, Ival);
                    if Overflow.Occurred then PredictedError(38)
                  end;
                Predf :
                  begin
                    ConstArith(Minus, Ival, 1, Ival);
                    if Overflow.Occurred then PredictedError(39)
                  end;
                Oddf :
                  begin
                    Ival := ord(odd(Ival));
                    Kind := BoolValue
                  end;
                Ordf : Kind := IntValue;
                Chrf : Kind := CharValue
              end;
            FreeEntry(Argument);
            StackConstant(Result)
          end
        else
          begin
            GetEntry(ResultEntry);
            with ResultEntry^ do
              begin
                SetResultLimits(Argument^.DataRep, DataRep);
                Kind := Operation;
                OpGroup := AnInteger;
                OpForm := Stdrd;
                StdOp := WhichFunc;
                StdEntry := Argument
              end;
            Push(ResultEntry)
          end
      end
  end { integerfunction };

procedure NegInteger;
visible;

  begin
    if CodeIsToBeGenerated then Negate(AnInteger)
  end { negateaninteger };

procedure BinaryIntegerOperation ( Operator: OpType );
visible;

  var LeftOperand, RightOperand: StackEntry;
      Result: ObjectValue;
      ResultVal: MCIntegerForm;
      ResultEntry: StackEntry;

  procedure SetResultLimits;

    var LeftMin, LeftMax, RightMin, RightMax, ResultMin, ResultMax,
        SavedMin:
          MCIntegerForm;
        UfCount, OfCount: MCIntegerForm;

    procedure TryMin(PossibleMin: MCIntegerForm);

      begin
        if PossibleMin < ResultMin then ResultMin := PossibleMin
      end { trymin };

    procedure TryMax(PossibleMax: MCIntegerForm);

      begin
        if ResultMax < PossibleMax then ResultMax := PossibleMax
      end { trymax };

    procedure TryProduct(Bound1, Bound2: MCIntegerForm);

      var Product: MCIntegerForm;

      begin
        ConstArith(Mul, Bound1, Bound2, Product);
        if Overflow.Occurred
        then
          if Overflow.Positive
          then
            begin
              OfCount := OfCount + 1;
              ResultMax := MCMaxint
            end
          else
            begin
              UfCount := UfCount + 1;
              ResultMin := -MCMaxint
            end
        else
          begin
            TryMin(Product);
            TryMax(Product)
          end
      end { tryproduct };

    procedure TryQuotient(Bound1, Bound2: MCIntegerForm);

      var Quotient: MCIntegerForm;

      begin
        ConstArith(Idiv, Bound1, Bound2, Quotient);
        TryMin(Quotient);
        TryMax(Quotient)
      end { tryquotient };

    begin
      with LeftOperand^.DataRep do
        begin
          LeftMin := Min;
          LeftMax := Max
        end;
      with RightOperand^.DataRep do
        begin
          RightMin := Min;
          RightMax := Max
        end;
      case Operator of
        Plus, Minus :
          begin
            if Operator = Minus
            then
              begin
                SavedMin := RightMin;
                RightMin := -RightMax;
                RightMax := -SavedMin
              end;
            ConstArith(Plus, LeftMin, RightMin, ResultMin);
            if Overflow.Occurred
            then
              if Overflow.Positive
              then PredictedError(47) else ResultMin := -MCMaxint;
            ConstArith(Plus, LeftMax, RightMax, ResultMax);
            if Overflow.Occurred
            then
              if Overflow.Positive
              then ResultMax := MCMaxint else PredictedError(47)
          end;
        Mul :
          begin
            ResultMin := MCMaxint;
            ResultMax := -MCMaxint;
            OfCount := 0;
            UfCount := 0;
            TryProduct(LeftMin, RightMin);
            TryProduct(LeftMin, RightMax);
            TryProduct(LeftMax, RightMin);
            TryProduct(LeftMax, RightMax);
            if (OfCount = 4) or (UfCount = 4) then PredictedError(47)
          end;
        Idiv :
          begin
            ResultMin := MCMaxint;
            ResultMax := -MCMaxint;
            if RightMin <> 0
            then
              begin
                TryQuotient(LeftMin, RightMin);
                TryQuotient(LeftMax, RightMin);

              end;
            if RightMax <> 0
            then
              begin
                TryQuotient(LeftMin, RightMax);
                TryQuotient(LeftMax, RightMax)
              end;
            if (RightMin <= 0) and (RightMax >= 0)
            then
              begin
                if RightMin < 0
                then
                  begin
                    TryQuotient(LeftMin, -1);
                    TryQuotient(LeftMax, -1)
                  end;
                if RightMax > 0
                then
                  begin
                    TryQuotient(LeftMin, 1);
                    TryQuotient(LeftMax, 1)
                  end;
                if (RightMin = 0) and (RightMax = 0)
                then PredictedError(45)
              end
          end;
        Imod :
          if (LeftMin = LeftMax) and (RightMin = RightMax)
          then
            begin
              ResultMin := LeftMin mod RightMin;
              ResultMax := ResultMin
            end
          else
            begin
              ResultMin := 0;
              if (LeftMin < 0) or (LeftMax >= RightMax)
              then ResultMax := RightMax - 1 else ResultMax := LeftMax
            end
      end;
      with ResultEntry^ do
        begin
          DataRep.Min := ResultMin;
          DataRep.Max := ResultMax
        end
    end { setresultlimits };

  begin
    if CodeIsToBeGenerated
    then
      begin
        Pop(RightOperand);
        Pop(LeftOperand);
        if (LeftOperand^.Kind = AConstant) and
           (RightOperand^.Kind = AConstant)
        then
          begin
            ConstArith
              (Operator, LeftOperand^.TheConst.Ival,
                 RightOperand^.TheConst.Ival, ResultVal);
            if Overflow.Occurred
            then
              begin
                case Operator of
                  Plus, Minus, Mul : PredictedError(47);
                  Idiv : PredictedError(45);
                  Imod : PredictedError(46)
                end;
                ResultVal := MCMaxint
              end;
            SetIval(ResultVal, Result);
            FreeEntry(LeftOperand);
            FreeEntry(RightOperand);
            StackConstant(Result)
          end
        else
          begin
            if Operator = Imod
            then
              begin
                Push(RightOperand);
                CheckRange(1, MCMaxint, 46);
                Pop(RightOperand)
              end;
            GetEntry(ResultEntry);
            with ResultEntry^ do
              begin
                DataRep := IntegerRepresentation;
                SetResultLimits;
                Kind := Operation;
                OpGroup := AnInteger;
                OpForm := Binary;
                LeftEntry := LeftOperand;
                RightEntry := RightOperand;
                BinaryOp := Operator
              end;
            Push(ResultEntry)
          end
      end
  end { binaryintegeroperation };

procedure OrdinalComparison ( operator: optype );
visible;

  var RightOperand, LeftOperand: StackEntry;
      Result: ObjectValue;
      Bval: Boolean;

  begin
    if CodeIsToBeGenerated
    then
      if (TopStackEntry^.Kind = AConstant) and
         (TopStackEntry^.NextNode^.Kind = AConstant)
      then
        begin
          Pop(RightOperand);
          Pop(LeftOperand);
          with LeftOperand^ do
            case Operator of
              LtOp :
                Bval := TheConst.Ival < RightOperand^.TheConst.Ival;
              LeOp :
                Bval := TheConst.Ival <= RightOperand^.TheConst.Ival;
              GeOp :
                Bval := TheConst.Ival >= RightOperand^.TheConst.Ival;
              GtOp :
                Bval := TheConst.Ival > RightOperand^.TheConst.Ival;
              NeOp :
                Bval := TheConst.Ival <> RightOperand^.TheConst.Ival;
              EqOp :
                Bval := TheConst.Ival = RightOperand^.TheConst.Ival
            end;
          SetBval(Bval, Result);
          FreeEntry(LeftOperand);
          FreeEntry(RightOperand);
          StackConstant(Result)
        end
      else Compare(Operator, AnInteger)
  end { ordinalcomparison };

{

 17.6  Real Arithmetic

 Real arithmetic is more simply handled, in that no range  analysis
 is possible, and no folding with constant operands is attempted.

                                                                     }

procedure FloatInteger ( StackPosition: StackTop );
visible;

  var ResultEntry, Argument, SavedEntry: StackEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        SavedEntry := nil;
        if StackPosition = TopOfStack
        then Pop(Argument)
        else
          begin
            Pop(SavedEntry);
            Pop(Argument)
          end;
        GetEntry(ResultEntry);
        with ResultEntry^ do
          begin
            DataRep := RealRepresentation;
            Kind := Operation;
            OpGroup := AnInteger;
            OpForm := Unary;
            UnaryOp := FloatOp;
            UnaryEntry := Argument
          end;
        Push(ResultEntry);
        if SavedEntry <> nil then Push(SavedEntry)
      end
  end { floatinteger };

procedure RealFunction ( WhichFunc: StdProcFuncs );
visible;

  var ResultEntry: StackEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        GetEntry(ResultEntry);
        with ResultEntry^ do
          begin
            if WhichFunc in [Truncf, Roundf]
            then DataRep := IntegerRepresentation
            else DataRep := RealRepresentation;
            Kind := Operation;
            OpGroup := AReal;
            OpForm := Stdrd;
            StdOp := WhichFunc;
            Pop(StdEntry)
          end;
        Push(ResultEntry)
      end
  end { realfunction };

procedure NegReal;
visible;

  begin
    if CodeIsToBeGenerated then Negate(AReal)
  end { negatereal };

procedure BinaryRealOperation ( RealOperator: OpType );
visible;

  var LeftOperand, RightOperand, ResultEntry: StackEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        Pop(RightOperand);
        Pop(LeftOperand);
        GetEntry(ResultEntry);
        with ResultEntry^ do
          begin
            DataRep := RealRepresentation;
            Kind := Operation;
            OpGroup := AReal;
            OpForm := Binary;
            RightEntry := RightOperand;
            LeftEntry := LeftOperand;
            BinaryOp := RealOperator
          end;
        Push(ResultEntry)
      end
  end { binaryrealoperation };

procedure RealComparison ( Operator: OpType );
visible;

  begin
    if CodeIsToBeGenerated then Compare(Operator, AReal)
  end { realcomparison };

{

 17.6  Boolean Arithmetic

 The IfFalseConditional and IfTrueConditional instructions  of  the
 P-machine  enable fast, simple code sequences using jump out logic
 for sequences of 'and' or 'or' operators.  For delayed  code  gen-
 eration  these are represented as an operation node of form Condi-
 tion which points to a chain of the operands involved.  With these
 P-code  instructions no problems arise with jump out conditions in
 any context,  so  the  interface  procedure  ExcludeConditions  is
 redundant.

                                                                     }

procedure NegateBoolean;
visible;

  begin
    if CodeIsToBeGenerated then Negate(ABoolean)
  end { negateaboolean };

procedure BinaryBooleanOperation ( Operator: OpType;
                                   FirstOperation: Boolean );
visible;

  var Entry, ListEntry, Index: StackEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        Pop(Entry);
        Entry^.NextNode := nil;
        if FirstOperation
        then
          begin
            GetEntry(ListEntry);
            with ListEntry^ do
              begin
                DataRep := BooleanRepresentation;
                Kind := Operation;
                OpForm := Condition;
                if Operator = OrOp
                then Jump := IfTrueConditional
                else Jump := IfFalseConditional;
                OpList := Entry
              end
          end
        else
          begin
            Pop(ListEntry);
            Index := ListEntry^.OpList;
            while Index^.NextNode <> nil do Index := Index^.NextNode;
            Index^.NextNode := Entry
          end;
        Push(ListEntry)
      end
  end { boolean operation };

procedure EliminateConditions;
visible;

  begin  end;

{

 17.7  Set Arithmetic

 Set arithmetic is handled by the procedures BinarySetOperation and
 SetComparison  in  a manner similar to that used for scalar types.
 In addition, however, set arithmetic involves the construction  of
 sets,  by  the procedures SingletonSet and RangeSet in conjunction
 with the union operation implemented by BinarySetOperation.

 Because all constructed sets, even those which are  entirely  con-
 stant,  are handled in this way, it is essential that all possible
 'folding' of set operations is carried out  at  compile-time.   To
 this  end, the procedure ConstSetOperation implements the complete
 range of set-producing  operators  for  operands  held  as  object
 values.

                                                                     }

procedure ConstSetOperation(var SetResult: ObjectValue;
                            Left, Right: ObjectValue;
                            Operator: OpType);

  var Index, LastNonZero: Scalar;
      ResultSet: MCWordForm;
      LeftList, RightList: WordEntry;
      Result: ObjectValue;
      LeftVal, RightVal: MCIntegerForm;

  procedure PushSet(Part: MCWordForm);

    var SetPart, NextPart: WordEntry;

    begin
      new(SetPart);
      with SetPart^ do
        begin
          Word := Part;
          Next := nil
        end;
      with Result do
        begin
          WordSize := WordSize + 1;
          if Setval = nil
          then Setval := SetPart
          else
            begin
              NextPart := Setval;
              while NextPart^.Next <> nil do
                NextPart := NextPart^.Next;
              NextPart^.Next := SetPart
            end
        end
    end { pushset };

  procedure SetFrame(Element: MCIntegerForm);

    var Empty: MCWordForm;

    begin
      Empty.WValue := 0;
      repeat
        PushSet(Empty);
        Element := Element - MCWordSetBits
      until Element < 0
    end { setframe };

  procedure FindWord(Element: MCIntegerForm; var Entry: WordEntry);

    var NextPart: WordEntry;

    begin
      NextPart := Result.Setval;
      while Element >= MCWordSetBits do
        begin
          NextPart := NextPart^.Next;
          Element := Element - MCWordSetBits
        end;
      Entry := NextPart;

    end { findword };

  procedure SetElement(Element: MCIntegerForm);

    var Part: WordEntry;
        Bit: MCSetBits;

    begin
      FindWord(Element, Part);
      Bit := Element mod MCWordSetBits;
      with Part^ do MCSetBit(Word, Bit)
    end { setelement };

  procedure CopySurplus(Surplus: WordEntry);

    begin
      while Surplus <> nil do
        begin
          PushSet(Surplus^.Word);
          Surplus := Surplus^.Next
        end
    end { copysurplus};

  procedure FreeList(FirstWord: WordEntry);

    var NextWord: WordEntry;

    begin
      while FirstWord <> nil do
        begin
          NextWord := FirstWord^.Next;
          dispose(FirstWord);
          FirstWord := NextWord
        end
    end { freelist };

  procedure ReduceResult(NewSize: MCIntegerForm);

    var NextEntry: WordEntry;
        i: MCIntegerForm;

    begin
      if NewSize = 0
      then
        begin
          FreeList(Result.Setval);
          Result := EmptyValue
        end
      else
        with Result do
          if WordSize <> NewSize
          then
            begin
              NextEntry := Setval;
              for i := 1 to NewSize - 1 do
                NextEntry := NextEntry^.Next;
              FreeList(NextEntry^.Next);
              NextEntry^.Next := nil;
              WordSize := NewSize
            end
    end { reduceresult };

  begin
    Result := EmptyValue;
    if Operator in [SingleOp, RangeOp]
    then
      begin
        LeftVal := Left.Ival;
        RightVal := Right.Ival
      end
    else
      begin
        LeftList := Left.Setval;
        RightList := Right.Setval
      end;
    case Operator of
      SingleOp, RangeOp :
        if LeftVal <= RightVal
        then
          begin
            SetFrame(RightVal);
            for Index := LeftVal to RightVal do SetElement(Index)
          end;
      Plus :
        begin
          while (LeftList <> nil) and (RightList <> nil) do
            begin
              ResultSet.WSet :=
                LeftList^.Word.WSet + RightList^.Word.WSet;
              PushSet(ResultSet);
              LeftList := LeftList^.Next;
              RightList := RightList^.Next
            end;
          if LeftList <> nil
          then CopySurplus(LeftList) else CopySurplus(RightList)
        end;
      Mul :
        begin
          LastNonZero := 0;
          while (LeftList <> nil) and (RightList <> nil) do
            begin
              ResultSet.WSet :=
                LeftList^.Word.WSet * RightList^.Word.WSet;
              PushSet(ResultSet);
              if ResultSet.WSet <> []
              then LastNonZero := Result.WordSize;
              LeftList := LeftList^.Next;
              RightList := RightList^.Next
            end;
          ReduceResult(LastNonZero)
        end;
      Minus :
        begin
          LastNonZero := 0;
          while (LeftList <> nil) and (RightList <> nil) do
            begin
              ResultSet.WSet :=
                LeftList^.Word.WSet - RightList^.Word.WSet;
              PushSet(ResultSet);
              if ResultSet.WSet <> []
              then LastNonZero := Result.WordSize;
              LeftList := LeftList^.Next;
              RightList := RightList^.Next
            end;
          if LeftList <> nil
          then CopySurplus(LeftList) else ReduceResult(LastNonZero)
        end
    end;
    SetResult := Result
  end { constsetoperation };

procedure SingletonSet ( SetRepresentation: TypeRepresentation );
visible;

  var Entry, ResultEntry: StackEntry;
      Result: ObjectValue;

  begin
    if CodeIsToBeGenerated
    then
      begin
        CheckRange(SetRepresentation.Min, SetRepresentation.Max, 62);
        Pop(Entry);
        if Entry^.Kind = AConstant
        then
          begin
            ConstSetOperation
              (Result, Entry^.TheConst, Entry^.TheConst, SingleOp);
            StackConstant(Result);
            FreeEntry(Entry)
          end
        else
          begin
            GetEntry(ResultEntry);
            with ResultEntry^ do
              begin
                DataRep := SetRepresentation;
                Kind := Operation;
                OpGroup := ASet;
                OpForm := Unary;
                UnaryEntry := Entry
              end;
            Push(ResultEntry)
          end
      end
  end { singletonset };

procedure RangeSet ( SetRepresentation: TypeRepresentation );
visible;

  var LowBound, HighBound, ResultEntry: StackEntry;
      Result: ObjectValue;

  begin
    if CodeIsToBeGenerated
    then
      begin
        CheckRange(SetRepresentation.Min, SetRepresentation.Max, 62);
        Pop(HighBound);
        CheckRange(SetRepresentation.Min, SetRepresentation.Max, 62);
        Pop(LowBound);
        if (LowBound^.Kind = AConstant) and
           (HighBound^.Kind = AConstant)
        then
          begin
            ConstSetOperation
              (Result, LowBound^.TheConst, HighBound^.TheConst,
                 RangeOp);
            StackConstant(Result);
            FreeEntry(LowBound);
            FreeEntry(HighBound)
          end
        else
          begin
            GetEntry(ResultEntry);
            with ResultEntry^ do
              begin
                DataRep := SetRepresentation;
                Kind := Operation;
                OpGroup := ASet;
                OpForm := Binary;
                LeftEntry := LowBound;
                RightEntry := HighBound;
                BinaryOp := RangeOp
              end;
            Push(ResultEntry)
          end
      end
  end { rangeset };

function NullSet(Entry: StackEntry): Boolean;

  begin
    with Entry^ do
      if Kind <> AConstant
      then NullSet := false else NullSet := (TheConst.Setval = nil)
  end { nullset };

procedure BinarySetOperation ( SetOperator: OpType );
visible;

  var ResultEntry, LeftOperand, RightOperand: StackEntry;
      Result: ObjectValue;

  procedure SetResultLimits;

    function MaxOf(a, b: MCScalar): MCScalar;

      begin
        if a >= b then MaxOf := a else MaxOf := b
      end { maxof };

    function MinOf(a, b: MCScalar): MCScalar;

      begin
        if a <= b then MinOf := a else MinOf := b
      end { minof };

    begin
      with ResultEntry^.DataRep do
        begin
          Kind := ForSet;
          case SetOperator of
            Plus :
              begin
                Min :=
                  MinOf
                    (LeftOperand^.DataRep.Min,
                       RightOperand^.DataRep.Min);
                Max :=
                  MaxOf
                    (LeftOperand^.DataRep.Max,
                       RightOperand^.DataRep.Max)
              end;
            Mul :
              begin
                Min :=
                  MaxOf
                    (LeftOperand^.DataRep.Min,
                       RightOperand^.DataRep.Min);
                Max :=
                  MinOf
                    (LeftOperand^.DataRep.Max,
                       RightOperand^.DataRep.Max)
              end;
            Minus :
              begin
                Min := LeftOperand^.DataRep.Min;
                Max := LeftOperand^.DataRep.Max
              end
          end
        end
    end { setresultlimits };

  begin
    if CodeIsToBeGenerated
    then
      begin
        Pop(RightOperand);
        Pop(LeftOperand);
        if NullSet(LeftOperand)
        then
          begin
            FreeEntry(LeftOperand);
            if SetOperator = Plus
            then Push(RightOperand)
            else
              begin
                StackConstant(EmptyValue);
                FreeEntry(RightOperand)
              end
          end
        else
          if NullSet(RightOperand)
          then
            begin
              if SetOperator in [Plus, Minus]
              then Push(LeftOperand)
              else
                begin
                  StackConstant(EmptyValue);
                  FreeEntry(LeftOperand)
                end
            end
          else
            if (RightOperand^.Kind = AConstant) and
               (LeftOperand^.Kind = AConstant)
            then
              begin
                ConstSetOperation
                  (Result, LeftOperand^.TheConst,
                     RightOperand^.TheConst, SetOperator);
                StackConstant(Result);
                FreeEntry(LeftOperand);
                FreeEntry(RightOperand)
              end
            else
              begin
                GetEntry(ResultEntry);
                SetResultLimits;
                with ResultEntry^ do
                  begin
                    Kind := Operation;
                    OpGroup := ASet;
                    OpForm := Binary;
                    LeftEntry := LeftOperand;
                    RightEntry := RightOperand;
                    BinaryOp := SetOperator
                  end;
                Push(ResultEntry)
              end
      end
  end { binarysetoperation };

procedure SetComparison ( SetOperator: OpType );
visible;

  var LeftOperand, RightOperand, ResultEntry: StackEntry;
      Result: ObjectValue;
      Bval: Boolean;

  begin
    if CodeIsToBeGenerated
    then
      begin
        if (TopStackEntry^.Kind = AConstant) and
           (TopStackEntry^.NextNode^.Kind = AConstant)
        then
          begin
            if SetOperator = GeOp
            then
              begin
                Pop(LeftOperand);
                Pop(RightOperand);
                SetOperator := LeOp
              end
            else
              begin
                Pop(RightOperand);
                Pop(LeftOperand)
              end;
            if SetOperator = InOp
            then
              with LeftOperand^ do
                begin
                  ConstSetOperation
                    (TheConst, TheConst, TheConst, SingleOp);
                  SetOperator := LeOp
                end;
            case SetOperator of
              LeOp :
                if LeftOperand^.TheConst.WordSize >
                     RightOperand^.TheConst.WordSize
                then Bval := false
                else
                  begin
                    ConstSetOperation
                      (Result, LeftOperand^.TheConst,
                         RightOperand^.TheConst, Minus);
                    Bval := (Result.Setval = nil)
                  end;
              NeOp :
                if LeftOperand^.TheConst.WordSize <>
                     RightOperand^.TheConst.WordSize
                then Bval := true
                else
                  begin
                    ConstSetOperation
                      (Result, LeftOperand^.TheConst,
                         RightOperand^.TheConst, Minus);
                    Bval := (Result.Setval <> nil)
                  end;
              EqOp :
                if LeftOperand^.TheConst.WordSize <>
                     RightOperand^.TheConst.WordSize
                then Bval := false
                else
                  begin
                    ConstSetOperation
                      (Result, LeftOperand^.TheConst,
                         RightOperand^.TheConst, Minus);
                    Bval := (Result.Setval = nil)
                  end
            end;
            SetBval(Bval, Result);
            StackConstant(Result);
            FreeEntry(LeftOperand);
            FreeEntry(RightOperand)
          end
        else Compare(SetOperator, ASet)
      end
  end { setcomparision };

{

 17.8 Pointer and String Comparison

 Delayed code generation for all pointer and string comparisons  is
 implemented as follows:

                                                                     }

procedure PnterComparison ( Operator: OpType );
visible;

  begin
    if CodeIsToBeGenerated then Compare(Operator, APointer)
  end { pointercomparison };

procedure StringComparison ( Operator: OpType;
                             Length : ObjectValue );
visible;

  var LeftEntry, RightEntry: StackEntry;

  begin
    if CodeIsToBeGenerated
    then
      begin
        Pop(RightEntry);
        RightEntry^.DataBytes := Length.Ival;
        Pop(LeftEntry);
        LeftEntry^.DataBytes := Length.Ival;
        Push(LeftEntry);
        Push(RightEntry);
        Compare(Operator, AString)
      end
  end { stringcomparison };

begin
{ end of module}
end.