xHarbour 64 bits y xbScritp - (Solucionado)

Re: xHarbour 64 bits y xbScritp

Postby Enrico Maria Giordano » Sun Sep 15, 2024 7: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.
User avatar
Enrico Maria Giordano
 
Posts: 8710
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: xHarbour 64 bits y xbScritp

Postby Cgallegoa » Sun Sep 15, 2024 9: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: Select all  Expand view
"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-24.07, xHarbour 1.3.1 Build 20240624, Borland C++7.70, PellesC ***
Cgallegoa
 
Posts: 491
Joined: Sun Oct 16, 2005 3:32 am
Location: Quito - Ecuador

Re: xHarbour 64 bits y xbScritp

Postby Antonio Linares » Mon Sep 16, 2024 6: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
User avatar
Antonio Linares
Site Admin
 
Posts: 42065
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: xHarbour 64 bits y xbScritp

Postby Enrico Maria Giordano » Mon Sep 16, 2024 8:19 am

No, it is not so simple. I need a sample, otherwise I can't help you, sorry.
User avatar
Enrico Maria Giordano
 
Posts: 8710
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: xHarbour 64 bits y xbScritp

Postby Enrico Maria Giordano » Mon Sep 16, 2024 8:57 am

Ok, I found a sample in the xHarbour docs. Now I can check if those functions are working fine in 64 bit...
User avatar
Enrico Maria Giordano
 
Posts: 8710
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: xHarbour 64 bits y xbScritp

Postby Enrico Maria Giordano » Mon Sep 16, 2024 9:34 am

Unfortunately, there are some ASM code in dllcall.c, something like this:

Code: Select all  Expand view
_asm mov pStack, esp


And the compiler complains:

Code: Select all  Expand view
error C4235: nonstandard extension used: '__asm' keyword not supported on this architecture


What to do now?
User avatar
Enrico Maria Giordano
 
Posts: 8710
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: xHarbour 64 bits y xbScritp

Postby Antonio Linares » Mon Sep 16, 2024 10:16 am

Dear Enrico,

Here we have a candidate to test:
Code: Select all  Expand view
#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
User avatar
Antonio Linares
Site Admin
 
Posts: 42065
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: xHarbour 64 bits y xbScritp

Postby Enrico Maria Giordano » Mon Sep 16, 2024 10:48 am

I get many errors. Please add #pragma BEGINDUMP and #pragma ENDDUMP and try yourself.
User avatar
Enrico Maria Giordano
 
Posts: 8710
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: xHarbour 64 bits y xbScritp

Postby Antonio Linares » 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
User avatar
Antonio Linares
Site Admin
 
Posts: 42065
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: xHarbour 64 bits y xbScritp

Postby Enrico Maria Giordano » Mon Sep 16, 2024 1: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.
User avatar
Enrico Maria Giordano
 
Posts: 8710
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: xHarbour 64 bits y xbScritp

Postby Cgallegoa » Mon Sep 16, 2024 4: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: Select all  Expand view
#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-24.07, xHarbour 1.3.1 Build 20240624, Borland C++7.70, PellesC ***
Cgallegoa
 
Posts: 491
Joined: Sun Oct 16, 2005 3:32 am
Location: Quito - Ecuador

Re: xHarbour 64 bits y xbScritp

Postby CARLOS ATUNCAR » Mon Sep 16, 2024 4: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ú
CARLOS ATUNCAR
 
Posts: 171
Joined: Thu Sep 17, 2015 11:40 pm
Location: Chincha - Peru

Re: xHarbour 64 bits y xbScritp

Postby Enrico Maria Giordano » Mon Sep 16, 2024 5:29 pm

I get:

Code: Select all  Expand view
error LNK2001: unresolved external symbol _HB_FUN_PP_RUN


I have no libraries containing the function PP_RUN().
User avatar
Enrico Maria Giordano
 
Posts: 8710
Joined: Thu Oct 06, 2005 8:17 pm
Location: Roma - Italia

Re: xHarbour 64 bits y xbScritp

Postby paquitohm » Mon Sep 16, 2024 5: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
paquitohm
 
Posts: 257
Joined: Fri Jan 14, 2022 8:37 am

Re: xHarbour 64 bits y xbScritp

Postby Cgallegoa » Mon Sep 16, 2024 6: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-24.07, xHarbour 1.3.1 Build 20240624, Borland C++7.70, PellesC ***
Cgallegoa
 
Posts: 491
Joined: Sun Oct 16, 2005 3:32 am
Location: Quito - Ecuador

PreviousNext

Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot] and 62 guests