1 unit DbgIntfMiscClasses;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, LazClasses;
9
10 type
11
12 (* TDbgEntityValue are created with a refcount of 0 (zero)
13 *)
14
15 TDbgEntityValuesList = class;
16 TDbgEntitiesThreadStackList = class;
17
18 { TDbgEntityValue
19 Locals, Watches, Registers
20 }
21
22 TDbgEntityValue = class(TRefCountedObject)
23 private
24 FOwner: TDbgEntityValuesList;
25 FFlags: set of (devImmutable);
GetImmutablenull26 function GetImmutable: Boolean;
GetStackFramenull27 function GetStackFrame: Integer;
GetThreadIdnull28 function GetThreadId: Integer;
29 procedure SetImmutable(AValue: Boolean);
30 protected
31 procedure DoAssign({%H-}AnOther: TDbgEntityValue); virtual;
32 property Owner: TDbgEntityValuesList read FOwner;
33 public
34 procedure Assign({%H-}AnOther: TDbgEntityValue);
35 property ThreadId: Integer read GetThreadId;
36 property StackFrame: Integer read GetStackFrame;
37 property Immutable: Boolean read GetImmutable write SetImmutable; // mainly used by assert
38 end;
39
40 { TDbgEntityValuesList
41 All Values for a specifer Thread/StackFrame
42 }
43
44 TDbgEntityValuesList = class(TRefCountedObject)
45 private
46 FStackFrame: Integer;
47 FThreadId: Integer;
48 FFlags: set of (devlImmutable);
49 FList: TRefCntObjList;
50 FOwner: TDbgEntitiesThreadStackList;
GetEntrynull51 function GetEntry(AnIndex: Integer): TDbgEntityValue;
GetImmutablenull52 function GetImmutable: Boolean;
53 procedure SetImmutable(AValue: Boolean);
54 protected
CreateEntrynull55 function CreateEntry: TDbgEntityValue; virtual; abstract;
56 procedure DoAssign(AnOther: TDbgEntityValuesList); virtual; // assert other has same thread/stack
57 procedure DoAssignListContent(AnOther: TDbgEntityValuesList); virtual; // assert other has same thread/stack
58 procedure DoCleared; virtual;
59 procedure DoAdded({%H-}AnEntry: TDbgEntityValue); virtual;
60 procedure Init; virtual;
61 property Owner: TDbgEntitiesThreadStackList read FOwner;
62 public
63 constructor Create(AThreadId, AStackFrame: Integer);
64 destructor Destroy; override;
65 procedure Assign(AnOther: TDbgEntityValuesList); // assert other has same thread/stack
66 procedure Add(AnEntry: TDbgEntityValue);
67 procedure Clear;
Countnull68 function Count: Integer;
69 property Entries[AnIndex: Integer]: TDbgEntityValue read GetEntry;
70
71 property ThreadId: Integer read FThreadId;
72 property StackFrame: Integer read FStackFrame;
73 property Immutable: Boolean read GetImmutable write SetImmutable; // mainly used by assert
74 end;
75
76 TDbgValuesThreadList = record
77 ThreadId: Integer;
78 List: TRefCntObjList;
79 end;
80
81 { TDbgEntitiesThreadStackList }
82
83 TDbgEntitiesThreadStackList = class(TRefCountedObject)
84 private
85 FList: array of TDbgValuesThreadList;
86 FFlags: set of (devtsImmutable);
GetEntrynull87 function GetEntry(AThreadId, AStackFrame: Integer): TDbgEntityValuesList;
GetEntryByIdxnull88 function GetEntryByIdx(AnIndex: Integer): TDbgEntityValuesList;
GetHasEntrynull89 function GetHasEntry(AThreadId, AStackFrame: Integer): Boolean;
GetImmutablenull90 function GetImmutable: Boolean;
IndexOfThreadnull91 function IndexOfThread(AThreadId: Integer; ACreateSubList: Boolean = False): Integer;
92 procedure SetImmutable(AValue: Boolean);
93 protected
CreateEntrynull94 function CreateEntry(AThreadId, AStackFrame: Integer): TDbgEntityValuesList; virtual; abstract;
95 procedure DoAssign(AnOther: TDbgEntitiesThreadStackList); virtual;
96 procedure DoAssignListContent(AnOther: TDbgEntitiesThreadStackList); virtual;
97 procedure DoCleared; virtual;
98 procedure DoAdded({%H-}AnEntry: TDbgEntityValuesList); virtual;
99 public
100 destructor Destroy; override;
101 procedure Assign(AnOther: TDbgEntitiesThreadStackList);
102 procedure Add(AnEntry: TDbgEntityValuesList);
103 procedure Clear;
Countnull104 function Count: Integer;
105 property EntriesByIdx[AnIndex: Integer]: TDbgEntityValuesList read GetEntryByIdx;
106 // Entries will automatically be created
107 property Entries[AThreadId, AStackFrame: Integer]: TDbgEntityValuesList read GetEntry; default;
108 property HasEntry[AThreadId, AStackFrame: Integer]: Boolean read GetHasEntry;
109 property Immutable: Boolean read GetImmutable write SetImmutable; // used by assert
110 end;
111
112 { TDelayedUdateItem }
113
114 TDelayedUdateItem = class(TCollectionItem)
115 private
116 FUpdateCount: Integer;
117 FDoChanged: Boolean;
118 protected
119 procedure Changed;
120 procedure DoChanged; virtual;
121 procedure DoEndUpdate; virtual; // even if not changed
122 public
123 procedure Assign(ASource: TPersistent); override;
124 procedure BeginUpdate; virtual;
125 constructor Create(ACollection: TCollection); override;
126 procedure EndUpdate;
IsUpdatingnull127 function IsUpdating: Boolean;
128 end;
129
130 { TRefCountedColectionItem }
131
132 TRefCountedColectionItem = class(TDelayedUdateItem)
133 public
134 constructor Create(ACollection: TCollection); override;
135 destructor Destroy; override;
136 procedure AddReference;
137 procedure ReleaseReference;
138 private
139 FRefCount: Integer;
140 protected
141 procedure DoFree; virtual;
142 property RefCount: Integer read FRefCount;
143 end;
144
145 procedure ReleaseRefAndNil(var ARefCountedObject);
146
147 implementation
148
149 procedure ReleaseRefAndNil(var ARefCountedObject);
150 begin
151 Assert( (Pointer(ARefCountedObject) = nil) or
152 (TObject(ARefCountedObject) is TRefCountedObject) or
153 (TObject(ARefCountedObject) is TRefCountedColectionItem),
154 'ReleaseRefAndNil requires TRefCountedObject');
155
156 if Pointer(ARefCountedObject) = nil then
157 exit;
158
159 if (TObject(ARefCountedObject) is TRefCountedObject) then
160 TRefCountedObject(ARefCountedObject).ReleaseReference
161 else
162 if (TObject(ARefCountedObject) is TRefCountedColectionItem) then
163 TRefCountedColectionItem(ARefCountedObject).ReleaseReference;
164
165 Pointer(ARefCountedObject) := nil;
166 end;
167
168 { TDbgEntityValue }
169
TDbgEntityValue.GetImmutablenull170 function TDbgEntityValue.GetImmutable: Boolean;
171 begin
172 Result := (devImmutable in FFlags) or ((FOwner <> nil) and FOwner.Immutable);
173 end;
174
GetStackFramenull175 function TDbgEntityValue.GetStackFrame: Integer;
176 begin
177 Result := FOwner.StackFrame;
178 end;
179
GetThreadIdnull180 function TDbgEntityValue.GetThreadId: Integer;
181 begin
182 Result := FOwner.ThreadId;
183 end;
184
185 procedure TDbgEntityValue.SetImmutable(AValue: Boolean);
186 begin
187 assert((AValue = True) or not(Immutable), 'TDbgEntityValue.SetImmutable Not allowed to set to false');
188 if AValue then Include(FFlags, devImmutable);
189 end;
190
191 procedure TDbgEntityValue.DoAssign(AnOther: TDbgEntityValue);
192 begin
193 //
194 end;
195
196 procedure TDbgEntityValue.Assign(AnOther: TDbgEntityValue);
197 begin
198 Assert(not Immutable, 'TDbgEntityValue.Assign Immutable');
199 DoAssign(AnOther);
200 end;
201
202 { TDbgEntityValuesList }
203
TDbgEntityValuesList.GetImmutablenull204 function TDbgEntityValuesList.GetImmutable: Boolean;
205 begin
206 Result := devlImmutable in FFlags;
207 end;
208
GetEntrynull209 function TDbgEntityValuesList.GetEntry(AnIndex: Integer): TDbgEntityValue;
210 begin
211 Result := TDbgEntityValue(FList[AnIndex]);
212 end;
213
214 procedure TDbgEntityValuesList.SetImmutable(AValue: Boolean);
215 begin
216 assert((AValue = True) or not(devlImmutable in FFlags), 'TDbgEntityValuesList.SetImmutable Not allowed to set to false');
217 if AValue then Include(FFlags, devlImmutable);
218 end;
219
220 procedure TDbgEntityValuesList.DoCleared;
221 begin
222 //
223 end;
224
225 procedure TDbgEntityValuesList.DoAdded(AnEntry: TDbgEntityValue);
226 begin
227
228 end;
229
230 procedure TDbgEntityValuesList.Init;
231 begin
232 //
233 end;
234
235 constructor TDbgEntityValuesList.Create(AThreadId, AStackFrame: Integer);
236 begin
237 inherited Create;
238 FFlags := [];
239 FThreadId := AThreadId;
240 FStackFrame := AStackFrame;
241 FList := TRefCntObjList.Create;
242 Init;
243 end;
244
245 destructor TDbgEntityValuesList.Destroy;
246 begin
247 Exclude(FFlags, devlImmutable);
248 Clear;
249 FList.Free;
250 inherited Destroy;
251 end;
252
253 procedure TDbgEntityValuesList.DoAssign(AnOther: TDbgEntityValuesList);
254 begin
255 DoAssignListContent(AnOther);
256 end;
257
258 procedure TDbgEntityValuesList.DoAssignListContent(AnOther: TDbgEntityValuesList);
259 var
260 e: TDbgEntityValue;
261 i: Integer;
262 begin
263 for i := 0 to AnOther.FList.Count - 1 do begin
264 e := CreateEntry;
265 e.FOwner := Self;
266 e.Assign(TDbgEntityValue(AnOther.FList[i]));
267 FList.Add(e);
268 end;
269 end;
270
271 procedure TDbgEntityValuesList.Assign(AnOther: TDbgEntityValuesList);
272 begin
273 Assert(not Immutable, 'TDbgEntityValuesList.Assign Immutable');
274 Assert((FThreadId = AnOther.FThreadId) and (FStackFrame = AnOther.FStackFrame), 'TDbgEntityValuesList.Assign same thread and stack');
275
276 Clear;
277 DoAssign(AnOther);
278 end;
279
280 procedure TDbgEntityValuesList.Add(AnEntry: TDbgEntityValue);
281 begin
282 Assert(not Immutable, 'TDbgEntityValuesList.Add Immutable');
283 AnEntry.FOwner := Self;
284 FList.Add(AnEntry);
285 DoAdded(AnEntry);
286 end;
287
288 procedure TDbgEntityValuesList.Clear;
289 var
290 i: Integer;
291 begin
292 Assert(not Immutable, 'TDbgEntityValuesList.Clear Immutable');
293 if FList.Count = 0 then
294 exit;
295 for i := 0 to FList.Count - 1 do
296 TDbgEntityValue(FList[i]).FOwner := nil;
297 FList.Clear;
298 DoCleared;
299 end;
300
Countnull301 function TDbgEntityValuesList.Count: Integer;
302 begin
303 Result := FList.Count;
304 end;
305
306 { TDbgEntitiesThreadStackList }
307
GetEntrynull308 function TDbgEntitiesThreadStackList.GetEntry(AThreadId, AStackFrame: Integer): TDbgEntityValuesList;
309 var
310 i, j: Integer;
311 begin
312 i := IndexOfThread(AThreadId);
313 if i >= 0 then begin
314 // TODO: binary search / need sorted list
315 for j := 0 to FList[i].List.Count - 1 do begin
316 Result := TDbgEntityValuesList(FList[i].List[j]);
317 if Result.StackFrame = AStackFrame then
318 exit;
319 end;
320 end;
321
322 if Immutable then begin
323 Result := nil;
324 exit;
325 end;
326
327 Result := CreateEntry(AThreadId, AStackFrame);
328 Add(Result);
329 end;
330
TDbgEntitiesThreadStackList.GetEntryByIdxnull331 function TDbgEntitiesThreadStackList.GetEntryByIdx(AnIndex: Integer): TDbgEntityValuesList;
332 var
333 i: Integer;
334 begin
335 Result := nil;
336 i := 0;
337 while AnIndex >= FList[i].List.Count do begin
338 dec(AnIndex, FList[i].List.Count);
339 inc(i);
340 if i >= Length(FList) then
341 exit;
342 end;
343 Result := TDbgEntityValuesList(FList[i].List[AnIndex]);
344 end;
345
GetHasEntrynull346 function TDbgEntitiesThreadStackList.GetHasEntry(AThreadId, AStackFrame: Integer): Boolean;
347 var
348 i, j: Integer;
349 begin
350 Result := False;
351 i := IndexOfThread(AThreadId);
352 if i < 0 then exit;
353 // TODO: binary search / need sorted list
354 for j := 0 to FList[i].List.Count - 1 do begin
355 if TDbgEntityValuesList(FList[i].List[j]).StackFrame = AStackFrame then begin
356 Result := True;
357 exit;
358 end;
359 end;
360 end;
361
TDbgEntitiesThreadStackList.GetImmutablenull362 function TDbgEntitiesThreadStackList.GetImmutable: Boolean;
363 begin
364 Result := devtsImmutable in FFlags;
365 end;
366
IndexOfThreadnull367 function TDbgEntitiesThreadStackList.IndexOfThread(AThreadId: Integer;
368 ACreateSubList: Boolean): Integer;
369 begin
370 Result := length(FList) - 1;
371 while (Result >= 0) and (FList[Result].ThreadId <> AThreadId) do
372 dec(Result);
373 if (Result >= 0) or (not ACreateSubList) then
374 exit;
375
376 Result := length(FList);
377 SetLength(FList, Result + 1);
378 FList[Result].ThreadId := AThreadId;
379 FList[Result].List := TRefCntObjList.Create;
380 end;
381
382 procedure TDbgEntitiesThreadStackList.SetImmutable(AValue: Boolean);
383 begin
384 assert((AValue = True) or not(devtsImmutable in FFlags), 'TDbgEntityValuesList.SetImmutable Not allowed to set to false');
385 if AValue then Include(FFlags, devtsImmutable);
386 end;
387
388 procedure TDbgEntitiesThreadStackList.DoCleared;
389 begin
390 //
391 end;
392
393 procedure TDbgEntitiesThreadStackList.DoAdded(AnEntry: TDbgEntityValuesList);
394 begin
395 //
396 end;
397
398 destructor TDbgEntitiesThreadStackList.Destroy;
399 begin
400 Exclude(FFlags, devtsImmutable);
401 Clear;
402 inherited Destroy;
403 end;
404
405 procedure TDbgEntitiesThreadStackList.DoAssign(AnOther: TDbgEntitiesThreadStackList);
406 begin
407 DoAssignListContent(AnOther);
408 end;
409
410 procedure TDbgEntitiesThreadStackList.DoAssignListContent(AnOther: TDbgEntitiesThreadStackList);
411 var
412 i, j: Integer;
413 t: Integer;
414 e, o: TDbgEntityValuesList;
415 begin
416 SetLength(FList, length(AnOther.FList));
417 for i := 0 to Length(FList) - 1 do begin
418 t := AnOther.FList[i].ThreadId;
419 FList[i].ThreadId := t;
420 FList[i].List := TRefCntObjList.Create;
421 for j := 0 to AnOther.FList[i].List.Count - 1 do begin
422 o := TDbgEntityValuesList(AnOther.FList[i].List[j]);
423 e := CreateEntry(t, o.StackFrame);
424 e.FOwner := Self;
425 e.Assign(o);
426 FList[i].List.Add(e);
427 end;
428 end;
429 end;
430
431 procedure TDbgEntitiesThreadStackList.Assign(AnOther: TDbgEntitiesThreadStackList);
432 begin
433 Assert(not Immutable, 'TDbgEntitiesThreadStackList.Assign Immutable');
434 Clear;
435 DoAssign(AnOther);
436 end;
437
438 procedure TDbgEntitiesThreadStackList.Add(AnEntry: TDbgEntityValuesList);
439 var
440 i: Integer;
441 begin
442 Assert(not Immutable, 'TDbgEntitiesThreadStackList.Add Immutable');
443 Assert((AnEntry.FOwner = nil) or (AnEntry.FOwner = Self), 'TDbgEntitiesThreadStackList.Add Entry.FThreadStackList');
444 AnEntry.FOwner := Self;
445 i := IndexOfThread(AnEntry.ThreadId, True);
446 FList[i].List.Add(AnEntry);
447 DoAdded(AnEntry);
448 end;
449
450 procedure TDbgEntitiesThreadStackList.Clear;
451 var
452 i, j: Integer;
453 begin
454 Assert(not Immutable, 'TDbgEntitiesThreadStackList.Clear Immutable');
455 if Length(FList) = 0 then
456 exit;
457 for i := 0 to Length(FList) - 1 do begin
458 for j := 0 to FList[i].List.Count - 1 do
459 TDbgEntityValuesList(FList[i].List[j]).FOwner := nil;
460 FList[i].List.Free;
461 end;
462 SetLength(FList, 0);
463 DoCleared;
464 end;
465
TDbgEntitiesThreadStackList.Countnull466 function TDbgEntitiesThreadStackList.Count: Integer;
467 var
468 i: Integer;
469 begin
470 Result := 0;
471 for i := 0 to Length(FList) - 1 do
472 Result := Result + FList[i].List.Count;
473 end;
474
475
476 { TDelayedUdateItem }
477
478 procedure TDelayedUdateItem.Assign(ASource: TPersistent);
479 begin
480 BeginUpdate;
481 try
482 inherited Assign(ASource);
483 finally
484 EndUpdate;
485 end;
486 end;
487
488 procedure TDelayedUdateItem.BeginUpdate;
489 begin
490 Inc(FUpdateCount);
491 if FUpdateCount = 1 then FDoChanged := False;
492 end;
493
494 procedure TDelayedUdateItem.Changed;
495 begin
496 if FUpdateCount > 0
497 then FDoChanged := True
498 else DoChanged;
499 end;
500
501 constructor TDelayedUdateItem.Create(ACollection: TCollection);
502 begin
503 inherited Create(ACollection);
504 FUpdateCount := 0;
505 end;
506
507 procedure TDelayedUdateItem.DoChanged;
508 begin
509 inherited Changed(False);
510 end;
511
512 procedure TDelayedUdateItem.DoEndUpdate;
513 begin
514 //
515 end;
516
517 procedure TDelayedUdateItem.EndUpdate;
518 begin
519 Dec(FUpdateCount);
520 if FUpdateCount < 0 then raise EInvalidOperation.Create('TDelayedUdateItem.EndUpdate');
521 if (FUpdateCount = 0)
522 then DoEndUpdate;
523 if (FUpdateCount = 0) and FDoChanged
524 then begin
525 DoChanged;
526 FDoChanged := False;
527 end;
528 end;
529
TDelayedUdateItem.IsUpdatingnull530 function TDelayedUdateItem.IsUpdating: Boolean;
531 begin
532 Result := FUpdateCount > 0;
533 end;
534
535
536 { TRefCountedColectionItem }
537
538 constructor TRefCountedColectionItem.Create(ACollection: TCollection);
539 begin
540 FRefCount := 0;
541 inherited Create(ACollection);
542 end;
543
544 destructor TRefCountedColectionItem.Destroy;
545 begin
546 Assert(FRefcount = 0, 'Destroying referenced object');
547 inherited Destroy;
548 end;
549
550 procedure TRefCountedColectionItem.AddReference;
551 begin
552 Inc(FRefcount);
553 end;
554
555 procedure TRefCountedColectionItem.ReleaseReference;
556 begin
557 Assert(FRefCount > 0, 'TRefCountedObject.ReleaseReference RefCount > 0');
558 Dec(FRefCount);
559 if FRefCount = 0 then DoFree;
560 end;
561
562 procedure TRefCountedColectionItem.DoFree;
563 begin
564 Self.Free;
565 end;
566
567 end.
568
569