FazBrowse GitHub Viewer
|
Trending
|
URL:
|
Home
Tools:
[Download Repo ZIP]
[View Raw Code]
[Original HTTPS Page]
DelphiAST/Source/StringPool.pas at master · RoutineOp/DelphiAST · GitHub
RoutineOp
DelphiAST
Repository navigation
Code
Pull requests
Actions
Projects
Wiki
Security and quality
Insights
Expand file tree
Breadcrumbs
DelphiAST
/
Source
/
StringPool.pas
Copy path
More file actions
More file actions
Latest commit
History
History
History
118 lines (98 loc) · 2.12 KB
Breadcrumbs
DelphiAST
/
Source
/
StringPool.pas
Copy path
File metadata and controls
118 lines (98 loc) · 2.12 KB
Raw
Copy raw file
Download raw file
Open symbols panel
Edit and raw actions
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
unit
StringPool;
{
$IFDEF FPC
}{
$MODE Delphi
}{
$ENDIF
}
interface
type
TStringBucket =
record
Hash: Cardinal;
Value
: string;
end
;
PStringBucket = ^TStringBucket;
TStringBuckets =
array
of
TStringBucket;
TStringPool =
class
private
FBuckets: TStringBuckets;
FCount: Integer;
FGrowth: Integer;
FCapacity: Integer;
procedure
Grow
;
public
procedure
StringIntern
(
var
s: string);
procedure
Clear
;
property
Count: Integer read FCount;
end
;
implementation
{
TStringPool
}
procedure
TStringPool.Clear
;
begin
SetLength(FBuckets,
0
);
FCount :=
0
;
FGrowth :=
0
;
FCapacity :=
0
;
end
;
procedure
TStringPool.Grow
;
var
i, j, n: Integer;
oldBuckets: TStringBuckets;
begin
if
FCapacity =
0
then
FCapacity :=
32
else
FCapacity := FCapacity *
2
;
FGrowth := (FCapacity *
3
)
div
4
- FCount;
oldBuckets := FBuckets;
FBuckets :=
nil
;
SetLength(FBuckets, FCapacity);
n := FCapacity -
1
;
for
i :=
0
to
High(oldBuckets)
do
begin
if
oldBuckets[i].Hash =
0
then
Continue;
j := oldBuckets[i].Hash
and
(FCapacity -
1
);
while
FBuckets[j].Hash <>
0
do
j := (j +
1
)
and
n;
FBuckets[j].Hash := oldBuckets[i].Hash;
FBuckets[j].
Value
:= oldBuckets[i].
Value
;
end
;
end
;
procedure
TStringPool.StringIntern
(
var
s: string);
{
$OVERFLOWCHECKS OFF
}
function
HashString
(
const
s: string): Cardinal; inline;
var
i: Integer;
begin
//
modified FNV-1a using length as seed
Result := Length(s);
for
i :=
1
to
Result
do
Result := (Result
xor
Ord(s[i])) *
16777619
;
end
;
{
$OVERFLOWCHECKS ON
}
var
hash: Cardinal;
i: Integer;
bucket: PStringBucket;
begin
if
s =
'
'
then
Exit;
if
FGrowth =
0
then
Grow;
hash := HashString(s)
shr
6
;
i := hash
and
(FCapacity -
1
);
repeat
bucket := @FBuckets[i];
if
(bucket.Hash = hash)
and
(bucket.
Value
= s)
then
begin
s := bucket.
Value
;
Exit;
end
else
if
bucket.Hash =
0
then
begin
bucket.Hash := hash;
bucket.
Value
:= s;
Inc(FCount);
Dec(FGrowth);
Exit;
end
;
i := (i +
1
)
and
(FCapacity -
1
);
until
False;
end
;
end
.
Back
|
FazBrowse Home
|
New Git URL