Chip Hitware 6 B/CHIP_HITWARE6_B.iso/biuro/BaseCalculator/Sources/Calc.pas

Pascal/Delphi Source File | 1996-11-06 | 18KB | 648 lines

unit Calc;

{************************************************************************
*                                                                       *
*                         Calculator State Machine                      *
*                                                                       *
************************************************************************}

{ Author:    John Zaitseff <[e-mail]>
  Date:      6th November, 1996.
  Version:   1.2

  This file provides an implementation of a state machine for a base
  integer calculator (ie, one that operates in decimal, hexadecimal,
  octal or binary), in either 8, 16 or 32 bit size.  As well as keeping
  the necessary values that the calculator needs, the calculator class
  also keeps the string representation of the value.

  This program, including this file, is under the terms of the GNU
  General Public License.
}

interface

const
  { The following constants are internal to TCalculator }
  FCalc_StackSize = 3;      { Needs to be set to the highest precedence
                              number }

type
  TCalcMode   = (Decimal, Hexadecimal, Binary, Octal);
  TCalcSize   = (Size8, Size16, Size32);
  TCalcKey    = (kNeg, kNot,
                 kMul, kDiv, kMod, kAnd,
                 kAdd, kSub, kOr,  kXor, kEqv,
                 kEquals);

  { The following types are internal to TCalculator }
  TCalc_State = (csFirstKey, csNextKey, csError);
  TCalc_Stack = record
                  FValue  : longint;
                  FOp     : TCalcKey;
                  FOpUsed : boolean
                end;

  { The actual calculator class }
  TCalculator = class
                  private
                    FMode        : TCalcMode;
                    FSigned      : boolean;
                    FSize        : TCalcSize;

                    FChanged     : boolean;

                    FString      : string;
                    FStrOK       : boolean;

                    FStack       : array [1..FCalc_StackSize] of TCalc_Stack;
                    FStackPtr    : integer;

                    FMemory      : longint;

                    FEntryState  : TCalc_State;

                    procedure SetCalcMode (Mode : TCalcMode);
                    procedure SetCalcSigned (Signed : boolean);
                    procedure SetCalcSize (Size : TCalcSize);

                  public
                    constructor Create;

                    property Mode : TCalcMode read FMode write SetCalcMode;
                    property Signed : boolean read FSigned write SetCalcSigned;
                    property Size : TCalcSize read FSize write SetCalcSize;

                    function CurrentValue : longint;
                    function CurrentString : string;
                    function Changed : boolean;
                    function InError : boolean;
                    function MemoryValue : longint;
                    function MemoryOccupied : boolean;

                    { Actual calculator functions }
                    procedure ClearAll;
                    procedure ClearOperations;    { Clear key }
                    procedure ClearMemory;

                    function AppendDigit (Digit : integer) : boolean;
                    function Backspace : boolean;

                    procedure StoreCurrentInMem;
                    procedure RetrieveMemory;
                    function AddToMemoryKey : boolean;

                    function HandleKey (Key : TCalcKey) : boolean;
                end;

{ Convert a value to a string }
function ValToStr (Value : longint; Mode : TCalcMode;
                   Signed : boolean; Size : TCalcSize) : string;

implementation

{ Round a value to 8, 16 or 32 bits, to the appropriate sign }
function RoundVal (Value : longint; Size : TCalcSize; Signed : boolean) : longint;

begin
  case Size of
    Size8  : begin
               Result := Value and $000000FF;
               if Signed and (Result > $7F) then
                 Result :=  Result - $00000100
             end;
    Size16 : begin
               Result := Value and $0000FFFF;
               if Signed and (Result > $7FFF) then
                 Result :=  Result - $00010000
             end;
    Size32 : Result := Value
  end
end;

{ Convert a value to its representation.  Only decimal numbers are to
  show a sign. }
function ValToStr (Value : longint; Mode : TCalcMode;
                   Signed : boolean; Size : TCalcSize) : string;

var
  Mult : integer;
  Neg  : boolean;
  I    : integer;
  R    : real;

const
  Table : array [0..15] of char = '0123456789ABCDEF';

begin
  Result := '';
  Neg := False;

  case Mode of
    Decimal     : Mult := 10;
    Hexadecimal : Mult := 16;
    Binary      : Mult := 2;
    Octal       : Mult := 8
  end;

  { Round the value, just in case }
  Value := RoundVal(Value, Size, Signed);

  { Display negative numbers as unsigned, except for signed decimals }
  if Value < 0 then
    begin
      if (Mode = Decimal) and Signed then
        begin
          Value := -Value;  { This will still be negative if $80000000 }
          Neg := True
        end
      else
        Value := RoundVal(Value, Size, False)
    end;

  { If bit 31 is set, Value is less than 0 }
  if Value < 0 then
    begin
      R := Value + 4294967296.0;
      I := Round(Frac(R / Mult) * Mult);
      Value := Trunc(R / Mult);
      Result := Table[I]
    end;

  repeat
    I := Value mod Mult;
    Value := Value div Mult;
    Result := Table[I] + Result
  until Value = 0;

  if Neg then
    Result := '-' + Result
end;


{ Create the calculator object }
constructor TCalculator.Create;

begin
  inherited Create;
  ClearAll
end;

{ Clear the calculator to its startup values }
procedure TCalculator.ClearAll;

begin
  { Set the default values }
  FMode := Decimal;
  FSigned := True;
  FSize := Size32;

  ClearOperations;
  ClearMemory
end;

{ Clear the calculator operations }
procedure TCalculator.ClearOperations;

var
  I : integer;

begin
  FStackPtr := 1;
  for I := 1 to FCalc_StackSize do
    with FStack[I] do
      begin
        FValue := 0;
        FOpUsed := False
      end;
  FString := '0';
  FStrOK := True;
  FEntryState := csFirstKey;
  FChanged := False
end;

{ Clear the calculator's memory }
procedure TCalculator.ClearMemory;

begin
  FMemory := 0
end;

{ Set the calculator mode (decimal, hexdecimal, binary, octal).  This
  affects the internal state machine FEntryState.  This procedure must
  NOT be called if InError returns True. }
procedure TCalculator.SetCalcMode (Mode : TCalcMode);

begin
  if FEntryState <> csError then
    begin
      FEntryState := csFirstKey;
      FMode := Mode;
      FStrOK := False;
      FChanged := True;
      { The representation, FString, will be updated in CurrentString }
    end
end;

{ Set signed or unsigned operation.  This changes FEntryState. This
  procedure must NOT be called if InError returns True. }
procedure TCalculator.SetCalcSigned (Signed : boolean);

var
  I : integer;

begin
  if FEntryState <> csError then
    begin
      FEntryState := csFirstKey;
      FSigned := Signed;
      FStrOK := False;
      FChanged := True;

      for I := 1 to FCalc_StackSize do
        with FStack[I] do
          FValue := RoundVal(FValue, FSize, FSigned);
      FMemory := RoundVal(FMemory, FSize, FSigned);
      { FString will be updated in CurrentString }
    end
end;

{ Set the size of the calculator operands.  Note that this permanently
  alters the contents of registers/memory, ie, bits are permanently
  lost in moving from a larger to smaller size.  This also changes
  TEntryState.  This procedure must NOT be called if InError returns
  True. }
procedure TCalculator.SetCalcSize (Size : TCalcSize);

var
  I : integer;

begin
  if FEntryState <> csError then
    begin
      { Make sure FValue is of the correct sign (using old FSize) }
      with FStack[FStackPtr] do
        FValue := RoundVal(FValue, FSize, FSigned);

      FEntryState := csFirstKey;
      FSize := Size;
      FStrOK := False;
      FChanged := True;

      for I := 1 to FCalc_StackSize do
        with FStack[I] do
          FValue := RoundVal(FValue, FSize, FSigned);
      FMemory := RoundVal(FMemory, FSize, FSigned);
      { FString will be updated in CurrentString }
    end
end;

{ Return the calculator's current value.  If InError returns True,
  this function returns a meaningless result. }
function TCalculator.CurrentValue : longint;

begin
  Result := FStack[FStackPtr].FValue
end;

{ Return the current value as a string.  If InError returns True,
  this function returns a meaningless result. }
function TCalculator.CurrentString : string;

begin
  if not FStrOK then
    begin
      FStrOK := True;
      FString := ValToStr(FStack[FStackPtr].FValue, FMode, FSigned, FSize)
    end;
  FChanged := False;
  Result := FString
end;

{ Return whether the calculator has been changed since the last
  display operation. }
function TCalculator.Changed : boolean;

begin
  Result := FChanged
end;

{ Return True if the calculator is in an error state and needs to
  be cleared by calling ClearOperation. }
function TCalculator.InError : boolean;

begin
  Result := (FEntryState = csError)
end;

{ Return the current memory value }
function TCalculator.MemoryValue : longint;

begin
  Result := FMemory
end;

{ Return True if memory is occupied }
function TCalculator.MemoryOccupied : boolean;

begin
  Result := (FMemory <> 0)
end;

{ Handle a digit key '0' to 'F' (passed as an integer 0-15).  This
  affects the current value.  The state machine used is incremented
  from csFirstKey to csNextKey on receipt of the first digit key.
  True is returned if the digit was successfully appended. }
function TCalculator.AppendDigit (Digit : integer) : boolean;

var
  Mult     : integer;
  C        : char;
  MaxValue : longint;

const
  MaxLen : array [Decimal..Octal, Size8..Size32] of byte
         = (( 3,  5, 10),         { Decimal }
            ( 2,  4,  8),         { Hexadecimal }
            ( 8, 16, 32),         { Binary }
            ( 3,  6, 11));        { Octal }

begin
  { Set up various scratch values }
  case FMode of
    Decimal     : Mult := 10;
    Hexadecimal : Mult := 16;
    Binary      : Mult := 2;
    Octal       : Mult := 8
  end;

  { Check for some common error conditions }
  if (FEntryState = csError) or (Digit < 0) or (Digit >= Mult) then
    begin
      Result := False;
      exit
    end;

  case FSize of
    Size8  : MaxValue := $000000FF;
    Size16 : MaxValue := $0000FFFF;
    Size32 : MaxValue := $7FFFFFFF   { NB: $FFFFFFFF is -1 }
  end;

  if Digit <= 9 then
    C := Chr(Digit + Ord('0'))
  else
    C := Chr(Digit + Ord('A') - 10);

  if FEntryState = csFirstKey then
    begin
      if Digit <> 0 then
        FEntryState := csNextKey;
      FStack[FStackPtr].FValue := Digit;
      FString := C;
      FStrOK := True
    end
  else { FEntryState = csNextKey }
    with FStack[FStackPtr] do
      begin
        { NB: String representation will ALWAYS be OK when FEntryState =
              csNextKey.  This is because any other function will alter
              FEntryState. }
        if (length(FString) >= MaxLen[FMode, FSize]) or
           (FValue * Mult + Digit > MaxValue) then
          begin
            Result := False;
            exit
          end;
        FValue := FValue * Mult + Digit;
        FString := FString + C;
        { FStrOK := True    --- already implicit }
      end;

  FChanged := True;
  Result := True
end;

{ Handle the Backspace key.  This only works if a digit key has already
  been pressed (ie, FEntryState is csNextKey). }
function TCalculator.Backspace : boolean;

var
  Mult : integer;

begin
  if FEntryState <> csNextKey then
    begin
      Result := False;
      exit
    end;

  case Mode of
    Decimal     : Mult := 10;
    Hexadecimal : Mult := 16;
    Binary      : Mult := 2;
    Octal       : Mult := 8
  end;

  { While TEntryState = csNextKey, FValue must be positive (if possible).
    The string representation is already positive; FStrOK is True. }
  with FStack[FStackPtr] do
    begin
      FValue := RoundVal(FValue, FSize, False);

      if FValue < 0 then
        FValue := Trunc((FValue + 4294967296.0) / Mult)
      else
        FValue := FValue div Mult
    end;

  Delete(FString, Length(FString), 1);      { Delete last digit }
  if (FString = '') or (FString = '-') then
    begin
      FEntryState := csFirstKey;
      FString := '0'
    end;

  FChanged := True;
  Result := True
end;

{ Store the current value in memory.  This must NOT be called if InError
  returns True. }
procedure TCalculator.StoreCurrentInMem;

begin
  if FEntryState <> csError then
    begin
      FEntryState := csFirstKey;
      FStrOK := False;
      FChanged := True;

      with FStack[FStackPtr] do
        begin
          FValue := RoundVal(FValue, FSize, FSigned);
          { FString will be updated in CurrentString }

          FMemory := FValue
        end
    end
end;

{ Store the value in memory into the current value.  This procedure must
  NOT be called if InError returns True. }
procedure TCalculator.RetrieveMemory;

begin
  if FEntryState <> csError then
    begin
      FEntryState := csFirstKey;
      FStrOK := False;
      FChanged := True;

      FStack[FStackPtr].FValue := FMemory;
      { FString will be updated in CurrentString }
    end
end;

{ Add the result of the calculation to the contents of memory and store
  it there.  Before this is done, the calculator simulates the Equals key
  being pressed.  If the result of this is an error, the memory value is
  NOT modified, and this function returns False; note that the display will
  still need to be updated if this is the case. }
function TCalculator.AddToMemoryKey : boolean;

begin
  if FEntryState = csError then
    begin
      Result := False;
      exit
    end;

  Result := HandleKey(kEquals);

  if Result = True then
    begin
      FMemory := FMemory + FStack[FStackPtr].FValue;
      FMemory := RoundVal(FMemory, FSize, FSigned)
    end
end;

{ Handle a function key (eg, Equals, Plus, Minus, ...).  This function
  returns True if the key could be handled.  Note that the display may
  still need to be updated if this function returns False. }
function TCalculator.HandleKey (Key : TCalcKey) : boolean;

  { Internal function:  Return the precedence of an operator.  A higher number
    means a higher precedence. }
  function Precedence (Op : TCalcKey) : integer;

  begin
    case Op of
      kNeg, kNot                  : Result := 3;
      kMul, kDiv, kMod, kAnd      : Result := 2;
      kAdd, kSub, kOr, kXor, kEqv : Result := 1;
      kEquals                     : Result := 0
    end
  end;

  { Internal procedure:  Perform all operations on the stack which are
    higher in precedence than the current operation (in "Key").  This
    procedure sets FEntryState to csError if an error occurrs. }
  procedure PerformPrevOps;

  begin
    while FStack[FStackPtr].FOpUsed and
          (Precedence(FStack[FStackPtr].FOp) >= Precedence(Key)) do
      begin
        FStackPtr := FStackPtr - 1;
        with FStack[FStackPtr] do
          begin
            case FStack[FStackPtr + 1].FOp of
              kMul : FValue := FValue * FStack[FStackPtr + 1].FValue;
              kDiv : if FStack[FStackPtr + 1].FValue <> 0 then
                       FValue := FValue div FStack[FStackPtr + 1].FValue
                     else
                       begin
                         ClearOperations;
                         FStrOK := False;
                         FChanged := True;
                         FEntryState := csError;
                         exit
                       end;
              kMod : if FStack[FStackPtr + 1].FValue <> 0 then
                       FValue := FValue mod FStack[FStackPtr + 1].FValue
                     else
                       begin
                         ClearOperations;
                         FStrOK := False;
                         FChanged := True;
                         FEntryState := csError;
                         exit
                       end;
              kAnd : FValue := FValue and FStack[FStackPtr + 1].FValue;
              kAdd : FValue := FValue + FStack[FStackPtr + 1].FValue;
              kSub : FValue := FValue - FStack[FStackPtr + 1].FValue;
              kOr  : FValue := FValue or FStack[FStackPtr + 1].FValue;
              kXor : FValue := FValue xor FStack[FStackPtr + 1].FValue;
              kEqv : FValue := not (FValue xor FStack[FStackPtr + 1].FValue);
            end;
            FValue := RoundVal(FValue, FSize, FSigned)
          end;
        FStack[FStackPtr + 1].FOpUsed := False
      end
  end;


begin { TCalculator.HandleKey }
  if FEntryState = csError then
    begin
      Result := False;
      exit
    end;

  FEntryState := csFirstKey;
  FStrOK := False;
  FChanged := True;

  Result := True;

  with FStack[FStackPtr] do
    FValue := RoundVal(FValue, FSize, FSigned);

  if Key in [kNeg, kNot] then
    begin
      with FStack[FStackPtr] do
        case Key of
          kNeg : FValue := -FValue;
          kNot : FValue := not FValue
        end
    end
  else
    begin
      PerformPrevOps;
      if FEntryState = csError then
        begin
          Result := False;
          exit
        end;

      if Key <> kEquals then
        begin
          FStackPtr := FStackPtr + 1;
          with FStack[FStackPtr] do
            begin
              FOpUsed := True;
              FOp := Key;
              FValue := FStack[FStackPtr - 1].FValue
            end
        end
    end;

  with FStack[FStackPtr] do
    FValue := RoundVal(FValue, FSize, FSigned);
  { FString will be updated in CurrentString }
end;

end.