Is this a "Pointer mess"?

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

Is this a "Pointer mess"?

Postby Fabrizio_00000 » Jun 26, 2020 7:08

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

Re: Is this a "Pointer mess"?

Postby fxm » Jun 26, 2020 8:40

[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: 2148
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Is this a "Pointer mess"?

Postby badidea » Jun 26, 2020 9:38

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

Re: Is this a "Pointer mess"?

Postby badidea » Jun 26, 2020 11:57

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

Re: Is this a "Pointer mess"?

Postby fxm » Jun 26, 2020 12:37

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

Re: Is this a "Pointer mess"?

Postby Fabrizio_00000 » Jun 26, 2020 15:21

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

Re: Is this a "Pointer mess"?

Postby Fabrizio_00000 » Jun 26, 2020 15:33

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

Re: Is this a "Pointer mess"?

Postby fxm » Jun 26, 2020 15:46

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.

Return to “Beginners”

Who is online

Users browsing this forum: No registered users and 6 guests