[solved] Is the FreeBASIC array alignment safe ?

General FreeBASIC programming questions.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by fxm »

dodicat wrote:How on earth does this work?
(flags and &h0000000f) provides the number of dimensions allocated in the descriptor (and not the number of dimensions of the array which is the 'dimensions' field).

The descriptor memory is allocated at the first array declaration.
When the array is first declared without dimensions ('[re]dim array()'), a descriptor size for 8 dimensions (the maximum) is allocated.
Then when the array is re-declared with an explicit number of dimensions ('redim array(0)' for example), the descriptor is not reallocated (only the 'dimensions' field is set and the end of the descriptor memory may become useless).

(flags and &h00000010) provides a flag which signifies that the descriptor has been allocated with a fixed number of dimensions (=> the one of the array)

( see FBARRAY (array descriptor structure and access) / paragraph 'Description' / FBARRAY.flags) )


Another code variant not using 'goto':

Code: Select all

sub align(s() as single,n as long,f as long=0)
   do
      redim as integer b(f) 'get some granularity
      redim s(n+f)
      if cast(uinteger,@s(0)) mod 32 =0  then f+=1:continue do
      if cast(uinteger,@s(0)) mod 16 <>0 then f+=1:continue do
      var i=cast(uinteger,@s(0))
      redim preserve s(n)
      if cast(uinteger,@s(0))<> i then f+=1: else exit do
   loop
end sub
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by dodicat »

Thanks, I had a look at the new .chm, I see the constants now, under arrays.
However I still like my goto's, (anywhere).
A false loop seems ugly just to avoid a simple goto.

Code: Select all




#include "fbc-int/array.bi"

function flagsString(flags as uinteger) as string
  return str(flags and &h0000000f) & " allocated dims " & _
  iif(flags and &h00000010,"dimensions are fixed " ," ") & _
  iif(flags and &h00000020,"memory is fixed lenght" ,"")
end function

function alignedString(adr as uinteger) as string
  if (adr and 31) = 0 then return " aligned(32)"
  if (adr and 15) = 0 then return " aligned(16)"
  if (adr and  7) = 0 then return " aligned(8)"
  return " not SSE aligned !"
end function

#macro printArrayInfo2(array)        
#define lbl2 label2
scope
      #print typeof(array)
  var p=FBC.ArrayConstDescriptorPtr(array())
  print "index_ptr         " & str(p->index_ptr) & alignedString(cast(uinteger,p->index_ptr))
  print "base_ptr          " & p->base_ptr & alignedString(cast(uinteger,p->base_ptr))
  print "size              " & p->size
  print "element_len       " & p->element_len
  print "dimensions        " & p->dimensions
  print "flags             " & p->flags & " " & flagsString(p->flags)
  if p->dimensions<1 then goto lbl2
  for i as uinteger = 0 to p->dimensions-1
    print "dimtb(" & i & ").elements " & p->dimtb(i).elements
    print "dimtb(" & i & ").lbound   " & p->dimtb(i).lbound
    print "dimtb(" & i & ").ubound   " & p->dimtb(i).ubound
    print
  next
  lbl2:
  end scope
  #undef label2
  #endmacro
  
  
#macro align(s,n)
#define  lbl label
scope
      dim as long f
lbl:
 redim as integer b(f) 'get some granularity
 redim s(n+f)
 if cast(uinteger,@s(0)) mod 32 =0  then f+=1:goto lbl
 if cast(uinteger,@s(0)) mod 16 <>0 then f+=1:goto lbl
 var i=cast(uinteger,@s(0))
 redim preserve s(n)
 if cast(uinteger,@s(0))<> i then f+=1:goto lbl
 end scope
 #undef label
#endmacro


width 120,50
type udt
      as double d(10)
end type

     
redim as udt vec3(0)
redim as byte vec4(0)
redim as long mat4(0)
redim as any ptr tst(0)

align(vec3,2)
align(vec4,3)
align(mat4,15)
align(tst,50)

locate 1
print "vec3()"
printArrayInfo2(vec3)
print
print "vec4()"
printArrayInfo2(vec4)
print
print "mat4()"
printArrayInfo2(mat4)
print
print "test()"
printArrayInfo2(tst)


sleep
  
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by fxm »

The advantage of use Do / Loop / Continue Loop / Exit Loop (or similarly with For / While loops), compared to backward Goto, is that this naturally protects against possible fraudulent jumps that could corrupt the stack and thus bug the program.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by jj2007 »

adeyblue wrote:you can just use _aligned_malloc /_aligned_realloc / _aligned_free, no hoop jumping required
Did anybody get this to work? I always get undefined reference, see above.
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by srvaldez »

from https://docs.microsoft.com/en-us/cpp/c- ... w=msvc-160

Code: Select all

'#include once "crt.bi"
#define NULL 0

extern "c"
	'declare function _aligned_malloc(byval as size_t,byval as size_t) as any ptr
	'declare sub _aligned_free(byval as any ptr)
	declare function _aligned_realloc(byval memblock as any ptr, byval size as uinteger, byval alignment as uinteger) as any ptr
	declare function _aligned_malloc(byval size as uinteger, byval alignment as uinteger) as any ptr
	declare sub _aligned_free(byval memblock as any ptr)
	declare function _aligned_recalloc(byval memblock as any ptr, byval num as uinteger, byval size as uinteger, byval alignment as uinteger) as any ptr
	declare function _aligned_offset_realloc(byval memblock as any ptr, byval size as uinteger, byval alignment as uinteger, byval offset as uinteger) as any ptr
	declare function _aligned_offset_malloc(byval size as uinteger, byval alignment as uinteger, byval offset as uinteger) as any ptr
end extern

private function main() as long
	dim ptr_ as any ptr
	dim alignment as uinteger
	dim off_set as uinteger
	alignment = 16
	off_set = 5
	ptr_ = _aligned_malloc(100, alignment)
	if ptr_ = NULL then
		print "Error allocation aligned memory."
		return -1
	end if
	if (cuint(ptr_) mod alignment) = 0 then
		print "This pointer, ";hex(ptr_,16);", is aligned on ";alignment
	else
		print "This pointer, ";hex(ptr_,16);", is not aligned on ";alignment
	end if
	ptr_ = _aligned_realloc(ptr_, 200, alignment)
	if (cuint(ptr_) mod alignment) = 0 then
		print "This pointer, ";hex(ptr_,16);", is aligned on "; alignment
	else
		print "This pointer, ";hex(ptr_,16);", is not aligned on "; alignment
	end if
	_aligned_free(ptr_)
	ptr_ = _aligned_offset_malloc(200, alignment, off_set)
	if ptr_ = NULL then
		print "Error allocation aligned offset memory."
		return -1
	end if
	if ((cuint(ptr_) + off_set) mod alignment) = 0 then
		print "This pointer, ";hex(ptr_,16);", is offset by ";off_set;" on alignment of "; alignment
	else
		print "This pointer, ";hex(ptr_,16);", does not satisfy offset ";off_set; "and alignment "; alignment
	end if
	ptr_ = _aligned_offset_realloc(ptr_, 200, alignment, off_set)
	if ptr_ = NULL then
		print "Error reallocation aligned offset memory."
		return -1
	end if
	if ((cuint(ptr_) + off_set) mod alignment) = 0 then
		print "This pointer, ";hex(ptr_,16);", is offset by ";off_set;" on alignment of "; alignment
	else
		print "This pointer, ";hex(ptr_,16);", does not satisfy offset ";off_set;" and alignment ";alignment
	end if

	_aligned_free(ptr_)
end function

main()
corrected as fxm suggested :-)
Last edited by srvaldez on Jun 20, 2021 20:11, edited 1 time in total.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by fxm »

To be compatible both with fbc 64-bit and fbc 32-bit:
if (culngint(ptr_) mod alignment) = 0 then
if (cuint(ptr_) mod alignment) = 0 then

(similarly for the other expressions)
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by srvaldez »

it compiles as is in win64 FB x64, but I suspected that culngint would need to be changed for 32-bit
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by jj2007 »

Thanks, the Extern "C" did the job!

Code: Select all

extern "c"
  declare function _aligned_malloc(byval as size_t, byval as size_t) as any ptr
  declare sub _aligned_free(byval as any ptr)
end extern
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by dodicat »

srvaldez, your pointers are also aligned 32.
(cast(uinteger,ptr_) mod 32) =0
Maybe something simpler but cheesy:

Code: Select all


function alignedString(adr as uinteger) as string
  if (adr and 31) = 0 then return " aligned(32)"
  if (adr and 15) = 0 then return " aligned(16)"
  if (adr and  7) = 0 then return " aligned(8)"
  return " not SSE aligned !"
end function

type array
    as byte u(any)
    end type

sub Get16Align(slots() as any ptr,size as long,num as long=0)
static as array ref(num+4000)=any
dim as long count=-1,n
do
      redim (ref(n).u)(size)
    var i=cast(uinteger,@ref(n).u(0))
     if  (i mod 32<>0) and (i mod 16=0) then
         count+=1
         redim preserve slots(count)
         slots(count)=cptr(any ptr,@ref(n).u(0))
   end if
   n+=1
loop until count>=num
end sub

redim as any ptr p()

Get16align(p(),13*sizeof(string),5)
print "element","pointer"
for n as long=0 to ubound(p)
      print n, (p(n)),alignedstring(cast(uinteger,p(n)))
next

print "using first pointer ";p(0)
dim as string ptr x=p(0)

print alignedstring(cast(uinteger,x))

for n as long=0 to 12
      x[n]=str(timer)
      print x[n]';" ";
next n
print


sleep

 
Last edited by dodicat on Jun 21, 2021 17:26, edited 4 times in total.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by jj2007 »

Here is another version, pretty fast:

Code: Select all

Dim shared as integer ProcHeap
ProcHeap=GetProcessHeap()

function Alloc16(bytes as long) As integer	' inspired by MasmBasic's Alloc16
Dim As integer a16=HeapAlloc(ProcHeap, HEAP_GENERATE_EXCEPTIONS or HEAP_ZERO_MEMORY, bytes+16)
  if a16 and 8 Then *cast(integer ptr, a16) = 8: return a16+8	' set the flag/offset, return ptr+8
  return a16+16	' flag not set, ret ptr+16
end function

Sub Free16(oldptr as integer)
  HeapFree(ProcHeap, 0, oldptr+*cast(integer ptr, oldptr-8)-16)
End Sub
Full example with timings against CRT _aligned_malloc:

Code: Select all

#include "Windows.bi"	' HeapAlloc + HeapFree
#include "crt.bi"	' _aligned_malloc + _aligned_free
#define elements 500	' array elements

extern "c"
  declare function _aligned_malloc(byval as size_t, byval as size_t) as integer
  declare sub _aligned_free(byval as integer)
end extern

Dim shared as integer ProcHeap
ProcHeap=GetProcessHeap()

function Alloc16(bytes as long) As integer	' inspired by MasmBasic's Alloc16
Dim As integer a16=HeapAlloc(ProcHeap, HEAP_GENERATE_EXCEPTIONS or HEAP_ZERO_MEMORY, bytes+16)
  if a16 and 8 Then *cast(integer ptr, a16) = 8: return a16+8	' set the flag/offset, return ptr+8
  return a16+16	' flag not set, ret ptr+16
end function

Sub Free16(oldptr as integer)
  HeapFree(ProcHeap, 0, oldptr+*cast(integer ptr, oldptr-8)-16)
End Sub

Dim as long somearray(elements)
Dim As double t
Dim As long useAlloc16
for tloop as Long=0 to 7
	t=timer
	For outerloop as long=1 to 2000
	For x as long=0 To elements
		if useAlloc16 then
			somearray(x)=Alloc16(Rnd()*1000)
		else
			somearray(x)=_aligned_malloc(Rnd()*1000, 16)
		endif
		' printf("%x ", somearray(x))
	Next 
	' print
	For x as long=0 To elements
		if useAlloc16 then
			Free16(somearray(x))
		else
			_aligned_free(somearray(x))
		endif
	Next
	Next
	t=timer-t
	print "Alloc16=";useAlloc16;": ";int(t*1000);" ms"
	useAlloc16=useAlloc16 xor 1
next
sleep
Last edited by jj2007 on Jun 21, 2021 20:02, edited 1 time in total.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by fxm »

About this above post, can you compile your example with the '-exx' option and fix the runtime errors (that would be better):
Aborting due to runtime error 6 (out of bounds array access) ...
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by srvaldez »

dodicat wrote:srvaldez, your pointers are also aligned 32.
(cast(uinteger,ptr_) mod 32) =0
Maybe something simpler but cheesy:
dodicat, I like that you think outside the box :-)
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by dodicat »

I notice that size (msdn) is in bytes, so I adjusted my previous code accordingly.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by jj2007 »

fxm wrote:About this above post, can you compile your example with the '-exx' option and fix the runtime errors (that would be better):
Aborting due to runtime error 6 (out of bounds array access) ...
Right. Line 23: Dim as long somearray(elements) ' take away the -1
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: [solved] Is the FreeBASIC array alignment safe ?

Post by D.J.Peters »

fxm wrote: Jun 20, 2021 8:51
D.J.Peters wrote:Only to show you an example here are vec4 aligned 16 bytes.

Code: Select all

.....
operator vec4 . cast as _VEC4 ptr
  return cptr(_VEC4 ptr,cast(uinteger,@memory) and MASK)
end operator
.....
operator vec4 . [] (byref index as const uinteger) byref as single
  return cptr(single ptr,cast(uinteger,@memory) and MASK)[index]
end operator
...
MASK ?
Anyway, I don't see how you can align this pointer with a simple AND (with the condition: pointer >= @memory) ?
I would rather seen a pointer value like this:
((cast(uinteger, @memory) + 15) and (-16))
Yes the part with MASK etc. was missing !

Today I play with embree a high CPU optimzed math library from INTEL https://github.com/embree/embree and it works great with aligned data types.

Joshy

Code: Select all

#include "crt.bi"
const as uinteger ALIGN = 15, MASK = NOT ALIGN

type _VEC4
  as single x=any,y=any,z=any,w=any
end type  


type vec4 ' is aligned(16)
  declare constructor
  declare constructor(byref v as vec4)
  declare constructor(byref x as const single, _
                      byref y as const single, _
                      byref z as const single, _
                      byref w as const single)
  declare operator cast as _VEC4 ptr ' <--- NOTE this data type are declared as parameter as replacement for C/C++ aligned array !
  declare operator cast as string
  declare operator let(byref v as vec4) 
  declare operator [] (byref index as const uinteger) byref as single
  declare property x as single
  declare property x (byref v as const single)
  declare property y as single
  declare property y (byref v as const single)
  declare property z as single
  declare property z (byref v as const single)
  declare property w as single
  declare property w (byref v as const single)  
  private:
  memory as zstring * 31 ' sizeof(single)*4=16 + 15 more bytes for alignment
end type
constructor vec4
end constructor
constructor vec4(byref v as vec4) 
  memcpy(this,v,sizeof(_VEC4))
end constructor
constructor vec4(byref a as const single, _
                 byref b as const single, _
                 byref c as const single, _
                 byref d as const single)
  this[0]=a : this[1]=b : this[2]=c : this[3]=d 
end constructor
operator vec4 . cast as _VEC4 ptr
  return cptr(_VEC4 ptr,cast(uinteger,@memory+15) and MASK)
end operator
operator vec4 . let(byref v as vec4)
  memcpy(this,v,sizeof(_VEC4))
end operator
' the primary key are here, all member access end in aligned adresses !
operator vec4 . [] (byref index as const uinteger) byref as single
  return cptr(single ptr,cast(uinteger,@memory+15) and MASK)[index]
end operator
operator vec4 . cast as string : return "vec4[" & this[0] & "," & this[1] & "," & this[2] & "," & this[3] & "]":end operator
property vec4 . x as single : return this[0] : end property
property vec4 . x (byref v as const single) : this[0]=v  : end property  
property vec4 . y as single : return this[1] : end property
property vec4 . y (byref v as const single) : this[1]=v  : end property  
property vec4 . z as single : return this[2] : end property
property vec4 . z (byref v as const single) : this[2]=v  : end property  
property vec4 . w as single : return this[3] : end property
property vec4 . w (byref v as const single) : this[3]=v  : end property  

dim as Vec4 a=vec4(1,2,3,4)
dim as _VEC4 ptr p=a
print a
print a.x,a.y,a.z,a.w
print p->x,p->y,p->z,p->w

print hex(mask)
sleep
Post Reply