Hi guys,
keeping track of which records have been deleted in a table has always ben an issue to me, so I wrote a simple routine that uses an allocated memory area as a bitmask:
dim shared as ulong FreeSlots, PoolSize
dim as ushort i, x
dim as ulong ptr table
function FindFreeSlot(byref rm as ulong ptr) as ulong
dim as ulong i, oldsize, newsize
dim j as ubyte
if FreeSlots = 0 then
oldsize = PoolSize shr 5
newsize = oldsize * 1.5
print: print "Buffer from "; oldsize;" to ";newsize; " DWORD."
rm = reallocate(rm, newsize)
if rm = 0 then return 0
clear rm[oldsize], 0, (newsize - oldsize) * sizeof(ulong)
PoolSize = newsize shl 5
FreeSlots = ((newsize - oldsize) shl 5) - 1
rm[oldsize] = 1
return (oldsize shl 5) + 1
endif
for i = 0 to (PoolSize shr 5) - 1
if rm[i] <> &hffffffff then
for j = 0 to 31
if (rm[i] and (1 shl j)) = 0 then
rm[i] or= (1 shl j)
FreeSlots -= 1
return ((i shl 5) or j) + 1
endif
next
endif
next
end function
PoolSize = 128: FreeSlots = PoolSize
Table = callocate(PoolSize shr 5)
for i = 1 to 500
x = FindFreeSlot(table)
print x; " ";
next
deallocate Table
This code snipped should "reserve" a record marking its position and should increase the amount of reserved space in case it runs out.
The code doesn't work and franky I don't understand why. Maybe I'm messing with pointers?
is there anyone who can shed light on this mystery?
Thanks!
dim shared as ulong FreeSlots, PoolSize
dim as ushort i, x
dim as ulong ptr table
function FindFreeSlot(byref rm as ulong ptr) as ulong
dim as ulong i, oldsize, newsize
dim j as ubyte
if FreeSlots = 0 then
oldsize = PoolSize shr 5
newsize = oldsize * 1.5
print: print "Buffer from "; oldsize;" to ";newsize; " DWORD."
'rm = reallocate(rm, newsize)
rm = reallocate(rm, newsize shl 2) ' 1 ulong = 4 bytes
if rm = 0 then return 0
clear rm[oldsize], 0, (newsize - oldsize) * sizeof(ulong)
PoolSize = newsize shl 5
FreeSlots = ((newsize - oldsize) shl 5) - 1
rm[oldsize] = 1
return (oldsize shl 5) + 1
endif
for i = 0 to (PoolSize shr 5) - 1
if rm[i] <> &hffffffff then
for j = 0 to 31
if (rm[i] and (1 shl j)) = 0 then
rm[i] or= (1 shl j)
FreeSlots -= 1
return ((i shl 5) or j) + 1
endif
next
endif
next
end function
PoolSize = 128: FreeSlots = PoolSize
'Table = callocate(PoolSize shr 5)
Table = callocate(PoolSize shr 3) ' 1 byte = 8 bits
for i = 1 to 500
x = FindFreeSlot(table)
print x; " ";
next
deallocate Table
dim shared as ulong FreeSlots, PoolSize
dim as ushort i, x
dim as ulong Table(any)
function FindFreeSlot(Tbl() as ulong) as ulong
dim as ulong i, oldsize, newsize
dim j as ubyte
if FreeSlots = 0 then
oldsize = PoolSize shr 5
newsize = oldsize * 1.5
print: print "Buffer from "; oldsize;" to ";newsize; " DWORD."
redim Tbl(0 to newsize - 1) 'can redim fail?
PoolSize = newsize shl 5
FreeSlots = ((newsize - oldsize) shl 5) - 1
Tbl(oldsize) = 1
return (oldsize shl 5) + 1
endif
for i = 0 to (PoolSize shr 5) - 1 '0 to 31
if Tbl(i) <> &hffffffff then
for j = 0 to 31
if (Tbl(i) and (1 shl j)) = 0 then
Tbl(i) or= (1 shl j)
FreeSlots -= 1
return ((i shl 5) or j) + 1
endif
next
endif
next
return -1
end function
PoolSize = 128: FreeSlots = PoolSize
redim Table(0 to (PoolSize shr 5) - 1)
for i = 1 to 500
x = FindFreeSlot(Table())
print x; " ";
next
erase Table
This seems to be safe at first glance, but in order to be also compatible with the '-exx' compile option, the triggered run-time error must be also catch by the user.
Example:
Redim As LongInt a(1 To 1)
Do
Dim As LongInt I = Ubound(a)
I = I * 2
On Error Goto out_of_memory
Redim Preserve a(1 to I)
On Error Goto 0
If Ubound(a) < I Then Print Lbound(a), Ubound(a), " End 1" : Sleep : End
Print Lbound(a), Ubound(a)
Loop
out_of_memory:
Print Lbound(a), Ubound(a), " End 2" : Sleep : End
Unfortunately the solution has to be built with no array: the allocation table is part of an object (I am writing an AVL Tree indexing object) and, as you know, dynamic arrays are not allowed within an object...
Thanks a lot, fxm, the problem was just under my eyes but I couldn't see it. I was keeping on confusing 32 (the number of bits in a qword) with 8 (the bits in a byte).
Again, thanks to you all! :)
FreeBASIC Type structures can contain dynamic data such as var-len (dynamic) strings, and also resizable (dynamic) arrays (since version 1.00).
For a member dynamic array, the only constraint is that the number of dimensions of the array must be defined in some way in the declaration of the Type.