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

2006-07-18 03:40 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/doc/en/hb_vm.txt
  * harbour/doc/es/hb_vm.txt
  * harbour/include/hbvm.h
  * harbour/contrib/hgf/gtk/mainlgtk.c
  * harbour/source/compiler/gencc.c
  * harbour/source/rtl/errorapi.c
  * harbour/source/rtl/gtalleg/gtalleg.c
  * harbour/source/vm/maindll.c
  * harbour/source/vm/mainpm.c
  * harbour/source/vm/mainstd.c
  * harbour/source/vm/mainwin.c
  * harbour/source/vm/hvm.c
    * changed hb_vmQuit() to not execute EXIT() but return s_nErrorLevel
    ! execute EXIT procedures in hb_vmRequestQuit() - Clipper compatible
      behavior
    * do not exit immediately in RT errors but return from all executed
      functions - some internal parts of RDD code will have to be fixed.

  * harbour/source/vm/proc.c
    ! fixed procname for codeblocks. Seems that we are not fully Clipper
      compatible yet. I'll look at it closer soon.

  * harbour/TODO
    + added new item: Clean RDD code to be safe for return from RT errors
      assigned to me
This commit is contained in:
Przemyslaw Czerpak
2006-07-18 01:30:23 +00:00
parent c3758d5849
commit f844d53197
15 changed files with 89 additions and 85 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
harbour/ChangeLog
View File

@@ -8,6 +8,33 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
! Fixed compilation of Harbour DLL
! Fixed compilation of HbPPTest.exe
% Improved building of customized Harbour DLL
% Some more minor fixes and improvements
2006-07-18 03:40 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/doc/en/hb_vm.txt
* harbour/doc/es/hb_vm.txt
* harbour/include/hbvm.h
* harbour/contrib/hgf/gtk/mainlgtk.c
* harbour/source/compiler/gencc.c
* harbour/source/rtl/errorapi.c
* harbour/source/rtl/gtalleg/gtalleg.c
* harbour/source/vm/maindll.c
* harbour/source/vm/mainpm.c
* harbour/source/vm/mainstd.c
* harbour/source/vm/mainwin.c
* harbour/source/vm/hvm.c
* changed hb_vmQuit() to not execute EXIT() but return s_nErrorLevel
! execute EXIT procedures in hb_vmRequestQuit() - Clipper compatible
behavior
* do not exit immediately in RT errors but return from all executed
functions - some internal parts of RDD code will have to be fixed.
* harbour/source/vm/proc.c
! fixed procname for codeblocks. Seems that we are not fully Clipper
compatible yet. I'll look at it closer soon.
* harbour/TODO
+ added new item: Clean RDD code to be safe for return from RT errors

6
harbour/TODO
View File

@@ -228,6 +228,12 @@ Detail...: Remove generation of runtime error inside 'hb_objGetMethod'
for built-in classes (GET, TBROWSE,...)
Status...: Open.
***
Assign to: Przemek
Detail...: Clean RDD code to be safe for return from RT errors
Status...: Open.
=======================================================================

4
harbour/contrib/hgf/gtk/mainlgtk.c
View File

@@ -65,9 +65,7 @@ int main( int argc, char * argv[] )
{
hb_cmdargInit( argc, argv );
hb_vmInit( TRUE );
hb_vmQuit();
/* uncoment the next line if hb_vmQuit() returns */
/* return 0; */
return hb_vmQuit();
}
else
{

4
harbour/doc/en/hb_vm.txt
View File

@@ -57,11 +57,11 @@
* C Prototype
*
* #include <hbvm.h>
* hb_vmQuit( void ) --> void
* hb_vmQuit( void ) --> int
* $ARGUMENTS$
*
* $RETURNS$
*
* ERRORLEVEL code
* $DESCRIPTION$
*
* $EXAMPLES$

4
harbour/doc/es/hb_vm.txt
View File

@@ -71,11 +71,11 @@
* C Prototype
*
* #include <hbvm.h>
* hb_vmQuit( void ) --> void
* hb_vmQuit( void ) --> int
* $ARGUMENTS$
* Ninguno
* $RETURNS$
* Nada
* ERRORLEVEL
* $DESCRIPTION$
* Ocasiona la Inmediata salida de la M quina Virtual
* $EXAMPLES$

2
harbour/include/hbvm.h
View File

@@ -59,7 +59,7 @@ HB_EXTERN_BEGIN
/* Harbour virtual machine init/exit functions */
extern HB_EXPORT void hb_vmInit( BOOL bStartMainProc );
extern HB_EXPORT void hb_vmQuit( void ); /* Immediately quits the virtual machine */
extern HB_EXPORT int hb_vmQuit( void ); /* Immediately quits the virtual machine, return ERRORLEVEL code */
/* registration AtInit and AtExit functions - they are executed
* just before (after) .prg INIT (EXIT) procedures.

6
harbour/source/compiler/gencc.c
View File

@@ -1253,10 +1253,10 @@ static HB_GENC_FUNC( hb_p_seqend )
HB_GENC_LABEL();
if( lOffset == 4 ) /* no RECOVER clasue */
fprintf( cargo->yyc, "\t} while( 0 );\n\thb_xvmSeqEnd( %s );\n",
fprintf( cargo->yyc, "\t} while( 0 );\n\tif( hb_xvmSeqEnd( %s ) ) break;\n",
cargo->fForEach ? "&lForEachBase" : "NULL" );
else /* RECOVER exists */
fprintf( cargo->yyc, "\thb_xvmSeqEnd( %s );\n\tgoto lab%05ld;\n\t} while( 0 );\n",
fprintf( cargo->yyc, "\tif( hb_xvmSeqEnd( %s ) ) break;\n\tgoto lab%05ld;\n\t} while( 0 );\n",
cargo->fForEach ? "&lForEachBase" : "NULL",
HB_GENC_GETLABEL( lPCodePos + lOffset ) );
return 4;
@@ -1266,7 +1266,7 @@ static HB_GENC_FUNC( hb_p_seqrecover )
{
HB_GENC_LABEL();
fprintf( cargo->yyc, "\thb_xvmSeqRecover( %s );\n",
fprintf( cargo->yyc, "\tif( hb_xvmSeqRecover( %s ) ) break;\n",
cargo->fForEach ? "&lForEachBase" : "NULL" );
return 1;
}

22
harbour/source/rtl/errorapi.c
View File

@@ -184,7 +184,6 @@ PHB_ITEM hb_errNew( void )
USHORT hb_errLaunch( PHB_ITEM pError )
{
USHORT uiAction = E_DEFAULT; /* Needed to avoid GCC -O2 warning */
USHORT usRequest;
HB_TRACE(HB_TR_DEBUG, ("hb_errLaunch(%p)", pError));
@@ -226,15 +225,7 @@ USHORT hb_errLaunch( PHB_ITEM pError )
/* Check results */
usRequest = hb_vmRequestQuery();
if( usRequest == HB_QUIT_REQUESTED )
{
if( pResult )
hb_itemRelease( pResult );
hb_errRelease( pError );
hb_vmQuit();
}
else if( usRequest == HB_BREAK_REQUESTED || usRequest == HB_ENDPROC_REQUESTED )
if( hb_vmRequestQuery() != 0 )
{
if( pResult )
hb_itemRelease( pResult );
@@ -292,7 +283,6 @@ USHORT hb_errLaunch( PHB_ITEM pError )
PHB_ITEM hb_errLaunchSubst( PHB_ITEM pError )
{
PHB_ITEM pResult;
USHORT usRequest;
HB_TRACE(HB_TR_DEBUG, ("hb_errLaunchSubst(%p)", pError));
@@ -332,15 +322,7 @@ PHB_ITEM hb_errLaunchSubst( PHB_ITEM pError )
/* Check results */
usRequest = hb_vmRequestQuery();
if( usRequest == HB_QUIT_REQUESTED )
{
if( pResult )
hb_itemRelease( pResult );
hb_errRelease( pError );
hb_vmQuit();
}
else if( usRequest == HB_BREAK_REQUESTED || usRequest == HB_ENDPROC_REQUESTED )
if( hb_vmRequestQuery() != 0 )
{
if( pResult )
hb_itemRelease( pResult );

4
harbour/source/rtl/gtalleg/gtalleg.c
View File

@@ -1220,8 +1220,6 @@ int _mangled_main( int argc, char * argv[] )
hb_cmdargInit( argc, argv );
hb_vmInit( TRUE );
hb_vmQuit();
return 0;
return hb_vmQuit();
}
void * _mangled_main_address = ( void * ) _mangled_main;

46
harbour/source/vm/hvm.c
View File

@@ -542,7 +542,7 @@ HB_EXPORT void hb_vmInit( BOOL bStartMainProc )
#endif
}
HB_EXPORT void hb_vmQuit( void )
HB_EXPORT int hb_vmQuit( void )
{
HB_TRACE(HB_TR_DEBUG, ("hb_vmQuit()"));
@@ -550,9 +550,6 @@ HB_EXPORT void hb_vmQuit( void )
hb_pp_Free();
#endif
s_uiActionRequest = 0; /* EXIT procedures should be processed */
hb_vmDoExitFunctions(); /* process defined EXIT functions */
/* process AtExit registered functions */
hb_vmDoModuleExitFunctions();
hb_vmCleanModuleFunctions();
@@ -588,7 +585,7 @@ HB_EXPORT void hb_vmQuit( void )
/* hb_dynsymLog(); */
hb_xexit();
exit( s_nErrorLevel );
return s_nErrorLevel;
}
HB_EXPORT void hb_vmExecute( const BYTE * pCode, PHB_SYMB pSymbols )
@@ -5921,8 +5918,18 @@ HB_FUNC( ERRORLEVEL )
void hb_vmRequestQuit( void )
{
static BOOL s_fDoExitProc = TRUE;
HB_TRACE(HB_TR_DEBUG, ("hb_vmRequestQuit()"));
/* EXIT procedures should be processed? */
if( s_fDoExitProc )
{
s_fDoExitProc = FALSE;
s_uiActionRequest = 0;
hb_vmDoExitFunctions(); /* process defined EXIT functions */
}
s_uiActionRequest = HB_QUIT_REQUESTED;
}
@@ -5945,6 +5952,10 @@ void hb_vmRequestBreak( PHB_ITEM pItem )
s_uiActionRequest = HB_BREAK_REQUESTED;
}
else
/*
* do not call hb_vmRequestQuit()
* Clipper does not execute EXIT procedures when quiting by BREAK()
*/
s_uiActionRequest = HB_QUIT_REQUESTED;
}
@@ -5976,6 +5987,10 @@ void hb_vmRequestCancel( void )
}
while( hb_procinfo( ++i, buffer, &uiLine, NULL ) );
/*
* do not call hb_vmRequestQuit()
* Clipper does not execute EXIT procedures when quiting using break key
*/
s_uiActionRequest = HB_QUIT_REQUESTED;
}
}
@@ -5991,17 +6006,8 @@ ULONG hb_vmFlagEnabled( ULONG flags )
#define HB_XVM_RETURN return ( s_uiActionRequest ? hb_xvmActionRequest() : FALSE );
static BOOL hb_xvmActionRequest( void )
{
if( s_uiActionRequest & ( HB_ENDPROC_REQUESTED | HB_BREAK_REQUESTED ) )
return TRUE;
else if( s_uiActionRequest & HB_QUIT_REQUESTED )
hb_vmQuit();
return FALSE;
}
#define HB_XVM_RETURN return ( s_uiActionRequest & \
( HB_ENDPROC_REQUESTED | HB_BREAK_REQUESTED | HB_QUIT_REQUESTED ) ) != 0;
HB_EXPORT void hb_xvmExitProc( ULONG ulPrivateBase )
{
@@ -6088,12 +6094,10 @@ HB_EXPORT BOOL hb_xvmSeqEnd( LONG * plForEachBase )
/* 1) Discard the value returned by BREAK statement */
hb_stackPop();
if( s_uiActionRequest & HB_ENDPROC_REQUESTED )
if( s_uiActionRequest & ( HB_ENDPROC_REQUESTED | HB_QUIT_REQUESTED ) )
return TRUE;
else if( s_uiActionRequest & HB_BREAK_REQUESTED )
s_uiActionRequest = 0;
else if( s_uiActionRequest & HB_QUIT_REQUESTED )
hb_vmQuit();
return FALSE;
}
@@ -6128,12 +6132,10 @@ HB_EXPORT BOOL hb_xvmSeqRecover( LONG * plForEachBase )
hb_stackDec();
/* 1) Leave the value returned from BREAK */
if( s_uiActionRequest & HB_ENDPROC_REQUESTED )
if( s_uiActionRequest & ( HB_ENDPROC_REQUESTED | HB_QUIT_REQUESTED ) )
return TRUE;
else if( s_uiActionRequest & HB_BREAK_REQUESTED )
s_uiActionRequest = 0;
else if( s_uiActionRequest & HB_QUIT_REQUESTED )
hb_vmQuit();
return FALSE;
}

4
harbour/source/vm/maindll.c
View File

@@ -64,7 +64,7 @@
HB_EXPORT BOOL WINAPI DllEntryPoint( HINSTANCE hInstance, DWORD fdwReason, PVOID pvReserved )
{
HB_TRACE( HB_TR_DEBUG, ("DllEntryPoint(%p, %p, %d)", hInstance, fdwReason,
HB_TRACE( HB_TR_DEBUG, ("DllEntryPoint(%p, %p, %p)", hInstance, fdwReason,
pvReserved ) );
HB_SYMBOL_UNUSED( hInstance );
@@ -78,7 +78,7 @@ HB_EXPORT BOOL WINAPI DllEntryPoint( HINSTANCE hInstance, DWORD fdwReason, PVOID
break;
case DLL_PROCESS_DETACH:
/* hb_vmQuit(); */
hb_vmQuit();
break;
}

6
harbour/source/vm/mainpm.c
View File

@@ -61,6 +61,7 @@
int main( int argc, char * argv[] )
{
int ;
HAB hab; /* Anchor Block handle */
HMQ hmq; /* Message Queue handle */
@@ -69,13 +70,12 @@ int main( int argc, char * argv[] )
hb_cmdargInit( argc, argv );
hb_vmInit( TRUE );
iErrorCode = hb_vmQuit();
WinDestroyMsgQueue( hmq );
WinTerminate( hab );
hb_vmQuit();
return 0;
return iErrorCode;
}

7
harbour/source/vm/mainstd.c
View File

@@ -64,12 +64,7 @@ int main( int argc, char * argv[] )
hb_cmdargInit( argc, argv );
hb_vmInit( TRUE );
hb_vmQuit();
/* NOTE: The exit value is set by exit() */
/* NOTE: This point is never reached */
return 0;
return hb_vmQuit();
}
#if defined(__DJGPP__)

12
harbour/source/vm/mainwin.c
View File

@@ -76,6 +76,7 @@ int WINAPI WinMain( HINSTANCE hInstance, /* handle to current instance */
{
LPSTR pArgs, pArg, pDst, pSrc;
BOOL fQuoted;
int iErrorCode;
#ifdef HB_INCLUDE_WINEXCHANDLER
{
@@ -130,16 +131,13 @@ int WINAPI WinMain( HINSTANCE hInstance, /* handle to current instance */
hb_winmainArgInit( hInstance, hPrevInstance, iCmdShow );
hb_cmdargInit( s_argc, s_argv );
hb_vmInit( TRUE );
hb_vmQuit();
iErrorCode = hb_vmQuit();
LocalFree( pArgs ); /* QUESTION: It seems we never reach here,
so how may we free it ? */
LocalFree( pArgs );
/* NOTE: The exit value is set by exit() */
/* NOTE: This point is never reached */
return 0;
return iErrorCode;
}
#if ( defined(__WATCOMC__) || defined(__MINGW32__) ) && !defined(__EXPORT__)

20
harbour/source/vm/proc.c
View File

@@ -202,7 +202,8 @@ char * hb_procname( int iLevel, char * szName, BOOL bSkipBlock )
pSelf = hb_stackItem( lOffset );
}
if( strcmp( pBase->item.asSymbol.value->szName, "EVAL" ) == 0 )
if( pBase->item.asSymbol.value == &hb_symEval ||
strcmp( pBase->item.asSymbol.value->szName, "EVAL" ) == 0 )
{
strcpy( szName, "(b)" );
@@ -250,20 +251,17 @@ BOOL hb_procinfo( int iLevel, char * szName, USHORT * puiLine, char * szFile )
strcat( szName, ":" );
strcat( szName, pSym->szName );
}
else
else if( pSym == &hb_symEval || strcmp( pSym->szName, "EVAL" ) == 0 )
{
if( pSym == &hb_symEval || strcmp( pSym->szName, "EVAL" ) == 0 )
{
strcpy( szName, "(b)" );
strcpy( szName, "(b)" );
if( HB_IS_BLOCK( pSelf ) )
strcat( szName, pSelf->item.asBlock.value->pDefSymb->szName );
else
strcat( szName, pSym->szName );
}
if( HB_IS_BLOCK( pSelf ) )
strcat( szName, pSelf->item.asBlock.value->pDefSymb->szName );
else
strcpy( szName, pSym->szName );
strcat( szName, pSym->szName );
}
else
strcpy( szName, pSym->szName );
}
if( puiLine )