| 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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
| ///////////////////////////////////////////////////////////////////////////
// //
// Copyright (c) 2015 by Charta Software B.V. //
// All rights reserved //
// //
// Version: 1.7.0.83525 //
// Web site: https://pascal.chartasoftware.com/ //
// //
// This code and information are provided "as is" without warranty of //
// any kind. Dissemination of this information or reproduction of //
// this material is strictly forbidden unless prior written permission //
// is obtained from Charta Software B.V.. //
// //
///////////////////////////////////////////////////////////////////////////
unit Object_.ReferenceCounted;
interface
uses
Exception,
Integer._32,
Object_.Base;
type
TReferenceCountedObject = class(TBaseObject)
protected
FReferenceCount: TInteger32;
function IncreaseReferenceCount(): TInteger32; virtual;
function DecreaseReferenceCount(): TInteger32; virtual;
public
constructor Create(); override;
destructor Destroy(); override;
procedure Free(DummyParameterToHideInheritedMethod: TInteger32); reintroduce;
procedure AddReference();
procedure ReleaseReference();
procedure Discard();
procedure DiscardReference();
property ReferenceCount: TInteger32 read FReferenceCount;
end;
EReferenceCountBelowZero = class(EException)
public
constructor Create(Value: TReferenceCountedObject); reintroduce; virtual;
end;
EReferenceCountShouldBeZero = class(EException)
public
constructor Create(Value: TReferenceCountedObject); reintroduce; virtual;
end;
implementation
uses
Memory.Address;
{ TReferenceCountedObject }
procedure TReferenceCountedObject.AddReference();
begin
if Self <> nil then
IncreaseReferenceCount();
end;
constructor TReferenceCountedObject.Create();
begin
inherited Create();
if TMemoryAddress(@FReferenceCount) mod 4 <> 0 then
raise EException.Create('Reference count variable should be aligned on 32-bit boundary');
end;
function TReferenceCountedObject.DecreaseReferenceCount(): TInteger32;
begin
Result := InterlockedDecrement(FReferenceCount);
if Result = 0 then
Destroy()
else if Result < 0 then
raise EReferenceCountBelowZero.Create(Self);
end;
destructor TReferenceCountedObject.Destroy();
begin
if FReferenceCount <> 0 then
raise EReferenceCountShouldBeZero.Create(Self);
inherited Destroy();
end;
procedure TReferenceCountedObject.Discard();
begin
AddReference();
ReleaseReference();
end;
procedure TReferenceCountedObject.DiscardReference();
var
NewCount: TInteger32;
begin
NewCount := InterlockedDecrement(FReferenceCount);
if NewCount < 0 then
raise EReferenceCountBelowZero.Create(Self);
end;
procedure TReferenceCountedObject.Free(DummyParameterToHideInheritedMethod: TInteger32);
begin
end;
function TReferenceCountedObject.IncreaseReferenceCount(): TInteger32;
begin
Result := InterlockedIncrement(FReferenceCount);
end;
procedure TReferenceCountedObject.ReleaseReference();
begin
if Self <> nil then
DecreaseReferenceCount();
end;
{ EReferenceCountBelowZero }
constructor EReferenceCountBelowZero.Create(Value: TReferenceCountedObject);
begin
inherited Create('Reference count below zero: ' + Value.ClassName);
end;
{ EReferenceCountShouldBeZero }
constructor EReferenceCountShouldBeZero.Create(Value: TReferenceCountedObject);
begin
inherited Create('Reference count should be zero: ' + Value.ClassName);
end;
end.
|