Memory deallocation strange issue

[sancho3]

I was tracking down a bug in some code and came accross a strange happening.
I have it isolated in this small code example.
In the destructor after img1 gets imagedestroy, I cast the any ptr to an integer ptr and make its contents 0.
Doing this seems to knock out the img2 ptr.
When stepping through the code with Sarg's debugger an error occurs on the next line (something about heap).
Commenting out the *cast line removes the error.

Code: Select all

Type test 
	As Any Ptr img1
	As Any Ptr img2
	Declare Destructor()
End Type

Destructor test()
	ImageDestroy(img1)
	*Cast(Integer Ptr, img1) = 0		' comment to remove error
	img1 = 0
	
	Imagedestroy(img2)			' crashes here when img1 is casted to integer ptr above 
	*Cast(Integer Ptr, img2) = 0
	img2 = 0
	
End Destructor

ScreenRes 800,600
Dim As test t 
t.img1 = ImageCreate(110,110)
t.img2 = ImageCreate(110,110) 

I also tried dodicat's version of createimage and it crashes as well.

Code: Select all

function createimage(w as long,h as long,clr as ulong=rgba(255,0,255,255)) as any ptr
    #define pad(n) (n)+(n) mod 16
    dim as ulong ptr  p=callocate(w*h,sizeof(ulong))
    p[0]=7              'always
    p[1]=4              'pixelsize
    p[2]=w              'width
    p[3]=h              'height
    p[4]=pad(w*p[1])    'pitch -- padded to a multiple of 16
    for a as long=5 to 7
        p[a]=0          'reserved
    next
    for a as long=8 to h*w 
        p[a]=clr        'colour
        next
    return p
end function

#define destroyimage(i)  deallocate i ':i=0

Type test 
	As Any Ptr img1
	As Any Ptr img2
	Declare Destructor()
End Type

Destructor test()
	destroyimage(this.img1)
	*Cast(Integer Ptr, img1) = 0
	img1 = 0
	
	destroyimage(this.img2)
	'*Cast(Integer Ptr, img2) = 0	 
	img2 = 0
End Destructor

Screenres  800,600, 32
Dim As test t 
t.img1 = createImage(110,110)
t.img2 = CreateImage(110,110) 

I know that it is not a good idea to try to write to a deallocated memory location.
The pointer is deallocated and although the variable still points to a memory address, that address is not safe. It could be used by other processes at any time.
But why is this affecting the img2 variable and memory address? At this point that memory address is not deallocated.

[fxm]

Your code does not crash on my PC, but I already expressed my advice (see "What does imagedestroy do?") on such a memory assignment after its deallocation.

By cons, dodicat's code crashes because it also writes outside allocated memory:
dim as ulong ptr p=callocate(w*h,sizeof(ulong))
.....
for a as long=8 to h*w
p[a]=clr 'colour
next

[MrSwiss]

Code: Select all

Type test
    As Any Ptr  img1
    As Any Ptr  img2
    Declare Destructor()
End Type

Destructor test()
    If This.img1 <> 0 Then ImageDestroy(This.img1) : This.img1 = 0
    If This.img2 <> 0 Then ImageDestroy(This.img2) : This.img2 = 0
End Destructor

''
ScreenRes(800, 600, 32)

Dim As test t
t.img1 = ImageCreate(110,110)
t.img2 = ImageCreate(110,110)

Print Str(t.img1), Str(t.img2)


Sleep

[fxm]

So what?
Code only absurd while the previous two were unsafe?

[dodicat]

I keep forgetting
allocate 5 is
0,1,2,3,4 pointer indices.

Here is a custom put, trying to keep all pointers within allocated memory.
the full image pointer is used, but only part of it is looped through.
Please note (trying)

Code: Select all

 
Sub Background(Byref im2 As Any Ptr,xres as long,yres as long)
    Dim As Single minx,maxx,miny,maxy,lasty,grad
    #define dist(x1,y1,x2,y2) Sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2))
    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
    #macro paintsketch(_function,r,g,b)
    For x As Double=minx To maxx Step (maxx-minx)/5000
        Dim As Double x1=(xres)*(x-minx)/(maxx-minx)
        Dim As Double y1=(yres)*(_function-maxy)/(miny-maxy)
        grad=y1-lasty
        lasty=y1
        grad=grad*250
         Line im2,(x1,yres)-(x1,y1),Rgb(r+grad,g+grad,b)
        Line im2,(x1,0)-(x1,yres-y1),Rgb(r+grad,g+grad,200)
    Next x
    #endmacro
    #macro _window(topleftX,topleftY,bottomrightX,bottomrightY)
    minx=topleftX
    maxx=bottomrightX
    miny=bottomrightY
    maxy=topleftY
    #endmacro
    For x As Integer=0 To xres
        For y As Integer=0 To yres
            Var d=dist(x,y,(.8*xres),(.9*yres))
            Var c=map(0,800,d,255,50)
            Pset im2,(x,y),Rgb(0,0,c)
        Next y
    Next x
    _window(-5,3,25,-1.2)
    paintsketch(.05*Sin(x)+.05*Sin(2*x),100,100,50)
    _window(5,2,30,-.8) 
    paintsketch(.1*Sin(x),100,100,0)
    _window(1,2,12,-.6) 
    paintsketch(.1*Sin(x),100,100,0)  
    _window(0,2,8,-.5)
    paintsketch(.2*Sin(x),100,100,0)
     Dim As Single pi=4*Atn(1)
     _window(-4*pi,3,4*pi,-1.2)
    paintsketch(.05*Sin(x)+.05*Sin(2*x),100,100,50)
    _window(-3*pi,2,3*pi,-.8) 
    paintsketch(.1*Sin(x),100,100,0)
    _window(-2*pi,2,2*pi,-.6) 
    paintsketch(.1*Sin(x),100,100,0)
    _window(-pi,2,pi,-.5)
    paintsketch(.2*Sin(x),100,100,0)
End Sub

function createimage(w as long,h as long,clr as ulong=rgba(255,0,255,255)) as any ptr
    #define pad(n) (n)+(n) mod 16
    dim as ulong ptr  p=callocate(w*h,sizeof(ulong))
    p[0]=7              'always
    p[1]=4              'pixelsize
    p[2]=w              'width
    p[3]=h              'height
    p[4]=pad(w*p[1])    'pitch -- padded to a multiple of 16
    for a as long=5 to 7
        p[a]=0          'reserved
    next
    for a as long=8 to h*w -1 'keep within allocation and outside header info
        p[a]=clr        'colour
        next
    return p
end function

#define destroyimage(i)  deallocate i ':i=0

sub Customput(xp as long,yp as long,wdth as long,hght as long,i as any ptr)
     dim as ulong ptr p=cast(ulong ptr,i)
    dim as any ptr row=screenptr
    dim as integer pitch,xx,yy
     screeninfo xx,yy,,,pitch
      dim as long localx=p[2]
      dim as long localy=p[3]
       xx=iif(localx>xx,xx,localx)
       yy=iif(localy>yy,yy,localy)
     dim as long xs=iif(xp<wdth\2,0,xp-wdth\2)
     dim as long xf=iif(xp>(xx-wdth\2-1),xx-1,xp+wdth\2-1)
     dim as long ys=iif(yp<hght\2,0,yp-hght\2)
     dim as long yf=iif(yp>(yy-hght\2-1),yy-1,yp+hght\2-1)
      #define ppset32(_x,_y,colour)    *cptr(ulong ptr,row+ (_y)*pitch+ (_x) shl 2)  =(colour)
    for y as long=ys to yf
        for x as long=xs to xf
            ppset32(x,y,p[x+(y)*localx+8])
    next
next
end sub

Function framecounter() As long
    dim as double t2=timer
    Static As Double t3,frames,answer
    frames=frames+1
    If (t2-t3)>=1 Then
        t3=t2
        answer=frames
        frames=0
    End If
    Return answer
End Function

screen 20,32
dim as integer xres,yres
screeninfo xres,yres
dim as any ptr im=createimage(xres+100,yres+100,rgb(0,10,155))
background(im,xres,yres)

dim as long mx,my,w
do 
    getmouse mx,my,w
   screenlock 
    cls
    CustomPut(mx,my,300+w*5,300+w*5,im)
    draw string (10,10),"FPS " &framecounter
     draw string (10,40),"Mouse wheel to adjust viewport"
    screenunlock
    sleep 1,1
    loop until len(inkey)
sleep
destroyimage(im)
     

[fxm]

Pretty!
The dunes are reflected in the sky like clouds.

[sancho3]

@fxm:
It does crash and I am guessing even on your system. This was a hard one to track because the program seemed to run fine but on exit XP gave up the error message.
Try stepping through it with a debugger and it should crash on the line prev. specified.
It needs no debugging or solution. I know I am "going out of bounds" so to speak.
I was just curious as to why the other pointer fails as well.
What I showed here was just a few lines of code that can replicate the issue.
What do you think about zeroing out contents of the image pointer prior to imagedestroy?
See the code at the end.
@Mr. Swiss:
Not really looking for a solution, just an explanation.
But yours is neither:

Code: Select all

Type test
    As Any Ptr  img1
    As Any Ptr  img2
    Declare Destructor()
End Type

Destructor test()
    If This.img1 <> 0 Then ImageDestroy(This.img1) : ?"destroyed a valid pointer":This.img1 = 0
    If This.img2 <> 0 Then ImageDestroy(This.img2) : ?"crashed And burned":This.img2 = 0
	sleep
End Destructor

''
ScreenRes(800, 600, 32)

Dim As test t
t.img1 = ImageCreate(110,110)
t.img2 = t.img1

Print Str(t.img1), Str(t.img2)

@all:
This code zeros out the contents of the image pointer. If ImageDestroy() simply deallocates memory then this destructor code acts much like a 'de-callocate', doesn't it?
Would it not destroy the imagepointer and any other 'dangling' pointers to the same memory?
But it also is crashing and I don't think there is any invalid/unsafe memory access code this time. I will have to do some more testing.

Code: Select all

Type test
    As Any Ptr  img1
    As Any Ptr  img2
    Declare Destructor()
End Type

Destructor test()
	If this.img1 <>0 Then 
	   Dim As any Ptr temp = this.img1
	   *Cast(Integer Ptr, this.img1) = 0      '
	   ImageDestroy(temp)
	   this.img1 = 0
	   temp = 0
	Endif 
	If this.img2 <>0 Then 
		Dim As any Ptr temp = this.img2
		*Cast(Integer Ptr, this.img2) = 0
		Imagedestroy(temp)        
		this.img2 = 0
		temp = 0
	Endif 
End Destructor

''
ScreenRes(800, 600, 32)

Dim As test t
t.img1 = ImageCreate(110,110)
't.img2 = ImageCreate(110,110)
t.img2 = t.img1

Print Str(t.img1), Str(t.img2)


'Sleep

[fxm]

Freeing same memory twice is unsafe.
It is why zeroing the pointer after each deallocation is a good habit because call any deallocation instruction on a null pointer is inactive.

[sancho3]

Freeing same memory twice is unsafe.

I don't see that happening in any of the code I posted.

By the way, it seems I was mistaken about the last code I posted (where I cast the pointer to integer and zero it out prior to imagedestroy). It seems to be working without crashing on Ubuntu .

[fxm]

Freeing same memory twice is unsafe.

I don't see that happening in any of the code I posted.

For example in the last posted code:
t.img1 and t.img2 are two different pointers, but with the same value so referring to the same image buffer.
After the first destroying using t.img1, doing "t.img1 = 0" don't clear t.img2 (because another variable), and so the second destroying is executed on the same image buffer.

[sancho3]

oops I screwed that up.
Here is the code fixed.
This version runs without crashing but it fails in Sargs debugger with the same 'heap' error message.
For some reason in his debugger imagedestroy(this.img1) fills this.img2 with values (x=238 in the debugger and x=0 run outside the debugger).
I am going to post it in his thread to see if he knows why.

Code: Select all

Type test 
	As Any Ptr img1
	As Any Ptr img2
	Declare Destructor()
End Type

Destructor test()
	Dim As UByte x = Peek(img2)	' x = 7
	If this.img1 <> 0 AndAlso Peek(img1) <> 0 Then 
		Cast(Integer Ptr, img1)[0] = 0
		x = Peek(img2)		' x = 0
		ImageDestroy(img1)
		x = Peek(img2)		' x = 238
		img1 = 0
	EndIf
	If this.img2 <> 0 AndAlso Peek(img2) <> 0 Then 
		Cast(Integer Ptr, img2)[0] = 0	 
		ImageDestroy(img2)
		img2 = 0
	EndIf 
End Destructor

ScreenRes 800,600
Dim As test t 
t.img1 = ImageCreate(110,110)
t.img2 = t.img1 

[fxm]

I always see an unsafe code.
As img1 = img2, after "ImageDestroy(img1)", the buffer memory is deallocated, and "x = Peek(img2)" accesses to a non allocated memory (the read value may depend on context: with or without debugger)

As img1 = img2:
"Destroy(img1)" and "Destroy(img2)" do the same thing
"Peek(img1)" and "Peek(img2)" access the same memory address
.....

[sancho3]

Yes you are correct.
I should get more sleep lol.
I guess the upshot here is that there is no safe way to check if a pointer is deallocated.(?)
Maybe a smart pointer?

[MrSwiss]

I guess the upshot here is that there is no safe way to check if a pointer is deallocated.(?)

There is, but you have to do it yourself. (As already stated!)
Whenever you deallocate a ptr (Imagedestroy() or any other deallocating method),
set it immediately thereafter, to: ptr = 0.
Then a simple zero ptr check suffices, to see, whether a ptr is valid or not.

Btw: I still don't understand the reason, to have 2 Any Ptr in the Type ... because,
one is imho, sufficient for the job?!?