Engine error?

[Brian Alvarez]

The following code does not compile. It complains about this:

Code: [Select]

ERROR: unexpected end of prog
WORD: join
LINE: 244
FILE: main source
PASS: 2
It compiles fine by commenting out the following line:

Code: [Select]

MSGBOX "?"
But it crashes at execution.

Help?

Code: [Select]

'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()

[Brian Alvarez]

I was able to reduce the code down to this, and it still crashes:

Code: [Select]

$ 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:

Code: [Select]

TAGCTLDATA ptctldata PTR
Doesn't crash anymore.

Replacing it with the following, fixes the inmediate crash:

Code: [Select]

DIM ptctldata AS TAGCTLDATA PTR
But then when using ptctldata, the app crashes again.

[JRS]

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.

[Charles Pegge]

Brian,

Does this work?

Code: [Select]

$ 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


[Brian Alvarez]

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.

[Brian Alvarez]

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):

Code: [Select]

'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):

Code: [Select]

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:

Code: [Select]

TAGCTLDATA ptctldata = _ByValue_ptctldata

[Brian Alvarez]

If i declare the BYVAL UDT parameter like this:

Code: [Select]

BYVAL TAGCTLDATA *_ByValue_ptctldata
Works fine on 32 bit and 64 bit.

 I dont know why though. 

[Charles Pegge]

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.

[Brian Alvarez]

Got it! I didnt know it could not be mixed.