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

2006-02-14 18:15 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* 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
This commit is contained in:
Przemyslaw Czerpak
2006-02-14 17:16:11 +00:00
parent e92af8dbd2
commit 1311b9d4ea
9 changed files with 105 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
harbour/ChangeLog
View File

@@ -8,6 +8,36 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
* 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 <rglab@imid.med.pl>
* 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 <rglab@imid.med.pl>
* 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 <rglab@imid.med.pl>
* include/hbapiitm.h

3
harbour/include/hbcomp.h
View File

@@ -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_ */

2
harbour/source/compiler/harbour.c
View File

@@ -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

1
harbour/source/compiler/hbpcode.c
View File

@@ -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 )

6
harbour/source/rdd/dbcmd.c
View File

@@ -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" );

11
harbour/source/rdd/dbfntx/dbfntx1.c
View File

@@ -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 );

31
harbour/source/rtl/dbdelim.prg
View File

@@ -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

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

@@ -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

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

@@ -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 );