View Issue Details

IDProjectCategoryView StatusLast Update
0037797LazarusDebuggerpublic2020-09-28 22:20
ReporterKlaus1 Assigned ToMartin Friebe  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Product Version2.0.10 
Fixed in Version2.2 
Summary0037797: In register windows the xmm register entrys are fragmented although the output of gdb is ok.
DescriptionThe entrys in register window are fragmented.
That is what I see:
 {v4_float = {2, 4, 6, 8}, v2_double = {512.0001220703125, 131072.03161621094}, v16_int8 = {0, 0, 0, 64, 0, 0, -128, 64, 0, 0, -64, 64, 0, 0, 0, 65}, v8_int16 = {0, 16384, 0, 16512, 0, 16576, 0, 16640}, v4_int32 = {1073741824, 1082130432, 1086324736, 1090519040
that is chop
}, v2_int64 = {4647714816520093696, 4683743613551640576}, uint128 = 86399819746058686129327266934672064512}
Only when I copy the value is the value complete.
Ok is a marginal error, but in debagging disruptive.
Regards Klaus
TagsNo tags attached.
Fixed in Revision63914
LazTarget2.2
WidgetsetWin32/Win64
Attached Files

Activities

Martin Friebe

2020-09-22 21:12

manager   ~0125761

It appears that (on windows) the Listview (report mode) has a limit of 259 or 260 chars for subitems. The value is shown as sub-item.

This may mean that the register window needs a replacement for TListView. (And the same will apply to other debug windows)

Martin Friebe

2020-09-23 23:15

manager   ~0125799

I replaced the ListView with a Grid. That should solve the cut off issue.

Please test and close if ok

Klaus1

2020-09-28 16:37

reporter   ~0125928

Hello Martin,
I hve in RegisterDlg.pas new procedures for the vector display in other values. In the work I have seen in unit DbgIntfDebuggerBase is a liitle mistake
in the function TRegisterDisplayValue.GetValue. The intern function has a error. The FNumValue is defined as Qword and not integer.
I upload the funktion and the unit RegisterDlg.pas as txt file. The idea with the grid is ok. I think the Register interface should new designed. For all
new vector registers (sse,vex,evex...)
upload.txt (28,745 bytes)   
function TRegisterDisplayValue.GetValue(ADispFormat: TRegisterDisplayFormat): String;
const Digits = '01234567';
  function IntToBase(Val :QWord; Base: Integer): String; // changed Klaus1
//  function IntToBase(Val, Base: Integer): String;
  var
    M: Integer;
  begin
    Result := '';
    case Base of
      2: M := 1;
      8: M := 7;
    end;
    while Val > 0 do begin
      Result := Digits[1 + (Val and m)] + Result;
      Val := Val div Base;
    end;
  end;
begin
  Result := '';
  if not(ADispFormat in FSupportedDispFormats) then exit;
  if (ADispFormat in [rdDefault, rdRaw]) or not (rdvHasNum in FFlags) then begin
    Result := FStringValue;
    exit;
  end;
  case ADispFormat of
    rdHex:    Result := IntToHex(FNumValue, FSize * 2);
    rdBinary: Result := IntToBase(FNumValue, 2);
    rdOctal:  Result := IntToBase(FNumValue, 8);
    rdDecimal: Result := IntToStr(FNumValue);
  end;
end;


{ $Id: registersdlg.pp 60384 2019-02-09 08:47:19Z mattias $ }
{               ----------------------------------------------  
                 registersdlg.pp  -  Overview of registers 
                ---------------------------------------------- 
 
 @created(Sun Nov 16th WET 2008)
 @lastmod($Date: 2019-02-09 09:47:19 +0100 (Sat, 09 Feb 2019) $)
 @author(Marc Weustink <marc@@dommelstein.net>)                       
 @a little changed Klaus

 This unit contains the registers debugger dialog.
 
 
 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
 *                                                                         *
 ***************************************************************************
}
unit RegistersDlg;

{$mode objfpc}{$H+}

interface

uses
  SysUtils, Classes, Controls, Forms, Clipbrd,
  BaseDebugManager, IDEWindowIntf, DebuggerStrConst,
  ComCtrls, ActnList, Menus, Debugger, DebuggerDlg,
  LazarusIDEStrConsts, IDEImagesIntf, DbgIntfDebuggerBase;

type

  { TRegistersDlg }

  TRegistersDlg = class(TDebuggerDlg)
    actCopyName: TAction;
    actCopyValue: TAction;
    actPower: TAction;
    ActionList1: TActionList;
    ImageList1: TImageList;
    lvRegisters: TListView;
    DispDefault: TMenuItem;
    DispHex: TMenuItem;
    DispBin: TMenuItem;
    DispOct: TMenuItem;
    DispDec: TMenuItem;
    DispRaw: TMenuItem;
    n3: TMenuItem;
    popOld: TMenuItem;
    popRaw: TMenuItem;
    popSingle: TMenuItem;
    popInt64: TMenuItem;
    N2: TMenuItem;
    popDouble: TMenuItem;
    popWord: TMenuItem;
    popDWord: TMenuItem;
    popInt8: TMenuItem;
    popInt16: TMenuItem;
    popInt32: TMenuItem;
    popQWord: TMenuItem;
    N1: TMenuItem;
    popByte: TMenuItem;
    PopDispDefault: TMenuItem;
    PopDispHex: TMenuItem;
    PopDispBin: TMenuItem;
    PopDispOct: TMenuItem;
    PopDispDec: TMenuItem;
    PopDispRaw: TMenuItem;
    popCopyValue: TMenuItem;
    popCopyName: TMenuItem;
    popFormat: TMenuItem;
    popL1: TMenuItem;
    PopupDispType: TPopupMenu;
    PopupMenu1: TPopupMenu;
    PopupMenu2: TPopupMenu;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButtonVector: TToolButton;
    ToolButtonDispType: TToolButton;
    ToolButtonPower: TToolButton;
    procedure actCopyNameExecute(Sender: TObject);
    procedure actCopyValueExecute(Sender: TObject);
    procedure actPowerExecute(Sender: TObject);
    procedure DispDefaultClick(Sender: TObject);
    procedure lvRegistersSelectItem(Sender: TObject; Item: TListItem; {%H-}Selected: Boolean);
    procedure ToolButtonDispTypeClick(Sender: TObject);
    function GetCurrentRegisters: TRegisters;
    // new >
    procedure SetVectorDisplay(Sender :TObject);
    procedure ToolButtonVectorClick(Sender: TObject);
    // end new
  private
    FNeedUpdateAgain: Boolean;
    FPowerImgIdx, FPowerImgIdxGrey: Integer;
    procedure RegistersChanged(Sender: TObject);
  protected
    procedure DoRegistersChanged; override;
    procedure DoBeginUpdate; override;
    procedure DoEndUpdate; override;
    function  ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
    procedure ColSizeSetter(AColId: Integer; ASize: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property RegistersMonitor;
    property ThreadsMonitor;
    property CallStackMonitor;
    //property SnapshotManager;
  end;


implementation
{$R *.lfm}

//  >> new
type
  Char2 = array[0..1] of Char;  // Byte
  Char4 = array[0..3] of Char;  // Word
  Char8 = array[0..7] of Char;  // Dword
  Char16 = array[0..15] of Char; // QWord

  T128Rec = packed record
    case Integer of
      0: (str  :array[1..32] of Char);
      1: (str8 :array[1..2]  of Char16);
      2: (str4 :array[1..4]  of Char8);
      3: (str2 :array[1..8]  of Char4);
      4: (str1 :array[1..16] of Char2);
  end;

  T256Rec = packed record
    case Integer of
      0: (str  :array[1..64] of Char);
      1: (str8 :array[1..4]  of Char16);
      2: (str4 :array[1..8]  of Char8);
      3: (str2 :array[1..16] of Char4);
      4: (str1 :array[1..32] of Char2);
  end;

  T512Rec = packed record
    case Integer of
      0: (str  :array[1..128] of Char);
      1: (str8 :array[1..8]  of Char16);
      2: (str4 :array[1..16] of Char8);
      3: (str2 :array[1..32] of Char4);
      4: (str1 :array[1..64] of Char2);
  end;
// < end new

var
  RegisterDlgWindowCreator: TIDEWindowCreator;

const
  COL_REGISTER_NAME   = 1;
  COL_REGISTER_VALUE  = 2;
  COL_WIDTHS: Array[0..1] of integer = ( 150, 50);

// >> new
{copy from fpc with changed}
procedure HexToByte(HexValue :Pchar; ByteValue: pByte; BinBufSize: Integer);
  // more complex, have to accept more than bintohex
  // A..F    1000001
  // a..f    1100001
  // 0..9     110000

  var i,j,h,l : integer;

  begin
    i:=binbufsize;
    while (i>0) do
      begin
      if hexvalue^ IN ['A'..'F','a'..'f'] then
        h:=((ord(hexvalue^)+9) and 15)
      else if hexvalue^ IN ['0'..'9'] then
        h:=((ord(hexvalue^)) and 15)
      else
        break;
      inc(hexvalue);
      if hexvalue^ IN ['A'..'F','a'..'f'] then
        l:=(ord(hexvalue^)+9) and 15
      else if hexvalue^ IN ['0'..'9'] then
        l:=(ord(hexvalue^)) and 15
      else
        break;
      j := l + (h shl 4);
      inc(hexvalue);
      byteValue^:=Byte(j);
      dec(Bytevalue);
      dec(i);
      end;
  end;

{Set the default display for all SSE,VEX or EVEX register value}
procedure TRegistersDlg.SetVectorDisplay(Sender :TObject);
 var
   Item   :TListItem;
   s      :string;
   ss     :string;
   sse    :T128Rec;
   vex    :T256Rec;
   evex   :T512Rec;
   i,j,k  :Integer;
   k2,err :Integer;
   b      :Byte;
   w      :Word;
   dw     :Longword;
   qw     :QWord;
   i8     :Shortint;
   i16    :Smallint;
   i32    :Longint;
   i64    :Int64;
   Format :TFormatSettings;
   sa     :array[0..3] of Byte;
   sd     :array[0..7] of Byte;
   pa     :pByte;
   p      :Pchar;
   Reg    :TRegisters;
   max,run:Integer;
   Flag   :Byte;

   function IntToByte(value :Byte):string;
   begin
     System.Str(Value,result);
   end;
   function IntToShort(value :Shortint):string;
   begin
     System.Str(Value,result);
   end;
   function IntToWord(value :Word):string;
   begin
     System.Str(Value,result);
   end;
   function IntToSmall(value :Smallint):string;
   begin
     System.Str(Value,result);
   end;
   function IntToDWord(value :DWord):string;
   begin
     System.Str(Value,result);
   end;

begin
  // string muss mit x or X or $ beginnen für Val

  if ToolButtonVector.Caption = 'Vector Register' then
    // no changes start value
    Exit;

  Format := DefaultFormatSettings;
  Format.DecimalSeparator := '.';

  BeginUpdate;
  try
  Reg := GetCurrentRegisters;
  for i := 0 to lvRegisters.Items.Count - 1 do begin
    Item := lvRegisters.Items[i];
    s := Item.Caption;
    s := UpperCase(s);
 {--------------------------------OLD-------------------------------------}
    if ToolButtonVector.Caption = 'OldVec' then begin
      // give the orignal display
      if (Pos('XMM',s) <> 0) or
         (Pos('YMM',s) <> 0) or
         (Pos('ZMM',s) <> 0) then begin
        if Reg <> nil then begin
          Reg[i].DisplayFormat := rdDefault;
          Item.SubItems[0] := Reg[i].Value;
        end;
      end;
      Continue;
    end;
    if (Pos('XMM',s) <> 0) then begin
      Flag := 1;
      max  := 16;     // max run variable for bytes
      if Reg <> nil then begin
        Reg[i].DisplayFormat := rdRaw;
        Item.SubItems[0] := Reg[i].Value;
       end
      else
        Exit;
    end;
    if Pos('YMM',s) <> 0 then begin
      Flag := 2;
      max  := 32;
      if Reg <> nil then begin
        Reg[i].DisplayFormat := rdRaw;
        Item.SubItems[0] := Reg[i].Value;
       end
      else
        Exit;
    end;
    if Pos('ZMM',s) <> 0 then begin
      Flag := 3;
      max  := 64;
      if Reg <> nil then begin
          Reg[i].DisplayFormat := rdRaw;
          Item.SubItems[0] := Reg[i].Value;
       end
      else
        Exit;
    end;
    case Flag of
     1..3: begin
      ss := UpperCase(Item.SubItems[0]);
      k2 := Pos('0X',ss);
      if k2 = 0 then
        k := Pos('$',ss);
      if k = 0 then
        k := Pos('X',ss);
      if k2 <> 0 then
        Delete(ss,k2,2);
      if k <> 0 then
        Delete(ss,k,1);
      // set the Txxxrec
      case Flag of
       1: sse.str  := ss;
       2: vex.str  := ss;
       3: evex.str := ss;
      else
        raise EConvertError.Create('undefined vector');
      end;
 {--------------------------------RAW----------------------------------------}
        if ToolButtonVector.Caption = 'RAW' then begin
          case Flag of
            1:  s := sse.str;
            2:  s := vex.str;
            3:  s := evex.str;
           else
            raise EConvertError.Create('undefined vector');
          end;
          Continue;
        end;

        s := '';
        s := '{';
 {--------------------unsigned Integer-----------------------------------}

        if ToolButtonVector.caption = 'Byte' then begin
          for j := 1 to max do begin
            ss := '0x';
            case Flag of
             1:  ss := ss + sse.str1[j];
             2:  ss := ss + vex.str1[j];
             3:  ss := ss + evex.str1[j];
            else
              raise EConvertError.Create('undefined vector');
            end;
            Val(ss,b,err);         // err is not relevant in display
            s := s + IntToByte(b);
            if j < max then
              s := s + ',';
          end;
        end;
        if ToolButtonVector.Caption = 'Word' then begin
          run := max shr 1;
          for j := 1 to run do begin
            ss := '0x';
            case Flag of
             1:  ss := ss + sse.str2[j];
             2:  ss := ss + vex.str2[j];
             3:  ss := ss + evex.str2[j];
            else
              raise EConvertError.Create('undefined vector');
            end;
            Val(ss,w,err);
            s := s + IntToWord(w);
            if j < run then
              s := s + ',';
          end;
        end;
        if ToolButtonVector.Caption = 'DWord' then begin
          run := max shr 2;
          for j := 1 to run do begin
            ss := '0x';
            case Flag of
             1:  ss := ss + sse.str4[j];
             2:  ss := ss + vex.str4[j];
             3:  ss := ss + evex.str4[j];
            else
              raise EConvertError.Create('undefined vector');
            end;
            Val(ss,dw,err);
            s := s + IntToDWord(dw);
            if j < run then
              s := s + ',';
          end;
        end;
        if ToolButtonVector.Caption = 'QWord' then begin
          run := max shr 3;
          for j := 1 to run do begin
            ss := '0x';
            case Flag of
             1:  ss := ss + sse.str8[j];
             2:  ss := ss + vex.str8[j];
             3:  ss := ss + evex.str8[j];
            else
              raise EConvertError.Create('undefined vector');
            end;
            Val(ss,qw,err);
            s := s + IntToStr(qw);
            if j < max then
              s := s + ',';
          end;
        end;
{-----------------------signed Integer-------------------------------------}
        if ToolButtonVector.Caption = 'Int8' then begin
          for j := 1 to max do begin
            ss := '0x';
            case Flag of
             1:  ss := ss + sse.str1[j];
             2:  ss := ss + vex.str1[j];
             3:  ss := ss + evex.str1[j];
            else
              raise EConvertError.Create('undefined vector');
            end;
            Val(ss,i8,err);
            s := s + IntToShort(i8);
            if j < max then
              s := s + ',';
          end;
        end;
        if ToolButtonVector.Caption = 'Int16' then begin
          run := max shr 1;
          for j := 1 to run do begin
            ss := '0x';
            case Flag of
             1:  ss := ss + sse.str2[j];
             2:  ss := ss + vex.str2[j];
             3:  ss := ss + evex.str2[j];
            else
              raise EConvertError.Create('undefined vector');
            end;
            Val(ss,i16,err);
            s := s + IntToSmall(i16);
            if j < run then
            s := s + ',';
          end;
        end;
        if ToolButtonVector.Caption = 'Int32' then begin
          run := max shr 2;
          for j := 1 to run do begin
            ss := '0x';
            case Flag of
             1:  ss := ss + sse.str4[j];
             2:  ss := ss + vex.str4[j];
             3:  ss := ss + evex.str4[j];
            else
              raise EConvertError.Create('undefined vector');
            end;
            Val(ss,i32,err);
            s := s + IntToStr(i32);
            if j < run then
              s := s + ',';
          end;
        end;
        if ToolButtonVector.Caption = 'Int64' then begin
          run := max shr 3;
          for j := 1 to run do begin
            ss := '0x';
            case Flag of
             1:  ss := ss + sse.str8[j];
             2:  ss := ss + vex.str8[j];
             3:  ss := ss + evex.str8[j];
            else
              raise EConvertError.Create('undefined vector');
            end;
            Val(ss,i64,err);
            s := s + IntToStr(i64);
            if j < run then
              s := s + ',';
          end;
        end;

 {--------------------------float--------------------------------------}

        if ToolButtonVector.Caption = 'Single' then begin
          run := max shr 2;
          for j := 1 to run do begin
            case Flag of
             1:  p := PChar(sse.str4[j]);
             2:  p := PChar(vex.str4[j]);
             3:  p := PChar(evex.str4[j]);
            else
              raise EConvertError.Create('undefined vector');
            end;
            pa := @sa;
            pa := pa + 3; // at the end of the array
            HexToByte(p,pa,8);
            s := s + FloatToStrF(Single(sa),ffExponent,9,2,Format);
            if j < run then
              s := s + ',';
          end;
        end;
        if ToolButtonVector.Caption = 'Double' then begin
          run := max shr 3;
          for j := 1 to run do begin
            case Flag of
             1:  p := PChar(sse.str8[j]);
             2:  p := PChar(vex.str8[j]);
             3:  p := PChar(evex.str8[j]);
            else
              raise EConvertError.Create('undefined vector');
            end;
            pa := @sd;
            pa := pa + 7;  // dito
            HexToByte(p,pa,16);
            s := s + FloatToStrF(Double(sd),ffExponent,18,3,Format);
            if j < run then
              s := s + ',';
          end;
        end;

        s := s + '}';
       Item.SubItems[0] := s;
      end; // Flag of case
    end; // case
  end; // for

  finally
   EndUpdate;
  end;
  if ToolButtonVector.Caption = 'OLD' then
    RegistersChanged(nil);

end;

{For Vector registers ToolButton}
procedure TRegistersDlg.ToolButtonVectorClick(Sender: TObject);
 var
   j :Integer;

begin
  with (Sender as TMenuItem) do begin
    case Tag of
      11..22 :
        begin
          for j := 0 to PopupMenu2.Items.Count - 1 do
            PopUpMenu2.Items.Items[j].Checked := False;
          Checked := True;
          ToolButtonVector.Caption := Caption;
          SetVectorDisplay(self);
        end;
    end;
  end;
end;
// << end new

function RegisterDlgColSizeGetter(AForm: TCustomForm; AColId: Integer; var ASize: Integer): Boolean;
begin
  Result := AForm is TRegistersDlg;
  if Result then
    Result := TRegistersDlg(AForm).ColSizeGetter(AColId, ASize);
end;

procedure RegisterDlgColSizeSetter(AForm: TCustomForm; AColId: Integer; ASize: Integer);
begin
  if AForm is TRegistersDlg then
    TRegistersDlg(AForm).ColSizeSetter(AColId, ASize);
end;

{ TRegistersDlg }

constructor TRegistersDlg.Create(AOwner: TComponent);
var
  i: Integer;
begin
  inherited Create(AOwner);
  ThreadsNotification.OnCurrent   := @RegistersChanged;
  CallstackNotification.OnCurrent := @RegistersChanged;
  RegistersNotification.OnChange  := @RegistersChanged;

  Caption:= lisRegisters;
  lvRegisters.Columns[0].Caption:= lisName;
  lvRegisters.Columns[1].Caption:= lisValue;

  ActionList1.Images := IDEImages.Images_16;
  ToolBar1.Images := IDEImages.Images_16;

  FPowerImgIdx := IDEImages.LoadImage('debugger_power');
  FPowerImgIdxGrey := IDEImages.LoadImage('debugger_power_grey');
  actPower.ImageIndex := FPowerImgIdx;
  //actPower.Caption := lisDbgWinPower;
  actPower.Hint := lisDbgWinPowerHint;

  actCopyName.Caption := lisLocalsDlgCopyName;
  actCopyValue.Caption := lisLocalsDlgCopyValue;

  ToolButtonDispType.Hint := regdlgDisplayTypeForSelectedRegisters;

  DispDefault.Caption := dlgPasStringKeywordsOptDefault;
  DispHex.Caption := regdlgHex;
  DispBin.Caption := regdlgBinary;
  DispOct.Caption := regdlgOctal;
  DispDec.Caption := regdlgDecimal;
  DispRaw.Caption := regdlgRaw;
  DispDefault.Tag := ord(rdDefault);
  DispHex.Tag := ord(rdHex);
  DispBin.Tag := ord(rdBinary);
  DispOct.Tag := ord(rdOctal);
  DispDec.Tag := ord(rdDecimal);
  DispRaw.Tag := ord(rdRaw);

  PopDispDefault.Caption := dlgPasStringKeywordsOptDefault;
  PopDispHex.Caption := regdlgHex;
  PopDispBin.Caption := regdlgBinary;
  PopDispOct.Caption := regdlgOctal;
  PopDispDec.Caption := regdlgDecimal;
  PopDispRaw.Caption := regdlgRaw;
  PopDispDefault.Tag := ord(rdDefault);
  PopDispHex.Tag := ord(rdHex);
  PopDispBin.Tag := ord(rdBinary);
  PopDispOct.Tag := ord(rdOctal);
  PopDispDec.Tag := ord(rdDecimal);
  PopDispRaw.Tag := ord(rdRaw);

  popFormat.Caption := regdlgFormat;

  actCopyName.Caption := lisLocalsDlgCopyName;
  actCopyValue.Caption := lisLocalsDlgCopyValue;

  for i := low(COL_WIDTHS) to high(COL_WIDTHS) do
    lvRegisters.Column[i].Width := COL_WIDTHS[i];
end;

destructor TRegistersDlg.Destroy;
begin
  inherited Destroy;
end;

procedure TRegistersDlg.actPowerExecute(Sender: TObject);
begin
  if ToolButtonPower.Down
  then begin
    actPower.ImageIndex := FPowerImgIdx;
    ToolButtonPower.ImageIndex := FPowerImgIdx;
    RegistersChanged(nil);
  end
  else begin
    actPower.ImageIndex := FPowerImgIdxGrey;
    ToolButtonPower.ImageIndex := FPowerImgIdxGrey;
  end;
end;

procedure TRegistersDlg.actCopyNameExecute(Sender: TObject);
begin
  Clipboard.Open;
  Clipboard.AsText := lvRegisters.Selected.Caption;
  Clipboard.Close;
end;

procedure TRegistersDlg.actCopyValueExecute(Sender: TObject);
begin
  Clipboard.Open;
  Clipboard.AsText := lvRegisters.Selected.SubItems[0];
  Clipboard.Close;
end;

{From Toolbutton Display click (Format change)}
procedure TRegistersDlg.DispDefaultClick(Sender: TObject);
var
  n: Integer;
  Item: TListItem;
  Reg: TRegisters;
  RegVal: TRegisterValue;

begin
  ToolButtonPower.Down := True;
  Reg := GetCurrentRegisters;
  if Reg = nil then exit;

  for n := 0 to lvRegisters.Items.Count -1 do
  begin
    Item := lvRegisters.Items[n];
    if Item.Selected then begin
      if Pos('xmm',Item.Caption) <> 0 then
        Continue;  // select for display change deaktiv
      RegVal := Reg.EntriesByName[Item.Caption];
      if RegVal <> nil then
        RegVal.DisplayFormat := TRegisterDisplayFormat(TMenuItem(Sender).Tag);
    end;
  end;
  lvRegistersSelectItem(nil, nil, True);
end;

procedure TRegistersDlg.lvRegistersSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
var
  n, j: Integer;
  SelFormat: TRegisterDisplayFormat;
  MultiFormat: Boolean;
  Reg: TRegisters;
  RegVal: TRegisterValue;
begin
  j := 0;
  MultiFormat := False;
  SelFormat := rdDefault;
  Reg := GetCurrentRegisters;
  if Reg = nil then exit;

  for n := 0 to lvRegisters.Items.Count -1 do begin
    Item := lvRegisters.Items[n];
    if Item.Selected then begin
      if Pos('xmm',Item.Caption) <> 0 then
        Continue; // auswahl deaktiv
      RegVal := Reg.EntriesByName[Item.Caption];
      if RegVal <> nil then begin
        if j = 0 then
          SelFormat := RegVal.DisplayFormat;
        inc(j);
        if SelFormat <> RegVal.DisplayFormat then begin
          MultiFormat := True;
          break;
        end;
      end;
    end;
  end;
  ToolButtonDispType.Enabled := j > 0;
  popFormat.Enabled := j > 0;
  actCopyName.Enabled := j > 0;
  actCopyValue.Enabled := j > 0;

  PopDispDefault.Checked := False;
  PopDispHex.Checked := False;
  PopDispBin.Checked := False;
  PopDispOct.Checked := False;
  PopDispDec.Checked := False;
  PopDispRaw.Checked := False;
  if MultiFormat then
    ToolButtonDispType.Caption := '...'
  else begin
    case SelFormat of
      rdDefault: begin
          ToolButtonDispType.Caption := DispDefault.Caption;
          PopDispDefault.Checked := True;
        end;
      rdHex:     begin
          ToolButtonDispType.Caption := DispHex.Caption;
          PopDispHex.Checked := True;
        end;
      rdBinary:  begin
          ToolButtonDispType.Caption := DispBin.Caption;
          PopDispBin.Checked := True;
        end;
      rdOctal:   begin
          ToolButtonDispType.Caption := DispOct.Caption;
          PopDispOct.Checked := True;
        end;
      rdDecimal: begin
          ToolButtonDispType.Caption := DispDec.Caption;
          PopDispDec.Checked := True;
        end;
      rdRaw:     begin
          ToolButtonDispType.Caption := DispRaw.Caption;
          PopDispRaw.Checked := True;
        end;
    end;
  end;
end;

procedure TRegistersDlg.ToolButtonDispTypeClick(Sender: TObject);
begin
  ToolButtonDispType.CheckMenuDropdown;
end;

function TRegistersDlg.GetCurrentRegisters: TRegisters;
var
  CurThreadId, CurStackFrame: Integer;
begin
  Result := nil;
  if (ThreadsMonitor = nil) or
     (ThreadsMonitor.CurrentThreads = nil) or
     (CallStackMonitor = nil) or
     (CallStackMonitor.CurrentCallStackList = nil) or
     (RegistersMonitor = nil)
  then
    exit;

  CurThreadId := ThreadsMonitor.CurrentThreads.CurrentThreadId;
  if (CallStackMonitor.CurrentCallStackList.EntriesForThreads[CurThreadId] = nil) then
    exit;

  CurStackFrame := CallStackMonitor.CurrentCallStackList.EntriesForThreads[CurThreadId].CurrentIndex;
  Result := RegistersMonitor.CurrentRegistersList[CurThreadId, CurStackFrame];
end;

procedure TRegistersDlg.RegistersChanged(Sender: TObject);
var
  n, idx, Cnt: Integer;
  List: TStringList;
  Item: TListItem;
  S: String;
  Reg: TRegisters;

begin
  if (not ToolButtonPower.Down) then exit;

  if IsUpdating then begin
    FNeedUpdateAgain := True;
    exit;
  end;
  FNeedUpdateAgain := False;

  BeginUpdate;
  try
    Reg := GetCurrentRegisters;
    if (Reg = nil) or (reg.DataValidity<> ddsValid) then begin
      if (DebugBoss = nil) or not (DebugBoss.State in [dsPause, dsInternalPause, dsRun]) then
        lvRegisters.Items.Clear;

      if (reg <> nil) then
        reg.Count;
      for n := 0 to lvRegisters.Items.Count - 1 do
        lvRegisters.Items[n].SubItems[0] := '<Unavailable>';
      exit;
    end;

    List := TStringList.Create;
    try
      //Get existing items
      for n := 0 to lvRegisters.Items.Count - 1 do begin
        Item := lvRegisters.Items[n];
        S := Item.Caption;
        S := UpperCase(S);
        List.AddObject(S, Item);
      end;

      // add/update entries
      Cnt := Reg.Count;          // Count may trigger changes
      FNeedUpdateAgain := False; // changes after this point, and we must update again

      for n := 0 to Cnt - 1 do begin
        idx := List.IndexOf(Uppercase(Reg[n].Name));
        if idx = -1 then begin
          // New entry
          Item := lvRegisters.Items.Add;
          Item.Caption := Reg[n].Name;
          Item.SubItems.Add(Reg[n].Value);
         end  // idx
        else begin
          // Existing entry
          Item := TListItem(List.Objects[idx]);
          Item.SubItems[0] := Reg[n].Value;
          List.Delete(idx);
        end;
        if Reg[n].Modified then
          Item.ImageIndex := 0
        else
          Item.ImageIndex := -1;
      end;

      // remove obsolete entries
      for n := 0 to List.Count - 1 do
        lvRegisters.Items.Delete(TListItem(List.Objects[n]).Index);

    finally
      List.Free;
    end;
  finally
    EndUpdate;
  end;

  SetVectorDisplay(self);
  lvRegistersSelectItem(nil, nil, True);
end;

procedure TRegistersDlg.DoRegistersChanged;
begin
  RegistersChanged(nil);
end;

procedure TRegistersDlg.DoBeginUpdate;
begin
  lvRegisters.BeginUpdate;
end;

procedure TRegistersDlg.DoEndUpdate;
begin
  lvRegisters.EndUpdate;
  if FNeedUpdateAgain then RegistersChanged(nil);
end;

function TRegistersDlg.ColSizeGetter(AColId: Integer; var ASize: Integer): Boolean;
begin
  if (AColId - 1 >= 0) and (AColId - 1 < lvRegisters.ColumnCount) then begin
    ASize := lvRegisters.Column[AColId - 1].Width;
    Result := ASize <> COL_WIDTHS[AColId - 1];
  end
  else
    Result := False;
end;

procedure TRegistersDlg.ColSizeSetter(AColId: Integer; ASize: Integer);
begin
  case AColId of
    COL_REGISTER_NAME:   lvRegisters.Column[0].Width := ASize;
    COL_REGISTER_VALUE:  lvRegisters.Column[1].Width := ASize;
  end;
end;

initialization

  RegisterDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtRegisters]);
  RegisterDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog;
  RegisterDlgWindowCreator.OnSetDividerSize := @RegisterDlgColSizeSetter;
  RegisterDlgWindowCreator.OnGetDividerSize := @RegisterDlgColSizeGetter;
  RegisterDlgWindowCreator.DividerTemplate.Add('RegisterName',  COL_REGISTER_NAME,  @drsColWidthName);
  RegisterDlgWindowCreator.DividerTemplate.Add('RegisterValue', COL_REGISTER_VALUE, @drsColWidthValue);
  RegisterDlgWindowCreator.CreateSimpleLayout;

end.
upload.txt (28,745 bytes)   

Klaus1

2020-09-28 22:20

reporter   ~0125944

Hallo Martin,
may changes only work in Laz 2.02. Ineed from debugger the RAW value. In Laz 2.10 is not RAW output.
Normal it is posible the debugger setup. Here no debugger setup for corrct debugging. I think here is a debugger display needed.
Regards Klaus

Issue History

Date Modified Username Field Change
2020-09-22 18:14 Klaus1 New Issue
2020-09-22 18:14 Klaus1 Status new => assigned
2020-09-22 18:14 Klaus1 Assigned To => Martin Friebe
2020-09-22 21:12 Martin Friebe Note Added: 0125761
2020-09-23 23:15 Martin Friebe Status assigned => resolved
2020-09-23 23:15 Martin Friebe Resolution open => fixed
2020-09-23 23:15 Martin Friebe Fixed in Version => 2.2
2020-09-23 23:15 Martin Friebe Fixed in Revision => 63914
2020-09-23 23:15 Martin Friebe LazTarget => 2.2
2020-09-23 23:15 Martin Friebe Widgetset Win32/Win64 => Win32/Win64
2020-09-23 23:15 Martin Friebe Note Added: 0125799
2020-09-28 16:37 Klaus1 Note Added: 0125928
2020-09-28 16:37 Klaus1 File Added: upload.txt
2020-09-28 22:20 Klaus1 Note Added: 0125944