paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 01:19:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

Debugger: Improved getting target info (pointer size, object-is-pointer)

Browse Source 
git-svn-id: trunk@30181 -
This commit is contained in:
martin 2011-04-04 13:31:22 +00:00
parent 3db7df3317
commit 4270e6f1e1
1 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
debugger/gdbmidebugger.pp
View File

@ -90,6 +90,7 @@ type
tfHasSymbols, // Debug symbols are present tfHasSymbols, // Debug symbols are present
tfRTLUsesRegCall, // the RTL is compiled with RegCall calling convention tfRTLUsesRegCall, // the RTL is compiled with RegCall calling convention
tfClassIsPointer, // with dwarf class names are pointer. with stabs they are not tfClassIsPointer, // with dwarf class names are pointer. with stabs they are not
tfExceptionIsPointer, // Can happen, if stabs and dwarf are mixed
tfFlagHasTypeObject, tfFlagHasTypeObject,
tfFlagHasTypeException, tfFlagHasTypeException,
tfFlagHasTypeShortstring, tfFlagHasTypeShortstring,
@ -2797,7 +2798,7 @@ function TGDBMIDebuggerCommandStartDebugging.DoExecute: Boolean;
FoundPtrSize: Boolean; FoundPtrSize: Boolean;
begin begin
// assume some defaults // assume some defaults
TargetInfo^.TargetPtrSize := GetIntValue('sizeof(POINTER)', []); TargetInfo^.TargetPtrSize := GetIntValue('sizeof(%s)', [PointerTypeCast]);
FoundPtrSize := (FLastExecResult.State <> dsError) and (TargetInfo^.TargetPtrSize > 0); FoundPtrSize := (FLastExecResult.State <> dsError) and (TargetInfo^.TargetPtrSize > 0);
if not FoundPtrSize if not FoundPtrSize
then TargetInfo^.TargetPtrSize := 4; then TargetInfo^.TargetPtrSize := 4;
@ -3015,10 +3016,15 @@ begin
R := CheckHasType('TObject', tfFlagHasTypeObject); R := CheckHasType('TObject', tfFlagHasTypeObject);
if R.State <> dsError if R.State <> dsError
then begin then begin
if (LeftStr(R.Values, 15) = 'type = ^TOBJECT') if UpperCase(LeftStr(R.Values, 15)) = UpperCase('type = ^TOBJECT')
then include(TargetInfo^.TargetFlags, tfClassIsPointer); then include(TargetInfo^.TargetFlags, tfClassIsPointer);
end; end;
CheckHasType('Exception', tfFlagHasTypeException); R := CheckHasType('Exception', tfFlagHasTypeException);
if R.State <> dsError
then begin
if UpperCase(LeftStr(R.Values, 17)) = UpperCase('type = ^EXCEPTION')
then include(TargetInfo^.TargetFlags, tfExceptionIsPointer);
end;
CheckHasType('Shortstring', tfFlagHasTypeShortstring); CheckHasType('Shortstring', tfFlagHasTypeShortstring);
//CheckHasType('PShortstring', tfFlagHasTypePShortString); //CheckHasType('PShortstring', tfFlagHasTypePShortString);
CheckHasType('pointer', tfFlagHasTypePointer); CheckHasType('pointer', tfFlagHasTypePointer);
@ -3372,7 +3378,7 @@ function TGDBMIDebuggerCommandExecute.ProcessStopped(const AParams: String;
if (dfImplicidTypes in FTheDebugger.DebuggerFlags) if (dfImplicidTypes in FTheDebugger.DebuggerFlags)
then begin then begin
if (tfFlagHasTypeException in TargetInfo^.TargetFlags) then begin if (tfFlagHasTypeException in TargetInfo^.TargetFlags) then begin
if tfClassIsPointer in TargetInfo^.TargetFlags if tfExceptionIsPointer in TargetInfo^.TargetFlags
then ExceptionMessage := GetText('Exception(%s).FMessage', [AInfo.ObjAddr]) then ExceptionMessage := GetText('Exception(%s).FMessage', [AInfo.ObjAddr])
else ExceptionMessage := GetText('^Exception(%s)^.FMessage', [AInfo.ObjAddr]); else ExceptionMessage := GetText('^Exception(%s)^.FMessage', [AInfo.ObjAddr]);
//ExceptionMessage := GetText('^^Exception($fp+8)^^.FMessage', []); //ExceptionMessage := GetText('^^Exception($fp+8)^^.FMessage', []);