I fixed it but it's only for ASM backend and x64 see 1st post.jassing wrote: Thu May 04, 2023 1:19 am While it works nicely, BUT... Thru trial and error, I found that if you use a regular map anywhere else in your program, the code generates a linker error about PB_FreeMap(); but as long as you don't use a regular map, it works fine.
Nicely done! Good job. Sure seems like there isn't much fog over there.
Code: Select all
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : GenericHashMap
; File Name : GenericHashMap - OOP.pb
; File version: 1.0.0
; Programming : OK
; Programmed by : StarBootics
; Date : May 4th, 2023
; Last Update : May 4th, 2023
; PureBasic code : V6.02 beta 2 LTS
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
DeclareModule GenericHashMap
Interface GenericHashMap
GetBucketKey.i()
GetBucketObject.i()
UpdateBucket(*Object)
LookUpBucket.i(Key.i)
AddBucket.i(Key.i, *Object)
RemoveBucket.i(Key.i)
ResetBuckets()
NextBucket.i()
BucketsCount.l()
RemoveAllBuckets()
Free()
EndInterface
Declare.i New(TableMax.l = 10, *ObjectDestructor = #Null)
EndDeclareModule
Module GenericHashMap
DisableDebugger
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structures declaration <<<<<
Structure Bucket
Key.i
*Object
*Next.Bucket
EndStructure
Structure Private_Members
VirtualTable.i
*ObjectDestructor
TableMax.l
*Table
*CurrentBucket.Bucket
CurrentIndex.l
BucketsCount.l
EndStructure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The ReachElement calculation macro <<<<<
Macro ReachElement(StartPtr, Index)
(StartPtr + (Index) * SizeOf(Integer))
EndMacro
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Object Destructor prototype <<<<<
Prototype DestructorFunction(*ObjectPtr)
; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Hash Function <<<<<
Procedure.i HashFunction(*This.Private_Members, Key.i)
Hash_Value.i = 1
For HashingRoundID = 0 To 3
Hash_Value = ((Hash_Value << 6) ! (Hash_Value >> 2) ! (Key << 6) ! (Key >> 2)) % *This\TableMax
Next
ProcedureReturn Hash_Value
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Getters <<<<<
Procedure.i GetBucketKey(*This.Private_Members)
If *This\CurrentBucket <> #Null
ProcedureReturn *This\CurrentBucket\Key
Else
ProcedureReturn -1
EndIf
EndProcedure
Procedure.i GetBucketObject(*This.Private_Members)
If *This\CurrentBucket <> #Null
ProcedureReturn *This\CurrentBucket\Object
Else
ProcedureReturn #Null
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The UpdateBucket operator <<<<<
Procedure UpdateBucket(*This.Private_Members, *Object)
If *This\CurrentBucket <> #Null
If *This\CurrentBucket\Object <> #Null And *This\ObjectDestructor <> #Null
Destructor.DestructorFunction = *This\ObjectDestructor
Destructor(*This\CurrentBucket\Object)
EndIf
*This\CurrentBucket\Object = *Object
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The LookupBucket operator <<<<<
Procedure.i LookupBucket(*This.Private_Members, Key.i)
Index.l = HashFunction(*This, Key)
*Temp.Integer = ReachElement(*This\Table, Index)
*Cursor.Bucket = *Temp\i
While *Cursor <> #Null
If *Cursor\Key = Key
*This\CurrentBucket = *Cursor
ProcedureReturn #True
EndIf
*Cursor = *Cursor\Next
Wend
ProcedureReturn #False
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The AddBucket operator <<<<<
Procedure.i AddBucket(*This.Private_Members, Key.i, *Object)
If LookupBucket(*This, Key) = #False
*Bucket.Bucket = AllocateStructure(Bucket)
*Bucket\Key = Key
*Bucket\Object = *Object
Index.i = HashFunction(*This, Key)
*Temp.Integer = ReachElement(*This\Table, Index)
*Bucket\Next = *Temp\i
*Temp\i = *Bucket
*This\CurrentBucket = *Bucket
*This\BucketsCount + 1
ProcedureReturn 1
Else
UpdateBucket(*This, *Object)
ProcedureReturn 2
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The RemoveBucket operator <<<<<
Procedure.i RemoveBucket(*This.Private_Members, Key.i)
*This\CurrentBucket = #Null
Index.l = HashFunction(*This, Key)
*Temp.Integer = ReachElement(*This\Table, Index)
*Cursor.Bucket = *Temp\i
*Previous.Bucket = #Null
While *Cursor <> #Null And *Cursor\Key <> Key
*Previous = *Cursor
*Cursor = *Cursor\Next
Wend
If *Cursor = #Null
ProcedureReturn #False
EndIf
If *Previous = #Null
If *Cursor\Object <> #Null And *This\ObjectDestructor <> #Null
Destructor.DestructorFunction = *This\ObjectDestructor
Destructor(*Cursor\Object)
EndIf
*Head = *Temp\i
*Temp\i = *Cursor\Next
FreeStructure(*Head)
*This\BucketsCount - 1
Else
*Previous\Next = *Cursor\Next
If *Cursor\Object <> #Null And *This\ObjectDestructor <> #Null
Destructor.DestructorFunction = *This\ObjectDestructor
Destructor(*Cursor\Object)
EndIf
FreeStructure(*Cursor)
*This\BucketsCount - 1
EndIf
ProcedureReturn #True
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The ResetBuckets operator <<<<<
Procedure ResetBuckets(*This.Private_Members)
*This\CurrentIndex = -1
*This\CurrentBucket = #Null
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The NextBucket operator <<<<<
Procedure.i NextBucket(*This.Private_Members)
If *This\CurrentBucket = #Null And *This\CurrentIndex = -1
*This\CurrentIndex = 0
For Index = *This\CurrentIndex To *This\TableMax - 1
*Temp.Integer = ReachElement(*This\Table, Index)
*Cursor.Bucket = *Temp\i
If *Cursor <> #Null
*This\CurrentBucket = *Cursor
*This\CurrentIndex = Index
ProcedureReturn *This\CurrentBucket
EndIf
Next
Else
If *This\CurrentBucket\Next <> #Null
*This\CurrentBucket = *This\CurrentBucket\Next
ProcedureReturn *This\CurrentBucket
Else
*This\CurrentIndex + 1
While *This\CurrentIndex < *This\TableMax
*Temp.Integer = ReachElement(*This\Table, *This\CurrentIndex)
*Cursor.Bucket = *Temp\i
If *Cursor <> #Null
*This\CurrentBucket = *Cursor
ProcedureReturn *This\CurrentBucket
EndIf
*This\CurrentIndex + 1
Wend
EndIf
EndIf
EndProcedure
Procedure.l BucketsCount(*This.Private_Members)
ProcedureReturn *This\BucketsCount
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The RemoveAllBuckets operator <<<<<
Procedure RemoveAllBuckets(*This.Private_Members)
For Index = 0 To *This\TableMax - 1
*Temp.Integer = ReachElement(*This\Table, Index)
*Cursor.Bucket = *Temp\i
If *Cursor <> #Null
While *Cursor <> #Null
If *Cursor\Object <> #Null And *This\ObjectDestructor <> #Null
Destructor.DestructorFunction = *This\ObjectDestructor
Destructor(*Cursor\Object)
EndIf
*Temp2 = *Cursor
*Cursor = *Cursor\Next
FreeStructure(*Temp2)
Wend
EndIf
*Temp\i = #Null
Next
*This\BucketsCount = 0
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Destructor <<<<<
Procedure Free(*This.Private_Members)
RemoveAllBuckets(*This)
FreeMemory(*This\Table)
FreeStructure(*This)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Constructor <<<<<
Procedure.i New(TableMax.l = 10, *ObjectDestructor = #Null)
*This.Private_Members = AllocateStructure(Private_Members)
*This\VirtualTable = ?START_METHODS
*This\ObjectDestructor = *ObjectDestructor
If TableMax < 10
TableMax = 10
EndIf
*This\TableMax = TableMax
*This\Table = *Table
*This\Table = AllocateMemory(*This\TableMax * SizeOf(Integer))
ProcedureReturn *This
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Virtual Table Entries <<<<<
DataSection
START_METHODS:
Data.i @GetBucketKey()
Data.i @GetBucketObject()
Data.i @UpdateBucket()
Data.i @LookUpBucket()
Data.i @AddBucket()
Data.i @RemoveBucket()
Data.i @ResetBuckets()
Data.i @NextBucket()
Data.i @BucketsCount()
Data.i @RemoveAllBuckets()
Data.i @Free()
END_METHODS:
EndDataSection
EnableDebugger
EndModule
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 00.001 seconds (88000.00 lines/second) <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
CompilerIf #PB_Compiler_IsMainFile
Structure Sphere
Radius.f
Volume.f
EndStructure
Procedure InitSphere(Radius.f)
*This.Sphere = AllocateStructure(Sphere)
*This\Radius = Radius
*This\Volume = (4.0/3.0) * #PI * *This\Radius* *This\Radius* *This\Radius
ProcedureReturn *This
EndProcedure
Procedure DestroySphere(*To_be_Destroyed)
Debug "DestroySphere() called!"
FreeStructure(*To_be_Destroyed)
EndProcedure
MyHashMap.GenericHashMap::GenericHashMap = GenericHashMap::New(15, @DestroySphere())
MyHashMap\AddBucket(2500, InitSphere(3.25))
MyHashMap\AddBucket(3126, InitSphere(5.55))
MyHashMap\AddBucket(2145, InitSphere(1.75))
MyHashMap\ResetBuckets()
While MyHashMap\NextBucket() <> #Null
Debug "Sphere No." + Str(MyHashMap\GetBucketKey())
*Sphere.Sphere = MyHashMap\GetBucketObject()
Debug "Radius -> " + StrF(*Sphere\Radius, 4)
Debug "Volume -> " + StrF(*Sphere\Volume, 4)
Debug ""
Wend
Debug "Let's remove the Sphere No. 2145"
MyHashMap\RemoveBucket(2145)
Debug ""
MyHashMap\ResetBuckets()
While MyHashMap\NextBucket() <> #Null
Debug "Sphere No." + Str(MyHashMap\GetBucketKey())
*Sphere.Sphere = MyHashMap\GetBucketObject()
Debug "Radius -> " + StrF(*Sphere\Radius, 4)
Debug "Volume -> " + StrF(*Sphere\Volume, 4)
Debug ""
Wend
Debug "Let's destroy the entire map !"
MyHashMap\Free()
CompilerEndIf
; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<Code: Select all
Macro Comments()
; SQUINT 3, Sparse Quad Union Indexed Nibble Trie
; Copyright Andrew Ferguson aka Idle (c) 2020 - 2022
; Version 3.0.4b
; PB 5.72-6.0 x86/x64 asm c backends Linux OSX Windows
; Thanks Wilbert for the high low insight and utf8 asm help.
; Squint is a compact prefix Trie indexed by nibbles into a sparse array with performance metrics close to a map
; It provides O(K*2) performance with a memory size ~32 times smaller than a 256 node trie
; Squint is at worst 2 times slower than a Map for set operations, look ups are closer to 1:1 or faster
; as squint can bail out as soon as a char of a key isn't found unlike a map that has to evaluate the whole key.
; Squint is lexographicaly sorted so sorting is magnitudes faster than what you could achieve with a map list or unsorted array
; Squint also supports collections or subtries, which facilitates tasks like in memory DB's
; The Numeric mode of squint behaves like a map and is closer to 1:1 performance with a sized map
; and the gets are of course faster as they can bail out earlier on evaluation of the key
;
; see https://en.wikipedia.org/wiki/Trie
; simillar structures
; https://dotat.at/prog/qp/blog-2015-10-04.html
; https://cr.yp.to/critbit.html
;
; Squint supports Set, Get, Enum, Walk, Delete and Prune with a flag in Delete
; keys can be either Unicode, Ascii, UTF8 the type must be specified
; String keys are all mapped to UTF8
;
; SquintNumeric supports, SetNumeric GetNumeric DeleteNumeric and WalkNumeric
; it's provided as a direct subtitute for a numeric map, though lacks enumeration
; keys are returned as pointers to Integers
;
; Note while you can mix string and numeric keys in the same trie it's not recomended unless you only require set and get
;
;
; MIT License
; Permission is hereby granted, Free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; To use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
;
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS Or
; IMPLIED, INCLUDING BUT Not LIMITED To THE WARRANTIES OF MERCHANTABILITY,
; FITNESS For A PARTICULAR PURPOSE And NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS Or COPYRIGHT HOLDERS BE LIABLE For ANY CLAIM, DAMAGES Or OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT Or OTHERWISE, ARISING FROM,
; OUT OF Or IN CONNECTION With THE SOFTWARE Or THE USE Or OTHER DEALINGS IN THE
; SOFTWARE.
EndMacro
DeclareModule SQUINT
#SQUINT_MAX_KEY = 1024
Structure squint_node Align #PB_Structure_AlignC
*vertex.edge
StructureUnion
squint.q
value.i
EndStructureUnion
EndStructure
Structure edge Align #PB_Structure_AlignC
e.squint_node[0]
EndStructure
Structure squint Align #PB_Structure_AlignC
*vt
size.i
*root.squint_node
sb.a[#SQUINT_MAX_KEY]
EndStructure
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
#Squint_Pmask = $ffffffff
CompilerElse
#Squint_Pmask = $ffffffffffff
CompilerEndIf
;-Squint Callback prototype
Prototype Squint_CB(*key,*value=0,*userdata=0)
Declare SquintNew()
Declare SquintFree(*this.Squint)
Declare SquintSetNode(*this.squint,*subtrie,*key,value.i,mode=#PB_Unicode)
Declare SquintGetNode(*this.squint,*subtrie,*key,mode=#PB_Unicode)
Declare SquintDeleteNode(*this.squint,*subtrie,*key,prune=0,mode=#PB_Unicode)
Declare SquintWalkNode(*this.squint,*subtrie,*pfn.squint_CB,*userdata=0)
Declare SquintEnum(*this.squint,*key,*pfn.squint_CB,*userdata=0,mode=#PB_Unicode)
Declare SquintSetNumeric(*this.squint,key.i,value.i)
Declare SquintGetNumeric(*this.squint,key.i)
Declare SquintDeleteNumeric(*this.squint,key.i)
Declare SquintWalkNumeric(*this.squint,*pfn.squint_CB,*userdata=0)
;-Squint Inteface iSquint
Interface iSquint
Free()
Delete(*subtrie,*key,prune=0,mode=#PB_Unicode)
Set(*subtrie,*key,value.i,mode=#PB_Unicode)
Get(*subtrie,*key,mode=#PB_Unicode)
Enum(*key,*pfn.squint_CB,*userdata=0,mode=#PB_Unicode)
Walk(*subtrie,*pfn.squint_CB,*userdata=0)
SetNumeric(key.i,value.i)
GetNumeric(key.i)
SquintDeleteNumeric(key.i)
WalkNumeric(*pfn.Squint_CB,*userdata=0)
EndInterface
DataSection: vtSquint:
Data.i @SquintFree()
Data.i @SquintDeleteNode()
Data.i @SquintSetNode()
Data.i @SquintGetNode()
Data.i @SquintEnum()
Data.i @SquintWalkNode()
Data.i @SquintSetNumeric()
Data.i @SquintGetNumeric()
Data.i @SquintDeleteNumeric()
Data.i @SquintWalkNumeric()
EndDataSection
EndDeclareModule
Module SQUINT
EnableExplicit
;-macros
Macro _SETINDEX(in,index,number)
in = in & ~(15 << (index << 2)) | (number << (index << 2))
EndMacro
Macro _GETNODECOUNT()
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
nodecount = MemorySize(*node\vertex) / SizeOf(squint_node)
CompilerElse
nodecount = (*node\vertex >> 48)
CompilerEndIf
EndMacro
Macro _POKENHL(in,Index,Number)
*Mem.Ascii = in
*Mem + Index >> 1
If Index & 1
*Mem\a = (*Mem\a & $f0) | (Number & $f)
Else
*Mem\a = (*Mem\a & $0f) | (Number << 4)
EndIf
EndMacro
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
Macro rax : eax : EndMacro
CompilerEndIf
CompilerIf #PB_Compiler_Backend = #PB_Backend_C
Macro AsmInput(var)
!:[var] "r" (v_#var)
EndMacro
Macro AsmInput2(var0,var1)
!:[var0] "r" (v_#var0),[var1] "r" (v_#var1)
EndMacro
Macro AsmInput2P(var0,var1)
!:[var0] "r" (p_#var0),[var1] "r" (p_#var1)
EndMacro
Macro AsmInput3(var0,var1,var2)
!:[var0] "r" (v_#var0),[var1] "r" (v_#var1),[var2] "r" (v_#var2)
EndMacro
Macro AsmOutput(var)
!".att_syntax;"
!:[var] "=r" (v_#var)
EndMacro
Macro BeginAsm()
!__asm__(
!".intel_syntax noprefix;"
EndMacro
Macro AsmClobbers() ;"eax","edx"
!:
EndMacro
Macro EndAsm()
!);
EndMacro
CompilerEndIf
CompilerIf #PB_Compiler_Thread
Macro _LockMutex(mut)
LockMutex(mut)
EndMacro
Macro _UnlockMutex(mut)
UnlockMutex(mut)
EndMacro
CompilerElse
Macro _Lockmutex(mut)
EndMacro
Macro _UnlockMutex(mut)
EndMacro
CompilerEndIf
Macro _gLockXCHG(var,var1)
CompilerIf #PB_Compiler_Backend = #PB_Backend_C
!__atomic_exchange_n(&p_node->f_vertex,p_new,__ATOMIC_SEQ_CST) ;
CompilerElse
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
!mov eax , [p.p_#var1]
!mov edx , [p.p_#var]
!xchg dword [edx] , eax
CompilerElse
!mov rax , [p.p_#var1]
!mov rdx , [p.p_#var]
!xchg qword [rdx] , rax
CompilerEndIf
CompilerEndIf
EndMacro
Macro _glockInc(var)
CompilerIf #PB_Compiler_Backend = #PB_Backend_C
! __atomic_fetch_add(&v_nodecount,1,__ATOMIC_SEQ_CST);
CompilerElse
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
!lock add dword [p.v_#var],1
CompilerElse
!lock add qword [p.v_#var],1
CompilerEndIf
CompilerEndIf
EndMacro
Macro _CONVERTUTF8()
vchar = PeekU(*key)
If mode = #PB_Unicode
CompilerIf #PB_Compiler_Backend = #PB_Backend_C
If vchar >= $80
If vchar >= $800
BeginAsm()
!"xor eax, eax;"
!"mov eax, %[vchar];"
!"shl eax, 4;"
!"shr ax, 2;"
!"shr al, 2;"
!"or eax, 14712960;"
!"bswap eax;"
!"shr eax, 8;"
!"mov %[vret], eax;"
AsmOutput(vret)
AsmInput(vchar)
AsmClobbers() "eax"
EndAsm()
vchar = vret
Else
BeginAsm()
!"xor eax,eax;"
!"mov eax, %[vchar];"
!"shl eax,2;"
!"shr al,2;"
!"or eax,49280;"
!"bswap eax;"
!"shr eax,16;"
!"mov %[vret], eax;"
AsmOutput(vret)
AsmInput(vchar)
AsmClobbers() "eax"
EndAsm()
vchar=vret
EndIf
EndIf
CompilerElse
!mov eax, [p.v_vchar]
!cmp eax, 0x0080
!jb .l3
!cmp eax, 0x0800
!jae .l4
!shl eax, 2
!shr al, 2
!or eax, 1100000010000000b
!bswap eax
!shr eax, 16
!jmp .l3
!.l4:
!shl eax, 4
!shr ax, 2
!shr al, 2
!or eax, 111000001000000010000000b
!bswap eax
!shr eax, 8
!.l3:
!mov [p.v_vchar],eax
CompilerEndIf
EndIf
EndMacro
Macro _MODECHECK()
_CONVERTUTF8()
If mode <> #PB_Unicode
If (vchar >> ((count&1)<<4) & $ff = 0)
Break
EndIf
EndIf
EndMacro
Global gwrite = CreateMutex()
Macro _SETNODE()
_LockMutex(gwrite)
If *node\vertex
_GETNODECOUNT()
If (offset <> 15 Or nodecount = 16)
*node = *node\Vertex\e[offset] & #Squint_Pmask
Else
offset = nodecount
;replaces realloc
*new = AllocateMemory((offset+1)*SizeOf(squint_node))
*old = *node\vertex & #Squint_Pmask
CopyMemory(*old,*new,(offset)*SizeOf(squint_node))
_glockInc(nodecount)
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
*new | ((nodecount) << 48)
CompilerEndIf
_gLockXCHG(node,new)
FreeMemory(*old)
;*node\vertex = ReAllocateMemory(*node\vertex & #Squint_Pmask,(nodecount)*SizeOf(squint_node))
*this\size+SizeOf(squint_node)
_SETINDEX(*node\squint,idx,offset)
*node = *node\Vertex\e[offset] & #Squint_Pmask
EndIf
Else
*node\vertex = AllocateMemory(SizeOf(squint_Node))
*this\size+SizeOf(squint_node)
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
*node\vertex | (1 << 48)
CompilerEndIf
*node\squint = -1
_SETINDEX(*node\squint,idx,0)
*node = *node\Vertex\e[0] & #Squint_Pmask
EndIf
_UnlockMutex(gwrite)
EndMacro
;-General functions
Procedure SquintNew()
Protected *this.squint,a
*this = AllocateMemory(SizeOf(squint))
If *this
*this\vt = ?vtSquint
*this\root = AllocateMemory(SizeOf(squint_node))
ProcedureReturn *this
EndIf
EndProcedure
Procedure ISquintFree(*this.squint,*node.squint_node=0)
Protected a,offset,nodecount
If Not *node
ProcedureReturn 0
EndIf
For a=0 To 15
offset = (*node\squint >> (a<<2)) & $f
If *node\vertex
_GETNODECOUNT()
If (offset <> 15 Or nodecount = 16)
*this\size - SizeOf(squint_node)
ISquintFree(*this,*node\Vertex\e[offset] & #Squint_Pmask)
EndIf
EndIf
Next
If *node\vertex
_GETNODECOUNT()
FreeMemory(*node\Vertex & #Squint_Pmask)
*node\vertex=0
EndIf
ProcedureReturn *node
EndProcedure
Procedure SquintFree(*this.squint) ;bfree free *node\value pointer
Protected a,offset,*node.squint_node,nodecount
*node = *this\root
For a=0 To 15
offset = (*node\squint >> (a<<2)) & $f
If *node\vertex
_GETNODECOUNT()
If (offset <> 15 Or nodecount = 16)
ISquintFree(*this,*node)
EndIf
EndIf
Next
FreeMemory(*this\root)
nodecount = *this\size
FreeMemory(*this)
ProcedureReturn nodecount
EndProcedure
;-string functions
Procedure SquintSetNode(*this.squint,*subtrie,*key,value.i,mode=#PB_Unicode)
Protected *node.squint_node,idx,offset,nodecount,vchar.l,vret.l,count,*out
Protected *new.squint_node,*old,*adr
If *subtrie = 0
*node = *this\root & #Squint_Pmask
Else
*node = *subtrie & #Squint_Pmask
EndIf
_CONVERTUTF8()
While vchar
idx = (vchar >> 4) & $f
offset = (*node\squint >> (idx<<2)) & $f
_SETNODE()
idx = vchar & $0f
offset = (*node\squint >> (idx<<2)) & $f
_SETNODE()
vchar >> 8
count+1
If vchar = 0
*key+2
_MODECHECK()
EndIf
Wend
idx=0
*out = *node
offset = *node\squint & $f
_SETNODE()
If value
*node\value = value
EndIf
ProcedureReturn *out
EndProcedure
Procedure SquintGetNode(*this.squint,*subtrie,*key,mode=#PB_Unicode)
Protected *node.squint_Node,idx,offset,nodecount,vchar.l,vret.l,count,*out
;_LockMutex(gwrite)
If *subtrie = 0
*node = *this\root & #Squint_Pmask
Else
*node = *subtrie & #Squint_Pmask
EndIf
_CONVERTUTF8()
While vchar
offset = (*node\squint >> ((vchar & $f0) >> 2 )) & $f
_GETNODECOUNT()
If offset < nodecount
*node = (*node\Vertex\e[offset] & #Squint_Pmask)
Else
;_UnlockMutex(gwrite)
ProcedureReturn 0
EndIf
offset = (*node\squint >> ((vchar & $0f) << 2)) & $f
_GETNODECOUNT()
If offset < nodecount
*node = (*node\Vertex\e[offset] & #Squint_Pmask)
Else
;_UnlockMutex(gwrite)
ProcedureReturn 0
EndIf
vchar >> 8
count+1
If vchar = 0
*key+2
_MODECHECK()
EndIf
Wend
offset = *node\squint & $f
_GETNODECOUNT()
If offset <= nodecount
*node = (*node\Vertex\e[offset] & #Squint_Pmask)
;_UnlockMutex(gwrite)
ProcedureReturn *node\value
Else
;_UnlockMutex(gwrite)
ProcedureReturn 0
EndIf
EndProcedure
Procedure SquintDeleteNode(*this.squint,*subtrie,*key.Unicode,prune=0,mode=#PB_Unicode)
Protected *node.squint_node,idx,*mem.Character,offset,nodecount,vchar.l,vret.l,count,*out
If *subtrie = 0
*node = *this\root & #Squint_Pmask
Else
*node = *subtrie & #Squint_Pmask
EndIf
_CONVERTUTF8()
While vchar
offset = (*node\squint >> ((vchar & $f0) >> 2 )) & $f
If *node\vertex
_GETNODECOUNT()
If (offset <> 15 Or nodecount = 16)
*node = *node\Vertex\e[offset] & #Squint_Pmask
EndIf
Else
ProcedureReturn 0
EndIf
If *node
offset = (*node\squint >> ((vchar & $0f) << 2)) & $f
If *node\vertex
_GETNODECOUNT()
If (offset <> 15 Or nodecount = 16)
*node = *node\Vertex\e[offset] & #Squint_Pmask
EndIf
Else
ProcedureReturn 0
EndIf
EndIf
vchar >> 8
If vchar = 0
*key+2
_MODECHECK()
EndIf
Wend
If prune
ISquintFree(*this,*node)
If (*node\vertex & #Squint_Pmask) = 0
*node\squint = 0
EndIf
Else
offset = *node\squint & $f
_GETNODECOUNT()
If offset <= nodecount
*node = (*node\Vertex\e[offset] & #Squint_Pmask)
If (*node\vertex & #Squint_Pmask) = 0
*node\squint = 0
EndIf
Else
ProcedureReturn 0
EndIf
EndIf
EndProcedure
Procedure IEnum(*this.squint,*node.squint_Node,depth,*pfn.squint_CB,*outkey,*userdata=0)
Protected a.i,offset,nodecount,*mem.Ascii
If Not *node
ProcedureReturn 0
EndIf
For a=0 To 15
offset = (*node\squint >> (a<<2)) & $f
If (*node\vertex And *node\squint)
_GETNODECOUNT()
If (offset <> 15 Or nodecount = 16)
_POKENHL(*outkey,depth,a)
IEnum(*this,*node\Vertex\e[offset] & #Squint_Pmask,depth+1,*pfn,*outkey,*userdata)
EndIf
EndIf
Next
If *node\vertex=0
If *pfn
PokeA(*outkey+((depth>>1)),0)
*pfn(*outkey,*node\value,*userdata)
EndIf
EndIf
ProcedureReturn *node
EndProcedure
Procedure SquintEnum(*this.squint,*key.Unicode,*pfn.squint_CB,*userdata=0,mode=#PB_Unicode)
Protected *node.squint_Node,idx,*mem.Ascii,offset,nodecount,depth,vchar.l,vret.l,count,*out
Protected outkey.s{1024}
_LockMutex(gwrite)
*node = *this\root
_CONVERTUTF8()
While vchar
idx = (vchar >> 4) & $f
offset = (*node\squint >> (idx<<2)) & $f
If (*node\vertex And *node\squint)
_GETNODECOUNT()
If (offset <> 15 Or nodecount = 16)
*mem = @outkey+(depth>>1)
*mem\a = (*mem\a & $0f) | (idx<<4)
depth+1
*node = *node\Vertex\e[offset] & #Squint_Pmask
EndIf
EndIf
If Not *node Or *node\vertex = 0
_UnlockMutex(gwrite)
ProcedureReturn 0
EndIf
idx = vchar & $f
offset = (*node\squint >> (idx<<2)) & $f
If (*node\vertex And *node\squint)
_GETNODECOUNT()
If (offset <> 15 Or nodecount = 16)
*mem = @outkey+(depth>>1)
*Mem\a = (*Mem\a & $f0) | (idx & $f)
depth+1
*node = *node\Vertex\e[offset] & #Squint_Pmask
EndIf
EndIf
If Not *node Or *node\vertex = 0
_UnlockMutex(gwrite)
ProcedureReturn 0
EndIf
vchar >> 8
count+1
If vchar = 0
*key+2
_MODECHECK()
EndIf
Wend
; _LockMutex(gwrite)
IEnum(*this,*node,depth,*pfn,@outkey,*userdata)
_UnlockMutex(gwrite)
EndProcedure
Procedure SquintWalk(*this.squint,*pfn.squint_CB,*userdata=0)
Protected outkey.s{1024}
_LockMutex(gwrite)
IEnum(*this,*this\root,0,*pfn,@outkey,*userdata)
_UnlockMutex(gwrite)
EndProcedure
Procedure SquintWalkNode(*this.squint,*subtrie,*pfn.squint_CB,*userdata=0)
Protected *node, outkey.s{1024}
_LockMutex(gwrite)
If *subtrie = 0
*node = *this\root
Else
*node = *subtrie & #Squint_Pmask
EndIf
IEnum(*this,*node,0,*pfn,@outkey,*userdata)
_UnLockMutex(gwrite)
EndProcedure
;-Numeric functions
Procedure SquintSetNumeric(*this.squint,key.i,value.i)
Protected *node.squint_node,idx,offset,nodecount,vchar.i,vret.i,count
Protected *old,*new,*adr
*node = *this\root & #Squint_Pmask
vchar = key
CompilerIf #PB_Compiler_Backend = #PB_Backend_C
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
BeginAsm()
!"mov rax, %[vchar];"
!"bswap rax;"
!"mov %[vret], rax;"
AsmOutput(vret)
AsmInput(vchar)
AsmClobbers() "rax"
EndAsm()
CompilerElse
BeginAsm()
!"mov eax, %[vchar];"
!"bswap eax;"
!"mov %[vret], eax;"
AsmOutput(vret)
AsmInput(vchar)
AsmClobbers() "eax"
EndAsm()
CompilerEndIf
vchar = vret
CompilerElse
EnableASM
mov rax, vchar
bswap rax;
mov vchar,rax
DisableASM
CompilerEndIf
While count < SizeOf(Integer)
idx = (vchar >> 4) & $f
offset = (*node\squint >> (idx<<2)) & $f
_SetNODE()
idx = (vchar & $f)
offset = (*node\squint >> (idx<<2)) & $f
_SetNODE()
vchar >> 8
count+1
Wend
*node\value = value
ProcedureReturn
EndProcedure
Procedure SquintGetNumeric(*this.squint,key.i)
Protected *node.squint_Node,idx,offset,nodecount,vchar.i,vret.i,count
*node = *this\root & #Squint_Pmask
vchar = key
CompilerIf #PB_Compiler_Backend = #PB_Backend_C
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
BeginAsm()
!"mov rax, %[vchar];"
!"bswap rax;"
!"mov %[vret], rax;"
AsmOutput(vret)
AsmInput(vchar)
AsmClobbers() "rax"
EndAsm()
CompilerElse
BeginAsm()
!"mov eax, %[vchar];"
!"bswap eax;"
!"mov %[vret], eax;"
AsmOutput(vret)
AsmInput(vchar)
AsmClobbers() "eax"
EndAsm()
CompilerEndIf
vchar = vret
CompilerElse
EnableASM
mov rax, vchar
bswap rax;
mov vchar,rax
DisableASM
CompilerEndIf
While count < SizeOf(Integer)
offset = (*node\squint >> ((vchar & $f0) >> 2 )) & $f
_GETNODECOUNT()
If offset < nodecount
*node = (*node\Vertex\e[offset] & #Squint_Pmask)
Else
ProcedureReturn 0
EndIf
offset = (*node\squint >> ((vchar & $0f) << 2)) & $f
_GETNODECOUNT()
If offset < nodecount
*node = (*node\Vertex\e[offset] & #Squint_Pmask)
Else
ProcedureReturn 0
EndIf
vchar>>8
count+1
Wend
ProcedureReturn *node\value
EndProcedure
Procedure SquintDeleteNumeric(*this.squint,key.i)
Protected *node.squint_node,idx,*mem.Character,offset,nodecount,vchar.i,vret.i,count
*node = *this\root & #Squint_Pmask
vchar = key
CompilerIf #PB_Compiler_Backend = #PB_Backend_C
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
BeginAsm()
!"mov rax, %[vchar];"
!"bswap rax;"
!"mov %[vret], rax;"
AsmOutput(vret)
AsmInput(vchar)
AsmClobbers() "rax"
EndAsm()
CompilerElse
BeginAsm()
!"mov eax, %[vchar];"
!"bswap eax;"
!"mov %[vret], eax;"
AsmOutput(vret)
AsmInput(vchar)
AsmClobbers() "eax"
EndAsm()
CompilerEndIf
vchar = vret
CompilerElse
EnableASM
mov rax, vchar
bswap rax;
mov vchar,rax
DisableASM
CompilerEndIf
While count < SizeOf(Integer)
offset = (*node\squint >> ((vchar & $f0) >> 2 )) & $f
_GETNODECOUNT()
If offset < nodecount
*node = (*node\Vertex\e[offset] & #Squint_Pmask)
Else
ProcedureReturn 0
EndIf
offset = (*node\squint >> ((vchar & $0f) << 2)) & $f
_GETNODECOUNT()
If offset < nodecount
*node = (*node\Vertex\e[offset] & #Squint_Pmask)
Else
ProcedureReturn 0
EndIf
vchar>>8
count+1
Wend
If (*node\vertex & #Squint_Pmask) = 0
*node\squint = 0
EndIf
EndProcedure
Procedure IEnumNumeric(*this.squint,*node.squint_Node,idx,depth,*pfn.squint_CB,*userdata=0)
Protected a.i,offset,nodecount,*mem.Ascii,vchar.i,vret.i
If Not *node
ProcedureReturn 0
EndIf
For a = 0 To 15
offset = (*node\squint >> (a<<2)) & $f
If (*node\vertex And *node\squint)
_GETNODECOUNT()
If (offset <> 15 Or nodecount = 16)
_POKENHL(@*this\sb,depth,a)
IEnumNumeric(*this,*node\Vertex\e[offset] & #Squint_Pmask,0,depth+1,*pfn,*userdata)
EndIf
EndIf
Next
If *node\vertex=0
vchar = PeekI(@*this\sb)
CompilerIf #PB_Compiler_Backend = #PB_Backend_C
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
BeginAsm()
!"mov rax, %[vchar];"
!"bswap rax;"
!"mov %[vret], rax;"
AsmOutput(vret)
AsmInput(vchar)
AsmClobbers() "rax"
EndAsm()
CompilerElse
BeginAsm()
!"mov eax, %[vchar];"
!"bswap eax;"
!"mov %[vret], eax;"
AsmOutput(vret)
AsmInput(vchar)
AsmClobbers() "eax"
EndAsm()
CompilerEndIf
vchar = vret
CompilerElse
EnableASM
mov rax, vchar
bswap rax;
mov vchar,rax
DisableASM
CompilerEndIf
If *pfn
*pfn(@vchar,*node\value,*userdata)
EndIf
EndIf
ProcedureReturn *node
EndProcedure
Procedure SquintWalkNumeric(*this.squint,*pfn.squint_CB,*userdata=0)
_LockMutex(gwrite)
IEnumNumeric(*this,*this\root,0,0,*pfn,*userdata)
_UnLockMutex(gwrite)
EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
UseModule Squint
Procedure CBSquint(*key,*value,*userData)
Protected sout.s
sout = PeekS(*key,-1,#PB_UTF8)
If *value
Debug sout + " " + Str(*value)
EndIf
EndProcedure
Procedure CBSquintWalk(*key.Integer,value,*userData)
If value
If *key\i < (1 << 24) ;weed out the non numeirc keys, string keys will appear after the numeric so should be able to trap them
Debug Str(*key\i) + " " + Str(value)
EndIf
EndIf
EndProcedure
;note you can use squint via raw pointer or via interface it's up to you
;string keys can be either ascii, utf8 or unicode. you can also use numeric integers, while it's valid to mix them it's not really recomended yet
Global sq.isquint = SquintNew()
Global *key,key.s,SubTrie_A,SubTrie_B,val
CompilerIf #PB_Compiler_Debugger
;test with interface
key = "subtrie_a_" ;create a subtrie called subtrie_a_
SubTrie_A = sq\Set(0,@key,123) ;Set it with utf8 flag it returns the root of the sub trie
key = "abc"
sq\Set(SubTrie_A,@key,1) ;add to the sub trie
val = $AC82E2
*key = @val ;UTF8("bcd") ;make another key utf8
sq\Set(SubTrie_A,*key,2,#PB_UTF8) ;add it to the sub trie with utf8 key
*key = Ascii("cde")
sq\set(SubTrie_A,*key,3,#PB_Ascii) ;add to sub trie with ascii key
Debug "value from ascii key " + Str(sq\Get(SubTrie_A,*key,#PB_Ascii)) ;get the value from the ascci key
key = "abc"
Debug "value from unicode key " + Str(sq\Get(SubTrie_A,@key)) ;get the unicode key
Debug "___ENUM from subtrie_a_____"
key = "subtrie_a"
sq\Enum(@key,@CBSquint()) ;returns the root key + sub keys
key.s = "subtrie_b_" ;test raw access no interface
SubTrie_B = SquintSetNode(sq,0,@key,456) ;make another sub trie root_pb
key = "abc"
SquintSetNode(sq,SubTrie_B,@key,7)
key = "bcd"
SquintSetNode(sq,SubTrie_B,@key,8)
key = "cde"
SquintSetNode(sq,SubTrie_B,@key,9)
key = "bcde" ;add a key below bcd"
SquintSetNode(sq,SubTrie_B,@key,10)
key = "bcdef" ;add a key below bcde"
SquintSetNode(sq,SubTrie_B,@key,11)
Debug "++++Enum subtrie_b++++++"
key = "subtrie_b_"
sq\Enum(@key,@CBSquint()) ;returns the root key + sub keys
Debug "++++Delete and prune from bcd and Enum subtrie_b++++++"
key = "bcd"
SquintDeleteNode(sq,SubTrie_B,@key,1) ;Delete from bcd and prune removes the bcde bcdef node
key = "subtrie_b_"
sq\Enum(@key,@CBSquint()) ;returns the root key + sub keys
Debug "++++dump subtrie_a ++++++++"
SquintWalkNode(sq,SubTrie_A,@CBSquint()) ;returns the sub keys of SubTrie_A
Debug "++++dump whole trie +++++"
SquintWalkNode(sq,0,@CBSquint()) ;Dumps the entire trie
Debug "-------Numeric------------"
sq\SetNumeric(-1,12345) ;Add numeric keys
sq\SetNumeric(34567,34567)
sq\SetNumeric(23456,23456)
Debug "get numeric key " + Str(sq\GetNumeric(23456)) ;test get numeric
Debug "-------Walk numeric ----"
sq\WalkNumeric(@CBSquintWalk()) ;walk the numeric thery return in sorted order
sq\Free()
Debug "freed"
Procedure CBSquintWalkNum(*key.Integer,value,*userData)
Debug Str(*key\i) + " " + Str(value)
EndProcedure
sq.isquint = SquintNew()
sq\SetNumeric(1,123)
sq\SetNumeric(4,456)
sq\SetNumeric(8,8910)
Debug sq\GetNumeric(1)
Debug sq\GetNumeric(2)
Debug sq\GetNumeric(4)
Debug sq\GetNumeric(6)
Debug sq\GetNumeric(8)
Debug "-------Walk numeric ----"
sq\WalkNumeric(@CBSquintWalkNum())
sq\Free()
CompilerElse
UseMD5Fingerprint()
Global gQuit,lt,a,num
Global avgkeylen,mask
Global start = CreateSemaphore()
sq.isquint = SquintNew()
Global ks = 20
#TestNumeric = 1
#TESTMAP = 0
#NUMTHREADS = 12
lt = 1<<ks ;must be power orf 2 for thread test
mask = lt-1 ;range mask
If MessageRequester("begin test","Test Size " + FormatNumber(lt,0,".",",") + " lookups over 1 second",#PB_MessageRequester_YesNo) <> #PB_MessageRequester_Yes
End
EndIf
Global NewMap mp(lt)
Global mpmut = CreateMutex()
For a = 0 To lt
num = Random(1<<ks)
key = Hex(num);
avgkeylen+StringByteLength(key)
CompilerIf #TestNumeric
sq\SetNumeric(num,a)
mp(key)=a
CompilerElse
sq\Set(0,@key,a)
mp(key)=a
CompilerEndIf
Next
CompilerIf #TestNumeric
avgkeylen=8
CompilerElse
avgkeylen/lt
CompilerEndIf
MessageRequester("threads test","avg key len = " + Str(avgkeylen))
Procedure mpread(key.s)
Protected ret
;LockMutex(mpmut)
ret = mp(key)
;UnlockMutex(mpmut)
ProcedureReturn ret
EndProcedure
Procedure mpwrite(key.s,val)
;LockMutex(mpmut)
mp(key) = val
;UnlockMutex(mpmut)
EndProcedure
Procedure _Read(*ct.integer)
Protected key.s, num,ct
WaitSemaphore(start)
Repeat
Delay(0)
num = Random((1<<ks))
key = Hex(num)
CompilerIf #TESTMAP = 0
CompilerIf #TestNumeric
sq\GetNumeric(num)
CompilerElse
sq\get(0,@key)
CompilerEndIf
CompilerElse
CompilerIf #TestNumeric
mpread(key)
CompilerElse
mpread(key)
CompilerEndIf
CompilerEndIf
*ct\i + 1
Until gQuit
EndProcedure
Procedure _write(*ct.integer)
Protected key.s, num,ct
WaitSemaphore(start)
Repeat
num = Random((1<<ks))
key = Hex(num)
CompilerIf #TESTMAP = 0
CompilerIf #TestNumeric
sq\setNumeric(num,*ct\i)
CompilerElse
sq\Set(0,@key,*ct\i)
CompilerEndIf
CompilerElse
CompilerIf #TestNumeric
mpwrite(key,*ct\i)
CompilerElse
mpwrite(key,*ct\i)
CompilerEndIf
CompilerEndIf
Delay(0)
*ct\i + 1
Until gQuit
EndProcedure
Global Dim counts(#NUMTHREADS)
Global Dim threads(#NUMTHREADS)
For a = 0 To #NUMTHREADS-2
threads(a) = CreateThread(@_read(),@counts(a))
Next
Threads(a) = CreateThread(@_write(),@counts(a))
Delay(1000)
For a = 0 To #NUMTHREADS-1
SignalSemaphore(start)
Next
Delay(1000)
gquit=1
For a = 0 To #NUMTHREADS-1
WaitThread(threads(a))
Next
Global out.s, total
For a = 0 To #NUMTHREADS-2
total + counts(a)
Next
CompilerIf #TESTMAP
out + "Map lookups per second " + FormatNumber(total,0) + " writes " + FormatNumber(counts(#NUMTHREADS-1),0) + " map size " + FormatNumber(MapSize(mp()),0)
CompilerElse
CompilerIf #TestNumeric
out + "Squintnumeric lookups per second " + FormatNumber(total,0) + " writes " + FormatNumber(counts(#NUMTHREADS-1),0)
CompilerElse
out + "Squint lookups per second " + FormatNumber(total,0) + " writes " + FormatNumber(counts(#NUMTHREADS-1),0)
CompilerEndIf
CompilerEndIf
SetClipboardText(out)
MessageRequester("threads",out)
CompilerEndIf
CompilerEndIf