{**************************************************************************************************}
{                                                                                                  }
{ 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: JvSIMDModifyForm.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: JclSIMDModifyForm.pas,v 1.9 2006/01/08 17:16:56 outchy Exp $

unit JclSIMDModifyForm;

interface

{$I jcl.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ToolsApi, Contnrs,
  JclOtaUtils, JclSysInfo, JclSIMDUtils;

const
  WM_MODIFYCONTINUE = WM_USER + 100;

type
  TJclRegisterType = (rtXMM, rtMM);
  
  TJclSIMDModifyFrm = class(TForm)
    ComboBoxDisplay: TComboBox;
    ComboBoxFormat: TComboBox;
    LabelDisplay: TLabel;
    LabelFormat: TLabel;
    LabelBlank: TLabel;
    PanelModify: TPanel;
    ButtonOK: TButton;
    ButtonCancel: TButton;
    MemoTip: TMemo;
    procedure ComboBoxDisplayChange(Sender: TObject);
    procedure ComboBoxFormatChange(Sender: TObject);
    procedure ButtonOKClick(Sender: TObject);
  private
    FRegisterType: TJclRegisterType;
    FXMMRegister: TJclXMMRegister;
    FMMRegister: TJclMMRegister;
    FDisplay: TJclXMMContentType;
    FFormat: TJclSIMDFormat;
    FDebuggerServices: IOTADebuggerServices;
    FComboBoxList: TComponentList;
    FLabelList: TComponentList;
    FHistory: TStringList;
    FThread: IOTAThread;
    FTextIndex: Integer;
    FExprStr: string;
    FResultStr: string;
    FReturnCode: Cardinal;
    FCPUInfo: TCpuInfo;
    FSettings: TJclOTASettings;
    procedure ContinueModify;
    procedure StartModify;
    procedure WMModifyContinue(var Msg: TMessage); message WM_MODIFYCONTINUE;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    property RegisterType: TJclRegisterType read FRegisterType;
    property XMMRegister: TJclXMMRegister read FXMMRegister;
    property MMRegister: TJclMMRegister read FMMRegister;
    property DebuggerServices: IOTADebuggerServices read FDebuggerServices;
  public
    constructor Create(AOwner: TComponent;
      ADebuggerServices: IOTADebuggerServices; ASettings: TJclOTASettings); reintroduce;
    destructor Destroy; override;
    function Execute(AThread: IOTAThread; ADisplay: TJclXMMContentType;
      AFormat: TJclSIMDFormat; var ARegister: TJclXMMRegister;
      const ACpuInfo: TCpuInfo): Boolean; overload;
    function Execute(AThread: IOTAThread; ADisplay: TJclXMMContentType;
      AFormat: TJclSIMDFormat; var ARegister: TJclMMRegister;
      const ACpuInfo: TCpuInfo): Boolean; overload;
    procedure ThreadEvaluate(const ExprStr, ResultStr: string; ReturnCode: Integer);
    procedure UpdateDisplay;
    procedure UpdateFormat;
    procedure LoadHistory;
    procedure SaveHistory;
    procedure MergeHistory;

    property Display: TJclXMMContentType read FDisplay;
    property Format: TJclSIMDFormat read FFormat;
    property History: TStringList read FHistory;
    property Thread: IOTAThread read FThread;
    property Settings: TJclOTASettings read FSettings;
  end;

implementation

{$R *.dfm}

const
  NbEdits: array [TJclRegisterType, TJclXMMContentType] of Byte =
   (
    (16, 8, 4, 2, 4, 2),
    ( 8, 4, 2, 1, 2, 1)
   );

  Texts: array [TJclXMMContentType] of string =
    ('Byte', 'Word', 'DWord', 'QWord', 'Single', 'Double');

  ItemFormat = 'Item%d';
  CountPropertyName = 'Count';

  HistoryListSize = 30;

//=== { TJclSIMDModifyFrm } ==================================================

constructor TJclSIMDModifyFrm.Create(AOwner: TComponent;
  ADebuggerServices: IOTADebuggerServices; ASettings: TJclOTASettings);
begin
  inherited Create(AOwner);

  FDebuggerServices := ADebuggerServices;
  FSettings := ASettings;

  FComboBoxList := TComponentList.Create(False);
  FLabelList := TComponentList.Create(False);
  FHistory := TStringList.Create;
  FHistory.Duplicates := dupIgnore;
end;

procedure TJclSIMDModifyFrm.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 TJclSIMDModifyFrm.Destroy;
begin
  FLabelList.Free;
  FComboBoxList.Free;
  FHistory.Free;
  FDebuggerServices := nil;

  inherited Destroy;
end;

function TJclSIMDModifyFrm.Execute(AThread: IOTAThread; ADisplay: TJclXMMContentType;
  AFormat: TJclSIMDFormat; var ARegister: TJclXMMRegister;
  const ACPUInfo: TCPUInfo): Boolean;
begin
  FTextIndex := 0;
  FRegisterType := rtXMM;
  FXMMRegister := ARegister;
  FFormat := AFormat;
  FDisplay := ADisplay;
  FThread := AThread;
  FCpuInfo := ACpuInfo;

  LoadHistory;

  ComboBoxDisplay.ItemIndex := Integer(Display);
  ComboBoxFormat.Enabled := Display in [xt16Bytes..xt2QWords];
  ComboBoxFormat.ItemIndex := Integer(Format);
  UpdateDisplay;

  Result := ShowModal = mrOk;

  if Result then
    ARegister := XMMRegister;

  MergeHistory;
  SaveHistory;
end;

function TJclSIMDModifyFrm.Execute(AThread: IOTAThread;
  ADisplay: TJclXMMContentType; AFormat: TJclSIMDFormat;
  var ARegister: TJclMMRegister; const ACpuInfo: TCpuInfo): Boolean;
begin
  FTextIndex := 0;
  FRegisterType := rtMM;
  FMMRegister := ARegister;
  FFormat := AFormat;
  FDisplay := ADisplay;
  FThread := AThread;
  FCpuInfo := ACpuInfo;

  LoadHistory;

  ComboBoxDisplay.ItemIndex := Integer(Display);
  ComboBoxFormat.Enabled := Display in [xt16Bytes..xt2QWords];
  ComboBoxFormat.ItemIndex := Integer(Format);
  UpdateDisplay;

  Result := ShowModal = mrOk;

  if Result then
    ARegister := MMRegister;

  MergeHistory;
  SaveHistory;
end;

procedure TJclSIMDModifyFrm.UpdateDisplay;
var
  Index: Integer;
  AComboBox: TComboBox;
  ALabel: TLabel;
  X, Y: Integer;
begin
  MergeHistory;
  while PanelModify.ControlCount > 0 do
    PanelModify.Controls[0].Free;
  FComboBoxList.Clear;
  FLabelList.Clear;

  ComboBoxDisplay.ItemIndex := Integer(Display);
  ComboBoxFormat.Enabled := Display in [xt16Bytes..xt2QWords];
  ComboBoxFormat.ItemIndex := Integer(Format);

  X := 0;
  Y := 12;
  for Index := 0 to NbEdits[RegisterType, Display] - 1 do
  begin
    AComboBox := TComboBox.Create(Self);
    AComboBox.Parent := PanelModify;
    AComboBox.SetBounds(X + 130, Y, 90, AComboBox.Height);
    AComboBox.Tag := Index;
    AComboBox.Text := '';
    AComboBox.Items.Assign(History);
    FComboBoxList.Add(AComboBox);
    ALabel := TLabel.Create(Self);
    ALabel.Parent := PanelModify;
    ALabel.SetBounds(X + 5, Y + 2, 60, ALabel.Height);
    ALabel.Tag := Index;
    FLabelList.Add(ALabel);
    if Index = 7 then
    begin
      Y := 12;
      X := 230;
    end
    else
      Inc(Y, 32);
  end;
  UpdateFormat;
end;

procedure TJclSIMDModifyFrm.UpdateFormat;
var
  Index: Integer;
  Value: TJclSIMDValue;
  ALabel: TLabel;
begin
  Value.Display := Display;
  for Index := 0 to FLabelList.Count - 1 do
  begin
    ALabel := FLabelList.Items[Index] as TLabel;
    case RegisterType of
      rtXMM:
        case Display of
          xt16Bytes:
            Value.ValueByte := XMMRegister.Bytes[ALabel.Tag];
          xt8Words:
            Value.ValueWord := XMMRegister.Words[ALabel.Tag];
          xt4DWords:
            Value.ValueDWord := XMMRegister.DWords[ALabel.Tag];
          xt2QWords:
            Value.ValueQWord := XMMRegister.QWords[ALabel.Tag];
          xt4Singles:
            Value.ValueSingle := XMMRegister.Singles[ALabel.Tag];
          xt2Doubles:
            Value.ValueDouble := XMMRegister.Doubles[ALabel.Tag];
        end;
      rtMM:
        case Display of
          xt16Bytes:
            Value.ValueByte := MMRegister.Bytes[ALabel.Tag];
          xt8Words:
            Value.ValueWord := MMRegister.Words[ALabel.Tag];
          xt4DWords:
            Value.ValueDWord := MMRegister.DWords[ALabel.Tag];
          xt2QWords:
            Value.ValueQWord := MMRegister.QWords;
          xt4Singles:
            Value.ValueSingle := MMRegister.Singles[ALabel.Tag];
          xt2Doubles:
            begin
              ALabel.Caption := '';
              Break;
            end;
        end;
    end;
    ALabel.Caption := SysUtils.Format('%s%d = %s', [Texts[Display], Index, FormatValue(Value, Format)]);
  end;
end;

procedure TJclSIMDModifyFrm.ComboBoxDisplayChange(Sender: TObject);
begin
  try
    FDisplay := TJclXMMContentType((Sender as TComboBox).ItemIndex);
    UpdateDisplay;
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
      raise;
    end;
  end;
end;

procedure TJclSIMDModifyFrm.ComboBoxFormatChange(Sender: TObject);
begin
  try
    FFormat := TJclSIMDFormat((Sender as TComboBox).ItemIndex);
    UpdateFormat;
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
      raise;
    end;
  end;
end;

procedure TJclSIMDModifyFrm.LoadHistory;
var
  Index, Count: Integer;
begin
  Count := Settings.LoadInteger(CountPropertyName, 0);
  History.Clear;

  for Index := 0 to Count - 1 do
    History.Add(Settings.LoadString(SysUtils.Format(ItemFormat, [Index]), ''));
end;

procedure TJclSIMDModifyFrm.SaveHistory;
var
  Index: Integer;
begin
  Settings.SaveInteger(CountPropertyName, History.Count);
  for Index := 0 to History.Count - 1 do
    Settings.SaveString(SysUtils.Format(ItemFormat, [Index]), History.Strings[Index]);
end;

procedure TJclSIMDModifyFrm.MergeHistory;
var
  I, J: Integer;
begin
  History.Duplicates := dupIgnore;
  for I := 0 to PanelModify.ControlCount - 1 do
    if PanelModify.Controls[I] is TComboBox then
      with TComboBox(PanelModify.Controls[I]) do
  begin
    for J := 0 to Items.Count - 1 do
      if (Items.Strings[J] <> '') and (History.IndexOf(Items.Strings[J]) = -1) then
        History.Add(Items.Strings[J]);
    if (Text <> '') and (History.IndexOf(Text) = -1) then
      History.Add(Text);
  end;
  while History.Count > HistoryListSize do
    History.Delete(0);
end;

procedure TJclSIMDModifyFrm.WMModifyContinue(var Msg: TMessage);
begin
  try
    ContinueModify;
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
      //raise; no exception throw message handler
    end;
  end;
end;

procedure TJclSIMDModifyFrm.StartModify;
begin
  FTextIndex := -1;
  FResultStr := '';
  FReturnCode := 0;
  ContinueModify;
end;

procedure TJclSIMDModifyFrm.ContinueModify;
const
  ResultBufferSize = 200;
var
  EvaluateResult: TOTAEvaluateResult;
  AValue: TJclSIMDValue;
  AComboBox: TComboBox;
  ResultBuffer: array [0..ResultBufferSize-1] of Char;
  ResultAddr, ResultSize: Cardinal;
  CanModify: Boolean;
  VectorFrame: TJclVectorFrame;
begin
  if (FReturnCode <> 0) then
    EvaluateResult := erError
  else
    EvaluateResult := erOK;
  AValue.Display := Display;
  GetVectorContext(Thread, VectorFrame);
  while (FTextIndex < FComboBoxList.Count) and (EvaluateResult = erOK) do
  begin
    if (FTextIndex >= 0) and (FResultStr <> '') then
    begin
      if (ParseValue(FResultStr,AValue,Format)) then
        case RegisterType of
          rtXMM:
            case AValue.Display of
              xt16Bytes:
                FXMMRegister.Bytes[FTextIndex] := AValue.ValueByte;
              xt8Words:
                FXMMRegister.Words[FTextIndex] := AValue.ValueWord;
              xt4DWords:
                FXMMRegister.DWords[FTextIndex] := AValue.ValueDWord;
              xt2QWords:
                FXMMRegister.QWords[FTextIndex] := AValue.ValueQWord;
              xt4Singles:
                FXMMRegister.Singles[FTextIndex] := AValue.ValueSingle;
              xt2Doubles:
                FXMMRegister.Doubles[FTextIndex] := AValue.ValueDouble;
            end;
          rtMM:
            case AValue.Display of
              xt16Bytes:
                FMMRegister.Bytes[FTextIndex] := AValue.ValueByte;
              xt8Words:
                FMMRegister.Words[FTextIndex] := AValue.ValueWord;
              xt4DWords:
                FMMRegister.DWords[FTextIndex] := AValue.ValueDWord;
              xt2QWords:
                FMMRegister.QWords := AValue.ValueQWord;
              xt4Singles:
                FMMRegister.Singles[FTextIndex] := AValue.ValueSingle;
              xt2Doubles:
                EvaluateResult := erError;
            end;
          else
            EvaluateResult := erError;
        end
      else
        EvaluateResult := erError;
    end;
    if EvaluateResult = erOK then
    begin
      Inc(FTextIndex);
      if FTextIndex < FComboBoxList.Count then
      begin
        AComboBox := TComboBox(FComboBoxList.Items[FTextIndex]);
        FExprStr := AComboBox.Text;
        if FExprStr <> '' then
        begin
          if not ParseValue(FExprStr, AValue, Format) then
          begin
            if ReplaceSIMDRegisters(FExprStr, FCPUInfo.Is64Bits, VectorFrame) then
              EvaluateResult := Thread.Evaluate(FExprStr, ResultBuffer,
                ResultBufferSize, CanModify, True, '', ResultAddr, ResultSize, FReturnCode)
            else
              EvaluateResult := erError;
            if (EvaluateResult <> erDeferred) and (FReturnCode <> 0) then
              EvaluateResult := erError;
            if EvaluateResult = erOK then
              FResultStr := ResultBuffer;
            if FResultStr = '' then
              EvaluateResult := erError;
          end
          else
          begin
            FResultStr := FExprStr;
            EvaluateResult := erOK;
          end;
        end
        else
          FResultStr := '';
      end;
    end;
  end;
  if (EvaluateResult = erError) and (FTextIndex < FComboBoxList.Count) then
  begin
    AComboBox := TComboBox(FComboBoxList.Items[FTextIndex]);
    FocusControl(AComboBox);
    AComboBox.SelectAll;
  end
  else
  if (EvaluateResult = erOK) and (FTextIndex >= FComboBoxList.Count) then
    ModalResult := mrOk;
end;

procedure TJclSIMDModifyFrm.ButtonOKClick(Sender: TObject);
begin
  try
    StartModify;
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
      raise;
    end;
  end;
end;

procedure TJclSIMDModifyFrm.ThreadEvaluate(const ExprStr, ResultStr: string; ReturnCode: Integer);
begin
  if CompareText(FExprStr, ExprStr) = 0 then
  begin
    FResultStr := ResultStr;
    FReturnCode := ReturnCode;
    PostMessage(Handle, WM_MODIFYCONTINUE, 0, 0);
  end;
end;

// History:

// $Log: JclSIMDModifyForm.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: JclSIMDModifyForm.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.