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

2007-09-28 14:08 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/include/hbapi.h
  * harbour/source/vm/itemapi.c
  * harbour/source/vm/garbage.c
    + added extended item references - it's universal reference which
      can be used by HVM for many different things without introducing
      new item types

  * harbour/include/hbexprb.c
    * respect -ks compiler also with <op>=, --, ++ operators

  * harbour/include/hbvm.h
  * harbour/source/vm/hvm.c
  * harbour/source/vm/classes.c
    + added extended references for SETGET methods used as object
      item references
    * use extended references to respect overloaded [] operator in
      object item references
    + added support for passing indexes to string item characters
      ( @cValue[n] ) by reference using extended references - extension
      enabled by -ks compiler switch and //flags:s RT switch. 
    + added hb_vmPushItemRef()

  * harbour/source/rdd/dbf1.c
  * harbour/source/rdd/usrrdd/usrrdd.c
    * use hb_vmPushItemRef()

  * harbour/contrib/xhb/xhbcomp.prg
  * harbour/contrib/xhb/xhbmsgs.c
    * overload +, -, *, %, ^, ++, -- in string and numeric scalar
      classes to emulated xHarbour behavior when 1 byte string is
      used as numeric value.
      Note: <nun> + <char1> in XHB lib gives numeric value when in
            xHarbour character. But because <nun> <anyOtherOper> <char1>
            in xHarbour gives numeric value then I guess that it's
            xHarbour bug and I should not replicate it, f.e.:
               proc main()
                  ? 1+"A", 131-"A", 33 * 2, 132 / chr(2), 133 % "C"
               return
    * overload +, - in hash scalar class to emulated xHarbour behavior
      for <hash> + <hash> and <hash> - <hash>
      Seems that now we can remove HB_COMPAT_XHB flag from HVM and keep
      Harbour compatibility only with -ks compile time switch and XHB
      library. Please make some tests with Harbour compiled without
      HB_COMPAT_XHB and xHarbour code using REQUEST XHB_LIB. It's possible
      that I missed sth but some basic test shows that our emulation is
      better then original and addresses places where xHarbour does not
      work at all or gives strange results, f.e.:

         #ifndef __XHARBOUR__
            request XHB_LIB
         #endif
         proc main()
            local h:={"ABC"=>123.45}
            ? h:abc
            h:abc+=1000   ; ? h:abc
            h["ABC"]+=1000; ? h:abc
            p(@h:abc)     ; ? h:abc
            p(@h["ABC"])  ; ? h:abc
         return
         proc p(x)
            x+=1000
         return

      or:

         #ifndef __XHARBOUR__
            request XHB_LIB
         #endif
         #include "hbclass.ch"
         proc main()
            local o:=myClass():new()
            o:setget:="ABC"; ? o:setget
            o:setget[2]:=42; ? o:setget
            o:setget[2]+=42; ? o:setget
            ? o:setget[2]+=42; ? o:setget
            ?
            o:var:="ABC"; ? o:var
            o:var[2]:=42; ? o:var
            o:var[2]+=42; ? o:var
            ? o:var[2]+=42; ? o:var
         return
         CREATE CLASS myClass
            VAR    var
            METHOD setget SETGET
         END CLASS
         METHOD setget( xNewVal ) CLASS myClass
            IF pcount() > 0
               ::var := xNewVal
            ENDIF
         RETURN ::var

  * harbour/include/hbapirdd.h
  * harbour/source/rdd/dbcmd.c
  * harbour/source/rdd/workarea.c
  * harbour/source/rdd/dbf1.c
  * harbour/source/rdd/dbffpt/dbffpt1.c
  * harbour/source/rdd/dbfcdx/dbfcdx1.c
  * harbour/source/rdd/dbfdbt/dbfdbt1.c
  * harbour/source/rdd/usrrdd/usrrdd.c
  * harbour/contrib/rdd_ads/ads1.c
    * changed second parameter in RELTEXT() method to PHB_ITEM
      Now RELTEXT() works like FILTERTEXT() and the size of
      expression is not limited. It's a modification I wanted
      to make for a long time and I think that now is a good
      moment to make it together with HB_FT_* modifications
    - rmoved not longer necessary HARBOUR_MAX_RDD_RELTEXT_LENGTH

  * harbour/source/rtl/gttrm/gttrm.c
    * small cleanup
This commit is contained in:
Przemyslaw Czerpak
2007-09-28 12:08:46 +00:00
parent 52cf61b74b
commit af5038b272
20 changed files with 1006 additions and 218 deletions
Download Patch File Download Diff File Expand all files Collapse all files

111
harbour/ChangeLog
View File

@@ -8,6 +8,117 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-09-28 14:08 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/hbapi.h
* harbour/source/vm/itemapi.c
* harbour/source/vm/garbage.c
+ added extended item references - it's universal reference which
can be used by HVM for many different things without introducing
new item types
* harbour/include/hbexprb.c
* respect -ks compiler also with <op>=, --, ++ operators
* harbour/include/hbvm.h
* harbour/source/vm/hvm.c
* harbour/source/vm/classes.c
+ added extended references for SETGET methods used as object
item references
* use extended references to respect overloaded [] operator in
object item references
+ added support for passing indexes to string item characters
( @cValue[n] ) by reference using extended references - extension
enabled by -ks compiler switch and //flags:s RT switch.
+ added hb_vmPushItemRef()
* harbour/source/rdd/dbf1.c
* harbour/source/rdd/usrrdd/usrrdd.c
* use hb_vmPushItemRef()
* harbour/contrib/xhb/xhbcomp.prg
* harbour/contrib/xhb/xhbmsgs.c
* overload +, -, *, %, ^, ++, -- in string and numeric scalar
classes to emulated xHarbour behavior when 1 byte string is
used as numeric value.
Note: <nun> + <char1> in XHB lib gives numeric value when in
xHarbour character. But because <nun> <anyOtherOper> <char1>
in xHarbour gives numeric value then I guess that it's
xHarbour bug and I should not replicate it, f.e.:
proc main()
? 1+"A", 131-"A", 33 * 2, 132 / chr(2), 133 % "C"
return
* overload +, - in hash scalar class to emulated xHarbour behavior
for <hash> + <hash> and <hash> - <hash>
Seems that now we can remove HB_COMPAT_XHB flag from HVM and keep
Harbour compatibility only with -ks compile time switch and XHB
library. Please make some tests with Harbour compiled without
HB_COMPAT_XHB and xHarbour code using REQUEST XHB_LIB. It's possible
that I missed sth but some basic test shows that our emulation is
better then original and addresses places where xHarbour does not
work at all or gives strange results, f.e.:
#ifndef __XHARBOUR__
request XHB_LIB
#endif
proc main()
local h:={"ABC"=>123.45}
? h:abc
h:abc+=1000 ; ? h:abc
h["ABC"]+=1000; ? h:abc
p(@h:abc) ; ? h:abc
p(@h["ABC"]) ; ? h:abc
return
proc p(x)
x+=1000
return
or:
#ifndef __XHARBOUR__
request XHB_LIB
#endif
#include "hbclass.ch"
proc main()
local o:=myClass():new()
o:setget:="ABC"; ? o:setget
o:setget[2]:=42; ? o:setget
o:setget[2]+=42; ? o:setget
? o:setget[2]+=42; ? o:setget
?
o:var:="ABC"; ? o:var
o:var[2]:=42; ? o:var
o:var[2]+=42; ? o:var
? o:var[2]+=42; ? o:var
return
CREATE CLASS myClass
VAR var
METHOD setget SETGET
END CLASS
METHOD setget( xNewVal ) CLASS myClass
IF pcount() > 0
::var := xNewVal
ENDIF
RETURN ::var
* harbour/include/hbapirdd.h
* harbour/source/rdd/dbcmd.c
* harbour/source/rdd/workarea.c
* harbour/source/rdd/dbf1.c
* harbour/source/rdd/dbffpt/dbffpt1.c
* harbour/source/rdd/dbfcdx/dbfcdx1.c
* harbour/source/rdd/dbfdbt/dbfdbt1.c
* harbour/source/rdd/usrrdd/usrrdd.c
* harbour/contrib/rdd_ads/ads1.c
* changed second parameter in RELTEXT() method to PHB_ITEM
Now RELTEXT() works like FILTERTEXT() and the size of
expression is not limited. It's a modification I wanted
to make for a long time and I think that now is a good
moment to make it together with HB_FT_* modifications
- rmoved not longer necessary HARBOUR_MAX_RDD_RELTEXT_LENGTH
* harbour/source/rtl/gttrm/gttrm.c
* small cleanup
2007-09-28 11:56 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* source/compiler/hbusage.c
! Show the -ks switch only when compiled with HB_COMPAT_XHB.

2
harbour/contrib/rdd_ads/ads1.c
View File

@@ -4661,7 +4661,7 @@ static const RDDFUNCS adsTable = { ( DBENTRYP_BP ) adsBof,
( DBENTRYP_V ) adsForceRel,
( DBENTRYP_SVP ) adsRelArea,
( DBENTRYP_VR ) adsRelEval,
( DBENTRYP_SVP ) adsRelText,
( DBENTRYP_SI ) adsRelText,
( DBENTRYP_VR ) adsSetRel,
( DBENTRYP_OI ) adsOrderListAdd,
( DBENTRYP_V ) adsOrderListClear,

22
harbour/contrib/xhb/xhbcomp.prg
View File

@@ -58,12 +58,32 @@ ANNOUNCE XHB_LIB
INIT PROCEDURE xhb_Init()
/* Add calls to do initial settings to Harbour to be more compatible with xhb. */
ASSOCIATE CLASS xhb_Character WITH TYPE Character
ASSOCIATE CLASS xhb_Numeric WITH TYPE Numeric
ASSOCIATE CLASS xhb_Array WITH TYPE Array
ASSOCIATE CLASS xhb_Hash WITH TYPE Hash
RETURN
CREATE CLASS Character INHERIT HBScalar FUNCTION xhb_Character
OPERATOR "[]" FUNCTION XHB_INDEX()
OPERATOR "+" FUNCTION XHB_PLUS()
OPERATOR "-" FUNCTION XHB_MINUS()
OPERATOR "*" FUNCTION XHB_MULT()
OPERATOR "/" FUNCTION XHB_DIV()
OPERATOR "%" FUNCTION XHB_MOD()
OPERATOR "^" FUNCTION XHB_POW()
OPERATOR "++" FUNCTION XHB_INC()
OPERATOR "--" FUNCTION XHB_DEC()
ENDCLASS
CREATE CLASS Numeric INHERIT HBScalar FUNCTION xhb_Numeric
OPERATOR "+" FUNCTION XHB_PLUS()
OPERATOR "-" FUNCTION XHB_MINUS()
OPERATOR "*" FUNCTION XHB_MULT()
OPERATOR "/" FUNCTION XHB_DIV()
OPERATOR "%" FUNCTION XHB_MOD()
OPERATOR "^" FUNCTION XHB_POW()
OPERATOR "++" FUNCTION XHB_INC()
OPERATOR "--" FUNCTION XHB_DEC()
ENDCLASS
CREATE CLASS Array INHERIT HBScalar FUNCTION xhb_Array
@@ -73,5 +93,7 @@ ENDCLASS
CREATE CLASS Hash INHERIT HBScalar FUNCTION xhb_Hash
ON ERROR FUNCTION XHB_HASHERROR()
OPERATOR "+" FUNCTION XHB_PLUS()
OPERATOR "-" FUNCTION XHB_MINUS()
OPERATOR "$$" FUNCTION XHB_INCLUDE()
ENDCLASS

237
harbour/contrib/xhb/xhbmsgs.c
View File

@@ -54,6 +54,7 @@
#include "hbapierr.h"
#include "hbapilng.h"
#include "hbstack.h"
#include "hbmath.h"
HB_FUNC( XHB_HASHERROR )
{
@@ -198,3 +199,239 @@ HB_FUNC( XHB_INDEX )
}
}
}
HB_FUNC( XHB_PLUS )
{
PHB_ITEM pSelf = hb_stackSelfItem();
PHB_ITEM pValue = hb_param( 1, HB_IT_ANY );
if( HB_IS_NUMERIC( pSelf ) && hb_itemGetCLen( pValue ) == 1 )
{
UCHAR uc = ( UCHAR ) hb_itemGetCPtr( pValue )[0];
int iDec;
double dValue = hb_itemGetNDDec( pSelf, &iDec );
hb_retnlen( dValue + uc, 0, iDec );
}
else if( HB_IS_STRING( pSelf ) && hb_itemGetCLen( pSelf ) == 1 &&
pValue && HB_IS_NUMERIC( pValue ) )
{
UCHAR uc = ( UCHAR ) hb_itemGetCPtr( pSelf )[0];
uc += hb_itemGetNI( pValue );
hb_retclen( ( char * ) &uc, 1 );
}
else if( HB_IS_HASH( pSelf ) && HB_IS_HASH( pValue ) )
{
PHB_ITEM pHash = hb_hashClone( pSelf );
hb_hashJoin( pHash, pValue, HB_HASH_UNION );
hb_itemReturnRelease( pHash );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1081, NULL, "+", 2, pSelf, pValue );
if( pResult )
hb_itemReturnRelease( pResult );
}
}
HB_FUNC( XHB_MINUS )
{
PHB_ITEM pSelf = hb_stackSelfItem();
PHB_ITEM pValue = hb_param( 1, HB_IT_ANY );
if( HB_IS_NUMERIC( pSelf ) && hb_itemGetCLen( pValue ) == 1 )
{
UCHAR uc = ( UCHAR ) hb_itemGetCPtr( pValue )[0];
int iDec;
double dValue = hb_itemGetNDDec( pSelf, &iDec );
hb_retnlen( dValue - uc, 0, iDec );
}
else if( HB_IS_STRING( pSelf ) && hb_itemGetCLen( pSelf ) == 1 &&
pValue && HB_IS_NUMERIC( pValue ) )
{
UCHAR uc = ( UCHAR ) hb_itemGetCPtr( pSelf )[0];
uc -= hb_itemGetNI( pValue );
hb_retclen( ( char * ) &uc, 1 );
}
else if( HB_IS_HASH( pSelf ) && HB_IS_HASH( pValue ) )
{
PHB_ITEM pHash = hb_hashClone( pSelf );
hb_hashRemove( pHash, pValue );
hb_itemReturnRelease( pHash );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1082, NULL, "-", 2, pSelf, pValue );
if( pResult )
hb_itemReturnRelease( pResult );
}
}
HB_FUNC( XHB_INC )
{
PHB_ITEM pSelf = hb_stackSelfItem();
if( HB_IS_NUMERIC( pSelf ) )
hb_retnd( hb_itemGetND( pSelf ) + 1 );
else if( HB_IS_STRING( pSelf ) && hb_itemGetCLen( pSelf ) == 1 )
{
UCHAR uc = ( UCHAR ) hb_itemGetCPtr( pSelf )[0] + 1;
hb_retclen( ( char * ) &uc, 1 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1086, NULL, "++", 1, pSelf );
if( pResult )
hb_itemReturnRelease( pResult );
}
}
HB_FUNC( XHB_DEC )
{
PHB_ITEM pSelf = hb_stackSelfItem();
if( HB_IS_NUMERIC( pSelf ) )
hb_retnd( hb_itemGetND( pSelf ) - 1 );
else if( HB_IS_STRING( pSelf ) && hb_itemGetCLen( pSelf ) == 1 )
{
UCHAR uc = ( UCHAR ) hb_itemGetCPtr( pSelf )[0] - 1;
hb_retclen( ( char * ) &uc, 1 );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1087, NULL, "--", 1, pSelf );
if( pResult )
hb_itemReturnRelease( pResult );
}
}
HB_FUNC( XHB_MULT )
{
PHB_ITEM pSelf = hb_stackSelfItem();
PHB_ITEM pValue = hb_param( 1, HB_IT_ANY );
if( HB_IS_NUMERIC( pSelf ) && hb_itemGetCLen( pValue ) == 1 )
{
UCHAR uc = ( UCHAR ) hb_itemGetCPtr( pValue )[0];
int iDec;
double dValue = hb_itemGetNDDec( pSelf, &iDec );
hb_retndlen( dValue * uc, 0, iDec );
}
else if( HB_IS_STRING( pSelf ) && hb_itemGetCLen( pSelf ) == 1 &&
pValue && HB_IS_NUMERIC( pValue ) )
{
UCHAR uc = ( UCHAR ) hb_itemGetCPtr( pSelf )[0];
int iDec;
double dValue = hb_itemGetNDDec( pValue, &iDec );
hb_retndlen( ( double ) uc * dValue, 0, iDec );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1083, NULL, "*", 2, pSelf, pValue );
if( pResult )
hb_itemReturnRelease( pResult );
}
}
HB_FUNC( XHB_DIV )
{
PHB_ITEM pSelf = hb_stackSelfItem();
PHB_ITEM pValue = hb_param( 1, HB_IT_ANY );
if( HB_IS_NUMERIC( pSelf ) && hb_itemGetCLen( pValue ) == 1 )
{
UCHAR uc = ( UCHAR ) hb_itemGetCPtr( pValue )[0];
if( uc == 0 )
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ZERODIV, 1340, NULL, "/", 2, pSelf, pValue );
if( pResult )
hb_itemReturnRelease( pResult );
}
else
hb_retnd( hb_itemGetND( pSelf ) / uc );
}
else if( HB_IS_STRING( pSelf ) && hb_itemGetCLen( pSelf ) == 1 &&
pValue && HB_IS_NUMERIC( pValue ) )
{
UCHAR uc = ( UCHAR ) hb_itemGetCPtr( pSelf )[0];
double dDivisor = hb_itemGetND( pValue );
if( dDivisor == 0 )
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ZERODIV, 1340, NULL, "/", 2, pSelf, pValue );
if( pResult )
hb_itemReturnRelease( pResult );
}
else
hb_retnd( ( double ) uc / dDivisor );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1084, NULL, "/", 2, pSelf, pValue );
if( pResult )
hb_itemReturnRelease( pResult );
}
}
HB_FUNC( XHB_MOD )
{
PHB_ITEM pSelf = hb_stackSelfItem();
PHB_ITEM pValue = hb_param( 1, HB_IT_ANY );
if( HB_IS_NUMERIC( pSelf ) && hb_itemGetCLen( pValue ) == 1 )
{
UCHAR uc = ( UCHAR ) hb_itemGetCPtr( pValue )[0];
if( uc == 0 )
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ZERODIV, 1341, NULL, "%", 2, pSelf, pValue );
if( pResult )
hb_itemReturnRelease( pResult );
}
else
hb_retnd( fmod( hb_itemGetND( pSelf ), ( double ) uc ) );
}
else if( HB_IS_STRING( pSelf ) && hb_itemGetCLen( pSelf ) == 1 &&
pValue && HB_IS_NUMERIC( pValue ) )
{
UCHAR uc = ( UCHAR ) hb_itemGetCPtr( pSelf )[0];
double dDivisor = hb_itemGetND( pValue );
if( dDivisor == 0 )
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ZERODIV, 1341, NULL, "%", 2, pSelf, pValue );
if( pResult )
hb_itemReturnRelease( pResult );
}
else
hb_retnd( fmod( ( double ) uc, dDivisor ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1085, NULL, "%", 2, pSelf, pValue );
if( pResult )
hb_itemReturnRelease( pResult );
}
}
HB_FUNC( XHB_POW )
{
PHB_ITEM pSelf = hb_stackSelfItem();
PHB_ITEM pValue = hb_param( 1, HB_IT_ANY );
if( HB_IS_NUMERIC( pSelf ) && hb_itemGetCLen( pValue ) == 1 )
{
UCHAR uc = ( UCHAR ) hb_itemGetCPtr( pValue )[0];
hb_retnd( pow( hb_itemGetND( pSelf ), ( double ) uc ) );
}
else if( HB_IS_STRING( pSelf ) && hb_itemGetCLen( pSelf ) == 1 &&
pValue && HB_IS_NUMERIC( pValue ) )
{
UCHAR uc = ( UCHAR ) hb_itemGetCPtr( pSelf )[0];
hb_retnd( pow( ( double ) uc, hb_itemGetND( pValue ) ) );
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1088, NULL, "^", 2, pSelf, pValue );
if( pResult )
hb_itemReturnRelease( pResult );
}
}

28
harbour/include/hbapi.h
View File

@@ -90,11 +90,12 @@ HB_EXTERN_BEGIN
#define HB_IT_MEMVAR ( ( HB_TYPE ) 0x04000 )
#define HB_IT_ARRAY ( ( HB_TYPE ) 0x08000 )
#define HB_IT_ENUM ( ( HB_TYPE ) 0x10000 )
#define HB_IT_EXTREF ( ( HB_TYPE ) 0x20000 )
#define HB_IT_OBJECT HB_IT_ARRAY
#define HB_IT_NUMERIC ( ( HB_TYPE ) ( HB_IT_INTEGER | HB_IT_LONG | HB_IT_DOUBLE ) )
#define HB_IT_NUMINT ( ( HB_TYPE ) ( HB_IT_INTEGER | HB_IT_LONG ) )
#define HB_IT_ANY ( ( HB_TYPE ) 0xFFFFFFFF )
#define HB_IT_COMPLEX ( ( HB_TYPE ) ( HB_IT_BLOCK | HB_IT_ARRAY | HB_IT_HASH | HB_IT_POINTER | /* HB_IT_MEMVAR | HB_IT_ENUM |*/ HB_IT_BYREF | HB_IT_STRING ) )
#define HB_IT_COMPLEX ( ( HB_TYPE ) ( HB_IT_BLOCK | HB_IT_ARRAY | HB_IT_HASH | HB_IT_POINTER | /* HB_IT_MEMVAR | HB_IT_ENUM | HB_IT_EXTREF |*/ HB_IT_BYREF | HB_IT_STRING ) )
#define HB_IT_GCITEM ( ( HB_TYPE ) ( HB_IT_BLOCK | HB_IT_ARRAY | HB_IT_HASH | HB_IT_POINTER | HB_IT_BYREF ) )
#define HB_IT_HASHKEY ( ( HB_TYPE ) ( HB_IT_INTEGER | HB_IT_LONG | HB_IT_DOUBLE | HB_IT_DATE | HB_IT_STRING ) )
@@ -134,6 +135,7 @@ HB_EXTERN_BEGIN
#define HB_IS_MEMVAR( p ) HB_IS_OF_TYPE( p, HB_IT_MEMVAR )
#define HB_IS_MEMO( p ) HB_IS_OF_TYPE( p, HB_IT_MEMO )
#define HB_IS_ENUM( p ) HB_IS_OF_TYPE( p, HB_IT_ENUM )
#define HB_IS_EXTREF( p ) HB_IS_OF_TYPE( p, HB_IT_EXTREF )
#define HB_IS_STRING( p ) ( ( HB_ITEM_TYPE( p ) & ~( HB_IT_BYREF | HB_IT_MEMOFLAG ) ) == HB_IT_STRING )
#define HB_IS_BYREF( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_BYREF ) != 0 )
#define HB_IS_NUMERIC( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_NUMERIC ) != 0 )
@@ -166,6 +168,7 @@ HB_EXTERN_BEGIN
#define HB_IS_MEMO( p ) ( HB_ITEM_TYPE( p ) == HB_IT_MEMO )
#define HB_IS_MEMVAR( p ) ( HB_ITEM_TYPE( p ) == ( HB_IT_MEMVAR | HB_IT_BYREF ) )
#define HB_IS_ENUM( p ) ( HB_ITEM_TYPE( p ) == ( HB_IT_ENUM | HB_IT_BYREF ) )
#define HB_IS_EXTREF( p ) ( HB_ITEM_TYPE( p ) == ( HB_IT_EXTREF | HB_IT_BYREF ) )
#define HB_IS_STRING( p ) ( ( HB_ITEM_TYPE( p ) & ~HB_IT_MEMOFLAG ) == HB_IT_STRING )
#define HB_IS_BYREF( p ) ( ( HB_ITEM_TYPE( p ) & ~HB_IT_MEMVAR ) == HB_IT_BYREF )
#define HB_IS_NUMERIC( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_NUMERIC ) != 0 )
@@ -197,6 +200,7 @@ HB_EXTERN_BEGIN
#define HB_IS_STRING( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_STRING ) != 0 )
#define HB_IS_MEMVAR( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_MEMVAR ) != 0 )
#define HB_IS_ENUM( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_ENUM ) != 0 )
#define HB_IS_EXTREF( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_EXTREF ) != 0 )
#define HB_IS_BYREF( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_BYREF ) != 0 )
#define HB_IS_NUMERIC( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_NUMERIC ) != 0 )
#define HB_IS_NUMINT( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_NUMINT ) != 0 )
@@ -233,6 +237,7 @@ struct _HB_BASEARRAY;
struct _HB_BASEHASH;
struct _HB_ITEM;
struct _HB_VALUE;
struct _HB_EXTREF;
typedef struct _HB_STACK_STATE
{
@@ -326,6 +331,12 @@ struct hb_struEnum
LONG offset;
};
struct hb_struExtRef
{
void * value; /* value item pointer */
const struct _HB_EXTREF * func; /* extended reference functions */
};
struct hb_struString
{
ULONG length;
@@ -367,6 +378,7 @@ typedef struct _HB_ITEM
struct hb_struMemvar asMemvar;
struct hb_struRefer asRefer;
struct hb_struEnum asEnum;
struct hb_struExtRef asExtRef;
struct hb_struString asString;
struct hb_struSymbol asSymbol;
struct hb_struRecover asRecover;
@@ -409,6 +421,20 @@ typedef struct _HB_VALUE
HB_HANDLE hPrevMemvar;
} HB_VALUE, * PHB_VALUE, * HB_VALUE_PTR;
typedef void ( * HB_EXTREF_FUNC0 )( void * );
typedef PHB_ITEM ( * HB_EXTREF_FUNC1 )( PHB_ITEM );
typedef PHB_ITEM ( * HB_EXTREF_FUNC2 )( PHB_ITEM, PHB_ITEM );
typedef void ( * HB_EXTREF_FUNC3 )( PHB_ITEM );
typedef struct _HB_EXTREF
{
HB_EXTREF_FUNC1 read;
HB_EXTREF_FUNC2 write;
HB_EXTREF_FUNC3 copy;
HB_EXTREF_FUNC0 clear;
HB_EXTREF_FUNC0 mark;
} HB_EXTREF, * PHB_EXTREF, * HB_EXTREF_PTR;
typedef struct _HB_NESTED_CLONED
{
void * value;

5
harbour/include/hbapirdd.h
View File

@@ -69,9 +69,6 @@ HB_EXTERN_BEGIN
/* #define HARBOUR_MAX_RDD_FIELDNAME_LENGTH 32 */
#define HARBOUR_MAX_RDD_AREA_NUM 65535
#define HARBOUR_MAX_RDD_RELTEXT_LENGTH 256
/* DBCMD errors */
#define EDBCMD_SEEK_BADPARAMETER 1001
@@ -710,7 +707,7 @@ typedef struct _RDDFUNCS
DBENTRYP_V forceRel; /* Force relational seeks in the specified WorkArea. */
DBENTRYP_SVP relArea; /*-Obtain the workarea number of the specified relation. */
DBENTRYP_VR relEval; /*-Evaluate a block against the relation in specified WorkArea. */
DBENTRYP_SVP relText; /*-Obtain the character expression of the specified relation. */
DBENTRYP_SI relText; /*-Obtain the character expression of the specified relation. */
DBENTRYP_VR setRel; /*-Set a relation in the parent file. */

56
harbour/include/hbexprb.c
View File

@@ -1305,7 +1305,25 @@ static HB_EXPR_FUNC( hb_compExprUseArrayAt )
{
fMacroIndex = pSelf->value.asList.pIndex->value.asList.reference;
}
HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_PUSH_PCODE );
if( pSelf->value.asList.reference && HB_SUPPORT_ARRSTR )
{
if( pSelf->value.asList.pExprList->ExprType == HB_ET_VARIABLE )
{
pSelf->value.asList.pExprList->ExprType = HB_ET_VARREF;
HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_PUSH_PCODE );
pSelf->value.asList.pExprList->ExprType = HB_ET_VARIABLE;
}
else if( pSelf->value.asList.pExprList->ExprType == HB_ET_SEND )
{
hb_compExprPushSendPop( pSelf->value.asList.pExprList, HB_COMP_PARAM );
HB_GEN_FUNC1( PCode1, HB_P_PUSHOVARREF );
}
else
HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_PUSH_PCODE );
}
else
HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_PUSH_PCODE );
HB_EXPR_USE( pSelf->value.asList.pIndex, HB_EA_PUSH_PCODE );
if( fMacroIndex )
HB_GEN_FUNC1( PCode1, HB_P_MACROPUSHINDEX );
@@ -1318,17 +1336,7 @@ static HB_EXPR_FUNC( hb_compExprUseArrayAt )
case HB_EA_POP_PCODE:
{
BOOL fMacroIndex = FALSE, bRemoveRef = FALSE;
/* to manage strings as bytes arrays, they must be pushed by reference */
/* arrays also are passed by reference */
if( pSelf->value.asList.pExprList->ExprType == HB_ET_VARIABLE )
{
if( HB_SUPPORT_ARRSTR )
{
pSelf->value.asList.pExprList->ExprType = HB_ET_VARREF;
bRemoveRef = TRUE;
}
}
BOOL fMacroIndex = FALSE;
if( pSelf->value.asList.pIndex->ExprType == HB_ET_MACRO )
{
if( HB_SUPPORT_XBASE )
@@ -1346,13 +1354,31 @@ static HB_EXPR_FUNC( hb_compExprUseArrayAt )
{
fMacroIndex = pSelf->value.asList.pIndex->value.asList.reference;
}
HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_PUSH_PCODE );
/* to manage strings as bytes arrays, they must be pushed by reference */
/* arrays also are passed by reference */
if( HB_SUPPORT_ARRSTR )
{
if( pSelf->value.asList.pExprList->ExprType == HB_ET_VARIABLE )
{
pSelf->value.asList.pExprList->ExprType = HB_ET_VARREF;
HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_PUSH_PCODE );
pSelf->value.asList.pExprList->ExprType = HB_ET_VARIABLE;
}
else if( pSelf->value.asList.pExprList->ExprType == HB_ET_SEND &&
HB_SUPPORT_ARRSTR )
{
hb_compExprPushSendPop( pSelf->value.asList.pExprList, HB_COMP_PARAM );
HB_GEN_FUNC1( PCode1, HB_P_PUSHOVARREF );
}
else
HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_PUSH_PCODE );
}
else
HB_EXPR_USE( pSelf->value.asList.pExprList, HB_EA_PUSH_PCODE );
HB_EXPR_USE( pSelf->value.asList.pIndex, HB_EA_PUSH_PCODE );
if( fMacroIndex )
HB_GEN_FUNC1( PCode1, HB_P_MACROPUSHINDEX );
HB_GEN_FUNC1( PCode1, HB_P_ARRAYPOP );
if( bRemoveRef )
pSelf->value.asList.pExprList->ExprType = HB_ET_VARIABLE;
break;
}

7
harbour/include/hbvm.h
View File

@@ -145,11 +145,16 @@ extern HB_EXPORT void hb_vmPushEvalSym( void ); /* pushes a codeblock eval s
extern HB_EXPORT void hb_vmPushPointer( void * ); /* push an item of HB_IT_POINTER type */
extern HB_EXPORT void hb_vmPushState( void ); /* push current VM state on stack */
extern HB_EXPORT void hb_vmPopState( void ); /* pop current VM state from stack */
extern HB_EXPORT void hb_vmPushItemRef( PHB_ITEM pItem ); /* push item reference */
extern BOOL hb_vmMsgReference( PHB_ITEM pObject, PHB_SYMB pMessage ); /* create extended message reference */
/* various flags for supported features */
#define HB_VMFLAG_HARBOUR 1 /* enable Harbour extension */
#define HB_VMFLAG_ARRSTR 16 /* support for string as array of bytes -ks */
extern HB_EXPORT ULONG hb_vmFlagEnabled( ULONG flag );
extern HB_EXPORT ULONG hb_vmFlagEnabled( ULONG flags );
extern HB_EXPORT void hb_vmFlagSet( ULONG flags );
extern HB_EXPORT void hb_vmFlagClear( ULONG flags );
HB_EXTERN_END

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

@@ -485,11 +485,9 @@ HB_FUNC( DBFILTER )
if( pArea )
{
PHB_ITEM pFilter = hb_itemNew( NULL );
hb_itemPutC( pFilter, "" );
PHB_ITEM pFilter = hb_itemPutC( NULL, "" );
SELF_FILTERTEXT( pArea, pFilter );
hb_itemReturn( pFilter );
hb_itemRelease( pFilter );
hb_itemReturnRelease( pFilter );
}
else
hb_retc( NULL );
@@ -2100,14 +2098,16 @@ HB_FUNC( ORDSCOPE )
HB_FUNC( DBRELATION ) /* (<nRelation>) --> cLinkExp */
{
char szExprBuff[ HARBOUR_MAX_RDD_RELTEXT_LENGTH + 1 ];
AREAP pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer();
szExprBuff[ 0 ] = 0;
if( pArea )
SELF_RELTEXT( pArea, hb_parni(1), szExprBuff ) ;
hb_retc( szExprBuff );
{
PHB_ITEM pRelExpr = hb_itemPutC( NULL, "" );
SELF_RELTEXT( pArea, hb_parni( 1 ), pRelExpr ) ;
hb_itemReturnRelease( pRelExpr );
}
else
hb_retc( NULL );
}
HB_FUNC( DBRSELECT ) /* (<nRelation>) --> nWorkArea */

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

@@ -73,11 +73,6 @@
# include "hbapicdp.h"
#endif
#ifdef HB_TRIGVAR_BYREF
#include "hbxvm.h"
#include "hbstack.h"
#endif
static USHORT s_uiRddId = ( USHORT ) -1;
static RDDFUNCS dbfSuper;
static const RDDFUNCS dbfTable = { ( DBENTRYP_BP ) hb_dbfBof,
@@ -138,7 +133,7 @@ static const RDDFUNCS dbfTable = { ( DBENTRYP_BP ) hb_dbfBof,
( DBENTRYP_V ) hb_dbfForceRel,
( DBENTRYP_SVP ) hb_dbfRelArea,
( DBENTRYP_VR ) hb_dbfRelEval,
( DBENTRYP_SVP ) hb_dbfRelText,
( DBENTRYP_SI ) hb_dbfRelText,
( DBENTRYP_VR ) hb_dbfSetRel,
( DBENTRYP_OI ) hb_dbfOrderListAdd,
( DBENTRYP_V ) hb_dbfOrderListClear,
@@ -434,16 +429,6 @@ static BOOL hb_dbfTriggerDo( DBFAREAP pArea, int iEvent,
{
if( hb_vmRequestReenter() )
{
#ifdef HB_TRIGVAR_BYREF
LONG lOffset = 0;
if( pItem )
{
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_vmPush( pItem );
}
#endif
hb_vmPushDynSym( pArea->pTriggerSym );
hb_vmPushNil();
/* nEvent */
@@ -455,7 +440,11 @@ static BOOL hb_dbfTriggerDo( DBFAREAP pArea, int iEvent,
/* xTrigVal (PREUSE/GET/PUT) */
if( pItem )
{
hb_xvmPushLocalByRef( ( SHORT ) lOffset );
#ifdef HB_TRIGVAR_BYREF
hb_vmPushItemRef( pItem );
#else
hb_vmPush( pItem );
#endif
hb_vmDo( 4 );
}
else
@@ -463,14 +452,6 @@ static BOOL hb_dbfTriggerDo( DBFAREAP pArea, int iEvent,
/* SIx3 makes: hb_vmPushInteger( 0 ); */
hb_vmDo( 3 );
}
#ifdef HB_TRIGVAR_BYREF
if( pItem )
{
hb_itemMove( pItem, hb_stackItemFromBase( lOffset ) );
hb_stackPop();
}
#endif
fResult = hb_parl( -1 );
hb_vmRequestRestore();
}

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

@@ -210,7 +210,7 @@ static const RDDFUNCS cdxTable =
( DBENTRYP_V ) hb_cdxForceRel,
( DBENTRYP_SVP ) hb_cdxRelArea,
( DBENTRYP_VR ) hb_cdxRelEval,
( DBENTRYP_SVP ) hb_cdxRelText,
( DBENTRYP_SI ) hb_cdxRelText,
( DBENTRYP_VR ) hb_cdxSetRel,
@@ -7140,7 +7140,7 @@ static ERRCODE hb_cdxZap ( CDXAREAP pArea )
/* ( DBENTRYP_V ) hb_cdxForceRel : NULL */
/* ( DBENTRYP_SVP ) hb_cdxRelArea : NULL */
/* ( DBENTRYP_VR ) hb_cdxRelEval : NULL */
/* ( DBENTRYP_SVP ) hb_cdxRelText : NULL */
/* ( DBENTRYP_SI ) hb_cdxRelText : NULL */
/* ( DBENTRYP_VR ) hb_cdxSetRel : NULL */
/* ( DBENTRYP_OI ) hb_cdxOrderListAdd */

2
harbour/source/rdd/dbfdbt/dbfdbt1.c
View File

@@ -144,7 +144,7 @@ static const RDDFUNCS dbtTable =
( DBENTRYP_V ) hb_dbtForceRel,
( DBENTRYP_SVP ) hb_dbtRelArea,
( DBENTRYP_VR ) hb_dbtRelEval,
( DBENTRYP_SVP ) hb_dbtRelText,
( DBENTRYP_SI ) hb_dbtRelText,
( DBENTRYP_VR ) hb_dbtSetRel,

2
harbour/source/rdd/dbffpt/dbffpt1.c
View File

@@ -156,7 +156,7 @@ static const RDDFUNCS fptTable =
( DBENTRYP_V ) hb_fptForceRel,
( DBENTRYP_SVP ) hb_fptRelArea,
( DBENTRYP_VR ) hb_fptRelEval,
( DBENTRYP_SVP ) hb_fptRelText,
( DBENTRYP_SI ) hb_fptRelText,
( DBENTRYP_VR ) hb_fptSetRel,

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

@@ -965,7 +965,7 @@ static ERRCODE hb_usrBof( AREAP pArea, BOOL * pBof )
HB_TRACE(HB_TR_DEBUG, ("hb_usrBof(%p, %p)", pArea, pBof));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_xvmPushLogical( pArea->fBof );
hb_vmPushLogical( pArea->fBof );
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_BOF ) )
{
hb_stackPop();
@@ -992,7 +992,7 @@ static ERRCODE hb_usrEof( AREAP pArea, BOOL * pEof )
HB_TRACE(HB_TR_DEBUG, ("hb_usrEof(%p, %p)", pArea, pEof));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_xvmPushLogical( pArea->fEof );
hb_vmPushLogical( pArea->fEof );
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_EOF ) )
{
hb_stackPop();
@@ -1019,7 +1019,7 @@ static ERRCODE hb_usrFound( AREAP pArea, BOOL * pFound )
HB_TRACE(HB_TR_DEBUG, ("hb_usrFound(%p, %p)", pArea, pFound));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_xvmPushLogical( pArea->fFound );
hb_vmPushLogical( pArea->fFound );
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_FOUND ) )
{
hb_stackPop();
@@ -1163,7 +1163,7 @@ static ERRCODE hb_usrDeleted( AREAP pArea, BOOL * pDeleted )
HB_TRACE(HB_TR_DEBUG, ("hb_usrDeleted(%p, %p)", pArea, pDeleted));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_xvmPushLogical( FALSE );
hb_vmPushLogical( FALSE );
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_DELETED ) )
{
hb_stackPop();
@@ -1293,7 +1293,7 @@ static ERRCODE hb_usrFieldCount( AREAP pArea, USHORT * puiFields )
HB_TRACE(HB_TR_DEBUG, ("hb_usrFieldCount(%p,%p)", pArea, puiFields));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_xvmPushInteger( 0 );
hb_vmPushInteger( 0 );
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_FIELDCOUNT ) )
{
hb_stackPop();
@@ -1394,26 +1394,16 @@ static ERRCODE hb_usrGetRec( AREAP pArea, BYTE ** pBuffer )
static ERRCODE hb_usrGetValue( AREAP pArea, USHORT uiIndex, PHB_ITEM pItem )
{
LONG lOffset;
HB_TRACE(HB_TR_DEBUG, ("hb_usrGetValue(%p,%hu,%p)", pArea, uiIndex, pItem));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_vmPushNil();
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_GETVALUE ) )
{
hb_stackPop();
return SUPER_GETVALUE( pArea, uiIndex, pItem );
}
hb_vmPushInteger( pArea->uiArea );
hb_vmPushInteger( uiIndex );
hb_xvmPushLocalByRef( ( SHORT ) lOffset );
hb_vmPushItemRef( pItem );
hb_vmDo( 3 );
hb_itemCopy( pItem, hb_stackItemFromBase( lOffset ) );
hb_stackPop();
return hb_usrReturn();
}
@@ -1439,7 +1429,7 @@ static ERRCODE hb_usrGetVarLen( AREAP pArea, USHORT uiIndex, ULONG * pulLength )
HB_TRACE(HB_TR_DEBUG, ("hb_usrGetVarLen(%p,%hu,%p)", pArea, uiIndex, pulLength));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_xvmPushInteger( 0 );
hb_vmPushInteger( 0 );
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_GETVARLEN ) )
{
hb_stackPop();
@@ -1464,7 +1454,7 @@ static ERRCODE hb_usrRecCount( AREAP pArea, ULONG * pulRecCount )
HB_TRACE(HB_TR_DEBUG, ("hb_usrRecCount(%p,%p)", pArea, pulRecCount));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_xvmPushInteger( 0 );
hb_vmPushInteger( 0 );
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_RECCOUNT ) )
{
hb_stackPop();
@@ -1483,27 +1473,17 @@ static ERRCODE hb_usrRecCount( AREAP pArea, ULONG * pulRecCount )
static ERRCODE hb_usrRecInfo( AREAP pArea, PHB_ITEM pRecID, USHORT uiInfoType, PHB_ITEM pInfo )
{
LONG lOffset;
HB_TRACE(HB_TR_DEBUG, ("hb_usrRecInfo(%p,%p,%hu,%p)", pArea, pRecID, uiInfoType, pInfo));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_vmPush( pInfo );
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_RECINFO ) )
{
hb_stackPop();
return SUPER_RECINFO( pArea, pRecID, uiInfoType, pInfo );
}
hb_vmPushInteger( pArea->uiArea );
hb_vmPush( pRecID );
hb_vmPushInteger( uiInfoType );
hb_xvmPushLocalByRef( ( SHORT ) lOffset );
hb_vmPushItemRef( pInfo );
hb_vmDo( 4 );
hb_itemCopy( pInfo, hb_stackItemFromBase( lOffset ) );
hb_stackPop();
return hb_usrReturn();
}
@@ -1514,7 +1494,7 @@ static ERRCODE hb_usrRecNo( AREAP pArea, ULONG * pulRecNo )
HB_TRACE(HB_TR_DEBUG, ("hb_usrRecNo(%p,%p)", pArea, pulRecNo));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_xvmPushInteger( 0 );
hb_vmPushInteger( 0 );
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_RECNO ) )
{
hb_stackPop();
@@ -1533,51 +1513,31 @@ static ERRCODE hb_usrRecNo( AREAP pArea, ULONG * pulRecNo )
static ERRCODE hb_usrRecId( AREAP pArea, PHB_ITEM pRecId )
{
LONG lOffset;
HB_TRACE(HB_TR_DEBUG, ("hb_usrRecId(%p,%p)", pArea, pRecId));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_vmPush( pRecId );
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_RECID ) )
{
hb_stackPop();
return SUPER_RECID( pArea, pRecId );
}
hb_vmPushInteger( pArea->uiArea );
hb_xvmPushLocalByRef( ( SHORT ) lOffset );
hb_vmPushItemRef( pRecId );
hb_vmDo( 2 );
hb_itemCopy( pRecId, hb_stackItemFromBase( lOffset ) );
hb_stackPop();
return hb_usrReturn();
}
static ERRCODE hb_usrFieldInfo( AREAP pArea, USHORT uiIndex, USHORT uiInfoType, PHB_ITEM pInfo )
{
LONG lOffset;
HB_TRACE(HB_TR_DEBUG, ("hb_usrFieldInfo(%p,%hu,%hu,%p)", pArea, uiIndex, uiInfoType, pInfo));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_vmPush( pInfo );
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_FIELDINFO ) )
{
hb_stackPop();
return SUPER_FIELDINFO( pArea, uiIndex, uiInfoType, pInfo );
}
hb_vmPushInteger( pArea->uiArea );
hb_vmPushInteger( uiIndex );
hb_vmPushInteger( uiInfoType );
hb_xvmPushLocalByRef( ( SHORT ) lOffset );
hb_vmPushItemRef( pInfo );
hb_vmDo( 4 );
hb_itemCopy( pInfo, hb_stackItemFromBase( lOffset ) );
hb_stackPop();
return hb_usrReturn();
}
@@ -1692,26 +1652,16 @@ static ERRCODE hb_usrOpen( AREAP pArea, LPDBOPENINFO pOpenInfo )
static ERRCODE hb_usrInfo( AREAP pArea, USHORT uiInfoType, PHB_ITEM pInfo )
{
LONG lOffset;
HB_TRACE(HB_TR_DEBUG, ("hb_usrInfo(%p,%hu,%p)", pArea, uiInfoType, pInfo));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_vmPush( pInfo );
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_INFO ) )
{
hb_stackPop();
return SUPER_INFO( pArea, uiInfoType, pInfo );
}
hb_vmPushInteger( pArea->uiArea );
hb_vmPushInteger( uiInfoType );
hb_xvmPushLocalByRef( ( SHORT ) lOffset );
hb_vmPushItemRef( pInfo );
hb_vmDo( 3 );
hb_itemCopy( pInfo, hb_stackItemFromBase( lOffset ) );
hb_stackPop();
return hb_usrReturn();
}
@@ -1754,7 +1704,7 @@ static ERRCODE hb_usrPackRec( AREAP pArea, ULONG ulRecNo, BOOL * pWritten )
HB_TRACE(HB_TR_DEBUG, ("hb_usrPackRec(%p,%lu,%p)", pArea, ulRecNo, pWritten));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_xvmPushLogical( TRUE );
hb_vmPushLogical( TRUE );
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_PACKREC ) )
{
hb_stackPop();
@@ -1990,29 +1940,18 @@ static ERRCODE hb_usrRelEval( AREAP pArea, LPDBRELINFO pRelInfo )
return hb_usrReturn();
}
static ERRCODE hb_usrRelText( AREAP pArea, USHORT uiRelNo, void * pExpr )
static ERRCODE hb_usrRelText( AREAP pArea, USHORT uiRelNo, PHB_ITEM pExpr )
{
LONG lOffset;
HB_TRACE(HB_TR_DEBUG, ("hb_usrRelText(%p,%hu,%p)", pArea, uiRelNo, pExpr));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_vmPushNil();
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_RELTEXT ) )
{
hb_stackPop();
return SUPER_RELTEXT( pArea, uiRelNo, pExpr );
}
hb_vmPushInteger( pArea->uiArea );
hb_vmPushInteger( uiRelNo );
hb_xvmPushLocalByRef( ( SHORT ) lOffset );
hb_vmPushItemRef( pExpr );
hb_vmDo( 3 );
hb_strncpy( ( char * ) pExpr, hb_itemGetCPtr( hb_stackItemFromBase( lOffset ) ),
HARBOUR_MAX_RDD_RELTEXT_LENGTH );
hb_stackPop();
return hb_usrReturn();
}
@@ -2297,25 +2236,15 @@ static ERRCODE hb_usrClearScope( AREAP pArea )
static ERRCODE hb_usrFilterText( AREAP pArea, PHB_ITEM pFilter )
{
LONG lOffset;
HB_TRACE(HB_TR_DEBUG, ("hb_usrFilterText(%p,%p)", pArea, pFilter));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_vmPush( pFilter );
if( !hb_usrPushMethod( SELF_USRNODE( pArea )->pMethods, UR_FILTERTEXT ) )
{
hb_stackPop();
return SUPER_FILTERTEXT( pArea, pFilter );
}
hb_vmPushInteger( pArea->uiArea );
hb_xvmPushLocalByRef( ( SHORT ) lOffset );
hb_vmPushItemRef( pFilter );
hb_vmDo( 2 );
hb_itemCopy( pFilter, hb_stackItemFromBase( lOffset ) );
hb_stackPop();
return hb_usrReturn();
}
@@ -2639,27 +2568,17 @@ static ERRCODE hb_usrExists( LPRDDNODE pRDD, PHB_ITEM pTable, PHB_ITEM pIndex )
static ERRCODE hb_usrRddInfo( LPRDDNODE pRDD, USHORT uiInfoType, ULONG ulConnection, PHB_ITEM pInfo )
{
LONG lOffset;
HB_TRACE(HB_TR_DEBUG, ("hb_usrRddInfo(%p,%hu,%lu,%p)", pRDD, uiInfoType, ulConnection, pInfo));
lOffset = hb_stackTopOffset() - hb_stackBaseOffset();
hb_vmPush( pInfo );
if( !hb_usrPushMethod( SELF_USRNODE( pRDD )->pMethods, UR_RDDINFO ) )
{
hb_stackPop();
return SUPER_RDDINFO( pRDD, uiInfoType, ulConnection, pInfo );
}
hb_vmPushInteger( pRDD->rddID );
hb_vmPushInteger( uiInfoType );
hb_vmPushLong( ulConnection );
hb_xvmPushLocalByRef( ( SHORT ) lOffset );
hb_vmPushItemRef( pInfo );
hb_vmDo( 4 );
hb_itemCopy( pInfo, hb_stackItemFromBase( lOffset ) );
hb_stackPop();
return hb_usrReturn();
}
@@ -2731,7 +2650,7 @@ static RDDFUNCS usrFuncTable =
/* ( DBENTRYP_V ) */ hb_usrForceRel, /* ForceRel */
/* ( DBENTRYP_SVP ) */ hb_usrRelArea, /* RelArea */
/* ( DBENTRYP_VR ) */ hb_usrRelEval, /* RelEval */
/* ( DBENTRYP_SVP ) */ hb_usrRelText, /* RelText */
/* ( DBENTRYP_SI ) */ hb_usrRelText, /* RelText */
/* ( DBENTRYP_VR ) */ hb_usrSetRel, /* SetRel */
/* Order Management */
@@ -2857,7 +2776,7 @@ static RDDFUNCS rddFuncTable =
/* ( DBENTRYP_V ) */ NULL, /* ForceRel */
/* ( DBENTRYP_SVP ) */ NULL, /* RelArea */
/* ( DBENTRYP_VR ) */ NULL, /* RelEval */
/* ( DBENTRYP_SVP ) */ NULL, /* RelText */
/* ( DBENTRYP_SI ) */ NULL, /* RelText */
/* ( DBENTRYP_VR ) */ NULL, /* SetRel */
/* Order Management */
@@ -3862,12 +3781,7 @@ HB_FUNC_UR_SUPER( RELTEXT )
AREAP pArea = hb_usrGetAreaParam( 3 );
if( pArea )
{
char szExpr[ HARBOUR_MAX_RDD_RELTEXT_LENGTH + 1 ];
hb_retni( SUPER_RELTEXT( pArea, hb_parni( 2 ), szExpr ) );
hb_storc( szExpr, 3 );
}
hb_retni( SUPER_RELTEXT( pArea, hb_parni( 2 ), hb_param( 3, HB_IT_ANY ) ) );
}
HB_FUNC_UR_SUPER( SETREL )

9
harbour/source/rdd/workarea.c
View File

@@ -1442,7 +1442,7 @@ static ERRCODE hb_waRelEval( AREAP pArea, LPDBRELINFO pRelInfo )
/*
* Obtain the character expression of the specified relation.
*/
static ERRCODE hb_waRelText( AREAP pArea, USHORT uiRelNo, void * pExpr )
static ERRCODE hb_waRelText( AREAP pArea, USHORT uiRelNo, PHB_ITEM pExpr )
{
LPDBRELINFO lpdbRelations;
USHORT uiIndex = 1;
@@ -1455,13 +1455,12 @@ static ERRCODE hb_waRelText( AREAP pArea, USHORT uiRelNo, void * pExpr )
{
if( uiIndex++ == uiRelNo )
{
hb_strncpy( ( char* ) pExpr, hb_itemGetCPtr( lpdbRelations->abKey ),
HARBOUR_MAX_RDD_RELTEXT_LENGTH );
hb_itemCopy( pExpr, lpdbRelations->abKey );
return SUCCESS;
}
lpdbRelations = lpdbRelations->lpdbriNext;
}
* ( char * ) pExpr = 0;
return FAILURE;
}
@@ -1963,7 +1962,7 @@ static const RDDFUNCS waTable =
( DBENTRYP_V ) hb_waUnsupported, /* ForceRel */
/* ( DBENTRYP_SVP ) */ hb_waRelArea, /* RelArea */
/* ( DBENTRYP_VR ) */ hb_waRelEval, /* RelEval */
/* ( DBENTRYP_SVP ) */ hb_waRelText, /* RelText */
/* ( DBENTRYP_SI ) */ hb_waRelText, /* RelText */
/* ( DBENTRYP_VR ) */ hb_waSetRel, /* SetRel */
/* Order Management */

9
harbour/source/rtl/gttrm/gttrm.c
View File

@@ -1726,6 +1726,11 @@ static BOOL hb_gt_trm_AnsiGetCursorPos( int * iRow, int * iCol )
i = read( s_termState.hFilenoStdin, rdbuf + n, sizeof( rdbuf ) - 1 - n );
if( i <= 0 )
break;
if( n == 0 )
{
while( i > 0 && rdbuf[0] != '\033' )
memmove( rdbuf, rdbuf + 1, i-- );
}
n += i;
if( n >= 6 )
{
@@ -1735,6 +1740,8 @@ static BOOL hb_gt_trm_AnsiGetCursorPos( int * iRow, int * iCol )
s_termState.fPosAnswer = TRUE;
break;
}
else if( n == sizeof( rdbuf ) )
break;
}
}
}
@@ -1745,7 +1752,7 @@ static BOOL hb_gt_trm_AnsiGetCursorPos( int * iRow, int * iCol )
do
{
i = getc( stdin );
if( i != EOF )
if( i != EOF && ( n || i == '\033' ) )
{
rdbuf[ n++ ] = ( char ) i;
if( n >= 6 && i == 'R' )

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

@@ -1978,6 +1978,10 @@ BOOL hb_objGetVarRef( PHB_ITEM pObject, PHB_SYMB pMessage,
}
else if( pExecSym->value.pFunPtr == hb___msgScopeErr )
(pExecSym->value.pFunPtr)();
else
{
return hb_vmMsgReference( pObject, pMessage );
}
}
return FALSE;

5
harbour/source/vm/garbage.c
View File

@@ -391,6 +391,11 @@ void hb_gcItemRef( HB_ITEM_PTR pItem )
{
if( HB_IS_ENUM( pItem ) )
return;
else if( HB_IS_EXTREF( pItem ) )
{
pItem->item.asExtRef.func->mark( pItem->item.asExtRef.value );
return;
}
else if( ! HB_IS_MEMVAR( pItem ) &&
pItem->item.asRefer.offset == 0 &&
pItem->item.asRefer.value >= 0 )

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

@@ -221,6 +221,9 @@ static void hb_vmDoInitFunctions( void ); /* executes all defined PRGs I
static void hb_vmDoExitFunctions( void ); /* executes all defined PRGs EXIT functions */
static void hb_vmReleaseLocalSymbols( void ); /* releases the memory of the local symbols linked list */
static void hb_vmStringReference( PHB_ITEM pRefer, ULONG ulIndex ); /* create string character reference */
static void hb_vmMsgIndexReference( PHB_ITEM pRefer, PHB_ITEM pObject, PHB_ITEM pIndex ); /* create object index reference */
#ifndef HB_NO_PROFILER
static ULONG hb_ulOpcodesCalls[ HB_P_LAST_PCODE ];/* array to profile opcodes calls */
static ULONG hb_ulOpcodesTime[ HB_P_LAST_PCODE ]; /* array to profile opcodes consumed time */
@@ -2453,7 +2456,6 @@ static void hb_vmPlus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIte
{
if( ulLen1 < ULONG_MAX - ulLen2 )
{
#if 1
if( pResult != pItem1 )
{
hb_itemMove( pResult, pItem1 );
@@ -2462,13 +2464,6 @@ static void hb_vmPlus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIte
hb_itemReSizeString( pItem1, ulLen1 + ulLen2 );
hb_xmemcpy( pItem1->item.asString.value + ulLen1,
pItem2->item.asString.value, ulLen2 );
#else
char * szNewString = ( char * ) hb_xgrab( ulLen1 + ulLen2 + 1 );
hb_xmemcpy( szNewString, pItem1->item.asString.value, ulLen1 );
hb_xmemcpy( szNewString + ulLen1, pItem2->item.asString.value, ulLen2 );
hb_itemPutCPtr( pResult, szNewString, ulLen1 + ulLen2 );
#endif
}
else
hb_errRT_BASE( EG_STROVERFLOW, 1209, NULL, "+", 2, pItem1, pItem2 );
@@ -4181,7 +4176,6 @@ static void hb_vmArrayPush( void )
else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pArray, pIndex );
}
/* #ifndef HB_C52_STRICT */
else if( HB_IS_STRING( pArray ) && hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) )
{
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asString.length ) )
@@ -4202,7 +4196,6 @@ static void hb_vmArrayPush( void )
return;
}
/* #endif */
else if( hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pArray, pArray, pIndex, NULL ) )
hb_stackPop();
@@ -4214,12 +4207,14 @@ static void hb_vmArrayPushRef( void )
{
PHB_ITEM pIndex;
PHB_ITEM pArray;
PHB_ITEM pRefer;
ULONG ulIndex;
HB_TRACE(HB_TR_DEBUG, ("hb_vmArrayPushRef()"));
pIndex = hb_stackItemFromTop( -1 );
pArray = hb_stackItemFromTop( -2 );
pRefer = hb_stackItemFromTop( -2 );
pArray = HB_IS_BYREF( pRefer ) ? hb_itemUnRef( pRefer ) : pRefer;
if( HB_IS_HASH( pArray ) && HB_IS_HASHKEY( pIndex ) )
{
@@ -4227,9 +4222,16 @@ static void hb_vmArrayPushRef( void )
if( pValue )
{
hb_itemCopy( pIndex, pValue );
hb_itemMove( pArray, pIndex );
hb_itemMove( pRefer, pIndex );
hb_stackDec();
}
else if( hb_objHasOperator( pArray, HB_OO_OP_ARRAYINDEX ) )
{
/* create extended object index reference */
hb_vmMsgIndexReference( pRefer, pArray, pIndex );
hb_stackPop();
return;
}
else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pArray, pIndex );
return;
@@ -4240,6 +4242,13 @@ static void hb_vmArrayPushRef( void )
ulIndex = ( ULONG ) pIndex->item.asLong.value;
else if( HB_IS_DOUBLE( pIndex ) )
ulIndex = ( ULONG ) pIndex->item.asDouble.value;
else if( hb_objHasOperator( pArray, HB_OO_OP_ARRAYINDEX ) )
{
/* create extended object index reference */
hb_vmMsgIndexReference( pRefer, pArray, pIndex );
hb_stackPop();
return;
}
else
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pArray, pIndex );
@@ -4247,7 +4256,7 @@ static void hb_vmArrayPushRef( void )
if( pResult )
{
hb_stackPop();
hb_itemMove( pArray, pResult );
hb_itemMove( pRefer, pResult );
hb_itemRelease( pResult );
}
return;
@@ -4255,29 +4264,54 @@ static void hb_vmArrayPushRef( void )
if( HB_IS_ARRAY( pArray ) )
{
/*
* TODO: operator overloading will need some deeper HVM modifications
* to work well with references. It will be necessary to create
* separate versions of hb_itemUnRef() for access and assign
* operations, [druzus]
*/
#if 0
if( HB_IS_OBJECT( pArray ) &&
hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pArray, pArray, pIndex, NULL ) )
if( HB_IS_OBJECT( pArray ) && hb_objHasOperator( pArray, HB_OO_OP_ARRAYINDEX ) )
{
/* create extended object index reference */
hb_vmMsgIndexReference( pRefer, pArray, pIndex );
hb_stackPop();
return;
}
#endif
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asArray.value->ulLen ) )
else if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asArray.value->ulLen ) )
{
/* This function is safe for overwriting passed array, [druzus] */
hb_arrayGetItemRef( pArray, ulIndex, pArray );
hb_arrayGetItemRef( pArray, ulIndex, pRefer );
hb_stackDec();
}
else if( !HB_IS_OBJECT( pArray ) && hb_objHasOperator( pArray, HB_OO_OP_ARRAYINDEX ) )
{
/* create extended object index reference */
hb_vmMsgIndexReference( pRefer, pArray, pIndex );
hb_stackPop();
return;
}
else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pArray, pIndex );
}
else if( HB_IS_STRING( pArray ) && hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) )
{
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asString.length ) )
{
/* create extended string reference */
hb_vmStringReference( pRefer, ulIndex );
hb_stackDec();
}
else if( hb_objHasOperator( pArray, HB_OO_OP_ARRAYINDEX ) )
{
/* create extended object index reference */
hb_vmMsgIndexReference( pRefer, pArray, pIndex );
hb_stackPop();
return;
}
else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pArray, pIndex );
}
else if( hb_objHasOperator( pArray, HB_OO_OP_ARRAYINDEX ) )
{
/* create extended object index reference */
hb_vmMsgIndexReference( pRefer, pArray, pIndex );
hb_stackPop();
return;
}
else
hb_errRT_BASE( EG_ARG, 1068, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pArray, pIndex );
}
@@ -4367,17 +4401,19 @@ 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_IS_STRING( pArray ) && hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) )
#if defined( HB_COMPAT_XHB )
else if( HB_IS_STRING( pArray ) && hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) &&
( HB_IS_NUMERIC( pValue ) || HB_IS_STRING( pValue ) ) )
#else
else if( HB_IS_STRING( pArray ) && hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) &&
( HB_IS_NUMERIC( pValue ) ||
( HB_IS_STRING( pValue ) && pValue->item.asString.length == 1 ) ) )
#endif
{
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asString.length ) )
{
#if defined( HB_COMPAT_XHB )
char cValue = HB_IS_STRING( pValue ) ? pValue->item.asString.value[ 0 ] :
hb_itemGetNI( pValue );
#else
char cValue = hb_itemGetNI( pValue );
#endif
if( pArray->item.asString.length == 1 )
{
hb_itemPutCL( pArray, hb_szAscii[ ( unsigned char ) cValue ], 1 );
@@ -4402,7 +4438,6 @@ static void hb_vmArrayPop( void )
hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ),
3, pArray, pIndex, pValue );
}
/* #endif */
else if( hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pArray, pArray, pIndex, pValue ) )
{
hb_stackPop();
@@ -6779,7 +6814,402 @@ static void hb_vmDoInitFunctions( void )
}
}
/* ----------------------------- */
/* ------------------------------- */
/* Extended references */
/* ------------------------------- */
/*
* extended item reference functions
*/
static PHB_ITEM hb_vmItemRefRead( PHB_ITEM pRefer )
{
return ( PHB_ITEM ) pRefer->item.asExtRef.value;
}
static PHB_ITEM hb_vmItemRefWrite( PHB_ITEM pRefer, PHB_ITEM pSource )
{
HB_SYMBOL_UNUSED( pSource );
return ( PHB_ITEM ) pRefer->item.asExtRef.value;
}
static void hb_vmItemRefCopy( PHB_ITEM pDest )
{
pDest->type = HB_IT_NIL;
hb_itemCopy( pDest, ( PHB_ITEM ) pDest->item.asExtRef.value );
}
static void hb_vmItemRefDummy( void * value )
{
HB_SYMBOL_UNUSED( value );
}
/*
* push extended item reference
*/
HB_EXPORT void hb_vmPushItemRef( PHB_ITEM pItem )
{
static const HB_EXTREF s_ItmExtRef = {
hb_vmItemRefRead,
hb_vmItemRefWrite,
hb_vmItemRefCopy,
hb_vmItemRefDummy,
hb_vmItemRefDummy };
PHB_ITEM pRefer;
HB_TRACE(HB_TR_DEBUG, ("hb_vmPushItemRef(%p)", pItem));
pRefer = hb_stackAllocItem();
pRefer->type = HB_IT_BYREF | HB_IT_EXTREF;
pRefer->item.asExtRef.value = ( void * ) pItem;
pRefer->item.asExtRef.func = &s_ItmExtRef;
}
/* ------------------------------- */
/*
* extended message reference structure
*/
typedef struct
{
PHB_DYNS access;
PHB_DYNS assign;
HB_ITEM object;
HB_ITEM value;
BOOL init;
} HB_MSGREF, * PHB_MSGREF;
/*
* extended message reference functions
*/
static PHB_ITEM hb_vmMsgRefRead( PHB_ITEM pRefer )
{
PHB_MSGREF pMsgRef = ( PHB_MSGREF ) pRefer->item.asExtRef.value;
if( !pMsgRef->init )
{
pMsgRef->init = TRUE;
hb_vmPushDynSym( pMsgRef->access );
hb_vmPush( &pMsgRef->object );
hb_vmSend( 0 );
hb_itemMove( &pMsgRef->value, hb_stackReturnItem() );
}
return &pMsgRef->value;
}
static PHB_ITEM hb_vmMsgRefWrite( PHB_ITEM pRefer, PHB_ITEM pSource )
{
HB_SYMBOL_UNUSED( pSource );
return hb_vmMsgRefRead( pRefer );
}
static void hb_vmMsgRefCopy( PHB_ITEM pDest )
{
hb_xRefInc( pDest->item.asExtRef.value );
}
static void hb_vmMsgRefClear( void * value )
{
if( hb_xRefDec( value ) )
{
PHB_MSGREF pMsgRef = ( PHB_MSGREF ) value;
if( pMsgRef->init )
{
if( hb_vmRequestReenter() )
{
hb_vmPushDynSym( pMsgRef->assign );
hb_vmPush( &pMsgRef->object );
hb_vmPush( &pMsgRef->value );
hb_vmSend( 1 );
hb_vmRequestRestore();
}
}
if( HB_IS_COMPLEX( &pMsgRef->value ) )
hb_itemClear( &pMsgRef->value );
if( HB_IS_COMPLEX( &pMsgRef->object ) )
hb_itemClear( &pMsgRef->object );
hb_xfree( value );
}
}
static void hb_vmMsgRefMark( void * value )
{
if( HB_IS_GCITEM( &( ( PHB_MSGREF ) value )->object ) )
hb_gcItemRef( &( ( PHB_MSGREF ) value )->object );
if( HB_IS_GCITEM( &( ( PHB_MSGREF ) value )->value ) )
hb_gcItemRef( &( ( PHB_MSGREF ) value )->value );
}
/*
* create extended message reference
*/
BOOL hb_vmMsgReference( PHB_ITEM pObject, PHB_SYMB pMessage )
{
static const HB_EXTREF s_MsgExtRef = {
hb_vmMsgRefRead,
hb_vmMsgRefWrite,
hb_vmMsgRefCopy,
hb_vmMsgRefClear,
hb_vmMsgRefMark };
PHB_MSGREF pMsgRef;
PHB_DYNS pAccess;
PHB_ITEM pRefer;
HB_TRACE(HB_TR_DEBUG, ("hb_vmMsgReference(%p,%p)", pObject, pMessage));
pAccess = hb_dynsymFind( pMessage->szName + 1 );
if( pAccess )
{
pMsgRef = ( PHB_MSGREF ) hb_xgrab( sizeof( HB_MSGREF ) );
pMsgRef->access = pAccess;
pMsgRef->assign = pMessage->pDynSym;
pMsgRef->init = FALSE;
pMsgRef->value.type = HB_IT_NIL;
pMsgRef->object.type = HB_IT_NIL;
hb_itemCopy( &pMsgRef->object, pObject );
pRefer = hb_stackReturnItem();
pRefer->type = HB_IT_BYREF | HB_IT_EXTREF;
pRefer->item.asExtRef.value = ( void * ) pMsgRef;
pRefer->item.asExtRef.func = &s_MsgExtRef;
return TRUE;
}
return FALSE;
}
/* ------------------------------- */
/*
* extended object index reference structure
*/
typedef struct
{
HB_ITEM object;
HB_ITEM value;
HB_ITEM index;
BOOL init;
} HB_MSGIDXREF, * PHB_MSGIDXREF;
/*
* extended object index reference functions
*/
static PHB_ITEM hb_vmMsgIdxRefRead( PHB_ITEM pRefer )
{
PHB_MSGIDXREF pMsgIdxRef = ( PHB_MSGIDXREF ) pRefer->item.asExtRef.value;
if( !pMsgIdxRef->init )
{
pMsgIdxRef->init = TRUE;
hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, &pMsgIdxRef->value,
HB_IS_BYREF( &pMsgIdxRef->object ) ?
hb_itemUnRef( &pMsgIdxRef->object ) :
&pMsgIdxRef->object, &pMsgIdxRef->index, NULL );
}
return &pMsgIdxRef->value;
}
static PHB_ITEM hb_vmMsgIdxRefWrite( PHB_ITEM pRefer, PHB_ITEM pSource )
{
HB_SYMBOL_UNUSED( pSource );
return hb_vmMsgIdxRefRead( pRefer );
}
static void hb_vmMsgIdxRefCopy( PHB_ITEM pDest )
{
hb_xRefInc( pDest->item.asExtRef.value );
}
static void hb_vmMsgIdxRefClear( void * value )
{
if( hb_xRefDec( value ) )
{
PHB_MSGIDXREF pMsgIdxRef = ( PHB_MSGIDXREF ) value;
if( pMsgIdxRef->init )
{
PHB_ITEM pObject = HB_IS_BYREF( &pMsgIdxRef->object ) ?
hb_itemUnRef( &pMsgIdxRef->object ) :
&pMsgIdxRef->object;
if( hb_vmRequestReenter() )
{
hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pObject, pObject,
&pMsgIdxRef->index, &pMsgIdxRef->value );
hb_vmRequestRestore();
}
}
if( HB_IS_COMPLEX( &pMsgIdxRef->value ) )
hb_itemClear( &pMsgIdxRef->value );
if( HB_IS_COMPLEX( &pMsgIdxRef->object ) )
hb_itemClear( &pMsgIdxRef->object );
if( HB_IS_COMPLEX( &pMsgIdxRef->index ) )
hb_itemClear( &pMsgIdxRef->index );
hb_xfree( value );
}
}
static void hb_vmMsgIdxRefMark( void * value )
{
if( HB_IS_GCITEM( &( ( PHB_MSGIDXREF ) value )->object ) )
hb_gcItemRef( &( ( PHB_MSGIDXREF ) value )->object );
if( HB_IS_GCITEM( &( ( PHB_MSGIDXREF ) value )->index ) )
hb_gcItemRef( &( ( PHB_MSGIDXREF ) value )->index );
if( HB_IS_GCITEM( &( ( PHB_MSGIDXREF ) value )->value ) )
hb_gcItemRef( &( ( PHB_MSGIDXREF ) value )->value );
}
/*
* create extended message reference
*/
static void hb_vmMsgIndexReference( PHB_ITEM pRefer, PHB_ITEM pObject, PHB_ITEM pIndex )
{
static const HB_EXTREF s_MsgIdxExtRef = {
hb_vmMsgIdxRefRead,
hb_vmMsgIdxRefWrite,
hb_vmMsgIdxRefCopy,
hb_vmMsgIdxRefClear,
hb_vmMsgIdxRefMark };
PHB_MSGIDXREF pMsgIdxRef;
HB_TRACE(HB_TR_DEBUG, ("hb_vmMsgIndexReference(%p,%p,%p)", pRefer, pObject, pIndex));
pMsgIdxRef = ( PHB_MSGIDXREF ) hb_xgrab( sizeof( HB_MSGIDXREF ) );
pMsgIdxRef->init = FALSE;
pMsgIdxRef->value.type = HB_IT_NIL;
pMsgIdxRef->object.type = HB_IT_NIL;
pMsgIdxRef->index.type = HB_IT_NIL;
hb_itemCopy( &pMsgIdxRef->object, HB_IS_STRING( pObject ) ? pRefer : pObject );
hb_itemCopy( &pMsgIdxRef->index, pIndex );
pIndex->type = HB_IT_BYREF | HB_IT_EXTREF;
pIndex->item.asExtRef.value = ( void * ) pMsgIdxRef;
pIndex->item.asExtRef.func = &s_MsgIdxExtRef;
hb_itemMove( pRefer, pIndex );
}
/* ------------------------------- */
/*
* extended string reference structure
*/
typedef struct
{
HB_ITEM refer;
HB_ITEM value;
ULONG index;
BOOL init;
} HB_STRREF, * PHB_STRREF;
/*
* extended string reference functions
*/
static PHB_ITEM hb_vmStringRefRead( PHB_ITEM pRefer )
{
PHB_STRREF pStrRef = ( PHB_STRREF ) pRefer->item.asExtRef.value;
if( !pStrRef->init )
{
PHB_ITEM pItem;
pStrRef->init = TRUE;
pItem = hb_itemUnRef( &pStrRef->refer );
if( HB_IS_STRING( pItem ) && pItem->item.asString.length > pStrRef->index )
{
UCHAR uc = ( UCHAR ) pItem->item.asString.value[ pStrRef->index ];
#if defined( HB_COMPAT_XHB )
hb_itemPutCL( &pStrRef->value, hb_szAscii[ uc ], 1 );
#else
hb_itemPutNI( &pStrRef->value, uc );
#endif
}
}
return &pStrRef->value;
}
static PHB_ITEM hb_vmStringRefWrite( PHB_ITEM pRefer, PHB_ITEM pSource )
{
HB_SYMBOL_UNUSED( pSource );
return hb_vmStringRefRead( pRefer );
}
static void hb_vmStringRefCopy( PHB_ITEM pDest )
{
hb_xRefInc( pDest->item.asExtRef.value );
}
static void hb_vmStringRefClear( void * value )
{
if( hb_xRefDec( value ) )
{
PHB_ITEM pItem = &( ( PHB_STRREF ) value )->value;
#if defined( HB_COMPAT_XHB )
if( HB_IS_NUMERIC( pItem ) || HB_IS_STRING( pItem ) )
#else
if( HB_IS_NUMERIC( pItem ) ||
( HB_IS_STRING( pItem ) && pItem->item.asString.length == 1 ) )
#endif
if( !HB_IS_NIL( pItem ) )
{
char cValue = HB_IS_STRING( pItem ) ? pItem->item.asString.value[ 0 ] :
hb_itemGetNI( pItem );
if( HB_IS_COMPLEX( pItem ) )
hb_itemClear( pItem );
pItem = hb_itemUnRef( &( ( PHB_STRREF ) value )->refer );
if( HB_IS_STRING( pItem ) && pItem->item.asString.length >
( ( PHB_STRREF ) value )->index )
{
if( pItem->item.asString.length == 1 )
hb_itemPutCL( pItem, hb_szAscii[ ( unsigned char ) cValue ], 1 );
else
{
hb_itemUnShareString( pItem );
pItem->item.asString.value[ ( ( PHB_STRREF ) value )->index ] = cValue;
}
}
}
hb_itemClear( &( ( PHB_STRREF ) value )->refer );
hb_xfree( value );
}
}
static void hb_vmStringRefMark( void * value )
{
if( HB_IS_GCITEM( &( ( PHB_STRREF ) value )->refer ) )
hb_gcItemRef( &( ( PHB_STRREF ) value )->refer );
if( HB_IS_GCITEM( &( ( PHB_STRREF ) value )->value ) )
hb_gcItemRef( &( ( PHB_STRREF ) value )->value );
}
/*
* create extended string reference
*/
static void hb_vmStringReference( PHB_ITEM pRefer, ULONG ulIndex )
{
static const HB_EXTREF s_StrExtRef = {
hb_vmStringRefRead,
hb_vmStringRefWrite,
hb_vmStringRefCopy,
hb_vmStringRefClear,
hb_vmStringRefMark };
PHB_STRREF pStrRef;
HB_TRACE(HB_TR_DEBUG, ("hb_vmStringReference(%p,%lu)", pItem, ulIndex));
pStrRef = ( PHB_STRREF ) hb_xgrab( sizeof( HB_STRREF ) );
memcpy( &pStrRef->refer, pRefer, sizeof( HB_ITEM ) );
pStrRef->value.type = HB_IT_NIL;
pStrRef->index = ulIndex - 1;
pStrRef->init = FALSE;
pRefer->type = HB_IT_BYREF | HB_IT_EXTREF;
pRefer->item.asExtRef.value = ( void * ) pStrRef;
pRefer->item.asExtRef.func = &s_StrExtRef;
}
/* ------------------------------- */
/* VM exceptions */
/* ------------------------------- */
void hb_vmRequestQuit( void )
{
@@ -8843,7 +9273,6 @@ static void hb_vmArrayItemPush( ULONG ulIndex )
else
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pArray, hb_stackItemFromTop( -1 ) );
}
/* #ifndef HB_C52_STRICT */
else if( HB_IS_STRING( pArray ) && hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) )
{
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asString.length ) )
@@ -8866,7 +9295,6 @@ static void hb_vmArrayItemPush( ULONG ulIndex )
2, pArray, hb_stackItemFromTop( -1 ) );
}
}
/* #endif */
else
{
hb_vmPushNumInt( ulIndex );
@@ -8952,17 +9380,19 @@ static void hb_vmArrayItemPop( ULONG ulIndex )
else
hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 3, pArray, hb_stackItemFromTop( -1 ), pValue );
}
/* #ifndef HB_C52_STRICT */
else if( HB_IS_STRING( pArray ) && hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) )
#if defined( HB_COMPAT_XHB )
else if( HB_IS_STRING( pArray ) && hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) &&
( HB_IS_NUMERIC( pValue ) || HB_IS_STRING( pValue ) ) )
#else
else if( HB_IS_STRING( pArray ) && hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) &&
( HB_IS_NUMERIC( pValue ) ||
( HB_IS_STRING( pValue ) && pValue->item.asString.length == 1 ) ) )
#endif
{
if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asString.length ) )
{
#if defined( HB_COMPAT_XHB )
char cValue = HB_IS_STRING( pValue ) ? pValue->item.asString.value[ 0 ] :
hb_itemGetNI( pValue );
#else
char cValue = hb_itemGetNI( pValue );
#endif
if( pArray->item.asString.length == 1 )
{
hb_itemPutCL( pArray, hb_szAscii[ ( unsigned char ) cValue ], 1 );
@@ -8990,7 +9420,6 @@ static void hb_vmArrayItemPop( ULONG ulIndex )
3, pArray, hb_stackItemFromTop( -1 ), pValue );
}
}
/* #endif */
else
{
hb_vmPushNumInt( ulIndex );
@@ -9261,9 +9690,19 @@ HB_EXPORT void hb_xvmWithObjectMessage( PHB_SYMB pSymbol )
#undef hb_vmFlagEnabled
ULONG hb_vmFlagEnabled( ULONG flags )
HB_EXPORT ULONG hb_vmFlagEnabled( ULONG flags )
{
return s_VMFlags & (flags);
return s_VMFlags & flags;
}
HB_EXPORT void hb_vmFlagSet( ULONG flags )
{
s_VMFlags |= flags;
}
HB_EXPORT void hb_vmFlagClear( ULONG flags )
{
s_VMFlags &= ~flags;
}
/* ------------------------------------------------------------------------ */

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

@@ -975,6 +975,7 @@ HB_EXPORT double hb_itemGetNDDec( PHB_ITEM pItem, int * piDec )
default:
dNumber = 0; /* To avoid GCC -O2 warning */
*piDec = 0;
break;
}
@@ -1301,6 +1302,9 @@ HB_EXPORT void hb_itemClear( PHB_ITEM pItem )
hb_vmEnumRelease( pItem->item.asEnum.basePtr,
pItem->item.asEnum.valuePtr );
else if( type & HB_IT_EXTREF )
pItem->item.asExtRef.func->clear( pItem->item.asExtRef.value );
else if( pItem->item.asRefer.offset == 0 && pItem->item.asRefer.value >= 0 )
hb_gcRefFree( pItem->item.asRefer.BasePtr.array );
}
@@ -1349,6 +1353,9 @@ HB_EXPORT void hb_itemCopy( PHB_ITEM pDest, PHB_ITEM pSource )
else if( HB_IS_ENUM( pSource ) ) /* enumerators cannnot be copied */
pDest->type = HB_IT_NIL;
else if( HB_IS_EXTREF( pSource ) )
pSource->item.asExtRef.func->copy( pDest );
else if( pSource->item.asRefer.offset == 0 && pSource->item.asRefer.value >= 0 )
hb_gcRefInc( pSource->item.asRefer.BasePtr.array );
}
@@ -1603,6 +1610,10 @@ PHB_ITEM hb_itemUnRefOnce( PHB_ITEM pItem )
return pItem->item.asEnum.valuePtr;
}
}
else if( HB_IS_EXTREF( pItem ) )
{
pItem = pItem->item.asExtRef.func->read( pItem );
}
else
{
if( pItem->item.asRefer.value >= 0 )
@@ -1686,7 +1697,11 @@ PHB_ITEM hb_itemUnRefWrite( PHB_ITEM pItem, PHB_ITEM pSource )
{
HB_TRACE(HB_TR_DEBUG, ("hb_itemUnRefWrite(%p,%p)", pItem, pSource));
if( HB_IS_STRING( pSource ) &&
if( HB_IS_EXTREF( pItem ) )
{
pItem = pItem->item.asExtRef.func->write( pItem, pSource );
}
else if( HB_IS_STRING( pSource ) &&
pSource->item.asString.length == 1 )
{
do