1 {
2 ---------------------------------------------------------------------------
3 FpDebugDebuggerUtils
4 ---------------------------------------------------------------------------
5
6 ***************************************************************************
7 * *
8 * This source is free software; you can redistribute it and/or modify *
9 * it under the terms of the GNU General Public License as published by *
10 * the Free Software Foundation; either version 2 of the License, or *
11 * (at your option) any later version. *
12 * *
13 * This code is distributed in the hope that it will be useful, but *
14 * WITHOUT ANY WARRANTY; without even the implied warranty of *
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
16 * General Public License for more details. *
17 * *
18 * A copy of the GNU General Public License is available on the World *
19 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
20 * obtain it by writing to the Free Software Foundation, *
21 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
22 * *
23 ***************************************************************************
24 }
25
26 unit FpDebugDebuggerUtils;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 FpDbgUtil, FpdMemoryTools, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif}, DbgIntfDebuggerBase, sysutils,
34 Classes, syncobjs, Forms;
35
36 type
37
38 { TFpDebugDebuggerPropertiesMemLimits }
39
40 TFpDebugDebuggerPropertiesMemLimits = class(TPersistent)
41 private
42 const
43 DEF_MaxMemReadSize = 512*1024*1024;
44 DEF_MaxStringLen = 10000;
45 DEF_MaxArrayLen = 100*1024;
46 DEF_MaxNullStringSearchLen = 10000;
47 DEF_MaxStackStringLen = 512;
48 DEF_MaxStackArrayLen = 64;
49 DEF_MaxStackNullStringSearchLen = 512;
50 private
51 FMaxArrayLen: QWord;
52 FMaxMemReadSize: QWord;
53 FMaxNullStringSearchLen: QWord;
54 FMaxStackArrayLen: QWord;
55 FMaxStackNullStringSearchLen: QWord;
56 FMaxStackStringLen: QWord;
57 FMaxStringLen: QWord;
MaxArrayLenIsStorednull58 function MaxArrayLenIsStored: Boolean;
MaxMemReadSizeIsStorednull59 function MaxMemReadSizeIsStored: Boolean;
MaxNullStringSearchLenIsStorednull60 function MaxNullStringSearchLenIsStored: Boolean;
MaxStackArrayLenIsStorednull61 function MaxStackArrayLenIsStored: Boolean;
MaxStackNullStringSearchLenIsStorednull62 function MaxStackNullStringSearchLenIsStored: Boolean;
MaxStackStringLenIsStorednull63 function MaxStackStringLenIsStored: Boolean;
MaxStringLenIsStorednull64 function MaxStringLenIsStored: Boolean;
65 procedure SetMaxArrayLen(AValue: QWord);
66 procedure SetMaxMemReadSize(AValue: QWord);
67 procedure SetMaxNullStringSearchLen(AValue: QWord);
68 procedure SetMaxStackArrayLen(AValue: QWord);
69 procedure SetMaxStackNullStringSearchLen(AValue: QWord);
70 procedure SetMaxStackStringLen(AValue: QWord);
71 procedure SetMaxStringLen(AValue: QWord);
72 public
73 constructor Create;
74 procedure Assign(Source: TPersistent); override;
75 published
76 property MaxMemReadSize: QWord read FMaxMemReadSize write SetMaxMemReadSize stored MaxMemReadSizeIsStored default DEF_MaxMemReadSize;
77
78 property MaxStringLen: QWord read FMaxStringLen write SetMaxStringLen stored MaxStringLenIsStored default DEF_MaxStringLen;
79 property MaxArrayLen: QWord read FMaxArrayLen write SetMaxArrayLen stored MaxArrayLenIsStored default DEF_MaxArrayLen;
80 property MaxNullStringSearchLen: QWord read FMaxNullStringSearchLen write SetMaxNullStringSearchLen stored MaxNullStringSearchLenIsStored default DEF_MaxNullStringSearchLen;
81
82 property MaxStackStringLen: QWord read FMaxStackStringLen write SetMaxStackStringLen stored MaxStackStringLenIsStored default DEF_MaxStackStringLen;
83 property MaxStackArrayLen: QWord read FMaxStackArrayLen write SetMaxStackArrayLen stored MaxStackArrayLenIsStored default DEF_MaxStackArrayLen;
84 property MaxStackNullStringSearchLen: QWord read FMaxStackNullStringSearchLen write SetMaxStackNullStringSearchLen stored MaxStackNullStringSearchLenIsStored default DEF_MaxStackNullStringSearchLen;
85 end;
86
87 TFpInt3DebugBreakOption = (
88 dboIgnoreAll //, dboIgnoreDLL, dboIgnoreNtdllNoneDebug, dboIgnoreNtdllDebug
89 );
90 TFpInt3DebugBreakOptions = set of TFpInt3DebugBreakOption;
91
92 { TFpDebugDebuggerProperties }
93
94 TFpDebugDebuggerProperties = class(TDebuggerProperties)
95 private
96 FConsoleTty: string;
97 {$ifdef windows}
98 FForceNewConsole: boolean;
99 {$endif windows}
100 FHandleDebugBreakInstruction: TFpInt3DebugBreakOptions;
101 FMemLimits: TFpDebugDebuggerPropertiesMemLimits;
102 FNextOnlyStopOnStartLine: boolean;
103 procedure SetMemLimits(AValue: TFpDebugDebuggerPropertiesMemLimits);
104 public
105 constructor Create; override;
106 destructor Destroy; override;
107 procedure Assign(Source: TPersistent); override;
108 {$ifdef unix}
109 published
110 {$endif unix}
111 property ConsoleTty: string read FConsoleTty write FConsoleTty;
112 published
113 property NextOnlyStopOnStartLine: boolean read FNextOnlyStopOnStartLine write FNextOnlyStopOnStartLine default False;
114 {$ifdef windows}
115 property ForceNewConsole: boolean read FForceNewConsole write FForceNewConsole default True;
116 {$endif windows}
117
118 property MemLimits: TFpDebugDebuggerPropertiesMemLimits read FMemLimits write SetMemLimits;
119 property HandleDebugBreakInstruction: TFpInt3DebugBreakOptions read FHandleDebugBreakInstruction write FHandleDebugBreakInstruction default [dboIgnoreAll];
120 end;
121
122
123 type
124
125 TFpThreadWorkerPriority = (
126 twpModify, // this is a user actions
127 twpUser,
128 twpThread, twpStack, twpLocal, twpWatch,
129 twpContinue
130 );
131
132 const
133 twpInspect = twpWatch;
134 twpDefault = twpUser;
135 type
136
137 { TFpThreadPriorityWorkerItem }
138
139 TFpThreadPriorityWorkerItem = class(TFpThreadWorkerItem)
140 private
141 FPriority: TFpThreadWorkerPriority;
142 public
143 constructor Create(APriority: TFpThreadWorkerPriority);
DebugTextnull144 function DebugText: String; override;
145 property Priority: TFpThreadWorkerPriority read FPriority;
146 end;
147
148 { TFpThreadPriorityWorkerQueue }
149
150 TFpThreadPriorityWorkerQueue = class(TFpThreadWorkerQueue)
151 private
GetOnQueueIdlenull152 function GetOnQueueIdle: TThreadMethod;
153 procedure SetOnQueueIdle(AValue: TThreadMethod);
154 protected type
155 TFpDbgTypedFifoQueue2 = TFpDbgTypedFifoQueue;
156 TFpDbgPriorytyFifoQueue = class(TFpDbgTypedFifoQueue2)
157 private
158 FOnQueueIdle: TThreadMethod;
159 FQueues: array[TFpThreadWorkerPriority] of TFpDbgTypedFifoQueue2;
160 FLowestAvail: TFpThreadWorkerPriority;
161 procedure DoOnIdle(Data: PtrInt);
162 public
163 constructor create(AQueueDepth: Integer = 10);
164 destructor Destroy; override;
PushItemnull165 function PushItem(const AItem: TFpThreadWorkerItem): Boolean; override;
PopItemnull166 function PopItem(out AItem: TFpThreadWorkerItem): Boolean; override;
167 end;
168 protected
CreateFifoQueuenull169 function CreateFifoQueue(AQueueDepth: Integer): TLazTypedFifoQueue; override;
170 public
171 constructor Create(AQueueDepth: Integer = 10; PushTimeout: cardinal = INFINITE; PopTimeout: cardinal = INFINITE);
172 procedure Lock; inline;
173 procedure Unlock; inline;
Countnull174 function Count: Integer;
175 property OnQueueIdle: TThreadMethod read GetOnQueueIdle write SetOnQueueIdle;
176 end;
177
178
179 implementation
180
181 var
182 FPDBG_QUEUE: PLazLoggerLogGroup;
183
184 { TFpDebugDebuggerPropertiesMemLimits }
185
186 procedure TFpDebugDebuggerPropertiesMemLimits.SetMaxMemReadSize(AValue: QWord);
187 begin
188 if (AValue <> 0) and (AValue < MINIMUM_MEMREAD_LIMIT) then
189 AValue := MINIMUM_MEMREAD_LIMIT;
190 if FMaxMemReadSize = AValue then Exit;
191 FMaxMemReadSize := AValue;
192
193 MaxStringLen := MaxStringLen;
194 MaxNullStringSearchLen := MaxNullStringSearchLen;
195 MaxArrayLen := MaxArrayLen;
196 MaxStackStringLen := MaxStackStringLen;
197 MaxStackNullStringSearchLen := MaxStackNullStringSearchLen;
198 MaxStackArrayLen := MaxStackArrayLen;
199 end;
200
201 procedure TFpDebugDebuggerPropertiesMemLimits.SetMaxArrayLen(AValue: QWord);
202 begin
203 if (AValue > FMaxMemReadSize) then
204 AValue := FMaxMemReadSize;
205 if FMaxArrayLen = AValue then Exit;
206 FMaxArrayLen := AValue;
207 end;
208
TFpDebugDebuggerPropertiesMemLimits.MaxArrayLenIsStorednull209 function TFpDebugDebuggerPropertiesMemLimits.MaxArrayLenIsStored: Boolean;
210 begin
211 Result := FMaxArrayLen <> DEF_MaxArrayLen;
212 end;
213
MaxMemReadSizeIsStorednull214 function TFpDebugDebuggerPropertiesMemLimits.MaxMemReadSizeIsStored: Boolean;
215 begin
216 Result := FMaxMemReadSize <> DEF_MaxMemReadSize;
217 end;
218
TFpDebugDebuggerPropertiesMemLimits.MaxNullStringSearchLenIsStorednull219 function TFpDebugDebuggerPropertiesMemLimits.MaxNullStringSearchLenIsStored: Boolean;
220 begin
221 Result := FMaxNullStringSearchLen <> DEF_MaxNullStringSearchLen;
222 end;
223
MaxStackArrayLenIsStorednull224 function TFpDebugDebuggerPropertiesMemLimits.MaxStackArrayLenIsStored: Boolean;
225 begin
226 Result := FMaxStackArrayLen <> DEF_MaxStackArrayLen;
227 end;
228
TFpDebugDebuggerPropertiesMemLimits.MaxStackNullStringSearchLenIsStorednull229 function TFpDebugDebuggerPropertiesMemLimits.MaxStackNullStringSearchLenIsStored: Boolean;
230 begin
231 Result := FMaxStackNullStringSearchLen <> DEF_MaxStackNullStringSearchLen;
232 end;
233
MaxStackStringLenIsStorednull234 function TFpDebugDebuggerPropertiesMemLimits.MaxStackStringLenIsStored: Boolean;
235 begin
236 Result := FMaxStackStringLen <> DEF_MaxStackStringLen;
237 end;
238
MaxStringLenIsStorednull239 function TFpDebugDebuggerPropertiesMemLimits.MaxStringLenIsStored: Boolean;
240 begin
241 Result := FMaxStringLen <> DEF_MaxStringLen;
242 end;
243
244 procedure TFpDebugDebuggerPropertiesMemLimits.SetMaxNullStringSearchLen(AValue: QWord);
245 begin
246 if (AValue > FMaxStringLen) then
247 AValue := FMaxStringLen;
248 if (AValue > FMaxMemReadSize) then
249 AValue := FMaxMemReadSize;
250 if FMaxNullStringSearchLen = AValue then Exit;
251 FMaxNullStringSearchLen := AValue;
252 end;
253
254 procedure TFpDebugDebuggerPropertiesMemLimits.SetMaxStackArrayLen(AValue: QWord
255 );
256 begin
257 if (AValue > FMaxMemReadSize) then
258 AValue := FMaxMemReadSize;
259 if FMaxStackArrayLen = AValue then Exit;
260 FMaxStackArrayLen := AValue;
261 end;
262
263 procedure TFpDebugDebuggerPropertiesMemLimits.SetMaxStackNullStringSearchLen(AValue: QWord);
264 begin
265 if (AValue > FMaxStackStringLen) then
266 AValue := FMaxStackStringLen;
267 if (AValue > FMaxMemReadSize) then
268 AValue := FMaxMemReadSize;
269 if FMaxStackNullStringSearchLen = AValue then Exit;
270 FMaxStackNullStringSearchLen := AValue;
271 end;
272
273 procedure TFpDebugDebuggerPropertiesMemLimits.SetMaxStackStringLen(AValue: QWord);
274 begin
275 if (AValue > FMaxMemReadSize) then
276 AValue := FMaxMemReadSize;
277 if FMaxStackStringLen = AValue then Exit;
278 FMaxStackStringLen := AValue;
279 MaxStackNullStringSearchLen := MaxStackNullStringSearchLen;
280 end;
281
282 procedure TFpDebugDebuggerPropertiesMemLimits.SetMaxStringLen(AValue: QWord);
283 begin
284 if (AValue > FMaxMemReadSize) then
285 AValue := FMaxMemReadSize;
286 if FMaxStringLen = AValue then Exit;
287 FMaxStringLen := AValue;
288 MaxNullStringSearchLen := MaxNullStringSearchLen;
289 end;
290
291 constructor TFpDebugDebuggerPropertiesMemLimits.Create;
292 begin
293 inherited Create;
294 FMaxMemReadSize := DEF_MaxMemReadSize;
295 FMaxStringLen := DEF_MaxStringLen;
296 FMaxArrayLen := DEF_MaxArrayLen;
297 FMaxNullStringSearchLen := DEF_MaxNullStringSearchLen ;
298 FMaxStackStringLen := DEF_MaxStackStringLen;
299 FMaxStackArrayLen := DEF_MaxStackArrayLen;
300 FMaxStackNullStringSearchLen:= DEF_MaxStackNullStringSearchLen;
301 end;
302
303 procedure TFpDebugDebuggerPropertiesMemLimits.Assign(Source: TPersistent);
304 begin
305 if Source is TFpDebugDebuggerPropertiesMemLimits then begin
306 FMaxMemReadSize := TFpDebugDebuggerPropertiesMemLimits(Source).FMaxMemReadSize;
307 FMaxStringLen := TFpDebugDebuggerPropertiesMemLimits(Source).FMaxStringLen;
308 FMaxArrayLen := TFpDebugDebuggerPropertiesMemLimits(Source).FMaxArrayLen;
309 FMaxNullStringSearchLen := TFpDebugDebuggerPropertiesMemLimits(Source).FMaxNullStringSearchLen;
310 FMaxStackStringLen := TFpDebugDebuggerPropertiesMemLimits(Source).FMaxStackStringLen;
311 FMaxStackArrayLen := TFpDebugDebuggerPropertiesMemLimits(Source).FMaxStackArrayLen;
312 FMaxStackNullStringSearchLen:= TFpDebugDebuggerPropertiesMemLimits(Source).FMaxStackNullStringSearchLen;
313 end;
314 end;
315
316 { TFpDebugDebuggerProperties }
317
318 procedure TFpDebugDebuggerProperties.SetMemLimits(AValue: TFpDebugDebuggerPropertiesMemLimits);
319 begin
320 FMemLimits.Assign(AValue);
321 end;
322
323 constructor TFpDebugDebuggerProperties.Create;
324 begin
325 inherited Create;
326 FNextOnlyStopOnStartLine:=False;
327 {$ifdef windows}
328 FForceNewConsole := True;
329 {$endif windows}
330 FMemLimits := TFpDebugDebuggerPropertiesMemLimits.Create;
331 FHandleDebugBreakInstruction := [dboIgnoreAll];
332 end;
333
334 destructor TFpDebugDebuggerProperties.Destroy;
335 begin
336 inherited Destroy;
337 FMemLimits.Free;
338 end;
339
340 procedure TFpDebugDebuggerProperties.Assign(Source: TPersistent);
341 begin
342 inherited Assign(Source);
343 if Source is TFpDebugDebuggerProperties then begin
344 FNextOnlyStopOnStartLine := TFpDebugDebuggerProperties(Source).NextOnlyStopOnStartLine;
345 FConsoleTty:=TFpDebugDebuggerProperties(Source).ConsoleTty;
346 {$ifdef windows}
347 FForceNewConsole:=TFpDebugDebuggerProperties(Source).FForceNewConsole;
348 {$endif windows}
349 FMemLimits.Assign(TFpDebugDebuggerProperties(Source).MemLimits);
350 FHandleDebugBreakInstruction:=TFpDebugDebuggerProperties(Source).FHandleDebugBreakInstruction;
351 end;
352 end;
353
354 { TFpThreadPriorityWorkerItem }
355
356 constructor TFpThreadPriorityWorkerItem.Create(
357 APriority: TFpThreadWorkerPriority);
358 begin
359 FPriority := APriority;
360 end;
361
DebugTextnull362 function TFpThreadPriorityWorkerItem.DebugText: String;
363 begin
364 WriteStr(Result, FPriority);
365 Result := inherited DebugText + '[' + Result + ':' + IntToStr(ord(FPriority)) + ']';
366 end;
367
368 { TFpThreadPriorityWorkerQueue.TFpDbgPriorytyFifoQueue }
369
370 procedure TFpThreadPriorityWorkerQueue.TFpDbgPriorytyFifoQueue.DoOnIdle(
371 Data: PtrInt);
372 begin
373 if Assigned(FOnQueueIdle) then
374 FOnQueueIdle();
375 end;
376
377 constructor TFpThreadPriorityWorkerQueue.TFpDbgPriorytyFifoQueue.create(
378 AQueueDepth: Integer);
379 var
380 a: TFpThreadWorkerPriority;
381 begin
382 inherited create(0);
383 for a in TFpThreadWorkerPriority do
384 FQueues[a] := TFpDbgTypedFifoQueue2.create(AQueueDepth);
385 end;
386
387 destructor TFpThreadPriorityWorkerQueue.TFpDbgPriorytyFifoQueue.Destroy;
388 var
389 a: TFpThreadWorkerPriority;
390 begin
391 Application.RemoveAsyncCalls(Self);
392 inherited Destroy;
393 for a in TFpThreadWorkerPriority do
394 FQueues[a].Free;
395 end;
396
TFpDbgPriorytyFifoQueuenull397 function TFpThreadPriorityWorkerQueue.TFpDbgPriorytyFifoQueue.PushItem(
398 const AItem: TFpThreadWorkerItem): Boolean;
399 begin
400 Application.RemoveAsyncCalls(Self);
401 inc(FTotalItemsPushed);
402 if not (AItem is TFpThreadPriorityWorkerItem) then begin
403 Result := FQueues[twpDefault].PushItem(AItem);
404 if twpDefault < FLowestAvail then
405 FLowestAvail := twpDefault;
406 end
407 else begin
408 Result := FQueues[TFpThreadPriorityWorkerItem(AItem).FPriority].PushItem(AItem);
409 if TFpThreadPriorityWorkerItem(AItem).FPriority < FLowestAvail then
410 FLowestAvail := TFpThreadPriorityWorkerItem(AItem).FPriority;
411 end;
412 end;
413
TFpThreadPriorityWorkerQueue.TFpDbgPriorytyFifoQueue.PopItemnull414 function TFpThreadPriorityWorkerQueue.TFpDbgPriorytyFifoQueue.PopItem(out
415 AItem: TFpThreadWorkerItem): Boolean;
416 begin
417 Result := FQueues[FLowestAvail].PopItem(AItem);
418 while (not Result) and (FLowestAvail < high(FLowestAvail)) do begin
419 inc(FLowestAvail);
420 Result := FQueues[FLowestAvail].PopItem(AItem);
421 end;
422 if Result then begin
423 inc(FTotalItemsPopped)
424 end
425 else begin
426 // IDLE => there is only one worker thread, so no other items are running
427 if Assigned(FOnQueueIdle) then
428 Application.QueueAsyncCall(@DoOnIdle, 0);
429 end;
430 assert(result or (TotalItemsPushed=TotalItemsPopped), 'TFpThreadPriorityWorkerQueue.TFpDbgPriorytyFifoQueue.PopItem: result or (TotalItemsPushed=TotalItemsPopped)');
431 end;
432
433 { TFpThreadPriorityWorkerQueue }
434
GetOnQueueIdlenull435 function TFpThreadPriorityWorkerQueue.GetOnQueueIdle: TThreadMethod;
436 begin
437 Result := TFpDbgPriorytyFifoQueue(FifoQueue).FOnQueueIdle;
438 end;
439
440 procedure TFpThreadPriorityWorkerQueue.SetOnQueueIdle(AValue: TThreadMethod);
441 begin
442 TFpDbgPriorytyFifoQueue(FifoQueue).FOnQueueIdle := AValue;
443 end;
444
CreateFifoQueuenull445 function TFpThreadPriorityWorkerQueue.CreateFifoQueue(AQueueDepth: Integer
446 ): TLazTypedFifoQueue;
447 begin
448 Result := TFpDbgPriorytyFifoQueue.Create(AQueueDepth);
449 end;
450
451 constructor TFpThreadPriorityWorkerQueue.Create(AQueueDepth: Integer;
452 PushTimeout: cardinal; PopTimeout: cardinal);
453 begin
454 inherited Create(AQueueDepth, PushTimeout, PopTimeout);
455 FLogGroup := FPDBG_QUEUE;
456 end;
457
458 procedure TFpThreadPriorityWorkerQueue.Lock;
459 begin
460 inherited Lock;
461 end;
462
463 procedure TFpThreadPriorityWorkerQueue.Unlock;
464 begin
465 inherited Unlock;
466 end;
467
Countnull468 function TFpThreadPriorityWorkerQueue.Count: Integer;
469 begin
470 Result := TotalItemsPushed - TotalItemsPopped;
471 end;
472
473 initialization
474 FPDBG_QUEUE := DebugLogger.FindOrRegisterLogGroup('FPDBG_QUEUE' {$IFDEF FPDBG_QUEUE} , True {$ENDIF} );
475 end.
476
477