Oxygen Basic
Programming => Bugs & Feature Requests => Topic started by: Brian Alvarez on November 29, 2018, 01:44:01 PM
-
The following code does not compile. It complains about this:
ERROR: unexpected end of prog
WORD: join
LINE: 244
FILE: main source
PASS: 2
It compiles fine by commenting out the following line:
MSGBOX "?"
But it crashes at execution.
Help? :)
'Generated with PluriBASIC 6.0.74371.0
$ filename "errors.exe"
uses rtl32
Declare Function PluriBASICMessageBox Lib "user32.dll" Alias "MessageBoxA"
' STARTS STRPTR.BIN
' no need.
' END OF STRPTR.BIN
' STARTS SIZEOF.BIN
'not needed
' END OF SIZEOF.BIN
' STARTS PLURIBASIC_INIT.BIN
' Enter the stock code and functions here.
' END OF PLURIBASIC_INIT.BIN
' STARTS MSGBOX.BIN
FUNCTION MSGBOX(string sText, sys mOptions = 0, string sCaption = "PluriBASIC") AS LONG
FUNCTION = PluriBASICMessageBox(0, sText, sCaption, mOptions)
END FUNCTION
' END OF MSGBOX.BIN
' STARTS CALLBACKDATA.BIN
' END OF CALLBACKDATA.BIN
' Initializes various things in the script.
FUNCTION PluriBASIC_Initialize() AS LONG
END FUNCTION
% GMEM_FIXED = &H0
% GMEM_ZEROINIT = &H40
% GMEM_NOT_BANKED = &H1000
TYPE POINTAPI
x AS INT
y AS INT
END TYPE
TYPE TAGCTLDATA
ncolor AS INT
scolor AS INT
hcolor AS INT
dcolor AS INT
nborder AS INT
lfescapement AS INT
pnormal AS INT
pselected AS INT
phover AS INT
pdisabled AS INT
hrgn AS INT
bhover AS INT
bcapture AS INT
bmousedown AS INT
bneedbitmaps AS INT
centerpoint AS POINTAPI
hbutton AS INT
idbutton AS INT
END TYPE
DECLARE FUNCTION GLOBALALLOC LIB "KERNEL32.DLL" ALIAS "GlobalAlloc" (BYVAL P1 AS INT, BYVAL P2 AS INT) AS LONG
Declare Function PluriBASICMessageBox Lib "user32.dll" Alias "MessageBoxA"
def __dim1 (d1-bnd[1])
def __dim2 (d2-bnd[3])
def __dim3 (d3-bnd[5])
def __class_nam_def class _arr_%1
macro __declare_array_type(dtype)
__class_nam_def(dtype)
public dtype t
int dims
int elems
int slength
int ispointer
sys hBuffer
sys hCustAddr
int BuffLen
string dtType
int Head
int bnd[10]
function redim(int pr, int * d, n)
int i
int ne = 0
for i = 1 to n step 2
bnd[i+0] = d[i+0]
bnd[i+1] = d[i+1]
ne += (d[i+1]-d[i+0])
next
if ne < elems then
if dtType = "STR" then
if hBuffer then
dtype dt at (hBuffer + 32)
for i = ne+1 to elems
frees dt(i)
next
end if
end if
end if
elems = ne
int nBufLen = (elems * sizeof(sys)) + head + 32
sys nBuffer = getmemory(nBufLen)
int eBfCopy = BuffLen
if BuffLen
if BuffLen>nBufLen then
eBfCopy = nBufLen
end if
copy nBuffer, hBuffer, eBfCopy
freememory hBuffer
endif
hBuffer = nBuffer
BuffLen = nBufLen
end function
method constructor(int * d, n, isptr, slen, string dtyp, sys hAddr)
head = 32
ispointer = isptr
dtType = dtyp
slength = slen
hCustAddr = hAddr
dims = n / 2
this.redim(0, d, n)
end method
function destructor()
int i
if (dtType = "STR") then
dtype dt at (hBuffer + 32)
for i = 0 to elems
frees dt(i)
next
end if
freememory(hBuffer)
hBuffer = 0
BuffLen = 0
end function
function b() as string
return ""
end function
function c(int d1, dtype v)
dtype dt at (hBuffer + 32)
dt(__dim1) = v
end function
function c(int d1) as dtype
dtype dt at (hBuffer + 32)
return dt(__dim1)
end function
function c(int d1, d2, dtype v)
dtype dt at (hBuffer + 32)
dt(__dim1 * __dim2) = v
end function
function c(int d1, d2) as dtype
dtype dt at (hBuffer + head)
return dt(__dim1 * __dim2)
end function
function c(int d1, d2, d3, dtype v)
dtype dt at (hBuffer + head)
dt(__dim1 * __dim2 + __dim3) = v
end function
function c(int d1, d2, d3) as dtype
dtype dt at (hBuffer + head)
return dt(__dim1 * __dim2 + __dim3)
end function
function p(int d1) as dtype*
dtype dt at (hBuffer + head)
return @dt(__dim1)
end function
function p(int d1, d2) as dtype*
dtype dt at (hBuffer + head)
return @dt(__dim1 * __dim2)
end function
function p(int d1, d2, d3) as dtype*
dtype dt at (hBuffer + head)
return @dt(__dim1 * __dim2 + __dim3)
end function
function strptr(int d1) as sys
dtype dt at (hBuffer + head)
int i = __dim1
return strptr(dt(i))
end function
function strptr(int d1, d2) as sys
redim dtype dt at (hBuffer + head)
int i = __dim1 * __dim2
return strptr(dt(i))
end function
function strptr(int d1, d2, d3) as sys
dtype dt at (hBuffer + head)
int i = __dim1 * __dim2 + __dim3
return strptr(dt(i))
end function
function lbound(int d) as int
return bnd[d]
end function
function ubound(int d) as int
return bnd[d+1]
end function
end class
end macro
__declare_array_type(bstring)
FUNCTION MSGBOX(string sText, sys mOptions = 0, string sCaption = "PluriBASIC") AS LONG
FUNCTION = PluriBASICMessageBox(0, sText, sCaption, mOptions)
END FUNCTION
FUNCTION JOIN(_arr_bstring *aa, int usebin, string ss) AS STRING
int i
int lb = aa.lbound(1)
int ub = aa.ubound(1)
string r
if usebin then
r = aa.b()
elseif len(ss) = 3 then
for i = lb to ub
r += mid(ss, 3, 1) & aa.c(i) & left(ss, 1)
if i < ub then
r += mid(ss, 2, 1)
end if
next
else
for i = lb to ub
r += aa.c(i)
if i < ub then
r += ss
end if
next
end if
return r
END FUNCTION
FUNCTION PluriBASIC_Initialize() AS LONG
END FUNCTION
FUNCTION MODUL(_arr_bstring *myarr, BYVAL TAGCTLDATA ptctldata PTR) AS INT
INT _FUNCTION = 0
ptctldata.ncolor = 552100
RETURN _FUNCTION
END FUNCTION
FUNCTION PBMAIN() AS INT
INT _FUNCTION = 0
CALL PluriBASIC_Initialize()
TAGCTLDATA ptctldata PTR
MSGBOX "?"
new _arr_bstring m(int{1, 100}, countof, 0, 0, "STR", 0)
ptctldata = GLOBALALLOC(GMEM_FIXED OR GMEM_ZEROINIT, SIZEOF(TAGCTLDATA))
ptctldata.ncolor = 12345
ptctldata.centerpoint.x = 1
MSGBOX(JOIN(m, 0, chr(34) & "," & chr(34)), 0, "")
MODUL(m, ptctldata)
END FUNCTION
PBMAIN()
-
I was able to reduce the code down to this, and it still crashes:
$ filename "errors_and_more_errors.exe"
uses rtl32
TYPE TAGCTLDATA
ncolor AS INT
END TYPE
def __class_nam_def class _arr_%1
macro __declare_array_type(dtype)
__class_nam_def(dtype)
method constructor(int * d, n, isptr, slen, string dtyp, sys hAddr)
end method
end class
end macro
__declare_array_type(bstring)
FUNCTION PBMAIN() AS INT
TAGCTLDATA ptctldata PTR
new _arr_bstring m(int{1, 100}, countof, 0, 0, "STR", 0)
END FUNCTION
PBMAIN() ' invoke entry point
Finally removing the line:
TAGCTLDATA ptctldata PTR
Doesn't crash anymore.
Replacing it with the following, fixes the inmediate crash:
DIM ptctldata AS TAGCTLDATA PTR
But then when using ptctldata, the app crashes again.
-
Brian,
Your project is exactly what O2 needs to mature. You are an amazing programmer and I can't wait to get my hands on your BASIC to O2 translator.
-
Brian,
Does this work?
$ filename "c.exe"
'uses rtl64
TYPE TAGCTLDATA
ncolor AS INT
END TYPE
def __class_nam_def class _arr_%1
macro __declare_array_type(dtype)
__class_nam_def(dtype)
method constructor(int * d, n, isptr, slen, string dtyp, sys hAddr)
indexbase 1
int i
for i=1 to n
print d[i]
next
print dtyp
end method
end class
end macro
__declare_array_type(bstring)
FUNCTION PBMAIN() AS INT
'TAGCTLDATA PTR ptctldata
DIM ptctldata AS TAGCTLDATA PTR
new _arr_bstring m(int{1, 100}, countof, 0, 0, "STR", 0)
END FUNCTION
PBMAIN() ' invoke entry point
-
Yes, but then the pointers dont work the same. I think they are backwards depending on the declaration style,
but im not sure. I will do more tests.
-
I finally found a combination that works fine... more or less. It compiles and runs fine on 64 bit mode,
but it compiles and crashes on 32bit (does everything except the final YAY):
'Generated with PluriBASIC 6.0.74371.0
$ filename "pointers.exe"
' Works fine for 64 bit... but 32 bit mode crashes.
uses rtl32
% GMEM_FIXED = &H0
% GMEM_ZEROINIT = &H40
% GMEM_NOT_BANKED = &H1000
TYPE POINTAPI
x AS INT
y AS INT
END TYPE
TYPE TAGCTLDATA
ncolor AS INT
scolor AS INT
hcolor AS INT
dcolor AS INT
nborder AS INT
lfescapement AS INT
pnormal AS INT
pselected AS INT
phover AS INT
pdisabled AS INT
hrgn AS INT
bhover AS INT
bcapture AS INT
bmousedown AS INT
bneedbitmaps AS INT
centerpoint AS POINTAPI
hbutton AS INT
idbutton AS INT
END TYPE
DECLARE FUNCTION GLOBALALLOC LIB "KERNEL32.DLL" ALIAS "GlobalAlloc" (BYVAL P1 AS INT, BYVAL P2 AS INT) AS LONG
Declare Function PluriBASICMessageBox Lib "user32.dll" Alias "MessageBoxA"
' STARTS STR$.BIN
' Enter the stock code and functions here.
FUNCTION _STR(double v, long d = 8) as string
long d2 = d-1
if v < 0 then
return str(v, d2)
else
return " " & str(v, d2)
end if
END FUNCTION
' END OF STR$.BIN
' STARTS SIZEOF.BIN
'not needed
' END OF SIZEOF.BIN
' STARTS PLURIBASIC_INIT.BIN
' Enter the stock code and functions here.
' END OF PLURIBASIC_INIT.BIN
' STARTS MSGBOX.BIN
FUNCTION MSGBOX(string sText, sys mOptions = 0, string sCaption = "PluriBASIC") AS LONG
FUNCTION = PluriBASICMessageBox(0, sText, sCaption, mOptions)
END FUNCTION
' END OF MSGBOX.BIN
' STARTS CALLBACKDATA.BIN
' END OF CALLBACKDATA.BIN
' Initializes various things in the script.
FUNCTION PluriBASIC_Initialize() AS LONG
END FUNCTION
FUNCTION MODUL(BYVAL TAGCTLDATA _ByValue_ptctldata, BYVAL INT _ByValue_ss) AS INT
INT _FUNCTION = 0
TAGCTLDATA ptctldata = _ByValue_ptctldata
INT ss = _ByValue_ss
MSGBOX "Consult: " & _STR(ptctldata.ncolor)
RETURN _FUNCTION
END FUNCTION
FUNCTION PBMAIN() AS INT
INT _FUNCTION = 0
CALL PluriBASIC_Initialize()
DIM ptctldata AS TAGCTLDATA PTR
@ptctldata = GLOBALALLOC(GMEM_FIXED OR GMEM_ZEROINIT, SIZEOF(TAGCTLDATA))
ptctldata.ncolor = 12345
ptctldata.centerpoint.x = 1
MODUL(ptctldata, ptctldata.ncolor)
MSGBOX "YAY: " & _STR(ptctldata.ncolor) & _STR(ptctldata.centerpoint.x) ' DOES NOT DISPLAY THIS ON 32 BIT MODE
END FUNCTION
PBMAIN() ' invoke entry point
Added:
When i pass ptctldata BYREF, PluriBASIC generates the following MODUL function, which doesnt crash at the end on 32 bit mode or 64 bit mode (Works fine on both):
FUNCTION MODUL(BYREF TAGCTLDATA ptctldata, BYVAL INT _ByValue_ss) AS INT
INT _FUNCTION = 0
INT ss = _ByValue_ss
MSGBOX "Consult: " & _STR(ptctldata.ncolor)
RETURN _FUNCTION
END FUNCTION
So, i am guessing the problem resides on either the parameter declaration or this line:
TAGCTLDATA ptctldata = _ByValue_ptctldata
-
If i declare the BYVAL UDT parameter like this:
BYVAL TAGCTLDATA *_ByValue_ptctldata
Works fine on 32 bit and 64 bit. :)
I dont know why though. :-[
-
TAGCTLDATA *_ByValue_ptctldata
or
TAGCTLDATA PTR _ByValue_ptctldata
You don't need BYVAL when using C-style terms.
Avoid mixing C-style terms and BASIC-style terms (varname AS vartype) in the same function header.
-
Got it! I didnt know it could not be mixed. :)