From 1311b9d4ea27c0eebc1e623fa547ed6fea5c0614 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Tue, 14 Feb 2006 17:16:11 +0000 Subject: [PATCH] 2006-02-14 18:15 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/compiler/harbour.c * enabled FM statistic by default when compiled without: -DHB_FM_STATISTICS_OFF after last Ryszard modification there is no memory leak in valid .prg code so this may help us to find some unknown problems. * harbour/include/hbcomp.h * harbour/source/compiler/hbpcode.c * formatting * harbour/source/rdd/dbcmd.c * fixed GPF in DBF2TEXT when work are is not in use. * harbour/source/rdd/dbfntx/dbfntx1.c * disabled validation of unused index pages - Clipper left them dirty so xHarbour reported that index is corrupted * harbour/source/rtl/dbdelim.prg * generate 2001 RT error when work area is not in used() state before export file is created. * harbour/source/rtl/errorapi.c * set DOSERROR() to oError:OSCODE when RT error is generated It's documented Clipper behavior. * harbour/source/vm/hvm.c * some fixes in new operators and removed unnecessary long->double->long conventions --- harbour/ChangeLog | 33 +++++++- harbour/include/hbcomp.h | 3 +- harbour/source/compiler/harbour.c | 2 +- harbour/source/compiler/hbpcode.c | 1 - harbour/source/rdd/dbcmd.c | 6 ++ harbour/source/rdd/dbfntx/dbfntx1.c | 11 ++- harbour/source/rtl/dbdelim.prg | 31 +++++-- harbour/source/rtl/errorapi.c | 6 ++ harbour/source/vm/hvm.c | 124 ++++++---------------------- 9 files changed, 105 insertions(+), 112 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index b223b99bbc..4e18f891e4 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,36 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ * fixed <-x-> match marker +2006-02-14 18:15 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/source/compiler/harbour.c + * enabled FM statistic by default when compiled without: + -DHB_FM_STATISTICS_OFF + after last Ryszard modification there is no memory leak in valid + .prg code so this may help us to find some unknown problems. + + * harbour/include/hbcomp.h + * harbour/source/compiler/hbpcode.c + * formatting + + * harbour/source/rdd/dbcmd.c + * fixed GPF in DBF2TEXT when work are is not in use. + + * harbour/source/rdd/dbfntx/dbfntx1.c + * disabled validation of unused index pages - Clipper left them + dirty so xHarbour reported that index is corrupted + + * harbour/source/rtl/dbdelim.prg + * generate 2001 RT error when work area is not in used() state + before export file is created. + + * harbour/source/rtl/errorapi.c + * set DOSERROR() to oError:OSCODE when RT error is generated + It's documented Clipper behavior. + + * harbour/source/vm/hvm.c + * some fixes in new operators and removed unnecessary + long->double->long conventions + 2006-02-14 16:10 UTC+0100 Ryszard Glab * include/hbapiitm.h * include/hbexpra.c @@ -33,13 +63,12 @@ * source/compiler/exproptc.c * source/macro/macroc.c * disabled optimalization of compound assignment in macro compiler - + 2006-02-14 13:40 UTC+0100 Ryszard Glab * include/hbexprc.c * source/compiler/exproptc.c * source/macro/macroc.c * disabled optimalization of compound assignment for fields - 2006-02-14 11:40 UTC+0100 Ryszard Glab * include/hbapiitm.h diff --git a/harbour/include/hbcomp.h b/harbour/include/hbcomp.h index 931d7e359c..42557d19ed 100644 --- a/harbour/include/hbcomp.h +++ b/harbour/include/hbcomp.h @@ -587,7 +587,7 @@ extern FILE *hb_comp_errFile; #define HB_COMPFLAG_HARBOUR 1 /* -kh */ #define HB_COMPFLAG_XBASE 2 /* -kx */ #define HB_COMPFLAG_HB_INLINE 4 /* -ki */ -#define HB_COMPFLAG_ARRSTR 8 /* -ks strings as array of bytes */ +#define HB_COMPFLAG_ARRSTR 8 /* -ks strings as array of bytes */ #define HB_COMPFLAG_OPTJUMP 16 /* -kj turn off jump optimalization */ #define HB_COMPFLAG_RT_MACRO 64 /* -kr */ @@ -600,4 +600,3 @@ extern FILE *hb_comp_errFile; HB_EXTERN_END #endif /* HB_COMP_H_ */ - diff --git a/harbour/source/compiler/harbour.c b/harbour/source/compiler/harbour.c index e576c13da5..2169c047f1 100644 --- a/harbour/source/compiler/harbour.c +++ b/harbour/source/compiler/harbour.c @@ -412,7 +412,7 @@ int isatty( int handle ) /* remove this 'undef' when number of memory leaks will be reduced to reasonable size */ -#undef HB_FM_STATISTICS +/* #undef HB_FM_STATISTICS */ #ifdef HB_FM_STATISTICS diff --git a/harbour/source/compiler/hbpcode.c b/harbour/source/compiler/hbpcode.c index 532380fba8..9d485a1e55 100644 --- a/harbour/source/compiler/hbpcode.c +++ b/harbour/source/compiler/hbpcode.c @@ -222,7 +222,6 @@ void hb_compPCodeEval( PFUNCTION pFunc, HB_PCODE_FUNC_PTR * pFunctions, void * c ++ulPos; } } - } void hb_compPCodeTrace( PFUNCTION pFunc, HB_PCODE_FUNC_PTR * pFunctions, void * cargo ) diff --git a/harbour/source/rdd/dbcmd.c b/harbour/source/rdd/dbcmd.c index 63aa982b99..34155e98c2 100644 --- a/harbour/source/rdd/dbcmd.c +++ b/harbour/source/rdd/dbcmd.c @@ -4634,6 +4634,12 @@ HB_FUNC( DBF2TEXT ) BOOL bNoFieldPassed = ( pFields == NULL || hb_arrayLen( pFields ) == 0 ); + if( !pArea ) + { + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, "COPY TO" ); + return; + } + if( ! handle ) { hb_errRT_DBCMD( EG_ARG, EDBCMD_EVAL_BADPARAMETER, NULL, "DBF2TEXT" ); diff --git a/harbour/source/rdd/dbfntx/dbfntx1.c b/harbour/source/rdd/dbfntx/dbfntx1.c index ab5b7e5d81..2a08b5b2ca 100644 --- a/harbour/source/rdd/dbfntx/dbfntx1.c +++ b/harbour/source/rdd/dbfntx/dbfntx1.c @@ -1306,7 +1306,8 @@ static LPPAGEINFO hb_ntxPageNew( LPTAGINFO pTag, BOOL fNull ) if( pTag->Owner->NextAvail != 0 ) { - /* Handling of a pool of empty pages. + /* + Handling of a pool of empty pages. Some sources says that this address is in the first 4 bytes of a page ( http://www.e-bachmann.dk/docs/xbase.htm ). But as I understood, studying dumps of Clipper ntx'es, address of the @@ -1317,12 +1318,20 @@ static LPPAGEINFO hb_ntxPageNew( LPTAGINFO pTag, BOOL fNull ) pPage = hb_ntxPageLoad( pTag, pTag->Owner->NextAvail ); if( ! pPage ) return NULL; + /* + Unfortunately Clipper does not left unused index pages clean and + the key counter can be set to non zero value so to make possible + concurrent index access from Clipper and xHarbour it's necessary + to disable the check code below. [druzus] + */ +#if 0 if( pPage->uiKeys != 0 ) { hb_ntxErrorRT( pTag->Owner->Owner, EG_CORRUPTION, EDBF_CORRUPT, pTag->Owner->IndexName, 0, 0 ); return NULL; } +#endif pTag->Owner->NextAvail = hb_ntxGetKeyPage( pPage, 0 ); #if defined( HB_NTX_NOMULTITAG ) hb_ntxSetKeyPage( pPage, 0, 0 ); diff --git a/harbour/source/rtl/dbdelim.prg b/harbour/source/rtl/dbdelim.prg index 32c44047be..57d559d041 100644 --- a/harbour/source/rtl/dbdelim.prg +++ b/harbour/source/rtl/dbdelim.prg @@ -84,6 +84,7 @@ local cCharEol:=HB_OSNewLine() local nLenEol:=LEN(cCharEol) local nPosLasteol local lcisonoeol +local lErrResult //------------------ // Process the delimiter argument. IF !EMPTY( cDelimArg ) @@ -136,20 +137,36 @@ local lcisonoeol IF lExport // COPY TO DELIMITED - handle := FCREATE( cFileName ) - IF handle == -1 + IF !USED() oErr := ErrorNew() oErr:severity := ES_ERROR - oErr:genCode := EG_CREATE + oErr:genCode := EG_NOTABLE oErr:subSystem := "DELIM" - oErr:subCode := 1002 + oErr:subCode := 2001 oErr:description := HB_LANGERRMSG( oErr:genCode ) - oErr:canRetry := .T. + oErr:canRetry := .F. oErr:canDefault := .T. - oErr:fileName := cFileName - oErr:osCode := FERROR() Eval(ErrorBlock(), oErr) + handle := -1 ELSE + WHILE ( handle := FCREATE( cFileName ) ) == -1 + oErr := ErrorNew() + oErr:severity := ES_ERROR + oErr:genCode := EG_CREATE + oErr:subSystem := "DELIM" + oErr:subCode := 1002 + oErr:description := HB_LANGERRMSG( oErr:genCode ) + oErr:canRetry := .T. + oErr:canDefault := .T. + oErr:fileName := cFileName + oErr:osCode := FERROR() + lErrResult := Eval(ErrorBlock(), oErr) + IF VALTYPE( lErrResult ) != "L" .OR. !lErrResult + EXIT + ENDIF + ENDDO + ENDIF + IF handle != -1 IF nStart > -1 // Only reposition if a starting record was specified or implied. IF nStart == 0 diff --git a/harbour/source/rtl/errorapi.c b/harbour/source/rtl/errorapi.c index 0c7e48b210..6cbba0aab3 100644 --- a/harbour/source/rtl/errorapi.c +++ b/harbour/source/rtl/errorapi.c @@ -206,6 +206,9 @@ USHORT hb_errLaunch( PHB_ITEM pError ) s_iLaunchCount++; + /* set DOSERROR() to last OS error code */ + s_uiErrorDOS = hb_errGetOsCode( pError ); + if( s_errorHandler ) { /* there is a low-level error handler defined - use it instead @@ -309,6 +312,9 @@ PHB_ITEM hb_errLaunchSubst( PHB_ITEM pError ) s_iLaunchCount++; + /* set DOSERROR() to last OS error code */ + s_uiErrorDOS = hb_errGetOsCode( pError ); + if( s_errorHandler ) { /* there is a low-level error handler defined - use it instead diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index df13591391..fc52ffa31d 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -2111,10 +2111,6 @@ static void hb_vmPlus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIte { hb_itemPutNDDec( pResult, ( double ) lNumber1 + ( double ) lNumber2, 0 ); } - while( iPopCnt-- > 0 ) - { - hb_stackDec(); - } } else if( HB_IS_NUMERIC( pItem1 ) && HB_IS_NUMERIC( pItem2 ) ) { @@ -2123,10 +2119,6 @@ static void hb_vmPlus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIte double dNumber2 = hb_itemGetNDDec( pItem2, &iDec2 ); hb_itemPutNumType( pResult, dNumber1 + dNumber2, ( ( iDec1 > iDec2 ) ? iDec1 : iDec2 ), iType1, iType2 ); - while( iPopCnt-- > 0 ) - { - hb_stackDec(); - } } else if( HB_IS_STRING( pItem1 ) && HB_IS_STRING( pItem2 ) ) { @@ -2140,10 +2132,6 @@ static void hb_vmPlus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIte hb_xmemcpy( szNewString, pItem1->item.asString.value, ulLen1 ); hb_xmemcpy( szNewString + ulLen1, pItem2->item.asString.value, ulLen2 ); hb_itemPutCPtr( pResult, szNewString, ulLen1 + ulLen2 ); - while( iPopCnt-- > 0 ) - { - hb_stackPop(); - } } else hb_errRT_BASE( EG_STROVERFLOW, 1209, NULL, "+", 2, pItem1, pItem2 ); @@ -2151,28 +2139,20 @@ static void hb_vmPlus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIte else if( HB_IS_DATE( pItem1 ) && HB_IS_DATE( pItem2 ) ) { /* NOTE: This is not a bug. CA-Cl*pper does exactly that. */ - hb_itemPutDL( pResult, ( long ) hb_itemGetND( pItem1 ) + ( long ) hb_itemGetND( pItem2 ) ); - while( iPopCnt-- > 0 ) - { - hb_stackDec(); - } + hb_itemPutDL( pResult, hb_itemGetNL( pItem1 ) + hb_itemGetNL( pItem2 ) ); } else if( HB_IS_DATE( pItem1 ) && HB_IS_NUMERIC( pItem2 ) ) { - hb_itemPutDL( pResult, ( long ) hb_itemGetND( pItem1 ) + ( long ) hb_itemGetND( pItem1 ) ); - while( iPopCnt-- > 0 ) - { - hb_stackDec(); - } + hb_itemPutDL( pResult, hb_itemGetDL( pItem1 ) + hb_itemGetNL( pItem2 ) ); + } + else if( HB_IS_NUMERIC( pItem1 ) && HB_IS_DATE( pItem2 ) ) + { + hb_itemPutDL( pResult, hb_itemGetNL( pItem1 ) + hb_itemGetDL( pItem2 ) ); } else if( HB_IS_OBJECT( pItem1 ) && hb_objHasMsg( pItem1, "__OpPlus" ) ) { hb_vmOperatorCall( pResult, pItem1, pItem2, "__OPPLUS" ); --iPopCnt; /* hb_vmOperatorCall pops pItem2 */ - while( iPopCnt-- > 0 ) - { - hb_stackPop(); - } } else { @@ -2183,10 +2163,10 @@ static void hb_vmPlus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIte hb_itemForwardValue( pResult, pSubst ); hb_itemRelease( pSubst ); } - while( iPopCnt-- > 0 ) - { - hb_stackPop(); - } + } + while( --iPopCnt >= 0 ) + { + hb_stackDec(); } } @@ -2208,10 +2188,6 @@ static void hb_vmMinus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIt { hb_itemPutNDDec( pResult, ( double ) lNumber1 - ( double ) lNumber2, 0 ); } - while( iPopCnt-- > 0 ) - { - hb_stackDec(); - } } else if( HB_IS_NUMERIC( pItem1 ) && HB_IS_NUMERIC( pItem2 ) ) { @@ -2220,26 +2196,14 @@ static void hb_vmMinus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIt double dNumber2 = hb_itemGetNDDec( pItem2, &iDec2 ); hb_itemPutNumType( pResult, dNumber1 - dNumber2, ( ( iDec1 > iDec2 ) ? iDec1 : iDec2 ), iType1, iType2 ); - while( iPopCnt-- > 0 ) - { - hb_stackDec(); - } } else if( HB_IS_DATE( pItem1 ) && HB_IS_DATE( pItem2 ) ) { - hb_itemPutNInt( pResult, ( long ) hb_itemGetND( pItem1 ) - ( long ) hb_itemGetND( pItem2 ) ); - while( iPopCnt-- > 0 ) - { - hb_stackDec(); - } + hb_itemPutNInt( pResult, hb_itemGetDL( pItem1 ) - hb_itemGetDL( pItem2 ) ); } else if( HB_IS_DATE( pItem1 ) && HB_IS_NUMERIC( pItem2 ) ) { - hb_itemPutNL( pResult, ( long ) hb_itemGetND( pItem1 ) - ( long ) hb_itemGetND( pItem1 ) ); - while( iPopCnt-- > 0 ) - { - hb_stackDec(); - } + hb_itemPutDL( pResult, hb_itemGetDL( pItem1 ) - hb_itemGetNL( pItem2 ) ); } else if( HB_IS_STRING( pItem1 ) && HB_IS_STRING( pItem2 ) ) { @@ -2258,10 +2222,6 @@ static void hb_vmMinus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIt hb_xmemcpy( szNewString + ulLen1, pItem2->item.asString.value, ulLen2 ); hb_xmemset( szNewString + ulLen1 + ulLen2, ' ', pItem1->item.asString.length - ulLen1 ); hb_itemPutCPtr( pResult, szNewString, ulNewLen ); - while( iPopCnt-- > 0 ) - { - hb_stackPop(); - } } else hb_errRT_BASE( EG_STROVERFLOW, 1210, NULL, "-", 2, pItem1, pItem2 ); @@ -2270,10 +2230,6 @@ static void hb_vmMinus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIt { hb_vmOperatorCall( pResult, pItem1, pItem2, "__OPMINUS" ); --iPopCnt; /* hb_vmOperatorCall pops pItem2 */ - while( iPopCnt-- > 0 ) - { - hb_stackPop(); - } } else { @@ -2284,10 +2240,10 @@ static void hb_vmMinus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIt hb_itemForwardValue( pResult, pSubst ); hb_itemRelease( pSubst ); } - while( iPopCnt-- > 0 ) - { - hb_stackPop(); - } + } + while( --iPopCnt >= 0 ) + { + hb_stackDec(); } } @@ -2312,20 +2268,12 @@ static void hb_vmMult( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIte double dNumber2 = hb_itemGetNDDec( pItem2, &iDec2 ); hb_itemPutNumType( pResult, dNumber1 * dNumber2, iDec1 + iDec2, iType1, iType2 ); - while( iPopCnt-- > 0 ) - { - hb_stackDec(); - } } else if( HB_IS_OBJECT( pItem1 ) && hb_objHasMsg( pItem1, "__OpMult" ) ) { hb_vmOperatorCall( pResult, pItem1, pItem2, "__OPMULT" ); --iPopCnt; /* hb_vmOperatorCall pops pItem2 */ - while( iPopCnt-- > 0 ) - { - hb_stackPop(); - } } else { @@ -2336,10 +2284,10 @@ static void hb_vmMult( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIte hb_itemForwardValue( pResult, pSubst ); hb_itemRelease( pSubst ); } - while( iPopCnt-- > 0 ) - { - hb_stackPop(); - } + } + while( --iPopCnt >= 0 ) + { + hb_stackPop(); } } @@ -2355,7 +2303,7 @@ static void hb_vmDivide( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pI { HB_LONG lDivisor = HB_ITEM_GET_NUMINTRAW( pItem2 ); - if ( lDivisor == 0 ) + if( lDivisor == 0 ) { PHB_ITEM pSubst = hb_errRT_BASE_Subst( EG_ZERODIV, 1340, NULL, "/", 2, pItem1, pItem2 ); @@ -2364,19 +2312,11 @@ static void hb_vmDivide( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pI hb_itemForwardValue( pResult, pSubst ); hb_itemRelease( pSubst ); } - while( iPopCnt-- > 0 ) - { - hb_stackPop(); - } } else { HB_LONG lNumber1 = HB_ITEM_GET_NUMINTRAW( pItem1 ); hb_itemPutNDDec( pResult, ( double ) lNumber1 / ( double ) lDivisor, hb_set.HB_SET_DECIMALS ); - while( iPopCnt-- > 0 ) - { - hb_stackDec(); - } } } else if( HB_IS_NUMERIC( pItem1 ) && HB_IS_NUMERIC( pItem2 ) ) @@ -2392,10 +2332,6 @@ static void hb_vmDivide( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pI hb_itemForwardValue( pResult, pSubst ); hb_itemRelease( pSubst ); } - while( iPopCnt-- > 0 ) - { - hb_stackPop(); - } } else { @@ -2409,20 +2345,12 @@ static void hb_vmDivide( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pI double dNumber1 = hb_itemGetND( pItem1 ); hb_itemPutNDDec( pResult, dNumber1 / dDivisor, hb_set.HB_SET_DECIMALS ); - while( iPopCnt-- > 0 ) - { - hb_stackDec(); - } } } else if( HB_IS_OBJECT( pItem1 ) && hb_objHasMsg( pItem1, "__OpDivide" ) ) { hb_vmOperatorCall( pResult, pItem1, pItem2, "__OPDIVIDE" ); --iPopCnt; /* hb_vmOperatorCall pops pItem2 */ - while( iPopCnt-- > 0 ) - { - hb_stackPop(); - } } else { @@ -2433,10 +2361,10 @@ static void hb_vmDivide( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pI hb_itemForwardValue( pResult, pSubst ); hb_itemRelease( pSubst ); } - while( iPopCnt-- > 0 ) - { - hb_stackPop(); - } + } + while( --iPopCnt >= 0 ) + { + hb_stackPop(); } } @@ -2473,7 +2401,7 @@ static void hb_vmModulus( void ) hb_stackDec(); /* NOTE: Clipper always returns the result of modulus with the SET number of decimal places. */ - if ( hb_set.HB_SET_DECIMALS == 0 ) + if( hb_set.HB_SET_DECIMALS == 0 ) hb_vmPushNumInt( HB_ITEM_GET_NUMINTRAW( pItem1 ) % lDivisor ); else hb_vmPushDouble( ( double ) ( HB_ITEM_GET_NUMINTRAW( pItem1 ) % lDivisor ), hb_set.HB_SET_DECIMALS );