FWCallDll() and MingW + Harbour

[hua]

I used outputdebugstring() and a dialog box appear saying "FWCallDll() not available yet for MinGW gcc. Does this mean whatever's using DLL/DLL32 command can't be compiled using MingW yet? Any workaround for this?

TIA

[Antonio Linares]

Hua,

We already have a calldll.c for gcc version that we are testing. Changes are basically this way:

Code: Select all  Expand view

             #ifdef __BORLANDC__
                 asm push ax;
              #elseif defined( _MSC_VER )
                 _asm { push ax }
              #elseif defined( __GNUC__ )  
                 asm( "push ax" );
              #endif

Here you have the new calldll.c version in case that you want to compile it yourself and test it:

calldll.c

Code: Select all  Expand view

#ifdef __BORLANDC__
   #pragma inline                 // via assembler
#endif

#include <Windows.h>

#ifndef UNICODE
   #include <dos.h>
#endif
   
#include <hbapi.h>

// a workaround to use Borland and Clipper on doubles

#ifdef __XPP__
#define hb_parnd __parnd
#define hb_retnd __retnd
#endif

#ifdef __C3__
   #undef __CLIPPER__
   void hb_retnd( double );
   double hb_parnd( WORD );
#endif

#ifdef __CLIPPER__
   LPWORD hb_parnd( WORD );
   void hb_retnd( WORD, WORD, WORD, WORD );
#endif

typedef DWORD ( FAR PASCAL * _CALLPROC32 ) ( FARPROC, DWORD, DWORD );
_CALLPROC32 GetCallProc32( void );

DWORD pascal GetVDMP32( LPVOID, UINT );

#define AS_PASCAL  1

#define AS_VOID    0
#define AS_BYTE    1
#define AS_CHAR    2
#define AS_WORD    3
#define AS_INT     4
#define AS_BOOL    5
#define AS_HDC     6
#define AS_LONG    7
#define AS_STRING  8
#define AS_LPSTR   9
#define AS_PTR    10
#define AS_DOUBLE 11
#define AS_DWORD  12

typedef struct
{
   FARPROC farProc;
   BYTE bType;
   BYTE bReturn;
   BYTE bParams;
   BYTE bParam[ 15 ];
} STRFUNC;

typedef void ( * FUNCPTR )( void );

#ifdef __FLAT__
#undef  PCLIPVAR
#define PCLIPVAR char *
#define REF_CLIPVAR char
#define MK_FP(seg,ofs) (seg + ofs)
#endif

//----------------------------------------------------------------------------//
// for numbers supplied by reference

static LPWORD GetNumAddress( PCLIPVAR pVar )
{
   #ifndef __FLAT__
   REF_CLIPVAR * pRef = MK_FP( _DS, pVar );
   LPCLIPVAR pNum = MK_FP( _DS, pRef->pClipVar );

   return ( LPWORD ) &( pNum->pPointer1 );
   #else
   HB_SYMBOL_UNUSED( pVar );
   return 0;
   #endif
}

//----------------------------------------------------------------------------//

static LPLONG GetLongAddress( LONG * paLongs, char b, LONG lValue )
{
   paLongs[ b ] = lValue;

   return &( paLongs[ b ] );
}

//----------------------------------------------------------------------------//

#ifndef _WIN64

HB_FUNC( FWCALLDLL )
{
   static STRFUNC * pStrFunc;
   static char b;
   static WORD wAX, wDX;
   static double d;
   static LPWORD pDouble;
   static LONG lEAX;

   #ifdef __FLAT__
      static LONG aLongs[ 15 ];
   #endif

   #ifdef __FLAT__
      static WORD bStack = 0;
   #else
      BYTE bStack = 0;
   #endif
   
   pStrFunc = ( STRFUNC * ) hb_parc( 1 );

   if( ! pStrFunc->farProc )
      return;

   #ifndef __FLAT__
      asm pusha;
   #endif

   #ifndef __FLAT__
      for( b = 0; b < pStrFunc->bParams; b++ )
   #else
      for( b = pStrFunc->bParams - 1; b >= 0; b-- )
   #endif
   {
      switch( pStrFunc->bParam[ b ] )
      {
         case AS_BYTE:
         case AS_CHAR:
              hb_parni( b + 2 );
              #ifdef __BORLANDC__
                 asm push ax;
              #elseif defined( _MSC_VER )
                 _asm { push ax }
              #elseif defined( __GNUC__ )  
                 asm( "push ax" );
              #endif
              bStack += 2;
              break;

         case AS_WORD:
         case AS_INT:
         case AS_HDC:
              hb_parni( b + 2 );
              #ifndef __FLAT__
                 asm push ax;
                 bStack += 2;
              #else
                 #ifdef __BORLANDC__
                    asm push eax;
                 #elseif defined( _MSC_VER )
                    _asm { push eax }
                 #elseif defined( __GNUC__ )  
                    asm( "push eax" );
                 #endif
                 bStack += 4;
              #endif
              break;

         case AS_BOOL:
              hb_parl( b + 2 );
              #ifndef __FLAT__
                 asm push ax;
                 bStack += 2;
              #else
                 #ifdef __BORLANDC__
                    asm push eax;
                 #elseif defined( _MSC_VER )
                    _asm { push eax }
                 #elseif defined( __GNUC__ )  
                    asm( "push eax" );
                 #endif
                 bStack += 4;
              #endif
              break;

         case AS_LONG:
         case AS_PTR:
         case AS_DWORD:
              if( HB_ISBYREF( b + 2 ) )
                 #ifndef __FLAT__
                    GetNumAddress( ( PCLIPVAR ) hb_param( b + 2, -1 ) );
                 #else
                    GetLongAddress( aLongs, b, hb_parnl( b + 2 ) );
                 #endif
              else
                 hb_parnl( b + 2 );
              #ifndef __FLAT__
                 asm push dx;
                 asm push ax;
              #else
                 #ifdef __BORLANDC__
                    asm push eax;
                 #elseif defined( _MSC_VER )
                    _asm { push eax }
                 #elseif defined( __GNUC__ )  
                    asm( "push eax" );
                 #endif
              #endif
              bStack += 4;
              break;

         case AS_LPSTR:
         case AS_STRING:
              hb_parc( b + 2 );
              #ifndef __FLAT__
                 asm push dx;
                 asm push ax;
              #else
                 #ifdef __BORLANDC__
                    asm push eax;
                 #elseif defined( _MSC_VER )
                    _asm { push eax }
                 #elseif defined( __GNUC__ )  
                    asm( "push eax" );
                 #endif
              #endif
              bStack += 4;
              break;

         case AS_DOUBLE:
              #ifndef __HARBOUR__
                 pDouble = hb_parnd( b + 2 );
              #else
                 d = hb_parnd( b + 2 );
                 pDouble = ( LPWORD ) &d;
              #endif
              #ifdef __BORLANDC__
                 _AX = pDouble[ 3 ];
                 asm push ax;
                 _AX = pDouble[ 2 ];
                 asm push ax;
                 _AX = pDouble[ 1 ];
                 asm push ax;
                 _AX = pDouble[ 0 ];
                 asm push ax;
              #elseif defined( _MSC_VER )
                 wAX = pDouble[ 3 ];
                 _asm { push wAX }
                 wAX = pDouble[ 2 ];
                 _asm { push wAX }
                 wAX = pDouble[ 1 ];
                 _asm { push wAX }
                 wAX = pDouble[ 0 ];
                 _asm { push wAX }
              #elseif defined( __GNUC__ )  
                 wAX = pDouble[ 3 ];
                 asm( "push wAX" );
                 wAX = pDouble[ 2 ];
                 asm( "push wAX" );
                 wAX = pDouble[ 1 ];
                 asm( "push wAX" );
                 wAX = pDouble[ 0 ];
                 asm( "push wAX" );
              #endif
              bStack += 8;
              break;
      }
   }

   ( ( FUNCPTR ) pStrFunc->farProc )();
   #ifndef __FLAT__
      wAX = _AX;
      wDX = _DX;
   #else
      #ifdef __BORLANDC__
         lEAX = _EAX;
      #elseif defined( _MSC_VER )
         _asm { mov lEAX, eax }
      #elseif defined( __GNUC__ )  
         asm( "mov lEAX, eax" );
      #endif
   #endif

   if( pStrFunc->bType != ( BYTE ) AS_PASCAL )
      #ifdef __BORLANDC__
         asm add sp, bStack;
      #elseif defined( _MSC_VER )
         _asm { add sp, bStack }
      #elseif defined( __GNUC__ )  
         asm( "add sp, bStack" );
      #endif

   #ifndef __FLAT__
      asm popa;
   #endif

   #ifdef __FLAT__
      if( pStrFunc->bParams )
         for( b = pStrFunc->bParams - 1; b >= 0; b-- )
            if( HB_ISBYREF( b + 2 ) )
            {
               switch( pStrFunc->bParam[ b ] )
               {
                  case AS_LONG:
                  case AS_PTR:
                  case AS_DWORD:
                       hb_stornl( aLongs[ b ], b + 2 );
               }
            }
   #endif

   switch( pStrFunc->bReturn )
   {
      case AS_BYTE:
      case AS_CHAR:
           #ifndef __FLAT__
              hb_retni( wAX & 0x00FF );
           #else
              hb_retni( lEAX );
           #endif
           break;

      case AS_WORD:
      case AS_INT:
           #ifndef __FLAT__
              hb_retni( wAX );
           #else
              hb_retnl( lEAX );
           #endif
           break;

      case AS_BOOL:
           #ifndef __FLAT__
              hb_retl( wAX );
           #else
              hb_retl( lEAX );
           #endif
           break;

      case AS_LONG:
      case AS_PTR:
      case AS_DWORD:
           #ifndef __FLAT__
              hb_retnl( MAKELONG( wAX, wDX ) );
           #else
              hb_retnl( lEAX );
           #endif
           break;

      case AS_STRING:
      case AS_LPSTR:
           #ifndef __FLAT__
              hb_retc( ( char * ) MK_FP( wDX, wAX ) );
           #else
              hb_retc( ( char * ) lEAX );
           #endif
           break;

      case AS_DOUBLE:
           #ifndef __FLAT__
              pDouble = ( LPWORD ) MK_FP( wDX, wAX );
           #else
              pDouble = ( LPWORD ) lEAX;
           #endif
           #ifndef __HARBOUR__
              hb_retnd( pDouble[ 0 ], pDouble[ 1 ], pDouble[ 2 ], pDouble[ 3 ] );
           #else
              d = * ( double * ) pDouble;
              hb_retnd( d );
           #endif
           break;
   }
}

#endif

//----------------------------------------------------------------------------//

static LONG power( LONG nPower )
{
   LONG n = 0, nResult = 1;

   while( n++ < nPower )
     nResult *= 2;

   return nResult;
}

//----------------------------------------------------------------------------//

#ifdef __BORLANDC__

HB_FUNC( FWCALLDLL32 )
{
   STRFUNC * pStrFunc = ( STRFUNC * ) hb_parc( 1 );
   BYTE b, bStack = 0;
   WORD wAX, wDX;
   LPWORD pDouble;
   double d;
   _CALLPROC32 CallProc32 = ( _CALLPROC32 ) GetCallProc32();
   DWORD dwParamConvert = 0;
   DWORD p32;
   UINT uSelector;

   if( ! pStrFunc->farProc )
      return;

   asm pusha;

   for( b = 0; b < pStrFunc->bParams; b++ )
   {
      switch( pStrFunc->bParam[ b ] )
      {
         case AS_BYTE:
         case AS_CHAR:
              hb_parni( b + 2 );
              #ifndef __FLAT__
              asm push ax;
              #endif
              bStack += 2;
              break;

         case AS_WORD:
         case AS_INT:
         case AS_HDC:
              hb_parni( b + 2 );
              #ifndef __FLAT__
              asm push ax;
              #endif
              bStack += 2;
              break;

         case AS_BOOL:
              hb_parl( b + 2 );
              #ifndef __FLAT__
              asm push ax;
              #endif
              bStack += 2;
              break;

         case AS_LONG:
         case AS_DWORD:
              if( HB_ISBYREF( b + 2 ) )
                 GetNumAddress( ( PCLIPVAR ) hb_param( b + 2, -1 ) );
              else
                 hb_parnl( b + 2 );
              #ifndef __FLAT__
              asm push dx;
              asm push ax;
              #endif
              bStack += 4;
              break;

         case AS_PTR:
              if( HB_ISBYREF( b + 2 ) )
                 GetNumAddress( ( PCLIPVAR ) hb_param( b + 2, -1 ) );
              else
                 hb_parnl( b + 2 );
              #ifndef __FLAT__
              asm push dx;
              asm push ax;
              #endif
              bStack += 4;
              dwParamConvert |= power( ( pStrFunc->bParams - b - 1 ) );
              break;

         case AS_LPSTR:
         case AS_STRING:
              hb_parc( b + 2 );
              #ifndef __FLAT__
              asm push dx;
              asm push ax;
              #endif
              bStack += 4;
              #ifndef __FLAT__
              if( _AX || _DX )
                 dwParamConvert |= power( ( pStrFunc->bParams - b - 1 ) );
              #endif
              break;

         case AS_DOUBLE:
              #ifndef __HARBOUR__
                 pDouble = hb_parnd( b + 2 );
              #else
                 d = hb_parnd( b + 2 );
                 pDouble = ( LPWORD ) ( ( char * ) &d );
              #endif
              #ifndef __FLAT__
              _AX = pDouble[ 3 ];
              asm push ax;
              _AX = pDouble[ 2 ];
              asm push ax;
              _AX = pDouble[ 1 ];
              asm push ax;
              _AX = pDouble[ 0 ];
              asm push ax;
              #endif
              bStack += 8;
              break;
      }
   }

   if( CallProc32 )
   {
      //    dwParamConvert:      000 <--- 32 bits --> 0 [ 110 ]
      //                  three params and 1 and 2 request 16-32 conversion

      CallProc32( pStrFunc->farProc, dwParamConvert, pStrFunc->bParams );


      #ifndef __FLAT__
      wAX = _AX;
      wDX = _DX;
      #endif
   }

   #ifndef __FLAT__
   if( pStrFunc->bType != AS_PASCAL )
      asm add sp, bStack;
   #endif

   asm popa;

   switch( pStrFunc->bReturn )
   {
      case AS_BYTE:
      case AS_CHAR:
           hb_retni( wAX & 0x00FF );
           break;

      case AS_WORD:
      case AS_INT:
           hb_retni( wAX );
           break;

      case AS_BOOL:
           hb_retl( wAX );
           break;

      case AS_LONG:
      case AS_PTR:
      case AS_DWORD:
           hb_retnl( MAKELONG( wAX, wDX ) );
           break;

      case AS_STRING:
      case AS_LPSTR:
           #ifndef __FLAT__
           uSelector = AllocSelector( _DS );
           SetSelectorBase( uSelector, ( DWORD ) MK_FP( wDX, wAX ) );
           SetSelectorLimit( uSelector, 65535 );
           hb_retc( ( char * ) MK_FP( uSelector, 0 ) );
           FreeSelector( uSelector );
           #endif
           break;

      case AS_DOUBLE:
           pDouble = ( LPWORD ) MK_FP( wDX, wAX );
           #ifndef __HARBOUR__
              hb_retnd( pDouble[ 0 ], pDouble[ 1 ], pDouble[ 2 ], pDouble[ 3 ] );
           #else
              d = * ( double * ) pDouble;
              hb_retnd( d );
           #endif
           break;
   }
}

#else

   HB_FUNC( CALLDLL32 )
   {
      #ifndef UNICODE
         MessageBox( 0, "CallDll32", "CallDll.c", 0 );
      #else  
         MessageBox( 0, L"CallDll32", L"CallDll.c", 0 );
      #endif  
   }

#endif

//----------------------------------------------------------------------------//
 

[Antonio Linares]

Hua,

There were some changes to implement and now it is working fine

We email you FiveHGC.lib

Thanks!

[hua]

Received and I can confirm it works Thanks so much Antonio

[Carlos Mora]

Hi Antonio,

May I have it?

[Antonio Linares]

Already Sent

[Carlos Mora]

Gracias!

[concentra]

Antonio, could you send it to me please.
Thanks.

[concentra]

Can anyone send this to me ?

I have a stucked conversion proccess to MinGw here because this missing function...

[[]] Maurício Ventura Faria

[Antonio Linares]

Mauricio,

What FWH version are you using ?

[concentra]

October 2011

[[]] Maurício

[Antonio Linares]

Mauricio,

Libs already sent to your email

[concentra]

Antonio, I updated the libs but I'm still getting a CallDll.c / CallDll32 MessageBox.



I made a small self contained sample TESTE.PRG:

Code: Select all  Expand view

#INCLUDE "fivewin.ch"

FUNCTION MAIN()

   Local hHandle

   hHandle  := LOADLIBRARY( "BWCC32.DLL" )
   IF hHandle < 1
      ALERT( "BWCC32.DLL not found..." )
   ELSE
      CALLDLL32( "BWCCRegister", "BWCC32.DLL", GetResources() )
   ENDIF

   MessageBox( 0, "Teste...", "Teste", 0 );

RETURN NIL 

Them called HBMK2 with the following .HBP:

Code: Select all  Expand view

-incpath=F:\FWH\include

-gui
-m
-n
-w
-a
-q
-p
-es2

-LF:\FWH\lib

-lfivehg
-lfivehgc

-lhbwin
-loledlg
-lpsapi
-lversion

Teste.PRG 

The lib DIR listing is:

Code: Select all  Expand view

F:\Work>dir F:\FWH\lib\fivehg*.*
 O volume na unidade F não tem nome.
 O número de série do volume é 4877-2894

 Pasta de F:\FWH\lib

18/11/2011  20:20         2.874.900 FiveHG.lib
14/11/2011  17:50           759.896 Fivehgc.lib
               2 arquivo(s)      3.634.796 bytes
               0 pasta(s) 15.836.467.200 bytes disponíveis

Could you please review this ?

[[]] Maurício

[concentra]

Is this a real problem or am I doing something wrong ?

[Antonio Linares]

Mauricio,

Thats not the right syntax to use. Please review samples\dllcall.prg example:

And build it this way:

buildg.bat dllcall

Please notice that inside dll.ch we use FWCallDll() but you should not call it directly. Use our DLL FUNCTION ... command syntax.