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

2006-04-07 15:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* 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
This commit is contained in:
Przemyslaw Czerpak
2006-04-07 12:57:59 +00:00
parent 7ccc4310e1
commit 130a3239d2
17 changed files with 583 additions and 368 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
harbour/ChangeLog
View File

@@ -8,13 +8,52 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
* 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

2
harbour/bin/hb-func.sh
View File

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

7
harbour/include/hbapi.h
View File

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

4
harbour/include/hbxvm.h
View File

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

68
harbour/source/common/hbdate.c
View File

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

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

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

48
harbour/source/compiler/hbfix.c
View File

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

8
harbour/source/rdd/dbf1.c
View File

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

2
harbour/source/rdd/dbfcdx/dbfcdx1.c
View File

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

63
harbour/source/rtl/padc.c
View File

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

55
harbour/source/rtl/padl.c
View File

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

55
harbour/source/rtl/padr.c
View File

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

18
harbour/source/rtl/substr.c
View File

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

52
harbour/source/vm/classes.c
View File

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

35
harbour/source/vm/extend.c
View File

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

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

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

38
harbour/source/vm/itemapi.c
View File

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