Is this a "Pointer mess"?

New to FreeBASIC? Post your questions here.
Post Reply
Fabrizio_00000
Posts: 21
Joined: Mar 31, 2011 17:30
Location: Rome, Italy

Is this a "Pointer mess"?

Post by Fabrizio_00000 »

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:

Code: Select all

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!
fxm
Moderator
Posts: 12082
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Is this a "Pointer mess"?

Post by fxm »

[C]Allocate / Reallocate allocates memory in Byte quantum (not in Long quantum).

Changing, for example with Shl / Shr keyword:

Code: Select all

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
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Is this a "Pointer mess"?

Post by badidea »

Annoying when you finally find the error and it turns out that fxm already posted the solution :-)

A version with redim, easier to debug. I hope I did it right:

Code: Select all

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
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Is this a "Pointer mess"?

Post by badidea »

fxm wrote:(something that was deleted later)
Is it possible to check the new array size boundaries to determine if redim (preserve) succeeded, or is this not safe?
fxm
Moderator
Posts: 12082
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Is this a "Pointer mess"?

Post by fxm »

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:

Code: Select all

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
Fabrizio_00000
Posts: 21
Joined: Mar 31, 2011 17:30
Location: Rome, Italy

Re: Is this a "Pointer mess"?

Post by Fabrizio_00000 »

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...
Fabrizio_00000
Posts: 21
Joined: Mar 31, 2011 17:30
Location: Rome, Italy

Re: Is this a "Pointer mess"?

Post by Fabrizio_00000 »

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! :)
fxm
Moderator
Posts: 12082
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Is this a "Pointer mess"?

Post by fxm »

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.
Post Reply