Unit Equation;

Interface

Uses Classes;

Type
  TOpType      = (otUnary,otBinary);
  TOperator    = (noAdd,noSubtract,noMultiply,noDivide,noModulo, { Numeric }
                  boAnd,boOr,boXor,boNot,                        { Boolean }
                  roEqual,roUnequal,roLess,roGreater,            { Relational }
                  roLessEqual,roGreaterEqual,
                  woAnd,woOr,woXor);                             { Bitwise }
  TVariable    = (vaCrtX,vaCrtY,vaP0,vaP1,vaM0,vaM1,vaBL,vaRegX,vaRegY,vaRegA,
                  vaRegP,vaRegS,vaRegPC);
  TItemType    = (itNumericOp,itBooleanOp,itRelationalOp,itBitwiseOp,
                  itNumeric,itBoolean,itVariable,itMemory,itOpenPar,
                  itClosePar,itNone);

  TItemTypeSet = Set Of TItemType;
  TOperatorSet = Set Of TOperator;

  TItemValue = Record
   Case TItemType Of
     itNumericOp,
     itBooleanOp,
  itRelationalOp,
     itBitwiseOp: (Operator : TOperator);
       itNumeric: (Number   : LongInt);
       itBoolean: (Bool     : Boolean);
      itVariable: (Variable : TVariable);
        itMemory: (Memory   : Word);
       itOpenPar,
      itClosePar,
          itNone: (Dummy    : Word);
   End; { Case }

  TItem = Class
    ItemType : TItemType;
    Value    : TItemValue;
    Constructor Init(IType: TItemType);
    Constructor InitItem(Item: TItem);
    Constructor InitOperator(IType: TItemType; IValue: TOperator);
    Constructor InitNumeric(IValue: LongInt);
    Constructor InitBoolean(IValue: Boolean);
    Constructor InitVariable(IValue: TVariable);
    Constructor InitMemory(IValue: Word);
    Destructor  Destroy; Override;
  End;

Function FixNum(St: String): String;
Function Evaluate(Items: TStringList;
                  Var Memory: Array Of Byte;
                  P0,P1,M0,M1,BL: Integer;
                  X,Y,A,P,S: Byte;
                  PC: Word;
                  CX,CY: Integer;
                  Var Error: Boolean): Boolean; Pascal;
Function PostFix(St: String): TStringList;
Function PostFixStr(Items: TStringList): String;
Function ValHex(St: String): LongInt;

Implementation

Uses HexWrite,SysUtils;

Function ValHex(St: String): LongInt;
Var
  Initial : LongInt;
  I       : Integer;
  Value   : LongInt;

Begin
  If St = '' Then
  Begin
    ValHex := -1;
    Exit;
  End;
{  If Length(St) > 8 Then St := Copy(St,1,8);}
  Value   := 0;
  St      := UpperCase(St);
  I       := (Length(St) - 1) * 4;
  Initial := 1 Shl I;
  For I := 1 To Length(St) Do
  Begin
    If St[I] In ['0'..'9'] Then Inc(Value,Initial * (Ord(St[I]) - Ord('0')))
     Else
      If St[I] In ['A'..'F'] Then Inc(Value,Initial * (Ord(St[I]) - Ord('A') + 10))
       Else
       Begin
         ValHex := -1;
         Exit;
       End;
    Initial := Initial Shr 4;
  End; { For I }
  ValHex := Value;
End; { ValHex }

Function FixNum(St: String): String;
Begin
  While (St <> '') And (St[1]          = ' ') Do Delete(St,1,1);
  While (St <> '') And (St[Length(St)] = ' ') Do Delete(St,Length(St),1);
  If St = '' Then St := '0';
  FixNum := St;
End; { FixNum }

Constructor TItem.Init(IType: TItemType);
Begin
  Inherited Create;
  ItemType    := IType;
  Value.Dummy := 0;
End; { TItem.Init }

Constructor TItem.InitItem(Item: TItem);
Begin
  Inherited Create;
  ItemType := Item.ItemType;
  Value    := Item.Value
End; { TItem.InitItem }

Constructor TItem.InitOperator(IType: TItemType; IValue: TOperator);
Begin
  Inherited Create;
  ItemType       := IType;
  Value.Operator := IValue;
End; { TItem.InitOperator }

Constructor TItem.InitNumeric(IValue: LongInt);
Begin
  Inherited Create;
  ItemType     := itNumeric;
  Value.Number := IValue;
End; { TItem.InitNumeric }

Constructor TItem.InitBoolean(IValue: Boolean);
Begin
  Inherited Create;
  ItemType   := itBoolean;
  Value.Bool := IValue;
End; { TItem.InitBoolean }

Constructor TItem.InitVariable(IValue: TVariable);
Begin
  Inherited Create;
  ItemType       := itVariable;
  Value.Variable := IValue;
End; { TItem.InitVariable }

Constructor TItem.InitMemory(IValue: Word);
Begin
  Inherited Create;
  ItemType     := itMemory;
  Value.Memory := IValue;
End; { TItem.InitMemory }

Destructor TItem.Destroy;
Begin
  Inherited;
End; { TItem.Done }

Function PostFix(St: String): TStringList;
Var
  St1       : String;
  I,J       : Integer;
  Stack     : TStringList;
  Items     : TStringList;
  Final     : TStringList;
//  Ch        : Char;
  Finished  : Boolean;
  Error     : Boolean;
  Ok        : Boolean;
  ItemType  : TItemType;
  L         : LongInt;
  Token     : Integer;
  Item      : TItem;

  Procedure PopStack;
  Var Item: TItem;
  Begin
    If Stack.Count > 0 Then
    Begin
      Item := TItem(Stack.Objects[Stack.Count - 1]);
      Final.AddObject('',TItem.InitItem(Item));
      Stack.Objects[Stack.Count - 1].Free;
      Stack.Delete(Stack.Count - 1);
    End;
  End; { PopStack }

  Procedure PushStack;
  Var Item: TItem;
  Begin
    If Items.Count > 0 Then
    Begin
      Item := TItem(Items.Objects[0]);
      Stack.AddObject('',TItem.InitItem(Item));
    End;
  End; { PushStack }

  Procedure InsertParentheses(IType: TItemType; OType: TOpType;
                              Op: TOperatorSet; Bounds: TItemTypeSet);
  Var
    OpPos    : Integer;
    I        : Integer;
    Level    : Integer;
    Finished : Boolean;
    Item     : TItem;
    Item1    : TItem;

  Begin
//    OpPos  := 1;
    I      := 0;
    While I < Items.Count Do
    Begin
      Item := TItem(Items.Objects[I]);

      { Detect the target operator }

      If (Item.ItemType       = IType) And
         (Item.Value.Operator In Op)   Then
      Begin

        { If this is a binary operator, backtrack to find the first operand }

        If OType = otBinary Then
        Begin
          OpPos    := I;
          Level    := 0;
          Finished := False;
          Repeat
            If OpPos > 0 Then
            Begin
              Dec(OpPos);
              Item1 := TItem(Items.Objects[OpPos]);
              If Item1.ItemType = itClosePar Then Inc(Level);
              If Item1.ItemType = itOpenPar  Then Dec(Level);
              If (Level = 0) And
                 (Item1.ItemType In (Bounds + [itOpenPar])) Then
               Finished := True;
            End;
          Until (OPPos <= 0) Or Finished;
          If OpPos < I Then
          Begin
            Items.InsertObject(OpPos,'',TItem.Init(itOpenPar));
            Inc(I);
          End;
        End
        Else
        Begin
          Items.InsertObject(I,'',TItem.Init(itOpenPar));
          Inc(I);
        End;

        { Move forward to find the next operand }

        Level    := 0;
        OpPos    := I;
        Finished := False;
        Repeat
          If OpPos < (Items.Count - 1) Then
          Begin
            Inc(OpPos);
            Item1 := TItem(Items.Objects[OpPos]);
            If Item1.ItemType = itOpenPar  Then Inc(Level);
            If Item1.ItemType = itClosePar Then Dec(Level);
            If (Level = 0) And
               (Item1.ItemType In (Bounds + [itClosePar])) Then
             Finished := True;
          End;
        Until (OpPos = Items.Count - 1) Or Finished;
        If OpPos > I Then
         Items.InsertObject(OpPos + 1,'',TItem.Init(itClosePar));
        Inc(I);
      End
      Else Inc(I);
    End; { While }
  End; { InsertParentheses }

  Procedure InsNumPar(OType: TOpType; Op: TOperatorSet);
  Begin
    InsertParentheses(itNumericOp,OType,Op,[itNumeric,itVariable,itMemory]);
  End; { InsNumPar }

  Procedure InsBoolPar(OType: TOpType; Op: TOperatorSet);
  Begin
    InsertParentheses(itBooleanOp,OType,Op,[itBoolean]);
  End; { InsBoolPar }

  Procedure InsRelBoolPar(OType: TOpType; Op: TOperatorSet);
  Begin
    InsertParentheses(itRelationalOp,OType,Op,[itBoolean]);
  End; { InsRelBoolPar }

  Procedure InsRelNumPar(OType: TOpType; Op: TOperatorSet);
  Begin
    InsertParentheses(itRelationalOp,OType,Op,[itNumeric,itVariable,itMemory]);
  End; { InsRelNumPar }

  Procedure InsBitwPar(OType: TOpType; Op: TOperatorSet);
  Begin
    InsertParentheses(itBitwiseOp,OType,Op,[itNumeric,itVariable,itMemory]);
  End; { InsBitwPar }

Begin

  { Check for mismatched parentheses }

  I     := 1;
  J     := 0;
  Error := False;
  While (I <= Length(St)) And Not Error Do
  Begin
    If St[I] = '(' Then Inc(J);
    If St[I] = ')' Then Dec(J);
    If J < 0 Then Error := True;
    Inc(I);
  End; { While }
  If J <> 0 Then Error := True;
  If Error Then
  Begin
    PostFix := Nil;
    Exit;
  End;

  { Initialize variables }

  Stack := TStringList.Create;
  Items := TStringList.Create;

  { Remove all spaces }

  I := Pos(' ',St);
  While I <> 0 Do
  Begin
    Delete(St,I,1);
    I := Pos(' ',St);
  End; { While }

  { Convert to uppercase }

  St := UpperCase(St);

  { Tokenize the string }

  I := 1;
  ItemType := itNone;
  Error    := False;
  While (I <= Length(St)) And Not Error Do
  Begin
    Token := 1;       { Default token size }

    { Detect operators (do larger ones first!) }

    If (Copy(St,I,2) = '&&') Then
    Begin
      Items.AddObject('',TItem.InitOperator(itBooleanOp,boAnd));
      Token := 2;
    End;
    If (Copy(St,I,2) = '||') Then
    Begin
      Items.AddObject('',TItem.InitOperator(itBooleanOp,boOr));
      Token := 2;
    End;
    If (Copy(St,I,2) = '^^') Then
    Begin
      Items.AddObject('',TItem.InitOperator(itBooleanOp,boXOr));
      Token := 2;
    End;
    If (Copy(St,I,2) = '<=') Then
    Begin
      Items.AddObject('',TItem.InitOperator(itRelationalOp,roLessEqual));
      Token := 2;
    End;
    If (Copy(St,I,2) = '>=') Then
    Begin
      Items.AddObject('',TItem.InitOperator(itRelationalOp,roGreaterEqual));
      Token := 2;
    End;
    If (Copy(St,I,2) = '<>') Then
    Begin
      Items.AddObject('',TItem.InitOperator(itRelationalOp,roUnequal));
      Token := 2;
    End;
    If (Copy(St,I,2) = '!=') Then
    Begin
      Items.AddObject('',TItem.InitOperator(itRelationalOp,roUnequal));
      Token := 2;
    End;
    If (Copy(St,I,2) = '==') Then
    Begin
      Items.AddObject('',TItem.InitOperator(itRelationalOp,roEqual));
      Token := 2;
    End;
    If Token = 1 Then
    Begin
      If St[I] = '~' Then Items.AddObject('',TItem.InitOperator(itBooleanOp,boNot));
      If St[I] = '!' Then Items.AddObject('',TItem.InitOperator(itBooleanOp,boNot));
      If St[I] = '=' Then Items.AddObject('',TItem.InitOperator(itRelationalOp,roEqual));
      If St[I] = '<' Then Items.AddObject('',TItem.InitOperator(itRelationalOp,roLess));
      If St[I] = '>' Then Items.AddObject('',TItem.InitOperator(itRelationalOp,roGreater));
      If St[I] = '&' Then Items.AddObject('',TItem.InitOperator(itBitwiseOp,woAnd));
      If St[I] = '|' Then Items.AddObject('',TItem.InitOperator(itBitwiseOp,woOr));
      If St[I] = '^' Then Items.AddObject('',TItem.InitOperator(itBitwiseOp,woXor));
      If St[I] = '%' Then Items.AddObject('',TItem.InitOperator(itNumericOp,noModulo));
      If St[I] = '*' Then Items.AddObject('',TItem.InitOperator(itNumericOp,noMultiply));
      If St[I] = '/' Then Items.AddObject('',TItem.InitOperator(itNumericOp,noDivide));
      If (St[I] = '+') And (ItemType In [itNumeric,itMemory,itVariable,itClosePar]) Then
       Items.AddObject('',TItem.InitOperator(itNumericOp,noAdd));
      If (St[I] = '-') And (ItemType In [itNumeric,itMemory,itVariable,itClosePar]) Then
       Items.AddObject('',TItem.InitOperator(itNumericOp,noSubtract));

      { Detect integers (decimal and hecadecimal) }

      If (St[I] In ['0'..'9']) Or
         ((St[I] In ['-','+']) And
          Not (ItemType In [itNumeric,itMemory,itVariable,itClosePar])) Then
      Begin
        J        := I + 1;
//        Ok       := True;
        Finished := False;
        While (J <= Length(St)) And Not Finished Do
        Begin
          If Not (St[J] In ['0'..'9','A'..'F'])
           Then Finished := True
           Else Inc(J);
        End; { While }

        { Detect hexadecimal numbers }

        If (J <= Length(St)) And (St[J] = 'H') Then Inc(J);

        { Get the number's value if possible }

        Token  := J - I;
        St1    := Copy(St,I,Token);
        If St1[1] = '+' Then Delete(St1,1,1);
        If St1[Length(St1)] <> 'H' Then Val(St1,L,J)
        Else
        Begin
          St1 := Copy(St1,1,Length(St1) - 1);  { Strip off the "h" }
          L := 0;
          If St1[1] = '-' Then Error := True Else L := ValHex(St1);
          If L < 0 Then Error := True;
        End;
        If Not Error Then Items.AddObject('',TItem.InitNumeric(L));
      End;

      { Detect numeric variables }

      If (Copy(St,I,2) = 'CX') Then
      Begin
        Items.AddObject('',TItem.InitVariable(vaCrtX));
        Token := 2;
      End;
      If (Copy(St,I,2) = 'CY') Then
      Begin
        Items.AddObject('',TItem.InitVariable(vaCrtY));
        Token := 2;
      End;
      If (Copy(St,I,2) = 'P0') Then
      Begin
        Items.AddObject('',TItem.InitVariable(vaP0));
        Token := 2;
      End;
      If (Copy(St,I,2) = 'P1') Then
      Begin
        Items.AddObject('',TItem.InitVariable(vaP1));
        Token := 2;
      End;
      If (Copy(St,I,2) = 'M0') Then
      Begin
        Items.AddObject('',TItem.InitVariable(vaM0));
        Token := 2;
      End;
      If (Copy(St,I,2) = 'M1') Then
      Begin
        Items.AddObject('',TItem.InitVariable(vaM1));
        Token := 2;
      End;
      If (Copy(St,I,2) = 'BL') Then
      Begin
        Items.AddObject('',TItem.InitVariable(vaBL));
        Token := 2;
      End;
      If (Copy(St,I,2) = 'PC') Then
      Begin
        Items.AddObject('',TItem.InitVariable(vaRegPC));
        Token := 2;
      End;
      If Token = 1 Then
      Begin
        If St[I] = 'A' Then Items.AddObject('',TItem.InitVariable(vaRegA));
        If St[I] = 'X' Then Items.AddObject('',TItem.InitVariable(vaRegX));
        If St[I] = 'Y' Then Items.AddObject('',TItem.InitVariable(vaRegY));
        If St[I] = 'P' Then Items.AddObject('',TItem.InitVariable(vaRegP));
        If St[I] = 'S' Then Items.AddObject('',TItem.InitVariable(vaRegS));

        { Detect memory references (always hexadecimal) }

        If St[I] = '[' Then
        Begin
          J        := I + 1;
          Ok       := True;
          Finished := False;
          While (J <= Length(St)) And Ok And Not Finished Do
          Begin
            If Not (St[J] In ['0'..'9','A'..'F',']']) Then Ok := False;
            If St[J] = ']' Then
            Begin
              Finished := True;
              If J = I + 1 Then Ok := False;  { Detect "[]" }
            End;
            Inc(J);
          End; { While }
          If Finished And Ok Then
          Begin
            Token := J - I;
            L     := ValHex(Copy(St,I + 1,Token - 2)); { Strip off brackets }
            If L >= 0
             Then Items.AddObject('',TItem.InitMemory(L))
             Else Error := True;
          End
          Else Error := True;
        End;

        { Detect parentheses }

        If St[I] = '(' Then Items.AddObject('',TItem.Init(itOpenPar));
        If St[I] = ')' Then Items.AddObject('',TItem.Init(itClosePar));
      End;
    End;

    { Remember the type of whatever we added for next time }

    If Items.Count > 0 Then
     ItemType := TItem(Items.Objects[Items.Count - 1]).ItemType;

    { Move to the next token }

    Inc(I,Token);
  End; { While }

  { If the string was tokenized okay, continue }

  If Not Error Then
  Begin

    { Insert multiplier operations where multiplication is implicit }

    Final    := TStringList.Create;
    I        := 0;
    ItemType := itNone;
    While I < Items.Count Do
    Begin
      Item := TItem(Items.Objects[I]);

      { Insert multipliers where needed }

      If (Item.ItemType In [itNumeric,itVariable,itMemory,itOpenPar]) And
         (ItemType      In [itNumeric,itVariable,itMemory,itClosePar]) Then
      Begin
        Items.InsertObject(I,'',TItem.InitOperator(itNumericOp,noMultiply));
        ItemType := itNumericOp;
      End
      Else ItemType := Item.ItemType; { Remember the type for next time }
      Inc(I);
    End; { While }

    { Add sets of parentheses for operator precedence }

    InsBoolPar(otUnary,[boNot]);
    InsNumPar(otBinary,[noMultiply,noDivide,noModulo]);
    InsBoolPar(otBinary,[boAnd]);
    InsBitwPar(otBinary,[woAnd]);
    InsNumPar(otBinary,[noAdd,noSubtract]);
    InsBoolPar(otBinary,[boOr,boXor]);
    InsBitwPar(otBinary,[woOr,woXor]);
    InsRelNumPar(otBinary,[roEqual,roUnequal,roLess,roGreater]);
    InsRelBoolPar(otBinary,[roEqual,roUnequal]);
    InsRelNumPar(otBinary,[roLessEqual,roGreaterEqual]);

    { Convert to postfix }

    While Items.Count > 0 Do
    Begin
//      Ok := True;

      ItemType := TItem(Items.Objects[0]).ItemType;
      Case ItemType Of
        itClosePar: PopStack;  { Pop an operator off the stack }

       itNumericOp,
       itBooleanOp,
    itRelationalOp,
       itBitwiseOp: PushStack; { Push any operators onto the stack }

         itNumeric,
        itVariable,
          itMemory,
         itBoolean: Final.AddObject('',TItem.InitItem(TItem(Items.Objects[0])));
      End; { Case }

      { Remove the item from the infix list }

      Items.Objects[0].Free;
      Items.Delete(0);
    End; { While }

    { Pop any operators off the stack }

    While Stack.Count > 0 Do PopStack;
  End
  Else Final := Nil;
  Items.Free;
  Stack.Free;
  PostFix := Final;
End; { PostFix }

Function PostFixStr(Items: TStringList): String;
Var
  I    : Integer;
  St   : String;
  Item : TItem;

Begin
  If Items <> Nil Then
  Begin
    St := '';
    I  := 0;
    While I < Items.Count Do
    Begin
      Item := TItem(Items.Objects[I]);
      Case Item.ItemType Of
        itNumericOp,
        itBooleanOp,
        itRelationalOp,
        itBitwiseOp:
        Begin
          Case Item.Value.Operator Of
            noAdd: St := St + '+';
       noSubtract: St := St + '-';
       noMultiply: St := St + '*';
         noDivide: St := St + '/';
         noModulo: St := St + '%';
            boAnd: St := St + 'And';
             boOr: St := St + 'Or';
            boXor: St := St + 'Xor';
            boNot: St := St + 'Not';
          roEqual: St := St + '=';
        roUnequal: St := St + '<>';
           roLess: St := St + '<';
        roGreater: St := St + '>';
      roLessEqual: St := St + '<=';
   roGreaterEqual: St := St + '>=';
            woAnd: St := St + 'And';
             woOr: St := St + 'Or';
            woXor: St := St + 'Xor';
          End; { Case }
        End;
        itNumeric: St := St + IntToStr(Item.Value.Number);
        itBoolean: If Item.Value.Bool Then St := St + 'TRUE' Else St := St + 'FALSE';
        itVariable:
        Begin
          Case Item.Value.Variable Of
         vaCrtX: St := St + 'Crt.X';
         vaCrtY: St := St + 'Crt.Y';
           vaP0: St := St + 'P0';
           vaP1: St := St + 'P1';
           vaM0: St := St + 'M0';
           vaM1: St := St + 'M1';
           vaBL: St := St + 'BL';
         vaRegX: St := St + 'Reg.X';
         vaRegY: St := St + 'Reg.Y';
         vaRegA: St := St + 'Reg.A';
         vaRegP: St := St + 'Reg.P';
         vaRegS: St := St + 'Reg.S';
        vaRegPC: St := St + 'Reg.PC';
          End; { Case }
        End;
        itMemory: St := St + HexWord(Item.Value.Memory);

        { These last two should never occur for a postfix expression }

        itOpenPar: St := St + '(';
       itClosePar: St := St + ')';
      End; { Case }
      St := St + ' ';
      Inc(I);
    End; { While }
  End
  Else St := 'ERROR';
  PostFixStr := St;
End; { PostFixStr }

Function Evaluate(Items: TStringList;
                  Var Memory: Array Of Byte;
                  P0,P1,M0,M1,BL: Integer;
                  X,Y,A,P,S: Byte;
                  PC: Word;
                  CX,CY: Integer;
                  Var Error: Boolean): Boolean; 
Var
  Func  : TItem;
  I     : Integer;
  Stack : TStringList;  { TCollections take WAY too long to do this }
  E1    : TItem;        { on every Atari instruction                }
  E2    : TItem;
  Item  : TItem;
  Count : Integer;
  Value : TItemValue;

  Procedure PopStack(Var Item: TItem);
  Begin
    If Not Error Then
    Begin
      If Stack.Count > 0 Then
      Begin
        Item.ItemType := TItem(Stack.Objects[Stack.Count - 1]).ItemType;
        Item.Value    := TItem(Stack.Objects[Stack.Count - 1]).Value;
        Stack.Objects[Stack.Count - 1].Free;
        Stack.Delete(Stack.Count - 1);
      End
      Else Error := True;
    End;
  End; { PopStack }

Begin
  Func  := TItem.Create;
  Error := False;
  E1    := TItem.Create;
  E2    := TItem.Create;
  If Items <> Nil Then
  Begin
    Count := Items.Count;

    { There should never be more than this on the stack }

    I     := 0;
    Error := False;
    Stack := TStringList.Create;
    While (I < Count) And Not Error Do
    Begin
      Item  := TItem(Items.Objects[I]);
      Value := Item.Value;
      Func.ItemType    := itNone;
      Func.Value.Dummy := 0;

      { Handle operators }

      Case Item.ItemType Of
        itNumericOp,
        itBooleanOp,
        itRelationalOp,
        itBitwiseOp:
        Begin
          Case Value.Operator Of
            noAdd:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itNumeric) And
                 (E2.ItemType = itNumeric) Then
              Begin
                Func.ItemType     := itNumeric;
                Func.Value.Number := E1.Value.Number + E2.Value.Number;
              End
              Else Error := True;
            End;
            noSubtract:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itNumeric) And
                 (E2.ItemType = itNumeric) Then
              Begin
                Func.ItemType     := itNumeric;
                Func.Value.Number := E2.Value.Number - E1.Value.Number;
              End
              Else Error := True;
            End;
            noMultiply:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itNumeric) And
                 (E2.ItemType = itNumeric) Then
              Begin
                Func.ItemType     := itNumeric;
                Func.Value.Number := E1.Value.Number * E2.Value.Number;
              End
              Else Error := True;
            End;
            noDivide:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itNumeric) And
                 (E2.ItemType = itNumeric) And
                 (E1.Value.Number <> 0)    Then
              Begin
                Func.ItemType     := itNumeric;
                Func.Value.Number := E2.Value.Number Div E1.Value.Number;
              End
              Else Error := True;
            End;
            noModulo:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itNumeric) And
                 (E2.ItemType = itNumeric) And
                 (E1.Value.Number <> 0)    Then
              Begin
                Func.ItemType     := itNumeric;
                Func.Value.Number := E2.Value.Number Mod E1.Value.Number;
              End
              Else Error := True;
            End;
            boAnd:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itBoolean) And
                 (E2.ItemType = itBoolean) Then
              Begin
                Func.ItemType   := itBoolean;
                Func.Value.Bool := E2.Value.Bool And E1.Value.Bool;
              End
              Else Error := True;
            End;
            boOr:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itBoolean) And
                 (E2.ItemType = itBoolean) Then
              Begin
                Func.ItemType   := itBoolean;
                Func.Value.Bool := E2.Value.Bool Or E1.Value.Bool;
              End
              Else Error := True;
            End;
            boXor:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itBoolean) And
                 (E2.ItemType = itBoolean) Then
              Begin
                Func.ItemType   := itBoolean;
                Func.Value.Bool := E2.Value.Bool Xor E1.Value.Bool;
              End
              Else Error := True;
            End;
            boNot:
            Begin
              PopStack(E1);
              If E1.ItemType = itBoolean Then
              Begin
                Func.ItemType   := itBoolean;
                Func.Value.Bool := Not E1.Value.Bool;
              End
              Else If E1.ItemType = itNumeric Then
              Begin
                Func.ItemType     := itNumeric;
                Func.Value.Number := Not E1.Value.Number;
              End
              Else Error := True;
            End;
            roEqual:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itBoolean) And
                 (E2.ItemType = itBoolean) Then
              Begin
                Func.ItemType   := itBoolean;
                Func.Value.Bool := (E2.Value.Bool = E1.Value.Bool);
              End
              Else If (E1.ItemType = itNumeric) And
                      (E2.ItemType = itNumeric) Then
              Begin
                Func.ItemType   := itBoolean;
                Func.Value.Bool := (E2.Value.Number = E1.Value.Number);
              End
              Else Error := True;
            End;
            roUnequal:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itBoolean) And
                 (E2.ItemType = itBoolean) Then
              Begin
                Func.ItemType   := itBoolean;
                Func.Value.Bool := (E2.Value.Bool <> E1.Value.Bool);
              End
              Else If (E1.ItemType = itNumeric) And
                      (E2.ItemType = itNumeric) Then
              Begin
                Func.ItemType   := itBoolean;
                Func.Value.Bool := (E2.Value.Number <> E1.Value.Number);
              End
              Else Error := True;
            End;
            roLess:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itNumeric) And
                 (E2.ItemType = itNumeric) Then
              Begin
                Func.ItemType   := itBoolean;
                Func.Value.Bool := (E2.Value.Number < E1.Value.Number);
              End
              Else Error := True;
            End;
            roGreater:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itNumeric) And
                 (E2.ItemType = itNumeric) Then
              Begin
                Func.ItemType   := itBoolean;
                Func.Value.Bool := (E2.Value.Number > E1.Value.Number);
              End
              Else Error := True;
            End;
            roLessEqual:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itNumeric) And
                 (E2.ItemType = itNumeric) Then
              Begin
                Func.ItemType   := itBoolean;
                Func.Value.Bool := (E2.Value.Number <= E1.Value.Number);
              End
              Else Error := True;
            End;
            roGreaterEqual:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itNumeric) And
                 (E2.ItemType = itNumeric) Then
              Begin
                Func.ItemType   := itBoolean;
                Func.Value.Bool := (E2.Value.Number >= E1.Value.Number);
              End
              Else Error := True;
            End;
            woAnd:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itNumeric) And
                 (E2.ItemType = itNumeric) Then
              Begin
                Func.ItemType     := itNumeric;
                Func.Value.Number := E2.Value.Number And E1.Value.Number;
              End
              Else Error := True;
            End;
            woOr:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itNumeric) And
                 (E2.ItemType = itNumeric) Then
              Begin
                Func.ItemType     := itNumeric;
                Func.Value.Number := E2.Value.Number Or E1.Value.Number;
              End
              Else Error := True;
            End;
            woXor:
            Begin
              PopStack(E1);
              PopStack(E2);
              If (E1.ItemType = itNumeric) And
                 (E2.ItemType = itNumeric) Then
              Begin
                Func.ItemType     := itNumeric;
                Func.Value.Number := E2.Value.Number Xor E1.Value.Number;
              End
              Else Error := True;
            End;
          Else
            Error := True;
          End; { Case }
        End;
        itNumeric,
        itBoolean: Func.InitItem(Item);
        itVariable:
        Begin
          Func.ItemType := itNumeric;
          Case Value.Variable Of
         vaCrtX: Func.Value.Number := CX;
         vaCrtY: Func.Value.Number := CY;
           vaP0: Func.Value.Number := P0;
           vaP1: Func.Value.Number := P1;
           vaM0: Func.Value.Number := M0;
           vaM1: Func.Value.Number := M1;
           vaBL: Func.Value.Number := BL;
         vaRegX: Func.Value.Number := X;
         vaRegY: Func.Value.Number := Y;
         vaRegA: Func.Value.Number := A;
         vaRegP: Func.Value.Number := P;
         vaRegS: Func.Value.Number := S;
        vaRegPC: Func.Value.Number := PC;
          Else
            Error := True;
          End; { Case }
        End;
        itMemory:
        Begin
          Func.ItemType := itNumeric;
          If Value.Memory < $2000 Then
           Func.Value.Number := Memory[Value.Memory]
          Else Error := True;
        End;
      End; { Case }
      Inc(I);
      If Not Error Then Stack.AddObject('',TItem.InitItem(Func));
    End; { While }
    Stack.Free;
    If Func.ItemType <> itBoolean Then Error := True;
  End
  Else Error := True;
  If Not Error Then Evaluate := Func.Value.Bool Else Evaluate := False;
  Func.Free;
  E1.Free;
  E2.Free;
End; { Evaluate }

End.

// ----------------------------------------------------------------------
// PCAE and PCAEWin - PC Atari Emulator - Atari 2600 emulator
// Copyright (C) 2000 John Dullea
//
//  This program is free software; you can redistribute it and/or modify
//  it under the terms of the GNU General Public License as published by
//  the Free Software Foundation; either version 2 of the License, or
//  (at your option) any later version.
//
//  This program is distributed in the hope that it will be useful,
//  but WITHOUT ANY WARRANTY; without even the implied warranty of
//  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
//  GNU General Public License for more details.
//
//  You should have received a copy of the GNU General Public License
//  along with this program; if not, write to the Free Software
//  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
// ----------------------------------------------------------------------
