Skip to content

Commit 6745da0

Browse files
gcarrenogcarreno
authored
Merge pull request #85 from bytebitespas/main
initial
2 parents 84b1db1 + f5c9a6b commit 6745da0

File tree

4 files changed

+668
-0
lines changed

4 files changed

+668
-0
lines changed

‎entries/gklark/README.md‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
This program uses thread pool from fpthreadpool
2+
and swissmap adapted from https://github.com/LIMachi/swiss-table/tree/master/src
3+
4+
Compiled with fpc 3.3.1 on Linux 64bit.

‎entries/gklark/src/swizmap.pas‎

Lines changed: 266 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,266 @@
1+
unit swizmap;
2+
3+
{$mode delphi}
4+
5+
interface
6+
7+
uses sysutils;
8+
//
9+
// https://github.com/LIMachi/swiss-table/tree/master
10+
// https://faultlore.com/blah/hashbrown-tldr/
11+
12+
const
13+
SWT_CONTROL_SIZE = 16;
14+
SWT_GROUP_SIZE = 16;
15+
SWT_VALUE_SIZE = SWT_CONTROL_SIZE * SWT_GROUP_SIZE;
16+
SWT_LOAD_FACTOR = 0.75;
17+
SWT_EXPAND_FACTOR = 2;
18+
SWT_FULL_MASK = 127;
19+
SWT_EMPTY = 128;
20+
21+
type
22+
tkeystr=record
23+
s:pchar;
24+
l:word;
25+
end;
26+
27+
t_swt_i128 = array[0..(SWT_CONTROL_SIZE)-1] of byte;
28+
29+
{ tswhash }
30+
31+
tswhash = record
32+
private
33+
flag0 : uint64;
34+
function get_meta : uint64;
35+
function get_position: uint64;
36+
public
37+
property meta:SizeUInt read get_meta;
38+
property position:sizeuint read get_position;
39+
end;
40+
41+
t_swt_hash = record
42+
case byte of
43+
0: ( h: tswhash );
44+
1: ( s: uint64 );
45+
end;
46+
47+
{ s_swt_group }
48+
49+
t_swt_group = record
50+
control : t_swt_i128;
51+
key : array[0..SWT_CONTROL_SIZE-1] of tkeystr;
52+
end;
53+
pgroup=^t_swt_group;
54+
55+
tgrouparray=array of t_swt_group;
56+
57+
t_swt_hashfun = function(str:pchar; len:integer):uint64;
58+
59+
{ tswmap }
60+
61+
tswpair<T>=record
62+
key:tkeystr;
63+
value:T;
64+
end;
65+
66+
tswmap<T> = record
67+
type
68+
tvaluearray=array of T;
69+
pT=^T;
70+
private
71+
fcurgroup,fcurpos:integer;
72+
function getcurrent: tswpair<T>;
73+
function dofind(hash:t_swt_hash; s:pchar;len:integer; var val: pT):boolean;
74+
function inserths(hash:t_swt_hash;s: pchar; len: integer; val: T): pT;
75+
function isequal(s:tkeystr;p:pchar;len:integer):boolean;overload;
76+
public
77+
nb_groups : uint64;
78+
pair_count : uint64;
79+
hashfun : t_swt_hashfun;
80+
groups :tgrouparray;
81+
values : tvaluearray;
82+
procedure init(factor: integer=1; grps: integer=SWT_GROUP_SIZE);
83+
function findoradd(s: pchar; len: integer;out val: pT): boolean;
84+
procedure expand(factor:integer);
85+
property count:uint64 read pair_count;
86+
property current:tswpair<T> read getcurrent;
87+
function getenumerator:tswmap<T>;
88+
function movenext:boolean;
89+
end;
90+
function ft_basic_hash(str:pchar;len:integer):uint64;
91+
92+
const SWTI128 : t_swt_i128=(128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128);
93+
94+
implementation
95+
96+
{ tswhash }
97+
98+
function tswhash.get_meta: uint64;
99+
begin
100+
result:=flag0 and 127;
101+
end;
102+
103+
function tswhash.get_position: uint64;
104+
begin
105+
result:=flag0 >> 7;
106+
end;
107+
108+
{$push}
109+
{$R-}{$O-}
110+
function ft_basic_hash(str:pchar;len:integer ):uint64;
111+
var
112+
hash:sizeuint;
113+
prime:sizeuint;
114+
begin
115+
hash := $cbf29ce484222325;
116+
prime := 1099511628211;
117+
while len>0 do begin
118+
hash := hash xor ord(str^);
119+
hash := hash * prime;
120+
str:=str+1;
121+
len:=len-1;
122+
end;
123+
result:=hash;
124+
end;
125+
{$pop}
126+
127+
function tswmap<T>.isequal(s:tkeystr;p:pchar;len:integer):boolean;
128+
var
129+
i: Integer;
130+
begin
131+
if s.l<>len then exit(false);
132+
for i:=1 to len do begin
133+
if s.s^<>p^ then exit(false);
134+
s.s:=s.s+1;
135+
p:=p+1;
136+
end;
137+
result:=true
138+
end;
139+
140+
{ tswmap }
141+
142+
procedure tswmap<T>.init(factor: integer=1; grps: integer=SWT_GROUP_SIZE);
143+
var
144+
i: uint64;
145+
begin
146+
pair_count :=0;
147+
nb_groups := factor * grps;
148+
hashfun := @ft_basic_hash;
149+
setlength(groups, nb_groups);
150+
SetLength(values, nb_groups * SWT_GROUP_SIZE);
151+
for i:=0 to nb_groups-1 do
152+
groups[i].control:=SWTI128;
153+
end;
154+
155+
156+
function tswmap<T>.findoradd(s: pchar; len: integer;out val: pT): boolean;
157+
var hash:t_swt_hash;
158+
begin
159+
if pair_count >= SWT_LOAD_FACTOR * nb_groups * SWT_CONTROL_SIZE then
160+
expand(SWT_EXPAND_FACTOR);
161+
162+
hash.s := hashfun(s, len);
163+
if dofind(hash,s,len,val) then exit(true);
164+
val := inserths(hash, s, len, default(T));
165+
result:=false;
166+
end;
167+
168+
function tswmap<T>.inserths(hash:t_swt_hash; s: pchar; len: integer; val: T): pT;
169+
var
170+
gi :uint64;
171+
i, st:integer;
172+
begin
173+
gi := hash.h.position mod nb_groups;
174+
st:=1;
175+
while true do begin
176+
for i := 0 to SWT_CONTROL_SIZE-1 do
177+
if groups[gi].control[i] and SWT_EMPTY<>0 then begin
178+
groups[gi].control[i] := hash.h.meta;
179+
groups[gi].key[i].s:=s;
180+
groups[gi].key[i].l:=len;
181+
result:=@values[gi * SWT_CONTROL_SIZE + i];
182+
result^:=val;
183+
pair_count:=pair_count+1;
184+
exit;
185+
end;
186+
gi := (gi + st) and (nb_groups-1);
187+
st:=st+1;
188+
end;
189+
end;
190+
191+
function tswmap<T>.dofind(hash:t_swt_hash; s: pchar; len: integer; var val: pT): boolean;
192+
var
193+
gi:uint64;
194+
i, st:integer;
195+
meta:integer;
196+
g:^t_swt_group;
197+
begin
198+
gi := hash.h.position and (nb_groups-1);
199+
st:=1;
200+
meta:=hash.h.meta;
201+
while true do begin
202+
g:=@groups[gi];
203+
for i := 0 to SWT_CONTROL_SIZE-1 do begin
204+
if g.control[i] and SWT_FULL_MASK=meta then
205+
if isequal(g.key[i], s, len) then begin
206+
val:=@values[gi * SWT_CONTROL_SIZE + i];
207+
exit(true);
208+
end;
209+
end;
210+
if g.control[SWT_CONTROL_SIZE-1] and SWT_EMPTY<>0 then exit(false);
211+
gi := (gi + st) and (nb_groups-1);
212+
st:=st+1
213+
end;
214+
end;
215+
216+
procedure tswmap<T>.expand(factor: integer);
217+
var
218+
tmp:tswmap<T>;
219+
i:uint64;
220+
j: integer;
221+
g:pgroup;
222+
hash:t_swt_hash;
223+
begin
224+
tmp.init(factor, nb_groups);
225+
for i := 0 to nb_groups-1 do begin
226+
g := @groups[i];
227+
for j := 0 to SWT_CONTROL_SIZE-1 do
228+
if g^.control[j] and SWT_EMPTY=0 then begin
229+
hash.s := hashfun(g.key[j].s, g.key[j].l);
230+
tmp.inserths(hash, g.key[j].s, g.key[j].l, values[i * SWT_CONTROL_SIZE + j])
231+
end;
232+
end;
233+
pair_count:=tmp.pair_count;
234+
nb_groups:=tmp.nb_groups;
235+
groups:=tmp.groups;
236+
values:=tmp.values;
237+
end;
238+
239+
function tswmap<T>.getenumerator: tswmap<T>;
240+
begin
241+
fcurgroup:=0;
242+
fcurpos:=-1;
243+
result:=self;
244+
end;
245+
246+
function tswmap<T>.movenext: boolean;
247+
begin
248+
repeat
249+
fcurpos:=fcurpos+1;
250+
if fcurpos=SWT_CONTROL_SIZE then begin
251+
fcurpos:=0;
252+
fcurgroup:=fcurgroup+1;
253+
if fcurgroup=nb_groups then exit(false);
254+
end;
255+
until groups[fcurgroup].control[fcurpos] and ord(SWT_EMPTY)=0;
256+
result:=true
257+
end;
258+
259+
function tswmap<T>.getcurrent: tswpair<T>;
260+
begin
261+
result.key:=groups[fcurgroup].key[fcurpos];
262+
result.value:=values[fcurgroup* SWT_CONTROL_SIZE + fcurpos]
263+
end;
264+
265+
end.
266+

‎entries/gklark/src/wcontest.lpi‎

Lines changed: 116 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,116 @@
1+
<?xml version="1.0" encoding="UTF-8"?>
2+
<CONFIG>
3+
<ProjectOptions>
4+
<Version Value="12"/>
5+
<General>
6+
<Flags>
7+
<MainUnitHasCreateFormStatements Value="False"/>
8+
<MainUnitHasTitleStatement Value="False"/>
9+
<MainUnitHasScaledStatement Value="False"/>
10+
</Flags>
11+
<SessionStorage Value="InProjectDir"/>
12+
<Title Value="wcontest"/>
13+
<UseAppBundle Value="False"/>
14+
<ResourceType Value="res"/>
15+
</General>
16+
<BuildModes>
17+
<Item Name="Debug" Default="True"/>
18+
<Item Name="Release">
19+
<CompilerOptions>
20+
<Version Value="11"/>
21+
<Target>
22+
<Filename Value="../../../bin/gklark"/>
23+
</Target>
24+
<SearchPaths>
25+
<IncludeFiles Value="$(ProjOutDir)"/>
26+
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
27+
</SearchPaths>
28+
<CodeGeneration>
29+
<SmartLinkUnit Value="True"/>
30+
<Optimizations>
31+
<OptimizationLevel Value="3"/>
32+
</Optimizations>
33+
</CodeGeneration>
34+
<Linking>
35+
<Debugging>
36+
<GenerateDebugInfo Value="False"/>
37+
<DebugInfoType Value="dsDwarf3"/>
38+
</Debugging>
39+
<LinkSmart Value="True"/>
40+
</Linking>
41+
<Other>
42+
<ConfigFile>
43+
<WriteConfigFilePath Value=""/>
44+
</ConfigFile>
45+
</Other>
46+
</CompilerOptions>
47+
</Item>
48+
</BuildModes>
49+
<PublishOptions>
50+
<Version Value="2"/>
51+
<UseFileFilters Value="True"/>
52+
</PublishOptions>
53+
<RunParams>
54+
<FormatVersion Value="2"/>
55+
</RunParams>
56+
<RequiredPackages>
57+
<Item>
58+
<PackageName Value="LazUtils"/>
59+
</Item>
60+
</RequiredPackages>
61+
<Units>
62+
<Unit>
63+
<Filename Value="wcontest.lpr"/>
64+
<IsPartOfProject Value="True"/>
65+
</Unit>
66+
</Units>
67+
</ProjectOptions>
68+
<CompilerOptions>
69+
<Version Value="11"/>
70+
<Target>
71+
<Filename Value="../../../bin/gklark"/>
72+
</Target>
73+
<SearchPaths>
74+
<IncludeFiles Value="$(ProjOutDir)"/>
75+
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
76+
</SearchPaths>
77+
<Parsing>
78+
<SyntaxOptions>
79+
<IncludeAssertionCode Value="True"/>
80+
</SyntaxOptions>
81+
</Parsing>
82+
<CodeGeneration>
83+
<Checks>
84+
<IOChecks Value="True"/>
85+
<StackChecks Value="True"/>
86+
</Checks>
87+
<VerifyObjMethodCallValidity Value="True"/>
88+
</CodeGeneration>
89+
<Linking>
90+
<Debugging>
91+
<DebugInfoType Value="dsDwarf3"/>
92+
<UseHeaptrc Value="True"/>
93+
<TrashVariables Value="True"/>
94+
<UseExternalDbgSyms Value="True"/>
95+
</Debugging>
96+
</Linking>
97+
<Other>
98+
<ConfigFile>
99+
<WriteConfigFilePath Value=""/>
100+
</ConfigFile>
101+
</Other>
102+
</CompilerOptions>
103+
<Debugging>
104+
<Exceptions>
105+
<Item>
106+
<Name Value="EAbort"/>
107+
</Item>
108+
<Item>
109+
<Name Value="ECodetoolError"/>
110+
</Item>
111+
<Item>
112+
<Name Value="EFOpenError"/>
113+
</Item>
114+
</Exceptions>
115+
</Debugging>
116+
</CONFIG>

0 commit comments

Comments
 (0)