BUG with imported VARIANT called byval

Windows specific questions.
aloberoger
Posts: 495
Joined: Jan 13, 2009 19:23

BUG with imported VARIANT called byval

Postby aloberoger » Feb 27, 2012 17:17

You can use a function calling a variant byval internally in FB, but when you try to export such a function via dll or dll com, other langauges get errors.
the same thing occurs in FB when you try to call such functions imported from other languages via dll or com dll.
dkl can you study this matter?
dkl
Site Admin
Posts: 3221
Joined: Jul 28, 2005 14:45
Location: Germany

Re: BUG with imported VARIANT called byval

Postby dkl » Mar 04, 2012 17:16

Does it work if you declare the FreeBASIC VARIANT without constructor/destructor/other methods? For example just:

Code: Select all

type VARIANT
   reserved(0 to 16-1) as byte
end type


(or use variant.bi's VARIANT_ instead of VARIANT, see also FreeBASIC/examples/Windows/variants/variant.bi)

It appears that FreeBASIC will pass non-trivial UDTs (with constructors/destructors/etc.) by reference, always, even if Byval was specified. I tested the same thing with the MinGW C++ compiler and it does the same. I don't know how Visual Basic (or others) handle Byval Variant, but I suspect they really push the whole 16 bytes onto the stack, not just a reference. FreeBASIC can do the same, but only if there are no constructors/destructors/etc for the UDT.
aloberoger
Posts: 495
Joined: Jan 13, 2009 19:23

Re: BUG with imported VARIANT called byval

Postby aloberoger » Mar 04, 2012 21:56

The things go well with VARIANT _ instead of VARIANT when one exports or imports a routine with VARIANT in parameters called by value from others languages.
It is thus necessary to modify the code obtained with axsuite2.exe. thanks to you dkl.
The programmers of FB would owe the knowledge, same if one uses my olevariant.bi : create VARIANT and use it in parameters which awaits VARIANT _
aloberoger
Posts: 495
Joined: Jan 13, 2009 19:23

Re: BUG with imported VARIANT called byval

Postby aloberoger » Mar 06, 2012 19:25

I think that VARIANT called by value need to specify byval
function(Byval v as VARIANT) as double export
or
type Interface
..........
det22 as function (pthis as interface ptr,byval V as VARAINT) ' v as VARIANT will cause a bug
dkl
Site Admin
Posts: 3221
Joined: Jul 28, 2005 14:45
Location: Germany

Re: BUG with imported VARIANT called byval

Postby dkl » Mar 06, 2012 20:39

Yea, normally in -lang fb the UDTs are passed byref by default, so you need to specifiy Byval explicitly, but if it's a class with constructor/destructor then it will apparently still be passed byref, despite the Byval. So an UDT without constructor/destructor must be used - like the plain VARIANT_ structure instead of the VARIANT class.
aloberoger
Posts: 495
Joined: Jan 13, 2009 19:23

Re: BUG with imported VARIANT called byval

Postby aloberoger » Mar 06, 2012 21:07

dkl I don't see the class your talking about here is the definition of variant in "win/oaidl.bi"
union VARIANT_
type
vt as VARTYPE
wReserved1 as WORD
wReserved2 as WORD
wReserved3 as WORD
union
lVal as integer
llVal as LONGLONG
bVal as ubyte
iVal as short
fltVal as single
dblVal as double
boolVal as VARIANT_BOOL
scode as SCODE
cyVal as CY
date as DATE_
bstrVal as BSTR
punkVal as IUnknown ptr
pdispVal as LPDISPATCH
parray as SAFEARRAY ptr
pbVal as ubyte ptr
piVal as short ptr
plVal as integer ptr
pfltVal as single ptr
pdblVal as double ptr
pboolVal as VARIANT_BOOL ptr
pbool as _VARIANT_BOOL ptr
pscode as SCODE ptr
pcyVal as CY ptr
pdate as DATE_ ptr
pbstrVal as BSTR ptr
ppunkVal as IUnknown ptr ptr
ppdispVal as LPDISPATCH ptr
pparray as SAFEARRAY ptr ptr
pvarVal as VARIANT_ ptr
byref as any ptr
cVal as CHAR
uiVal as USHORT
ulVal as ULONG
ullVal as ULONGLONG
intVal as INT_
uintVal as UINT
pdecVal as DECIMAL ptr
pcVal as CHAR ptr
puiVal as USHORT ptr
pulVal as ULONG ptr
pintVal as INT_ ptr
puintVal as UINT ptr
type
pvRecord as PVOID
pRecInfo as IRecordInfo_ ptr
end type
end union
end type
decVal as DECIMAL
end union

type VARIANT as VARIANT_


you can see this example , compile it as a dll, replace byval as VARIANT by as VARIANT you will see the differences

[B DllVar.bas/B]

Code: Select all


#Include Once "windows.bi"
#Include Once "Olevariant.bi"

#DEFINE MatOk 0 
' No error

#DEFINE MatSing -2 
' Quasi-singular matrix

#DEFINE MatErrDim -3
' Non-compatible dimensions

' ------------------------------------------------------------------
' Machine-dependent constant
' ------------------------------------------------------------------

#DEFINE MachEp 2.220446049250313D-16 
' Floating point precision: 2^(-52)

' ------------------------------------------------------------------
' Global variable
' ------------------------------------------------------------------

COMMON SHARED ErrCode AS INTEGER
' Error code from the latest function evaluation

' ******************************************************************

Dim Shared PMatkg As SAFEARRAY Ptr


SUB GaussJordan (A() AS DOUBLE, BYREF Det AS DOUBLE) 
' ------------------------------------------------------------------
' Gauss-Jordan algorithm for a matrix A(L..N, L..M) with M >= N
' ------------------------------------------------------------------
' On input:
'   * The submatrix A(L..N, L..N) contains the system matrix
'   * The submatrix A(L..N, (N+1)..M) contains the constant vector(s)
'
' On output:
'   * The submatrix A(L..N, L..N) contains the inverse matrix
'   * The submatrix A(L..N, (N+1)..M) contains the solution vector(s)
'   * The determinant of the system matrix is returned in Det
'   * The error code is returned in the global variable ErrCode:
'       ErrCode = MatOk     ==> no error
'       ErrCode = MatErrDim ==> non-compatible dimensions (N < M)
'       ErrCode = MatSing   ==> quasi-singular matrix
' ------------------------------------------------------------------

  DIM AS INTEGER L, N, M  ' Bounds of A
  DIM AS INTEGER I, J, K  ' Loop variables
  DIM AS INTEGER Ik, Jk   ' Pivot coordinates
  DIM AS DOUBLE  Pvt      ' Pivot
  DIM AS DOUBLE  T        ' Auxiliary variable

  L = LBOUND(A, 1)
  N = UBOUND(A, 1)
  M = UBOUND(A, 2)
 
  IF N > M THEN
    ErrCode = MatErrDim
    EXIT SUB
  END IF

  DIM AS INTEGER PRow(L TO N)  ' Stores line of pivot
  DIM AS INTEGER PCol(L TO N)  ' Stores column of pivot
  DIM AS DOUBLE  MCol(L TO N)  ' Stores a column of the matrix

  Det = 1
  K = L

  DO WHILE K <= N
    ' Search for largest pivot in submatrix A[K..N, K..N]
    Pvt = A(K, K)
    Ik = K
    Jk = K
    FOR I = K TO N
      FOR J = K TO N
        IF ABS(A(I, J)) > ABS(Pvt) THEN
          Pvt = A(I, J)
          Ik = I
          Jk = J
        END IF
      NEXT J
    NEXT I

    ' Pivot too small ==> quasi-singular matrix
    IF ABS(Pvt) < MachEp THEN
      Det = 0
      ErrCode = MatSing
      EXIT SUB
    END IF

    ' Save pivot position
    PRow(K) = Ik
    PCol(K) = Jk

    ' Update determinant
    Det = Det * Pvt
    IF Ik <> K THEN Det = -Det
    IF Jk <> K THEN Det = -Det

    ' Exchange current row (K) with pivot row (Ik)
    IF Ik <> K THEN
      FOR J = L TO M
        SWAP A(K, J), A(Ik, J)
      NEXT J
    END IF

    ' Exchange current column (K) with pivot column (Jk)
    IF Jk <> K THEN
      FOR I = L TO N
        SWAP A(I, K), A(I, Jk)
      NEXT I
    END IF

    ' Store col. K of A into MCol and set this col. to 0
    FOR I = L TO N
      IF I <> K THEN
        MCol(I) = A(I, K)
        A(I, K) = 0
      ELSE
        MCol(I) = 0
        A(I, K) = 1
      END IF
    NEXT I

    ' Transform pivot row
    FOR J = L TO M
      A(K, J) = A(K, J) / Pvt
    NEXT J

    ' Transform other rows
    FOR I = L TO N
      IF I <> K THEN
        T = MCol(I)
        FOR J = L TO M
          A(I, J) = A(I, J) - T * A(K, J)
        NEXT J
      END IF
    NEXT I

    K = K + 1
  LOOP

  ' Exchange lines of whole matrix
  FOR I = N TO L STEP -1
    Ik = PCol(I)
    IF Ik <> I THEN
      FOR J = L TO M
        SWAP A(I, J), A(Ik, J)
      NEXT J
    END IF
  NEXT I

  ' Exchange columns of inverse matrix
  FOR J = N TO L STEP -1
    Jk = PRow(J)
    IF Jk <> J THEN
      FOR I = L TO N
        SWAP A(I, J), A(I, Jk)
      NEXT I
    END IF
  NEXT J

  ErrCode = MatOk
END Sub


Extern "windows-ms"

Sub Gauss_Jordan(ByRef V As VARIANT ,ByRef det As Double) Export
   Dim A() As Double
   VariantToArray  (A() , V)
   GaussJordan(A(),det)
 
   V=ArrayToVariant(A())
End Sub

 ' ByRef P As SAFEARRAY Ptr = Byval P As SAFEARRAY Ptr Ptr
Sub Gauss_Jordan2(ByRef P As SAFEARRAY Ptr ,ByRef det As Double) Export
   Dim A() As Double
   SafeArrayToArray  (A() , P)
   GaussJordan(A(),det)
   ArrayToSafeArray P,A()
   
End Sub

                   ' ByRef P As SAFEARRAY Ptr = Byval P As SAFEARRAY Ptr Ptr
Sub StrTequation(a As Double,b As Double,c As Double,ByRef P As SAFEARRAY Ptr)Export  'byref nécessaire
   Dim Arr(0 To 2) As Double
   Arr(0)=a
   Arr(1)=b
   Arr(2)=c
   ArrayToSafeArray(P,Arr())
End Sub

 

Function Det22(ByVal V As VARIANT_ ) As Double  Export
    Dim C() As Double ' must be dynamic
    VariantToArray( C(),V)
    Return C(1,1)*C(2,2)-C(2,1)*C(1,2)
End Function

End Extern



testvb.bas

Code: Select all

codePrivate Declare Sub Gauss_Jordan Lib "DllVar.dll" (ByRef P As Variant, ByRef Det As Double)
Private Declare Sub Gauss_Jordan2 Lib "DllVar.dll" (P() As Double, ByRef Det As Double)
Private Declare Sub StrTequation Lib "DllVar.dll" (ByVal A As Double, ByVal b As Double, ByVal c As Double, P() As Double)
Private Declare Function Det22 Lib "DllVar.dll" (ByVal V As Variant) As Double

 
Dim hlib As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long



Function printmatrix(A() As Double)
Dim i As Integer, j As Integer
For i = 1 To UBound(A, 1)
 For j = 1 To UBound(A, 2)
   Print A(i, j),
 Next
 Print
 Next
End Function

Function printVariant(V As Variant)
Dim i As Integer, j As Integer
For i = 1 To UBound(V, 1)
 For j = 1 To UBound(V, 2)
   Print V(i, j),
 Next
 Print
 Next
End Function

Sub CopyMat(M() As Double, A() As Double)
Dim i As Integer, j As Integer
For i = 1 To UBound(A, 1)
 For j = 1 To UBound(A, 2)
A(i, j) = M(i, j)
Next j, i
End Sub


Private Sub Command1_Click()
Const N = 3, M = 4  ' Size of matrix
Dim b() As Double
Dim A(1 To 3, 1 To 4) As Double

A(1, 1) = 3: A(1, 2) = 1: A(1, 3) = -1: A(1, 4) = 2
A(2, 1) = 1: A(2, 2) = 2: A(2, 3) = 0: A(2, 4) = 4
A(3, 1) = 0: A(3, 2) = 0: A(3, 3) = 1: A(3, 4) = 3


Dim Det As Double  ' Determinant

Cls

A(1, 1) = 3: A(1, 2) = 1: A(1, 3) = -1: A(1, 4) = 2
A(2, 1) = 1: A(2, 2) = 2: A(2, 3) = 0: A(2, 4) = 4
A(3, 1) = 0: A(3, 2) = 0: A(3, 3) = 1: A(3, 4) = 3

Gauss_Jordan2 A(), Det
MsgBox "det= " & Det
MsgBox "x= " & A(1, 4) & vbCrLf & "y= " & A(2, 4) & vbCrLf & "z= " & A(3, 4)
Cls
printmatrix A()
End Sub



Private Sub Command4_Click()
 Const N = 3, M = 4  ' Size of matrix
Dim b() As Double
Dim A(1 To 3, 1 To 4) As Double

A(1, 1) = 3: A(1, 2) = 1: A(1, 3) = -1: A(1, 4) = 2
A(2, 1) = 1: A(2, 2) = 2: A(2, 3) = 0: A(2, 4) = 4
A(3, 1) = 0: A(3, 2) = 0: A(3, 3) = 1: A(3, 4) = 3


Dim Det As Double  ' Determinant

Cls

A(1, 1) = 3: A(1, 2) = 1: A(1, 3) = -1: A(1, 4) = 2
A(2, 1) = 1: A(2, 2) = 2: A(2, 3) = 0: A(2, 4) = 4
A(3, 1) = 0: A(3, 2) = 0: A(3, 3) = 1: A(3, 4) = 3
Dim V As Variant
V = A  ' transmission of vb array to variant
Gauss_Jordan V, Det
MsgBox "det= " & Det
MsgBox "x= " & V(1, 4) & vbCrLf & "y= " & V(2, 4) & vbCrLf & "z= " & V(3, 4)
Cls
printVariant V
End Sub


Private Sub Commanddet22_Click()
Dim M22(1 To 2, 1 To 2)  As Double
M22(1, 1) = 4: M22(1, 2) = 3
M22(2, 1) = 2: M22(2, 2) = 5
Dim V As Variant
V = M22
MsgBox "det(M22)= " & Det22(V)
End Sub

Private Sub CommandstrT_Click()
Dim A(0 To 2) As Double
Call StrTequation(5, -10, 3, A())
MsgBox "A(0)= " & A(0) & vbCrLf & "A(1)= " & A(1) & vbCrLf & "A(2)= " & A(2)
End Sub



Private Sub Form_Load()
hlib = LoadLibrary("RDM1D.dll")
If hlib = 0 Then MsgBox "une dll est nécessaire"
End Sub

Private Sub Form_Unload(Cancel As Integer)
FreeLibrary hlib
End Sub
dkl
Site Admin
Posts: 3221
Joined: Jul 28, 2005 14:45
Location: Germany

Re: BUG with imported VARIANT called byval

Postby dkl » Mar 06, 2012 21:19

Ok, yea, I meant the VARIANT from FreeBASIC/examples/Windows/variants/variant.bi. But if you're using the VARIANT from win/oaidl.bi then byval x as VARIANT should work.
Loe
Posts: 323
Joined: Apr 30, 2006 14:49

Re: BUG with imported VARIANT called byval

Postby Loe » Mar 09, 2012 23:57

hi alober,
i need sometime to dig up axsuite2 project since my pc broken up and freebasic.net/arch was missing.
in axsuite2 all byref parameters will change to byval pointer.
so for variant type, as i remember, it will pass as byval pointer.
for variant class i used FreeBASIC/examples/Windows/variants/variant.bi.
freebasic variant pointer will pointed to its variant_ pointer.
aloberoger
Posts: 495
Joined: Jan 13, 2009 19:23

Re: BUG with imported VARIANT called byval

Postby aloberoger » Mar 12, 2012 17:02

Yes Loé I thing :
byval as VARIANT PTR work for [out] parameters
BYVAL as VARIANT work for [in] parameters( without BYVAL here is not good at all)

Return to “Windows”

Who is online

Users browsing this forum: No registered users and 3 guests