Freebasic 1.20.0 Development

General discussion for topics related to the FreeBASIC project or its community.
Post Reply
TJF
Posts: 3809
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: Freebasic 1.20.0 Development

Post by TJF »

Just to remember:

Code: Select all

$ ./fbc -r a.bas 
$ gcc -S -nostdlib -nostdinc -Wall -Wno-unused -Wno-main -Werror-implicit-function-declaration -O0 -fno-strict-aliasing -frounding-math -fno-math-errno -fwrapv -fno-exceptions -fno-asynchronous-unwind-tables -fno-unwind-tables -Wno-format "a.c" -o "a.asm"
$ ./a 
Hello
$ gcc -march=native -S -nostdlib -nostdinc -Wall -Wno-unused -Wno-main -Werror-implicit-function-declaration -O0 -fno-strict-aliasing -frounding-math -fno-math-errno -fwrapv -fno-exceptions -fno-asynchronous-unwind-tables -fno-unwind-tables -Wno-format "a.c" -o "a.asm"
$ ./a 
Hello
$ 
Regards
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Freebasic 1.20.0 Development

Post by UEZ »

Why does x64 version looks not ok?

Code: Select all

'Ported from https://www.dwitter.net/d/7495 by jylikangas to FB by UEZ build 2023-12-11

#Include "fbgfx.bi"
Using FB

Const _t = 1 / 60

Dim As Long _s = 1, iw = 1000, ih = Int(iw * 9 / 16), iw2 = iw Shr 1, ih2 = ih Shr 1
Screenres _s * iw, _s * ih, 32, 2, GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH 'Or GFX_NO_FRAME 'Or GFX_ALWAYS_ON_TOP 'Or GFX_FULLSCREEN
Screenset 1, 0

Dim Shared As Any Ptr pImage, pImage_scaled, pImage2
pImage = Imagecreate(iw, ih, 0, 32)
pImage2 = Imagecreate(iw, ih, 0, 32)

Dim As Ulong iFPS, cfps = 0
Dim As Double t = 0, tt, fTimer = Timer
Dim As Double px, py, pxo, pyo, x, y, z
Dim As Long i

Do
    tt = t
	Line pImage, (0, 0) - (iw, ih), &hF0FFFFFF, BF
	pImage2 = Imagecreate(iw, ih, &h01FFFFFF, 32)
    
    For i = 15 To 0 Step -1
        t += ((7 - i) Mod 2) / 0.64
        z = Cos(t) + 1 + IIf(t < 6, 1, 0)
        x = iw2 + Sin(t) * iw2 / z
        y = ih2 + (((i Mod 4) \ 2 Shl 9) - 280) / z
        If i < 15 Then Line pImage2, (pxo, pyo) - (x, y), &h88000000
        pxo = x
        pyo = y
        Put pImage2, (0 , i), pImage2, Alpha
    Next
    t = tt
    t += _t
    
    Put pImage, (0 , 0), pImage2, Alpha
	Put (0, 0), pImage, PSet
    Imagedestroy(pImage2)
    
	Draw String(4, 4), iFPS & " fps", &hFF000000
	
	Flip

	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep (1)
Loop Until Len(Inkey())

Imagedestroy(pImage)
x86:
Image

x64:
Image

Btw, it crashes after running some seconds.

Tested on Windows 11 x64 only.
srvaldez
Posts: 3379
Joined: Sep 25, 2005 21:54

Re: Freebasic 1.20.0 Development

Post by srvaldez »

Hi UEZ :)
I tested with FB versions all the way down 1.01 and the program behaved the same
but notice that before the crash the box decomposes, so I am thinking that the image is being drawn out of bounds
Last edited by srvaldez on Dec 12, 2023 18:15, edited 1 time in total.
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Freebasic 1.20.0 Development

Post by UEZ »

srvaldez wrote: Dec 12, 2023 3:17 I tested with FB versions all the way down 1.01 and the program behaved the same
but notice that before the crash the box decomposes, so I am thinking that the image is being drawn out of bounds
Thanks for testing but the internal line function should cover drawing outside the screen. On other examples there is no crash when line is outside the visible screen.
SARG
Posts: 1768
Joined: May 27, 2005 7:15
Location: FRANCE

Re: Freebasic 1.20.0 Development

Post by SARG »

The crash seems to be related to this line as commented no crash :

Code: Select all

If i < 15 Then Line pImage2, (pxo, pyo) - (x, y), &h88000000

Just before the crash the values are :
px=991.82
py=5.53
x=40856.38
y=-911896.01

Are you sure about the used code ?
Could you post the original one.
fxm
Moderator
Posts: 12132
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Freebasic 1.20.0 Development

Post by fxm »

UEZ wrote: Dec 12, 2023 9:19 Thanks for testing but the internal line function should cover drawing outside the screen. On other examples there is no crash when line is outside the visible screen.
Yes for the screen, but on the other hand you must not draw outside of an image buffer created by ImageCreate() (otherwise possible crash by accessing outside allocated memory by ImageCreate()).

As a result, you should not even overflow a single pixel, so that your code must also be modified as for example below:

Code: Select all

pImage = Imagecreate(iw, ih, 0, 32)
.....
''Line pImage, (0, 0) - (iw, ih), &hF0FFFFFF, BF
Line pImage, (0, 0) - (iw-1, ih-1), &hF0FFFFFF, BF
Similar constraint for pImage2.

As soon as we access outside all allocated memory, we cannot predict the consequences:
- none by chance,
- disturbed operation,
- crash.
(for a same code, the consequences may be different depending on the execution environment)
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Freebasic 1.20.0 Development

Post by UEZ »

That makes sense but somehow the internal line function has some problems with this kind of values.
SARG wrote: Dec 12, 2023 9:31 The crash seems to be related to this line as commented no crash :

Code: Select all

If i < 15 Then Line pImage2, (pxo, pyo) - (x, y), &h88000000

Just before the crash the values are :
px=991.82
py=5.53
x=40856.38
y=-911896.01

Are you sure about the used code ?
Could you post the original one.
Here the original JS code:

Code: Select all

c.width = 198
with (x)
for (i = 16; i--;)
	t += (7 - i) % 2 / 0.64,
	Z = (t < 6) + 1 + C(t),
	X = 99 + S(t)*99 / Z,
    	Y = 49 + ((i % 4 / 2 << 6) - 25) / Z,
	lineTo(X, Y),
	stroke(),
	globalAlpha = .1,
	drawImage(c, 0, i);
Just c/p the code to http://capjs.3d2k.com to see it live.

What about the different look on x86 <-> x64?
srvaldez
Posts: 3379
Joined: Sep 25, 2005 21:54

Re: Freebasic 1.20.0 Development

Post by srvaldez »

in 32-bit I get a segmentation error (code 12), in both gen gas and gen gcc
the bottom of the box look cleaner in 32-bit but it decomposes just as with 64-bit and then the crash
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Freebasic 1.20.0 Development

Post by UEZ »

When I'm using the DrawLineAAWu function instead then it works without crashing.

Code: Select all

'Ported from https://www.dwitter.net/d/7495 by jylikangas to FB by UEZ build 2023-12-12

#Include "crt/math.bi"
#Include "fbgfx.bi"
Using FB

#Define _Alpha(iCol)					((iCol And &hFF000000) Shr 24)		
#Define _Red(iCol)						((iCol And &h00FF0000) Shr 16)		
#Define _Green(iCol)					((iCol And &h0000FF00) Shr 8)		
#Define _Blue(iCol)						((iCol And &h000000FF))
'#Define Floor(x) 						(((x) * 2.0 - 0.5) Shr 1)

Function ColBlend(col1 As Ulong, col2 As Ulong, blend As Single) As Ulong
	Dim As Single bl = 1 - blend
	Return Rgba(_Red(col1) * blend + _Red(col2) * bl, _Green(col1) * blend + _Green(col2) * bl, _Blue(col1) * blend + _Blue(col2) * bl, _Alpha(col1) * blend + _Alpha(col2) * bl)
End Function

#Define fpart(x)						(Frac(x))
#Define rfpart(x)						(1 - Frac(x))
'https://en.wikipedia.org/wiki/Xiaolin_Wu%27s_line_algorithm
Sub DrawLineAAWu(x0 As Long, y0 As Long, x1 As Long, y1 As Long, _col As Ulong, pImage As Any Ptr = 0)
	Dim As Boolean steep = Abs(y1 - y0) > Abs(x1 - x0)
	If steep Then
		Swap x0, y0
		Swap x1, y1
	End If
	If x0 > x1 Then
        Swap x0, x1
        Swap y0, y1
	End If
	Dim As Long dx_, dy, xend, yend, xgap, xpxl1, ypxl1, xpxl2, ypxl2
	Dim As Single  gradient, intery, f
	Dim As Ulong _rgb = _col And &h00FFFFFF
	Dim As Ubyte a = _Alpha(_col)
	
    dx_ = x1 - x0
    dy = y1 - y0	
	gradient = dy / dx_
	If dx_ = 0 Then gradient = 1
	
	'handle first endpoint
	xend = Round(x0)
	yend = y0 + gradient * (xend - x0)
    xgap = rfpart(x0)
	xpxl1 = xend
	ypxl1 = Floor(yend)
	If steep Then
		f = rfpart(yend) * xgap
		Pset pImage, (ypxl1, xpxl1), (a * f) Shl 24 Or _rgb
		f = fpart(yend) * xgap
		Pset pImage, (ypxl1 + 1, xpxl1), (a * f) Shl 24 Or _rgb
	Else
		f = rfpart(yend) * xgap
		Pset pImage, (xpxl1, ypxl1), (a * f) Shl 24 Or _rgb
		f = fpart(yend) * xgap
		Pset pImage, (xpxl1, ypxl1 + 1), (a * f) Shl 24 Or _rgb	
	End If
	intery = yend + gradient
	
	'handle second endpoint
	xend = Round(x1)
	yend = y1 + gradient * (xend - x1)
    xgap = rfpart(x1)
	xpxl2 = xend
	ypxl2 = Floor(yend)
	If steep Then
		f = rfpart(yend) * xgap
		Pset pImage, (ypxl2, xpxl2), (a * f) Shl 24 Or _rgb
		f = fpart(yend) * xgap
		Pset pImage, (ypxl2 + 1, xpxl2), (a * f) Shl 24 Or _rgb
	Else
		f = rfpart(yend) * xgap
		Pset pImage,(xpxl2, ypxl2), (a * f) Shl 24 Or _rgb
		f = fpart(yend) * xgap
		Pset pImage, (xpxl2, ypxl2 + 1), (a * f) Shl 24 Or _rgb	
	End If
	
	'main line
	If steep Then
		For x As Short = xpxl1 + 1 to xpxl2 - 1
			f = rfpart(intery)
			Pset pImage, (Floor(intery), x), (a * f) Shl 24 Or _rgb
			f = fpart(intery)
			Pset pImage, (Floor(intery) + 1, x), (a * f) Shl 24 Or _rgb
			intery += gradient
		Next
	Else
		For x As Short = xpxl1 + 1 to xpxl2 - 1
			f = rfpart(intery)
			Pset pImage, (x, Floor(intery)), (a * f) Shl 24 Or _rgb
			f = fpart(intery)
			Pset pImage, (x, Floor(intery) + 1), (a * f) Shl 24 Or _rgb
			intery += gradient
		Next	
	End If
End Sub

Function ImageScale(s As Image Ptr, w As Integer, h As Integer) As Image Ptr 'by D.J. Peters aka Joshy (https://www.freebasic.net/forum/viewtopic.php?t=10533#p91780)
	If s         = 0 Then Return 0
	If s->Width  < 1 Then Return 0
	If s->height < 1 Then Return 0
	If w < 4 Then w = 4
	If h < 4 Then h = 4
	Dim As Image Ptr t = Imagecreate(w, h)
	Dim As Long xs = (s->Width  / t->Width ) * &h10000 '(1024*64)
	Dim As Long ys = (s->height / t->height) * &h10000 '(1024*64)
	Dim As Long x, y, sy
	Dim As Ulong Ptr ps= Cptr(Ulong Ptr,s) + 8
	Dim As Ulong     sp= (s->pitch Shr 2)
	Dim As Ulong Ptr pt= Cptr(Ulong Ptr,t) + 8
	Dim As Ulong     tp= (t->pitch Shr 2) - t->Width
	For ty As Long = 0 To t->height - 1
		Dim As Ulong Ptr src = ps + (sy Shr 16) * sp
		For tx As Long = 0 To t->Width - 1
			*pt = src[x Shr 16] : pt += 1 : x += xs
		Next
		pt += tp : sy += ys : x = 0
	Next
	Return t
End Function


Const _t = 1 / 60

Dim As Long _s = 4, iw = 198 * 2, ih = Int(iw * 9 / 16), iw2 = iw Shr 1, ih2 = ih Shr 1
Screenres _s * iw, _s * ih, 32, 2, GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH 'Or GFX_NO_FRAME 'Or GFX_ALWAYS_ON_TOP 'Or GFX_FULLSCREEN
Screenset 1, 0

Dim Shared As Any Ptr pImage, pImage_scaled, pImage2
pImage = Imagecreate(iw, ih, 0, 32)
pImage2 = Imagecreate(iw, ih, 0, 32)

Dim As Ulong iFPS, cfps = 0
Dim As Double t = 0, tt, fTimer = Timer
Dim As Single px, py, pxo, pyo, x, y, z
Dim As Long i

Do
    tt = t
	Line pImage, (0, 0) - (iw, ih), &h18FFFFFF, BF
	pImage2 = Imagecreate(iw, ih, &h01FFFFFF, 32)
    
    For i = 15 To 0 Step -1
        t += ((7 - i) Mod 2) / 0.64
        z = Cos(t) + 1 + IIf(t < 6, 1, 0)
        x = iw2 + Sin(t) * iw2 / z
        y = ih2 + (((i Mod 4) \ 2 Shl 7) - 50) / z
        'If i < 15 Then Line pImage2, (pxo, pyo) - (Cshort(x), Cshort(y)), &h88000000
        'pxo = Cshort(x)
        'pyo = Cshort(y)
        If i < 15 Then DrawLineAAWu(pxo, pyo, x, y, &h60000000, pImage2)
        pxo = x
        pyo = y
        Put pImage2, (0 , i), pImage2, Alpha
    Next
    t = tt
    t += _t
    
    Put pImage, (0 , 0), pImage2, Alpha
	pImage_scaled = ImageScale(pImage, _s * iw, _s * ih)
	Put (0, 0), pImage_scaled, PSet
	Imagedestroy(pImage_scaled)    
    Imagedestroy(pImage2)
    
	Draw String(4, 4), iFPS & " fps", &hFF000000
	
	Flip

	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep (1)
Loop Until Len(Inkey())

Imagedestroy(pImage)
SARG
Posts: 1768
Joined: May 27, 2005 7:15
Location: FRANCE

Re: Freebasic 1.20.0 Development

Post by SARG »

Sorry found nothing that can explain the difference and same for the crash. :-(

Code: Select all

screen 18

dim as any ptr pImage = Imagecreate(1080, 960, 0, 32)
dim as double x=-89500000,y=500,x2=-5000100,y2=96 ''tested with different values

line pimage,(x,y)-(x2,y2)

print "end"
sleep
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Freebasic 1.20.0 Development

Post by UEZ »

SARG wrote: Dec 12, 2023 20:15 Sorry found nothing that can explain the difference and same for the crash. :-(

Code: Select all

screen 18

dim as any ptr pImage = Imagecreate(1080, 960, 0, 32)
dim as double x=-89500000,y=500,x2=-5000100,y2=96 ''tested with different values

line pimage,(x,y)-(x2,y2)

print "end"
sleep
Thanks for your feedback. Regarding the internal line function I assume that a pixel is set outside the image boundaries without the needed check which causes the crash (Exception code: 0xc0000005). No clue for the different output (x86 <-> x64). :?:
fxm
Moderator
Posts: 12132
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Freebasic 1.20.0 Development

Post by fxm »

UEZ wrote: Dec 12, 2023 20:29 No clue for the different output (x86 <-> x64). :?:

I am bothered by this line without bug-free workaround and simple:
Put pImage2, (0 , i), pImage2, Alpha
because this immediately induces an overflow outside the allocated memory.

With this modified code, same appearance at the start before the crash, for both 32 and 64 bit versions:

Code: Select all

'Ported from https://www.dwitter.net/d/7495 by jylikangas to FB by UEZ build 2023-12-11

#Include "fbgfx.bi"
Using FB

Const _t = 1 / 60

Dim As Long _s = 1, iw = 1000, ih = Int(iw * 9 / 16), iw2 = iw Shr 1, ih2 = ih Shr 1
Screenres _s * iw, _s * ih, 32, 2, GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH 'Or GFX_NO_FRAME 'Or GFX_ALWAYS_ON_TOP 'Or GFX_FULLSCREEN
Screenset 1, 0

Dim Shared As Any Ptr pImage, pImage_scaled, pImage2, pImage3
pImage = Imagecreate(iw, ih, 0, 32)
pImage2 = Imagecreate(iw, ih, 0, 32)

Dim As Ulong iFPS, cfps = 0
Dim As Double t = 0, tt, fTimer = Timer
Dim As Double px, py, pxo, pyo, x, y, z
Dim As Long i

Do
    tt = t
	Line pImage, (0, 0) - (iw, ih), &hF0FFFFFF, BF
	pImage2 = Imagecreate(iw, ih, &h01FFFFFF, 32)
	pImage3 = Imagecreate(iw, ih+15, &h01FFFFFF, 32)
    
    For i = 15 To 0 Step -1
        t += ((7 - i) Mod 2) / 0.64
        z = Cos(t) + 1 + IIf(t < 6, 1, 0)
        x = iw2 + Sin(t) * iw2 / z
        y = ih2 + (((i Mod 4) \ 2 Shl 9) - 280) / z
        If i < 15 Then Line pImage2, (pxo, pyo) - (x, y), &h88000000
        pxo = x
        pyo = y
        Put pImage3, (0 , 0), pImage2, Alpha
        Put pImage3, (0 , i), pImage2, Alpha
    Next
    t = tt
    t += _t
    
    Put pImage, (0 , 0), pImage3, Alpha
	Put (0, 0), pImage, PSet
    Imagedestroy(pImage2)
    Imagedestroy(pImage3)
    
	Draw String(4, 4), iFPS & " fps", &hFF000000
	
	Flip

	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep (1)
Loop Until Len(Inkey())

Imagedestroy(pImage)
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Freebasic 1.20.0 Development

Post by UEZ »

Thanks fxm, but I wasn't looking for a workaround, I wanted to report the 2 problems.
coderJeff
Site Admin
Posts: 4326
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: Freebasic 1.20.0 Development

Post by coderJeff »

UEZ wrote: Dec 12, 2023 12:21 When I'm using the DrawLineAAWu function instead then it works without crashing.
Many other things replaced too: floats instead of integers, no line clipping (pset does pixel clipping instead, different expressions (smaller values), singles instead of doubles, a smaller image scaled up, etc. (and the alpha blending function seems incorrect).

One of these is a problem statement regardless:

Code: Select all

        z = Cos(t) + 1 + IIf(t < 6, 1, 0)
        x = iw2 + Sin(t) * iw2 / z
        y = ih2 + (((i Mod 4) \ 2 Shl 9) - 280) / z
If 'z' is very small then |x| and |y| can become very large, or a divide by zero. Depending on 'const _t = 1/60' can affect if there is a crash or not.
UEZ wrote: Dec 12, 2023 20:29 Regarding the internal line function I assume that a pixel is set outside the image boundaries without the needed check which causes the crash (Exception code: 0xc0000005).
half correct. The line clipping algorithm that clips the line to the current target (screen or image) uses all integer math. However, part of the line clipping math is something like (x2-x1)*(y2-y1) and if difference of values are too large, then and overflow introduces bad values in line drawing algorithm, causing pixels to be specified outside the target area. The intent of line clipping is so that only the pixels that are in the target area are calculating instead of checking every pixel.
No clue for the different output (x86 <-> x64). :?:
Appears to be a bug; 32-bit x86 by default will use the assembly encoded procedures using MMX registers and there is a difference between MMX and C implementation.

This is the C implementation:
Image
coderJeff
Site Admin
Posts: 4326
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: Freebasic 1.20.0 Development

Post by coderJeff »

I didn't find any bug with PUT memory access, only with LINE clipping math overflow in the clipping algorithm.
fxm wrote: Dec 12, 2023 22:13 I am bothered by this line without bug-free workaround and simple:
Put pImage2, (0 , i), pImage2, Alpha
because this immediately induces an overflow outside the allocated memory.
PUT self, (x,y), self, mode is only "safe" in that it should not access any memory outside of the 'image'

However, "PUT self,(...),self" may vary in the exact results, because:
- copy order appears to be left-to-right, top-to-bottom, but I make no promises that it should always be so
- the copying of memory is from and to overlapping regions, so results may not be as desired depending on position of source and destination (like memcpy())
- the internal blender used (pixel copying procedure), may process up to 4 pixels at once depending on the screen mode so there may be 1, 2, or 4 pixel reads followed by 1, 2, 4 pixel writes, which will give different results depending on source and target coordinates
Post Reply