diff --git a/components/fpdebug/fppascalbuilder.pas b/components/fpdebug/fppascalbuilder.pas index f2c40681e4..b3f2c23012 100644 --- a/components/fpdebug/fppascalbuilder.pas +++ b/components/fpdebug/fppascalbuilder.pas @@ -27,10 +27,15 @@ type ); TTypeDeclarationFlags = set of TTypeDeclarationFlag; + TPrintPasValFlag = (dummyx1); + TPrintPasValFlags = set of TPrintPasValFlag; + function GetTypeName(out ATypeName: String; ADbgSymbol: TDbgSymbol; AFlags: TTypeNameFlags = []): Boolean; function GetTypeAsDeclaration(out ATypeDeclaration: String; ADbgSymbol: TDbgSymbol; AFlags: TTypeDeclarationFlags = []; AnIndent: Integer = 0): Boolean; +function PrintPasValue(out APrintedValue: String; AResValue: TDbgSymbolValue; AnAddrSize: Integer; AFlags: TPrintPasValFlags = []): Boolean; + implementation function GetTypeName(out ATypeName: String; ADbgSymbol: TDbgSymbol; @@ -386,6 +391,128 @@ begin ATypeDeclaration := GetIndent + ATypeDeclaration; end; +function PrintPasValue(out APrintedValue: String; AResValue: TDbgSymbolValue; + AnAddrSize: Integer; AFlags: TPrintPasValFlags): Boolean; + + function ResTypeName: String; + begin + if not((AResValue.TypeInfo<> nil) and + GetTypeName(Result, AResValue.TypeInfo, [])) + then + Result := ''; + end; + + procedure DoPointer; + var + s: String; + begin + s := ResTypeName; + APrintedValue := '$'+IntToHex(AResValue.AsCardinal, AnAddrSize); + if s <> '' then + APrintedValue := s + '(' + APrintedValue + ')'; + Result := True; + end; + + procedure DoInt; + begin + APrintedValue := IntToStr(AResValue.AsInteger); + Result := True; + end; + + procedure DoCardinal; + begin + APrintedValue := IntToStr(AResValue.AsCardinal); + Result := True; + end; + + procedure DoBool; + begin + if AResValue.AsBool then begin + APrintedValue := 'True'; + if AResValue.AsCardinal <> 1 then + APrintedValue := APrintedValue + '(' + IntToStr(AResValue.AsCardinal) + ')'; + end + else + APrintedValue := 'False'; + Result := True; + end; + + procedure DoChar; + begin + APrintedValue := '''' + AResValue.AsString + ''''; // Todo escape + Result := True; + end; + + procedure DoFloat; + begin + APrintedValue := FloatToStr(AResValue.AsFloat); + Result := True; + end; + + procedure DoEnum; + var + s: String; + begin + APrintedValue := AResValue.AsString; + if APrintedValue = '' then begin + s := ResTypeName; + APrintedValue := s + '(' + IntToStr(AResValue.AsCardinal) + ')'; + end; + Result := True; + end; + + procedure DoEnumVal; + begin + APrintedValue := AResValue.AsString; + if APrintedValue <> '' then + APrintedValue := APrintedValue + ':='; + APrintedValue := APrintedValue+ IntToStr(AResValue.AsCardinal); + Result := True; + end; + + procedure DoSet; + var + s: String; + i: Integer; + begin + APrintedValue := ''; + for i := 0 to AResValue.MemberCount-1 do + if i = 0 + then APrintedValue := AResValue.Member[i].AsString + else APrintedValue := APrintedValue + ', ' + AResValue.Member[i].AsString; + APrintedValue := '[' + APrintedValue + ']'; + Result := True; + end; + +begin + Result := False; + case AResValue.Kind of + skUnit: ; + skProcedure: ; + skFunction: ; + skPointer: DoPointer; + skInteger: DoInt; + skCardinal: DoCardinal; + skBoolean: DoBool; + skChar: DoChar; + skFloat: DoFloat; + skString: ; + skAnsiString: ; + skCurrency: ; + skVariant: ; + skWideString: ; + skEnum: DoEnum; + skEnumValue: DoEnumVal; + skSet: DoSet; + skRecord: ; + skObject: ; + skClass: ; + skInterface: ; + skArray: ; + end; + +end; + end. diff --git a/components/lazdebuggerfp/fpgdbmidebugger.pp b/components/lazdebuggerfp/fpgdbmidebugger.pp index 1aa8716ebd..ecf2a98f7d 100644 --- a/components/lazdebuggerfp/fpgdbmidebugger.pp +++ b/components/lazdebuggerfp/fpgdbmidebugger.pp @@ -86,6 +86,7 @@ type procedure LoadDwarf; procedure UnLoadDwarf; function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; override; + procedure QueueCommand(const ACommand: TGDBMIDebuggerCommand; ForceQueue: Boolean = False); procedure GetCurrentContext(out AThreadId, AStackFrame: Integer); function GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr; @@ -112,15 +113,37 @@ type function DoExecute: Boolean; override; end; + TFPGDBMIWatches = class; + + { TFpGDBMIDebuggerCommandEvaluate } + + TFpGDBMIDebuggerCommandEvaluate = class(TGDBMIDebuggerCommand) + private + FOwner: TFPGDBMIWatches; + protected + function DoExecute: Boolean; override; + procedure DoFree; override; + procedure DoCancel; override; + procedure DoLockQueueExecute; override; + procedure DoUnLockQueueExecute; override; + public + constructor Create(AOwner: TFPGDBMIWatches); + end; + { TFPGDBMIWatches } TFPGDBMIWatches = class(TGDBMIWatches) private FWatchEvalList: TList; + FWatchEvalLock: Integer; + FNeedRegValues: Boolean; + FEvaluationCmdObj: TFpGDBMIDebuggerCommandEvaluate; procedure DoWatchFreed(Sender: TObject); protected function FpDebugger: TFpGDBMIDebugger; //procedure DoStateChange(const AOldState: TDBGState); override; + procedure ProcessEvalList; + procedure QueueCommand; procedure InternalRequestData(AWatchValue: TWatchValueBase); override; public constructor Create(const ADebugger: TDebuggerIntf); @@ -147,6 +170,42 @@ type procedure Cancel(const ASource: String); override; end; +{ TFpGDBMIDebuggerCommandEvaluate } + +function TFpGDBMIDebuggerCommandEvaluate.DoExecute: Boolean; +begin + FOwner.FEvaluationCmdObj := nil; + FOwner.ProcessEvalList; +end; + +procedure TFpGDBMIDebuggerCommandEvaluate.DoFree; +begin + FOwner.FEvaluationCmdObj := nil; + inherited DoFree; +end; + +procedure TFpGDBMIDebuggerCommandEvaluate.DoCancel; +begin + FOwner.FEvaluationCmdObj := nil; + inherited DoCancel; +end; + +procedure TFpGDBMIDebuggerCommandEvaluate.DoLockQueueExecute; +begin + // +end; + +procedure TFpGDBMIDebuggerCommandEvaluate.DoUnLockQueueExecute; +begin + // +end; + +constructor TFpGDBMIDebuggerCommandEvaluate.Create(AOwner: TFPGDBMIWatches); +begin + inherited Create(AOwner.FpDebugger); + FOwner := AOwner; +end; + { TFpGDBMIAndWin32DbgMemReader } destructor TFpGDBMIAndWin32DbgMemReader.Destroy; @@ -813,14 +872,20 @@ begin FWatchEvalList.Remove(pointer(Sender)); end; -procedure TFPGDBMIWatches.InternalRequestData(AWatchValue: TWatchValueBase); +procedure TFPGDBMIWatches.ProcessEvalList; var + WatchValue: TWatchValueBase; PasExpr: TFpPascalExpression; ResValue: TDbgSymbolValue; ResTypeInfo: TDBGType; ResText: String; Ctx: TDbgInfoAddressContext; + function IsWatchValueAlive: Boolean; + begin + Result := (FWatchEvalList.Count > 0) and (FWatchEvalList[0] = Pointer(WatchValue)); + end; + function ResTypeName: String; begin if not((ResValue.TypeInfo<> nil) and @@ -830,109 +895,157 @@ var end; procedure DoPointer; - var - s: String; begin - s := ResTypeName; - ResTypeInfo := TDBGType.Create(skSimple, s); // TODO, IDE must learn pointer - ResText := '$'+IntToHex(ResValue.AsCardinal, Ctx.SizeOfAddress); - if s <> '' then - ResText := s + '(' + ResText + ')'; + if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then + exit; + ResTypeInfo := TDBGType.Create(skSimple, ResTypeName); // TODO, IDE must learn pointer ResTypeInfo.Value.AsString := ResText; //ResTypeInfo.Value.AsPointer := ; // ??? end; - procedure DoInt; - var - s: String; + procedure DoSimple; begin - s := ResTypeName; - ResTypeInfo := TDBGType.Create(skSimple, s); // TODO, IDE must learn skInteger; - ResText := IntToStr(ResValue.AsInteger); + if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then + exit; + ResTypeInfo := TDBGType.Create(skSimple, ResTypeName); ResTypeInfo.Value.AsString := ResText; end; - procedure DoCardinal; - var - s: String; + procedure DoEnum; begin - s := ResTypeName; - ResTypeInfo := TDBGType.Create(skSimple, s); // TODO, IDE must learn skInteger; - ResText := IntToStr(ResValue.AsCardinal); + if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then + exit; + ResTypeInfo := TDBGType.Create(skEnum, ResTypeName); + ResTypeInfo.Value.AsString := ResText; + end; + + procedure DoSet; + begin + if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then + exit; + ResTypeInfo := TDBGType.Create(skSet, ResTypeName); ResTypeInfo.Value.AsString := ResText; end; begin + if FNeedRegValues then begin + FNeedRegValues := False; + FpDebugger.Registers.Values[0]; + QueueCommand; + exit; + end; + + if FWatchEvalLock > 0 then + exit; + inc(FWatchEvalLock); + try // TODO: if the stack/thread is changed, registers will be wrong + while (FWatchEvalList.Count > 0) and (FEvaluationCmdObj = nil) do begin + try + WatchValue := TWatchValueBase(FWatchEvalList[0]); + ResTypeInfo := nil; + Ctx := FpDebugger.GetInfoContextForContext(WatchValue.ThreadId, WatchValue.StackFrame); + + PasExpr := TFpPascalExpression.Create(WatchValue.Expression, Ctx); + if not IsWatchValueAlive then + continue; + + if not (PasExpr.Valid and (PasExpr.ResultValue <> nil)) then begin + if not IsWatchValueAlive then + continue; + debugln(['TFPGDBMIWatches.InternalRequestData FAILED']); + inherited InternalRequestData(WatchValue); + continue; + end; + if not IsWatchValueAlive then + continue; + + ResValue := PasExpr.ResultValue; + + case PasExpr.ResultValue.Kind of + skUnit: ; + skProcedure: ; + skFunction: ; + skPointer: DoPointer; + skInteger: DoSimple; + skCardinal: DoSimple; + skBoolean: DoSimple; + skChar: DoSimple; + skFloat: DoSimple; + skString: ; + skAnsiString: ; + skCurrency: ; + skVariant: ; + skWideString: ; + skEnum: DoEnum; + skEnumValue: DoSimple; + skSet: DoSet; + skRecord: ; + skObject: ; + skClass: ; + skInterface: ; + skArray: ; + end; + + + if IsWatchValueAlive then begin + if ResTypeInfo = nil then begin + debugln(['TFPGDBMIWatches.InternalRequestData FAILED']); + inherited InternalRequestData(WatchValue); + continue; + end; + + debugln(['TFPGDBMIWatches.InternalRequestData GOOOOOOD']); + WatchValue.Value := ResText; + WatchValue.TypeInfo := ResTypeInfo; + WatchValue.Validity := ddsValid; + end; + + + finally + if IsWatchValueAlive then begin + WatchValue.RemoveFreeeNotification(@DoWatchFreed); + FWatchEvalList.Remove(pointer(WatchValue)); + end; + PasExpr.Free; + Application.ProcessMessages; + end; + end; + finally + dec(FWatchEvalLock); + end; +end; + +procedure TFPGDBMIWatches.QueueCommand; +begin + FEvaluationCmdObj := TFpGDBMIDebuggerCommandEvaluate.Create(Self); + FEvaluationCmdObj.Properties := [dcpCancelOnRun]; + // If a ExecCmd is running, then defer exec until the exec cmd is done + FpDebugger.QueueCommand(FEvaluationCmdObj, ForceQueuing); +end; + +procedure TFPGDBMIWatches.InternalRequestData(AWatchValue: TWatchValueBase); +begin + if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin + AWatchValue.Validity := ddsInvalid; + Exit; + end; AWatchValue.AddFreeeNotification(@DoWatchFreed); // we may call gdb FWatchEvalList.Add(pointer(AWatchValue)); - try - ResTypeInfo := nil; - Ctx := FpDebugger.GetInfoContextForContext(AWatchValue.ThreadId, AWatchValue.StackFrame); - PasExpr := TFpPascalExpression.Create(AWatchValue.Expression, Ctx); - if FWatchEvalList.IndexOf(pointer(AWatchValue)) < 0 then - exit; + if FEvaluationCmdObj <> nil then exit; - if not (PasExpr.Valid and (PasExpr.ResultValue <> nil)) then begin - if FWatchEvalList.IndexOf(pointer(AWatchValue)) < 0 then - exit; - debugln(['TFPGDBMIWatches.InternalRequestData FAILED']); - inherited InternalRequestData(AWatchValue); - exit; - end; - if FWatchEvalList.IndexOf(pointer(AWatchValue)) < 0 then - exit; - - ResValue := PasExpr.ResultValue; - - case PasExpr.ResultValue.Kind of - skUnit: ; - skProcedure: ; - skFunction: ; - skPointer: DoPointer; - skInteger: DoInt; - skCardinal: DoCardinal; - skBoolean: ; - skChar: ; - skFloat: ; - skString: ; - skAnsiString: ; - skCurrency: ; - skVariant: ; - skWideString: ; - skEnum: ; - skEnumValue: ; - skSet: ; - skRecord: ; - skObject: ; - skClass: ; - skInterface: ; - skArray: ; - end; - - - if FWatchEvalList.IndexOf(pointer(AWatchValue)) >= 0 then begin - if ResTypeInfo = nil then begin - debugln(['TFPGDBMIWatches.InternalRequestData FAILED']); - inherited InternalRequestData(AWatchValue); - exit; - end; - - debugln(['TFPGDBMIWatches.InternalRequestData GOOOOOOD']); - AWatchValue.Value := ResText; - AWatchValue.TypeInfo := ResTypeInfo; - AWatchValue.Validity := ddsValid; - end; - - - finally - AWatchValue.RemoveFreeeNotification(@DoWatchFreed); - FWatchEvalList.Remove(pointer(AWatchValue)); - PasExpr.Free; + FpDebugger.Threads.CurrentThreads.Count; // trigger threads, in case + if FpDebugger.Registers.Count = 0 then // trigger register, in case + FNeedRegValues := True + else + begin + FNeedRegValues := False; + FpDebugger.Registers.Values[0]; end; - Application.ProcessMessages; + // Join the queue, registers and threads are needed first + QueueCommand; end; constructor TFPGDBMIWatches.Create(const ADebugger: TDebuggerIntf); @@ -1108,6 +1221,12 @@ begin Result := inherited RequestCommand(ACommand, AParams); end; +procedure TFpGDBMIDebugger.QueueCommand(const ACommand: TGDBMIDebuggerCommand; + ForceQueue: Boolean); +begin + inherited QueueCommand(ACommand, ForceQueue); +end; + procedure TFpGDBMIDebugger.GetCurrentContext(out AThreadId, AStackFrame: Integer); begin if CurrentThreadIdValid then begin diff --git a/components/lazdebuggergdbmi/gdbmidebugger.pp b/components/lazdebuggergdbmi/gdbmidebugger.pp index fc8d2246a9..01c5576499 100644 --- a/components/lazdebuggergdbmi/gdbmidebugger.pp +++ b/components/lazdebuggergdbmi/gdbmidebugger.pp @@ -622,6 +622,7 @@ type procedure DoStateChange(const AOldState: TDBGState); override; procedure Changed; procedure Clear; + function ForceQueuing: Boolean; procedure InternalRequestData(AWatchValue: TWatchValueBase); override; property ParentFPListChangeStamp: Integer read FParentFPListChangeStamp; public @@ -714,8 +715,6 @@ type function ExecuteCommand(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICommandFlags; var AResult: TGDBMIExecResult): Boolean; overload; function ExecuteCommandFull(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICommandFlags; const ACallback: TGDBMICallback; const ATag: PtrInt; var AResult: TGDBMIExecResult): Boolean; overload; procedure RunQueue; - procedure QueueCommand(const ACommand: TGDBMIDebuggerCommand; ForceQueue: Boolean = False); - procedure UnQueueCommand(const ACommand: TGDBMIDebuggerCommand); procedure CancelAllQueued; procedure CancelBeforeRun; procedure CancelAfterStop; @@ -737,6 +736,8 @@ type {$ENDIF} procedure QueueExecuteLock; procedure QueueExecuteUnlock; + procedure QueueCommand(const ACommand: TGDBMIDebuggerCommand; ForceQueue: Boolean = False); + procedure UnQueueCommand(const ACommand: TGDBMIDebuggerCommand); function ConvertToGDBPath(APath: string; ConvType: TConvertToGDBPathType = cgptNone): string; function ChangeFileName: Boolean; override; @@ -10009,9 +10010,16 @@ begin FCommandList.Clear; end; +function TGDBMIWatches.ForceQueuing: Boolean; +begin + Result := (TGDBMIDebugger(Debugger).FCurrentCommand <> nil) + and (TGDBMIDebugger(Debugger).FCurrentCommand is TGDBMIDebuggerCommandExecute) + and (not TGDBMIDebuggerCommandExecute(TGDBMIDebugger(Debugger).FCurrentCommand).NextExecQueued) + and (Debugger.State <> dsInternalPause); +end; + procedure TGDBMIWatches.InternalRequestData(AWatchValue: TWatchValueBase); var - ForceQueue: Boolean; EvaluationCmdObj: TGDBMIDebuggerCommandEvaluate; begin if (Debugger = nil) or not(Debugger.State in [dsPause, dsInternalPause]) then begin @@ -10025,12 +10033,8 @@ begin EvaluationCmdObj.OnDestroy := @DoEvaluationDestroyed; EvaluationCmdObj.Properties := [dcpCancelOnRun]; // If a ExecCmd is running, then defer exec until the exec cmd is done - ForceQueue := (TGDBMIDebugger(Debugger).FCurrentCommand <> nil) - and (TGDBMIDebugger(Debugger).FCurrentCommand is TGDBMIDebuggerCommandExecute) - and (not TGDBMIDebuggerCommandExecute(TGDBMIDebugger(Debugger).FCurrentCommand).NextExecQueued) - and (Debugger.State <> dsInternalPause); FCommandList.Add(EvaluationCmdObj); - TGDBMIDebugger(Debugger).QueueCommand(EvaluationCmdObj, ForceQueue); + TGDBMIDebugger(Debugger).QueueCommand(EvaluationCmdObj, ForceQueuing); (* DoEvaluationFinished may be called immediately at this point *) end;