Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Fixes for 64bit Windows and Delphi 10.2/10.3 #44

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
Open

Fixes for 64bit Windows and Delphi 10.2/10.3 #44

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
1733b34
-changed procedure GDIError to use Length instead of SizeOf so it wor…
Feb 1, 2019
d9c7027
-fixed JclDebug to work correctly when 64bit system has more than 4GB…
Feb 1, 2019
370cc0b
-fixed to work correctly in Delphi 10.2/10.3
Feb 1, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions jcl/experts/debug/converter/JclDebugIdeImpl.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -605,6 +605,9 @@ procedure TJclDebugExtension.DisplayResults;
begin
if FBuildError or (Length(FResultInfo) = 0) then
Exit;
if Assigned(Settings) and (Settings.LoadBool(JclDebugQuietSetting, false)) then
Exit;

with TJclDebugResultForm.Create(Application, Settings) do
try
for I := 0 to Length(FResultInfo) - 1 do
Expand Down
2 changes: 1 addition & 1 deletion jcl/experts/debug/converter/JclDebugIdeResult.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@ interface
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
JclOtaUtils;
JclOtaUtils{$IFDEF HAS_UNITSCOPE}, System.ImageList{$ENDIF};

type
TJclDebugResultForm = class(TForm)
Expand Down
2 changes: 1 addition & 1 deletion jcl/source/vcl/JclGraphUtils.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -380,7 +380,7 @@ procedure GDIError;
begin
ErrorCode := GetLastError;
if (ErrorCode <> 0) and (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil,
ErrorCode, LOCALE_USER_DEFAULT, Buf, SizeOf(Buf), nil) <> 0) then
ErrorCode, LOCALE_USER_DEFAULT, Buf, Length(Buf), nil) <> 0) then
raise EOutOfResources.Create(Buf)
else
OutOfResources;
Expand Down
113 changes: 57 additions & 56 deletions jcl/source/windows/JclDebug.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -199,9 +199,9 @@ TJclMapStringCache = record
PJclMapSegmentClass = ^TJclMapSegmentClass;
TJclMapSegmentClass = record
Segment: Word; // segment ID
Start: DWORD; // start as in the map file
Addr: DWORD; // start as in process memory
VA: DWORD; // position relative to module base adress
Start: TJclAddr; // start as in the map file
Addr: TJclAddr; // start as in process memory
VA: TJclAddr; // position relative to module base adress
Len: DWORD; // segment length
SectionName: TJclMapStringCache;
GroupName: TJclMapStringCache;
Expand All @@ -210,22 +210,22 @@ TJclMapSegmentClass = record
PJclMapSegment = ^TJclMapSegment;
TJclMapSegment = record
Segment: Word;
StartVA: DWORD; // VA relative to (module base address + $10000)
EndVA: DWORD;
StartVA: TJclAddr; // VA relative to (module base address + $10000)
EndVA: TJclAddr;
UnitName: TJclMapStringCache;
end;

PJclMapProcName = ^TJclMapProcName;
TJclMapProcName = record
Segment: Word;
VA: DWORD; // VA relative to (module base address + $10000)
VA: TJclAddr; // VA relative to (module base address + $10000)
ProcName: TJclMapStringCache;
end;

PJclMapLineNumber = ^TJclMapLineNumber;
TJclMapLineNumber = record
Segment: Word;
VA: DWORD; // VA relative to (module base address + $10000)
VA: TJclAddr; // VA relative to (module base address + $10000)
LineNumber: Integer;
UnitName: PJclMapString;
end;
Expand All @@ -244,9 +244,9 @@ TJclMapScanner = class(TJclAbstractMapParser)
FProcNamesCnt: Integer;
FSegmentCnt: Integer;
FLastAccessedSegementIndex: Integer;
function IndexOfSegment(Addr: DWORD): Integer;
function IndexOfSegment(Addr: TJclAddr): Integer;
protected
function MAPAddrToVA(const Addr: DWORD): DWORD;
function MAPAddrToVA(const Addr: TJclAddr): TJclAddr;
procedure ClassTableItem(const Address: TJclMapAddress; Len: Integer; SectionName, GroupName: PJclMapString); override;
procedure SegmentItem(const Address: TJclMapAddress; Len: Integer; GroupName, UnitName: PJclMapString); override;
function CanHandlePublicsByName: Boolean; override;
Expand All @@ -265,13 +265,13 @@ TJclMapScanner = class(TJclAbstractMapParser)
class function MapStringCacheToStr(var MapString: TJclMapStringCache; IgnoreSpaces: Boolean = False): string;

// Addr are virtual addresses relative to (module base address + $10000)
function LineNumberFromAddr(Addr: DWORD): Integer; overload;
function LineNumberFromAddr(Addr: DWORD; out Offset: Integer): Integer; overload;
function ModuleNameFromAddr(Addr: DWORD): string;
function ModuleStartFromAddr(Addr: DWORD): DWORD;
function ProcNameFromAddr(Addr: DWORD): string; overload;
function ProcNameFromAddr(Addr: DWORD; out Offset: Integer): string; overload;
function SourceNameFromAddr(Addr: DWORD): string;
function LineNumberFromAddr(Addr: TJclAddr): Integer; overload;
function LineNumberFromAddr(Addr: TJclAddr; out Offset: Integer): Integer; overload;
function ModuleNameFromAddr(Addr: TJclAddr): string;
function ModuleStartFromAddr(Addr: TJclAddr): TJclAddr;
function ProcNameFromAddr(Addr: TJclAddr): string; overload;
function ProcNameFromAddr(Addr: TJclAddr; out Offset: Integer): string; overload;
function SourceNameFromAddr(Addr: TJclAddr): string;
property LineNumberErrors: Integer read FLineNumberErrors;
property LineNumbersCnt: Integer read FLineNumbersCnt;
property LineNumberByIndex[Index: Integer]: TJclMapLineNumber read GetLineNumberByIndex;
Expand Down Expand Up @@ -306,7 +306,7 @@ TJclBinDebugGenerator = class(TJclMapScanner)
end;

TJclBinDbgNameCache = record
Addr: DWORD;
Addr: TJclAddr;
FirstWord: Integer;
SecondWord: Integer;
end;
Expand All @@ -323,19 +323,19 @@ TJclBinDebugScanner = class(TObject)
procedure CacheLineNumbers;
procedure CacheProcNames;
procedure CheckFormat;
function DataToStr(A: Integer): string;
function MakePtr(A: Integer): Pointer;
function DataToStr(A: TJclAddr): string;
function MakePtr(A: TJclAddr): Pointer;
function ReadValue(var P: Pointer; var Value: Integer): Boolean;
public
constructor Create(AStream: TCustomMemoryStream; CacheData: Boolean);
function IsModuleNameValid(const Name: TFileName): Boolean;
function LineNumberFromAddr(Addr: DWORD): Integer; overload;
function LineNumberFromAddr(Addr: DWORD; out Offset: Integer): Integer; overload;
function ProcNameFromAddr(Addr: DWORD): string; overload;
function ProcNameFromAddr(Addr: DWORD; out Offset: Integer): string; overload;
function ModuleNameFromAddr(Addr: DWORD): string;
function ModuleStartFromAddr(Addr: DWORD): DWORD;
function SourceNameFromAddr(Addr: DWORD): string;
function LineNumberFromAddr(Addr: TJclAddr): Integer; overload;
function LineNumberFromAddr(Addr: TJclAddr; out Offset: Integer): Integer; overload;
function ProcNameFromAddr(Addr: TJclAddr): string; overload;
function ProcNameFromAddr(Addr: TJclAddr; out Offset: Integer): string; overload;
function ModuleNameFromAddr(Addr: TJclAddr): string;
function ModuleStartFromAddr(Addr: TJclAddr): TJclAddr;
function SourceNameFromAddr(Addr: TJclAddr): string;
property ModuleName: string read GetModuleName;
property ValidFormat: Boolean read FValidFormat;
end;
Expand Down Expand Up @@ -472,7 +472,7 @@ TJclDebugInfoSource = class(TObject)
FModule: HMODULE;
function GetFileName: TFileName;
protected
function VAFromAddr(const Addr: Pointer): DWORD; virtual;
function VAFromAddr(const Addr: Pointer): TJclAddr; virtual;
public
constructor Create(AModule: HMODULE); virtual;
function InitializeSource: Boolean; virtual; abstract;
Expand Down Expand Up @@ -1817,7 +1817,7 @@ constructor TJclMapScanner.Create(const MapFileName: TFileName; Module: HMODULE)
Scan;
end;

function TJclMapScanner.MAPAddrToVA(const Addr: DWORD): DWORD;
function TJclMapScanner.MAPAddrToVA(const Addr: TJclAddr): TJclAddr;
begin
// MAP file format was changed in Delphi 2005
// before Delphi 2005: segments started at offset 0
Expand Down Expand Up @@ -1908,7 +1908,7 @@ procedure TJclMapScanner.ClassTableItem(const Address: TJclMapAddress; Len: Inte
end;
end;

function TJclMapScanner.LineNumberFromAddr(Addr: DWORD): Integer;
function TJclMapScanner.LineNumberFromAddr(Addr: TJclAddr): Integer;
var
Dummy: Integer;
begin
Expand All @@ -1920,10 +1920,10 @@ function Search_MapLineNumber(Item1, Item2: Pointer): Integer;
Result := Integer(PJclMapLineNumber(Item1)^.VA) - PInteger(Item2)^;
end;

function TJclMapScanner.LineNumberFromAddr(Addr: DWORD; out Offset: Integer): Integer;
function TJclMapScanner.LineNumberFromAddr(Addr: TJclAddr; out Offset: Integer): Integer;
var
I: Integer;
ModuleStartAddr: DWORD;
ModuleStartAddr: TJclAddr;
begin
ModuleStartAddr := ModuleStartFromAddr(Addr);
Result := 0;
Expand Down Expand Up @@ -1997,7 +1997,7 @@ function TJclMapScanner.GetLineNumberByIndex(Index: Integer): TJCLMapLineNumber;
Result := FLineNumbers[Index];
end;

function TJclMapScanner.IndexOfSegment(Addr: DWORD): Integer;
function TJclMapScanner.IndexOfSegment(Addr: TJclAddr): Integer;
var
L, R: Integer;
S: PJclMapSegment;
Expand Down Expand Up @@ -2032,7 +2032,7 @@ function TJclMapScanner.IndexOfSegment(Addr: DWORD): Integer;
Result := -1;
end;

function TJclMapScanner.ModuleNameFromAddr(Addr: DWORD): string;
function TJclMapScanner.ModuleNameFromAddr(Addr: TJclAddr): string;
var
I: Integer;
begin
Expand All @@ -2043,17 +2043,17 @@ function TJclMapScanner.ModuleNameFromAddr(Addr: DWORD): string;
Result := '';
end;

function TJclMapScanner.ModuleStartFromAddr(Addr: DWORD): DWORD;
function TJclMapScanner.ModuleStartFromAddr(Addr: TJclAddr): TJclAddr;
var
I: Integer;
begin
I := IndexOfSegment(Addr);
Result := DWORD(-1);
Result := High(TJclAddr);
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is this correct or should this be Low(TJclAddr)?

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Low(TJclAddr) SHOULD be 0 (as it is in 32bit and FPC mode) so High(TJclAddr) is correct but I seem to have missed a change in JclBase.pas.
Line:
TJclAddr64 = Int64;
should be replaced with.
TJclAddr64 = UInt64;

To support older Delphi maybe something like this would be better:
{$IF declared(UInt64)}
TJclAddr64 = UInt64;
{$ELSE}
TJclAddr64 = Int64;
{$ENDIF}
but I don't have the old Delphi to test this with.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

TJclAddr64 should not be changed to unsigned, it will break all memory operations that result in negative offsets which are valid right now.

Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hm, that sounds like a design fault, as memory addresses are never signed, can never be negative. Offsets can, however, so perhaps those memory operations should be updated to work with offsets? (And be annotated that offsets are signed, so can't be used to indicate absolute memory addresses.)

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Even if they could all be found inside the JCL, it would be impossible to find them in user's code and it is really hard to track down a bug resulting from signed/unsigned mixup.
So no, this will have to stay this way.
As to the original cast, I would simply keep the -1 and cast it to TJclAddr instead of DWORD.

Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Deprecated warnings can help spot the use of obsolete symbols in user-code. But I agree with the "no breaking changes" approach.

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

TJclAddr64 is already unsigned in FPC and TJclAddr32 is unsigned in 32 bit code. If 32 bit code already works with unsigned addresses then 64 bit code should too.
64 bit code definitely does not work with what is in JclDebug if you have more than 4GB RAM and code that I have committed has worked in production for over a year.
Even if you keep TJclAddr64 as signed, the rest of the code should still work for the next few decades until OS and hardware can hit the top of the 64 bit address space but what is there before this change does not work on most of the modern computers.
As far as splitting the commit, I don't think it's required, just use a decent difference viewer and the reason for each change becomes obvious.
Most of the changes in the commit were made to fix the 64 bit code which used Integer/DWORD to cast addresses and references. There were few bits were changes made fixed the Ansi to Unicode strings, mostly by changing SizeOf to Length.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Seems toe pull request is not 100% approved. There seem to be some things in it though, which are not disputed. Can they be put into a separate pull request? Or if they affect different topics maybe several pull requests?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

One of the commits contained in this pull request was singled out and pulled in now:
JclGraphUtils GDIError: replaced SizeOf by Length #53
another one as well where I put the first part of this part of this pull request here in:
370cc0b

Now to my point: I didn't (yet) create a pull request for the 2nd part of that one, as the Rio IDE constantly puts System.ImageList before the {$IFDEF HAS_UNITSCOPE} in the line this request wants to change and I also no not know why this unit is necessary, as ImgList is in the uses clause already. Means: I didn't fully understand what the requester wants to achieve with this change.

Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

About 64 memory addresses never reaching the sign-bit: that's not true. Consider top-down allocation for example, or random address executable location, or loading a 64 bit DLL with a fixed load address that has the sign bit set

if I <> -1 then
Result := FSegments[I].StartVA;
end;

function TJclMapScanner.ProcNameFromAddr(Addr: DWORD): string;
function TJclMapScanner.ProcNameFromAddr(Addr: TJclAddr): string;
var
Dummy: Integer;
begin
Expand All @@ -2065,10 +2065,10 @@ function Search_MapProcName(Item1, Item2: Pointer): Integer;
Result := Integer(PJclMapProcName(Item1)^.VA) - PInteger(Item2)^;
end;

function TJclMapScanner.ProcNameFromAddr(Addr: DWORD; out Offset: Integer): string;
function TJclMapScanner.ProcNameFromAddr(Addr: TJclAddr; out Offset: Integer): string;
var
I: Integer;
ModuleStartAddr: DWORD;
ModuleStartAddr: TJclAddr;
begin
ModuleStartAddr := ModuleStartFromAddr(Addr);
Result := '';
Expand All @@ -2093,6 +2093,7 @@ function TJclMapScanner.CanHandlePublicsByValue: Boolean;

procedure TJclMapScanner.PublicsByNameItem(const Address: TJclMapAddress; Name: PJclMapString);
begin
{ TODO : What to do? }
end;

procedure TJclMapScanner.PublicsByValueItem(const Address: TJclMapAddress; Name: PJclMapString);
Expand Down Expand Up @@ -2269,10 +2270,10 @@ procedure TJclMapScanner.SegmentItem(const Address: TJclMapAddress; Len: Integer
end;
end;

function TJclMapScanner.SourceNameFromAddr(Addr: DWORD): string;
function TJclMapScanner.SourceNameFromAddr(Addr: TJclAddr): string;
var
I: Integer;
ModuleStartVA: DWORD;
ModuleStartVA: TJclAddr;
begin
// try with line numbers first (Delphi compliance)
ModuleStartVA := ModuleStartFromAddr(Addr);
Expand Down Expand Up @@ -3163,7 +3164,7 @@ procedure TJclBinDebugScanner.CheckFormat;
{$OVERFLOWCHECKS ON}
{$ENDIF OVERFLOWCHECKS_ON}

function TJclBinDebugScanner.DataToStr(A: Integer): string;
function TJclBinDebugScanner.DataToStr(A: TJclAddr): string;
var
P: PAnsiChar;
begin
Expand All @@ -3186,18 +3187,18 @@ function TJclBinDebugScanner.IsModuleNameValid(const Name: TFileName): Boolean;
Result := AnsiSameText(ModuleName, PathExtractFileNameNoExt(Name));
end;

function TJclBinDebugScanner.LineNumberFromAddr(Addr: DWORD): Integer;
function TJclBinDebugScanner.LineNumberFromAddr(Addr: TJclAddr): Integer;
var
Dummy: Integer;
begin
Result := LineNumberFromAddr(Addr, Dummy);
end;

function TJclBinDebugScanner.LineNumberFromAddr(Addr: DWORD; out Offset: Integer): Integer;
function TJclBinDebugScanner.LineNumberFromAddr(Addr: TJclAddr; out Offset: Integer): Integer;
var
P: Pointer;
Value, LineNumber: Integer;
CurrVA, ModuleStartVA, ItemVA: DWORD;
CurrVA, ModuleStartVA, ItemVA: TJclAddr;
begin
ModuleStartVA := ModuleStartFromAddr(Addr);
LineNumber := 0;
Expand Down Expand Up @@ -3245,15 +3246,15 @@ function TJclBinDebugScanner.LineNumberFromAddr(Addr: DWORD; out Offset: Integer
Result := LineNumber;
end;

function TJclBinDebugScanner.MakePtr(A: Integer): Pointer;
function TJclBinDebugScanner.MakePtr(A: TJclAddr): Pointer;
begin
Result := Pointer(TJclAddr(FStream.Memory) + TJclAddr(A));
end;

function TJclBinDebugScanner.ModuleNameFromAddr(Addr: DWORD): string;
function TJclBinDebugScanner.ModuleNameFromAddr(Addr: TJclAddr): string;
var
Value, Name: Integer;
StartAddr: DWORD;
StartAddr: TJclAddr;
P: Pointer;
begin
P := MakePtr(PJclDbgHeader(FStream.Memory)^.Units);
Expand All @@ -3274,10 +3275,10 @@ function TJclBinDebugScanner.ModuleNameFromAddr(Addr: DWORD): string;
Result := DataToStr(Name);
end;

function TJclBinDebugScanner.ModuleStartFromAddr(Addr: DWORD): DWORD;
function TJclBinDebugScanner.ModuleStartFromAddr(Addr: TJclAddr): TJclAddr;
var
Value: Integer;
StartAddr, ModuleStartAddr: DWORD;
StartAddr, ModuleStartAddr: TJclAddr;
P: Pointer;
begin
P := MakePtr(PJclDbgHeader(FStream.Memory)^.Units);
Expand All @@ -3298,18 +3299,18 @@ function TJclBinDebugScanner.ModuleStartFromAddr(Addr: DWORD): DWORD;
Result := ModuleStartAddr;
end;

function TJclBinDebugScanner.ProcNameFromAddr(Addr: DWORD): string;
function TJclBinDebugScanner.ProcNameFromAddr(Addr: TJclAddr): string;
var
Dummy: Integer;
begin
Result := ProcNameFromAddr(Addr, Dummy);
end;

function TJclBinDebugScanner.ProcNameFromAddr(Addr: DWORD; out Offset: Integer): string;
function TJclBinDebugScanner.ProcNameFromAddr(Addr: TJclAddr; out Offset: Integer): string;
var
P: Pointer;
Value, FirstWord, SecondWord: Integer;
CurrAddr, ModuleStartAddr, ItemAddr: DWORD;
CurrAddr, ModuleStartAddr, ItemAddr: TJclAddr;
begin
ModuleStartAddr := ModuleStartFromAddr(Addr);
FirstWord := 0;
Expand Down Expand Up @@ -3387,10 +3388,10 @@ function TJclBinDebugScanner.ReadValue(var P: Pointer; var Value: Integer): Bool
Result := (Value <> MaxInt);
end;

function TJclBinDebugScanner.SourceNameFromAddr(Addr: DWORD): string;
function TJclBinDebugScanner.SourceNameFromAddr(Addr: TJclAddr): string;
var
Value, Name: Integer;
StartAddr, ModuleStartAddr, ItemAddr: DWORD;
StartAddr, ModuleStartAddr, ItemAddr: TJclAddr;
P: Pointer;
Found: Boolean;
begin
Expand Down Expand Up @@ -3729,7 +3730,7 @@ function TJclDebugInfoSource.GetFileName: TFileName;
Result := GetModulePath(FModule);
end;

function TJclDebugInfoSource.VAFromAddr(const Addr: Pointer): DWORD;
function TJclDebugInfoSource.VAFromAddr(const Addr: Pointer): TJclAddr;
begin
Result := DWORD(TJclAddr(Addr) - TJclAddr(FModule) - ModuleCodeOffset);
end;
Expand Down Expand Up @@ -5137,7 +5138,7 @@ function JclValidateModuleAddress(Addr: Pointer): Boolean;

{$STACKFRAMES OFF}

function ValidCodeAddr(CodeAddr: DWORD; ModuleList: TJclModuleInfoList): Boolean;
function ValidCodeAddr(CodeAddr: TJclAddr; ModuleList: TJclModuleInfoList): Boolean;
begin
if stAllModules in JclStackTrackingOptions then
Result := ModuleList.IsValidModuleAddress(Pointer(CodeAddr))
Expand Down