/
DestructionQueue.pas
133 lines (100 loc) · 2.31 KB
/
DestructionQueue.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
unit DestructionQueue;
interface
uses
debug, managedthread, generics.collections.fixed, classes, sysutils, better_collections, betterobject, orderlyinit;
type
EDestructionQueueError = class(Exception);
TDestructionQueue = class(TManagedThread)
protected
FList: TSharedList<TObject>;
FIncoming: TSharedList<TObject>;
public
procedure Init;override;
procedure Detach;override;
procedure Add(o: TObject);
procedure DoExecute;override;
end;
var
dq: TDestructionQueue = nil;
implementation
{ TDestructionQueue }
procedure TDestructionQueue.Add(o: TObject);
begin
if o = nil then begin
Debug.Log(self,'Why are you adding a nil object to the DQ?');
exit;
end;
FIncoming.Lock;
try
FIncoming.add(o);
HAsWork := true;//NOTE: HASWORK should always be evaluated under the FINcoming lock;
finally
FIncoming.Unlock;
end;
end;
procedure TDestructionQueue.Detach;
begin
if FList.count> 0 then
raise EDestructionQueueError.create('Cannot detach the destruction queue until its objects are destroyed.');
FList.Free;
FIncoming.free;
inherited;
end;
procedure TDestructionQueue.DoExecute;
var
o: TObject;
t: nativeint;
begin
o := nil;
if (FList.Count > 0) then begin
o := FList[0];
FList.Delete(0);
end else begin
FIncoming.Lock;
try
for t:= 0 to FIncoming.count-1 do begin
fList.add(FIncoming[t]);
end;
FIncoming.Clear;
HasWork := FLIst.count > 0;//NOTE: HASWORK should always be evaluated under the FINcoming lock;
finally
Fincoming.unlock;
end;
end;
if o <> nil then begin
Debug.log('DQ: Destroy '+o.classname);
if o is TBetterObject then
TBetterObject(o).Detach;
o.free;
end;
end;
procedure TDestructionQueue.Init;
begin
inherited;
FIncoming := TSharedList<TObject>.create;
FList := TSharedList<TObject>.create;
Loop := true;
end;
procedure oinit;
begin
dq := TPM.NeedThread<TDestructionQueue>(nil);
dq.BeginStart;
// dq.EndStart;
// dq.Start;
end;
procedure ofinal;
begin
//dq.EndStart;
dq.Stop;
dq.SafeWaitFor;
TPM.NoNeedthread(dq);
dq := nil;
end;
procedure oLATEfinal;
begin
// dq.free;
dq := nil;
end;
initialization
orderlyinit.init.RegisterProcs('DestructionQueue',oinit, nil, ofinal, oLATEfinal, 'BackgroundThreads,ManagedThread');
end.