xHarbour 64 bits y xbScritp - (Solucionado)
- Enrico Maria Giordano
- Posts: 8728
- Joined: Thu Oct 06, 2005 8:17 pm
- Location: Roma - Italia
- Contact:
Re: xHarbour 64 bits y xbScritp
But I still need a sample to check it. I'm not going to rebuild and upload the whole xHarbour just for testing.
Re: xHarbour 64 bits y xbScritp
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 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.
xHarbour automatically generates that when you run
Code: Select all | Expand
"c:\xharbour64\bin\harbour -n -I....\include xbscript.prg"
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 ***
Carlos Gallego
*** FWH-24.07, xHarbour 1.3.1 Build 20240624, Borland C++7.70, PellesC ***
- Antonio Linares
- Site Admin
- Posts: 42259
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: xHarbour 64 bits y xbScritp
If you don't rebuild it then we will not know if it works or not, and why such check was placed there...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 defined( __WIN32__ ) && ! defined( __WIN64__ )
- Enrico Maria Giordano
- Posts: 8728
- Joined: Thu Oct 06, 2005 8:17 pm
- Location: Roma - Italia
- Contact:
Re: xHarbour 64 bits y xbScritp
No, it is not so simple. I need a sample, otherwise I can't help you, sorry.
- Enrico Maria Giordano
- Posts: 8728
- Joined: Thu Oct 06, 2005 8:17 pm
- Location: Roma - Italia
- Contact:
Re: xHarbour 64 bits y xbScritp
Ok, I found a sample in the xHarbour docs. Now I can check if those functions are working fine in 64 bit...
- Enrico Maria Giordano
- Posts: 8728
- Joined: Thu Oct 06, 2005 8:17 pm
- Location: Roma - Italia
- Contact:
Re: xHarbour 64 bits y xbScritp
Unfortunately, there are some ASM code in dllcall.c, something like this:
And the compiler complains:
What to do now?
Code: Select all | Expand
_asm mov pStack, esp
Code: Select all | Expand
error C4235: nonstandard extension used: '__asm' keyword not supported on this architecture
- Antonio Linares
- Site Admin
- Posts: 42259
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: xHarbour 64 bits y xbScritp
Dear Enrico,
Here we have a candidate to test:
Here we have a candidate to test:
Code: Select all | Expand
#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__ */
- Enrico Maria Giordano
- Posts: 8728
- Joined: Thu Oct 06, 2005 8:17 pm
- Location: Roma - Italia
- Contact:
Re: xHarbour 64 bits y xbScritp
I get many errors. Please add #pragma BEGINDUMP and #pragma ENDDUMP and try yourself.
- Antonio Linares
- Site Admin
- Posts: 42259
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Re: xHarbour 64 bits y xbScritp
Dear Enrico,
Here it compiled clean on first try:
Here it compiled clean on first try:
dir *.*c:\temp\dllcall>c:\bcc7764\bin\bcc64 dllcall.c
Embarcadero C++ 7.70 for Win64 Copyright (c) 2012-2023 Embarcadero Technologies, Inc.
dllcall.c:
No need for #pragma BEGINDUMP ... as it is a C file16/09/2024 13:30 9.204 dllcall.c
16/09/2024 13:30 664 dllcall.o
- Enrico Maria Giordano
- Posts: 8728
- Joined: Thu Oct 06, 2005 8:17 pm
- Location: Roma - Italia
- Contact:
Re: xHarbour 64 bits y xbScritp
I meant, so that you can put the code in your PRG sample and try if it works fine.Antonio Linares wrote:No need for #pragma BEGINDUMP ... as it is a C file
Re: xHarbour 64 bits y xbScritp
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".
This is the sample with c code:┌──────────────────────────────────────────────────────────────────────────────┐
?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 *
Code: Select all | Expand
#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 ***
Carlos Gallego
*** FWH-24.07, xHarbour 1.3.1 Build 20240624, Borland C++7.70, PellesC ***
-
- Posts: 176
- Joined: Thu Sep 17, 2015 11:40 pm
- Location: Chincha - Peru
- Contact:
Re: xHarbour 64 bits y xbScritp
Saludos Antonio, una consulta que alternativa podemos evaluar en 64 bits para trabajar a parte de xHarbour y cuales serian _ en nuestra codificación o se tendría que seguir en 32bits por el momento. Gracias un abrazo
- Enrico Maria Giordano
- Posts: 8728
- Joined: Thu Oct 06, 2005 8:17 pm
- Location: Roma - Italia
- Contact:
Re: xHarbour 64 bits y xbScritp
I get:
I have no libraries containing the function PP_RUN().
Code: Select all | Expand
error LNK2001: unresolved external symbol _HB_FUN_PP_RUN
Re: xHarbour 64 bits y xbScritp
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
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
Re: xHarbour 64 bits y xbScritp
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 , rddads, ADO, mysql, postgresql, etc,. Ufffff, parece largo el camino.
Tocará ir probando Harbour, a ver cmo se adapta lo de xbScript , 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 ***
Carlos Gallego
*** FWH-24.07, xHarbour 1.3.1 Build 20240624, Borland C++7.70, PellesC ***