983 lines
32 KiB
ObjectPascal
983 lines
32 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (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.mozilla.org/MPL/ }
|
|
{ }
|
|
{ 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: JvSIMDViewForm.pas, released on 2004-10-11. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Florent Ouchet }
|
|
{ [ouchet dott florent att laposte dott net] }
|
|
{ Portions created by Florent Ouchet are Copyright (C) 2004 Florent Ouchet. }
|
|
{ All Rights Reserved. }
|
|
{ }
|
|
{ You may retrieve the latest version of this file at the Project JEDI's JCL home page, }
|
|
{ located at http://jcl.sourceforge.net }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
// $Id: JclSIMDViewForm.pas,v 1.9 2006/01/08 17:16:56 outchy Exp $
|
|
|
|
unit JclSIMDViewForm;
|
|
|
|
{$I jcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
|
Dialogs, StdCtrls, ToolsApi, Grids, ExtCtrls, Menus, ActnList,
|
|
JclOtaUtils, JclSysInfo, JclSIMDUtils, JclSIMDModifyForm;
|
|
|
|
type
|
|
TJclSIMDViewFrm = class(TForm)
|
|
Splitter: TSplitter;
|
|
ListBoxRegs: TListBox;
|
|
ListBoxMXCSR: TListBox;
|
|
PopupMenuRegs: TPopupMenu;
|
|
PopupMenuMXCSR: TPopupMenu;
|
|
MenuItemComplement: TMenuItem;
|
|
MenuItemBinary: TMenuItem;
|
|
MenuItemSigned: TMenuItem;
|
|
MenuItemUnsigned: TMenuItem;
|
|
MenuItemHexa: TMenuItem;
|
|
MenuItemDisplay: TMenuItem;
|
|
MenuItemFormat: TMenuItem;
|
|
MenuItemBytes: TMenuItem;
|
|
MenuItemWords: TMenuItem;
|
|
MenuItemDWords: TMenuItem;
|
|
MenuItemQWords: TMenuItem;
|
|
MenuItemSeparator1: TMenuItem;
|
|
MenuItemSingles: TMenuItem;
|
|
MenuItemDoubles: TMenuItem;
|
|
MenuItemSeparator2: TMenuItem;
|
|
MenuItemStayOnTop: TMenuItem;
|
|
MenuItemModify: TMenuItem;
|
|
MenuItemCpuInfo: TMenuItem;
|
|
ActionListOptions: TActionList;
|
|
ActionStayOnTop: TAction;
|
|
ActionModify: TAction;
|
|
ActionComplement: TAction;
|
|
ActionEmpty: TAction;
|
|
ActionEmptyAll: TAction;
|
|
MenuItemEmptyMM: TMenuItem;
|
|
MenuItemEmptyAll: TMenuItem;
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure ListBoxMXCSRDrawItem(Control: TWinControl; Index: Integer;
|
|
Rect: TRect; State: TOwnerDrawState);
|
|
procedure ListBoxMXCSRMouseMove(Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
procedure ListBoxRegsDrawItem(Control: TWinControl; Index: Integer;
|
|
Rect: TRect; State: TOwnerDrawState);
|
|
procedure MenuItemFormatClick(Sender: TObject);
|
|
procedure MenuItemDisplayClick(Sender: TObject);
|
|
procedure MenuItemCpuInfoClick(Sender: TObject);
|
|
procedure ActionStayOnTopUpdate(Sender: TObject);
|
|
procedure ActionStayOnTopExecute(Sender: TObject);
|
|
procedure ActionModifyUpdate(Sender: TObject);
|
|
procedure ActionModifyExecute(Sender: TObject);
|
|
procedure ActionComplementExecute(Sender: TObject);
|
|
procedure ActionComplementUpdate(Sender: TObject);
|
|
procedure ActionEmptyUpdate(Sender: TObject);
|
|
procedure ActionEmptyAllUpdate(Sender: TObject);
|
|
procedure ActionEmptyExecute(Sender: TObject);
|
|
procedure ActionEmptyAllExecute(Sender: TObject);
|
|
procedure ListBoxesMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
private
|
|
FDebuggerServices: IOTADebuggerServices;
|
|
FVectorFrame: TJclVectorFrame;
|
|
FDisplay: TJclXMMContentType;
|
|
FFormat: TJclSIMDFormat;
|
|
FCpuInfo: TCpuInfo;
|
|
FSIMDCaption: string;
|
|
FNbMMRegister: Integer;
|
|
FNbXMMRegister: Integer;
|
|
FOldThreadID: LongWord;
|
|
FOldThreadState: TOTAThreadState;
|
|
FModifyForm: TJclSIMDModifyFrm;
|
|
FMXCSRChanged: array [TMXCSRRange] of Boolean;
|
|
FRegisterChanged: array of Boolean;
|
|
FSettings: TJclOtaSettings;
|
|
procedure SetDisplay(const Value: TJclXMMContentType);
|
|
procedure SetFormat(const Value: TJclSIMDFormat);
|
|
protected
|
|
procedure DoClose(var Action: TCloseAction); override;
|
|
procedure UpdateActions; override;
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
public
|
|
constructor Create(AOwner: TComponent; ADebuggerServices: IOTADebuggerServices;
|
|
ASettings: TJclOtaSettings); reintroduce;
|
|
destructor Destroy; override;
|
|
procedure ThreadEvaluate(const ExprStr, ResultStr: string; ReturnCode: Integer);
|
|
procedure SetThreadValues;
|
|
procedure GetThreadValues;
|
|
property CpuInfo: TCpuInfo read FCpuInfo;
|
|
property Format: TJclSIMDFormat read FFormat write SetFormat;
|
|
property Display: TJclXMMContentType read FDisplay write SetDisplay;
|
|
property SIMDCaption: string read FSIMDCaption write FSIMDCaption;
|
|
property DebuggerServices: IOTADebuggerServices read FDebuggerServices;
|
|
property NbMMRegister: Integer read FNbMMRegister;
|
|
property NbXMMRegister: Integer read FNbXMMRegister;
|
|
property Settings: TJclOtaSettings read FSettings;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
TypInfo,
|
|
JclOtaResources, JclOtaConsts,
|
|
JclSIMDCpuInfo;
|
|
|
|
{$R *.dfm}
|
|
|
|
constructor TJclSIMDViewFrm.Create(AOwner: TComponent;
|
|
ADebuggerServices: IOTADebuggerServices; ASettings: TJclOTASettings);
|
|
var
|
|
I: TMXCSRRange;
|
|
J: Integer;
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
FDebuggerServices := ADebuggerServices;
|
|
FOldThreadID := 0;
|
|
FOldThreadState := tsNone;
|
|
FSettings := ASettings;
|
|
|
|
JclSysInfo.GetCpuInfo(FCpuInfo);
|
|
|
|
// the behaviour of Delphi and C++Builder overrides all changes made on
|
|
// the floating point context of the debugged thread when it is run
|
|
// (even using step into and step over).
|
|
// to be uncommented as soon as Borland changes this behaviour
|
|
{if CpuInfo.MMX or CPUInfo._3DNow then
|
|
FNbMMRegister := 8
|
|
else
|
|
FNbMMRegister := 0;}
|
|
|
|
FNbMMRegister := 0;
|
|
|
|
if CpuInfo.SSE = 0 then
|
|
FNbXMMRegister := 0
|
|
else
|
|
if CpuInfo.Is64Bits then
|
|
FNbXMMRegister := 17
|
|
else
|
|
FNbXMMRegister := 9;
|
|
|
|
ListBoxMXCSR.Items.Clear;
|
|
with CpuInfo do
|
|
for I := Low(TMXCSRRange) to High(TMXCSRRange) do
|
|
ListBoxMXCSR.Items.Add('0');
|
|
ListBoxRegs.Items.Clear;
|
|
|
|
SetLength(FRegisterChanged,NbMMRegister + NbXMMRegister);
|
|
for J := 0 to NbMMRegister + NbXMMRegister - 1 do
|
|
// MM registers (MMX) + XMM registers (SSE) + 1 cardinal (MXCSR)
|
|
ListBoxRegs.Items.Add('');
|
|
|
|
MenuItemBinary.Tag := Integer(sfBinary);
|
|
MenuItemSigned.Tag := Integer(sfSigned);
|
|
MenuItemUnsigned.Tag := Integer(sfUnsigned);
|
|
MenuItemHexa.Tag := Integer(sfHexa);
|
|
MenuItemBytes.Tag := Integer(xt16Bytes);
|
|
MenuItemWords.Tag := Integer(xt8Words);
|
|
MenuItemDWords.Tag := Integer(xt4DWords);
|
|
MenuItemQWords.Tag := Integer(xt2QWords);
|
|
MenuItemSingles.Tag := Integer(xt4Singles);
|
|
MenuItemDoubles.Tag := Integer(xt2Doubles);
|
|
|
|
Format := sfHexa;
|
|
Display := xt8Words;
|
|
|
|
GetThreadValues;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
|
|
// Fixing the Window Ghosting "bug"
|
|
Params.Style := params.Style or WS_POPUP;
|
|
if Assigned(Screen.ActiveForm) then
|
|
Params.WndParent := Screen.ActiveForm.Handle
|
|
else if Assigned (Application.MainForm) then
|
|
Params.WndParent := Application.MainForm.Handle
|
|
else
|
|
Params.WndParent := Application.Handle;
|
|
end;
|
|
|
|
destructor TJclSIMDViewFrm.Destroy;
|
|
begin
|
|
SetLength(FRegisterChanged,0);
|
|
FDebuggerServices := nil;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ListBoxMXCSRDrawItem(Control: TWinControl;
|
|
Index: Integer; Rect: TRect; State: TOwnerDrawState);
|
|
begin
|
|
try
|
|
with (Control as TListBox), Canvas do
|
|
begin
|
|
if not (odFocused in State) then
|
|
begin
|
|
Pen.Color := Brush.Color;
|
|
if odSelected in State then
|
|
Font.Color := clWindow;
|
|
end;
|
|
Rectangle(Rect);
|
|
TextOut(Rect.Left + 2, Rect.Top, MXCSRBitsDescriptions[Index].ShortName);
|
|
if FMXCSRChanged[Index] then
|
|
Font.Color := clRed;
|
|
TextOut(Rect.Left + 2 + TextExtent(MXCSRBitsDescriptions[Index].ShortName).cx, Rect.Top, Items[Index]);
|
|
end;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ListBoxMXCSRMouseMove(Sender: TObject;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
AIndex: Integer;
|
|
AText: string;
|
|
begin
|
|
try
|
|
if Shift <> [] then
|
|
Application.HideHint
|
|
else
|
|
with Sender as TListBox do
|
|
begin
|
|
AIndex := ItemAtPos(Point(X,Y),True);
|
|
if (AIndex >= 0) and (AIndex < Items.Count) then
|
|
begin
|
|
with MXCSRBitsDescriptions[AIndex] do
|
|
begin
|
|
AText := LongName;
|
|
if AndMask = MXCSR_RC then
|
|
case (FVectorFrame.MXCSR and AndMask) shr Shifting of
|
|
0:
|
|
AText := SysUtils.Format('%s (%s)', [AText, RsRoundToNearest]);
|
|
1:
|
|
AText := SysUtils.Format('%s (%s)', [AText, RsRoundDown]);
|
|
2:
|
|
AText := SysUtils.Format('%s (%s)', [AText, RsRoundUp]);
|
|
3:
|
|
AText := SysUtils.Format('%s (%s)', [AText, RsRoundTowardZero]);
|
|
end;
|
|
if AText <> Hint then
|
|
begin
|
|
Hint := AText;
|
|
Application.HideHint;
|
|
Application.ActivateHint(Point(X, Y));
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Hint := '';
|
|
Application.HideHint;
|
|
end;
|
|
end;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ListBoxRegsDrawItem(Control: TWinControl; Index: Integer;
|
|
Rect: TRect; State: TOwnerDrawState);
|
|
var
|
|
AText: string;
|
|
begin
|
|
try
|
|
with (Control as TListBox), Canvas do
|
|
begin
|
|
if not (odFocused in State) then
|
|
begin
|
|
Pen.Color := Brush.Color;
|
|
if odSelected in State then
|
|
Font.Color := clWindow;
|
|
end;
|
|
Rectangle(Rect);
|
|
if Index < NbMMRegister then
|
|
AText := SysUtils.Format('MM%d ', [Index])
|
|
else
|
|
if Index < NbMMRegister + NbXMMRegister - 1 then
|
|
begin
|
|
if CpuInfo.Is64Bits then
|
|
AText := SysUtils.Format('XMM%.2d ', [Index - NbMMRegister])
|
|
else
|
|
AText := SysUtils.Format('XMM%d ', [Index - NbMMRegister]);
|
|
end
|
|
else
|
|
AText := 'MXCSR ';
|
|
TextOut(Rect.Left + 2, Rect.Top, AText);
|
|
if FRegisterChanged[Index] then
|
|
Font.Color := clRed;
|
|
TextOut(Rect.Left + 2 + TextExtent(AText).cx, Rect.Top, Items[Index]);
|
|
end;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.GetThreadValues;
|
|
var
|
|
NewVectorFrame: TJclVectorFrame;
|
|
NewBitValue, OldBitValue: Cardinal;
|
|
Index: Integer;
|
|
AProcess: IOTAProcess;
|
|
AThread: IOTAThread;
|
|
|
|
function ChangedFlag(const Value1, Value2: TJclXMMRegister): Boolean; overload;
|
|
begin
|
|
Result := (Value1.QWords[0] <> Value2.QWords[0]) or (Value1.QWords[1] <> Value2.QWords[1]);
|
|
end;
|
|
|
|
function ChangedFlag(const Value1, Value2: TJclMMRegister): Boolean; overload;
|
|
begin
|
|
Result := Value1.QWords <> Value2.QWords;
|
|
end;
|
|
|
|
function FormatReg(const AReg: TJclXMMRegister): string; overload;
|
|
var
|
|
I: Integer;
|
|
Value: TJclSIMDValue;
|
|
begin
|
|
Result := '';
|
|
Value.Display := Display;
|
|
case Display of
|
|
xt16Bytes:
|
|
for I := High(AReg.Bytes) downto Low(AReg.Bytes) do
|
|
begin
|
|
Value.ValueByte := AReg.Bytes[I];
|
|
Result := Result + ' ' + FormatValue(Value, Format);
|
|
end;
|
|
xt8Words:
|
|
for I := High(AReg.Words) downto Low(AReg.Words) do
|
|
begin
|
|
Value.ValueWord := AReg.Words[I];
|
|
Result := Result + ' ' + FormatValue(Value, Format);
|
|
end;
|
|
xt4DWords:
|
|
for I := High(AReg.DWords) downto Low(AReg.DWords) do
|
|
begin
|
|
Value.ValueDWord := AReg.DWords[I];
|
|
Result := Result + ' ' + FormatValue(Value, Format);
|
|
end;
|
|
xt2QWords:
|
|
for I := High(AReg.QWords) downto Low(AReg.QWords) do
|
|
begin
|
|
Value.ValueQWord := AReg.QWords[I];
|
|
Result := Result + ' ' + FormatValue(Value, Format);
|
|
end;
|
|
xt4Singles:
|
|
for I := High(AReg.Singles) downto Low(AReg.Singles) do
|
|
begin
|
|
Value.ValueSingle := AReg.Singles[I];
|
|
Result := Result + ' ' + FormatValue(Value, sfBinary);
|
|
end;
|
|
xt2Doubles:
|
|
for I := High(AReg.Doubles) downto Low(AReg.Doubles) do
|
|
begin
|
|
Value.ValueDouble := AReg.Doubles[I];
|
|
Result := Result + ' ' + FormatValue(Value, sfBinary);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function FormatReg(const AReg: TJclFPUData; Index: Cardinal): string; overload;
|
|
var
|
|
I: Integer;
|
|
Value: TJclSIMDValue;
|
|
begin
|
|
Result := '';
|
|
Value.Display := Display;
|
|
|
|
if (AReg.Reserved = $FFFF) and ((NewVectorFrame.FTW and (1 shl Index)) <> 0) then
|
|
case Display of
|
|
xt16Bytes:
|
|
for I := High(AReg.MMRegister.Bytes) downto Low(AReg.MMRegister.Bytes) do
|
|
begin
|
|
Value.ValueByte := AReg.MMRegister.Bytes[I];
|
|
Result := Result + ' ' + FormatValue(Value, Format);
|
|
end;
|
|
xt8Words:
|
|
for I := High(AReg.MMRegister.Words) downto Low(AReg.MMRegister.Words) do
|
|
begin
|
|
Value.ValueWord := AReg.MMRegister.Words[I];
|
|
Result := Result + ' ' + FormatValue(Value, Format);
|
|
end;
|
|
xt4DWords:
|
|
for I := High(AReg.MMRegister.DWords) downto Low(AReg.MMRegister.DWords) do
|
|
begin
|
|
Value.ValueDWord := AReg.MMRegister.DWords[I];
|
|
Result := Result + ' ' + FormatValue(Value, Format);
|
|
end;
|
|
xt2QWords:
|
|
begin
|
|
Value.ValueQWord := AReg.MMRegister.QWords;
|
|
Result := FormatValue(Value, Format);
|
|
end;
|
|
xt4Singles:
|
|
for I := High(AReg.MMRegister.Singles) downto Low(AReg.MMRegister.Singles) do
|
|
begin
|
|
Value.ValueSingle := AReg.MMRegister.Singles[I];
|
|
Result := Result + ' ' + FormatValue(Value, sfBinary);
|
|
end;
|
|
xt2Doubles:
|
|
Result := RsNotSupportedFormat;
|
|
end
|
|
else
|
|
Result := RsNoPackedData;
|
|
end;
|
|
|
|
begin
|
|
AProcess := nil;
|
|
AThread := nil;
|
|
if DebuggerServices.ProcessCount > 0 then
|
|
AProcess := DebuggerServices.CurrentProcess;
|
|
if (AProcess <> nil) and (AProcess.ThreadCount > 0) then
|
|
AThread := AProcess.CurrentThread;
|
|
|
|
if (AThread = nil) or (AThread.State = tsNone) or
|
|
(AThread.GetOSThreadID = 0) or (AThread.Handle = 0) then
|
|
begin
|
|
Close;
|
|
Exit;
|
|
end;
|
|
|
|
case AThread.State of
|
|
tsStopped:
|
|
begin
|
|
if DebuggerServices.CurrentProcess.ThreadCount > 1 then
|
|
Caption := SysUtils.Format('%s Thread : %d', [SIMDCaption,AThread.GetOSThreadID])
|
|
else
|
|
Caption := SIMDCaption;
|
|
|
|
GetVectorContext(AThread,NewVectorFrame);
|
|
|
|
for Index := 0 to ListBoxMXCSR.Items.Count - 1 do
|
|
with ListBoxMXCSR, Items, MXCSRBitsDescriptions[Index] do
|
|
begin
|
|
NewBitValue := NewVectorFrame.MXCSR and AndMask;
|
|
OldBitValue := FVectorFrame.MXCSR and AndMask;
|
|
FMXCSRChanged[Index] := NewBitValue <> OldBitValue;
|
|
Strings[Index] := IntToStr(NewBitValue shr Shifting);
|
|
end;
|
|
ListBoxMXCSR.Invalidate;
|
|
|
|
for Index := 0 to NbMMRegister - 1 do
|
|
begin
|
|
FRegisterChanged[Index] := ChangedFlag(NewVectorFrame.FPURegisters[Index].Data.MMRegister,
|
|
FVectorFrame.FPURegisters[Index].Data.MMRegister);
|
|
ListBoxRegs.Items.Strings[Index] := FormatReg(NewVectorFrame.FPURegisters[Index].Data, Index);
|
|
end;
|
|
|
|
if FNbXMMRegister > 0 then
|
|
begin
|
|
for Index := 0 to FNbXMMRegister - 2 do
|
|
begin
|
|
FRegisterChanged[Index + NbMMRegister] := ChangedFlag(NewVectorFrame.XMMRegisters.LongXMM[Index],
|
|
FVectorFrame.XMMRegisters.LongXMM[Index]);
|
|
ListBoxRegs.Items.Strings[Index + NbMMRegister] := FormatReg(NewVectorFrame.XMMRegisters.LongXMM[Index]);
|
|
end;
|
|
|
|
FRegisterChanged[NbMMRegister + NbXMMRegister - 1] := NewVectorFrame.MXCSR <> FVectorFrame.MXCSR;
|
|
ListBoxRegs.Items.Strings[NbMMRegister + NbXMMRegister - 1] := IntToHex(NewVectorFrame.MXCSR, 8);
|
|
end;
|
|
ListBoxRegs.Invalidate;
|
|
|
|
FVectorFrame := NewVectorFrame;
|
|
end;
|
|
tsRunnable:
|
|
Caption := SysUtils.Format('%s <running>', [SIMDCaption]);
|
|
tsBlocked:
|
|
Caption := SysUtils.Format('%s <blocked>', [SIMDCaption]);
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.SetThreadValues;
|
|
begin
|
|
if not SetVectorContext(DebuggerServices.CurrentProcess.CurrentThread,FVectorFrame) then
|
|
raise EJclExpertException.Create(RsECantUpdateThreadContext);
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.MenuItemFormatClick(Sender: TObject);
|
|
begin
|
|
try
|
|
Format := TJclSIMDFormat((Sender as TMenuItem).Tag);
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.SetDisplay(const Value: TJclXMMContentType);
|
|
var
|
|
AEnabled: Boolean;
|
|
begin
|
|
FDisplay := Value;
|
|
MenuItemBytes.Checked := Value = xt16Bytes;
|
|
MenuItemWords.Checked := Value = xt8Words;
|
|
MenuItemDWords.Checked := Value = xt4DWords;
|
|
MenuItemQWords.Checked := Value = xt2QWords;
|
|
MenuItemSingles.Checked := Value = xt4Singles;
|
|
MenuItemDoubles.Checked := Value = xt2Doubles;
|
|
|
|
AEnabled := not (Value in [xt4Singles, xt2Doubles]);
|
|
MenuItemBinary.Enabled := AEnabled;
|
|
MenuItemSigned.Enabled := AEnabled;
|
|
MenuItemUnsigned.Enabled := AEnabled;
|
|
MenuItemHexa.Enabled := AEnabled;
|
|
|
|
GetThreadValues;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.SetFormat(const Value: TJclSIMDFormat);
|
|
begin
|
|
FFormat := Value;
|
|
MenuItemBinary.Checked := Value = sfBinary;
|
|
MenuItemSigned.Checked := Value = sfSigned;
|
|
MenuItemUnsigned.Checked := Value = sfUnsigned;
|
|
MenuItemHexa.Checked := Value = sfHexa;
|
|
|
|
GetThreadValues;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.MenuItemDisplayClick(Sender: TObject);
|
|
begin
|
|
try
|
|
Display := TJclXMMContentType((Sender as TMenuItem).Tag);
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.DoClose(var Action: TCloseAction);
|
|
begin
|
|
Action := caFree;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.FormCreate(Sender: TObject);
|
|
begin
|
|
SetBounds(
|
|
Settings.LoadInteger('Left', Left),
|
|
Settings.LoadInteger('Top', Top),
|
|
Settings.LoadInteger('Width', Width),
|
|
Settings.LoadInteger('Height', Height));
|
|
|
|
if Left < 0 then
|
|
Left := 0;
|
|
if Top < 0 then
|
|
Top := 0;
|
|
if Width > Screen.Width then
|
|
Width := Screen.Width;
|
|
if (Left + Width) > Screen.DesktopWidth then
|
|
Left := Screen.DesktopWidth - Width;
|
|
if Height > Screen.Height then
|
|
Height := Screen.Height;
|
|
if (Top + Height) > Screen.DesktopHeight then
|
|
Top := Screen.DesktopHeight - Height;
|
|
|
|
Format := TJclSIMDFormat(GetEnumValue(TypeInfo(TJclSIMDFormat),
|
|
Settings.LoadString('Format', GetEnumName(TypeInfo(TJclSIMDFormat), Integer(sfHexa)))));
|
|
Display := TJclXMMContentType(GetEnumValue(TypeInfo(TJclXMMContentType),
|
|
Settings.LoadString('Display', GetEnumName(TypeInfo(TJclXMMContentType), Integer(xt8Words)))));
|
|
|
|
if Settings.LoadInteger('StayOnTop', 0) = 1 then
|
|
FormStyle := fsStayOnTop
|
|
else
|
|
FormStyle := fsNormal;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.FormDestroy(Sender: TObject);
|
|
begin
|
|
Settings.SaveInteger('Left', Left);
|
|
Settings.SaveInteger('Top', Top);
|
|
Settings.SaveInteger('Width', Width);
|
|
Settings.SaveInteger('Height', Height);
|
|
Settings.SaveString('Display', GetEnumName(TypeInfo(TJclXMMContentType), Integer(Display)));
|
|
Settings.SaveString('Format', GetEnumName(TypeInfo(TJclSIMDFormat), Integer(Format)));
|
|
Settings.SaveInteger('StayOnTop', Ord(FormStyle = fsStayOnTop));
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.MenuItemCpuInfoClick(Sender: TObject);
|
|
var
|
|
FormCPUInfo: TJclFormCpuInfo;
|
|
begin
|
|
try
|
|
FormCPUInfo := TJclFormCpuInfo.Create(Self);
|
|
try
|
|
FormCPUInfo.Execute(CpuInfo);
|
|
finally
|
|
FormCPUInfo.Free;
|
|
end;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.UpdateActions;
|
|
var
|
|
CurrentThreadID: Cardinal;
|
|
AProcess: IOTAProcess;
|
|
AThread: IOTAThread;
|
|
ANewThreadState: TOTAThreadState;
|
|
begin
|
|
inherited UpdateActions;
|
|
|
|
CurrentThreadID := 0;
|
|
AProcess := nil;
|
|
AThread := nil;
|
|
|
|
if DebuggerServices.ProcessCount > 0 then
|
|
AProcess := DebuggerServices.CurrentProcess;
|
|
if (AProcess <> nil) and (AProcess.ThreadCount > 0) then
|
|
AThread := AProcess.CurrentThread;
|
|
if AThread <> nil then
|
|
begin
|
|
ANewThreadState := AThread.State;
|
|
if ANewThreadState in [tsStopped, tsBlocked] then
|
|
CurrentThreadID := AThread.GetOSThreadID;
|
|
if (CurrentThreadID <> 0) and ((CurrentThreadID <> FOldThreadID) or (ANewThreadState <> FOldThreadState)) then
|
|
begin
|
|
FOldThreadID := CurrentThreadID;
|
|
FOldThreadState := ANewThreadState;
|
|
GetThreadValues;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ThreadEvaluate(const ExprStr, ResultStr: string;
|
|
ReturnCode: Integer);
|
|
begin
|
|
if Assigned(FModifyForm) then
|
|
FModifyForm.ThreadEvaluate(ExprStr, ResultStr, ReturnCode);
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ActionStayOnTopUpdate(Sender: TObject);
|
|
var
|
|
AAction: TAction;
|
|
begin
|
|
try
|
|
AAction := Sender as TAction;
|
|
AAction.Checked := FormStyle = fsStayOnTop;
|
|
AAction.Enabled := True;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ActionStayOnTopExecute(Sender: TObject);
|
|
begin
|
|
try
|
|
if FormStyle = fsStayOnTop then
|
|
FormStyle := fsNormal
|
|
else
|
|
FormStyle := fsStayOnTop;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ActionModifyUpdate(Sender: TObject);
|
|
var
|
|
AProcess: IOTAProcess;
|
|
AThread: IOTAThread;
|
|
AItemIndex: Integer;
|
|
begin
|
|
try
|
|
AProcess := DebuggerServices.CurrentProcess;
|
|
AThread := nil;
|
|
AItemIndex := ListBoxRegs.ItemIndex;
|
|
if NbXMMRegister > 0 then
|
|
Inc(AItemIndex);
|
|
|
|
if Assigned(AProcess) then
|
|
AThread := AProcess.CurrentThread;
|
|
|
|
(Sender as TAction).Enabled := Assigned(AThread) and (AThread.State = tsStopped) and
|
|
(AItemIndex >= 0) and (AItemIndex < (NbMMRegister + NbXMMRegister));
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ActionModifyExecute(Sender: TObject);
|
|
var
|
|
AItemIndex: Integer;
|
|
begin
|
|
try
|
|
AItemIndex := ListBoxRegs.ItemIndex;
|
|
if AItemIndex >= 0 then
|
|
try
|
|
FModifyForm := TJclSIMDModifyFrm.Create(Self, DebuggerServices, Settings);
|
|
FModifyForm.Icon.Assign(Self.Icon);
|
|
|
|
if AItemIndex < NbMMRegister then
|
|
begin
|
|
FModifyForm.Caption := SysUtils.Format(RsModifyMM, [AItemIndex]);
|
|
if FModifyForm.Execute(DebuggerServices.CurrentProcess.CurrentThread, Display,
|
|
Format, FVectorFrame.FPURegisters[AItemIndex].Data.MMRegister ,FCpuInfo) then
|
|
begin
|
|
FVectorFrame.FPURegisters[AItemIndex].Data.Reserved := $FFFF;
|
|
FVectorFrame.FTW := FVectorFrame.FTW or (1 shl AItemIndex);
|
|
SetThreadValues;
|
|
GetThreadValues;
|
|
FRegisterChanged[AItemIndex] := True;
|
|
ListBoxRegs.Invalidate;
|
|
end;
|
|
end else
|
|
begin
|
|
if CpuInfo.Is64Bits then
|
|
FModifyForm.Caption := SysUtils.Format(RsModifyXMM2, [AItemIndex - NbMMRegister])
|
|
else
|
|
FModifyForm.Caption := SysUtils.Format(RsModifyXMM1, [AItemIndex - NbMMRegister]);
|
|
if FModifyForm.Execute(DebuggerServices.CurrentProcess.CurrentThread, Display,
|
|
Format, FVectorFrame.XMMRegisters.LongXMM[AItemIndex - NbMMRegister], FCpuInfo) then
|
|
begin
|
|
SetThreadValues;
|
|
GetThreadValues;
|
|
FRegisterChanged[AItemIndex] := True;
|
|
ListBoxRegs.Invalidate;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeAndNil(FModifyForm);
|
|
end;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ActionEmptyUpdate(Sender: TObject);
|
|
var
|
|
AProcess: IOTAProcess;
|
|
AThread: IOTAThread;
|
|
AItemIndex: Integer;
|
|
begin
|
|
try
|
|
AProcess := DebuggerServices.CurrentProcess;
|
|
AThread := nil;
|
|
AItemIndex := ListBoxRegs.ItemIndex;
|
|
if Assigned(AProcess) then
|
|
AThread := AProcess.CurrentThread;
|
|
(Sender as TAction).Enabled := Assigned(AThread) and (AThread.State = tsStopped) and
|
|
(AItemIndex >= 0) and (AItemIndex < NbMMRegister) and
|
|
((FVectorFrame.FTW and (1 shl AItemIndex)) <> 0) and
|
|
(FVectorFrame.FPURegisters[AItemIndex].Data.Reserved = $FFFF);
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ActionEmptyExecute(Sender: TObject);
|
|
var
|
|
AItemIndex: Integer;
|
|
begin
|
|
try
|
|
AItemIndex := ListBoxRegs.ItemIndex;
|
|
FVectorFrame.FTW := FVectorFrame.FTW and not (1 shl AItemIndex);
|
|
FVectorFrame.FPURegisters[AItemIndex].Data.FloatValue := 0.0;
|
|
SetThreadValues;
|
|
GetThreadValues;
|
|
FRegisterChanged[AItemIndex] := True;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ActionEmptyAllUpdate(Sender: TObject);
|
|
var
|
|
AProcess: IOTAProcess;
|
|
AThread: IOTAThread;
|
|
AItemIndex: Integer;
|
|
begin
|
|
try
|
|
AProcess := DebuggerServices.CurrentProcess;
|
|
AThread := nil;
|
|
AItemIndex := ListBoxRegs.ItemIndex;
|
|
if Assigned(AProcess) then
|
|
AThread := AProcess.CurrentThread;
|
|
(Sender as TAction).Enabled := (AItemIndex >= 0) and (AItemIndex < NbMMRegister) and
|
|
Assigned(AThread) and (AThread.State = tsStopped);
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ActionEmptyAllExecute(Sender: TObject);
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
try
|
|
FVectorFrame.FTW := 0;
|
|
for Index := Low(FVectorFrame.FPURegisters) to High(FVectorFrame.FPURegisters) do
|
|
FVectorFrame.FPURegisters[Index].Data.FloatValue := 0.0;
|
|
SetThreadValues;
|
|
GetThreadValues;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ActionComplementUpdate(Sender: TObject);
|
|
begin
|
|
try
|
|
(Sender as TAction).Enabled := ListBoxMXCSR.ItemIndex >= 0;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ActionComplementExecute(Sender: TObject);
|
|
var
|
|
BitValue: Cardinal;
|
|
OldMXCSRValue: Cardinal;
|
|
begin
|
|
try
|
|
if ListBoxMXCSR.ItemIndex >= 0 then
|
|
with MXCSRBitsDescriptions[ListBoxMXCSR.ItemIndex] do
|
|
begin
|
|
OldMXCSRValue := FVectorFrame.MXCSR;
|
|
BitValue := (Cardinal(FVectorFrame.MXCSR) and AndMask) shr Shifting;
|
|
Inc(BitValue);
|
|
FVectorFrame.MXCSR := (FVectorFrame.MXCSR and (not AndMask)) or ((BitValue shl Shifting) and AndMask);
|
|
SetThreadValues;
|
|
FVectorFrame.MXCSR := OldMXCSRValue;
|
|
GetThreadValues;
|
|
end;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSIMDViewFrm.ListBoxesMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
AListBox: TListBox;
|
|
begin
|
|
try
|
|
if Button = mbRight then
|
|
begin
|
|
AListBox := Sender as TListBox;
|
|
AListBox.ItemIndex := AListBox.ItemAtPos(Point(X, Y), True);
|
|
end;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// History:
|
|
|
|
// $Log: JclSIMDViewForm.pas,v $
|
|
// Revision 1.9 2006/01/08 17:16:56 outchy
|
|
// Settings reworked.
|
|
// Common window for expert configurations
|
|
//
|
|
// Revision 1.8 2005/12/16 23:46:25 outchy
|
|
// Added expert stack form.
|
|
// Added code to display call stack on expert exception.
|
|
// Fixed package extension for D2006.
|
|
//
|
|
// Revision 1.7 2005/12/04 10:10:57 obones
|
|
// Borland Developer Studio 2006 support
|
|
//
|
|
// Revision 1.6 2005/11/21 21:25:40 outchy
|
|
// Modified the get/set methods of thread context for Delphi 2005
|
|
//
|
|
// Revision 1.5 2005/10/26 03:29:44 rrossmair
|
|
// - improved header information, added $Date: 2006/01/08 17:16:56 $ and $Log: JclSIMDViewForm.pas,v $
|
|
// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Revision 1.9 2006/01/08 17:16:56 outchy
|
|
// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Settings reworked.
|
|
// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Common window for expert configurations
|
|
// - improved header information, added $Date: 2006/01/08 17:16:56 $ and
|
|
// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Revision 1.8 2005/12/16 23:46:25 outchy
|
|
// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Added expert stack form.
|
|
// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Added code to display call stack on expert exception.
|
|
// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Fixed package extension for D2006.
|
|
// - improved header information, added $Date: 2006/01/08 17:16:56 $ and
|
|
// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Revision 1.7 2005/12/04 10:10:57 obones
|
|
// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Borland Developer Studio 2006 support
|
|
// - improved header information, added $Date: 2006/01/08 17:16:56 $ and CVS tags.
|
|
//
|
|
|
|
end.
|