dbgwatches.pas

一个不出名的GBA模拟器

//////////////////////////////////////////////////////////////////////
//                                                                  //
// dbgWatches.pas: Watch management                                 //
//   Contains the TWatch class and watch list management.           //
//                                                                  //
// The contents of this file are subject to the Bottled Light       //
// Public License Version 1.0 (the "License"); you may not use this //
// file except in compliance with the License. You may obtain a     //
// copy of the License at http://www.bottledlight.com/BLPL/         //
//                                                                  //
// Software distributed under the License is distributed on an      //
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or   //
// implied. See the License for the specific language governing     //
// rights and limitations under the License.                        //
//                                                                  //
// The Original Code is the Mappy VM User Interface, released       //
// April 1st, 2003. The Initial Developer of the Original Code is   //
// Bottled Light, Inc. Portions created by Bottled Light, Inc. are  //
// Copyright (C) 2001-2003 Bottled Light, Inc. All Rights Reserved. //
//                                                                  //
// Author(s):                                                       //
//   Michael Noland (joat), [e-mail]                //
//                                                                  //
// Changelog:                                                       //
//   1.0: First public release (April 1st, 2003)                    //
//                                                                  //
// Notes:                                                           //
//   A watch is only evaluated at observer update rates, NOT        //
//   after every atomic operation.                                  //
//                                                                  //
//   In addition, most of this code will probably be made obsolete  //
//   by the changes to the DWARF debugger.  It could still serve    //
//   a purpose in tracing the BIOS, unattributed assembly code, or  //
//   *shudder* REing however.                                       //
//                                                                  //
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
unit dbgWatches; /////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
interface ////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

uses
  SysUtils, Classes, Contnrs, nexus, console, dbgExpressions,
  AddressSpace;

//////////////////////////////////////////////////////////////////////

var
  watches: TObjectList;

//////////////////////////////////////////////////////////////////////

type
  TWatchDisplayMode = (wdmHexadecimal, wdmInteger, wdmUnsigned, wdmBinary, wdmFixed, wdmFloating);
  TWatchType = (wtByte, wtHalfword, wtWord, wtCharacter, wtString, wtPointer);

  TWatch = class
  private
    function EvaluateOnce(address: uint32): string;
  public
    expression: TExpression;
    watchType: TWatchType;
    watchMode: TWatchDisplayMode;
    arraySize: integer;
    enabled: boolean;

    constructor Create;
    destructor Destroy; override;

    function SaveToString: string;
    procedure LoadFromString(st: string);

    function Evaluate: string;
  end;

//////////////////////////////////////////////////////////////////////

procedure ClearWatches;

procedure AddWatch(watch: TWatch);
procedure RemoveWatch(watch: TWatch);

//////////////////////////////////////////////////////////////////////
implementation ///////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

procedure AddWatch(watch: TWatch);
begin
  watches.add(watch);
end;

//////////////////////////////////////////////////////////////////////

procedure RemoveWatch(watch: TWatch);
begin
  watches.remove(watch);
end;

//////////////////////////////////////////////////////////////////////

procedure ClearWatches;
begin
  if Assigned(watches) then watches.Free;
  watches := TObjectList.Create;
end;

//////////////////////////////////////////////////////////////////////
// TWatch ////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

constructor TWatch.Create;
begin
  expression := '$03000000';
  watchType := wtPointer;
  watchMode := wdmHexadecimal;
  arraySize := 0;
  enabled := true;
end;

//////////////////////////////////////////////////////////////////////

destructor TWatch.Destroy;
begin
  inherited;
end;
//////////////////////////////////////////////////////////////////////

function TWatch.EvaluateOnce(address: uint32): string;
var
  number: uint32;
  j: integer;
begin
  Result := '';
  case watchType of
    wtByte: begin
      number := vmReadByte(address);
      case watchMode of
        wdmHexadecimal: Result := '$' + IntToHex(number, 2);
        wdmInteger: Result := IntToStr(int8(number));
        wdmUnsigned: Result := IntToStr(number);
        wdmBinary: begin
          Result := '%';
          for j := 7 downto 0 do
            if number and (1 shl j) <> 0 then
              Result := Result + '1'
            else
              Result := Result + '0';
         end;
         wdmFixed: Result := FloatToStrF(int8(number) / 256.0, ffFixed, 7, 2);
         wdmFloating: Result := FloatToStr(Pfloat32(@(number))^);
      end;
    end;

    wtHalfword: begin
      number := vmReadHalfword(address);
      case watchMode of
        wdmHexadecimal: Result := '$' + IntToHex(number, 4);
        wdmInteger: Result := IntToStr(int16(number));
        wdmUnsigned: Result := IntToStr(number);
        wdmBinary: begin
          Result := '%';
          for j := 15 downto 0 do
            if number and (1 shl j) <> 0 then
              Result := Result + '1'
            else
              Result := Result + '0';
         end;
         wdmFixed: Result := FloatToStrF(int16(number) / 256.0, ffFixed, 7, 2);
         wdmFloating: Result := FloatToStr(Pfloat32(@(number))^);
      end;
    end;

    wtWord: begin
      number := vmReadWord(address);

      case watchMode of
        wdmHexadecimal: Result := IntToHex(number, 8);
        wdmInteger: Result := IntToStr(int32(number));
        wdmUnsigned: Result := IntToStr(int64(number));
        wdmBinary: begin
          Result := '%';
          for j := 31 downto 0 do
            if number and (1 shl j) <> 0 then
              Result := Result + '1'
            else
              Result := Result + '0';
         end;
         wdmFixed: Result := FloatToStrF(int32(number) / 256.0, ffFixed, 7, 2);
         wdmFloating: Result := FloatToStr(Pfloat32(@(number))^);
      end;
    end;

    wtCharacter: begin
      number := vmReadByte(address);
      case number of
        32: Result := '" "';
        0..31, 127..255: Result := '\0x' + IntToHex(number, 2);
      else
        Result := Chr(number);
      end;
    end;

    wtString: begin
      j := 0;
      address := vmReadWord(address);
      repeat
        number := vmReadByte(address + number);
        Inc(j);
        if number <> 0 then Result := Result + Chr(number);
      until (j > 255) or (number = 0);
    end;

    wtPointer: Result := '$' + IntToHex(vmReadWord(address), 8);
  end;
end;

//////////////////////////////////////////////////////////////////////

function TWatch.Evaluate: string;
var
  address: uint32;
  delta, i: integer;
begin
  if enabled then begin
    address := EvaluateExpression(expression);
    if arraySize > 0 then begin
      // Figure out the delta per array item
      case watchType of
        wtByte, wtCharacter: delta := 1;
        wtHalfword: delta := 2;
      else
        delta := 4;
      end;

      // Build the array string
      Result := '[';
      for i := 0 to arraySize - 1 do begin
        Result := Result + EvaluateOnce(address) + ', ';
        Inc(address, delta);
      end;
      Delete(Result, Length(Result), 1);
      Result[Length(Result)] := ']';
    end else begin
      Result := EvaluateOnce(address);
    end;
  end else
    Result := '<disabled>';
end;

//////////////////////////////////////////////////////////////////////

procedure TWatch.LoadFromString(st: string);
begin
  enabled := StringToBoolean(CutAnyLeft(st, #255));
  watchType := TWatchType(StrToIntDef(CutAnyLeft(st, #255), 0));
  watchMode := TWatchDisplayMode(StrToIntDef(CutAnyLeft(st, #255), 0));
  arraySize := StrToIntDef(CutAnyLeft(st, #255), 0);
  expression := st;
end;

//////////////////////////////////////////////////////////////////////

function TWatch.SaveToString: string;
begin
  Result := BooleanToString(enabled) + #255 +
            IntToStr(Ord(watchType)) + #255 +
            IntToStr(Ord(watchMode)) + #255 +
            IntToStr(arraySize) + #255 +
            expression;
end;

//////////////////////////////////////////////////////////////////////

initialization
  ClearWatches;
finalization
  if Assigned(watches) then watches.Free;
end.

//////////////////////////////////////////////////////////////////////