diff --git a/debugger/debugger.pp b/debugger/debugger.pp index aa4b03c356..b74b9856c2 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -78,7 +78,8 @@ type dsPause, dsInit, dsRun, - dsError + dsError, + dsDestroying ); TDBGExceptionType = ( @@ -117,6 +118,11 @@ type dsError: Something unforseen has happened. A shutdown of the debugger is in most cases needed. + + -dsDestroying + The debugger is about to be destroyed. + Should normally happen immediate on calling Release. + But the debugger may be in nested calls, and has to exit them first. -------------------------------------------------------------------------- } @@ -1323,6 +1329,7 @@ type virtual; abstract; // True if succesful procedure SetExitCode(const AValue: Integer); procedure SetState(const AValue: TDBGState); + procedure DoRelease; virtual; public class function Caption: String; virtual; // The name of the debugger as shown in the debuggeroptions class function ExePaths: String; virtual; // The default locations of the exe @@ -1339,6 +1346,7 @@ type procedure Init; virtual; // Initializes the debugger procedure Done; virtual; // Kills the debugger + procedure Release; // Free/Destroy self procedure Run; // Starts / continues debugging procedure Pause; // Stops running procedure Stop; // quit debugging @@ -1413,7 +1421,8 @@ const 'Pause', 'Init', 'Run', - 'Error' + 'Error', + 'Destroying' ); DBGBreakPointActionNames: array[TIDEBreakPointAction] of string = ( @@ -1446,7 +1455,8 @@ const dcDisassemble], {dsInit } [], {dsRun } [dcPause, dcStop, dcBreak, dcWatch, dcEnvironment], - {dsError} [dcStop] + {dsError} [dcStop], + {dsDestroying} [] ); var @@ -1654,6 +1664,12 @@ begin FCurEnvironment.Clear; end; +procedure TDebugger.Release; +begin + if Self <> nil + then Self.DoRelease; +end; + procedure TDebugger.DoCurrent(const ALocation: TDBGLocationRec); begin if Assigned(FOnCurrent) then FOnCurrent(Self, ALocation); @@ -1903,6 +1919,17 @@ procedure TDebugger.SetState(const AValue: TDBGState); var OldState: TDBGState; begin + // dsDestroying is final, do not unset + if FState = dsDestroying + then exit; + + // dsDestroying must be silent. The ide believes the debugger is gone already + if AValue = dsDestroying + then begin + FState := AValue; + exit; + end; + if AValue <> FState then begin OldState := FState; @@ -1917,6 +1944,11 @@ begin end; end; +procedure TDebugger.DoRelease; +begin + Self.Free; +end; + procedure TDebugger.StepInto; begin if ReqCmd(dcStepInto, []) then exit; diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index aac5d0d4a4..59eb0e806c 100644 --- a/debugger/gdbmidebugger.pp +++ b/debugger/gdbmidebugger.pp @@ -132,6 +132,7 @@ type procedure DoUnockQueueExecute; virtual; function DoExecute: Boolean; virtual; abstract; procedure DoOnExecuted; + procedure DoCancel; virtual; procedure DoOnCanceled; // ExecuteCommand does execute direct. It does not use the queue function ExecuteCommand(const ACommand: String): Boolean; overload; @@ -185,6 +186,7 @@ type FAsmCache: TTypedMap; FAsmCacheIter: TTypedMapIterator; FSourceNames: TStringList; // Objects[] -> TMap[Integer|Integer] -> TDbgPtr + FReleaseLock: Integer; // GDB info (move to ?) FGDBVersion: String; @@ -216,6 +218,10 @@ type out ADump, AStatement, AFile: String; out ALine: Integer): Boolean; function GDBSourceAdress(const ASource: String; ALine, AColumn: Integer; out AAddr: TDbgPtr): Boolean; + // prevent destruction while nested in any call + procedure LockRelease; + procedure UnlockRelease; + procedure CallStackSetCurrent(AIndex: Integer); function ConvertPascalExpression(var AExpression: String): Boolean; // --- @@ -250,6 +256,7 @@ type function ExecuteCommandFull(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICmdFlags; const ACallback: TGDBMICallback; const ATag: PtrInt; var AResult: TGDBMIExecResult): Boolean; overload; procedure QueueCommand(const ACommand: TGDBMIDebuggerCommand); procedure UnQueueCommand(const ACommand: TGDBMIDebuggerCommand); + procedure CancelAllQueued; function StartDebugging(const AContinueCommand: String): Boolean; protected procedure QueueExecuteLock; @@ -277,6 +284,7 @@ type property TargetFlags: TGDBMITargetFlags read FTargetFlags write FTargetFlags; property PauseWaitState: TGDBMIPauseWaitState read FPauseWaitState; property DebuggerFlags: TGDBMIDebuggerFlags read FDebuggerFlags; + procedure DoRelease; override; // Destroy self (or schedule) public class function CreateProperties: TDebuggerProperties; override; // Creates debuggerproperties class function Caption: String; override; @@ -1594,6 +1602,7 @@ end; constructor TGDBMIDebugger.Create(const AExternalDebugger: String); begin + FReleaseLock := 0; FBreakErrorBreakID := -1; FRunErrorBreakID := -1; FExceptionBreakID := -1; @@ -1653,6 +1662,7 @@ end; destructor TGDBMIDebugger.Destroy; begin + LockRelease; inherited; ClearCommandQueue; FreeAndNil(FCommandQueue); @@ -1664,9 +1674,15 @@ end; procedure TGDBMIDebugger.Done; begin - if State = dsRun then GDBPause(True); - ExecuteCommand('-gdb-exit', []); - inherited Done; + LockRelease; + try + CancelAllQueued; + if State = dsRun then GDBPause(True); + ExecuteCommand('-gdb-exit', []); + inherited Done; + finally + UnlockRelease; + end; end; procedure TGDBMIDebugger.DoState(const OldState: TDBGState); @@ -1681,6 +1697,15 @@ begin inherited DoState(OldState); end; +procedure TGDBMIDebugger.DoRelease; +begin + SetState(dsDestroying); + if FReleaseLock > 0 + then exit; + + inherited DoRelease; +end; + function TGDBMIDebugger.ExecuteCommand(const ACommand: String; const AFlags: TGDBMICmdFlags): Boolean; var @@ -1748,21 +1773,25 @@ procedure TGDBMIDebugger.QueueCommand(const ACommand: TGDBMIDebuggerCommand); var R: Boolean; Cmd: TGDBMIDebuggerCommand; + SavedInExecuteCount: LongInt; begin - FCommandQueue.Add(ACommand); - if (FCommandQueue.Count > 1) or (FCommandQueueExecLock > 0) - then begin - {$IFDEF GDMI_QUEUE_DEBUG} - debugln(['Queueing (Recurse-Count=', FInExecuteCount, ') at pos ', FCommandQueue.Count-1, ': "', ACommand.DebugText,'" State=',DBGStateNames[State], ' Lock=',FCommandQueueExecLock ]); - {$ENDIF} - ACommand.DoQueued; - Exit; - end; + SavedInExecuteCount := FInExecuteCount; + LockRelease; + try + FCommandQueue.Add(ACommand); + if (FCommandQueue.Count > 1) or (FCommandQueueExecLock > 0) + then begin + {$IFDEF GDMI_QUEUE_DEBUG} + debugln(['Queueing (Recurse-Count=', FInExecuteCount, ') at pos ', FCommandQueue.Count-1, ': "', ACommand.DebugText,'" State=',DBGStateNames[State], ' Lock=',FCommandQueueExecLock ]); + {$ENDIF} + ACommand.DoQueued; + Exit; + end; + + // If we are here we can process the command directly + repeat + Inc(FInExecuteCount); - // If we are here we can process the command directly - repeat - Inc(FInExecuteCount); - try Cmd := TGDBMIDebuggerCommand(FCommandQueue[0]); FCommandQueue.Delete(0); {$IFDEF GDMI_QUEUE_DEBUG} @@ -1771,38 +1800,40 @@ begin R := Cmd.Execute; Cmd.DoFinished; - if State = dsError + Dec(FInExecuteCount); + + if State in [dsError, dsDestroying] then begin //DebugLn('[WARNING] TGDBMIDebugger: ExecuteCommand "',Cmd,'" failed.'); Break; end; - finally - Dec(FInExecuteCount); - end; - - if FCommandQueue.Count = 0 - then begin - if (FInExecuteCount = 0) // not in Recursive call - and (FPauseWaitState = pwsInternal) - and (State = dsRun) + if FCommandQueue.Count = 0 then begin - // reset state - FPauseWaitState := pwsNone; - // insert continue command - Cmd := TGDBMIDebuggerSimpleCommand.Create(Self, '-exec-continue', [], [], nil, 0); - FCommandQueue.Add(Cmd); - {$IFDEF GDMI_QUEUE_DEBUG} - debugln(['Internal Queueing: exec-continue']); - {$ENDIF} - end - else Break; // Queue empty - end; + if (FInExecuteCount = 0) // not in Recursive call + and (FPauseWaitState = pwsInternal) + and (State = dsRun) + then begin + // reset state + FPauseWaitState := pwsNone; + // insert continue command + Cmd := TGDBMIDebuggerSimpleCommand.Create(Self, '-exec-continue', [], [], nil, 0); + FCommandQueue.Add(Cmd); + {$IFDEF GDMI_QUEUE_DEBUG} + debugln(['Internal Queueing: exec-continue']); + {$ENDIF} + end + else Break; // Queue empty + end; - until not R; - {$IFDEF GDMI_QUEUE_DEBUG} - debugln(['Leaving Queue with count: ', FCommandQueue.Count, ' Recurse-Count=', FInExecuteCount,' State=',DBGStateNames[State]]); - {$ENDIF} + until not R; + {$IFDEF GDMI_QUEUE_DEBUG} + debugln(['Leaving Queue with count: ', FCommandQueue.Count, ' Recurse-Count=', FInExecuteCount,' State=',DBGStateNames[State]]); + {$ENDIF} + finally + UnlockRelease; + FInExecuteCount := SavedInExecuteCount; + end; end; procedure TGDBMIDebugger.UnQueueCommand(const ACommand: TGDBMIDebuggerCommand); @@ -1810,6 +1841,19 @@ begin FCommandQueue.Remove(ACommand); end; +procedure TGDBMIDebugger.CancelAllQueued; +var + i: Integer; +begin + i := FCommandQueue.Count - 1; + while i >= 0 do begin + TGDBMIDebuggerCommand(FCommandQueue[i]).Cancel; + dec(i); + if i >= FCommandQueue.Count + then i := FCommandQueue.Count - 1; + end; +end; + class function TGDBMIDebugger.ExePaths: String; begin Result := '/usr/bin/gdb;/usr/local/bin/gdb;/opt/fpc/gdb'; @@ -2482,6 +2526,18 @@ begin LinesList.Free; end; +procedure TGDBMIDebugger.LockRelease; +begin + inc(FReleaseLock); +end; + +procedure TGDBMIDebugger.UnlockRelease; +begin + dec(FReleaseLock); + if (FReleaseLock = 0) and (State = dsDestroying) + then Release; +end; + function TGDBMIDebugger.GDBStepInto: Boolean; begin Result := False; @@ -2727,37 +2783,42 @@ procedure TGDBMIDebugger.Init; var Options: String; begin - FPauseWaitState := pwsNone; - FInExecuteCount := 0; + LockRelease; + try + FPauseWaitState := pwsNone; + FInExecuteCount := 0; - Options := '-silent -i mi -nx'; + Options := '-silent -i mi -nx'; - if Length(TGDBMIDebuggerProperties(GetProperties).Debugger_Startup_Options) > 0 - then Options := Options + ' ' + TGDBMIDebuggerProperties(GetProperties).Debugger_Startup_Options; + if Length(TGDBMIDebuggerProperties(GetProperties).Debugger_Startup_Options) > 0 + then Options := Options + ' ' + TGDBMIDebuggerProperties(GetProperties).Debugger_Startup_Options; - if CreateDebugProcess(Options) - then begin - if not ParseInitialization + if CreateDebugProcess(Options) then begin + if not ParseInitialization + then begin + SetState(dsError); + Exit; + end; + + ExecuteCommand('-gdb-set confirm off', []); + // for win32, turn off a new console otherwise breaking gdb will fail + // ignore the error on other platforms + ExecuteCommand('-gdb-set new-console off', [cfIgnoreError]); + + if not ParseGDBVersionMI then ParseGDBVersion; + CheckGDBVersion; + + inherited Init; + end + else begin + if DebugProcess = nil + then MessageDlg('Debugger', 'Failed to create debug process for unknown reason', mtError, [mbOK], 0) + else MessageDlg('Debugger', Format('Failed to create debug process: %s', [ReadLine]), mtError, [mbOK], 0); SetState(dsError); - Exit; end; - - ExecuteCommand('-gdb-set confirm off', []); - // for win32, turn off a new console otherwise breaking gdb will fail - // ignore the error on other platforms - ExecuteCommand('-gdb-set new-console off', [cfIgnoreError]); - - if not ParseGDBVersionMI then ParseGDBVersion; - CheckGDBVersion; - - inherited Init; - end - else begin - if DebugProcess = nil - then MessageDlg('Debugger', 'Failed to create debug process for unknown reason', mtError, [mbOK], 0) - else MessageDlg('Debugger', Format('Failed to create debug process: %s', [ReadLine]), mtError, [mbOK], 0); - SetState(dsError); + finally + UnlockRelease; end; end; @@ -3244,21 +3305,26 @@ end; function TGDBMIDebugger.RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; begin - case ACommand of - dcRun: Result := GDBRun; - dcPause: Result := GDBPause(False); - dcStop: Result := GDBStop; - dcStepOver: Result := GDBStepOver; - dcStepInto: Result := GDBStepInto; - dcStepOut: Result := GDBStepOut; - dcRunTo: Result := GDBRunTo(String(AParams[0].VAnsiString), AParams[1].VInteger); - dcJumpto: Result := GDBJumpTo(String(AParams[0].VAnsiString), AParams[1].VInteger); - dcEvaluate: Result := GDBEvaluate(String(AParams[0].VAnsiString), String(AParams[1].VPointer^),TGDBType(AParams[2].VPointer^)); - dcModify: Result := GDBModify(String(AParams[0].VAnsiString), String(AParams[1].VAnsiString)); - dcEnvironment: Result := GDBEnvironment(String(AParams[0].VAnsiString), AParams[1].VBoolean); - dcDisassemble: Result := GDBDisassemble(AParams[0].VQWord^, AParams[1].VBoolean, TDbgPtr(AParams[2].VPointer^), - String(AParams[3].VPointer^), String(AParams[4].VPointer^), - String(AParams[5].VPointer^), Integer(AParams[6].VPointer^)); + LockRelease; + try + case ACommand of + dcRun: Result := GDBRun; + dcPause: Result := GDBPause(False); + dcStop: Result := GDBStop; + dcStepOver: Result := GDBStepOver; + dcStepInto: Result := GDBStepInto; + dcStepOut: Result := GDBStepOut; + dcRunTo: Result := GDBRunTo(String(AParams[0].VAnsiString), AParams[1].VInteger); + dcJumpto: Result := GDBJumpTo(String(AParams[0].VAnsiString), AParams[1].VInteger); + dcEvaluate: Result := GDBEvaluate(String(AParams[0].VAnsiString), String(AParams[1].VPointer^),TGDBType(AParams[2].VPointer^)); + dcModify: Result := GDBModify(String(AParams[0].VAnsiString), String(AParams[1].VAnsiString)); + dcEnvironment: Result := GDBEnvironment(String(AParams[0].VAnsiString), AParams[1].VBoolean); + dcDisassemble: Result := GDBDisassemble(AParams[0].VQWord^, AParams[1].VBoolean, TDbgPtr(AParams[2].VPointer^), + String(AParams[3].VPointer^), String(AParams[4].VPointer^), + String(AParams[5].VPointer^), Integer(AParams[6].VPointer^)); + end; + finally + UnlockRelease; end; end; @@ -5505,8 +5571,6 @@ begin OldState := FState; FState := NewState; DoStateChanged(OldState); - if State = dcsCanceled - then DoOnCanceled; if State in [dcsFinished, dcsCanceled] then DoFree; end; @@ -5538,6 +5602,11 @@ begin FOnExecuted(self); end; +procedure TGDBMIDebuggerCommand.DoCancel; +begin + // empty +end; + procedure TGDBMIDebuggerCommand.DoOnCanceled; begin if assigned(FOnCancel) then @@ -5915,9 +5984,9 @@ end; procedure TGDBMIDebuggerCommand.Cancel; begin - if State <> dcsQueued - then exit; FTheDebugger.UnQueueCommand(Self); + DoCancel; + DoOnCanceled; SetState(dcsCanceled); end; diff --git a/ide/debugmanager.pas b/ide/debugmanager.pas index 2dacd709f3..92098ac37a 100644 --- a/ide/debugmanager.pas +++ b/ide/debugmanager.pas @@ -1503,8 +1503,8 @@ procedure TDebugManager.DebuggerChangeState(ADebugger: TDebugger; const // dsNone, dsIdle, dsStop, dsPause, dsInit, dsRun, dsError TOOLSTATEMAP: array[TDBGState] of TIDEToolStatus = ( - // dsNone, dsIdle, dsStop, dsPause, dsInit, dsRun, dsError - itNone, itNone, itNone, itDebugger, itDebugger, itDebugger, itDebugger + // dsNone, dsIdle, dsStop, dsPause, dsInit, dsRun, dsError, dsDestroying + itNone, itNone, itNone, itDebugger, itDebugger, itDebugger, itDebugger, itNone ); //STATENAME: array[TDBGState] of string = ( // 'dsNone', 'dsIdle', 'dsStop', 'dsPause', 'dsInit', 'dsRun', 'dsError' @@ -2259,7 +2259,7 @@ var begin dbg := FDebugger; SetDebugger(nil); - dbg.Free; + dbg.Release; FManagerStates := []; if MainIDE.ToolStatus = itDebugger