FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index FiveWin para Harbour/xHarbour xHarbour 64 bits y xbScritp - (Solucionado)
Posts: 9020
Joined: Thu Oct 06, 2005 08:17 PM
Re: xHarbour 64 bits y xbScritp
Posted: Sun Sep 15, 2024 07:06 PM

But I still need a sample to check it. I'm not going to rebuild and upload the whole xHarbour just for testing.

Posts: 514
Joined: Sun Oct 16, 2005 03:32 AM
Re: xHarbour 64 bits y xbScritp
Posted: Sun Sep 15, 2024 09:59 PM
I'm sorry Enrico, I don't use anything related to those four functions anywhere in my code or libraries.

xHarbour automatically generates that when you run
Code (fw): Select all Collapse
"c:\xharbour64\bin\harbour -n -I....\include xbscript.prg"
to produce the "xbscript.c" file. It's in that file where the reference to those four functions, and many others, is made.

Could you generate the "xpscript.c" file so you can see what I mean, or would you prefer that I send you the one I generated?

The library is built with 4 files: clsresults.ch, xbs_harb.ch, xbsclass.ch, and xbscript.prg. That's all. I think there's something in one of those four files that causes "xbscript.c" to include the call to those four functions, but I don't have the knowledge or expertise to fix the problem, that's why I'm asking for help.

I don't know what else to do, the fact is that it doesn't work in xHarbour 64 with Borland 7.7 64-bit, which is a shame, because it's a feature that gives xHarbour great power.

Saludos,



Carlos Gallego



*** FWH-25.12, xHarbour 1.3.1 Build 20241008, Borland C++7.70, PellesC, ADS 11.1***

Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 06:11 AM
Enrico Maria Giordano wrote:But I still need a sample to check it. I'm not going to rebuild and upload the whole xHarbour just for testing.
If you don't rebuild it then we will not know if it works or not, and why such check was placed there...

#if defined( __WIN32__ ) && ! defined( __WIN64__ )
regards, saludos

Antonio Linares
www.fivetechsoft.com
Posts: 9020
Joined: Thu Oct 06, 2005 08:17 PM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 08:19 AM

No, it is not so simple. I need a sample, otherwise I can't help you, sorry.

Posts: 9020
Joined: Thu Oct 06, 2005 08:17 PM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 08:57 AM

Ok, I found a sample in the xHarbour docs. Now I can check if those functions are working fine in 64 bit...

Posts: 9020
Joined: Thu Oct 06, 2005 08:17 PM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 09:34 AM
Unfortunately, there are some ASM code in dllcall.c, something like this:
Code (fw): Select all Collapse
_asm mov pStack, esp
And the compiler complains:
Code (fw): Select all Collapse
error C4235: nonstandard extension used: '__asm' keyword not supported on this architecture
What to do now?
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 10:16 AM
Dear Enrico,

Here we have a candidate to test:
Code (fw): Select all Collapse
#if defined( __WIN32__ ) || defined( __WIN64__ )

#ifndef NODLL

#define _WIN32_WINNT 0x0400
#define WIN32_LEAN_AND_MEAN

#include "hbapiitm.h"
#include <windows.h>
#include "hbdll.h"
#include "hbapi.h"
#include "hbstack.h"
#include "hbvm.h"

#define EXEC_DLL 0x45584543

typedef struct tag_ExecStruct
{
   DWORD dwType;
   char * cDLL;
   HMODULE hDLL;
   char * cProc;
   DWORD dwOrdinal;
   DWORD dwFlags;
   FARPROC lpFunc;
} EXECSTRUCT, * PEXECSTRUCT;

static PHB_DYNS pHB_CSTRUCTURE = NULL, pPOINTER, pVALUE, pBUFFER, pDEVALUE;

HB_EXTERN_BEGIN
char * hb_parcstruct( int iParam, ... );
HB_EXTERN_END

char * hb_parcstruct( int iParam, ... )
{
   // ... (código sin cambios)
}

static HB_GARBAGE_FUNC( _DLLUnload )
{
   PEXECSTRUCT xec = ( PEXECSTRUCT ) Cargo;

   if( xec->dwType == EXEC_DLL )
   {
      if( xec->cDLL != NULL )
      {
         if( xec->hDLL != NULL )
         {
            FreeLibrary( xec->hDLL );
         }
         hb_xfree( xec->cDLL );
      }
      if( xec->cProc != NULL )
      {
         hb_xfree( xec->cProc );
      }
      xec->dwType = 0;
   }
}

HB_FUNC( DLLPREPARECALL )
{
   PEXECSTRUCT xec = ( PEXECSTRUCT ) hb_gcAlloc( sizeof( EXECSTRUCT ), _DLLUnload );

   memset( xec, 0, sizeof( EXECSTRUCT ) );

   if( HB_ISCHAR( 1 ) )
   {
      xec->cDLL = hb_strdup( hb_parc( 1 ) );
      xec->hDLL = LoadLibrary( xec->cDLL );
   }
   else
   {
      xec->hDLL = ( HMODULE ) hb_parptr( 1 );
   }

   if( HB_ISNUM( 2 ) )
   {
      xec->dwFlags = hb_parnl( 2 );
   }
   else
   {
      xec->dwFlags = DC_CALL_STD;
   }

   if( xec->hDLL )
   {
      if( HB_ISCHAR( 3 ) )
      {
         xec->cProc = ( char * ) hb_xgrab( hb_parclen( 3 ) + 2 );
         hb_strncpy( xec->cProc, hb_parc( 3 ), hb_parclen( 3 ) );
      }
      else if( HB_ISNUM( 3 ) )
      {
         xec->dwOrdinal = hb_parnl( 3 );
      }
   }
   else
   {
      if( xec->cDLL )
      {
         MessageBox( GetActiveWindow(), "DllPrepareCall:LoadLibrary() failed!", xec->cDLL, MB_OK | MB_ICONERROR );
      }
      else
      {
         MessageBox( GetActiveWindow(), "DllPrepareCall() invalid handle argument!", "DllPrepareCall", MB_OK | MB_ICONERROR );
      }
   }

   xec->dwType = EXEC_DLL;
   xec->lpFunc = ( FARPROC ) GetProcAddress( xec->hDLL, xec->cProc != NULL ? ( LPCSTR ) xec->cProc : ( LPCSTR ) ( DWORD_PTR ) xec->dwOrdinal );

   if( xec->lpFunc == NULL && xec->cProc )
   {
      xec->cProc[ hb_parclen( 3 ) ] = 'A';
      xec->cProc[ hb_parclen( 3 ) + 1 ] = '\0';
      xec->lpFunc = ( FARPROC ) GetProcAddress( xec->hDLL, xec->cProc );
   }

   if( xec->hDLL && xec->lpFunc )
   {
      hb_retptrGC( xec );
   }
   else if( xec->hDLL && xec->lpFunc == NULL )
   {
      if( xec->cProc )
      {
         LPVOID lpMsgBuf;
         FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, NULL,
                        GetLastError(), MAKELANGID( LANG_NEUTRAL, SUBLANG_DEFAULT ),
                        ( LPTSTR ) &lpMsgBuf, 0, NULL );
         MessageBox( GetActiveWindow(), ( LPCSTR ) lpMsgBuf, "DllPrepareCall:GetProcAddress() failed!", MB_OK | MB_ICONERROR );
         LocalFree( lpMsgBuf );
      }
      else
      {
         MessageBox( GetActiveWindow(), "DllPrepareCall:GetProcAddress() invalid ordinal argument!", "DllPrepareCall", MB_OK | MB_ICONERROR );
      }
   }
}

HB_FUNC( GETPROCADDRESS )
{
   FARPROC lpProcAddr;
   char cFuncName[ MAX_PATH ];

   if( ( lpProcAddr = GetProcAddress( ( HMODULE ) hb_parptr( 1 ),
                                      HB_ISCHAR( 2 ) ? ( LPCSTR ) hb_parcx( 2 ) :
                                      ( LPCSTR ) ( DWORD_PTR ) hb_parnint( 2 ) ) ) == 0 )
   {
      if( HB_ISCHAR( 2 ) )
      {
         hb_xstrcpy( cFuncName, hb_parc( 2 ), 0 );
         hb_xstrcat( cFuncName, "A", 0 );
         lpProcAddr = GetProcAddress( ( HMODULE ) hb_parptr( 1 ), cFuncName );
      }
   }

   hb_retptr( ( void * ) lpProcAddr );
}

#ifdef _WIN64
#include <intrin.h>

typedef struct
{
   DWORD64 Low;
   DWORD64 High;
} RESULT;

typedef struct
{
   DWORD64 dwFlags;
   int nWidth;
   union
   {
      BYTE bArg;
      SHORT usArg;
      DWORD dwArg;
      DWORD64 qwArg;
      double dArg;
   };
   void * pArg;
} DYNAPARM;

RESULT DynaCall64(DWORD64 Flags, FARPROC lpFunction, int nArgs, DYNAPARM Parm[], void* pRet, int nRetSiz)
{
    RESULT Res = { 0 };
    DWORD64 args[4] = { 0 };  // For the first 4 arguments
    double dargs[4] = { 0 };  // For float/double arguments
    int i, nIntArgs = 0, nFloatArgs = 0;

    // Prepare arguments
    for (i = 0; i < nArgs && i < 4; i++)
    {
        if (Parm[i].dwFlags & DC_FLAG_FLOAT)
        {
            dargs[nFloatArgs++] = Parm[i].dArg;
        }
        else
        {
            args[nIntArgs++] = Parm[i].qwArg;
        }
    }

    // Call the function using inline assembly
    __asm
    {
        // Load floating point arguments into XMM registers
        movsd xmm0, qword ptr[dargs]
        movsd xmm1, qword ptr[dargs + 8]
        movsd xmm2, qword ptr[dargs + 16]
        movsd xmm3, qword ptr[dargs + 24]

        // Load integer arguments into registers
        mov rcx, args[0]
        mov rdx, args[8]
        mov r8, args[16]
        mov r9, args[24]

        // Adjust stack for any remaining arguments (if nArgs > 4)
        sub rsp, 32  // Shadow space for Win64 ABI

        // Call the function
        call lpFunction

        // Restore stack
        add rsp, 32

        // Store the result
        mov Res.Low, rax
        mov Res.High, rdx
    }

    // Handle return value if needed
    if (pRet && nRetSiz > 0)
    {
        memcpy(pRet, &Res, nRetSiz);
    }

    return Res;
}
#else
// Mantener la implementación original de DynaCall para 32 bits
#endif

static void DllExec(int iFlags, FARPROC lpFunction, int iParams, int iFirst, int iArgCnt, PEXECSTRUCT xec)
{
#ifdef _WIN64
    DYNAPARM Parm[32];  // Ajusta el tamaño según sea necesario
    int i;
    for (i = 0; i < iArgCnt && i < 32; i++)
    {
        // Configurar Parm[i] basándose en los argumentos de Harbour
        // Esto dependerá de cómo estés pasando los argumentos desde Harbour
        if (HB_ISNUM(iFirst + i))
        {
            Parm[i].dwFlags = 0;
            Parm[i].qwArg = (DWORD64)hb_parnd(iFirst + i);
        }
        else if (HB_ISPOINTER(iFirst + i))
        {
            Parm[i].dwFlags = 0;
            Parm[i].pArg = hb_parptr(iFirst + i);
        }
        // Agregar más tipos según sea necesario
    }
    RESULT Res = DynaCall64(iFlags, lpFunction, iArgCnt, Parm, NULL, 0);
    // Manejar el resultado según sea necesario
    hb_retnint((HB_PTRDIFF)Res.Low);
#else
    // Implementación existente para 32 bits
#endif
}

HB_FUNC( DLLEXECUTECALL )
{
   int iParams = hb_pcount();
   int iFirst = 2;
   int iArgCnt = iParams - 1;
   PEXECSTRUCT xec = ( PEXECSTRUCT ) hb_parptr( 1 );

   if( xec != NULL )
   {
      if( xec->dwType == EXEC_DLL )
      {
         if( xec->hDLL != NULL )
         {
            if( xec->lpFunc != NULL )
            {
               DllExec( 0, xec->lpFunc, iParams, iFirst, iArgCnt, xec );
            }
         }
      }
   }
}

HB_FUNC( DLLCALL )
{
   int iParams = hb_pcount();
   int iFirst = 4;
   int iArgCnt = iParams - 3;
   int iFlags;
   BOOL lUnload = FALSE;
   HMODULE hInst;
   FARPROC lpFunction;
   BYTE cFuncName[ MAX_PATH ];

   if( HB_ISCHAR( 1 ) )
   {
      hInst = LoadLibrary( hb_parc( 1 ) );
      lUnload = TRUE;
   }
   else
   {
      hInst = ( HMODULE ) hb_parptr( 1 );
   }

   if( hInst == NULL )
   {
      hb_ret();
      return;
   }

   iFlags = hb_parni( 2 );

   if( ( lpFunction = GetProcAddress( hInst,
                                      HB_ISCHAR( 3 ) ? ( LPCSTR ) hb_parcx( 3 ) :
                                      ( LPCSTR ) ( DWORD_PTR ) hb_parnint( 3 ) ) ) == 0 )
   {
      if( HB_ISCHAR( 3 ) )
      {
         hb_xstrcpy( ( char * ) cFuncName, hb_parc( 3 ), 0 );
         hb_xstrcat( ( char * ) cFuncName, "A", 0 );
         lpFunction = GetProcAddress( hInst, ( const char * ) cFuncName );
      }
   }

   if( lpFunction != NULL )
   {
      DllExec( iFlags, lpFunction, iParams, iFirst, iArgCnt, NULL );
   }

   if( lUnload )
   {
      FreeLibrary( hInst );
   }
}

#endif /* NODLL */

HB_FUNC( LOADLIBRARY )
{
   hb_retptr( ( void * ) LoadLibraryA( ( LPCSTR ) hb_parcx( 1 ) ) );
}

HB_FUNC( FREELIBRARY )
{
   hb_retl( FreeLibrary( ( HMODULE ) hb_parptr( 1 ) ) );
}

HB_FUNC( GETLASTERROR )
{
   hb_retnint( ( HB_PTRDIFF ) GetLastError() );
}

HB_FUNC( SETLASTERROR )
{
   hb_retnint( ( HB_PTRDIFF ) GetLastError() );
   SetLastError( ( DWORD ) hb_parnint( 1 ) );
}

// compatibility
HB_FUNC( DLLLOAD )
{
   HB_FUNCNAME( LOADLIBRARY ) ();
}

// compatibility
HB_FUNC( DLLUNLOAD )
{
   HB_FUNCNAME( FREELIBRARY ) ();
}

#endif /* End of __WIN32__ || __WIN64__ */
regards, saludos

Antonio Linares
www.fivetechsoft.com
Posts: 9020
Joined: Thu Oct 06, 2005 08:17 PM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 10:48 AM

I get many errors. Please add #pragma BEGINDUMP and #pragma ENDDUMP and try yourself.

Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 11:32 AM
Dear Enrico,

Here it compiled clean on first try:
c:\temp\dllcall>c:\bcc7764\bin\bcc64 dllcall.c
Embarcadero C++ 7.70 for Win64 Copyright (c) 2012-2023 Embarcadero Technologies, Inc.
dllcall.c:
dir *.*
16/09/2024 13:30 9.204 dllcall.c
16/09/2024 13:30 664 dllcall.o
No need for #pragma BEGINDUMP ... as it is a C file
regards, saludos

Antonio Linares
www.fivetechsoft.com
Posts: 9020
Joined: Thu Oct 06, 2005 08:17 PM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 01:39 PM
Antonio Linares wrote:No need for #pragma BEGINDUMP ... as it is a C file
I meant, so that you can put the code in your PRG sample and try if it works fine.
Posts: 514
Joined: Sun Oct 16, 2005 03:32 AM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 04:22 PM
Enrico, I put the code for the function proposed by Antonio in the sample PRG, but the same issue persists when compiling using "buildx64.bat".
┌──────────────────────────────────────────────────────────────────────────────┐
?FiveWin for xHarbour 24.07 64bits - Aug. 2024 Harbour development power │▄
?(c) FiveTech 1993-2024 for Microsoft Windows 9X/NT/200X/ME/XP/Vista/7/8/10/11 │█
└──────────────────────────────────────────────────────────────────────────────┘?
  ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀?
Compiling...
D:\XHARBOUR64\bin\harbour PRUEBA1 /n /d__64__ /i.\..\include;D:\XHARBOUR64\include /w /p
xHarbour 1.3.1 Intl. (SimpLex) (Build 20240624)
Copyright 1999-2024, http://www.xharbour.org http://www.harbour-project.org/
Compiling 'PRUEBA1.prg' and generating preprocessed output to 'PRUEBA1.ppo'...
Generating C source output to 'PRUEBA1.c'...
Done.
Lines 19, Functions/Procedures 1, pCodes 143
PRUEBA1.prg(3) Warning W0001 Redefinition or duplicate definition of #define MB_ICONINFORMATION
Embarcadero C++ 7.70 for Win64 Copyright (c) 2012-2023 Embarcadero Technologies, Inc.
PRUEBA1.c:
Turbo Incremental Link64 6.98 Copyright (c) 1997-2023 Embarcadero Technologies, Inc.
Error: Unresolved external 'HB_FUN_DLLPREPARECALL' referenced from C:\XHARBOUR64\UTILS\XBSCRIPT\XBSCRIPT.A|xbscript.o
Error: Unresolved external 'HB_FUN_GETPROCADDRESS' referenced from C:\XHARBOUR64\UTILS\XBSCRIPT\XBSCRIPT.A|xbscript.o
Error: Unresolved external 'HB_FUN_DLLEXECUTECALL' referenced from C:\XHARBOUR64\UTILS\XBSCRIPT\XBSCRIPT.A|xbscript.o
Error: Unresolved external 'HB_FUN_DLLCALL' referenced from C:\XHARBOUR64\UTILS\XBSCRIPT\XBSCRIPT.A|xbscript.o
* Linking errors *
This is the sample with c code:
Code (fw): Select all Collapse
#include "FiveWin.ch"

function Main()

   local oWnd, oDlg

   DEFINE WINDOW oWnd

      @ 2, 2 BUTTON "Test" ACTION ( pp_run("PRUEBA1.SCR") ) SIZE 80, 20
      @ 4, 2 BUTTON "Exit" ACTION ( oWnd:End ) SIZE 80, 20

   ACTIVATE WINDOW oWnd

return nil


#pragma BEGINDUMP

#if defined( __WIN32__ ) || defined( __64__ )

#ifndef NODLL

#define _WIN32_WINNT 0x0400
#define WIN32_LEAN_AND_MEAN

#include "hbapiitm.h"
#include <windows.h>
#include "hbdll.h"
#include "hbapi.h"
#include "hbstack.h"
#include "hbvm.h"

#define EXEC_DLL 0x45584543

typedef struct tag_ExecStruct
{
   DWORD dwType;
   char * cDLL;
   HMODULE hDLL;
   char * cProc;
   DWORD dwOrdinal;
   DWORD dwFlags;
   FARPROC lpFunc;
} EXECSTRUCT, * PEXECSTRUCT;

static PHB_DYNS pHB_CSTRUCTURE = NULL, pPOINTER, pVALUE, pBUFFER, pDEVALUE;

HB_EXTERN_BEGIN
char * hb_parcstruct( int iParam, ... );
HB_EXTERN_END

char * hb_parcstruct( int iParam, ... )
{
   // ... (código sin cambios)
}

static HB_GARBAGE_FUNC( _DLLUnload )
{
   PEXECSTRUCT xec = ( PEXECSTRUCT ) Cargo;

   if( xec->dwType == EXEC_DLL )
   {
      if( xec->cDLL != NULL )
      {
         if( xec->hDLL != NULL )
         {
            FreeLibrary( xec->hDLL );
         }
         hb_xfree( xec->cDLL );
      }
      if( xec->cProc != NULL )
      {
         hb_xfree( xec->cProc );
      }
      xec->dwType = 0;
   }
}

HB_FUNC( DLLPREPARECALL )
{
   PEXECSTRUCT xec = ( PEXECSTRUCT ) hb_gcAlloc( sizeof( EXECSTRUCT ), _DLLUnload );

   memset( xec, 0, sizeof( EXECSTRUCT ) );

   if( HB_ISCHAR( 1 ) )
   {
      xec->cDLL = hb_strdup( hb_parc( 1 ) );
      xec->hDLL = LoadLibrary( xec->cDLL );
   }
   else
   {
      xec->hDLL = ( HMODULE ) hb_parptr( 1 );
   }

   if( HB_ISNUM( 2 ) )
   {
      xec->dwFlags = hb_parnl( 2 );
   }
   else
   {
      xec->dwFlags = DC_CALL_STD;
   }

   if( xec->hDLL )
   {
      if( HB_ISCHAR( 3 ) )
      {
         xec->cProc = ( char * ) hb_xgrab( hb_parclen( 3 ) + 2 );
         hb_strncpy( xec->cProc, hb_parc( 3 ), hb_parclen( 3 ) );
      }
      else if( HB_ISNUM( 3 ) )
      {
         xec->dwOrdinal = hb_parnl( 3 );
      }
   }
   else
   {
      if( xec->cDLL )
      {
         MessageBox( GetActiveWindow(), "DllPrepareCall:LoadLibrary() failed!", xec->cDLL, MB_OK | MB_ICONERROR );
      }
      else
      {
         MessageBox( GetActiveWindow(), "DllPrepareCall() invalid handle argument!", "DllPrepareCall", MB_OK | MB_ICONERROR );
      }
   }

   xec->dwType = EXEC_DLL;
   xec->lpFunc = ( FARPROC ) GetProcAddress( xec->hDLL, xec->cProc != NULL ? ( LPCSTR ) xec->cProc : ( LPCSTR ) ( DWORD_PTR ) xec->dwOrdinal );

   if( xec->lpFunc == NULL && xec->cProc )
   {
      xec->cProc[ hb_parclen( 3 ) ] = 'A';
      xec->cProc[ hb_parclen( 3 ) + 1 ] = '\0';
      xec->lpFunc = ( FARPROC ) GetProcAddress( xec->hDLL, xec->cProc );
   }

   if( xec->hDLL && xec->lpFunc )
   {
      hb_retptrGC( xec );
   }
   else if( xec->hDLL && xec->lpFunc == NULL )
   {
      if( xec->cProc )
      {
         LPVOID lpMsgBuf;
         FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, NULL,
                        GetLastError(), MAKELANGID( LANG_NEUTRAL, SUBLANG_DEFAULT ),
                        ( LPTSTR ) &lpMsgBuf, 0, NULL );
         MessageBox( GetActiveWindow(), ( LPCSTR ) lpMsgBuf, "DllPrepareCall:GetProcAddress() failed!", MB_OK | MB_ICONERROR );
         LocalFree( lpMsgBuf );
      }
      else
      {
         MessageBox( GetActiveWindow(), "DllPrepareCall:GetProcAddress() invalid ordinal argument!", "DllPrepareCall", MB_OK | MB_ICONERROR );
      }
   }
}

HB_FUNC( GETPROCADDRESS )
{
   FARPROC lpProcAddr;
   char cFuncName[ MAX_PATH ];

   if( ( lpProcAddr = GetProcAddress( ( HMODULE ) hb_parptr( 1 ),
                                      HB_ISCHAR( 2 ) ? ( LPCSTR ) hb_parcx( 2 ) :
                                      ( LPCSTR ) ( DWORD_PTR ) hb_parnint( 2 ) ) ) == 0 )
   {
      if( HB_ISCHAR( 2 ) )
      {
         hb_xstrcpy( cFuncName, hb_parc( 2 ), 0 );
         hb_xstrcat( cFuncName, "A", 0 );
         lpProcAddr = GetProcAddress( ( HMODULE ) hb_parptr( 1 ), cFuncName );
      }
   }

   hb_retptr( ( void * ) lpProcAddr );
}

#ifdef _WIN64
#include <intrin.h>

typedef struct
{
   DWORD64 Low;
   DWORD64 High;
} RESULT;

typedef struct
{
   DWORD64 dwFlags;
   int nWidth;
   union
   {
      BYTE bArg;
      SHORT usArg;
      DWORD dwArg;
      DWORD64 qwArg;
      double dArg;
   };
   void * pArg;
} DYNAPARM;

RESULT DynaCall64(DWORD64 Flags, FARPROC lpFunction, int nArgs, DYNAPARM Parm[], void* pRet, int nRetSiz)
{
    RESULT Res = { 0 };
    DWORD64 args[4] = { 0 };  // For the first 4 arguments
    double dargs[4] = { 0 };  // For float/double arguments
    int i, nIntArgs = 0, nFloatArgs = 0;

    // Prepare arguments
    for (i = 0; i < nArgs && i < 4; i++)
    {
        if (Parm[i].dwFlags & DC_FLAG_FLOAT)
        {
            dargs[nFloatArgs++] = Parm[i].dArg;
        }
        else
        {
            args[nIntArgs++] = Parm[i].qwArg;
        }
    }

    // Call the function using inline assembly
    __asm
    {
        // Load floating point arguments into XMM registers
        movsd xmm0, qword ptr[dargs]
        movsd xmm1, qword ptr[dargs + 8]
        movsd xmm2, qword ptr[dargs + 16]
        movsd xmm3, qword ptr[dargs + 24]

        // Load integer arguments into registers
        mov rcx, args[0]
        mov rdx, args[8]
        mov r8, args[16]
        mov r9, args[24]

        // Adjust stack for any remaining arguments (if nArgs > 4)
        sub rsp, 32  // Shadow space for Win64 ABI

        // Call the function
        call lpFunction

        // Restore stack
        add rsp, 32

        // Store the result
        mov Res.Low, rax
        mov Res.High, rdx
    }

    // Handle return value if needed
    if (pRet && nRetSiz > 0)
    {
        memcpy(pRet, &Res, nRetSiz);
    }

    return Res;
}
#else
// Mantener la implementación original de DynaCall para 32 bits
#endif

static void DllExec(int iFlags, FARPROC lpFunction, int iParams, int iFirst, int iArgCnt, PEXECSTRUCT xec)
{
#ifdef _WIN64
    DYNAPARM Parm[32];  // Ajusta el tamaño según sea necesario
    int i;
    for (i = 0; i < iArgCnt && i < 32; i++)
    {
        // Configurar Parm[i] basándose en los argumentos de Harbour
        // Esto dependerá de cómo estés pasando los argumentos desde Harbour
        if (HB_ISNUM(iFirst + i))
        {
            Parm[i].dwFlags = 0;
            Parm[i].qwArg = (DWORD64)hb_parnd(iFirst + i);
        }
        else if (HB_ISPOINTER(iFirst + i))
        {
            Parm[i].dwFlags = 0;
            Parm[i].pArg = hb_parptr(iFirst + i);
        }
        // Agregar más tipos según sea necesario
    }
    RESULT Res = DynaCall64(iFlags, lpFunction, iArgCnt, Parm, NULL, 0);
    // Manejar el resultado según sea necesario
    hb_retnint((HB_PTRDIFF)Res.Low);
#else
    // Implementación existente para 32 bits
#endif
}

HB_FUNC( DLLEXECUTECALL )
{
   int iParams = hb_pcount();
   int iFirst = 2;
   int iArgCnt = iParams - 1;
   PEXECSTRUCT xec = ( PEXECSTRUCT ) hb_parptr( 1 );

   if( xec != NULL )
   {
      if( xec->dwType == EXEC_DLL )
      {
         if( xec->hDLL != NULL )
         {
            if( xec->lpFunc != NULL )
            {
               DllExec( 0, xec->lpFunc, iParams, iFirst, iArgCnt, xec );
            }
         }
      }
   }
}

HB_FUNC( DLLCALL )
{
   int iParams = hb_pcount();
   int iFirst = 4;
   int iArgCnt = iParams - 3;
   int iFlags;
   BOOL lUnload = FALSE;
   HMODULE hInst;
   FARPROC lpFunction;
   BYTE cFuncName[ MAX_PATH ];

   if( HB_ISCHAR( 1 ) )
   {
      hInst = LoadLibrary( hb_parc( 1 ) );
      lUnload = TRUE;
   }
   else
   {
      hInst = ( HMODULE ) hb_parptr( 1 );
   }

   if( hInst == NULL )
   {
      hb_ret();
      return;
   }

   iFlags = hb_parni( 2 );

   if( ( lpFunction = GetProcAddress( hInst,
                                      HB_ISCHAR( 3 ) ? ( LPCSTR ) hb_parcx( 3 ) :
                                      ( LPCSTR ) ( DWORD_PTR ) hb_parnint( 3 ) ) ) == 0 )
   {
      if( HB_ISCHAR( 3 ) )
      {
         hb_xstrcpy( ( char * ) cFuncName, hb_parc( 3 ), 0 );
         hb_xstrcat( ( char * ) cFuncName, "A", 0 );
         lpFunction = GetProcAddress( hInst, ( const char * ) cFuncName );
      }
   }

   if( lpFunction != NULL )
   {
      DllExec( iFlags, lpFunction, iParams, iFirst, iArgCnt, NULL );
   }

   if( lUnload )
   {
      FreeLibrary( hInst );
   }
}

#endif /* NODLL */

HB_FUNC( LOADLIBRARY )
{
   hb_retptr( ( void * ) LoadLibraryA( ( LPCSTR ) hb_parcx( 1 ) ) );
}

HB_FUNC( FREELIBRARY )
{
   hb_retl( FreeLibrary( ( HMODULE ) hb_parptr( 1 ) ) );
}

HB_FUNC( GETLASTERROR )
{
   hb_retnint( ( HB_PTRDIFF ) GetLastError() );
}

HB_FUNC( SETLASTERROR )
{
   hb_retnint( ( HB_PTRDIFF ) GetLastError() );
   SetLastError( ( DWORD ) hb_parnint( 1 ) );
}

// compatibility
HB_FUNC( DLLLOAD )
{
   HB_FUNCNAME( LOADLIBRARY ) ();
}

// compatibility
HB_FUNC( DLLUNLOAD )
{
   HB_FUNCNAME( FREELIBRARY ) ();
}

#endif /* End of __WIN32__ || __64__ */

#pragma ENDDUMP

Saludos,



Carlos Gallego



*** FWH-25.12, xHarbour 1.3.1 Build 20241008, Borland C++7.70, PellesC, ADS 11.1***

Posts: 230
Joined: Thu Sep 17, 2015 11:40 PM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 04:51 PM

Saludos Antonio, una consulta que alternativa podemos evaluar en 64 bits para trabajar a parte de xHarbour y cuales serian los cambios en nuestra codificación o se tendría que seguir en 32bits por el momento. Gracias un abrazo

Carlos Atuncar - CaSoftSystem
Chincha - Perú
+51983478218
carlosalbatun@gmail.com
Posts: 9020
Joined: Thu Oct 06, 2005 08:17 PM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 05:29 PM
I get:
Code (fw): Select all Collapse
error LNK2001: unresolved external symbol _HB_FUN_PP_RUN
I have no libraries containing the function PP_RUN().
Posts: 318
Joined: Fri Jan 14, 2022 08:37 AM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 05:30 PM

Disculpen, pero ¿ y por qué no cambian a Harbour ?

El propio creador de xHarbour, Ron Pinkas, recomienda pasar a Harbour

Me pareciera a mi que esa transición les ahorraría muchos dolores de cabeza

Posts: 514
Joined: Sun Oct 16, 2005 03:32 AM
Re: xHarbour 64 bits y xbScritp
Posted: Mon Sep 16, 2024 06:23 PM
Parece que si, da la impresión de que xHarbour está llegando al final de su ruta, y que ya está en cuidados paliativos. Parece que ya es hora de dejarlo ir.

Tocará ir probando Harbour, a ver cmo se adapta lo de xbScript :cry:, rddads, ADO, mysql, postgresql, etc,. Ufffff, parece largo el camino.

Saludos,



Carlos Gallego



*** FWH-25.12, xHarbour 1.3.1 Build 20241008, Borland C++7.70, PellesC, ADS 11.1***