All worked so far on 64-bit Windows and Linux but crashed on 32-bit.
I found out that FreeBASIC alloctes UDT's and of course Classes on 32-bit on a 8 byte boundary and on 64-bit on a 16 byte boundary.
So I needed SSE aligned memory on 32-bit also.
By the way I used it in fbImage before that means you can free an aligend pointer with ImageDestroy() if you like :-)
Of course AlignFree() does the same job and set the deallocated pointer to NULL !
Code: Select all
' alloc aligned memory (default not cleared)
function AlignAlloc(byval nItems as uinteger, byval sizeofItem as uinteger, byval alignment as uinteger,byval bClearMem as boolean=false) as any ptr
if nItems=0 then return 0
if sizeofItem=0 then sizeofItem=nItems
if alignment=0 then alignment=sizeofItem
'print "AlignAlloc(" & nItems & "," & sizeofItem & "," & alignment & ")"
dim as uinteger pointer_size = (sizeof(any ptr)*3)
dim as uinteger payload_size = nItems*sizeofItem
dim as integer allocated_size = payload_size + pointer_size + alignment
dim as any ptr tmp = iif(bClearMem,callocate(allocated_size),allocate(allocated_size))
dim as any ptr p = cptr(any ptr,((cast(uinteger,tmp) + pointer_size + alignment) and not alignment))
cptr(any ptr ptr,p)[-3] = cptr(any ptr,payload_size)
cptr(any ptr ptr,p)[-2] = cptr(any ptr,allocated_size)
cptr(any ptr ptr,p)[-1] = tmp
' alloc cleared aligned memory
function AlignCAlloc(byval nItems as uinteger, byval sizeofItem as uinteger, byval alignment as uinteger) as any ptr
' get total size of aligned memory
function AlignSize(byval p as any ptr) as uinteger
if p=0 then return 0
return cast(uinteger,cptr(any ptr ptr,p)[-2])
' get size of payload memory
function AlignPayload(byval p as any ptr) as uinteger
if p=0 then return 0
return cast(uinteger,cptr(any ptr ptr,p)[-3])
' free an aligned pointer (byref) and set it NULL
' !!! be sure the pointer was allocted aligned before !!!
' Is the same as ImageDestroy() :-)
sub AlignFree(byref p as any ptr)
if p then
var original_p = cptr(any ptr ptr,p)[-1]
if original_p then deallocate original_p