373 lines
12 KiB
ObjectPascal
373 lines
12 KiB
ObjectPascal
////////////////////////////////////////////////////////////////////////////
|
|
// PaxCompiler
|
|
// Site: http://www.paxcompiler.com
|
|
// Author: Alexander Baranovsky (paxscript@gmail.com)
|
|
// ========================================================================
|
|
// Copyright (c) Alexander Baranovsky, 2006-2014. All rights reserved.
|
|
// Code Version: 4.2
|
|
// ========================================================================
|
|
// Unit: PaxCompilerDebugger.pas
|
|
// ========================================================================
|
|
////////////////////////////////////////////////////////////////////////////
|
|
|
|
{$I PaxCompiler.def}
|
|
unit PaxCompilerDebugger;
|
|
interface
|
|
uses {$I uses.def}
|
|
TypInfo,
|
|
SysUtils,
|
|
Classes,
|
|
PAXCOMP_CONSTANTS,
|
|
PAXCOMP_SYS,
|
|
PAXCOMP_KERNEL,
|
|
PAXCOMP_MAP,
|
|
PAXCOMP_BASERUNNER,
|
|
PaxCompiler,
|
|
PaxRunner;
|
|
type
|
|
TPaxCompilerDebugger = class(TComponent)
|
|
private
|
|
compiler: TPaxCompiler;
|
|
prog: TPaxRunner;
|
|
|
|
function GetRunMode: Integer;
|
|
procedure SetRunMode(Value: Integer);
|
|
|
|
function GetValid: Boolean;
|
|
function GetCallStackCount: Integer;
|
|
function GetCallStackItem(I: Integer): Integer;
|
|
function GetCallStackLineNumber(I: Integer): Integer;
|
|
function GetCallStackModuleName(I: Integer): String;
|
|
function GetCallStackModuleIndex(I: Integer): Integer;
|
|
|
|
function GetSourceLineNumber: Integer;
|
|
function GetModuleName: String;
|
|
|
|
protected
|
|
public
|
|
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure RegisterCompiler(i_compiler: TPaxCompiler;
|
|
i_prog: TPaxRunner);
|
|
procedure Run;
|
|
function IsPaused: Boolean;
|
|
|
|
function GetAddress(StackFrameNumber, Id: Integer): Pointer; overload;
|
|
function GetAddress(Id: Integer): Pointer; overload;
|
|
|
|
function GetValueAsString(StackFrameNumber, Id: Integer): String; overload;
|
|
function GetValueAsString(Id: Integer): String; overload;
|
|
|
|
function GetValueAsBriefString(StackFrameNumber, Id: Integer): String; overload;
|
|
function GetValueAsBriefString(Id: Integer): String; overload;
|
|
|
|
function GetValue(StackFrameNumber, Id: Integer): Variant; overload;
|
|
function GetValue(Id: Integer): Variant; overload;
|
|
|
|
procedure PutValue(StackFrameNumber, Id: Integer; const Value: Variant); overload;
|
|
procedure PutValue(Id: Integer; const Value: Variant); overload;
|
|
|
|
function GetFieldValueAsString(StackFrameNumber: Integer;
|
|
Id, FieldNumber: Integer): String;
|
|
function GetFieldValueAsBriefString(StackFrameNumber: Integer;
|
|
Id, FieldNumber: Integer): String;
|
|
function GetPublishedPropValueAsString(StackFrameNumber: Integer;
|
|
Id, PropNumber: Integer): String;
|
|
|
|
function GetArrayItemValueAsString(StackFrameNumber: Integer;
|
|
Id, Index: Integer): String;
|
|
function GetDynArrayLength(StackFrameNumber, Id: Integer): Integer;
|
|
function GetDynArrayItemValueAsString(StackFrameNumber: Integer;
|
|
Id, Index: Integer): String;
|
|
function AddBreakpoint(const ModuleName: String;
|
|
SourceLine: Integer): Boolean;
|
|
function AddTempBreakpoint(const ModuleName: String;
|
|
SourceLine: Integer): Boolean;
|
|
function RemoveBreakpoint(const ModuleName: String;
|
|
SourceLine: Integer): Boolean;
|
|
procedure RemoveAllBreakpoints;
|
|
function HasBreakpoint(const ModuleName: String;
|
|
SourceLine: Integer): Boolean;
|
|
procedure Reset;
|
|
|
|
property CallStackCount: Integer read GetCallStackCount;
|
|
property CallStack[I: Integer]: Integer read GetCallStackItem;
|
|
property CallStackLineNumber[I: Integer]: Integer read
|
|
GetCallStackLineNumber;
|
|
property CallStackModuleName[I: Integer]: String read
|
|
GetCallStackModuleName;
|
|
property CallStackModuleIndex[I: Integer]: Integer read
|
|
GetCallStackModuleIndex;
|
|
property ModuleName: String read GetModuleName;
|
|
property RunMode: Integer read GetRunMode write SetRunMode;
|
|
property SourceLineNumber: Integer read GetSourceLineNumber;
|
|
property Valid: Boolean read GetValid;
|
|
end;
|
|
|
|
implementation
|
|
|
|
/////////////// TPaxCompilerDebugger ///////////////////////////////////////////
|
|
|
|
procedure RaiseError(const Message: string; params: array of Const);
|
|
begin
|
|
raise Exception.Create(Format(Message, params))
|
|
end;
|
|
|
|
constructor TPaxCompilerDebugger.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
compiler := nil;
|
|
prog := nil;
|
|
end;
|
|
|
|
destructor TPaxCompilerDebugger.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TPaxCompilerDebugger.RegisterCompiler(i_compiler: TPaxCompiler;
|
|
i_prog: TPaxRunner);
|
|
begin
|
|
// if not i_compiler.DebugMode then
|
|
// RaiseError(errDebugModeIsRequred, []);
|
|
|
|
compiler := i_compiler;
|
|
prog := i_prog;
|
|
end;
|
|
|
|
procedure TPaxCompilerDebugger.Run;
|
|
begin
|
|
prog.Run;
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.IsPaused: Boolean;
|
|
begin
|
|
result := prog.GetProgPtr.IsPaused;
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetAddress(StackFrameNumber, Id: Integer): Pointer;
|
|
begin
|
|
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetFinalAddress(
|
|
prog.GetProgPtr, StackFrameNumber, Id);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetAddress(Id: Integer): Pointer;
|
|
begin
|
|
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetFinalAddress(
|
|
prog.GetProgPtr, 0, Id);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetValue(StackFrameNumber, Id: Integer): Variant;
|
|
begin
|
|
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetValue(
|
|
prog.GetProgPtr, StackFrameNumber, Id);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetValue(Id: Integer): Variant;
|
|
begin
|
|
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetValue(
|
|
prog.GetProgPtr, 0, Id);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetValueAsString(StackFrameNumber, Id: Integer): String;
|
|
var
|
|
TypeMapRec: TTypeMapRec;
|
|
begin
|
|
TypeMapRec := TKernel(compiler.GetKernelPtr).GetTypeMapRec(Id);
|
|
|
|
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetValueAsString(
|
|
prog.GetProgPtr, StackFrameNumber, Id, TypeMapRec);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetValueAsString(Id: Integer): String;
|
|
var
|
|
TypeMapRec: TTypeMapRec;
|
|
begin
|
|
TypeMapRec := TKernel(compiler.GetKernelPtr).GetTypeMapRec(Id);
|
|
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetValueAsString(
|
|
prog.GetProgPtr, 0, Id, TypeMapRec);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetValueAsBriefString(StackFrameNumber, Id: Integer): String;
|
|
var
|
|
TypeMapRec: TTypeMapRec;
|
|
begin
|
|
TypeMapRec := TKernel(compiler.GetKernelPtr).GetTypeMapRec(Id);
|
|
|
|
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetValueAsString(
|
|
prog.GetProgPtr, StackFrameNumber, Id, TypeMapRec, true);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetValueAsBriefString(Id: Integer): String;
|
|
var
|
|
TypeMapRec: TTypeMapRec;
|
|
begin
|
|
TypeMapRec := TKernel(compiler.GetKernelPtr).GetTypeMapRec(Id);
|
|
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetValueAsString(
|
|
prog.GetProgPtr, 0, Id, TypeMapRec, true);
|
|
end;
|
|
|
|
procedure TPaxCompilerDebugger.PutValue(StackFrameNumber, Id: Integer; const Value: Variant);
|
|
begin
|
|
TKernel(compiler.GetKernelPtr).SymbolTable.PutValue(
|
|
prog.GetProgPtr, StackFrameNumber, Id, Value);
|
|
end;
|
|
|
|
procedure TPaxCompilerDebugger.PutValue(Id: Integer; const Value: Variant);
|
|
begin
|
|
TKernel(compiler.GetKernelPtr).SymbolTable.PutValue(
|
|
prog.GetProgPtr, 0, Id, Value);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetFieldValueAsString(StackFrameNumber: Integer;
|
|
Id, FieldNumber: Integer): String;
|
|
var
|
|
TypeMapRec: TTypeMapRec;
|
|
begin
|
|
TypeMapRec := TKernel(compiler.GetKernelPtr).GetTypeMapRec(Id);
|
|
|
|
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetFieldValueAsString(
|
|
prog.GetProgPtr, StackFrameNumber, Id, FieldNumber, TypeMapRec);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetFieldValueAsBriefString(StackFrameNumber: Integer;
|
|
Id, FieldNumber: Integer): String;
|
|
var
|
|
TypeMapRec: TTypeMapRec;
|
|
begin
|
|
TypeMapRec := TKernel(compiler.GetKernelPtr).GetTypeMapRec(Id);
|
|
|
|
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetFieldValueAsString(
|
|
prog.GetProgPtr, StackFrameNumber, Id, FieldNumber, TypeMapRec, true);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetPublishedPropValueAsString(StackFrameNumber: Integer;
|
|
Id, PropNumber: Integer): String;
|
|
begin
|
|
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetPublishedPropValueAsString(
|
|
prog.GetProgPtr, StackFrameNumber, Id, PropNumber);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetDynArrayLength(StackFrameNumber,
|
|
Id: Integer): Integer;
|
|
var
|
|
Address, P: Pointer;
|
|
begin
|
|
Address := TKernel(compiler.GetKernelPtr).SymbolTable.GetFinalAddress(
|
|
prog.GetProgPtr, StackFrameNumber, Id);
|
|
Address := Pointer(Address^);
|
|
|
|
if Address = nil then
|
|
begin
|
|
result := -1;
|
|
Exit;
|
|
end;
|
|
|
|
P := ShiftPointer(Address, - SizeOf(Integer));
|
|
result := Integer(P^);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetArrayItemValueAsString(StackFrameNumber: Integer;
|
|
Id, Index: Integer): String;
|
|
begin
|
|
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetArrayItemValueAsString(
|
|
prog.GetProgPtr, StackFrameNumber, Id, Index);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetDynArrayItemValueAsString(StackFrameNumber: Integer;
|
|
Id, Index: Integer): String;
|
|
begin
|
|
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetDynArrayItemValueAsString(
|
|
prog.GetProgPtr, StackFrameNumber, Id, Index);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.AddBreakpoint(const ModuleName: String;
|
|
SourceLine: Integer): Boolean;
|
|
begin
|
|
result := prog.GetProgPtr.AddBreakpoint(ModuleName, SourceLine) <> nil;
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.AddTempBreakpoint(const ModuleName: String;
|
|
SourceLine: Integer): Boolean;
|
|
begin
|
|
result := prog.GetProgPtr.AddTempBreakpoint(ModuleName, SourceLine) <> nil;
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.RemoveBreakpoint(const ModuleName: String;
|
|
SourceLine: Integer): Boolean;
|
|
begin
|
|
result := prog.GetProgPtr.RemoveBreakpoint(ModuleName, SourceLine);
|
|
end;
|
|
|
|
procedure TPaxCompilerDebugger.RemoveAllBreakpoints;
|
|
begin
|
|
prog.GetProgPtr.RemoveAllBreakpoints;
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.HasBreakpoint(const ModuleName: String;
|
|
SourceLine: Integer): Boolean;
|
|
begin
|
|
result := prog.GetProgPtr.HasBreakpoint(ModuleName, SourceLine);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetSourceLineNumber: Integer;
|
|
begin
|
|
result := prog.GetProgPtr.GetSourceLine;
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetModuleName: String;
|
|
begin
|
|
result := prog.GetProgPtr.GetModuleName;
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetRunMode: Integer;
|
|
begin
|
|
result := prog.GetProgPtr.RunMode;
|
|
end;
|
|
|
|
procedure TPaxCompilerDebugger.SetRunMode(Value: Integer);
|
|
begin
|
|
prog.GetProgPtr.RunMode := Value;
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetValid: Boolean;
|
|
begin
|
|
if prog = nil then
|
|
result := false
|
|
else
|
|
result := prog.GetProgPtr.Valid;
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetCallStackCount: Integer;
|
|
begin
|
|
result := prog.GetProgPtr.GetCallStackCount;
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetCallStackItem(I: Integer): Integer;
|
|
begin
|
|
result := prog.GetProgPtr.GetCallStackItem(I);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetCallStackLineNumber(I: Integer): Integer;
|
|
begin
|
|
result := prog.GetProgPtr.GetCallStackLineNumber(I);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetCallStackModuleName(I: Integer): String;
|
|
begin
|
|
result := prog.GetProgPtr.GetCallStackModuleName(I);
|
|
end;
|
|
|
|
function TPaxCompilerDebugger.GetCallStackModuleIndex(I: Integer): Integer;
|
|
begin
|
|
result := prog.GetProgPtr.GetCallStackModuleIndex(I);
|
|
end;
|
|
|
|
procedure TPaxCompilerDebugger.Reset;
|
|
begin
|
|
prog.GetProgPtr.ResetRun;
|
|
end;
|
|
|
|
end.
|