is that right?!
-
- Posts: 182
- Joined: Dec 18, 2018 16:37
- Location: Germany, Hessdorf
- Contact:
is that right?!
'''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
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
-
- Posts: 8586
- Joined: May 28, 2005 3:28
- Contact:
Re: is that right?!
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
Re: is that right?!
Yes, it's right that initial code has a double reason to crash!
-
- Posts: 182
- Joined: Dec 18, 2018 16:37
- Location: Germany, Hessdorf
- Contact:
Re: is that right?!
D.J.Peters wrote: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
-
- Posts: 182
- Joined: Dec 18, 2018 16:37
- Location: Germany, Hessdorf
- Contact:
Re: is that right?!
THE INITIAL CODE DONT CRASH IN MY MACHINE...WIN7..SEEM NOT CLEAR THE PONTERfxm wrote:Yes, it's right that initial code has a double reason to crash!
-
- Posts: 182
- Joined: Dec 18, 2018 16:37
- Location: Germany, Hessdorf
- Contact:
Re: is that right?!
THANK YOU, BUT SEEMS TO BE A WORK AROUND...IS THE POINTER CLEAN ANF FREE OR IS A FB MESS?D.J.Peters wrote: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
-
- Posts: 182
- Joined: Dec 18, 2018 16:37
- Location: Germany, Hessdorf
- Contact:
Re: is that right?!
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.
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.
-
- Posts: 182
- Joined: Dec 18, 2018 16:37
- Location: Germany, Hessdorf
- Contact:
Re: is that right?!
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 helpcaseih wrote: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.
Re: is that right?!
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.
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.
Re: is that right?!
I wrote a short article about "How to Manage Dynamic Memory (Allocation / Deallocation) in FB".
-
- Posts: 182
- Joined: Dec 18, 2018 16:37
- Location: Germany, Hessdorf
- Contact:
Re: is that right?!
thanks fnx but i want to know with "new" what i shoud use to free for real the memory? And once again:fxm wrote:I wrote a short article about "How to Manage Dynamic Memory (Allocation / Deallocation) in FB".
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
"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
Re: is that right?!
"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:
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
-
- Posts: 182
- Joined: Dec 18, 2018 16:37
- Location: Germany, Hessdorf
- Contact:
Re: is that right?!
ok thank you
work around
https://drive.google.com/file/d/1W2MGUh ... sp=sharing
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
fxm wrote:"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
-
- Posts: 182
- Joined: Dec 18, 2018 16:37
- Location: Germany, Hessdorf
- Contact:
Re: is that right?!
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:
and testing code:
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
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