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

2006-06-15 18:10 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/source/rdd/usrrdd/usrrdd.c
    + added functions to set WorkArea flags USRRDD_SETBOF, USRRDD_SETEOF,
      USRRDD_SETFOUND, USRRDD_SETTOP, USRRDD_SETBOTTOM

  * harbour/include/hbapierr.h
    + added HB_ERR_ARGS_BASEPARAMS

  * harbour/source/rtl/errorapi.c
    ! check if ARGS passed to __ERRRT_BASE() and __ERRRT_SBASE() are
      valid to avoid possible GPF
    * replaced old hack with passing ARGS in array for some chosen errors
      by HB_ERR_ARGS_BASEPARAMS in hb_errRT_BASE and hb_errRT_BASE_SubstR
      - it was impossible to generate Clipper compatible error message

  * harbour/source/rtl/do.c
    * use HB_ERR_ARGS_BASEPARAMS

  * harbour/source/rtl/tobject.prg
    * assign SELF to ARGS of error object when EG_NO[VAR]METHOD RT error
      is generated - Clipper compatible.

  * harbour/source/vm/classes.c
    * added __msgNoMethod which is returned to hb_vmSend when object does
      not support requested message. This handler can display previous
      Harbour error message though now it's disabled and Clipper compatible
      error message is generated. I leave the decision to Harbour users
      which version of error message should be used.
    * changed __msgClsSel to return variable size array with only valid items
      If some code needs fixed size array then it will have to be updated

  * harbour/source/vm/hvm.c
    * generate Clipper compatible error messages for EG_NO[VAR]METHOD
      and EG_NOFUNC. Please do not change it. If you want previous Harbour
      error messages for EG_NO[VAR]METHOD then please change __msgNoMethod
      in classy.c

  * harbour/source/vm/arrays.c
    * minor modification
This commit is contained in:
Przemyslaw Czerpak
2006-06-15 16:11:27 +00:00
parent 1d3ba3a5a1
commit 3f605c0795
9 changed files with 255 additions and 214 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
harbour/ChangeLog
View File

@@ -8,6 +8,46 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
! 2907 MAIN_MISC(200) TFORNEXT( NIL, NIL, NIL )
like in Clipper. I cannot uncomment it because it will break
backward binary compatibility so I'll do that when some modification
! 2919 MAIN_MISC(212) TFORNEXT( NIL, NIL, NIL )
Enabling this code clean the following errors reported by hbtest:
! 2907 MAIN_MISC(200) TFORNEXT( NIL, NIL, NIL )
Result: "E BASE 1074 Argument error <= A:2:U:NIL;U:NIL F:S"
Expected: "E BASE 1075 Argument error > A:2:U:NIL;U:NIL F:S"
! 2919 MAIN_MISC(212) TFORNEXT( NIL, NIL, NIL )
Result: "E BASE 1074 Argument error <= A:2:U:NIL;U:NIL F:S"
Expected: "E BASE 1075 Argument error > A:2:U:NIL;U:NIL F:S"
2006-06-15 18:10 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
+ added HB_ERR_ARGS_BASEPARAMS
+ added functions to set WorkArea flags USRRDD_SETBOF, USRRDD_SETEOF,
USRRDD_SETFOUND, USRRDD_SETTOP, USRRDD_SETBOTTOM
* harbour/include/hbapierr.h
+ added HB_ERR_ARGS_BASEPARAMS
* harbour/source/rtl/errorapi.c
! check if ARGS passed to __ERRRT_BASE() and __ERRRT_SBASE() are
valid to avoid possible GPF
* replaced old hack with passing ARGS in array for some chosen errors
by HB_ERR_ARGS_BASEPARAMS in hb_errRT_BASE and hb_errRT_BASE_SubstR
- it was impossible to generate Clipper compatible error message
* harbour/source/rtl/do.c
* use HB_ERR_ARGS_BASEPARAMS
* harbour/source/rtl/tobject.prg
* assign SELF to ARGS of error object when EG_NO[VAR]METHOD RT error
is generated - Clipper compatible.
* harbour/source/vm/classes.c
* added __msgNoMethod which is returned to hb_vmSend when object does
not support requested message. This handler can display previous
Harbour error message though now it's disabled and Clipper compatible
error message is generated. I leave the decision to Harbour users
which version of error message should be used.
* changed __msgClsSel to return variable size array with only valid items
If some code needs fixed size array then it will have to be updated

2
harbour/include/hbapierr.h
View File

@@ -93,6 +93,8 @@ HB_EXTERN_BEGIN
#define HB_ERR_IE_UNREC_ERROR 1026
#define HB_ERR_IE_GENERIC 1027
#define HB_ERR_ARGS_BASEPARAMS 0xFFFFFFFF
/* Standard API */
extern char * hb_errGetDescription ( PHB_ITEM pError );

80
harbour/source/rdd/usrrdd/usrrdd.c
View File

@@ -2955,6 +2955,86 @@ HB_FUNC( USRRDD_AREARESULT )
}
}
HB_FUNC( USRRDD_SETBOF )
{
AREAP pArea;
if( ISLOG( 2 ) )
{
if( ISNUM( 1 ) )
pArea = hb_usrGetAreaPointer( hb_parni( 1 ) );
else
pArea = ( AREAP ) hb_parptr( 1 );
if( pArea && pArea->rddID < s_uiUsrNodes && SELF_USRNODE( pArea ) )
pArea->fBof = hb_parl( 2 );
}
}
HB_FUNC( USRRDD_SETEOF )
{
AREAP pArea;
if( ISLOG( 2 ) )
{
if( ISNUM( 1 ) )
pArea = hb_usrGetAreaPointer( hb_parni( 1 ) );
else
pArea = ( AREAP ) hb_parptr( 1 );
if( pArea && pArea->rddID < s_uiUsrNodes && SELF_USRNODE( pArea ) )
pArea->fEof = hb_parl( 2 );
}
}
HB_FUNC( USRRDD_SETFOUND )
{
AREAP pArea;
if( ISLOG( 2 ) )
{
if( ISNUM( 1 ) )
pArea = hb_usrGetAreaPointer( hb_parni( 1 ) );
else
pArea = ( AREAP ) hb_parptr( 1 );
if( pArea && pArea->rddID < s_uiUsrNodes && SELF_USRNODE( pArea ) )
pArea->fFound = hb_parl( 2 );
}
}
HB_FUNC( USRRDD_SETTOP )
{
AREAP pArea;
if( ISLOG( 2 ) )
{
if( ISNUM( 1 ) )
pArea = hb_usrGetAreaPointer( hb_parni( 1 ) );
else
pArea = ( AREAP ) hb_parptr( 1 );
if( pArea && pArea->rddID < s_uiUsrNodes && SELF_USRNODE( pArea ) )
pArea->fTop = hb_parl( 2 );
}
}
HB_FUNC( USRRDD_SETBOTTOM )
{
AREAP pArea;
if( ISLOG( 2 ) )
{
if( ISNUM( 1 ) )
pArea = hb_usrGetAreaPointer( hb_parni( 1 ) );
else
pArea = ( AREAP ) hb_parptr( 1 );
if( pArea && pArea->rddID < s_uiUsrNodes && SELF_USRNODE( pArea ) )
pArea->fBottom = hb_parl( 2 );
}
}
static ERRCODE hb_usrErrorRT( AREAP pArea, USHORT uiGenCode, USHORT uiSubCode )
{
PHB_ITEM pError;

2
harbour/source/rtl/do.c
View File

@@ -84,7 +84,7 @@ HB_FUNC( DO )
{
PHB_ITEM pArgsArray = hb_arrayBaseParams();
hb_errRT_BASE( EG_NOFUNC, 1001, NULL, hb_itemGetCPtr( pItem ), 1, pArgsArray );
hb_errRT_BASE( EG_NOFUNC, 1001, NULL, hb_itemGetCPtr( pItem ), HB_ERR_ARGS_BASEPARAMS );
hb_itemRelease( pArgsArray );
return;
}

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

@@ -757,7 +757,7 @@ HB_FUNC( __ERRRT_BASE )
( ULONG ) hb_parnl( 2 ),
hb_parc( 3 ),
hb_parc( 4 ),
( USHORT ) hb_parni( 5 ),
( USHORT ) ( hb_pcount() > 5 && hb_parni( 5 ) > 0 ? 1 : 0 ),
hb_param( 6, HB_IT_ANY ) );
}
@@ -767,7 +767,7 @@ HB_FUNC( __ERRRT_SBASE )
( ULONG ) hb_parnl( 2 ),
hb_parc( 3 ),
hb_parc( 4 ),
( USHORT ) hb_parni( 5 ),
( USHORT ) ( hb_pcount() > 5 && hb_parni( 5 ) > 0 ? 1 : 0 ),
hb_param( 6, HB_IT_ANY ) );
}
@@ -776,42 +776,34 @@ USHORT hb_errRT_BASE( ULONG ulGenCode, ULONG ulSubCode, const char * szDescripti
USHORT uiAction;
PHB_ITEM pError;
PHB_ITEM pArray, pArg;
PHB_ITEM pArray;
va_list va;
ULONG ulArgPos;
BOOL bRelease = TRUE;
/* Build the array from the passed arguments. */
va_start( va, ulArgCount );
if( ( ulSubCode == 1001 || ulSubCode == 1004 || ulSubCode == 1005 ) && ulArgCount == 1 )
{
pArray = va_arg( va, PHB_ITEM );
if( HB_IS_ARRAY( pArray ) )
{
bRelease = FALSE;
}
else
{
pArg = pArray;
pArray = hb_itemArrayNew( 1 );
hb_itemArrayPut( pArray, 1, pArg );
}
}
else if ( ulArgCount == 0 )
if( ulArgCount == 0 )
{
pArray = NULL;
}
else if( ulArgCount == HB_ERR_ARGS_BASEPARAMS )
{
if( hb_pcount() == 0 )
pArray = NULL;
else
pArray = hb_arrayBaseParams();
}
else
{
pArray = hb_itemArrayNew( ulArgCount );
va_start( va, ulArgCount );
for( ulArgPos = 1; ulArgPos <= ulArgCount; ulArgPos++ )
{
hb_itemArrayPut( pArray, ulArgPos, va_arg( va, PHB_ITEM ) );
}
va_end( va );
}
va_end( va );
/* I replaced EF_CANRETRY with EF_NONE for Clipper compatibility
* If it's wrong and I missed sth please fix me, Druzus.
@@ -924,42 +916,34 @@ void hb_errRT_BASE_SubstR( ULONG ulGenCode, ULONG ulSubCode, const char * szDesc
{
PHB_ITEM pError;
PHB_ITEM pArray, pArg;
PHB_ITEM pArray;
va_list va;
ULONG ulArgPos;
BOOL bRelease = TRUE;
/* Build the array from the passed arguments. */
va_start( va, ulArgCount );
if( ( ulSubCode == 1001 || ulSubCode == 1004 || ulSubCode == 1005 ) && ulArgCount == 1 )
{
pArray = va_arg( va, PHB_ITEM );
if( HB_IS_ARRAY( pArray ) )
{
bRelease = FALSE;
}
else
{
pArg = pArray;
pArray = hb_itemArrayNew( 1 );
hb_itemArrayPut( pArray, 1, pArg );
}
}
else if ( ulArgCount == 0 )
if( ulArgCount == 0 )
{
pArray = NULL;
}
else if( ulArgCount == HB_ERR_ARGS_BASEPARAMS )
{
if( hb_pcount() == 0 )
pArray = NULL;
else
pArray = hb_arrayBaseParams();
}
else
{
pArray = hb_itemArrayNew( ulArgCount );
va_start( va, ulArgCount );
for( ulArgPos = 1; ulArgPos <= ulArgCount; ulArgPos++ )
{
hb_itemArrayPut( pArray, ulArgPos, va_arg( va, PHB_ITEM ) );
}
va_end( va );
}
va_end( va );
pError = hb_errRT_New_Subst( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE );

4
harbour/source/rtl/tobject.prg
View File

@@ -173,9 +173,9 @@ static function HBObject_Error( cDesc, cClass, cMsg, nCode )
DEFAULT nCode TO 1004
IF nCode == 1005
RETURN __errRT_SBASE( EG_NOVARMETHOD, 1005, cDesc, cClass + ":" + cMsg )
RETURN __errRT_SBASE( EG_NOVARMETHOD, 1005, cDesc, cClass + ":" + cMsg, 1, QSelf() )
ENDIF
RETURN __errRT_SBASE( EG_NOMETHOD, nCode, cDesc, cClass + ":" + cMsg )
RETURN __errRT_SBASE( EG_NOMETHOD, nCode, cDesc, cClass + ":" + cMsg, 1, QSelf() )

6
harbour/source/vm/arrays.c
View File

@@ -599,16 +599,16 @@ ULONG hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG *
if( HB_IS_BLOCK( pValue ) )
{
for( ulStart--; ulCount > 0; ulCount--, ulStart++ )
for( --ulStart; ulCount > 0; --ulCount )
{
hb_vmPushSymbol( &hb_symEval );
hb_vmPush( pValue );
hb_vmPush( pBaseArray->pItems + ulStart );
hb_vmPushLong( ulStart + 1 );
hb_vmPushLong( ++ulStart );
hb_vmDo( 2 );
if( HB_IS_LOGICAL( hb_stackReturnItem() ) && hb_stackReturnItem()->item.asLogical.value )
return ulStart + 1; /* arrays start from 1 */
return ulStart; /* arrays start from 1 */
}
}
else if( HB_IS_STRING( pValue ) )

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

@@ -198,6 +198,7 @@ static HARBOUR hb___msgSetShrData( void );
static HARBOUR hb___msgEvalInline( void );
static HARBOUR hb___msgVirtual( void );
static HARBOUR hb___msgSuper( void );
static HARBOUR hb___msgNoMethod( void );
static HARBOUR hb___msgClsH( void );
static HARBOUR hb___msgClsName( void );
@@ -248,6 +249,7 @@ static HB_SYMB s___msgGetShrData = { "__msgGetShrData", {HB_FS_MESSAGE}, {hb___m
static HB_SYMB s___msgEvalInline = { "__msgEvalInline", {HB_FS_MESSAGE}, {hb___msgEvalInline}, NULL };
static HB_SYMB s___msgVirtual = { "__msgVirtual", {HB_FS_MESSAGE}, {hb___msgVirtual}, NULL };
static HB_SYMB s___msgSuper = { "__msgSuper", {HB_FS_MESSAGE}, {hb___msgSuper}, NULL };
static HB_SYMB s___msgNoMethod = { "__msgNoMethod", {HB_FS_MESSAGE}, {hb___msgNoMethod}, NULL };
static HB_SYMB s___msgClassName = { "CLASSNAME", {HB_FS_MESSAGE}, {hb___msgClsName}, NULL };
static HB_SYMB s___msgClassH = { "CLASSH", {HB_FS_MESSAGE}, {hb___msgClsH}, NULL };
@@ -748,17 +750,11 @@ char * hb_objGetClsName( PHB_ITEM pObject )
*/
char * hb_objGetRealClsName( PHB_ITEM pObject, char * szName )
{
char * szClassName;
HB_TRACE(HB_TR_DEBUG, ("hb_objGetrealClsName(%p)", pObject));
if( HB_IS_ARRAY( pObject ) )
{
if( ! pObject->item.asArray.value->uiClass )
{
szClassName = "ARRAY";
}
else
if( pObject->item.asArray.value->uiClass )
{
PHB_DYNS pMsg = hb_dynsymFindName( szName );
USHORT uiClass;
@@ -796,75 +792,20 @@ char * hb_objGetRealClsName( PHB_ITEM pObject, char * szName )
uiClsTree=1; /* Flag Value */
break;
}
uiAt++;
if( uiAt == uiMask )
{
if( ++uiAt == uiMask )
uiAt = 0;
}
}
}
if (-- uiClsTree)
{
uiCurCls = pObject->item.asArray.value->puiClsTree[uiClsTree] ;
}
}
if( uiClass && uiClass <= s_uiClasses )
{
szClassName = ( s_pClasses + uiClass - 1 )->szName;
}
else
{
szClassName = "UNKNOWN";
}
}
}
else /* built in types */
{
switch( pObject->type )
{
case HB_IT_NIL:
szClassName = "NIL";
break;
case HB_IT_STRING:
case HB_IT_MEMO:
szClassName = "CHARACTER";
break;
case HB_IT_BLOCK:
szClassName = "BLOCK";
break;
case HB_IT_SYMBOL:
szClassName = "SYMBOL";
break;
case HB_IT_DATE:
szClassName = "DATE";
break;
case HB_IT_INTEGER:
case HB_IT_LONG:
case HB_IT_DOUBLE:
szClassName = "NUMERIC";
break;
case HB_IT_LOGICAL:
szClassName = "LOGICAL";
break;
default:
szClassName = "UNKNOWN";
break;
return ( s_pClasses + uiClass - 1 )->szName;
}
}
return szClassName;
return hb_objGetClsName( pObject );
}
static void hb_objPushSuperCast( PHB_ITEM pObject )
@@ -922,12 +863,17 @@ void hb_objPopSuperCast( PHB_ITEM pObject )
}
}
static PHB_SYMB hb_objGetMthd( PHB_ITEM pObject, PHB_SYMB pMessage, BOOL * pfPopSuper )
/*
* <pFuncSym> = hb_objGetMethod( <pObject>, <pMessage>, <fpPopSuper> )
*
* Internal function to the function pointer of a message of an object
*/
PHB_SYMB hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage, BOOL * pfPopSuper )
{
PCLASS pClass = NULL;
PHB_DYNS pMsg;
HB_TRACE(HB_TR_DEBUG, ("hb_objGetMthd(%p, %p, %p)", pObject, pMessage, pfPopSuper));
HB_TRACE(HB_TR_DEBUG, ("hb_objGetMethod(%p, %p, %p)", pObject, pMessage, pfPopSuper));
s_pMethod = NULL;
if( pfPopSuper )
@@ -987,31 +933,27 @@ static PHB_SYMB hb_objGetMthd( PHB_ITEM pObject, PHB_SYMB pMessage, BOOL * pfPop
else if( pMsg == s___msgClassSel.pDynSym )
return &s___msgClassSel;
/*
else if( pMsg == s___msgEval.pDynSym )
return &s___msgEval;
/*
else if( pMsg == s___msgClsParent.pDynSym )
return &s___msgClsParent;
else if( pMsg == s___msgClass.pDynSym )
return &s___msgClass;
*/
else if( pClass && pfPopSuper )
return pClass->pFunError;
else if( pfPopSuper )
{
if( pClass && pClass->pFunError )
return pClass->pFunError;
/* remove this line if you want default HVM error message */
return &s___msgNoMethod;
}
return NULL;
}
/*
* <pFunc> = hb_objGetMethod( <pObject>, <pMessage>, <fpPopSuper> )
*
* Internal function to the function pointer of a message of an object
*/
PHB_SYMB hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage, BOOL * pfPopSuper )
{
return hb_objGetMthd( (PHB_ITEM) pObject, (PHB_SYMB) pMessage, pfPopSuper );
}
static PHB_SYMB hb_objFuncParam( int iParam )
{
PHB_ITEM pItem = hb_param( iParam, HB_IT_SYMBOL );
@@ -1122,7 +1064,7 @@ BOOL hb_objHasMsg( PHB_ITEM pObject, char *szString )
if( pDynSym )
{
return hb_objGetMthd( pObject, pDynSym->pSymbol, NULL ) != NULL;
return hb_objGetMethod( pObject, pDynSym->pSymbol, NULL ) != NULL;
}
else
{
@@ -2165,20 +2107,21 @@ HB_FUNC( __CLASSSEL )
USHORT uiPos = 0;
USHORT uiAt;
hb_itemRelease( pReturn );
pReturn = hb_itemArrayNew( pClass->uiMethods );
/* Create a transfer array */
hb_arrayNew( pReturn, pClass->uiMethods ); /* Create a transfer array */
for( uiAt = 0; uiAt < uiLimit; uiAt++ )
{
PHB_DYNS pMessage = ( PHB_DYNS ) pClass->pMethods[ uiAt ].pMessage;
if( pMessage ) /* Hash Entry used ? */
{
PHB_ITEM pItem = hb_itemPutC( NULL, pMessage->pSymbol->szName );
/* Add to array */
hb_itemArrayPut( pReturn, ++uiPos, pItem );
hb_itemRelease( pItem );
PHB_ITEM pItem = hb_arrayGetItemPtr( pReturn, ++uiPos );
if( pItem )
hb_itemPutC( pItem, pMessage->pSymbol->szName );
else
break; /* Generate internal error? */
}
}
if( uiPos < pClass->uiMethods )
hb_arraySize( pReturn, uiPos );
}
hb_itemRelease( hb_itemReturn( pReturn ) );
@@ -2235,25 +2178,22 @@ HB_FUNC( __CLASSH )
*/
HB_FUNC( __EVAL )
{
PHB_ITEM pObject = hb_itemParam( 1 );
PHB_ITEM pObject = hb_param( 1, HB_IT_ANY );
USHORT uiPCount = hb_pcount();
if( HB_IS_BLOCK( pObject ) )
if( pObject && HB_IS_BLOCK( pObject ) )
{
USHORT uiParam;
hb_vmPushSymbol( &hb_symEval );
hb_vmPush( pObject ); /* Push block */
for( uiParam = 1; uiParam <= uiPCount; uiParam++ )
hb_vmPush( hb_param( uiParam, HB_IT_ANY ) );
hb_vmPush( pObject ); /* Push block */
for( uiParam = 1; uiParam <= uiPCount; ++uiParam )
hb_vmPush( hb_stackItemFromBase( uiParam ) );
hb_vmDo( ( USHORT ) uiPCount ); /* Self is also an argument */
hb_vmDo( ( USHORT ) uiPCount );
}
else
hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, "EVAL", 0 );
hb_itemRelease( pObject );
hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, "EVAL", pObject ? 1 : 0, pObject );
}
/* ================================================ */
@@ -2295,60 +2235,48 @@ static HARBOUR hb___msgClsName( void )
*/
static HARBOUR hb___msgClsSel( void )
{
HB_ITEM_PTR pSelf = hb_stackSelfItem();
USHORT uiClass = ( USHORT ) ( HB_IS_ARRAY( pSelf )
? pSelf->item.asArray.value->uiClass : 0 );
/* Get class word */
PHB_ITEM pReturn = hb_itemNew( NULL );
USHORT nParam = HB_MSGLISTALL;
USHORT uiPCount = hb_pcount();
PHB_ITEM pSelf = hb_stackSelfItem();
USHORT uiClass;
if( uiPCount >= 1 )
{
nParam = ( USHORT ) hb_parni( 1 );
}
if( HB_IS_BYREF( pSelf ) )
pSelf = hb_itemUnRef( pSelf );
if( ( ! uiClass ) && HB_IS_BYREF( pSelf ) )
{ /* Variables by reference */
PHB_ITEM pItemRef = hb_itemUnRef( pSelf );
if( HB_IS_ARRAY( pItemRef ) )
uiClass = pItemRef->item.asArray.value->uiClass;
}
uiClass = hb_objGetClass( pSelf );
if( uiClass && uiClass <= s_uiClasses )
{
PCLASS pClass = s_pClasses + ( uiClass - 1 );
USHORT uiLimit = ( USHORT ) ( pClass->uiHashKey * BUCKET ); /* Number of Hash keys */
USHORT uiPos = 0;
USHORT uiAt;
USHORT uiPos = 0, uiAt;
USHORT nParam;
nParam = hb_pcount() > 0 ? ( USHORT ) hb_parni( 1 ) : HB_MSGLISTALL;
hb_arrayNew( pReturn, pClass->uiMethods );
for( uiAt = 0; uiAt < uiLimit && uiPos < pClass->uiMethods; uiAt++ )
{
PHB_DYNS pMessage = ( PHB_DYNS ) pClass->pMethods[ uiAt ].pMessage;
s_pMethod = NULL; /* Current method pointer */
if( pMessage ) /* Hash Entry used ? */
{
s_pMethod = pClass->pMethods + uiAt;
PMETHOD pMethod = pClass->pMethods + uiAt;
if( ( nParam == HB_MSGLISTALL ) ||
( nParam == HB_MSGLISTCLASS &&
(
( s_pMethod->pFuncSym == &s___msgSetClsData ) ||
( s_pMethod->pFuncSym == &s___msgGetClsData ) ||
( s_pMethod->pFuncSym == &s___msgSetShrData ) ||
( s_pMethod->pFuncSym == &s___msgGetShrData )
( pMethod->pFuncSym == &s___msgSetClsData ) ||
( pMethod->pFuncSym == &s___msgGetClsData ) ||
( pMethod->pFuncSym == &s___msgSetShrData ) ||
( pMethod->pFuncSym == &s___msgGetShrData )
)
) ||
( nParam == HB_MSGLISTPURE &&
!(
( s_pMethod->pFuncSym == &s___msgSetClsData ) ||
( s_pMethod->pFuncSym == &s___msgGetClsData ) ||
( s_pMethod->pFuncSym == &s___msgSetShrData ) ||
( s_pMethod->pFuncSym == &s___msgGetShrData )
( pMethod->pFuncSym == &s___msgSetClsData ) ||
( pMethod->pFuncSym == &s___msgGetClsData ) ||
( pMethod->pFuncSym == &s___msgSetShrData ) ||
( pMethod->pFuncSym == &s___msgGetShrData )
)
)
)
@@ -2358,9 +2286,12 @@ static HARBOUR hb___msgClsSel( void )
}
}
}
if( uiPos < pClass->uiMethods )
hb_arraySize( pReturn, uiPos );
hb_itemRelease( hb_itemReturn( pReturn ) );
}
hb_itemRelease( hb_itemReturn( pReturn ) );
else
hb_ret();
}
#if 0
@@ -2450,20 +2381,52 @@ static HARBOUR hb___msgEvalInline( void )
static HARBOUR hb___msgEval( void )
{
HB_ITEM_PTR pSelf = hb_stackSelfItem();
if( HB_IS_BLOCK( pSelf ) )
{
USHORT uiParam;
USHORT uiPCount=hb_pcount();
USHORT uiPCount = hb_pcount();
hb_vmPushSymbol( &hb_symEval );
hb_vmPush( pSelf ); /* Push block */
hb_vmPush( pSelf );
for( uiParam = 1; uiParam <= uiPCount; uiParam++ )
hb_vmPush( hb_param( uiParam, HB_IT_ANY ) );
hb_vmPush( hb_stackItemFromBase( uiParam ) );
hb_vmDo( ( USHORT ) uiPCount ); /* Self is also an argument */
hb_vmDo( ( USHORT ) uiPCount );
}
else
hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, "EVAL", 0 );
hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, "EVAL", 1, pSelf );
}
/*
* __msgNoMethod()
*
* Internal function for generating error when not existing message is sent
*/
static HARBOUR hb___msgNoMethod( void )
{
PHB_ITEM pSelf = hb_stackSelfItem();
PHB_SYMB pSym = hb_itemGetSymbol( hb_stackBaseItem() );
#if 1 /* Clipper compatible error message */
if( pSym->szName[ 0 ] == '_' )
hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, pSelf );
else
hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, 1, pSelf );
#else
char szDesc[ 128 ];
if( pSym->szName[ 0 ] == '_' )
{
sprintf( szDesc, "Class: '%s' has no property", hb_objGetClsName( pSelf ) );
hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, szDesc, pSym->szName + 1, HB_ERR_ARGS_BASEPARAMS );
}
else
{
sprintf( szDesc, "Class: '%s' has no exported method", hb_objGetClsName( pSelf ) );
hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, szDesc, pSym->szName, HB_ERR_ARGS_BASEPARAMS );
}
#endif
}
/*

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

@@ -3224,7 +3224,6 @@ static void hb_vmEnumNext( void )
for( i = ( int ) hb_stackItemFromTop( -2 )->item.asLong.value; i > 0; --i )
{
// pEnum = hb_itemUnRefRefer( hb_stackItemFromTop( -( i << 1 ) - 1 ) );
pEnum = hb_itemUnRefOnce( hb_stackItemFromTop( -( i << 1 ) - 1 ) );
if( HB_IS_ARRAY( pEnum->item.asEnum.basePtr ) )
{
@@ -3263,7 +3262,6 @@ static void hb_vmEnumPrev( void )
for( i = hb_stackItemFromTop( -2 )->item.asLong.value; i > 0; --i )
{
// pEnum = hb_itemUnRefRefer( hb_stackItemFromTop( -( i << 1 ) - 1 ) );
pEnum = hb_itemUnRefOnce( hb_stackItemFromTop( -( i << 1 ) - 1 ) );
if( HB_IS_ARRAY( pEnum->item.asEnum.basePtr ) )
{
@@ -3931,15 +3929,9 @@ HB_EXPORT void hb_vmDo( USHORT uiParams )
#endif
}
else if( pSym->szName[ 0 ] == '_' )
{
hb_vmArrayGen( uiParams );
hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, hb_stackItemFromTop( -1 ) );
}
hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, pSelf );
else
{
hb_vmArrayGen( uiParams );
hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, 1, hb_stackItemFromTop( -1 ) );
}
hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, 1, pSelf );
if( lPopSuper )
hb_objPopSuperCast( pSelf );
@@ -3973,13 +3965,7 @@ HB_EXPORT void hb_vmDo( USHORT uiParams )
#endif
}
else
{
/* Attempt to call an undefined function
* - generate unrecoverable runtime error
*/
hb_vmArrayGen( uiParams );
hb_errRT_BASE_SubstR( EG_NOFUNC, 1001, NULL, pSym->szName, 1, hb_stackItemFromTop( -1 ) );
}
hb_errRT_BASE_SubstR( EG_NOFUNC, 1001, NULL, pSym->szName, HB_ERR_ARGS_BASEPARAMS );
}
if( s_bDebugging )
@@ -4039,7 +4025,6 @@ HB_EXPORT void hb_vmSend( USHORT uiParams )
{
/* method of enumerator variable from FOR EACH statement
*/
//HB_ITEM_PTR pEnum = hb_itemUnRefRefer( pSelf );
HB_ITEM_PTR pEnum = hb_itemUnRefOnce( pSelf );
if( HB_IS_ENUM( pEnum ) )
@@ -4089,23 +4074,10 @@ HB_EXPORT void hb_vmSend( USHORT uiParams )
hb_mthAddTime( pMethod, clock() - ulClock );
#endif
}
else if( pSym->szName[ 0 ] == '_' )
hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, pSelf );
else
{
char sDesc[128];
if( pSym->szName[ 0 ] == '_' )
{
sprintf( (char *) sDesc, "Class: '%s' has no property", hb_objGetClsName( pSelf ) );
hb_vmArrayGen( uiParams );
hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, (char *) sDesc, pSym->szName + 1, 1, hb_stackItemFromTop( -1 ) );
}
else
{
sprintf( (char *) sDesc, "Class: '%s' has no exported method", hb_objGetClsName( pSelf ) );
hb_vmArrayGen( uiParams );
hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, (char *) sDesc, pSym->szName, 1, hb_stackItemFromTop( -1 ) );
}
}
hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, 1, pSelf );
if( lPopSuper )
hb_objPopSuperCast( pSelf );