From f844d53197b2b83ba7a9bb6d77d12afd4908fb1d Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Tue, 18 Jul 2006 01:30:23 +0000 Subject: [PATCH] 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 assigned to me --- harbour/ChangeLog | 27 ++++++++++++++++ harbour/TODO | 6 ++++ harbour/contrib/hgf/gtk/mainlgtk.c | 4 +-- harbour/doc/en/hb_vm.txt | 4 +-- harbour/doc/es/hb_vm.txt | 4 +-- harbour/include/hbvm.h | 2 +- harbour/source/compiler/gencc.c | 6 ++-- harbour/source/rtl/errorapi.c | 22 ++----------- harbour/source/rtl/gtalleg/gtalleg.c | 4 +-- harbour/source/vm/hvm.c | 46 +++++++++++++++------------- harbour/source/vm/maindll.c | 4 +-- harbour/source/vm/mainpm.c | 6 ++-- harbour/source/vm/mainstd.c | 7 +---- harbour/source/vm/mainwin.c | 12 +++----- harbour/source/vm/proc.c | 20 ++++++------ 15 files changed, 89 insertions(+), 85 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index da070e09bc..11f7900123 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,33 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ + ! 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 diff --git a/harbour/TODO b/harbour/TODO index e8a034c12a..bea1da3a11 100644 --- a/harbour/TODO +++ b/harbour/TODO @@ -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. + ======================================================================= diff --git a/harbour/contrib/hgf/gtk/mainlgtk.c b/harbour/contrib/hgf/gtk/mainlgtk.c index c6105141bb..4c2dfc85ff 100644 --- a/harbour/contrib/hgf/gtk/mainlgtk.c +++ b/harbour/contrib/hgf/gtk/mainlgtk.c @@ -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 { diff --git a/harbour/doc/en/hb_vm.txt b/harbour/doc/en/hb_vm.txt index 78d242ef58..1f9b2d6860 100644 --- a/harbour/doc/en/hb_vm.txt +++ b/harbour/doc/en/hb_vm.txt @@ -57,11 +57,11 @@ * C Prototype * * #include - * hb_vmQuit( void ) --> void + * hb_vmQuit( void ) --> int * $ARGUMENTS$ * * $RETURNS$ - * + * ERRORLEVEL code * $DESCRIPTION$ * * $EXAMPLES$ diff --git a/harbour/doc/es/hb_vm.txt b/harbour/doc/es/hb_vm.txt index 7559dcd51b..807260a3f5 100644 --- a/harbour/doc/es/hb_vm.txt +++ b/harbour/doc/es/hb_vm.txt @@ -71,11 +71,11 @@ * C Prototype * * #include - * hb_vmQuit( void ) --> void + * hb_vmQuit( void ) --> int * $ARGUMENTS$ * Ninguno * $RETURNS$ - * Nada + * ERRORLEVEL * $DESCRIPTION$ * Ocasiona la Inmediata salida de la M quina Virtual * $EXAMPLES$ diff --git a/harbour/include/hbvm.h b/harbour/include/hbvm.h index 26290c4858..c345f01ee1 100644 --- a/harbour/include/hbvm.h +++ b/harbour/include/hbvm.h @@ -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. diff --git a/harbour/source/compiler/gencc.c b/harbour/source/compiler/gencc.c index 9d528673b2..8c4839cc09 100644 --- a/harbour/source/compiler/gencc.c +++ b/harbour/source/compiler/gencc.c @@ -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; } diff --git a/harbour/source/rtl/errorapi.c b/harbour/source/rtl/errorapi.c index 8365ba29da..335d712fd4 100644 --- a/harbour/source/rtl/errorapi.c +++ b/harbour/source/rtl/errorapi.c @@ -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 ); diff --git a/harbour/source/rtl/gtalleg/gtalleg.c b/harbour/source/rtl/gtalleg/gtalleg.c index 7f0e8b25c2..3757e11053 100644 --- a/harbour/source/rtl/gtalleg/gtalleg.c +++ b/harbour/source/rtl/gtalleg/gtalleg.c @@ -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; diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 5a8fc27413..94e78a56ad 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -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; } diff --git a/harbour/source/vm/maindll.c b/harbour/source/vm/maindll.c index 66dfc8abd5..ac03ad3e1b 100644 --- a/harbour/source/vm/maindll.c +++ b/harbour/source/vm/maindll.c @@ -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; } diff --git a/harbour/source/vm/mainpm.c b/harbour/source/vm/mainpm.c index 8ea04d46d6..f59757cc39 100644 --- a/harbour/source/vm/mainpm.c +++ b/harbour/source/vm/mainpm.c @@ -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; } diff --git a/harbour/source/vm/mainstd.c b/harbour/source/vm/mainstd.c index cdcb54954e..68ea27d5a0 100644 --- a/harbour/source/vm/mainstd.c +++ b/harbour/source/vm/mainstd.c @@ -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__) diff --git a/harbour/source/vm/mainwin.c b/harbour/source/vm/mainwin.c index 2f00a51c44..1bd30a4f11 100644 --- a/harbour/source/vm/mainwin.c +++ b/harbour/source/vm/mainwin.c @@ -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__) diff --git a/harbour/source/vm/proc.c b/harbour/source/vm/proc.c index 3a01edfbdf..54be8a4391 100644 --- a/harbour/source/vm/proc.c +++ b/harbour/source/vm/proc.c @@ -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 )