VB6 / VBA is slow to deallocate class instances
VB* class instance deallocation becomes exponentially slower the more instances of that particular class there are.
Quick test. You will need:
- Guido's excellent AccurateTimer library
- a class module
Class1with no code - the following code in a standard .bas module
Run TestDeallocSpeed1 method.
Option Explicit
Sub TestDeallocSpeed1()
Dim i As Long
Dim n As Long
Dim cInit As Currency
Dim cDestroy As Currency
Dim arr() As Class1
Const alignR As Long = 14
'
Debug.Print AlignRight(alignR, "Instances", "Init (uS)", "Destroy (uS)")
n = 3
Do
'Init
ReDim arr(1 To n)
cInit = AccurateTimerUs()
For i = 1 To n
Set arr(i) = New Class1
Next i
cInit = AccurateTimerUs() - cInit
'
'Destroy
cDestroy = AccurateTimerUs()
Erase arr
cDestroy = AccurateTimerUs() - cDestroy
'
Debug.Print AlignRight(alignR, n, cInit, cDestroy)
n = n * 1.2
Loop Until n > 2 ^ 20
End Sub
Private Function AlignRight(ByVal size As Long, ParamArray args() As Variant) As String
Dim v As Variant
Dim res As String
Dim arg As String
Dim lBuf As String: lBuf = Space$(size)
'
For Each v In args
If IsNumeric(v) Then arg = Format$(v, "#,##0") Else arg = v
arg = Right$(lBuf & arg, size)
res = res & arg
Next v
AlignRight = res
End Function
The results will be printed to your Immediate window. Here are the results on my x64 VBA7 Windows, shown on a chart:
Creating almost 950,000 instances takes around 0.6 seconds while destroying them takes 185 seconds. Ridiculous.
Please note that this only applies to custom class modules. Destroying instances created in DLL references is fast, e.g. the native Collection from VBE7.DLL
Why is deallocation slow
Olaf Schmidt has done some investigation on this issue in the past. The following posts were really helpful:
Many thanks to Olaf. His work has put me on the right path to figure out why this is happening.
Apparently, each class instance holds a pointer to the previous instance immediately after the virtual table pointer i.e. at address ObjPtr(instance) + PTR_SIZE where PTR_SIZE is 4 (x32) or 8 (x64) bytes. We will explore the VB* class footprint later below to gain more clarity.
There are some assumptions being made in those posts. Here are the most important ones:
- VB* must hold a pointer to the last created instance
- when VB* destroys a class instance, it traverses all instances starting from the last created instance all the way to the first
- the speed issue is probably caused by te registration / deregistration calls to
IConnectionPointinterface while traversing the linked list of instance pointers - it's a possibility that the list of instance pointers is double-linked
After extensive testing, it turns out that only the first two assumptions are correct. I've discovered the following:
- VB* does hold a pointer to the last instance
- traversal indeed always goes from last instance to first
- list of instance pointers is single-linked i.e. instances only "know" what the previous instance is but not the next
- event deregistration does not affect speed
- instances are often only partially destroyed, so that the class footprint memory space is reused
- there is a second list of pointers but only for the partially destroyed instances. The pointers for this can be found at address
ObjPtr(instance)i.e. where the vTable pointer was before termination. More details on this later below - each traversal can deallocate (free up memory) for none, one or more partially deallocated instances
In other words, the speed degradation cause is the following: while traversing, VB also deallocates instances that have nothing to do with the one currently being terminated. This is because instances can be partially destroyed. All the checks involved are presumably done for each instance being traversed thus exponentially taking longer. Demonstration further below.
Please note that throughout this explanation, the word Terminated refers to a Partial Deallocation.
VB* Class Footprint
We must first understand the layout of a class instance. Olaf's findings were really close:
Public Type VBClassHeader '64Bytes for a naked Class -> 16 32Bit Members
pVTable As Long
pPreviousInstanceSameType As Long '<- here's the most interesting one
pUnkInstance As Long 'always denoting with 28Bytes Offs to our own ObjInstance-Ptr
pInstanceBaseClass As Long 'sidewards-allocation (extra memory)
pInstanceIConnectionPoint As Long 'sidewards-allocation (extra memory)
YetToFindOut1 As Long 'usually at Zero
YetToFindOut2 As Long 'usually at Zero
pUnkVTable As Long 'the 7'th member after pVTable (= our 28Bytes Offs)
lRefCount As Long
lDataSourceBehaviourFlag As Long
YetToFindOut3 As Long 'usually at Zero
StateFlag As Long 'usually at &H100F, but at &H1C6E when terminating
YetToFindOut4 As Long 'usually at Zero
'-> ...Class-private Vars will be inserted here, shifting the IClassModuleEvt-vTable down
pVTableIClassModuleEvt As Long
YetToFindOut5 As Long 'usually at Zero
YetToFindOut6 As Long 'usually at Zero
End Type
There are a few differences I found during testing:
pInstanceIConnectionPointis in fact a pointer to an array of virtual function tablespInstanceBaseClassis in fact pointing to the last virtual table in the array mentioned above- in between the class private vars and
pVTableIClassModuleEvtthere will be pointers to interfaces being implemented or interfaces created for varsWithEvents, if any YetToFindOut5is a pointer to where theStaticclass variables are stored i.e. the ones declared inside the class methods, if any
Let's update the names and make it x64 compatible. The members are prefixed with alphabet letters so that when viewed in the Locals window, while debugging, we can see them in the correct order.
Public Type VBClass
a_VTableOrPrevTerm As LongPtr 'While Active, points to the class main virtual table (derived from IDispatch)
'After termination, points to the previous terminated instance
b_PreviousInstance As LongPtr 'Points to the previous created instance of the same class type. This can be a terminated instance
c_IUnknownPtr As LongPtr 'Points to h_IUnknown virtual table i.e. offset 52 (x64) or 28 (x32) from instance pointer
d_BaseClass As LongPtr 'Points to last vTable in array pointed by e_VBClassVTables i.e. e_VBClassVTables + PTR_SIZE * 6
e_VBClassVTables As LongPtr 'Points to an array of virtual tables - see VBClassVTables struct below
f_YetToFindOut1 As LongPtr '0
g_YetToFindOut2 As LongPtr '0
h_IUnknown As LongPtr 'Points to the class IUnknown virtual table
i_RefCount As Long 'Instance reference count
j_DataSourceBehaviourFlag As Long 'Seems to be 0 in VBA - don't have VB6 to test with
k_YetToFindOut3 As Long '0
l_StateFlag As Long 'Initializing = &H1007 (while within Class_Initialize)
'Active = &H100F,
'Releasing = &H1057 (while within IUnknown::Release),
'ReleasingLost = &H1867 (while within Release but state lost),
'Terminating = &H1807 (while within Class_Terminate),
'Terminated = &H1C6E (not destroyed)
m_YetToFindOut4 As LongPtr '0
n_YetToFindOut5 As LongPtr '0
'
'Class-private Variables will be inserted here, shifting the IClassModuleEvt-vTable down, if any
'
'Class implemented interfaces (virtual tables pointers) will be inserted here, if any
'Interfaces created by VB automatically, when there are WithEvents variables declared, will be inserted here, if any
'
o_IClassModuleEvt As LongPtr 'Points to the class IClassModuleEvt virtual table
p_StaticVars As LongPtr 'If any, a call to Win API like GlobalSize or LocalSize will return the byte size being used
q_YetToFindOut6 As LongPtr '0
End Type
Public Type VBClassVTables
a_SomeVTable1 As LongPtr
b_IConnectionPoint As LongPtr
c_IConnectionPointCointainer As LongPtr
d_SomeVTable2 As LongPtr
e_SomeVTable3 As LongPtr
f_IMarshall As LongPtr
g_BaseClass As LongPtr
End Type
A quick test, run TestClassFootprint:
Option Explicit
#If Mac Then
#If VBA7 Then
Public Declare PtrSafe Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As LongPtr) As LongPtr
#Else
Public Declare Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As Long) As Long
#End If
#Else
#If VBA7 Then
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If
#End If
#If Win64 Then
Public Const PTR_SIZE As Long = 8
Public Const NULL_PTR As LongLong = 0^
#Else
Public Const PTR_SIZE As Long = 4
Public Const NULL_PTR As Long = 0&
#End If
#If VBA7 = 0 Then
Public Enum LongPtr
[_]
End Enum
#End If
Public Function MemLongPtr(ByVal addr As LongPtr) As LongPtr
CopyMemory MemLongPtr, ByVal addr, PTR_SIZE
End Function
Sub TestClassFootprint()
Dim vc As VBClass
Dim vct As VBClassVTables
Dim temp As Class1
Dim c As Class1
'
Set temp = New Class1
Set c = New Class1
'
CopyMemory vc, ByVal ObjPtr(c), LenB(vc)
CopyMemory vct, ByVal vc.e_VBClassVTables, LenB(vct)
'
Debug.Assert MemLongPtr(vc.d_BaseClass) = vct.g_BaseClass
Debug.Assert vc.b_PreviousInstance = ObjPtr(temp)
Debug.Assert MemLongPtr(vc.c_IUnknownPtr) = vc.h_IUnknown
'
Stop
End Sub
Looks like this:
VB* can partially destroy instances
These are, roughly, the steps that VB* takes when terminating a class instance:
IUnknown::Releaseis called as a result of:- user manually set the object variable to
Nothing - object variable went out of scope
- state was lost
- user manually set the object variable to
- if the reference count is bigger than 1, then it gets decreased and nothing else happens
- if the reference count is 1 (
i_RefCount), meaning it will be zero after decreasing, state is set to 'Terminated' (&H1C6E) at offset 76 (x64) / 44 (x32) bytes (l_StateFlag) _Terminateis called on theIClassModuleEvtinterface and soClass_Terminateis called, if present. However, if state was lost (e.g.Endran or Stop was pressed in the VBE) thenClass_Terminateis not called- static variables are cleared -
p_StaticVarspoints to where these are stored - internal variables are cleared, if not already cleared by bespoke code in
Class_Terminate - pointers are cleared for (see class footprint in previous section):
a_VTableOrPrevTermd_BaseClasse_VBClassVTables- the array pointed by this is also deallocated
- the class footprint is never deallocated for the instance being terminated
- VB traveses the list of instance pointers and might deallocate the class footprint for previously terminated instances, depending how many there are - again, these are held to be reused and presumably to avoid deallocate >> reallocate if unnecessary
- VB will update the
a_VTableOrPrevTermto point to the previous terminated (but not deallocated) instance. If there are no previously terminated instances or if they were deallocated, thena_VTableOrPrevTermwill be set to zero / null ptr - VB will update the
b_PreviousInstancepointers in case any previously terminated instances were deallocated
To test this, you must use Excel as it is important to see the results while code stops on the Stop lines. Keep the VBE and Excel windows side by side. Add this code to a standard module and run TestDealloc (press F5 key to jump to the next Stop):
Option Explicit
Sub TestDealloc()
Dim i As Long
Dim coll As New Collection
Const n As Long = 30
Dim c(1 To n) As Class1
Dim ptrs(1 To n) As LongPtr
'
For i = 1 To n
Set c(i) = New Class1
ptrs(i) = ObjPtr(c(i))
coll.Add i, CStr(ptrs(i))
Next i
coll.Add "vTblPtr", CStr(MemLongPtr(ObjPtr(c(1))))
coll.Add "n/a", CStr(0)
'
WriteTraversal coll, ptrs(n) 'Start from last pointer
Stop
'
For i = 1 To n
If i Mod 7 = 0 Then
Set c(i) = Nothing
WriteTraversal coll, ptrs(n)
Stop
End If
Next i
For i = 1 To n
If i Mod 7 <> 0 Then
Set c(i) = Nothing
WriteTraversal coll, ptrs(n)
Stop
End If
Next i
For i = 1 To 4
Set c(i) = New Class1
WriteTraversal coll, ptrs(n)
Stop
Next i
Erase c
WriteTraversal coll, ptrs(n)
Stop
End Sub
Sub WriteTraversal(ByVal coll As Collection, ByVal lastPtr As LongPtr)
Dim res As New Collection
Dim ptr As LongPtr: ptr = lastPtr
Dim v As Variant
'
Do 'Traverse the linked list of instance pointers
res.Add coll(CStr(ptr))
res.Add coll(CStr(MemLongPtr(ptr))) 'vTbl or previously terminated
ptr = MemLongPtr(ptr + PTR_SIZE) 'Previous instance
res.Add coll(CStr(ptr))
Loop Until ptr = NULL_PTR
'
Dim i As Long
Dim j As Long
Const c As Long = 3
Dim r As Long: r = res.Count / c
Dim arr() As Variant: ReDim arr(1 To r, 1 To c)
'
i = r
For Each v In res
j = j + 1
arr(i, j) = v
If j = c Then
j = 0
i = i - 1
End If
Next v
'
With Range("A1")
.Resize(1, 3).Value2 = Array("Instance #" _
, "VTbl or prevTerminated" _
, "Prev instance")
With .Offset(1, 0)
.Resize(.End(xlDown).Row - .Row + 1, c).Value2 = Empty
.Resize(r, c).Value2 = arr
End With
End With
End Sub
Please note that I chose to use the index of the instance (in the creation order) instead of using pointers, to make it easier to follow what is going on.
The above code illustrates how previously terminated instances are reused and how deallocation works. Here's a gif:
Pelase note that I did not share code used to test and prove some of the points mentioned here (e.g. how e_VBClassVTables is deallocated or how l_StateFlag is changed). This is because it would bloat this question and it's irrelevant to the following section.
The above code/gif only runs a simple demonstation but in reality, while instances are terminated and reused, the order of those pointers can point in both directions e.g. instance 17 points to instance 16 at PTR_SIZE offset while pointing to instance 50 at zero offset because both 17 and 50 are partially deallocated.
Overcome VB design - Faster Instance Deallocation
My goal was to make VBA-FastDictionary faster, which is a must for working with JSON. JSON that took 8 seconds to parse was taking hundreds of seconds to deallocate, but with this and eventually this, the deallocation is now under a second.
The problem with VBA7 is that it has a massive API overhead - see this Code Review question. If we want to keep all code inside the relevant class, then we must copy memory using something native. I am using fake arrays which I call memory accesors but we could also use fake Variant ByRef (see VBA-MemoryTools for both approaches).
For now, this is the code needed to fix the problem for our example Class1 but see the next section for other thoughts and ideas. Please note we need the global instance i.e. Attribute VB_PredeclaredId = True. So, place the below code in a Class1.cls text file and then import that file:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'@PredeclaredId
Option Explicit
#If Mac Then
#If VBA7 Then
Private Declare PtrSafe Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As LongPtr) As LongPtr
#Else
Private Declare Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As Long) As Long
#End If
#Else 'Windows
#If VBA7 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If
#End If
#If VBA7 = 0 Then
Private Enum LongPtr
[_]
End Enum
#End If
#Const Windows = (Mac = 0)
#Const x64 = Win64
Private Enum InternalConstants 'Hides constants from Locals window
#If x64 Then
ptrSize = 8
#Else
ptrSize = 4
#End If
prevOffset = ptrSize 'Previous instance pointer immediately after vTable
End Enum
Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Private Type SAFEARRAY_1D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As LongPtr
rgsabound0 As SAFEARRAYBOUND
End Type
'Data shared across all class instances
Private Type Globals
saP As SAFEARRAY_1D
d As Double 'A safe pointer
dPtr As LongPtr
lastInstancePtr As LongPtr
lastTerminatedPtr As LongPtr
lastTerminatedNextPtr As LongPtr
nextPtrOffset As LongPtr
defPtrOffset As LongPtr
End Type
'These will link into the default (Predeclared) instance of this class
Private Type MemoryAccessors
Common() As Globals
RPtr() As LongPtr
End Type
Private Type DeallocVars
ThisPtr As LongPtr
NextClassPtr As LongPtr
End Type
Private Type ClassVariables
DefInstance As Class1 'Avoids deallocation of default (Predeclared) instance
Dealloc As DeallocVars
End Type
'Class members
Private Vars As ClassVariables
Private Mem As MemoryAccessors
Private Sub InitSafeArray(ByRef sa As SAFEARRAY_1D, ByVal elemSize As Long)
Const FADF_AUTO As Long = &H1
Const FADF_FIXEDSIZE As Long = &H10
Const FADF_COMBINED As Long = FADF_AUTO Or FADF_FIXEDSIZE
With sa
.cDims = 1
.fFeatures = FADF_COMBINED
.cbElements = elemSize
.cLocks = 1
End With
End Sub
'To avoid API calls overhead memory accessors are cached in the default instance
' (Attribute VB_PredeclaredId = True)
Friend Sub InitStructs(ByRef v As ClassVariables _
, ByRef m As MemoryAccessors)
#If x64 Then
Const nullPtr As LongLong = 0^
#Else
Const nullPtr As Long = 0&
#End If
Static h As Globals
Static saH As SAFEARRAY_1D
Static saPtrs(0 To 1) As LongPtr
Dim temp As Object
'
If Not Vars.DefInstance Is Nothing Then
Vars.DefInstance.InitStructs v, m
Exit Sub
End If
'
If saH.cDims = 0 Then
h.nextPtrOffset = VarPtr(Vars.Dealloc.NextClassPtr) - Vars.Dealloc.ThisPtr
h.defPtrOffset = VarPtr(Vars.DefInstance) - Vars.Dealloc.ThisPtr
'
saPtrs(0) = VarPtr(saH)
saPtrs(1) = VarPtr(h.saP)
'
InitSafeArray saH, LenB(h)
InitSafeArray h.saP, ptrSize
'
saH.pvData = VarPtr(h)
h.dPtr = VarPtr(h.d)
h.saP.pvData = h.dPtr
'
saH.rgsabound0.cElements = 1
h.saP.rgsabound0.cElements = 1
'
'The only API call
CopyMemory ByVal VarPtr(Mem) + ptrSize, saPtrs(1), ptrSize
End If
'
'Avoid deallocation of Global Instance
If v.Dealloc.ThisPtr <> Vars.Dealloc.ThisPtr Then Set v.DefInstance = Me
'
'Init memory accesors for each instance
h.saP.pvData = VarPtr(m)
Mem.RPtr(0) = saPtrs(0)
h.saP.pvData = h.saP.pvData + ptrSize
Mem.RPtr(0) = saPtrs(1)
'
'Read previous instance pointer
h.saP.pvData = v.Dealloc.ThisPtr + prevOffset
'
Dim prevPtr As LongPtr: prevPtr = Mem.RPtr(0)
Dim tempPtr As LongPtr
'
If prevPtr = nullPtr Then 'Can only be def instance
h.lastInstancePtr = v.Dealloc.ThisPtr
h.saP.pvData = h.dPtr
Exit Sub
End If
'
'In case user modified the global instance e.g. Set Class1 = Nothing
If v.DefInstance Is Nothing Then
Do
h.saP.pvData = prevPtr + h.defPtrOffset
tempPtr = Mem.RPtr(0)
If tempPtr Then Exit Do
'
h.saP.pvData = prevPtr + prevOffset
If Mem.RPtr(0) = nullPtr Then
h.saP.pvData = prevPtr + h.nextPtrOffset
If Mem.RPtr(0) Then tempPtr = prevPtr
Exit Do
End If
prevPtr = Mem.RPtr(0)
Loop
If (tempPtr <> nullPtr) And (tempPtr <> Vars.Dealloc.ThisPtr) Then
'Link to the 'real' def instance
h.saP.pvData = VarPtr(temp)
Mem.RPtr(0) = tempPtr 'Unmanaged - ref count not increased
Set Vars.DefInstance = temp
Mem.RPtr(0) = nullPtr 'Ref count not decreased
'
Vars.DefInstance.InitStructs Vars, Mem
With Mem.Common(0)
.saP.pvData = .lastTerminatedPtr + prevOffset
If Mem.RPtr(0) = v.Dealloc.ThisPtr Then
'Previous instance is currently initializing and it is
' definitely reusing previously terminated memory
v.Dealloc.NextClassPtr = .lastTerminatedPtr
.saP.pvData = .lastTerminatedPtr + .nextPtrOffset
Mem.RPtr(0) = .lastTerminatedNextPtr
.lastTerminatedNextPtr = v.Dealloc.ThisPtr
.saP.pvData = v.Dealloc.ThisPtr + prevOffset
.lastTerminatedPtr = Mem.RPtr(0)
End If
.saP.pvData = .dPtr
End With
Exit Sub
End If
End If
'
If v.Dealloc.ThisPtr = h.lastTerminatedPtr Then
'Reusing previously terminated memory
v.Dealloc.NextClassPtr = h.lastTerminatedNextPtr
h.lastTerminatedPtr = prevPtr
h.lastTerminatedNextPtr = v.Dealloc.ThisPtr
Else
If prevPtr = h.lastInstancePtr Then
h.lastInstancePtr = v.Dealloc.ThisPtr
Else 'The previous instance could be initializing
h.saP.pvData = prevPtr + prevOffset
If Mem.RPtr(0) = h.lastInstancePtr Then
h.lastInstancePtr = v.Dealloc.ThisPtr
End If
End If
End If
h.saP.pvData = prevPtr + h.nextPtrOffset
Mem.RPtr(0) = v.Dealloc.ThisPtr
'
h.saP.pvData = h.dPtr
End Sub
'Only initialize memory manipulation structs
Private Sub Class_Initialize()
Vars.Dealloc.ThisPtr = ObjPtr(Me)
Class1.InitStructs Vars, Mem
End Sub
'Postpones termination to a later stage where we have full control over how VBA
' traverses the linked list of all class instances
Private Sub Class_Terminate()
'Deallocate internal variables here e.g. other Class1 instances
'...
'...
'
'Cache this instance inside the global instance and destroy later
Vars.DefInstance.DelayTermination Me, Vars
Set Vars.DefInstance = Nothing
End Sub
'When VB* terminates a class instance, it traverses all instances starting from
' the last created instance all the way to the first. On itself this would be
' fast but unfortunately VB also makes checks and can reclaim memory that is
' unrelated to the instance being terminated. So, this traversal becomes
' exponentially slower the more instances there are - O(n^2)
'This method 'tricks' VB into traversing only a handful of instances thus making
' the whole termination process linear - O(n)
Friend Sub DelayTermination(ByRef instanceToDelay As Class1 _
, ByRef v As ClassVariables)
#If x64 Then
Const nullPtr As LongLong = 0^
#Else
Const nullPtr As Long = 0&
#End If
Static pendingClass As Class1
Static pendingPtr As LongPtr
Static lastClass As Class1
Static lastClassPtr As LongPtr
Dim prevPtr As LongPtr
Dim followPtr As LongPtr
Dim secondLastPtr As LongPtr
Dim tempClass As Class1
'
If pendingClass Is Nothing Then
Set pendingClass = instanceToDelay
pendingPtr = v.Dealloc.ThisPtr
Exit Sub
End If
With Mem.Common(0)
If pendingPtr = .lastInstancePtr Then
'We force keep the last instance active to avoid extra logic
If lastClass Is Nothing Then
Set lastClass = pendingClass
lastClassPtr = pendingPtr
Set pendingClass = instanceToDelay
pendingPtr = v.Dealloc.ThisPtr
Exit Sub
End If
'
Set tempClass = lastClass
Set lastClass = pendingClass
Set pendingClass = tempClass
Set tempClass = Nothing
pendingPtr = lastClassPtr
lastClassPtr = .lastInstancePtr
End If
'
If .lastTerminatedPtr = nullPtr Then
.lastTerminatedPtr = Vars.Dealloc.ThisPtr 'Use Def instance
End If
'
.saP.pvData = pendingPtr + prevOffset
prevPtr = Mem.RPtr(0)
'
If prevPtr = .lastTerminatedPtr Then
.saP.pvData = pendingPtr + .nextPtrOffset
followPtr = Mem.RPtr(0)
Else 'Insert after last terminated
Mem.RPtr(0) = .lastTerminatedPtr
.saP.pvData = .lastTerminatedPtr + .nextPtrOffset
'
Dim tempPtr As LongPtr: tempPtr = Mem.RPtr(0)
Mem.RPtr(0) = pendingPtr
'
.saP.pvData = tempPtr + prevOffset
Mem.RPtr(0) = pendingPtr
'
.saP.pvData = pendingPtr + .nextPtrOffset
followPtr = Mem.RPtr(0)
Mem.RPtr(0) = tempPtr
'
If prevPtr <> nullPtr Then 'Not first ever instance
.saP.pvData = prevPtr + .nextPtrOffset
Mem.RPtr(0) = followPtr
End If
'
.saP.pvData = followPtr + prevOffset
Mem.RPtr(0) = prevPtr
followPtr = tempPtr
End If
'
'Make VB 'believe' that trailing instance is the last instance
' so that a shorter list is traversed when we terminate 'pending'
.saP.pvData = .lastInstancePtr + prevOffset
secondLastPtr = Mem.RPtr(0)
Mem.RPtr(0) = pendingPtr
'
Set pendingClass = Nothing 'Traverse short list and deallocate as needed
'
Mem.RPtr(0) = secondLastPtr 'Restore to long list
'
.saP.pvData = pendingPtr + prevOffset
If .lastTerminatedPtr <> Mem.RPtr(0) Then 'Memory was reclaimed
.saP.pvData = Mem.RPtr(0) + .nextPtrOffset
Mem.RPtr(0) = pendingPtr
End If
.lastTerminatedPtr = pendingPtr
.lastTerminatedNextPtr = followPtr
.saP.pvData = .dPtr
'
Set pendingClass = instanceToDelay
pendingPtr = v.Dealloc.ThisPtr
End With
End Sub
Now run again the TestDeallocSpeed1 method that we initially ran on Class1 when it had no code. This is the new result:
So, destroying 950,000 instances used to take 185 seconds but it is now done in 0.67 seconds. This is how things should be - destroy should be faster than create.
Other approaches and ideas
Needless to say, reaching the above result took literally months and I explored and implemented several approaches. I won't go into details on them but I will share some thoughts on the current approach and some ideas to expand the solution.
I chose to implement all code inside the relevant class as I wanted to have a self-contained solution, which was always the goal for a single-class library like VBA-FastDictionary. You probably realized that the Class1 solution above is just a stripped down version of the dictionary class.
However, all this could be done using a standard .bas module that could handle all the memory manipulation to overcome the API overhead and it could be written to support multiple classes. For example, all classes would pass themselves to a global method which would then keep track of the necessary pointers per each class type. The code would be quite complicated, but definitely doable. While this would be a great fit-all solution it would introduce a necessary dependency on that standard module.
Alternatively, we could have the memory manipulation inside a standard module while still keeping track of the pointers inside each class. Easier to implement but still with dependency.
Current approach
For those who don't have the time to understand what the code does. Here are the main ideas:
- we keep track of the next instance pointer in each instance while we let VB* keep track of the previous instance
- we keep track of the last instance ever created which VB also does. This is slightly tricky because the user can terminate the global instance and so we have to maintain a default instance that coordinates everything and stores such "global" pointers
- we never deallocate the last instance. This greatly simplifies the logic needed and is much faster. This implies that we always have at least 2 active instances: the default and the last. These will only be deallocated when state is lost / application quits
- when the
Class_Terminatemethod is called, we simply store the instance as pending so that we get outside the scope ofClass_Terminate. In other words, we delay termination. While this is going on, we can terminate the previously pending instance, if any - when we terminate a pending instance, we make sure to trick VB* into traversing a shorter list of instances. To do that, we make sure we insert the pending instance immediately after the previously terminated (or the default one). This could require up to 6 pointer swaps to make sure we maintain our now double-linked list. Once inserted, we link the very last created instance directly to our pending instance, meaning VB* will skip traversing anything in between. At this step, VB* might deallocate one or more previously terminated instances (which we've maintained in order by doing the swaps) but will never deallocate the one pending
- once terminated, we restore the list to it's full length so that VB can properly deallocate in case of state loss
Question
Can this approach be improved?
Any other feedback or suggestions are welcome.
