dbgbreakpoints.pas

一个不出名的GBA模拟器

//////////////////////////////////////////////////////////////////////
//                                                                  //
// dbgBreakpoints.pas: Breakpoint management                        //
//   Contains the TBreakpoint class and breakpoint 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:                                                           //
//   None at present.                                               //
//                                                                  //
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
unit dbgBreakpoints; /////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

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

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

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

var
  breakpoints: TObjectList;

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

type
  TBreakpoint = class
  private
    FValid: boolean;
    FEnabled: boolean;
    FPassCount: integer;
    FPassesLeft: integer;
    FMessage: string;
    FAddress: uint32;

    procedure SetEnabled(value: boolean);
    procedure SetPassCount(value: integer);
    procedure SetAddress(value: uint32);
    procedure MakeValid;
  public
    filename: string;
    line: integer;
    condition: TExpression;
    breakExecution: boolean;

    constructor Create;
    destructor Destroy; override;
    function SaveToString: string;
    procedure LoadFromString(st: string);
    function TriggerBP: boolean;
    property enabled: boolean read FEnabled write SetEnabled;
    property passCount: integer read FPassCount write SetPassCount;
    property logMessage: string read FMessage write FMessage;
    property address: uint32 read FAddress write SetAddress;
  end;

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

procedure SetTempBreakpoint(address: uint32);
procedure ClearTempBreakpoint;
function IsTempBreakpoint: boolean;

procedure ClearBreakpoints;
procedure ReassertBreakpoints;

procedure AddBreakpoint(bp: TBreakpoint);
procedure RemoveBreakpoint(bp: TBreakpoint);
function FindBreakpoint(address: uint32): TBreakpoint;

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

var
  tempAddress: uint32;
  tempBP: boolean;

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

procedure AddBreakpoint(bp: TBreakpoint);
begin
  breakpoints.add(bp);
end;

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

procedure RemoveBreakpoint(bp: TBreakpoint);
begin
  breakpoints.remove(bp);
end;

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

function FindBreakpoint(address: uint32): TBreakpoint;
var
  i: integer;
begin
  Result := nil;
  for i := 0 to breakpoints.Count - 1 do
    if TBreakpoint(breakpoints.Items[i]).address = address then begin
      Result := TBreakpoint(breakpoints.Items[i]);
      Exit;
    end;
end;

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

procedure SetTempBreakpoint(address: uint32);
begin
  ClearTempBreakpoint;
  tempAddress := address;
  tempBP := not (bpmHard in vmIsBreakpoint(tempAddress));
  if tempBP then vmAddBreakpoint(tempAddress, false);
end;

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

procedure ClearTempBreakpoint;
begin
  if tempBP then vmRemoveBreakpoint(tempAddress, [bpmHard]);
  tempBP := false;
end;

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

function IsTempBreakpoint: boolean;
begin
  Result := vmCurrentPC = tempAddress;
  ClearTempBreakpoint;
end;

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

procedure ClearBreakpoints;
begin
  if Assigned(breakpoints) then breakpoints.Free;
  tempBP := false;
  breakpoints := TObjectList.Create;
  ClearTempBreakpoint;
end;

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

procedure ReassertBreakpoints;
var
  i: integer;
begin
  for i := 0 to breakpoints.Count - 1 do
    TBreakpoint(breakpoints.Items[i]).MakeValid;
end;

//////////////////////////////////////////////////////////////////////
// TBreakpoint ///////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

constructor TBreakpoint.Create;
begin
  FValid := false;
  FEnabled := false;

  filename := '';
  line := 1;
  condition := '';
  breakExecution := true;

  FPassCount := 0;
  FPassesLeft := 0;
  FMessage := '';
end;

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

destructor TBreakpoint.Destroy;
begin
  if FValid and coreLoaded then vmRemoveBreakpoint(address, [bpmHard]);
  inherited;
end;

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

procedure TBreakpoint.LoadFromString(st: string);
begin
  FEnabled := StringToBoolean(CutAnyLeft(st, #255));
  FPassCount := StrToIntDef(CutAnyLeft(st, #255), 0);
  FPassesLeft := StrToIntDef(CutAnyLeft(st, #255), 0);
  FMessage := CutAnyLeft(st, #255);
  FAddress := StrToIntDef('$' + CutAnyLeft(st, #255), 0);
  filename := CutAnyLeft(st, #255);
  line := StrToIntDef(CutAnyLeft(st, #255), 0);
  condition := CutAnyLeft(st, #255);
  breakExecution := StringToBoolean(CutAnyLeft(st, #255));

  MakeValid;
end;

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

function TBreakpoint.TriggerBP: boolean;
begin
  Result := false;
  if FPassCount > 0 then Dec(FPassesLeft);
  if (EvaluateExpression(condition) <> 0) and (FPassesLeft = 0) then begin
    Result := breakExecution;
    if FMessage <> '' then logWriteLn(FMessage);
    FPassesLeft := FPassCount;
  end;
end;

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

function TBreakpoint.SaveToString: string;
begin
  Result := BooleanToString(FEnabled) + #255 +
            IntToStr(FPassCount) + #255 +
            IntToStr(FPassesLeft) + #255 +
            FMessage + #255 +
            IntToHex(FAddress, 8) + #255 +
            filename + #255 +
            IntToStr(line) + #255 +
            condition + #255 +
            BooleanToString(breakExecution);
end;

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

procedure TBreakpoint.SetEnabled(value: boolean);
begin
  FEnabled := value;
  if FValid and not FEnabled then begin
    vmRemoveBreakpoint(address, [bpmHard]);
    FValid := false;
  end else if FEnabled and not FValid then begin
    vmAddBreakpoint(address, false);
    FValid := true;
  end;
end;

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

procedure TBreakpoint.SetPassCount(value: integer);
begin
  if value < 0 then value := 0;
  FPassCount := value;
  FPassesLeft := value;
end;

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

procedure TBreakpoint.SetAddress(value: uint32);
var
  wasEnabled: boolean;
begin
  if value <> FAddress then begin
    wasEnabled := FEnabled;
    SetEnabled(false);
    FAddress := value;
    SetEnabled(wasEnabled);
  end;
end;

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

procedure TBreakpoint.MakeValid;
begin
  if FEnabled then begin
    vmAddBreakpoint(address, false);
    FValid := true;
  end;
end;

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

initialization
  tempBP := false;
  ClearBreakpoints;
finalization
  if Assigned(breakpoints) then breakpoints.Free;
end.

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