Code: Select all
;-TOP Module NumericKeyMap
; Comment: Module NumericKeyMap is a map with a numeric key
; Author : Wilbert
; Version: v1.02
; Create : 12/20/2019
; Update : 12/21/2019
; Link : https://www.purebasic.fr/english/viewtopic.php?f=12&t=74238
DeclareModule NumericKeyMap
;- Prototypes
Prototype.i ProtoAllocElement()
Prototype ProtoFreeElement(*Element)
;- Structures
Structure NKMapElement
*NextElement.NKMapElement
Key.i
Value.i
EndStructure
Structure NKMap
RShift.i
*AllocElement.ProtoAllocElement
*FreeElement.ProtoFreeElement
*Element.NKMapElement
*PrevElement.NKMapElement
*Buckets.NKMapElement[0]
EndStructure
;- Procedure declarations
Declare NKMap_Clear (*Map.NKMap)
Declare.i NKMap_Create (NrBuckets = 1024, *AllocElement = #Null, *FreeElement = #Null)
Declare.i NKMap_FindElement (*Map.NKMap, Key)
Declare NKMap_Free (*Map.NKMap)
Declare.i NKMap_GetValue (*Map.NKMap, Key)
Declare.i NKMap_NextElement (*Map.NKMap, *PtrElement.Integer)
Declare NKMap_RemoveElement (*Map.NKMap, Key)
Declare NKMap_Reset (*Map.NKMap)
Declare.i NKMap_SetValue (*Map.NKMap, Key, Value = 0)
EndDeclareModule
Module NumericKeyMap
DisableDebugger
EnableExplicit
;- Private macros
Macro NKMap_Get(n)
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
!mov r9, 11400714819323198549
!mov rdx, [p.p_Map] ; *Map
!mov rax, [p.v_Key] ; Key
!mov ecx, [rdx] ; RShift
!imul rax, r9
!shr rax, cl
CompilerIf n >= 1
!lea rax, [rdx + rax*8 + 40] ; *Bucket
!mov rdx, [p.v_Key] ; Key
!.l0:
!mov rcx, rax
!mov rax, [rcx]
!test rax, rax ; *Element #Null check
!jz .l1
!cmp rdx, [rax + 8] ; cmp Key, *Element\Key
!jb .l0
!je .l1
!xor eax, eax
!.l1:
!mov rdx, [p.p_Map]
!mov [rdx + 24], rax ; set *Map\Element
!mov [rdx + 32], rcx ; set *Map\PrevElement
CompilerEndIf
CompilerIf n >= 2
!test rax, rax
!jz .l2
!mov rax, [rax + 16]
!.l2:
CompilerEndIf
CompilerElse
!mov edx, [p.p_Map] ; *Map
!mov eax, [p.v_Key] ; Key
!mov ecx, [edx] ; RShift
!imul eax, 2654435761
!shr eax, cl
CompilerIf n >= 1
!lea eax, [edx + eax*4 + 20] ; *Bucket
!mov edx, [p.v_Key] ; Key
!.l0:
!mov ecx, eax
!mov eax, [ecx]
!test eax, eax ; *Element #Null check
!jz .l1
!cmp edx, [eax + 4] ; cmp Key, *Element\Key
!jb .l0
!je .l1
!xor eax, eax
!.l1:
!mov edx, [p.p_Map]
!mov [edx + 12], eax ; set *Map\Element
!mov [edx + 16], ecx ; set *Map\PrevElement
CompilerEndIf
CompilerIf n >= 2
!test eax, eax
!jz .l2
!mov eax, [eax + 8]
!.l2:
CompilerEndIf
CompilerEndIf
EndMacro
;- Private procedures
Procedure.i NKMap_Bucket(*Map.NKMap, Key)
NKMap_Get(0)
ProcedureReturn
EndProcedure
;- Public procedures
Procedure.i NKMap_FindElement(*Map.NKMap, Key)
; Return a pointer to the found element or
; #Null when the element wasn't found.
NKMap_Get(1)
ProcedureReturn
EndProcedure
Procedure.i NKMap_GetValue(*Map.NKMap, Key)
; Return the value of the element with the specified key.
NKMap_Get(2)
ProcedureReturn
EndProcedure
Procedure.i NKMap_Create(NrBuckets = 1024, *AllocElement = #Null, *FreeElement = #Null)
; Create a new map with the specified number of buckets.
; The number of buckets should be a power of 2.
; AllocElement and FreeElement are callback pointers to allocate
; and free a custom element.
Protected.NKMap *Map
Protected.l Shift, n = 1
If NrBuckets < 16
NrBuckets = 16
ElseIf NrBuckets > 16777216
NrBuckets = 16777216
EndIf
While n < NrBuckets
n << 1 : Shift + 1
Wend
NrBuckets = 1 << Shift
*Map = AllocateMemory((NrBuckets + 5) * SizeOf(Integer))
If *Map
*Map\RShift = SizeOf(Integer)<<3 - Shift
*Map\AllocElement = *AllocElement
*Map\FreeElement = *FreeElement
EndIf
ProcedureReturn *Map
EndProcedure
Procedure NKMap_Clear(*Map.NKMap)
; Remove all map items but leave the map structure
; itself available for further use.
Protected.NKMapElement *Element, *NextElement
Protected.l NrBuckets, Bucket
*Map\Element = #Null
NrBuckets = 1 << (SizeOf(Integer)<<3 - *Map\RShift)
While Bucket < NrBuckets
*Element = *Map\Buckets[Bucket]
*Map\Buckets[Bucket] = #Null
If *Map\FreeElement
While *Element
*NextElement = *Element\NextElement
*Map\FreeElement(*Element)
*Element = *NextElement
Wend
Else
While *Element
*NextElement = *Element\NextElement
FreeMemory(*Element)
*Element = *NextElement
Wend
EndIf
Bucket + 1
Wend
EndProcedure
Procedure NKMap_Free(*Map.NKMap)
; Free the map completely.
; The map can no longer be used after calling this.
NKMap_Clear(*Map)
FreeMemory(*Map)
EndProcedure
Procedure.i NKMap_NextElement(*Map.NKMap, *PtrElement.Integer)
; Return the next map element.
Protected.NKMapElement *Element
Protected.l NrBuckets, Bucket
*Element = *Map\Element
If *Element
If *Element\NextElement
; return next element in current bucket
*Element = *Element\NextElement
*Map\Element = *Element
If *PtrElement
*PtrElement\i = *Element
EndIf
ProcedureReturn #True
Else
; find next bucket number
Bucket = NKMap_Bucket(*Map, *Element\Key) + 1
EndIf
EndIf
NrBuckets = 1 << (SizeOf(Integer)<<3 - *Map\RShift)
While Bucket < NrBuckets And *Map\Buckets[Bucket] = #Null
Bucket + 1
Wend
If Bucket < NrBuckets
*Element = *Map\Buckets[Bucket]
*Map\Element = *Element
If *PtrElement
*PtrElement\i = *Element
EndIf
ProcedureReturn #True
Else
; end of map has been reached
ProcedureReturn #False
EndIf
EndProcedure
Procedure NKMap_RemoveElement(*Map.NKMap, Key)
; Remove the element with the specified key.
Protected.NKMapElement *Element
*Element = NKMap_FindElement(*Map, Key)
If *Element
*Map\PrevElement\NextElement = *Element\NextElement
*Map\Element = #Null
If *Map\FreeElement
*Map\FreeElement(*Element)
Else
FreeMemory(*Element)
EndIf
EndIf
EndProcedure
Procedure NKMap_Reset(*Map.NKMap)
; Reset the current map element
*Map\Element = #Null
EndProcedure
Procedure.i NKMap_SetValue(*Map.NKMap, Key, Value = 0)
; Set the value for the map element with the specified key.
; If the element doesn't exist, it will be created.
; The element is also returned from the procedure.
Protected.NKMapElement *Element
*Element = NKMap_FindElement(*Map, Key)
If *Element = #Null
If *Map\AllocElement
*Element = *Map\AllocElement()
Else
*Element = AllocateMemory(SizeOf(NKMapElement), #PB_Memory_NoClear)
EndIf
*Element\Key = Key
*Element\NextElement = *Map\PrevElement\NextElement
*Map\PrevElement\NextElement = *Element
EndIf
*Element\Value = Value
ProcedureReturn *Element
EndProcedure
EndModule