From 130a3239d2a1b7f62a241dbf17b5704c59fcabbe Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Fri, 7 Apr 2006 12:57:59 +0000 Subject: [PATCH] 2006-04-07 15:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/bin/hb-func.sh * support for detecting startup function in C++ mode * harbour/include/hbapi.h * some few #defines to translate some xHarbour functions names to Harbour * harbour/include/hbxvm.h * harbour/source/compiler/gencc.c * harbour/source/vm/hvm.c * harbour/source/vm/itemapi.c * harbour/source/common/hbdate.c + added optimizations for add and div by integer value * changed code generated for double values to avoid limitation in some C compilers like MSC and possible differ conversion inside C RTL then the one which uses Harbour RTL * some minor optimizations, cleanups and code formating * harbour/source/compiler/hbfix.c * optimize usage of HB_P_NOT PCODE - remove repeated NOT operations or revert conditional jumps if they are just after NOT. * harbour/source/rdd/dbf1.c * added support for NULL value set in memo fields by ACCESS * harbour/source/rdd/dbfcdx/dbfcdx1.c * fixed ordKeyPos() - for records out of scope * harbour/source/rtl/padc.c * harbour/source/rtl/padl.c * harbour/source/rtl/padr.c * harbour/source/rtl/substr.c * some minor optimizations to avoid new string item creation when it's not necessary * harbour/source/vm/classes.c * harbour/source/vm/extend.c * minor code formatting and optimizations --- harbour/ChangeLog | 41 ++- harbour/bin/hb-func.sh | 2 +- harbour/include/hbapi.h | 7 +- harbour/include/hbxvm.h | 4 +- harbour/source/common/hbdate.c | 68 ++--- harbour/source/compiler/gencc.c | 85 +++++-- harbour/source/compiler/hbfix.c | 48 +++- harbour/source/rdd/dbf1.c | 8 +- harbour/source/rdd/dbfcdx/dbfcdx1.c | 2 +- harbour/source/rtl/padc.c | 63 ++--- harbour/source/rtl/padl.c | 55 +++-- harbour/source/rtl/padr.c | 55 +++-- harbour/source/rtl/substr.c | 18 +- harbour/source/vm/classes.c | 52 ++-- harbour/source/vm/extend.c | 35 +-- harbour/source/vm/hvm.c | 370 ++++++++++++++++------------ harbour/source/vm/itemapi.c | 38 ++- 17 files changed, 583 insertions(+), 368 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 034ad20caf..230b9e8391 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,13 +8,52 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ + * harbour/source/vm/classes.c + % hb_dynsymGet() calls replaced with hb_dynsymGetCase() where the + of 25 times for most cases. + ! Possible problem fixed in __CLSADDMSG() where message parameter + was required to be uppercase when overloading operator .NOT., + .AND. or .OR. + % hb_dynsymGet() calls replaced with hb_dynsymGetCase() where the + parameter was an already uppercased constant. + + * harbour/source/vm/dynsym.c + ! Fixed HB_TRACE() function name in hb_dynsymGetCase(). + +2006-04-07 15:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/bin/hb-func.sh + * support for detecting startup function in C++ mode + + * harbour/include/hbapi.h + * some few #defines to translate some xHarbour functions names to Harbour + + * harbour/include/hbxvm.h + * harbour/source/compiler/gencc.c + * harbour/source/vm/hvm.c + * harbour/source/vm/itemapi.c + * harbour/source/common/hbdate.c + + added optimizations for add and div by integer value + * changed code generated for double values to avoid limitation in some + C compilers like MSC and possible differ conversion inside C RTL then + the one which uses Harbour RTL + * some minor optimizations, cleanups and code formating + + * harbour/source/compiler/hbfix.c + * optimize usage of HB_P_NOT PCODE - remove repeated NOT operations + or revert conditional jumps if they are just after NOT. + + * harbour/source/rdd/dbf1.c + * added support for NULL value set in memo fields by ACCESS + + * harbour/source/rdd/dbfcdx/dbfcdx1.c + * fixed ordKeyPos() - for records out of scope + * harbour/source/rtl/padc.c * harbour/source/rtl/padl.c * harbour/source/rtl/padr.c * harbour/source/rtl/substr.c * some minor optimizations to avoid new string item creation when it's not necessary - * harbour/source/vm/classes.c * harbour/source/vm/extend.c diff --git a/harbour/bin/hb-func.sh b/harbour/bin/hb-func.sh index 6485815435..e222371e27 100644 --- a/harbour/bin/hb-func.sh +++ b/harbour/bin/hb-func.sh @@ -466,7 +466,7 @@ hb_lnk_request() hb_lnk_main() { - (${CCPREFIX}nm \$1 -g -n --defined-only|sed -e '/HB_FUN_/ ! d' -e 's/^[0-9a-fA-F]* T HB_FUN_//'|head -1|grep -v '^MAIN\$')2>/dev/null + (${CCPREFIX}nm \$1 -g -n --defined-only -C|sed -e '/ HB_FUN_/ ! d' -e 's/^[0-9a-fA-F]* T HB_FUN_\([A-Z0-9_]*\).*/\1/'|head -1|grep -v '^MAIN\$')2>/dev/null # (${CCPREFIX}nm \$1 -n --defined-only|sed -e '/HB_FUN_/ ! d' -e 's/^[0-9a-fA-F]* [Tt] HB_FUN_//'|head -1|grep -v '^MAIN\$')2>/dev/null } diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 0c46e82b4c..444e816a99 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -402,6 +402,11 @@ extern HB_EXPORT BOOL hb_extIsObject( int iParam ); extern HB_EXPORT LONGLONG hb_parnll( int iParam, ... ); /* retrieve a numeric parameter as a long long */ #endif +/* xHarbour compatible function */ +#define hb_retcAdopt( szText ) hb_retc_buffer( (szText) ) +#define hb_retclenAdopt( szText, ulLen ) hb_retclen_buffer( (szText), (ulLen) ) +#define hb_retcStatic( szText ) hb_retc_const( (szText) ) + #ifdef HB_API_MACROS #define hb_pcount() ( ( int ) ( hb_stackBaseItem() )->item.asSymbol.paramcnt ) @@ -413,7 +418,6 @@ extern HB_EXPORT LONGLONG hb_parnll( int iParam, ... ); /* retrieve a numeric #define hb_retc_const( szText ) hb_itemPutCConst( hb_stackReturnItem(), szText ) #define hb_retclen( szText, ulLen ) hb_itemPutCL( hb_stackReturnItem(), szText, ulLen ) #define hb_retclen_buffer( szText, ulLen ) hb_itemPutCPtr( hb_stackReturnItem(), szText, ulLen ) -#define hb_retcAdopt( szText ) hb_itemPutCPtr( hb_stackReturnItem(), (szText), strlen( szText ) ) #define hb_retds( szDate ) hb_itemPutDS( hb_stackReturnItem(), szDate ) #define hb_retd( iYear, iMonth, iDay ) hb_itemPutD( hb_stackReturnItem(), iYear, iMonth, iDay ) #define hb_retdl( lJulian ) hb_itemPutDL( hb_stackReturnItem(), lJulian ) @@ -440,7 +444,6 @@ extern HB_EXPORT void hb_retc_buffer( char * szText ); /* sames as above, but extern HB_EXPORT void hb_retc_const( const char * szText ); /* returns a string as a pcode based string */ extern HB_EXPORT void hb_retclen( const char * szText, ULONG ulLen ); /* returns a string with a specific length */ extern HB_EXPORT void hb_retclen_buffer( char * szText, ULONG ulLen ); /* sames as above, but accepts an allocated buffer */ -extern HB_EXPORT void hb_retcAdopt( char * szText ); /* adopts a pointer to a string as the value of an item */ extern HB_EXPORT void hb_retds( const char * szDate ); /* returns a date, must use yyyymmdd format */ extern HB_EXPORT void hb_retd( int iYear, int iMonth, int iDay ); /* returns a date */ extern HB_EXPORT void hb_retdl( long lJulian ); /* returns a long value as a julian date */ diff --git a/harbour/include/hbxvm.h b/harbour/include/hbxvm.h index 7e2ec62148..cb971c3dbc 100644 --- a/harbour/include/hbxvm.h +++ b/harbour/include/hbxvm.h @@ -117,7 +117,7 @@ extern HB_EXPORT BOOL hb_xvmPushAlias( void ); extern HB_EXPORT BOOL hb_xvmPopAlias( void ); /* select the workarea using a given item or a substituted value */ extern HB_EXPORT BOOL hb_xvmPopLogical( BOOL * ); /* pops the stack latest value and returns its logical value */ extern HB_EXPORT BOOL hb_xvmSwapAlias( void ); /* swaps items on the eval stack and pops the workarea number */ -extern HB_EXPORT BOOL hb_xvmLocalAddInt( int iLocal, int iAdd ); /* add integer to given local variable */ +extern HB_EXPORT BOOL hb_xvmLocalAddInt( int iLocal, LONG lAdd ); /* add integer to given local variable */ extern HB_EXPORT BOOL hb_xvmAnd( void ); extern HB_EXPORT BOOL hb_xvmOr( void ); @@ -196,6 +196,8 @@ extern HB_EXPORT void hb_xvmPushLongLong( LONGLONG llNumber ); extern HB_EXPORT BOOL hb_xvmArrayItemPush( ULONG ulIndex ); extern HB_EXPORT BOOL hb_xvmArrayItemPop( ULONG ulIndex ); extern HB_EXPORT BOOL hb_xvmMultByInt( LONG lValue ); +extern HB_EXPORT BOOL hb_xvmDivideByInt( LONG lValue ); +extern HB_EXPORT BOOL hb_xvmAddInt( LONG lValue ); HB_EXTERN_END diff --git a/harbour/source/common/hbdate.c b/harbour/source/common/hbdate.c index 32a56d603e..3a39b4ae1e 100644 --- a/harbour/source/common/hbdate.c +++ b/harbour/source/common/hbdate.c @@ -170,6 +170,40 @@ HB_EXPORT void hb_dateStrGet( const char * szDate, int * piYear, int * piMonth, } } +/* This function always closes the date with a zero byte, so it needs a + 9 character long buffer. */ + +HB_EXPORT char * hb_dateDecStr( char * szDate, LONG lJulian ) +{ + int iYear, iMonth, iDay; + + HB_TRACE(HB_TR_DEBUG, ("hb_dateDecStr(%p, %ld)", szDate, lJulian)); + + if( lJulian <= 0 ) + { + memset( szDate, ' ', 8 ); + } + else + { + hb_dateDecode( lJulian, &iYear, &iMonth, &iDay ); + hb_dateStrPut( szDate, iYear, iMonth, iDay ); + } + szDate[ 8 ] = '\0'; + + return szDate; +} + +HB_EXPORT LONG hb_dateEncStr( const char * szDate ) +{ + int iYear, iMonth, iDay; + + HB_TRACE(HB_TR_DEBUG, ("hb_dateEncStr(%s)", szDate)); + + hb_dateStrGet( szDate, &iYear, &iMonth, &iDay ); + + return hb_dateEncode( iYear, iMonth, iDay ); +} + HB_EXPORT int hb_dateJulianDOW( LONG lJulian ) { HB_TRACE(HB_TR_DEBUG, ("hb_dateJulianDOW(%ld)", lJulian)); @@ -195,37 +229,3 @@ HB_EXPORT int hb_dateDOW( int iYear, int iMonth, int iDay ) return ( iDay + 26 * iMonth / 10 + iYear + iYear / 4 - iYear / 100 + iYear / 400 + 6 ) % 7 + 1; } - -/* This function always closes the date with a zero byte, so it needs a - 9 character long buffer. */ - -HB_EXPORT char * hb_dateDecStr( char * szDate, LONG lJulian ) -{ - int iYear, iMonth, iDay; - - HB_TRACE(HB_TR_DEBUG, ("hb_dateDecStr(%p, %ld)", szDate, lJulian)); - - if( lJulian == 0 ) - { - memset( szDate, ' ', 8 ); - } - else - { - hb_dateDecode( lJulian, &iYear, &iMonth, &iDay ); - hb_dateStrPut( szDate, iYear, iMonth, iDay ); - } - szDate[ 8 ] = '\0'; - - return szDate; -} - -HB_EXPORT LONG hb_dateEncStr( const char * szDate ) -{ - int iYear, iMonth, iDay; - - HB_TRACE(HB_TR_DEBUG, ("hb_dateEncStr(%s)", szDate)); - - hb_dateStrGet( szDate, &iYear, &iMonth, &iDay ); - - return hb_dateEncode( iYear, iMonth, iDay ); -} diff --git a/harbour/source/compiler/gencc.c b/harbour/source/compiler/gencc.c index b443b252ae..00cc438367 100644 --- a/harbour/source/compiler/gencc.c +++ b/harbour/source/compiler/gencc.c @@ -78,20 +78,41 @@ static void hb_gencc_string_put( FILE * yyc, BYTE * pText, USHORT usLen ) static int hb_gencc_checkNumAhead( LONG lValue, PFUNCTION pFunc, ULONG lPCodePos, PHB_LABEL_INFO cargo ) { - if( HB_GENC_GETLABEL( lPCodePos ) == 0 && lValue > 0 ) + if( HB_GENC_GETLABEL( lPCodePos ) == 0 ) { switch( pFunc->pCode[ lPCodePos ] ) { case HB_P_ARRAYPUSH: - fprintf( cargo->yyc, "\tif( hb_xvmArrayItemPush( %ld ) ) break;\n", lValue ); - return 1; + if( lValue > 0 ) + { + fprintf( cargo->yyc, "\tif( hb_xvmArrayItemPush( %ld ) ) break;\n", lValue ); + return 1; + } + break; case HB_P_ARRAYPOP: - fprintf( cargo->yyc, "\tif( hb_xvmArrayItemPop( %ld ) ) break;\n", lValue ); - return 1; + if( lValue > 0 ) + { + fprintf( cargo->yyc, "\tif( hb_xvmArrayItemPop( %ld ) ) break;\n", lValue ); + return 1; + } + break; + case HB_P_MULT: fprintf( cargo->yyc, "\tif( hb_xvmMultByInt( %ld ) ) break;\n", lValue ); return 1; + + case HB_P_DIVIDE: + fprintf( cargo->yyc, "\tif( hb_xvmDivideByInt( %ld ) ) break;\n", lValue ); + return 1; + + case HB_P_PLUS: + fprintf( cargo->yyc, "\tif( hb_xvmAddInt( %ld ) ) break;\n", lValue ); + return 1; + + case HB_P_MINUS: + fprintf( cargo->yyc, "\tif( hb_xvmAddInt( -%ld ) ) break;\n", lValue ); + return 1; } } return 0; @@ -430,7 +451,7 @@ static HB_GENC_FUNC( hb_p_line ) { HB_GENC_LABEL(); - fprintf( cargo->yyc, "\thb_xvmSetLine( %d );\n", + fprintf( cargo->yyc, "\thb_xvmSetLine( %d );\n", HB_PCODE_MKUSHORT( &pFunc->pCode[ lPCodePos + 1 ] ) ); return 3; } @@ -561,7 +582,7 @@ static HB_GENC_FUNC( hb_p_message ) { HB_GENC_LABEL(); - fprintf( cargo->yyc, "\thb_xvmPushSymbol( symbols + %hu );\n", + fprintf( cargo->yyc, "\thb_xvmPushSymbol( symbols + %hu );\n", HB_PCODE_MKUSHORT( &pFunc->pCode[ lPCodePos + 1 ] ) ); return 3; } @@ -845,12 +866,22 @@ static HB_GENC_FUNC( hb_p_pushdouble ) { HB_GENC_LABEL(); +#if 0 fprintf( cargo->yyc, "\thb_xvmPushDouble( %.*f, %d, %d );\n", pFunc->pCode[ lPCodePos + 1 + sizeof( double ) + sizeof( BYTE ) ] + 1, HB_PCODE_MKDOUBLE( &pFunc->pCode[ lPCodePos + 1 ] ), pFunc->pCode[ lPCodePos + 1 + sizeof( double ) ], pFunc->pCode[ lPCodePos + 1 + sizeof( double ) + sizeof( BYTE ) ] ); - +#else + /* + * This version keeps double calculation compatible with RT FL functions + */ + fprintf( cargo->yyc, "\thb_xvmPushDouble( * ( double * ) " ); + hb_gencc_string_put( cargo->yyc, &pFunc->pCode[ lPCodePos + 1 ], sizeof( double ) ); + fprintf( cargo->yyc, ", %d, %d );\n", + pFunc->pCode[ lPCodePos + 1 + sizeof( double ) ], + pFunc->pCode[ lPCodePos + 1 + sizeof( double ) + sizeof( BYTE ) ] ); +#endif return sizeof( double ) + sizeof( BYTE ) + sizeof( BYTE ) + 1; } @@ -918,28 +949,46 @@ static HB_GENC_FUNC( hb_p_pushlocalref ) static HB_GENC_FUNC( hb_p_pushlong ) { + LONG lVal = HB_PCODE_MKLONG( &pFunc->pCode[ lPCodePos + 1 ] ), iSkip; + HB_GENC_LABEL(); -#if HB_INT_MAX >= INT32_MAX - fprintf( cargo->yyc, "\thb_xvmPushInteger( %d );\n", ( int ) -#else - fprintf( cargo->yyc, "\thb_xvmPushLong( %ldL );\n", ( long ) -#endif - HB_PCODE_MKLONG( &pFunc->pCode[ lPCodePos + 1 ] ) ); + iSkip = hb_gencc_checkNumAhead( lVal, pFunc, lPCodePos + 5, cargo ); - return 5; + if( iSkip == 0 ) + { +#if HB_INT_MAX >= INT32_MAX + fprintf( cargo->yyc, "\thb_xvmPushInteger( %d );\n", ( int ) lVal ); +#else + fprintf( cargo->yyc, "\thb_xvmPushLong( %ldL );\n", ( long ) lVal ); +#endif + } + return 5 + iSkip; } static HB_GENC_FUNC( hb_p_pushlonglong ) { +#ifdef HB_LONG_LONG_OFF + HB_GENC_LABEL(); + fprintf( cargo->yyc, "\thb_xvmPushLongLong( %.1f );\n", HB_PCODE_MKLONGLONG( &pFunc->pCode[ lPCodePos + 1 ] ) ); + return 9; +#elif LONG_MAX == LONGLONG_MAX + LONGLONG llVal = HB_PCODE_MKLONGLONG( &pFunc->pCode[ lPCodePos + 1 ] ), iSkip; + HB_GENC_LABEL(); -#ifdef HB_LONG_LONG_OFF - fprintf( cargo->yyc, "\thb_xvmPushLongLong( %.0f );\n", HB_PCODE_MKLONGLONG( &pFunc->pCode[ lPCodePos + 1 ] ) ); + iSkip = hb_gencc_checkNumAhead( lVal, pFunc, lPCodePos + 9, cargo ); + + if( iSkip == 0 ) + { + fprintf( cargo->yyc, "\thb_xvmPushLong( %ldL );\n", ( long ) lVal ); + } + return 9 + iSkip; #else + HB_GENC_LABEL(); fprintf( cargo->yyc, "\thb_xvmPushLongLong( HB_LL( %" PFLL "i ) );\n", HB_PCODE_MKLONGLONG( &pFunc->pCode[ lPCodePos + 1 ] ) ); -#endif return 9; +#endif } static HB_GENC_FUNC( hb_p_pushmemvar ) diff --git a/harbour/source/compiler/hbfix.c b/harbour/source/compiler/hbfix.c index d9aad1eb9b..b055f8ba23 100644 --- a/harbour/source/compiler/hbfix.c +++ b/harbour/source/compiler/hbfix.c @@ -362,6 +362,52 @@ static HB_FIX_FUNC( hb_p_true ) return 1; } +static HB_FIX_FUNC( hb_p_not ) +{ + if( cargo->iNestedCodeblock == 0 ) + { + BYTE opcode; + + switch( pFunc->pCode[ lPCodePos + 1 ] ) + { + case HB_P_NOT: + opcode = HB_P_NOOP; + break; + case HB_P_JUMPTRUENEAR: + opcode = HB_P_JUMPFALSENEAR; + break; + case HB_P_JUMPTRUE: + opcode = HB_P_JUMPFALSE; + break; + case HB_P_JUMPTRUEFAR: + opcode = HB_P_JUMPFALSEFAR; + break; + case HB_P_JUMPFALSENEAR: + opcode = HB_P_JUMPTRUENEAR; + break; + case HB_P_JUMPFALSE: + opcode = HB_P_JUMPTRUE; + break; + case HB_P_JUMPFALSEFAR: + opcode = HB_P_JUMPTRUEFAR; + break; + default: + opcode = HB_P_LAST_PCODE; + break; + } + + if( opcode < HB_P_LAST_PCODE && ! hb_compIsJump( pFunc, lPCodePos + 1 ) ) + { + hb_compNOOPfill( pFunc, lPCodePos, 1, FALSE, FALSE ); + if( opcode == HB_P_NOOP ) + hb_compNOOPfill( pFunc, lPCodePos + 1, 1, FALSE, FALSE ); + else + pFunc->pCode[ lPCodePos + 1 ] = opcode; + } + } + return 1; +} + static HB_FIX_FUNC( hb_p_jumpfar ) { if( cargo->iNestedCodeblock == 0 && HB_COMP_ISSUPPORTED(HB_COMPFLAG_OPTJUMP) ) @@ -494,7 +540,7 @@ static HB_FIX_FUNC_PTR s_fixlocals_table[] = NULL, /* HB_P_MULT, */ NULL, /* HB_P_NEGATE, */ NULL, /* HB_P_NOOP, */ - NULL, /* HB_P_NOT, */ + hb_p_not, /* HB_P_NOT, */ NULL, /* HB_P_NOTEQUAL, */ NULL, /* HB_P_OR, */ NULL, /* HB_P_PARAMETER, */ diff --git a/harbour/source/rdd/dbf1.c b/harbour/source/rdd/dbf1.c index 04195084c5..0a2867f110 100644 --- a/harbour/source/rdd/dbf1.c +++ b/harbour/source/rdd/dbf1.c @@ -679,7 +679,11 @@ HB_EXPORT ERRCODE hb_dbfGetMemoData( DBFAREAP pArea, USHORT uiIndex, *pulBlock = HB_GET_LE_UINT32( pSMTFiled->block ); } } - else + /* + * check for NULL fields created by Access, they have chr(0) set + * in the whole memo block address, [druzus] + */ + else if( pArea->pRecord[ pArea->pFieldOffset[ uiIndex ] ] != 0 ) { USHORT uiCount; BYTE bByte; @@ -690,7 +694,7 @@ HB_EXPORT ERRCODE hb_dbfGetMemoData( DBFAREAP pArea, USHORT uiIndex, bByte = pArea->pRecord[ pArea->pFieldOffset[ uiIndex ] + uiCount ]; if( bByte >= '0' && bByte <= '9' ) ulValue = ulValue * 10 + ( bByte - '0' ); - else if( bByte != ' ' ) + else if( bByte != ' ' || ulValue ) return FAILURE; } *pulBlock = ulValue; diff --git a/harbour/source/rdd/dbfcdx/dbfcdx1.c b/harbour/source/rdd/dbfcdx/dbfcdx1.c index f8cd52ab7d..2ceb71c3aa 100644 --- a/harbour/source/rdd/dbfcdx/dbfcdx1.c +++ b/harbour/source/rdd/dbfcdx/dbfcdx1.c @@ -5750,7 +5750,7 @@ static LONG hb_cdxDBOIKeyNo( CDXAREAP pArea, LPCDXTAG pTag, BOOL fFilters ) { if ( pTag->topScopeKey || pTag->bottomScopeKey || pTag->UsrUnique || pArea->dbfi.fFilter ) { - if ( hb_cdxBottomScope( pTag ) && + if ( hb_cdxBottomScope( pTag ) && hb_cdxTopScope( pTag ) && ( !fCheckFilter || hb_cdxCheckRecordFilter( pArea, ulRecNo ) ) ) { diff --git a/harbour/source/rtl/padc.c b/harbour/source/rtl/padc.c index b1c92b35b2..c61f4a9429 100644 --- a/harbour/source/rtl/padc.c +++ b/harbour/source/rtl/padc.c @@ -60,45 +60,48 @@ HB_FUNC( PADC ) ULONG ulSize; BOOL bFreeReq; char * szText; + long lLen = hb_parnl( 2 ); - if ( ISNUM( 2 ) ) - szText = hb_itemPadConv( hb_param( 1, HB_IT_ANY ), &ulSize, &bFreeReq ); - else - szText = NULL; - - if( szText ) + if( lLen > 0 ) { - long lLen = hb_parnl( 2 ); + PHB_ITEM pItem = hb_param( 1, HB_IT_ANY ); - if( lLen > ( long ) ulSize ) + if( pItem && HB_IS_STRING( pItem ) && ( ULONG ) lLen == hb_itemGetCLen( pItem ) ) { - char * szResult = ( char * ) hb_xgrab( lLen + 1 ); - char cPad; - long w, lPos = ( lLen - ( long ) ulSize ) / 2; - - hb_xmemcpy( szResult + lPos, szText, ( long ) ulSize + 1 ); - - cPad = ( ISCHAR( 3 ) ? *hb_parc( 3 ) : ' ' ); - - for( w = 0; w < lPos; w++ ) - szResult[ w ] = cPad; - - for( w = ( long ) ulSize + lPos; w < lLen; w++ ) - szResult[ w ] = cPad; - - szResult[ lLen ] = '\0'; - - hb_retclen_buffer( szResult, lLen ); + hb_itemReturn( pItem ); } else { - if( lLen < 0 ) - lLen = 0; + szText = hb_itemPadConv( pItem, &ulSize, &bFreeReq ); + if( szText ) + { + if( ( ULONG ) lLen > ulSize ) + { + char * szResult = ( char * ) hb_xgrab( lLen + 1 ); + char cPad; + long ulPad = ( ( ULONG ) lLen - ulSize ) >> 1; - hb_retclen( szText, lLen ); + cPad = ( ISCHAR( 3 ) ? *( hb_parc( 3 ) ) : ' ' ); + hb_xmemset( szResult, cPad, ulPad ); + hb_xmemcpy( szResult + ulPad, szText, ulSize ); + hb_xmemset( szResult + ulPad + ulSize, cPad, + ( ULONG ) lLen - ulSize - ulPad ); + + hb_retclen_buffer( szResult, ( ULONG ) lLen ); + if ( bFreeReq ) + hb_xfree( szText ); + } + else + { + if ( bFreeReq ) + hb_retclen_buffer( szText, ( ULONG ) lLen ); + else + hb_retclen( szText, lLen ); + } + } + else + hb_retc( NULL ); } - if ( bFreeReq ) - hb_xfree( szText ); } else hb_retc( NULL ); diff --git a/harbour/source/rtl/padl.c b/harbour/source/rtl/padl.c index f243af5a38..8cf67a5077 100644 --- a/harbour/source/rtl/padl.c +++ b/harbour/source/rtl/padl.c @@ -60,40 +60,45 @@ HB_FUNC( PADL ) ULONG ulSize; BOOL bFreeReq; char * szText; + long lLen = hb_parnl( 2 ); - if ( ISNUM( 2 ) ) - szText = hb_itemPadConv( hb_param( 1, HB_IT_ANY ), &ulSize, &bFreeReq ); - else - szText = NULL; - - if( szText ) + if( lLen > 0 ) { - long lLen = hb_parnl( 2 ); + PHB_ITEM pItem = hb_param( 1, HB_IT_ANY ); - if( lLen > ( long ) ulSize ) + if( pItem && HB_IS_STRING( pItem ) && ( ULONG ) lLen == hb_itemGetCLen( pItem ) ) { - char * szResult = ( char * ) hb_xgrab( lLen + 1 ); - long lPos = lLen - ( long ) ulSize; - char cPad; - - hb_xmemcpy( szResult + lPos, szText, ( long ) ulSize ); - - cPad = ( ISCHAR( 3 ) ? *( hb_parc( 3 ) ) : ' ' ); - - for(; lPos > 0; lPos-- ) - szResult[ lPos - 1 ] = cPad; - - hb_retclen_buffer( szResult, lLen ); + hb_itemReturn( pItem ); } else { - if( lLen < 0 ) - lLen = 0; + szText = hb_itemPadConv( pItem, &ulSize, &bFreeReq ); + if( szText ) + { + if( ( ULONG ) lLen > ulSize ) + { + char * szResult = ( char * ) hb_xgrab( lLen + 1 ); + char cPad; - hb_retclen( szText, lLen ); + cPad = ( ISCHAR( 3 ) ? *( hb_parc( 3 ) ) : ' ' ); + hb_xmemset( szResult, cPad, ( ULONG ) lLen - ulSize ); + hb_xmemcpy( szResult + ( ULONG ) lLen - ulSize, szText, ulSize ); + + hb_retclen_buffer( szResult, ( ULONG ) lLen ); + if ( bFreeReq ) + hb_xfree( szText ); + } + else + { + if ( bFreeReq ) + hb_retclen_buffer( szText, ( ULONG ) lLen ); + else + hb_retclen( szText, lLen ); + } + } + else + hb_retc( NULL ); } - if ( bFreeReq ) - hb_xfree( szText ); } else hb_retc( NULL ); diff --git a/harbour/source/rtl/padr.c b/harbour/source/rtl/padr.c index 9682604988..4ffb1fc837 100644 --- a/harbour/source/rtl/padr.c +++ b/harbour/source/rtl/padr.c @@ -60,40 +60,45 @@ HB_FUNC( PADR ) ULONG ulSize; BOOL bFreeReq; char * szText; + long lLen = hb_parnl( 2 ); - if ( ISNUM( 2 ) ) - szText = hb_itemPadConv( hb_param( 1, HB_IT_ANY ), &ulSize, &bFreeReq ); - else - szText = NULL; - - if( szText ) + if( lLen > 0 ) { - long lLen = hb_parnl( 2 ); + PHB_ITEM pItem = hb_param( 1, HB_IT_ANY ); - if( lLen > ( long ) ulSize ) + if( pItem && HB_IS_STRING( pItem ) && ( ULONG ) lLen == hb_itemGetCLen( pItem ) ) { - char * szResult = ( char * ) hb_xgrab( lLen + 1 ); - long lPos; - char cPad; - - hb_xmemcpy( szResult, szText, ( long ) ulSize ); - - cPad = ( ISCHAR( 3 ) ? *( hb_parc( 3 ) ) : ' ' ); - - for( lPos = ( long ) ulSize; lPos < lLen; lPos++ ) - szResult[ lPos ] = cPad; - - hb_retclen_buffer( szResult, ( ULONG ) lLen ); + hb_itemReturn( pItem ); } else { - if( lLen < 0 ) - lLen = 0; + szText = hb_itemPadConv( pItem, &ulSize, &bFreeReq ); + if( szText ) + { + if( ( ULONG ) lLen > ulSize ) + { + char * szResult = ( char * ) hb_xgrab( lLen + 1 ); + char cPad; - hb_retclen( szText, lLen ); + cPad = ( ISCHAR( 3 ) ? *( hb_parc( 3 ) ) : ' ' ); + hb_xmemcpy( szResult, szText, ulSize ); + hb_xmemset( szResult + ulSize, cPad, ( ULONG ) lLen - ulSize ); + + hb_retclen_buffer( szResult, ( ULONG ) lLen ); + if ( bFreeReq ) + hb_xfree( szText ); + } + else + { + if ( bFreeReq ) + hb_retclen_buffer( szText, ( ULONG ) lLen ); + else + hb_retclen( szText, lLen ); + } + } + else + hb_retc( NULL ); } - if ( bFreeReq ) - hb_xfree( szText ); } else hb_retc( NULL ); diff --git a/harbour/source/rtl/substr.c b/harbour/source/rtl/substr.c index da76a20872..ce27eecfcf 100644 --- a/harbour/source/rtl/substr.c +++ b/harbour/source/rtl/substr.c @@ -63,10 +63,11 @@ HB_FUNC( SUBSTR ) if( pText && ISNUM( 2 ) ) { long lPos = hb_parnl( 2 ); + long lSize = ( long ) hb_itemGetCLen( pText ); if( lPos < 0 ) { - lPos += ( long ) hb_itemGetCLen( pText ); + lPos += lSize; if( lPos < 0 ) lPos = 0; } @@ -75,7 +76,7 @@ HB_FUNC( SUBSTR ) lPos--; } - if( lPos < ( long ) hb_itemGetCLen( pText ) ) + if( lPos < lSize ) { long lLen; @@ -85,8 +86,8 @@ HB_FUNC( SUBSTR ) { lLen = hb_parnl( 3 ); - if( lLen > ( long ) hb_itemGetCLen( pText ) - lPos ) - lLen = ( long ) hb_itemGetCLen( pText ) - lPos; + if( lLen > lSize - lPos ) + lLen = lSize - lPos; } else { @@ -96,10 +97,15 @@ HB_FUNC( SUBSTR ) } } else - lLen = ( long ) hb_itemGetCLen( pText ) - lPos; + lLen = lSize - lPos; if( lLen > 0 ) - hb_retclen( hb_itemGetCPtr( pText ) + lPos, lLen ); + { + if( lPos == 0 && lLen == lSize ) + hb_itemReturn( pText ); + else + hb_retclen( hb_itemGetCPtr( pText ) + lPos, lLen ); + } else hb_retc( NULL ); } diff --git a/harbour/source/vm/classes.c b/harbour/source/vm/classes.c index e21a7258b8..e9ce79040d 100644 --- a/harbour/source/vm/classes.c +++ b/harbour/source/vm/classes.c @@ -2214,10 +2214,9 @@ static HARBOUR hb___msgClsSel( void ) USHORT uiPos = 0; USHORT uiAt; - hb_itemRelease( pReturn ); - pReturn = hb_itemArrayNew( pClass->uiMethods ); - /* Create a transfer array */ - for( uiAt = 0; uiAt < uiLimit; uiAt++ ) + hb_arrayNew( pReturn, pClass->uiMethods ); + + for( uiAt = 0; uiAt < uiLimit && uiPos < pClass->uiMethods; uiAt++ ) { PHB_DYNS pMessage = ( PHB_DYNS ) pClass->pMethods[ uiAt ].pMessage; @@ -2227,31 +2226,28 @@ static HARBOUR hb___msgClsSel( void ) { s_pMethod = pClass->pMethods + uiAt; - if ( ( nParam==HB_MSGLISTALL ) || - ( (nParam==HB_MSGLISTCLASS) && - ( - (s_pMethod->pFunction == hb___msgSetClsData) || - (s_pMethod->pFunction == hb___msgGetClsData) || - (s_pMethod->pFunction == hb___msgSetShrData) || - (s_pMethod->pFunction == hb___msgGetShrData) - ) - ) || - ( (nParam==HB_MSGLISTPURE) && - ( - (! (s_pMethod->pFunction == hb___msgSetClsData)) && - (! (s_pMethod->pFunction == hb___msgGetClsData)) && - (! (s_pMethod->pFunction == hb___msgSetShrData)) && - (! (s_pMethod->pFunction == hb___msgGetShrData)) - ) + if( ( nParam == HB_MSGLISTALL ) || + ( nParam == HB_MSGLISTCLASS && + ( + ( s_pMethod->pFunction == hb___msgSetClsData ) || + ( s_pMethod->pFunction == hb___msgGetClsData ) || + ( s_pMethod->pFunction == hb___msgSetShrData ) || + ( s_pMethod->pFunction == hb___msgGetShrData ) ) - ) - { - - PHB_ITEM pItem = hb_itemPutC( NULL, pMessage->pSymbol->szName ); - /* Add to array */ - hb_itemArrayPut( pReturn, ++uiPos, pItem ); - hb_itemRelease( pItem ); - } + ) || + ( nParam == HB_MSGLISTPURE && + !( + ( s_pMethod->pFunction == hb___msgSetClsData ) || + ( s_pMethod->pFunction == hb___msgGetClsData ) || + ( s_pMethod->pFunction == hb___msgSetShrData ) || + ( s_pMethod->pFunction == hb___msgGetShrData ) + ) + ) + ) + { + hb_itemPutC( hb_arrayGetItemPtr( pReturn, ++uiPos ), + pMessage->pSymbol->szName ); + } } } } diff --git a/harbour/source/vm/extend.c b/harbour/source/vm/extend.c index 5ce95f0560..d5e750e2ad 100644 --- a/harbour/source/vm/extend.c +++ b/harbour/source/vm/extend.c @@ -87,7 +87,6 @@ HB_EXPORT PHB_ITEM hb_param( int iParam, long lMask ) if( ( iParam >= 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) ) { PHB_ITEM pItem = ( iParam == -1 ) ? &hb_stack.Return : hb_stackItemFromBase( iParam ); - HB_TYPE uiType; if( pItem->type & HB_IT_BYREF ) { @@ -96,9 +95,7 @@ HB_EXPORT PHB_ITEM hb_param( int iParam, long lMask ) return pItem; } - uiType = pItem->type; - - if( ( uiType & ( HB_TYPE ) lMask ) || ( uiType == HB_IT_NIL && ( HB_TYPE ) lMask == HB_IT_ANY ) ) + if( ( pItem->type & ( HB_TYPE ) lMask ) || ( HB_TYPE ) lMask == HB_IT_ANY ) return pItem; } @@ -672,14 +669,6 @@ HB_EXPORT ULONG hb_parinfo( int iParam ) } } -#undef hb_pcount -HB_EXPORT int hb_pcount( void ) -{ - HB_TRACE(HB_TR_DEBUG, ("hb_pcount()")); - - return ( int ) ( hb_stackBaseItem() )->item.asSymbol.paramcnt; -} - #undef hb_ret HB_EXPORT void hb_ret( void ) { @@ -747,19 +736,7 @@ HB_EXPORT void hb_retcAdopt( char * szText ) */ HB_TRACE_STEALTH( HB_TR_INFO, ("hb_retcAdopt(%s)", szText ) ); - - if( ( &(hb_stack.Return) )->type ) - { - hb_itemClear( &(hb_stack.Return) ); - } - - ( &(hb_stack.Return) )->type = HB_IT_STRING; - ( &(hb_stack.Return) )->item.asString.u.pulHolders = ( HB_COUNTER * ) hb_xgrab( sizeof( HB_COUNTER ) ); - *( ( &(hb_stack.Return) )->item.asString.u.pulHolders ) = 1; - ( &(hb_stack.Return) )->item.asString.bStatic = FALSE; - ( &(hb_stack.Return) )->item.asString.value = szText; - ( &(hb_stack.Return) )->item.asString.length = strlen( szText ); - + hb_itemPutCPtr( &hb_stack.Return, szText, strlen( szText ) ); } /* szDate must have YYYYMMDD format */ @@ -1241,4 +1218,12 @@ HB_EXPORT int hb_storptr( void * pointer, int iParam, ... ) return 0; } +#undef hb_pcount +HB_EXPORT int hb_pcount( void ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_pcount()")); + + return ( int ) ( hb_stackBaseItem() )->item.asSymbol.paramcnt; +} + HB_EXTERN_END diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 07811e41be..f7151217f7 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -114,7 +114,7 @@ static void hb_vmPower( void ); /* power the latest two values on t static void hb_vmInc( void ); /* increment the latest numeric value on the stack */ static void hb_vmDec( void ); /* decrements the latest numeric value on the stack */ static void hb_vmFuncPtr( void ); /* pushes a function address pointer. Removes the symbol from the satck */ -static void hb_vmAddInt( HB_ITEM_PTR pResult, int iAdd ); /* add integer to given item */ +static void hb_vmAddInt( HB_ITEM_PTR pResult, LONG lAdd ); /* add integer to given item */ static void hb_vmPlus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pItem2, int iPopCnt ); /* sums the latest two values on the stack, removes them and leaves the result */ static void hb_vmMinus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pItem2, int iPopCnt ); /* substracts the latest two values on the stack, removes them and leaves the result */ static void hb_vmMult( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pItem2, int iPopCnt ); /* multiplies the latest two values on the stack, removes them and leaves the result */ @@ -1975,11 +1975,11 @@ HB_EXPORT void hb_vmExecute( const BYTE * pCode, PHB_SYMB pSymbols ) /* character / misc ) */ /* ------------------------------- */ -static void hb_vmAddInt( HB_ITEM_PTR pResult, int iAdd ) +static void hb_vmAddInt( HB_ITEM_PTR pResult, LONG lAdd ) { double dNewVal; - HB_TRACE(HB_TR_DEBUG, ("hb_vmAddInt(%p,%d)", pResult, iAdd)); + HB_TRACE(HB_TR_DEBUG, ("hb_vmAddInt(%p,%ld)", pResult, lAdd)); if( HB_IS_BYREF( pResult ) ) { @@ -1990,39 +1990,39 @@ static void hb_vmAddInt( HB_ITEM_PTR pResult, int iAdd ) { HB_LONG lVal = HB_ITEM_GET_NUMINTRAW( pResult ), lNewVal; - lNewVal = lVal + iAdd; + lNewVal = lVal + lAdd; - if( iAdd >= 0 ? lNewVal >= lVal : lNewVal < lVal ) + if( lAdd >= 0 ? lNewVal >= lVal : lNewVal < lVal ) { HB_ITEM_PUT_NUMINTRAW( pResult, lNewVal ); return; } else { - dNewVal = ( double ) lVal + ( double ) iAdd; + dNewVal = ( double ) lVal + lAdd; } } else if( HB_IS_DATE( pResult ) ) { - pResult->item.asDate.value += iAdd; + pResult->item.asDate.value += lAdd; return; } else if( pResult->type & HB_IT_DOUBLE ) { - dNewVal = pResult->item.asDouble.value + iAdd; + dNewVal = pResult->item.asDouble.value + lAdd; } else { PHB_ITEM pSubst, pAdd = hb_stackTopItem(); - if( iAdd > 0 ) + if( lAdd > 0 ) { - hb_vmPushInteger( iAdd ); + hb_vmPushLong( lAdd ); pSubst = hb_errRT_BASE_Subst( EG_ARG, 1081, NULL, "+", 2, pResult, pAdd ); } else { - hb_vmPushInteger( -iAdd ); + hb_vmPushLong( -lAdd ); pSubst = hb_errRT_BASE_Subst( EG_ARG, 1082, NULL, "-", 2, pResult, pAdd ); } @@ -3160,9 +3160,9 @@ static LONG hb_vmEnumStart( BYTE nVars, BYTE nDescend, LONG lOldBase ) } for( i = nVars * 2; i >= 0; i -= 2 ) - { + { PHB_ITEM pBaseValue; - + /* copy value to iterate */ pBaseValue = hb_itemNew( hb_itemUnRef( hb_stackItemFromTop( -i -2 ) ) ); /* the control variable */ @@ -3177,19 +3177,19 @@ static LONG hb_vmEnumStart( BYTE nVars, BYTE nDescend, LONG lOldBase ) pRef->item.asRefer.offset = -1; /* enumerator variable */ pItem = pRef->item.asRefer.BasePtr.itemPtr; - if( HB_IS_ARRAY(pItem) ) + if( HB_IS_ARRAY( pItem ) ) { - pRef->item.asRefer.value = (nDescend>0)?1:pItem->item.asArray.value->ulLen; /* the index into an array */ + pRef->item.asRefer.value = ( nDescend > 0 ) ? 1 : pItem->item.asArray.value->ulLen; /* the index into an array */ if( ulMax > pItem->item.asArray.value->ulLen ) ulMax = pItem->item.asArray.value->ulLen; } - else if( HB_IS_STRING(pItem) ) + else if( HB_IS_STRING( pItem ) ) { /* storage item for single characters */ - pRef->item.asRefer.value = (nDescend>0)?1:pItem->item.asString.length; + pRef->item.asRefer.value = ( nDescend > 0 ) ? 1 : pItem->item.asString.length; pRef->item.asRefer.ValuePtr.itemPtr = hb_itemPutCL( NULL, pItem->item.asString.value + - pRef->item.asRefer.value-1, 1 ); + pRef->item.asRefer.value - 1, 1 ); if( ulMax > pItem->item.asString.length ) ulMax = pItem->item.asString.length; } @@ -3236,17 +3236,17 @@ static void hb_vmEnumNext( void ) for( i=lVars; i >= 0; i-- ) { pRef = hb_itemUnRefRefer( hb_stackItemFromTop( -(i<<1) - 4 ) ); - if( HB_IS_ARRAY(pRef->item.asRefer.BasePtr.itemPtr) ) + if( HB_IS_ARRAY( pRef->item.asRefer.BasePtr.itemPtr ) ) { pRef->item.asRefer.value++; } - else if( HB_IS_STRING(pRef->item.asRefer.BasePtr.itemPtr) ) + else if( HB_IS_STRING( pRef->item.asRefer.BasePtr.itemPtr ) ) { HB_ITEM_PTR pItem; pRef->item.asRefer.value++; pItem = pRef->item.asRefer.BasePtr.itemPtr; hb_itemPutCL( pRef->item.asRefer.ValuePtr.itemPtr, - pItem->item.asString.value + pRef->item.asRefer.value-1, 1 ); + pItem->item.asString.value + pRef->item.asRefer.value - 1, 1 ); } else { @@ -3278,7 +3278,7 @@ static void hb_vmEnumPrev( void ) int i; LONG lVars; - lVars = ( hb_stackItemFromTop( - 3 ) )->item.asLong.value; + lVars = ( hb_stackItemFromTop( -3 ) )->item.asLong.value; --lVars; pIdx = hb_stackItemFromTop( -1 ); @@ -3288,17 +3288,17 @@ static void hb_vmEnumPrev( void ) for( i=lVars; i >= 0; i-- ) { pRef = hb_itemUnRefRefer( hb_stackItemFromTop( -(i<<1) - 4 ) ); - if( HB_IS_ARRAY(pRef->item.asRefer.BasePtr.itemPtr) ) + if( HB_IS_ARRAY( pRef->item.asRefer.BasePtr.itemPtr ) ) { pRef->item.asRefer.value--; } - else if( HB_IS_STRING(pRef->item.asRefer.BasePtr.itemPtr) ) + else if( HB_IS_STRING( pRef->item.asRefer.BasePtr.itemPtr ) ) { HB_ITEM_PTR pItem; pRef->item.asRefer.value--; pItem = pRef->item.asRefer.BasePtr.itemPtr; hb_itemPutCL( pRef->item.asRefer.ValuePtr.itemPtr, - pItem->item.asString.value + pRef->item.asRefer.value-1, 1 ); + pItem->item.asString.value + pRef->item.asRefer.value - 1, 1 ); } else { @@ -3330,23 +3330,23 @@ static LONG hb_vmEnumEnd( void ) /* remove loop counter */ hb_stackDec(); - ( hb_stackTopItem() )->type = HB_IT_NIL; + hb_stackTopItem()->type = HB_IT_NIL; /* restore stack frame offset of previous FOREACH loop */ hb_stackDec(); - lOldBase = ( hb_stackTopItem() )->item.asLong.value; - ( hb_stackTopItem() )->type = HB_IT_NIL; + lOldBase = hb_stackTopItem()->item.asLong.value; + hb_stackTopItem()->type = HB_IT_NIL; /* remove number of iterators */ hb_stackDec(); - lVars = ( hb_stackTopItem() )->item.asLong.value; - ( hb_stackTopItem() )->type = HB_IT_NIL; + lVars = hb_stackTopItem()->item.asLong.value; + hb_stackTopItem()->type = HB_IT_NIL; --lVars; for( i=lVars; i>=0; i-- ) { /* restore the value of variable before the FOREACH loop */ - hb_itemCopy( hb_itemUnRefOnce( hb_stackItemFromTop( -1 ) ), hb_stackItemFromTop( -2 ) ); - hb_stackPop(); + hb_itemMove( hb_itemUnRefOnce( hb_stackItemFromTop( -1 ) ), hb_stackItemFromTop( -2 ) ); + hb_stackDec(); hb_stackPop(); } return lOldBase; @@ -3635,28 +3635,6 @@ static void hb_vmArrayPop( void ) return; } -/* #ifndef HB_C52_STRICT */ - if( (hb_vmFlagEnabled(HB_VMFLAG_ARRSTR)) && (HB_IS_STRING( pArray )) ) - { - if( ulIndex > 0 && ulIndex <= pArray->item.asString.length ) - { - if( pArray->item.asString.bStatic || *( pArray->item.asString.u.pulHolders ) > 1 ) - hb_itemPutCL( pArray, pArray->item.asString.value, pArray->item.asString.length ); - - pArray->item.asString.value[ ulIndex - 1 ] = hb_itemGetNI( pValue ); - - hb_stackPop(); - hb_stackPop(); - hb_stackPop(); /* remove the value from the stack just like other POP operations */ - } - else - hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), - 2, pArray, pIndex ); - - return; - } -/* #endif */ - if( HB_IS_ARRAY( pArray ) ) { if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) @@ -3670,6 +3648,30 @@ static void hb_vmArrayPop( void ) else hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 1, pIndex ); } +/* #ifndef HB_C52_STRICT */ + else if( hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) && HB_IS_STRING( pArray ) ) + { + if( ulIndex > 0 && ulIndex <= pArray->item.asString.length ) + { + if( pArray->item.asString.length == 1 ) + hb_itemPutCL( pArray, hb_vm_acAscii[ ( BYTE ) hb_itemGetNI( pValue ) ], 1 ); + else + { + if( pArray->item.asString.bStatic || *( pArray->item.asString.u.pulHolders ) > 1 ) + hb_itemPutCL( pArray, pArray->item.asString.value, pArray->item.asString.length ); + pArray->item.asString.value[ ulIndex - 1 ] = hb_itemGetNI( pValue ); + } + + hb_stackPop(); + hb_stackPop(); + hb_stackPop(); /* remove the value from the stack just like other POP operations */ + } + else + hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), + 2, pArray, pIndex ); + } +/* #endif */ + else hb_errRT_BASE( EG_ARG, 1069, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 1, pIndex ); } @@ -3996,7 +3998,7 @@ HB_EXPORT void hb_vmDo( USHORT uiParams ) BOOL lPopSuper = FALSE; PHB_BASEARRAY pSelfBase = NULL; - if( pSym == &( hb_symEval ) && HB_IS_BLOCK( pSelf ) ) + if( pSym == &hb_symEval && HB_IS_BLOCK( pSelf ) ) pFunc = pSym->value.pFunPtr; /* __EVAL method = function */ else { @@ -4006,38 +4008,37 @@ HB_EXPORT void hb_vmDo( USHORT uiParams ) pSelfBase = pSelf->item.asArray.value; if( pSelfBase->uiPrevCls ) /* Is is a Super cast ? */ { - PHB_ITEM pRealSelf; - USHORT nPos; - USHORT uiClass; + PHB_ITEM pRealSelf; + USHORT nPos; + USHORT uiClass; - /* - printf( "\n VmDo Method: %s \n", pSym->szName ); - */ - uiClass=pSelfBase->uiClass; + /* + printf( "\n VmDo Method: %s \n", pSym->szName ); + */ + uiClass=pSelfBase->uiClass; - pRealSelf = hb_itemNew( NULL ) ; - hb_itemCopy(pRealSelf ,pSelf->item.asArray.value->pItems) ; /* hb_arrayGetItemPtr(pSelf,1) ; */ - /* and take back the good pSelfBase */ - pSelfBase = pRealSelf->item.asArray.value; - /* Now I should exchnage it with the current stacked value */ - hb_itemSwap( pSelf, pRealSelf ); - hb_itemRelease(pRealSelf) ; /* and release the fake one */ + pRealSelf = hb_itemNew( NULL ) ; + hb_itemCopy(pRealSelf ,pSelf->item.asArray.value->pItems) ; /* hb_arrayGetItemPtr(pSelf,1) ; */ + /* and take back the good pSelfBase */ + pSelfBase = pRealSelf->item.asArray.value; + /* Now I should exchnage it with the current stacked value */ + hb_itemSwap( pSelf, pRealSelf ); + hb_itemRelease(pRealSelf) ; /* and release the fake one */ - /* Push current SuperClass handle */ - lPopSuper = TRUE ; + /* Push current SuperClass handle */ + lPopSuper = TRUE ; - if ( ! pSelf->item.asArray.value->puiClsTree) - { - pSelf->item.asArray.value->puiClsTree = ( USHORT * ) hb_xgrab( sizeof( USHORT ) ); - pSelf->item.asArray.value->puiClsTree[0]=0; - } + if ( ! pSelf->item.asArray.value->puiClsTree) + { + pSelf->item.asArray.value->puiClsTree = ( USHORT * ) hb_xgrab( sizeof( USHORT ) ); + pSelf->item.asArray.value->puiClsTree[0]=0; + } - nPos=pSelfBase->puiClsTree[0]+1; - pSelfBase->puiClsTree = ( USHORT * ) hb_xrealloc( pSelfBase->puiClsTree, sizeof( USHORT ) * ( nPos + 1 ) ); - - pSelfBase->puiClsTree[0] = nPos ; - pSelfBase->puiClsTree[ nPos ] = uiClass; + nPos=pSelfBase->puiClsTree[0]+1; + pSelfBase->puiClsTree = ( USHORT * ) hb_xrealloc( pSelfBase->puiClsTree, sizeof( USHORT ) * ( nPos + 1 ) ); + pSelfBase->puiClsTree[0] = nPos ; + pSelfBase->puiClsTree[ nPos ] = uiClass; } } } @@ -4055,20 +4056,19 @@ HB_EXPORT void hb_vmDo( USHORT uiParams ) if (lPopSuper && pSelfBase->puiClsTree) { - USHORT nPos=pSelfBase->puiClsTree[0]-1; - /* POP SuperClass handle */ + USHORT nPos=pSelfBase->puiClsTree[0]-1; + /* POP SuperClass handle */ - if (nPos) + if (nPos) { - pSelfBase->puiClsTree = ( USHORT * ) hb_xrealloc( pSelfBase->puiClsTree, sizeof( USHORT ) * (nPos + 1) ); - pSelfBase->puiClsTree[0]=nPos; + pSelfBase->puiClsTree = ( USHORT * ) hb_xrealloc( pSelfBase->puiClsTree, sizeof( USHORT ) * (nPos + 1) ); + pSelfBase->puiClsTree[0]=nPos; } - else + else { - hb_xfree(pSelfBase->puiClsTree); - pSelfBase->puiClsTree = NULL ; + hb_xfree(pSelfBase->puiClsTree); + pSelfBase->puiClsTree = NULL ; } - } if( bProfiler ) @@ -4076,15 +4076,13 @@ HB_EXPORT void hb_vmDo( USHORT uiParams ) } else if( pSym->szName[ 0 ] == '_' ) { - PHB_ITEM pArgsArray = hb_arrayFromStack( uiParams ); - hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, pArgsArray ); - hb_itemRelease( pArgsArray ); + hb_vmArrayGen( uiParams ); + hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, hb_stackItemFromTop( -1 ) ); } else { - PHB_ITEM pArgsArray = hb_arrayFromStack( uiParams ); - hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, 1, pArgsArray ); - hb_itemRelease( pArgsArray ); + hb_vmArrayGen( uiParams ); + hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, 1, hb_stackItemFromTop( -1 ) ); } } else /* it is a function */ @@ -4093,37 +4091,39 @@ HB_EXPORT void hb_vmDo( USHORT uiParams ) if( pFunc ) { - if( bProfiler && pSym->pDynSym ) { - pSym->pDynSym->ulRecurse++; - } + if( bProfiler && pSym->pDynSym ) + { + pSym->pDynSym->ulRecurse++; + } - if ( hb_bTracePrgCalls ) - HB_TRACE(HB_TR_ALWAYS, ("Calling: %s", pSym->szName)); + if ( hb_bTracePrgCalls ) + HB_TRACE(HB_TR_ALWAYS, ("Calling: %s", pSym->szName)); - pFunc(); + pFunc(); - if( bProfiler && pSym->pDynSym ) + if( bProfiler && pSym->pDynSym ) + { + pSym->pDynSym->ulCalls++; /* profiler support */ + + /* Time spent has to be added only inside topmost call of a recursive function */ + if( pSym->pDynSym->ulRecurse == 1 ) { - pSym->pDynSym->ulCalls++; /* profiler support */ - - /* Time spent has to be added only inside topmost call of a recursive function */ - if( pSym->pDynSym->ulRecurse == 1 ) { - pSym->pDynSym->ulTime += clock() - ulClock; /* profiler support */ - } + pSym->pDynSym->ulTime += clock() - ulClock; /* profiler support */ } + } - if( bProfiler && pSym->pDynSym ) { - pSym->pDynSym->ulRecurse--; - } + if( bProfiler && pSym->pDynSym ) + { + pSym->pDynSym->ulRecurse--; + } } else { /* Attempt to call an undefined function * - generate unrecoverable runtime error */ - PHB_ITEM pArgsArray = hb_arrayFromStack( uiParams ); - hb_errRT_BASE_SubstR( EG_NOFUNC, 1001, NULL, pSym->szName, 1, pArgsArray ); - hb_itemRelease( pArgsArray ); + hb_vmArrayGen( uiParams ); + hb_errRT_BASE_SubstR( EG_NOFUNC, 1001, NULL, pSym->szName, 1, hb_stackItemFromTop( -1 ) ); } } @@ -4241,15 +4241,13 @@ HB_EXPORT void hb_vmSend( USHORT uiParams ) } else if( pSym->szName[ 0 ] == '_' ) { - PHB_ITEM pArgsArray = hb_arrayFromStack( uiParams ); - hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, "Class: NIL has no exported property", pSym->szName + 1, 1, pArgsArray ); - hb_itemRelease( pArgsArray ); + hb_vmArrayGen( uiParams ); + hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, "Class: NIL has no exported property", pSym->szName + 1, 1, hb_stackItemFromTop( -1 ) ); } else { - PHB_ITEM pArgsArray = hb_arrayFromStack( uiParams ); - hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, "Class: NIL has no exported method", pSym->szName, 1, pArgsArray ); - hb_itemRelease( pArgsArray ); + hb_vmArrayGen( uiParams ); + hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, "Class: NIL has no exported method", pSym->szName, 1, hb_stackItemFromTop( -1 ) ); } } @@ -4367,19 +4365,15 @@ HB_EXPORT void hb_vmSend( USHORT uiParams ) if( pSym->szName[ 0 ] == '_' ) { - PHB_ITEM pArgsArray = hb_arrayFromStack( uiParams ); - sprintf( (char *) sDesc, "Class: '%s' has no property", sClass ); - hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, (char *) sDesc, pSym->szName + 1, 1, pArgsArray ); - hb_itemRelease( pArgsArray ); + hb_vmArrayGen( uiParams ); + hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, (char *) sDesc, pSym->szName + 1, 1, hb_stackItemFromTop( -1 ) ); } else { - PHB_ITEM pArgsArray = hb_arrayFromStack( uiParams ); - sprintf( (char *) sDesc, "Class: '%s' has no exported method", sClass ); - hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, (char *) sDesc, pSym->szName, 1, pArgsArray ); - hb_itemRelease( pArgsArray ); + hb_vmArrayGen( uiParams ); + hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, (char *) sDesc, pSym->szName, 1, hb_stackItemFromTop( -1 ) ); } } } @@ -4967,7 +4961,7 @@ HB_EXPORT void hb_vmPushString( char * szText, ULONG length ) hb_stackPush(); } -void hb_vmPushStringPcode( char * szText, ULONG length ) +HB_EXPORT void hb_vmPushStringPcode( char * szText, ULONG length ) { PHB_ITEM pStackTopItem = hb_stackTopItem(); @@ -6433,11 +6427,11 @@ HB_EXPORT BOOL hb_xvmPopAliasedVar( PHB_SYMB pSymbol ) HB_XVM_RETURN } -HB_EXPORT BOOL hb_xvmLocalAddInt( int iLocal, int iAdd ) +HB_EXPORT BOOL hb_xvmLocalAddInt( int iLocal, LONG lAdd ) { - HB_TRACE(HB_TR_DEBUG, ("hb_xvmLocalAddInt(%d,%d)", iLocal, iAdd)); + HB_TRACE(HB_TR_DEBUG, ("hb_xvmLocalAddInt(%d,%ld)", iLocal, lAdd)); - hb_vmAddInt( hb_stackItemFromBase( iLocal ), iAdd ); + hb_vmAddInt( hb_stackItemFromBase( iLocal ), lAdd ); HB_XVM_RETURN } @@ -6580,6 +6574,15 @@ HB_EXPORT BOOL hb_xvmInstring( void ) HB_XVM_RETURN } +HB_EXPORT BOOL hb_xvmAddInt( LONG lAdd ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_xvmLocalAddInt(%ld)", lAdd)); + + hb_vmAddInt( hb_stackItemFromTop( -1 ), lAdd ); + + HB_XVM_RETURN +} + HB_EXPORT BOOL hb_xvmPlus( void ) { HB_TRACE(HB_TR_DEBUG, ("hb_xvmPlus()")); @@ -6690,7 +6693,6 @@ HB_EXPORT BOOL hb_xvmMultByInt( LONG lValue ) HB_XVM_RETURN } - HB_EXPORT BOOL hb_xvmMult( void ) { HB_TRACE(HB_TR_DEBUG, ("hb_xvmMult()")); @@ -6726,6 +6728,58 @@ HB_EXPORT BOOL hb_xvmMultEqPop( void ) HB_XVM_RETURN } +HB_EXPORT BOOL hb_xvmDivideByInt( LONG lDivisor ) +{ + PHB_ITEM pValue; + + HB_TRACE(HB_TR_DEBUG, ("hb_xvmDivideByInt(%ld)", lDivisor)); + + pValue = hb_stackItemFromTop( -1 ); + + if( HB_IS_NUMERIC( pValue ) ) + { + if( lDivisor == 0 ) + { + PHB_ITEM pSubst; + + hb_vmPushLong( lDivisor ); + pSubst = hb_errRT_BASE_Subst( EG_ZERODIV, 1340, NULL, "/", 2, pValue, hb_stackItemFromTop( -1 ) ); + + if( pSubst ) + { + hb_stackPop(); + hb_itemForwardValue( pValue, pSubst ); + hb_itemRelease( pSubst ); + } + } + else + { + hb_itemPutNDDec( pValue, hb_itemGetND( pValue ) / lDivisor, hb_set.HB_SET_DECIMALS ); + } + } + else if( HB_IS_OBJECT( pValue ) && hb_objHasMsg( pValue, "__OpDivide" ) ) + { + hb_vmPushLong( lDivisor ); + hb_vmOperatorCall( pValue, pValue, hb_stackItemFromTop( -1 ), "__OPDIVIDE" ); + } + else + { + PHB_ITEM pSubst; + + hb_vmPushLong( lDivisor ); + pSubst = hb_errRT_BASE_Subst( EG_ARG, 1084, NULL, "/", 2, pValue, hb_stackItemFromTop( -1 ) ); + + if( pSubst ) + { + hb_stackPop(); + hb_itemForwardValue( pValue, pSubst ); + hb_itemRelease( pSubst ); + } + } + + HB_XVM_RETURN +} + HB_EXPORT BOOL hb_xvmDivide( void ) { HB_TRACE(HB_TR_DEBUG, ("hb_xvmDivide()")); @@ -6888,30 +6942,6 @@ static void hb_vmArrayItemPop( ULONG ulIndex ) if( HB_IS_BYREF( pArray ) ) pArray = hb_itemUnRef( pArray ); -/* #ifndef HB_C52_STRICT */ - if( (hb_vmFlagEnabled(HB_VMFLAG_ARRSTR)) && (HB_IS_STRING( pArray )) ) - { - if( ulIndex > 0 && ulIndex <= pArray->item.asString.length ) - { - if( pArray->item.asString.bStatic || *( pArray->item.asString.u.pulHolders ) > 1 ) - hb_itemPutCL( pArray, pArray->item.asString.value, pArray->item.asString.length ); - - pArray->item.asString.value[ ulIndex - 1 ] = hb_itemGetNI( pValue ); - - hb_stackPop(); - hb_stackPop(); /* remove the value from the stack just like other POP operations */ - } - else - { - hb_vmPushNumInt( ulIndex ); - hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), - 2, pArray, hb_stackItemFromTop( -1 ) ); - } - - return; - } -/* #endif */ - if( HB_IS_ARRAY( pArray ) ) { if( ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) @@ -6927,6 +6957,30 @@ static void hb_vmArrayItemPop( ULONG ulIndex ) hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 1, hb_stackItemFromTop( -1 ) ); } } +/* #ifndef HB_C52_STRICT */ + else if( hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) && HB_IS_STRING( pArray ) ) + { + if( ulIndex > 0 && ulIndex <= pArray->item.asString.length ) + { + if( pArray->item.asString.length == 1 ) + hb_itemPutCL( pArray, hb_vm_acAscii[ ( BYTE ) hb_itemGetNI( pValue ) ], 1 ); + else + { + if( pArray->item.asString.bStatic || *( pArray->item.asString.u.pulHolders ) > 1 ) + hb_itemPutCL( pArray, pArray->item.asString.value, pArray->item.asString.length ); + pArray->item.asString.value[ ulIndex - 1 ] = hb_itemGetNI( pValue ); + } + hb_stackPop(); + hb_stackPop(); /* remove the value from the stack just like other POP operations */ + } + else + { + hb_vmPushNumInt( ulIndex ); + hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), + 2, pArray, hb_stackItemFromTop( -1 ) ); + } + } +/* #endif */ else { hb_vmPushNumInt( ulIndex ); diff --git a/harbour/source/vm/itemapi.c b/harbour/source/vm/itemapi.c index 1df33181f1..b5b5093385 100644 --- a/harbour/source/vm/itemapi.c +++ b/harbour/source/vm/itemapi.c @@ -198,6 +198,8 @@ HB_EXPORT PHB_ITEM hb_itemArrayPut( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pIt HB_EXPORT PHB_ITEM hb_itemPutC( PHB_ITEM pItem, const char * szText ) { + ULONG ulLen = szText ? strlen( szText ) : 0; + HB_TRACE(HB_TR_DEBUG, ("hb_itemPutC(%p, %s)", pItem, szText)); if( pItem ) @@ -210,13 +212,13 @@ HB_EXPORT PHB_ITEM hb_itemPutC( PHB_ITEM pItem, const char * szText ) pItem->type = HB_IT_STRING; - if( szText == NULL || szText[0] == '\0' ) + if( ulLen == 0 ) { pItem->item.asString.length = 0; pItem->item.asString.value = hb_vm_sNull; pItem->item.asString.bStatic = TRUE; } - else if( szText[1] == '\0' ) + else if( ulLen == 1 ) { pItem->item.asString.length = 1; pItem->item.asString.value = hb_vm_acAscii[ (unsigned char) ( szText[0] ) ]; @@ -224,12 +226,13 @@ HB_EXPORT PHB_ITEM hb_itemPutC( PHB_ITEM pItem, const char * szText ) } else { - pItem->item.asString.length = strlen( szText ); - pItem->item.asString.value = ( char * ) hb_xgrab( pItem->item.asString.length + 1 ); + pItem->item.asString.length = ulLen; + pItem->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 ); pItem->item.asString.bStatic = 0; pItem->item.asString.u.pulHolders = ( HB_COUNTER * ) hb_xgrab( sizeof( HB_COUNTER ) ); * ( pItem->item.asString.u.pulHolders ) = 1; - strcpy( pItem->item.asString.value, szText ); + hb_xmemcpy( pItem->item.asString.value, szText, ulLen ); + pItem->item.asString.value[ ulLen ] = '\0'; } return pItem; @@ -322,11 +325,26 @@ HB_EXPORT PHB_ITEM hb_itemPutCPtr( PHB_ITEM pItem, char * szText, ULONG ulLen ) pItem->type = HB_IT_STRING; pItem->item.asString.length = ulLen; - pItem->item.asString.value = szText; - pItem->item.asString.value[ ulLen ] = '\0'; - pItem->item.asString.bStatic = 0; - pItem->item.asString.u.pulHolders = ( HB_COUNTER * ) hb_xgrab( sizeof( HB_COUNTER ) ); - * ( pItem->item.asString.u.pulHolders ) = 1; + if( ulLen == 0 ) + { + pItem->item.asString.value = hb_vm_sNull; + pItem->item.asString.bStatic = TRUE; + hb_xfree( szText ); + } + else if( ulLen == 1 ) + { + pItem->item.asString.value = hb_vm_acAscii[ (unsigned char) ( szText[0] ) ]; + pItem->item.asString.bStatic = TRUE; + hb_xfree( szText ); + } + else + { + pItem->item.asString.value = szText; + pItem->item.asString.value[ ulLen ] = '\0'; + pItem->item.asString.bStatic = FALSE; + pItem->item.asString.u.pulHolders = ( HB_COUNTER * ) hb_xgrab( sizeof( HB_COUNTER ) ); + * ( pItem->item.asString.u.pulHolders ) = 1; + } return pItem; }