fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2010-06-17 13:11 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/src/vm/harbinit.prg
  * harbour/src/vm/runner.c
  * harbour/src/vm/hvm.c
    ! fixed the order in which HVM calls __SetHelpK() PRG function.
      It should be called after all INIT proc and before main application
      entry.
    * removed __SetHelpK() from thread initialization code.
    ! fixed the order in which INIT procedures are executed in single
      module - CA-Cl*pper calls INIT PROCEDUREs in the reverted order
      (from last to first)
    + added support for undocumented Clipper extension: two execution
      levels of INIT PROCEDUREs. When application starts CA-Cl*pper
      executes INIT PROCEDUREs called CLIPINIT from all linked PRG
      modules. Then it repeats this operation for all modules executing
      all other PROCEDUREs.

      Now Harbour and Clipper gives the same results for this code:
         proc main()
            ? PROCNAME()
         proc errorsys()
            ? PROCNAME()
         init proc INITPROC1()
            ? PROCNAME()
         init proc clipinit()
            ? PROCNAME()
         init proc INITPROC2()
            ? PROCNAME()
         proc __SetHelpK()
            ? PROCNAME()
         proc HELP()
This commit is contained in:
Przemyslaw Czerpak
2010-06-17 11:11:52 +00:00
parent fb5241c566
commit 9cc47dbdc2
4 changed files with 137 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

32
harbour/ChangeLog
View File

@@ -16,6 +16,38 @@
The license applies to all entries newer than 2009-04-28.
*/
2010-06-17 13:11 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/src/vm/harbinit.prg
* harbour/src/vm/runner.c
* harbour/src/vm/hvm.c
! fixed the order in which HVM calls __SetHelpK() PRG function.
It should be called after all INIT proc and before main application
entry.
* removed __SetHelpK() from thread initialization code.
! fixed the order in which INIT procedures are executed in single
module - CA-Cl*pper calls INIT PROCEDUREs in the reverted order
(from last to first)
+ added support for undocumented Clipper extension: two execution
levels of INIT PROCEDUREs. When application starts CA-Cl*pper
executes INIT PROCEDUREs called CLIPINIT from all linked PRG
modules. Then it repeats this operation for all modules executing
all other PROCEDUREs.
Now Harbour and Clipper gives the same results for this code:
proc main()
? PROCNAME()
proc errorsys()
? PROCNAME()
init proc INITPROC1()
? PROCNAME()
init proc clipinit()
? PROCNAME()
init proc INITPROC2()
? PROCNAME()
proc __SetHelpK()
? PROCNAME()
proc HELP()
2010-06-17 07:47 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
* contrib/hbqt/hbqt_common.hbm
* contrib/hbqt/detect.mk

6
harbour/src/vm/harbinit.prg
View File

@@ -80,12 +80,6 @@ PROCEDURE ClipInit()
ErrorSys()
/* TOFIX: In Clipper this function is not called from here CLIPINIT(). */
/* NOTE: In Clipper __SETHELPK() is called *after* ERRORSYS(). */
IF Type( "HELP()" ) == "UI"
__SetHelpK()
ENDIF
RETURN
PROCEDURE __SetHelpK()

118
harbour/src/vm/hvm.c
View File

@@ -206,7 +206,7 @@ static void hb_vmPopStatic( HB_USHORT uiStatic ); /* pops the stack latest va
/* misc */
static void hb_vmDoInitStatics( void ); /* executes all _INITSTATICS functions */
static void hb_vmDoInitFunctions( void ); /* executes all defined PRGs INIT functions */
static void hb_vmDoInitFunctions( HB_BOOL ); /* executes all defined PRGs INIT functions */
static void hb_vmDoExitFunctions( void ); /* executes all defined PRGs EXIT functions */
static void hb_vmReleaseLocalSymbols( void ); /* releases the memory of the local symbols linked list */
@@ -373,7 +373,9 @@ static void hb_vmDoModuleQuitFunctions( void )
}
/* call CLIPINIT function to initialize ErrorBlock() and __SetHelpK() */
/* call CLIPINIT function to initialize GETLIST public variable
* and set ErrorBlock() by ERRORSYS() function
*/
static void hb_vmDoInitClip( void )
{
PHB_DYNS pDynSym = hb_dynsymFind( "CLIPINIT" );
@@ -386,6 +388,23 @@ static void hb_vmDoInitClip( void )
}
}
/* call __SetHelpK() if HELP() function is linked */
static void hb_vmDoInitHelp( void )
{
PHB_DYNS pDynSym = hb_dynsymFind( "HELP" );
if( pDynSym && pDynSym->pSymbol->value.pFunPtr )
{
pDynSym = hb_dynsymFind( "__SETHELPK" );
if( pDynSym && pDynSym->pSymbol->value.pFunPtr )
{
hb_vmPushSymbol( pDynSym->pSymbol );
hb_vmPushNil();
hb_vmProc( 0 );
}
}
}
#if !defined( HB_MT_VM )
HB_BOOL hb_vmIsMt( void ) { return HB_FALSE; }
@@ -793,8 +812,8 @@ void hb_vmThreadInit( void * Cargo )
if( s_fHVMActive )
{
/* call CLIPINIT function to initialize GetList PUBLIC variables
* ErrorBlock() and __SetHelpK()
/* call CLIPINIT function to initialize GETLIST public variable
* and set ErrorBlock() by ERRORSYS() function
*/
hb_vmDoInitClip();
}
@@ -979,18 +998,27 @@ void hb_vmInit( HB_BOOL bStartMainProc )
* because INIT function can use static variables
*/
hb_vmDoInitStatics();
/* call CLIPINIT function to initialize GetList PUBLIC variables
* ErrorBlock() and __SetHelpK()
/* call CLIPINIT function to initialize GETLIST public variable
* and set ErrorBlock() by ERRORSYS() function
* Because on some platform the execution order of init functions
* is out of Harbour control then this function has to be called
* explicitly in VM initialization process before hb_vmDoInitFunctions()
* and not depends on INIT clause.
*/
hb_vmDoInitClip();
hb_clsDoInit(); /* initialize Classy .prg functions */
hb_vmDoModuleInitFunctions(); /* process AtInit registered functions */
hb_vmDoInitFunctions(); /* process defined INIT functions */
hb_clsDoInit(); /* initialize Class(y) .prg functions */
hb_vmDoModuleInitFunctions(); /* process AtInit registered functions */
hb_vmDoInitFunctions( HB_TRUE ); /* process registered CLIPINIT INIT procedures */
hb_vmDoInitFunctions( HB_FALSE ); /* process registered other INIT procedures */
/* Call __SetHelpK() function to redirect K_F1 to HELP() function
* if it is linked. CA-Cl*pper calls it after INIT PROCEDURes and
* before executing the application entry function.
*/
hb_vmDoInitHelp();
/* This is undocumented CA-Cl*pper, if there's a function called _APPMAIN
it will be executed first. [vszakats] */
@@ -7676,33 +7704,45 @@ void hb_vmInitSymbolGroup( void * hNewDynLib, int argc, const char * argv[] )
if( fFound )
{
pLastSymbols = s_pSymbols;
while( pLastSymbols )
{
if( pLastSymbols->hDynLib == hNewDynLib )
{
if( pLastSymbols->fActive && ( pLastSymbols->hScope & HB_FS_INIT ) != 0 )
{
for( ui = 0; ui < pLastSymbols->uiModuleSymbols; ui++ )
{
HB_SYMBOLSCOPE scope = ( pLastSymbols->pModuleSymbols + ui )->scope.value & HB_FS_INITEXIT;
HB_BOOL fClipInit = HB_TRUE;
if( scope == HB_FS_INIT )
do
{
pLastSymbols = s_pSymbols;
while( pLastSymbols && hb_vmRequestQuery() == 0 )
{
if( pLastSymbols->hDynLib == hNewDynLib )
{
if( pLastSymbols->fActive && ( pLastSymbols->hScope & HB_FS_INIT ) != 0 )
{
ui = pLastSymbols->uiModuleSymbols;
while( ui-- )
{
int i;
hb_vmPushSymbol( pLastSymbols->pModuleSymbols + ui );
hb_vmPushNil();
for( i = 0; i < argc; ++i )
HB_SYMBOLSCOPE scope = ( pLastSymbols->pModuleSymbols + ui )->scope.value & HB_FS_INITEXIT;
if( scope == HB_FS_INIT &&
( strcmp( ( pLastSymbols->pModuleSymbols + ui )->szName,
"CLIPINIT$" ) == 0 ? fClipInit : !fClipInit ) )
{
hb_vmPushString( argv[i], strlen( argv[i] ) );
int i;
hb_vmPushSymbol( pLastSymbols->pModuleSymbols + ui );
hb_vmPushNil();
for( i = 0; i < argc; ++i )
{
hb_vmPushString( argv[i], strlen( argv[i] ) );
}
hb_vmProc( ( HB_USHORT ) argc );
if( hb_vmRequestQuery() != 0 )
break;
}
hb_vmProc( ( HB_USHORT ) argc );
}
}
}
pLastSymbols = pLastSymbols->pNext;
}
pLastSymbols = pLastSymbols->pNext;
fClipInit = !fClipInit;
}
while( !fClipInit );
}
}
}
@@ -7995,7 +8035,7 @@ static void hb_vmDoInitStatics( void )
for( ui = 0; ui < pLastSymbols->uiModuleSymbols; ui++ )
{
HB_SYMBOLSCOPE scope = ( pLastSymbols->pModuleSymbols + ui )->scope.value & ( HB_FS_EXIT | HB_FS_INIT );
HB_SYMBOLSCOPE scope = ( pLastSymbols->pModuleSymbols + ui )->scope.value & HB_FS_INITEXIT;
if( scope == HB_FS_INITEXIT )
{
@@ -8010,24 +8050,26 @@ static void hb_vmDoInitStatics( void )
}
}
static void hb_vmDoInitFunctions( void )
static void hb_vmDoInitFunctions( HB_BOOL fClipInit )
{
PHB_SYMBOLS pLastSymbols = s_pSymbols;
HB_TRACE(HB_TR_DEBUG, ("hb_vmDoInitFunctions()"));
HB_TRACE(HB_TR_DEBUG, ("hb_vmDoInitFunctions(%d)", fClipInit));
while( pLastSymbols )
while( pLastSymbols && hb_vmRequestQuery() == 0 )
{
/* only if module contains some INIT functions */
if( pLastSymbols->fActive && pLastSymbols->hScope & HB_FS_INIT )
if( pLastSymbols->fActive && ( pLastSymbols->hScope & HB_FS_INIT ) != 0 )
{
HB_USHORT ui;
HB_USHORT ui = pLastSymbols->uiModuleSymbols;
for( ui = 0; ui < pLastSymbols->uiModuleSymbols; ui++ )
while( ui-- )
{
HB_SYMBOLSCOPE scope = ( pLastSymbols->pModuleSymbols + ui )->scope.value & ( HB_FS_EXIT | HB_FS_INIT );
HB_SYMBOLSCOPE scope = ( pLastSymbols->pModuleSymbols + ui )->scope.value & HB_FS_INITEXIT;
if( scope == HB_FS_INIT )
if( scope == HB_FS_INIT &&
( strcmp( ( pLastSymbols->pModuleSymbols + ui )->szName,
"CLIPINIT$" ) == 0 ? fClipInit : !fClipInit ) )
{
int argc = hb_cmdargARGC();
char ** argv = hb_cmdargARGV();
@@ -8049,6 +8091,8 @@ static void hb_vmDoInitFunctions( void )
}
hb_vmProc( ( HB_USHORT ) iArgCount );
if( hb_vmRequestQuery() != 0 )
break;
}
}
}
@@ -8078,7 +8122,7 @@ static void hb_vmDoExitFunctions( void )
for( ui = 0; ui < pLastSymbols->uiModuleSymbols; ui++ )
{
HB_SYMBOLSCOPE scope = ( pLastSymbols->pModuleSymbols + ui )->scope.value & ( HB_FS_EXIT | HB_FS_INIT );
HB_SYMBOLSCOPE scope = ( pLastSymbols->pModuleSymbols + ui )->scope.value & HB_FS_INITEXIT;
if( scope == HB_FS_EXIT )
{

33
harbour/src/vm/runner.c
View File

@@ -203,24 +203,39 @@ static void hb_hrbInit( PHRB_BODY pHrbBody, int iPCount, PHB_ITEM * pParams )
if( hb_vmRequestReenter() )
{
HB_ULONG ul;
HB_BOOL fRepeat, fClipInit = HB_TRUE;
int i;
pHrbBody->fInit = HB_FALSE;
pHrbBody->fExit = HB_TRUE;
for( ul = 0; ul < pHrbBody->ulSymbols; ul++ ) /* Check INIT functions */
do
{
if( ( pHrbBody->pSymRead[ ul ].scope.value & HB_FS_INITEXIT ) == HB_FS_INIT )
fRepeat = HB_FALSE;
ul = pHrbBody->ulSymbols;
while( ul-- )
{
hb_vmPushSymbol( pHrbBody->pSymRead + ul );
hb_vmPushNil();
for( i = 0; i < iPCount; i++ )
hb_vmPush( pParams[ i ] );
hb_vmProc( ( HB_USHORT ) iPCount );
if( hb_vmRequestQuery() != 0 )
break;
/* Check INIT functions */
if( ( pHrbBody->pSymRead[ ul ].scope.value & HB_FS_INITEXIT ) == HB_FS_INIT )
{
if( strcmp( pHrbBody->pSymRead[ ul ].szName, "CLIPINIT$" ) ?
!fClipInit : fClipInit )
{
hb_vmPushSymbol( pHrbBody->pSymRead + ul );
hb_vmPushNil();
for( i = 0; i < iPCount; i++ )
hb_vmPush( pParams[ i ] );
hb_vmProc( ( HB_USHORT ) iPCount );
if( hb_vmRequestQuery() != 0 )
break;
}
else if( fClipInit )
fRepeat = HB_TRUE;
}
}
fClipInit = HB_FALSE;
}
while( fRepeat && hb_vmRequestQuery() == 0 );
hb_vmRequestRestore();
}