is that right?!

[nastasa eodor]

'''tll me if that right?!

type dummy extends object
end type

type x extends dummy
z as byte
end type


dim as x ptr y=new x

print y

sleep 5000

deallocate y
delete y

print y
y->z = 10

print y->z

sleep

[D.J.Peters]

Code: Select all

type dummy extends object
end type
type x extends dummy
  z as byte
end type
dim as x ptr y=new x
print y
delete y : y=0
print y
y->z = 10
print y->z
sleep

[fxm]

Yes, it's right that initial code has a double reason to crash!

[nastasa eodor]

Code: Select all

type dummy extends object
end type
type x extends dummy
  z as byte
end type
dim as x ptr y=new x
print y
delete y : y=0
print y
y->z = 10
print y->z
sleep

Code: Select all

Const HEAP_NO_SERIALIZE             = &H1
Const HEAP_ZERO_MEMORY              = &H8

Declare Function HeapFree Lib "kernel32" Alias "HeapFree" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Long) As Long
Declare Function GetProcessHeap Lib "kernel32" Alias "GetProcessHeap" () As Long
Declare Function HeapDestroy Lib "kernel32" Alias "HeapDestroy" (ByVal hHeap As Long) As Long

Sub PtrFree(P as long)
    If P>0 Then 
       HeapFree(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,P)
       P = 0
    End If
End Sub

type dummy extends object
end type

type x extends dummy
    z as byte
end type

dim as x ptr y=new x

print y

sleep 5000

deallocate y
delete y

print y
y->z = 10

print y->z

PtrFree(clng(y))

print y
y->z = 10

print y->z

HeapDestroy(clng(y))'''seems only that work on here

print y
y->z = 10

print y->z



sleep

[nastasa eodor]

Yes, it's right that initial code has a double reason to crash!

THE INITIAL CODE DONT CRASH IN MY MACHINE...WIN7..SEEM NOT CLEAR THE PONTER

[nastasa eodor]

Code: Select all

type dummy extends object
end type
type x extends dummy
  z as byte
end type
dim as x ptr y=new x
print y
delete y : y=0
print y
y->z = 10
print y->z
sleep

THANK YOU, BUT SEEMS TO BE A WORK AROUND...IS THE POINTER CLEAN ANF FREE OR IS A FB MESS?

[nastasa eodor]

https://drive.google.com/open?id=1gA8km ... JOi9_8WY_q

[caseih]

You're the programmer. You are the one who knows whether a pointer is "clean" or not. If you can't always make that clear, assign a NULL to the pointer after you delete the memory. I don't see any problem or "mess" with with FB.

Having the language set pointers to NULL isn't something that C or C++ (or FB) does, although I could see how one could argue that FBC should automatically assign a pointer to zero after a "delete" statement. That would be in keeping with how FB automatically initializes variables to zero. At least that would guarantee a program crash when you try to access a freed pointer, rather than be a heisenbug. So feel free to make a request for this to the developers.

But in the meantime, no this is not a bug; it's common behavior, especially in C and C++ where free() is a libC call and has no way of setting the pointer to NULL anyway.

[nastasa eodor]

You're the programmer. You are the one who knows whether a pointer is "clean" or not. If you can't always make that clear, assign a NULL to the pointer after you delete the memory. I don't see any problem or "mess" with with FB.

Having the language set pointers to NULL isn't something that C or C++ (or FB) does, although I could see how one could argue that FBC should automatically assign a pointer to zero after a "delete" statement. That would be in keeping with how FB automatically initializes variables to zero. At least that would guarantee a program crash when you try to access a freed pointer, rather than be a heisenbug. So feel free to make a request for this to the developers.

But in the meantime, no this is not a bug; it's common behavior, especially in C and C++ where free() is a libC call and has no way of setting the pointer to NULL anyway.

THANK YOU FOR CLEARING MY MIND...ok i will use heapdestroy to free for real the #%$@ pointer...anyway you should teach about DELPHI how you free and clean the garbage...once again thank you was for help

[caseih]

I'm not sure what you mean about "free for real." When you use FB delete, memory is released--it *is* freed for real. The pointers that may have pointed to the memory have nothing to do with that. The OS can't help it if you try to refer to some memory that you shouldn't be. FB is not FreePascal; don't assume that FreePascal's idioms and ways of doing things are going to be the same in FB, or C, C++, or even Java.

Just a word of warning about memory management. Do not mix different sorts of memory management. For example, don't use malloc() to allocate memory and then use FB's delete to free it. Don't use the Win32 API calls to allocate memory and then use libc free() to free it. It *might* work, but no guarantees. I encourage you to use FB's new and delete operators because they ensure that the proper contructor and destructor are called on object. I don't think I'd use HeapFree or HeapDestroy either--they aren't portable calls and are unnecessary.

[fxm]

I wrote a short article about "How to Manage Dynamic Memory (Allocation / Deallocation) in FB".

[nastasa eodor]

I wrote a short article about "How to Manage Dynamic Memory (Allocation / Deallocation) in FB".

thanks fnx but i want to know with "new" what i shoud use to free for real the memory? And once again:

Code: Select all

type dummy extends object
end type

type x extends dummy
    z as byte
end type

dim as x ptr y=new x

print y

sleep 5000

deallocate y
y->z = 10

print y->z

delete y

print y
y->z = 10

print y->z


sleep

the resut are both
"10"
why if that #%$@ pointer was clear? it sould be a crush here. p.s. i build already a huge windows gui wrapper and an ide for it, and i am stuck in that..cant free memory of allocated controls with "new" operator. get me?

see that https://drive.google.com/open?id=1gA8km ... JOi9_8WY_q

[fxm]

"Delete" frees the memory allocated by "New", but "to free" does not mean to reset, nor that you can not access it (fraudulently) through the value of the pointer that has retained the address of the allocation.

This little code shows that "Delete" works well because the memory 2 address is reallocated only from the moment when "Delete" has been applied to it:

Code: Select all

Dim As Integer Ptr p1 = New Integer
Print "allocate   memory 1: @" & p1

Dim As Integer Ptr p2 = New Integer
Print "allocate   memory 2: @" & p2

Dim As Integer Ptr p3 = New Integer
Print "allocate   memory 3: @" & p3

Delete p2
Print "deallocate memory 2: @" & p2

Dim As Integer Ptr p4 = New Integer
Print "allocate   memory 4: @" & p4

Dim As Integer Ptr p5 = New Integer
Print "allocate   memory 5: @" & p5

Delete p1
Delete p3
Delete p4
Delete p5

Sleep

Code: Select all

allocate   memory 1: @6433440
allocate   memory 2: @6433488
allocate   memory 3: @6433504
deallocate memory 2: @6433488
allocate   memory 4: @6433488
allocate   memory 5: @6433520

[nastasa eodor]

ok thank you

work around
https://drive.google.com/file/d/1W2MGUh ... sp=sharing

Code: Select all

#include once "registerclasses.bas"

#include once "core.bas"
#include once "classes.bas"
#include once "component.bas"
#include once "controls.bas"
#include once "messages.bas"
#include once "forms.bas"
#include once "stdctrls.bas"
#include once "additional.bas"



var obj = TObject

var bcomp = TComponent

dim shared as TComponent c1,c2,c3

bcomp.destructor

type tdummy extends twincontrol
    declare virtual sub process(byref as TMessage)
    declare virtual sub defaulthandler(byref as TMessage)
    declare operator cast as any ptr
end type

operator tdummy.cast as any ptr
    return @this
end operator  

sub tdummy.process(byref message as TMessage)
end sub

sub tdummy.defaulthandler(byref message as TMessage)
end sub

dim shared as tdummy ctrl, ctrl1, ctrl2, ctrl3

ctrl1.parent = ctrl
ctrl2.parent = ctrl
ctrl3.parent = ctrl1

dim shared as tcomponent cc

type tpalette extends tcomponent
end type

var p = tpalette


dim shared as QForm f,ff,fff
f.text="main"
ff.text="modal"
fff.text="normal"
fff.width=450
dim shared as QDialog D 
d.text="dialog"

dim shared as Qmenuitem m, m1,m2,m3

sub fpaint(sender as tobject)
    with FormClass(@sender) 
        .Canvas.brush.color = clActivecaption
        .canvas.rectangle(0,0,200,200)
        .canvas.textout 10,10,"buci"
    end with
end sub

f.onpaint = @fpaint
f.parent = 0

ff.parent = f 
'''ff.showmodal

d.parent = f
fff.parent=f

m.caption="i"
m1.caption="i1"
m2.caption="i2"
m3.caption="i2"
m.add m1
m2.add m3
m.add m2

dim shared as tbitmap bmp
bmp= "blur.bmp"
bmp.savetofile "###.bmp"
print "bmp ",bmp.handle,lasterrormessage

sub clientpaint(sender as tobject)
    with MDIClientClass(@sender)
        .canvas.font.bold=1
        .canvas.font.size=11
        .canvas.textout(.canvas.width-.canvas.textwidth("koganion")-8,.Canvas.Height-.canvas.textheight("Wg")-8,"koganion")
    end with
end sub

dim shared as QMDIForm mf
dim shared as QMDIChild mc
mf.mdiclient.onpaint = @clientpaint

mf.parent=f
mf.MainMenu.add m
mc.text="child window"
mc.parent = mf.mdiclient
mf.mdiclient.align=1
mf.addchild
mf.addchild
mf.addchild
mf.addchild
mf.mdiclient.scrollbars = sbboth
mf.mdiclient.style = mf.mdiclient.style or ws_hscroll or ws_vscroll
print mf.childcount,mf.mdiclient.controlcount
mf.childcount=7
'''''''''''''''''''''''''''''''''''
dim as pmdiform mff=new qmdiform
print mff
mff->parent=f
mff->destroyhandle 'work around
mff=0'work around
'''''''''''''''''''''''''''''''''
dim shared as qbutton b:b.name="cur"
b.text="button"
b.parent = d
dim shared as qlabel l:l.name="cur"
l.text="label"
l.left = 80
l.tabstop=1
l.parent=d
dim shared as qcombobox cb:cb.name="cur"
cb.left=150
cb.tabstop=1
cb.parent=d
dim shared as qedit e
e.text="edit"
e.left=280
e.tabstop=1
e.parent=d
dim shared as qscrollbar sb
sb.top=40
sb.width=221
sb.parent=d
dim shared as qmemo me
me.top=60
me.width=200
me.height=100
me.parent=d
dim shared as qrichedit re
re.top=60
re.left=225
re.parent=d
'fff.designmode=1

type myedit extends qedit
    declare constructor
end type
constructor myedit
    fclassname = "myedit"
    fclassancestor="qedit"
    fstyle or=es_multiline or ws_hscroll or ws_vscroll
    fwidth = 221
    fheight = 121
end constructor
twincontrol.register("myedit","qedit",qedit.windowproc)

dim shared as myedit my
my.parent=ff
my.text="myedit"

type myredit extends qrichedit
    declare constructor
end type
constructor myredit
    fclassname = "myredit"
    fclassancestor="qrichedit"
    fstyle or=es_multiline or ws_hscroll or ws_vscroll
    fwidth = 221
    fheight = 221
end constructor
twincontrol.register("myredit","qrichedit",qedit.windowproc)

dim shared as myredit mry
mry.parent=ff
mry.left= 225
mry.text="myedit"


dim as tinifile ini
ini.writeinteger("main","is",cint(@f))

sub fclose(sender as tobject,byref closeaction as integer)
    if msgbox("Close?","question",mb_iconquestion or mb_yesnocancel) = idno then
        closeaction = 0
    end if
end sub

dim as hwnd hw = createwindowex(ws_ex_controlparent,"qform","scratch",ws_overlappedwindow or ws_visible,100,100,500,400,f.handle,0,instance,0)
print hw," ",lasterrormessage
formfromwindow(hw).onclose = @fclose
print createwindowex(ws_ex_controlparent,"qbutton","scratch",ws_child or ws_visible,0,0,75,40,hw,cast(hmenu,1001),instance,0),lasterrormessage
print createwindowex(ws_ex_controlparent,"qgroupbox","scratch",ws_child or ws_visible or bs_groupbox,0,45,175,470,hw,cast(hmenu,1002),instance,0),lasterrormessage
print createwindowex(ws_ex_controlparent,"qlabel","scratch",ws_child or ws_visible or ss_simple,80,0,95,20,hw,cast(hmenu,1003),instance,0),lasterrormessage
dim as hwnd mm = createwindowex(ws_ex_controlparent or ws_ex_clientedge,"qmemo","scratch",ws_child or ws_visible or ss_simple,240,0,95,220,hw,cast(hmenu,1004),instance,0)
print mm,lasterrormessage
memofromwindow(mm).align=2
'formfromwindow(hw).designmode = true

dim as qcustomframe fr, memo
dim as wndclassex wc

wc.cbsize = sizeof(wc)
wc.style=cs_globalclass or cs_dblclks or cs_classdc
wc.hinstance=instance
wc.lpszclassname=@"myclass"
wc.lpfnwndproc=fr.windowproc
wc.hcursor=loadcursor(0,idc_arrow)
wc.cbwndextra +=4 '''pay atention here missing allocation fail create window
registerclassex(@wc)
fr.classproc=0

clear wc,0,len(wc):print len(wc)

wc.cbsize = sizeof(wc)
if getclassinfoex(instance,"qmemo",@wc) then
    memo.classproc=wc.lpfnwndproc
    wc.cbwndextra +=4
    wc.lpszclassname = @"mymemo"
    wc.lpfnwndproc=wc.lpfnwndproc'''pay attention here
    print "register ",*wc.lpszclassname,registerclassex(@wc),lasterrormessage
end if

dim as hwnd w = createwindowex(0,"myclass","#%$@ myclass",ws_overlappedwindow or ws_visible,120,120,500,300,f.handle,0,instance,0)
fr.handle=w
memo.handle = createwindowex(ws_ex_clientedge,"mymemo","#%$@ myclass",ws_child or ws_visible,200,0,300,200,fr.handle,0,instance,0)
'print memo.handle,lasterrormessage



memo.classname="mymemo"
memo.classancestor="qmemo"
enablewindow(memo.handle,1)

fr.text="buci"
'fr.height=600
fr.style=ws_caption or ws_sysmenu or ws_visible or ws_sizebox
'fr.width=600

Application.Run

"Delete" frees the memory allocated by "New", but "to free" does not mean to reset, nor that you can not access it (fraudulently) through the value of the pointer that has retained the address of the allocation.

This little code shows that "Delete" works well because the memory 2 address is reallocated only from the moment when "Delete" has been applied to it:

Code: Select all

Dim As Integer Ptr p1 = New Integer
Print "allocate   memory 1: @" & p1

Dim As Integer Ptr p2 = New Integer
Print "allocate   memory 2: @" & p2

Dim As Integer Ptr p3 = New Integer
Print "allocate   memory 3: @" & p3

Delete p2
Print "deallocate memory 2: @" & p2

Dim As Integer Ptr p4 = New Integer
Print "allocate   memory 4: @" & p4

Dim As Integer Ptr p5 = New Integer
Print "allocate   memory 5: @" & p5

Delete p1
Delete p3
Delete p4
Delete p5

Sleep

Code: Select all

allocate   memory 1: @6433440
allocate   memory 2: @6433488
allocate   memory 3: @6433504
deallocate memory 2: @6433488
allocate   memory 4: @6433488
allocate   memory 5: @6433520

[nastasa eodor]

sometimes ago, is about 10 years i wrote a unit for RapidQ called "memory.inc",
well right now i translate it for freebasic,so...who want to use it ...get it.

the memory.bi code:

Code: Select all

#include once "windows.bi"

#DEFINE WIN_INCLUDEALL

#IFNDEF WIN_INCLUDEALL

Const HEAP_CREATE_ALIGN_16          = &H10000
Const HEAP_CREATE_ENABLE_TRACING    = &H20000
Const HEAP_DISABLE_COALESCE_ON_FREE = &H80
Const HEAP_FREE_CHECKING_ENABLED    = &H40
Const HEAP_GENERATE_EXCEPTIONS      = &H4
Const HEAP_GROWABLE                 = &H2
Const HEAP_MAXIMUM_TAG              = &HFFF
Const HEAP_NO_SERIALIZE             = &H1
Const HEAP_PSEUDO_TAG_FLAG          = &H8000
Const HEAP_REALLOC_IN_PLACE_ONLY    = &H10
Const HEAP_TAG_SHIFT                = 18
Const HEAP_TAIL_CHECKING_ENABLED    = &H20
Const HEAP_ZERO_MEMORY              = &H8

Declare Function HeapCreate Lib "kernel32" Alias "HeapCreate" (ByVal flOptions As Long, ByVal dwInitialSize As Long, ByVal dwMaximumSize As Long) As Long
Declare Function HeapDestroy Lib "kernel32" Alias "HeapDestroy" (ByVal hHeap As Long) As Long
Declare Function HeapAlloc Lib "kernel32" Alias "HeapAlloc" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Declare Function HeapReAlloc Lib "kernel32" Alias "HeapReAlloc" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Long, ByVal dwBytes As Long) As Long
Declare Function HeapFree Lib "kernel32" Alias "HeapFree" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Long) As Long
Declare Function HeapSize Lib "kernel32" Alias "HeapSize" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Long) As Long
Declare Function GetProcessHeap Lib "kernel32" Alias "GetProcessHeap" () As Long

#ENDIF

dim shared as CRITICAL_SECTION cs
initializeCriticalSection(@cs)

Function PtrSize(byref P as any ptr) As Integer
    dim as integer Size = 0 
    If P Then
       Size = HeapSize(GetProcessHeap,0,P)
    End If
    return Size
End Function

Sub PtrFree(byref P as any ptr)
    enterCriticalSection(@cs)
    If P Then 
       HeapFree(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,P)
       P = 0
    End If
    leaveCriticalSection(@cs)
End Sub

Sub PtrZero(byref P as any ptr,size as integer)
    If P Then 
       ZeroMemory(P,size)
    End If
End Sub

Sub PtrDestroy(byref P as any ptr)
    enterCriticalSection(@cs)
    If P Then 
       HeapDestroy(P)
       P = 0
    End If
    leaveCriticalSection(@cs)
End Sub

function FillPtr(P as any ptr, size as integer, ch as byte) as any ptr
    if P then
        FillMemory(P, Size, ch)
        return P
    else
        return 0
    end if
end function

Function _ReAllocate(byref P as any ptr,Count as integer) As any ptr
    If P Then
       P = cast(any ptr,HeapReAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,P,PtrSize(P)+Count))
    End If
    return P
End Function

Function _Allocate(Count as integer) As any ptr
    return cast(any ptr,HeapAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,Count))
End Function

Function xPtr(P as any ptr,Size as integer,Index as integer) As any ptr
    If P Then
       dim as integer Count = PtrSize(P)/Size
       If Index < Count Then
          return cast(any ptr,cint(P) + Index*Size)
       End If
    End If
    return 0
End Function

Function NewZStr(S As String) As string
    dim as string cs = s + Chr(0)
    dim as zstring ptr __Ptr = HeapAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,Len(cs))
    If __Ptr Then
       If cs <> "" Then
          MemCpy __Ptr,VarPTR(cs),Len(cs)
       Else
          __Ptr = 0
       End If
    End If
    return *__Ptr
End Function

Function NewStr(S As String) As string
    dim as string Cs = s
    dim as string ptr __Ptr = HeapAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,Len(Cs))
    If __Ptr Then MemCpy __Ptr,VarPTR(Cs),Len(Cs)
    return *__Ptr
End Function

Function StrFromPtr(P as string ptr) As String
    dim as string s = *P
    If P Then
       dim as integer L = HeapSize(GetProcessHeap,HEAP_NO_SERIALIZE,P)
       If L <> &HFFFFFFFF Then
          if s = "" then s = Space(L)
          MemCpy VarPTR(s),P,L
       Else
          s = ""
       End If
    End If
    return s
End Function

Function NewPtr(Size as long,Typ as any ptr) As any ptr
    dim as any ptr __Ptr = HeapAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,Size)
    If __Ptr Then If Typ Then MemCpy __Ptr,Typ,Size
    return __Ptr
End Function

Function NewDouble(Typ as double) As double
    dim as double F = Typ
    dim as double ptr __Ptr = HeapAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,SizeOf(Double))
    If __Ptr Then MemCpy __Ptr,VarPTR(F),SizeOf(Double)
    return *__Ptr
End Function

Function DoubleFromPtr(P as double ptr) As Double
    dim as double F = 0
    If P Then
       F = *P
       return F
    Else
       return 0
    End If
End Function

Function NewSingle(Typ as single) As single
    dim as single F = Typ
    dim as single ptr __Ptr = HeapAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,SizeOf(Single))
    If __Ptr Then MemCpy __Ptr,VarPTR(F),SizeOf(Single)
    return *__Ptr
End Function

Function SingleFromPtr(P as single ptr) As Single
    dim as single F = 0
    If P Then
       F = *P
       return F
    Else
       return 0
    End If
End Function

Function NewInteger(Typ as integer) As Integer
    dim as integer I = Typ
    dim as integer ptr __Ptr = HeapAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,SizeOf(Integer))
    If __Ptr Then MemCpy __Ptr,VarPTR(I),SizeOf(Integer)
    return *__Ptr
End Function

Function IntFromPtr(P as integer ptr) As Integer
    dim as integer I = 0
    If P Then
       I = *P
       return I
    Else
       return 0
    End If
End Function

Function NewShort(Typ as short) As short
    dim as short I = Typ
    dim as short ptr __Ptr = HeapAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,SizeOf(short))
    If __Ptr Then MemCpy __Ptr,VarPTR(I),SizeOf(Short)
    return *__Ptr
End Function

Function ShortFromPtr(P as short ptr) As Short
    dim as short I = 0
    If P Then
       I = *P
       return I
    Else
       return 0
    End If
End Function

Function NewByte(Typ as byte) As Integer
    dim as byte I = Typ
    dim as byte ptr __Ptr = HeapAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,SizeOf(Byte))
    If __Ptr Then MemCpy __Ptr,VarPTR(I),SizeOf(Byte)
    return *__Ptr
End Function

Function ByteFromPtr(P as byte ptr) As byte
    dim as byte I = 0
    If P Then
       I = *P
       return I
    Else
       return 0
    End If
End Function

Function NewByteArray(Count as integer) As byte ptr
    dim as byte ptr __Ptr = HeapAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,SizeOf(Byte)*Count)
    return __Ptr
End Function

Function NewIntArray(Count as integer) As Integer ptr
    dim as integer ptr __Ptr = HeapAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,SizeOf(Integer)*Count)
    return __Ptr
End Function

Function NewSngArray(Count as integer) As single ptr
    dim as single ptr __Ptr = HeapAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,SizeOf(Single)*Count)
    return __Ptr
End Function

Function NewDblArray(Count as integer) As double ptr
    dim as double ptr __Ptr = HeapAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,SizeOf(Double)*Count)
    return __Ptr
End Function

Function NewStrArray(Count as integer) As string ptr
    dim as string ptr __Ptr = HeapAlloc(GetProcessHeap,HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY,SizeOf(String)*Count)
    return __Ptr
End Function

and testing code:

Code: Select all

#include once "memory.bi"

dim as byte b = 12
dim as integer i
dim as long l
dim as short s
dim as single sg
dim as double d


dim as byte ptr nb = newptr(10,@b)

print ptrsize(nb), nb[0]

type x extends object
    f as string = "mata"
end type


dim as x y

dim as x ptr yy=newptr(10,@y)

print ptrsize(yy)

yy=cptr(x ptr,_ReAllocate(yy,29))

print ptrsize(yy),ptrsize(@yy[0].f),len(yy[0].f),sizeof(yy[0].f)

print yy[38].f,yy[9].f

fillptr(strptr(y.f),sizeof(y.f),39)

print y.f

ptrzero(@y,sizeof(y))

print "y = ",y.f,@y

ptrfree(yy)
ptrfree(@y)

print ptrsize(yy),yy,@y

/'ptrdestroy(yy)

print yy,ptrsize(yy)

ptrdestroy(@y)

print @y,ptrsize(@y) 'thst ones tow give a crush, but is normal '/

sleep