diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 36a5133c4f..ff7c480818 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,97 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-10-01 19:42 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/source/rtl/errorapi.c + + added protection against possible GPF when some assign methods + were called without parameters + + * harbour/source/rdd/workarea.c + * initialize uiFalgs also when DBS_FLAGS is not set + + * harbour/contrib/bmdbfcdx/bmdbfcdx1.c + * fixed hb_cdxSkipFilter() declaration - it should be 'static' function + + * harbour/source/pp/ppcore.c + * harbour/source/compiler/ppcomp.c + + added support for changing all -k? switches by #pragma, f.e.; + #pragma -ks+ + #pragma -kM- + #pragma -kx1 + #pragma -kJ0 + + * harbour/source/compiler/hbusage.c + * changed -ks description + + * harbour/include/hbexpra.c + * harbour/include/hbexprb.c + * do not generate error message for negative indexes and + [] operators are used for simple types when -ks option + is used + + * harbour/include/hbvmpub.h + * harbour/include/hbapi.h + * harbour/source/vm/hvm.c + * harbour/source/vm/extend.c + * harbour/source/vm/itemapi.c + * harbour/source/vm/memvars.c + + added HB_IT_DEFAULT flags - it allows to check if item was changed + + * harbour/source/vm/memvars.c + * harbour/include/hbvm.h + ! fixed HB_IT_MEMOFLAG updating to be Clipper compatible. Here we are + not Clipper compatible in one place: in clodeblock local parameters + with memo values are marked as MEMO but if you leave function where + codeblock were created then Clipper during detaching removes MEMO + flag. In Harbour memo flag is kept. + + * harbour/include/hbvm.h + * harbour/source/vm/classes.c + * harbour/source/vm/hvm.c + % improved speed of extended references used for SETGET methods + and overloaded [] operators + + * harbour/include/hbapi.h + * harbour/include/hbsetup.ch + * harbour/source/compiler/hbcomp.c + * harbour/source/vm/hvm.c + * harbour/source/vm/macro.c + * harbour/source/vm/cmdarg.c + * removed HB_COMPAT_XHB flags - only one HB_COMPAT_XHB still exist + in HVM in hashes.c - it will be removed soon. + + * harbour/source/common/hbverdsp.c + * removed information about xHarbour compatibility mode - it's not + longer used. We are emulating xHarbour behavior using external + XHB library and standard compiler/HVM features + + * harbour/contrib/xhb/xhb.ch + * harbour/contrib/xhb/xhbfunc.c + * harbour/source/vm/arrayshb.c + * moved XHB_AINS(), XHB_ADEL() from XHB lib to HVM as HB_AINS(), HB_ADEL() + + * harbour/contrib/xhb/xhb.ch + + added #pragma -ks+ + + added transaltion for hb_enumindex( ) + + + harbour/contrib/xhb/xhbenum.c + + added emulation for HB_EUMMINDEX() + + * harbour/contrib/xhb/xhbfunc.c + * do not add INET*() function wrappers for DOS builds or when + HB_NO_DEFAULT_INET macro is set + + * harbour/contrib/xhb/xhbmsgs.c + * added comment + + * harbour/contrib/Makefile + + added TIP and XHB + + * harbour/make_rpm.sh + * harbour/harbour.spec + * removed HB_COMPAT_XHB, --with tip, --with xhb + they are not longer necessary + 2007-09-01 17:54 UTC+0100 Miguel Angel Marchuet * contrib/bmdbfcdx/bmdbfcdx1.c * contrib/bmdbfcdx/hbrddbmcdx.h diff --git a/harbour/contrib/Makefile b/harbour/contrib/Makefile index 88975e7734..aa858ea475 100644 --- a/harbour/contrib/Makefile +++ b/harbour/contrib/Makefile @@ -12,6 +12,7 @@ DIRS=\ libmisc \ libnf \ samples \ + xhb \ $(HB_CONTRIBLIBS) @@ -69,9 +70,9 @@ endif endif endif -#ifneq ($(HB_ARCHITECTURE),dos) -#DIRS += tip +ifneq ($(HB_ARCHITECTURE),dos) +DIRS += tip #DIRS += xhb -#endif +endif include $(ROOT)config/dir.cf diff --git a/harbour/contrib/bmdbfcdx/bmdbfcdx1.c b/harbour/contrib/bmdbfcdx/bmdbfcdx1.c index ee6220494c..775a806a2f 100644 --- a/harbour/contrib/bmdbfcdx/bmdbfcdx1.c +++ b/harbour/contrib/bmdbfcdx/bmdbfcdx1.c @@ -7016,7 +7016,7 @@ static ERRCODE hb_cdxSkip( CDXAREAP pArea, LONG lToSkip ) /* * Reposition cursor respecting any filter setting. */ -ERRCODE hb_cdxSkipFilter( CDXAREAP pArea, LONG lUpDown ) +static ERRCODE hb_cdxSkipFilter( CDXAREAP pArea, LONG lUpDown ) { BOOL fBottom, fDeleted; ERRCODE uiError; diff --git a/harbour/contrib/xhb/Makefile b/harbour/contrib/xhb/Makefile index 2b4a7a9236..26cb84365d 100644 --- a/harbour/contrib/xhb/Makefile +++ b/harbour/contrib/xhb/Makefile @@ -9,6 +9,7 @@ C_SOURCES=\ hbsyslog.c \ hboutdbg.c \ cstructc.c \ + xhbenum.c \ xhbfunc.c \ xhbmsgs.c \ xhbwith.c \ diff --git a/harbour/contrib/xhb/xhb.ch b/harbour/contrib/xhb/xhb.ch index 114e426bbe..f1ec6ee527 100644 --- a/harbour/contrib/xhb/xhb.ch +++ b/harbour/contrib/xhb/xhb.ch @@ -84,8 +84,10 @@ #xtranslate hb_HexToStr([]) => HexToStr() #xtranslate hb_StrToHex([]) => StrToHex() - #xtranslate hb_AScan(,,[],[],) => AScan(,,,,) - #xtranslate hb_RAScan([]) => RAScan() + #xtranslate hb_AScan([) => AScan() + #xtranslate hb_RAScan([]) => RAScan() + #xtranslate hb_AIns([]) => AIns() + #xtranslate hb_ADel([]) => ADel() #xtranslate hb_ISPOINTER( )=> ISPOINTER( ) @@ -103,11 +105,9 @@ #else + #pragma -ks+ REQUEST XHB_LIB - #xtranslate AIns(,,[]) => xhb_AIns(,,) - #xtranslate ADel(,,) => xhb_ADel(,,) - #xtranslate gtSys => hb_gtSys #xtranslate gtInfo([]) => hb_gtInfo() #xtranslate hb_gt_Version([]) => hb_gtVersion() @@ -136,6 +136,8 @@ #xtranslate AScan(,,[],[],) => hb_AScan(,,,,) #xtranslate RAScan([]) => hb_RAScan() + #xtranslate AIns(,,[]) => hb_AIns(,,) + #xtranslate ADel(,,) => hb_ADel(,,) #xtranslate ISPOINTER( ) => hb_ISPOINTER( ) @@ -226,6 +228,9 @@ /* SWITCH ... ; case ... ; DEFAULT ; ... ; END */ #xcommand DEFAULT => OTHERWISE + /* FOR EACH hb_enumIndex() */ + #xtranslate hb_enumIndex() => :__enumIndex() + /* TRY / CATCH / FINALLY / END */ #xcommand TRY => BEGIN SEQUENCE WITH {|oErr| Break( oErr )} #xcommand CATCH [] => RECOVER [USING ] <-oErr-> @@ -235,6 +240,7 @@ #xtranslate \<|[]| => {|| #xcommand > [<*x*>] => } + /* xHarbour operators: IN, HAS, LIKE, >>, <<, |, &, ^^ */ #translate ( IN ) => ( () $ () ) #translate ( HAS ) => ( HB_REGEXHAS( (), () ) ) diff --git a/harbour/contrib/xhb/xhbenum.c b/harbour/contrib/xhb/xhbenum.c new file mode 100644 index 0000000000..e852bc9a6f --- /dev/null +++ b/harbour/contrib/xhb/xhbenum.c @@ -0,0 +1,71 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * xHarbour compatible HB_ENUMINDEX() internal FOR EACH function + * + * Copyright 2007 Przemyslaw Czerpak + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#include "hbvmopt.h" +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbstack.h" + +HB_FUNC( HB_ENUMINDEX ) +{ + LONG lFuncOffset = hb_stackBaseOffset() - 1, lIndex = 0; + while( --lFuncOffset > 0 ) + { + PHB_ITEM pItem = hb_stackItem( lFuncOffset ); + if( HB_IS_ENUM( pItem ) ) + { + lIndex = pItem->item.asEnum.offset; + break; + } + } + hb_retnl( lIndex ); +} diff --git a/harbour/contrib/xhb/xhbfunc.c b/harbour/contrib/xhb/xhbfunc.c index 01805597ca..44e17e1c1d 100644 --- a/harbour/contrib/xhb/xhbfunc.c +++ b/harbour/contrib/xhb/xhbfunc.c @@ -128,6 +128,12 @@ HB_FUNC( HGETAUTOADD ) { HB_FUNC_EXEC( HB_HAUTOADD ); hb_retl( hb_parni( HB_FUNC( HALLOCATE ) { HB_FUNC_EXEC( HB_HALLOCATE ); } HB_FUNC( HDEFAULT ) { HB_FUNC_EXEC( HB_HDEFAULT ); } +#if defined( HB_OS_DOS ) && !defined( HB_NO_DEFAULT_INET ) +# define HB_NO_DEFAULT_INET +#endif + +#if !defined( HB_NO_DEFAULT_INET ) + /* Inet*() functions */ HB_FUNC_EXTERN( HB_INETINIT ); HB_FUNC_EXTERN( HB_INETCLEANUP ); @@ -212,52 +218,8 @@ HB_FUNC( INETCRLF ) { HB_FUNC_EXEC( HB_INETCRLF ); } HB_FUNC( ISINETSOCKET ) { HB_FUNC_EXEC( HB_ISINETSOCKET ); } HB_FUNC( INETDESTROY ) { } -HB_FUNC( XHB_AINS ) -{ - PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY ); +#endif /* !HB_NO_DEFAULT_INET */ - if( pArray ) - { - long lPos = hb_parnl( 2 ); - - if( lPos == 0 ) - lPos = 1; - - if( hb_pcount() >= 4 && ISLOG( 4 ) && hb_parl( 4 ) ) - { - ULONG ulLen = hb_arrayLen( pArray ) + 1; - if( lPos >= 1 && ( ULONG ) lPos <= ulLen ) - hb_arraySize( pArray, ulLen ); - } - - if( hb_arrayIns( pArray, lPos ) ) - { - if( hb_pcount() >= 3 && !ISNIL( 3 ) ) - hb_arraySet( pArray, lPos, hb_param( 3, HB_IT_ANY ) ); - } - hb_itemReturn( pArray ); /* AIns() returns the array itself */ - } -} - -HB_FUNC( XHB_ADEL ) -{ - PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY ); - - if( pArray ) - { - long lPos = hb_parnl( 2 ); - - if( lPos == 0 ) - lPos = 1; - - if( hb_arrayDel( pArray, lPos ) ) - { - if( hb_pcount() >= 3 && ISLOG( 3 ) && hb_parl( 3 ) ) - hb_arraySize( pArray, hb_arrayLen( pArray ) - 1 ); - } - hb_itemReturn( pArray ); /* ADel() returns the array itself */ - } -} HB_FUNC_EXTERN( __SENDER ); diff --git a/harbour/contrib/xhb/xhbmsgs.c b/harbour/contrib/xhb/xhbmsgs.c index ab12418894..56e0ba097a 100644 --- a/harbour/contrib/xhb/xhbmsgs.c +++ b/harbour/contrib/xhb/xhbmsgs.c @@ -116,6 +116,11 @@ HB_FUNC( XHB_INCLUDE ) } } +/* + * check if array/string index is in valid range, update it if necessary + * in xHarbour compatibility mode where negative indexes are used to access + * data from tail + */ #undef HB_IS_VALID_INDEX #define HB_IS_VALID_INDEX( idx, max ) ( ( ( LONG ) (idx) < 0 ? (idx) += (max) + 1 : (idx) ) > 0 && ( ULONG ) (idx) <= (max) ) diff --git a/harbour/harbour.spec b/harbour/harbour.spec index b7bb2ea792..b05f0a6ba7 100644 --- a/harbour/harbour.spec +++ b/harbour/harbour.spec @@ -17,10 +17,8 @@ # --with pgsql - build pgsql lib # --with pgsql4 - build pgsql4 lib # --with gd - build gd lib -# --with tip - build tip lib (needs --withxhb) # --with odbc - build odbc lib # --with allegro - build GTALLEG - Allegro based GT driver -# --with xhb - build with xHarbour compatible extensions # --without adsrdd - do not build ADS RDD # --without gpl - do not build libs which needs GPL 3-rd party code # --without nf - do not build nanforum lib @@ -82,7 +80,7 @@ %define hb_ldir export HB_LIB_INSTALL=%{_libdir}/%{name} %define hb_opt export HB_GTALLEG=%{?_with_allegro:yes} %define hb_cmrc export HB_COMMERCE=%{?_without_gpl:yes} -%define hb_ctrb export HB_CONTRIBLIBS="%{?_with_gd:gd} %{?_with_tip:tip} %{?_with_xhb:xhb} %{?_with_pgsql:pgsql} %{?_with_mysql:mysql}" +%define hb_ctrb export HB_CONTRIBLIBS="%{?_with_gd:gd} %{?_with_pgsql:pgsql} %{?_with_mysql:mysql}" %define hb_env %{hb_arch} ; %{hb_cc} ; %{hb_cflag} ; %{hb_lflag} ; %{hb_mt} ; %{hb_gt} ; %{hb_defgt} ; %{hb_gpm} ; %{hb_sln} ; %{hb_x11} ; %{hb_bdir} ; %{hb_idir} ; %{hb_ldir} ; %{hb_opt} ; %{hb_ctrb} ; %{hb_cmrc} %define hb_host www.harbour-project.org @@ -245,11 +243,7 @@ case "`uname -m`" in export C_USR="$C_USR -fPIC" ;; esac -if [ "%{?_with_xhb:1}" ]; then - sed -e "s!/\* #define HB_COMPAT_XHB \*/!#define HB_COMPAT_XHB !g" \ - include/hbsetup.ch > include/hbsetup.ch-new && \ - mv include/hbsetup.ch-new include/hbsetup.ch -fi + [ "%{?_with_odbc:1}" ] || rm -fR contrib/odbc make -r @@ -522,13 +516,12 @@ rm -rf $RPM_BUILD_ROOT %{?_with_pgsql: %{_libdir}/%{name}/libhbpg.a} %{?_with_pgsql4: %{_libdir}/%{name}/libhbpg.a} %{?_with_gd: %{_libdir}/%{name}/libhbgd.a} -%{?_with_tip: %{_libdir}/%{name}/libtip.a} -%{?_with_xhb: %{_libdir}/%{name}/libxhb.a} - %{_libdir}/%{name}/libhbbtree.a %{_libdir}/%{name}/libhtml.a %{_libdir}/%{name}/libmisc.a %{_libdir}/%{name}/libct.a +%{_libdir}/%{name}/libtip.a +%{_libdir}/%{name}/libxhb.a %files lib %defattr(755,root,root,755) diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 14db187cc1..eb05268ea7 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -91,6 +91,7 @@ HB_EXTERN_BEGIN #define HB_IT_ARRAY ( ( HB_TYPE ) 0x08000 ) #define HB_IT_ENUM ( ( HB_TYPE ) 0x10000 ) #define HB_IT_EXTREF ( ( HB_TYPE ) 0x20000 ) +#define HB_IT_DEFAULT ( ( HB_TYPE ) 0x40000 ) #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 ) ) @@ -186,28 +187,28 @@ HB_EXTERN_BEGIN * these ones are can be the most efficiently optimized on some CPUs */ #define HB_IS_NIL( p ) ( HB_ITEM_TYPE( p ) == HB_IT_NIL ) -#define HB_IS_ARRAY( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_ARRAY ) != 0 ) -#define HB_IS_BLOCK( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_BLOCK ) != 0 ) -#define HB_IS_DATE( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_DATE ) != 0 ) -#define HB_IS_DOUBLE( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_DOUBLE ) != 0 ) -#define HB_IS_INTEGER( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_INTEGER ) != 0 ) -#define HB_IS_LOGICAL( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_LOGICAL ) != 0 ) -#define HB_IS_LONG( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_LONG ) != 0 ) -#define HB_IS_SYMBOL( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_SYMBOL ) != 0 ) -#define HB_IS_POINTER( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_POINTER ) != 0 ) -#define HB_IS_HASH( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_HASH ) != 0 ) -#define HB_IS_MEMO( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_MEMOFLAG ) != 0 ) -#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 ) -#define HB_IS_COMPLEX( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_COMPLEX ) != 0 ) -#define HB_IS_GCITEM( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_GCITEM ) != 0 ) -#define HB_IS_HASHKEY( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_HASHKEY ) != 0 ) -#define HB_IS_BADITEM( p ) ( ( HB_ITEM_TYPE( p ) & HB_IT_COMPLEX ) != 0 && ( HB_ITEM_TYPE( p ) & ~( HB_IT_COMPLEX | HB_IT_MEMOFLAG ) ) != 0 ) +#define HB_IS_ARRAY( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_ARRAY ) != 0 ) +#define HB_IS_BLOCK( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_BLOCK ) != 0 ) +#define HB_IS_DATE( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_DATE ) != 0 ) +#define HB_IS_DOUBLE( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_DOUBLE ) != 0 ) +#define HB_IS_INTEGER( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_INTEGER ) != 0 ) +#define HB_IS_LOGICAL( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_LOGICAL ) != 0 ) +#define HB_IS_LONG( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_LONG ) != 0 ) +#define HB_IS_SYMBOL( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_SYMBOL ) != 0 ) +#define HB_IS_POINTER( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_POINTER ) != 0 ) +#define HB_IS_HASH( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_HASH ) != 0 ) +#define HB_IS_MEMO( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_MEMOFLAG ) != 0 ) +#define HB_IS_STRING( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_STRING ) != 0 ) +#define HB_IS_MEMVAR( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_MEMVAR ) != 0 ) +#define HB_IS_ENUM( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_ENUM ) != 0 ) +#define HB_IS_EXTREF( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_EXTREF ) != 0 ) +#define HB_IS_BYREF( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_BYREF ) != 0 ) +#define HB_IS_NUMERIC( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_NUMERIC ) != 0 ) +#define HB_IS_NUMINT( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_NUMINT ) != 0 ) +#define HB_IS_COMPLEX( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_COMPLEX ) != 0 ) +#define HB_IS_GCITEM( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_GCITEM ) != 0 ) +#define HB_IS_HASHKEY( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_HASHKEY ) != 0 ) +#define HB_IS_BADITEM( p ) ( ( HB_ITEM_TYPERAW( p ) & HB_IT_COMPLEX ) != 0 && ( HB_ITEM_TYPERAW( p ) & ~( HB_IT_COMPLEX | HB_IT_MEMOFLAG | HB_IT_DEFAULT ) ) != 0 ) #define HB_IS_OBJECT( p ) ( HB_IS_ARRAY( p ) && HB_ARRAY_OBJ( p ) ) #define HB_IS_NUMBER( p ) HB_IS_NUMERIC( p ) @@ -608,17 +609,7 @@ extern HB_EXPORT void hb_retnll( LONGLONG lNumber );/* returns a long long num extern HB_EXPORT void hb_retnlllen( LONGLONG lNumber, int iWidth ); /* returns a long long number, with specific width */ #endif -/* - * check if array/string index is in valid range, update it if necessary - * in xHarbour compatibility mode where negative indexes are used to access - * data from tail - */ -#if defined( HB_COMPAT_XHB ) -# define HB_IS_VALID_INDEX( idx, max ) ( ( ( LONG ) (idx) < 0 ? (idx) += (max) + 1 : (idx) ) > 0 && ( ULONG ) (idx) <= (max) ) -#else -# define HB_IS_VALID_INDEX( idx, max ) ( (idx) > 0 && ( ULONG ) (idx) <= (max) ) -#endif - +#define HB_IS_VALID_INDEX( idx, max ) ( (idx) > 0 && ( ULONG ) (idx) <= (max) ) /* xHarbour compatible function */ #define hb_retcAdopt( szText ) hb_retc_buffer( (szText) ) diff --git a/harbour/include/hbexpra.c b/harbour/include/hbexpra.c index d4feec1710..ba973341cf 100644 --- a/harbour/include/hbexpra.c +++ b/harbour/include/hbexpra.c @@ -137,7 +137,7 @@ HB_EXPR_PTR hb_compExprNewFunCall( HB_EXPR_PTR pName, HB_EXPR_PTR pParms, HB_COM /* TODO: EMPTY() (not done by Clipper) */ if( iCount == 0 ) { -#if !defined( HB_MACRO_SUPPORT ) && defined( HB_COMPAT_XHB ) +#if !defined( HB_MACRO_SUPPORT ) && defined( HB_EMULATE_ENUMINDEX_FUNC ) if( strcmp( "HB_ENUMINDEX", pName->value.asSymbol ) == 0 ) { HB_ENUMERATOR_PTR pForVar, pEnumVar = NULL; @@ -497,7 +497,8 @@ HB_EXPR_PTR hb_compExprNewArrayAt( HB_EXPR_PTR pArray, HB_EXPR_PTR pIndex, HB_CO pExpr = HB_COMP_EXPR_NEW( HB_ET_ARRAYAT ); /* Check if this expression can be indexed */ - HB_EXPR_USE( pArray, HB_EA_ARRAY_AT ); + if( ! HB_SUPPORT_ARRSTR ) + HB_EXPR_USE( pArray, HB_EA_ARRAY_AT ); /* Check if this expression can be an index */ HB_EXPR_USE( pIndex, HB_EA_ARRAY_INDEX ); pExpr->value.asList.pExprList = pArray; diff --git a/harbour/include/hbexprb.c b/harbour/include/hbexprb.c index f2056875d4..3aa65816e3 100644 --- a/harbour/include/hbexprb.c +++ b/harbour/include/hbexprb.c @@ -54,7 +54,7 @@ #include "hbcomp.h" #include "hbmacro.ch" -#if !defined( HB_HASH_USES_ARRAY_INDEXES ) /* && defined( HB_COMPAT_XHB ) */ +#if !defined( HB_HASH_USES_ARRAY_INDEXES ) # define HB_HASH_USES_ARRAY_INDEXES #endif @@ -342,8 +342,7 @@ static HB_EXPR_FUNC( hb_compExprUseString ) case HB_EA_REDUCE: break; case HB_EA_ARRAY_AT: - if( ! HB_SUPPORT_ARRSTR ) - HB_COMP_ERROR_TYPE( pSelf ); + HB_COMP_ERROR_TYPE( pSelf ); break; case HB_EA_ARRAY_INDEX: #ifdef HB_HASH_USES_ARRAY_INDEXES @@ -1210,11 +1209,6 @@ static HB_EXPR_FUNC( hb_compExprUseArrayAt ) else lIndex = ( LONG ) pIdx->value.asNum.val.d; -#if !defined( HB_COMPAT_XHB ) - if( lIndex <= 0 ) - hb_compErrorBound( HB_COMP_PARAM, pIdx ); /* index <= 0 - bound error */ - else -#endif if( pExpr->ExprType == HB_ET_ARRAY ) /* is it a literal array */ { ULONG ulSize = hb_compExprParamListCheck( HB_COMP_PARAM, pExpr ); @@ -1223,7 +1217,10 @@ static HB_EXPR_FUNC( hb_compExprUseArrayAt ) /* restore original expression type */ pExpr->ExprType = HB_ET_ARRAY; else if( !HB_IS_VALID_INDEX( lIndex, ulSize ) ) - hb_compErrorBound( HB_COMP_PARAM, pIdx ); + { + if( !HB_SUPPORT_ARRSTR ) + hb_compErrorBound( HB_COMP_PARAM, pIdx ); + } else { pExpr = pExpr->value.asList.pExprList; /* the first element in the array */ @@ -1246,15 +1243,16 @@ static HB_EXPR_FUNC( hb_compExprUseArrayAt ) HB_COMP_EXPR_DELETE( pSelf ); pSelf = pNew; } - else + else if( !HB_SUPPORT_ARRSTR ) hb_compErrorBound( HB_COMP_PARAM, pIdx ); } } +#if 0 else if( pExpr->ExprType == HB_ET_STRING && HB_SUPPORT_ARRSTR ) /* is it a literal string */ { if( HB_IS_VALID_INDEX( lIndex, pExpr->ulLength ) ) { -#if defined( HB_COMPAT_XHB ) +#if defined( HB_COMPAT_X HB ) char * pszValue = ( char * ) hb_xgrab( 2 ); pszValue[ 0 ] = pExpr->value.asString.string[ lIndex - 1 ]; pszValue[ 1 ] = '\0'; @@ -1271,7 +1269,8 @@ static HB_EXPR_FUNC( hb_compExprUseArrayAt ) else hb_compErrorBound( HB_COMP_PARAM, pIdx ); } - else +#endif + else if( !HB_SUPPORT_ARRSTR ) { HB_EXPR_USE( pExpr, HB_EA_ARRAY_AT ); } diff --git a/harbour/include/hbsetup.ch b/harbour/include/hbsetup.ch index 8ff5a6a197..f51f621a41 100644 --- a/harbour/include/hbsetup.ch +++ b/harbour/include/hbsetup.ch @@ -71,7 +71,6 @@ /* #define HB_COMPAT_FOXPRO */ /* Enable FoxPro extensions */ /* #define HB_COMPAT_DBASE */ /* Enable dBase extensions */ /* #define HB_COMPAT_CLIP */ /* Enable CLIP extensions */ -/* #define HB_COMPAT_XHB */ /* Enable xHarbour extensions */ /* NOTE: HB_SHORTNAMES must be defined manually if the symbol name length is set to 10 explicitly and not through the HB_C52_STRICT option diff --git a/harbour/include/hbvm.h b/harbour/include/hbvm.h index 2e361d987c..485ac96fb8 100644 --- a/harbour/include/hbvm.h +++ b/harbour/include/hbvm.h @@ -147,7 +147,7 @@ extern HB_EXPORT void hb_vmPushState( void ); /* push current VM state on st 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 */ +extern BOOL hb_vmMsgReference( PHB_ITEM pObject, PHB_DYNS pMessage, PHB_DYNS pAccMsg ); /* create extended message reference */ /* various flags for supported features */ #define HB_VMFLAG_HARBOUR 1 /* enable Harbour extension */ diff --git a/harbour/include/hbvmpub.h b/harbour/include/hbvmpub.h index 818357c1b8..e3bcd97e46 100644 --- a/harbour/include/hbvmpub.h +++ b/harbour/include/hbvmpub.h @@ -61,14 +61,15 @@ HB_EXTERN_BEGIN struct _HB_SYMB; -# define HB_ITEM_TYPE( p ) ( ( p )->type ) -# define HB_OBJ_CLASS( p ) ( ( p )->item.asArray.value->uiClass ) -# define HB_ARRAY_OBJ( p ) ( ( p )->item.asArray.value->uiClass != 0 ) +# define HB_ITEM_TYPERAW( p ) ( ( p )->type ) +# define HB_ITEM_TYPE( p ) ( HB_ITEM_TYPERAW( p ) & ~ HB_IT_DEFAULT ) +# define HB_OBJ_CLASS( p ) ( ( p )->item.asArray.value->uiClass ) +# define HB_ARRAY_OBJ( p ) ( ( p )->item.asArray.value->uiClass != 0 ) # if defined(__GNUC__) -# define HB_ITEM_NIL { HB_IT_NIL, {} } +# define HB_ITEM_NIL { HB_IT_NIL, {} } # else -# define HB_ITEM_NIL { HB_IT_NIL, NULL } +# define HB_ITEM_NIL { HB_IT_NIL, NULL } # endif # define HB_ITEM_GET_NUMINTRAW( p ) ( HB_IS_INTEGER( p ) ? \ @@ -89,7 +90,7 @@ struct _HB_SYMB; (p)->item.asLong.value = (v); \ (p)->item.asLong.length = HB_LONG_LENGTH( v ); \ } \ - } while ( 0 ) + } while( 0 ) /* dynamic symbol structure */ typedef struct _HB_DYNS @@ -118,10 +119,11 @@ struct _HB_SYMB; # undef HB_STACK_MACROS /* This is ugly trick but works without speed overhead */ -# define HB_ITEM_TYPE( p ) ( * ( HB_TYPE * ) ( p ) ) - +# define HB_ITEM_TYPERAW( p ) ( * ( HB_TYPE * ) ( p ) ) /* if you do not like it then use this definition */ -/* # define HB_ITEM_TYPE( p ) ( hb_itemType( p ) ) */ +/* # define HB_ITEM_TYPERAW( p ) ( hb_itemType( p ) ) */ + +# define HB_ITEM_TYPE( p ) ( HB_ITEM_TYPERAW( p ) & ~HB_IT_DEFAULT ) # define HB_OBJ_CLASS( p ) ( hb_objGetClass( p ) ) # define HB_ARRAY_OBJ( p ) ( hb_arrayIsObject( p ) ) @@ -154,7 +156,6 @@ struct _HB_SYMB; #endif - /* symbol support structure */ typedef struct _HB_SYMB { diff --git a/harbour/make_rpm.sh b/harbour/make_rpm.sh index 6555513f4b..6a31c9ca79 100755 --- a/harbour/make_rpm.sh +++ b/harbour/make_rpm.sh @@ -16,10 +16,8 @@ # --with mysql - build mysql lib # --with pgsql - build pgsql lib # --with gd - build gd lib -# --with tip - build tip lib (needs --withxhb) # --with odbc - build odbc lib # --with allegro - build GTALLEG - Allegro based GT driver -# --with xhb - build with xHarbour compatible extensions # --without adsrdd - do not build ADS RDD # --without gpl - do not build libs which needs GPL 3-rd party code # --without nf - do not build nanforum lib @@ -121,9 +119,6 @@ if ! test_reqrpm "XFree86-devel" then INST_PARAM="${INST_PARAM} --without X11" fi -if [ "${C_USR//-DHB_COMPAT_XHB/}" = "${C_USR}" ]; then - INST_PARAM="${INST_PARAM} --without tip" -fi TOINST_LST="" for i in ${NEED_RPM} diff --git a/harbour/source/common/hbverdsp.c b/harbour/source/common/hbverdsp.c index 2bfb91c33c..23d8beff8d 100644 --- a/harbour/source/common/hbverdsp.c +++ b/harbour/source/common/hbverdsp.c @@ -169,14 +169,6 @@ void hb_verBuildInfo( void ) #endif hb_conOutErr( hb_conNewLine(), 0 ); - hb_conOutErr( "xHarbour compatible extensions: ", 0 ); -#if defined( HB_COMPAT_XHB ) - hb_conOutErr( "Yes", 0 ); -#else - hb_conOutErr( "No", 0 ); -#endif - hb_conOutErr( hb_conNewLine(), 0 ); - hb_conOutErr( "Alaska Xbase++ compatible extensions: ", 0 ); #if defined( HB_COMPAT_XPP ) hb_conOutErr( "Yes", 0 ); diff --git a/harbour/source/compiler/hbcomp.c b/harbour/source/compiler/hbcomp.c index 2673ddcb34..21185257b2 100644 --- a/harbour/source/compiler/hbcomp.c +++ b/harbour/source/compiler/hbcomp.c @@ -216,9 +216,6 @@ HB_COMP_PTR hb_comp_new( void ) HB_COMPFLAG_HB_INLINE | HB_COMPFLAG_OPTJUMP | HB_COMPFLAG_MACROTEXT | -#if defined( HB_COMPAT_XHB ) - HB_COMPFLAG_ARRSTR | -#endif HB_COMPFLAG_SHORTCUTS; pComp->fTextSubst = ( pComp->supported & HB_COMPFLAG_MACROTEXT ) != 0; diff --git a/harbour/source/compiler/hbusage.c b/harbour/source/compiler/hbusage.c index ed7a6bac75..7cb28686de 100644 --- a/harbour/source/compiler/hbusage.c +++ b/harbour/source/compiler/hbusage.c @@ -127,9 +127,7 @@ void hb_compPrintModes( HB_COMP_DECL ) "\n h Harbour mode (default)", "\n i enable support for HB_INLINE", "\n r runtime settings enabled", -#if defined( HB_COMPAT_XHB ) - "\n s string as bytes array enabled", -#endif + "\n s allow indexed assignment on all types", "\n x extended xbase mode", "\n J turn off jump optimization in pcode", "\n M turn off macrotext substitution", diff --git a/harbour/source/compiler/ppcomp.c b/harbour/source/compiler/ppcomp.c index eae1fd922a..d07169b844 100644 --- a/harbour/source/compiler/ppcomp.c +++ b/harbour/source/compiler/ppcomp.c @@ -187,10 +187,55 @@ static BOOL hb_pp_CompilerSwitch( void * cargo, const char * szSwitch, } else if( i == 2 ) { - if( hb_strnicmp( szSwitch, "es", 2 ) == 0 && - ( iValue == HB_EXITLEVEL_DEFAULT || - iValue == HB_EXITLEVEL_SETEXIT || - iValue == HB_EXITLEVEL_DELTARGET ) ) + if( szSwitch[ 0 ] == 'k' || szSwitch[ 0 ] == 'K' ) + { + int iFlag = 0; + /* -k? parameters are case sensitive */ + switch( szSwitch[ 1 ] ) + { + case 'c': + /* clear all flags - minimal set of features */ + HB_COMP_PARAM->supported &= HB_COMPFLAG_SHORTCUTS; + HB_COMP_PARAM->supported |= HB_COMPFLAG_OPTJUMP; + break; + case 'h': + iFlag = HB_COMPFLAG_HARBOUR; + break; + case 'i': + iFlag = HB_COMPFLAG_HB_INLINE; + break; + case 'r': + iFlag = HB_COMPFLAG_RT_MACRO; + break; + case 'x': + iFlag = HB_COMPFLAG_XBASE; + break; + case 'J': + iFlag = HB_COMPFLAG_OPTJUMP; + iValue = !iValue; + break; + case 'M': + iFlag = HB_COMPFLAG_MACROTEXT; + iValue = !iValue; + break; + case 's': + iFlag = HB_COMPFLAG_ARRSTR; + break; + default: + fError = TRUE; + } + if( !fError && iFlag ) + { + if( iValue ) + HB_COMP_PARAM->supported |= iFlag; + else + HB_COMP_PARAM->supported &= ~iFlag; + } + } + else if( hb_strnicmp( szSwitch, "es", 2 ) == 0 && + ( iValue == HB_EXITLEVEL_DEFAULT || + iValue == HB_EXITLEVEL_SETEXIT || + iValue == HB_EXITLEVEL_DELTARGET ) ) HB_COMP_PARAM->iExitLevel = iValue; else if( hb_stricmp( szSwitch, "p+" ) == 0 ) HB_COMP_PARAM->fPPT = iValue != 0; diff --git a/harbour/source/pp/ppcore.c b/harbour/source/pp/ppcore.c index 4492b5f341..ab57bd398e 100644 --- a/harbour/source/pp/ppcore.c +++ b/harbour/source/pp/ppcore.c @@ -2183,15 +2183,17 @@ static PHB_PP_TOKEN hb_pp_pragmaGetSwitch( PHB_PP_TOKEN pToken, int * piValue ) if( pToken && HB_PP_TOKEN_TYPE( pToken->type ) == HB_PP_TOKEN_KEYWORD ) { + BOOL fNum = pToken->len > 1 && HB_PP_ISDIGIT( pToken->value[ pToken->len - 1 ] ); + if( HB_PP_TOKEN_ISEOC( pToken->pNext ) ) { - if( pToken->len > 1 && HB_PP_ISDIGIT( pToken->value[ pToken->len - 1 ] ) ) + if( fNum ) { pValue = pToken; * piValue = pValue->value[ pToken->len - 1 ] - '0'; } } - else if( HB_PP_TOKEN_ISEOC( pToken->pNext->pNext ) ) + else if( HB_PP_TOKEN_ISEOC( pToken->pNext->pNext ) && !fNum ) { if( HB_PP_TOKEN_TYPE( pToken->pNext->type ) == HB_PP_TOKEN_MINUS ) { @@ -2206,7 +2208,7 @@ static PHB_PP_TOKEN hb_pp_pragmaGetSwitch( PHB_PP_TOKEN pToken, int * piValue ) else if( HB_PP_TOKEN_TYPE( pToken->pNext->type ) == HB_PP_TOKEN_NUMBER ) { pValue = pToken; - * piValue = atoi( pValue->value ); + * piValue = atoi( pValue->pNext->value ); } } } diff --git a/harbour/source/rdd/workarea.c b/harbour/source/rdd/workarea.c index e38fec6c12..3ddfa80622 100644 --- a/harbour/source/rdd/workarea.c +++ b/harbour/source/rdd/workarea.c @@ -299,6 +299,8 @@ static ERRCODE hb_waCreateFields( AREAP pArea, PHB_ITEM pStruct ) pFieldInfo.uiDec = 0; #ifdef DBS_FLAG pFieldInfo.uiFlags = hb_arrayGetNI( pFieldDesc, DBS_FLAG ); +#else + pFieldInfo.uiFlags = 0; #endif iData = toupper( hb_arrayGetCPtr( pFieldDesc, DBS_TYPE )[ 0 ] ); switch( iData ) diff --git a/harbour/source/rtl/errorapi.c b/harbour/source/rtl/errorapi.c index 1746fd76c3..fe174ed3a1 100644 --- a/harbour/source/rtl/errorapi.c +++ b/harbour/source/rtl/errorapi.c @@ -251,7 +251,7 @@ HB_FUNC_STATIC( _DESCRIPTION ) { PHB_ITEM pItem = hb_param( 1, HB_IT_ANY ); - if( HB_IS_STRING( pItem ) ) + if( pItem && HB_IS_STRING( pItem ) ) hb_errPutDescription( hb_stackSelfItem(), hb_itemGetCPtr( pItem ) ); hb_itemReturn( pItem ); @@ -267,7 +267,7 @@ HB_FUNC_STATIC( _FILENAME ) { PHB_ITEM pItem = hb_param( 1, HB_IT_ANY ); - if( HB_IS_STRING( pItem ) ) + if( pItem && HB_IS_STRING( pItem ) ) hb_errPutFileName( hb_stackSelfItem(), hb_itemGetCPtr( pItem ) ); hb_itemReturn( pItem ); @@ -283,7 +283,7 @@ HB_FUNC_STATIC( _OPERATION ) { PHB_ITEM pItem = hb_param( 1, HB_IT_ANY ); - if( HB_IS_STRING( pItem ) ) + if( pItem && HB_IS_STRING( pItem ) ) hb_errPutOperation( hb_stackSelfItem(), hb_itemGetCPtr( pItem ) ); hb_itemReturn( pItem ); @@ -299,7 +299,7 @@ HB_FUNC_STATIC( _SUBSYSTEM ) { PHB_ITEM pItem = hb_param( 1, HB_IT_ANY ); - if( HB_IS_STRING( pItem ) ) + if( pItem && HB_IS_STRING( pItem ) ) hb_errPutSubSystem( hb_stackSelfItem(), hb_itemGetCPtr( pItem ) ); hb_itemReturn( pItem ); diff --git a/harbour/source/vm/arrayshb.c b/harbour/source/vm/arrayshb.c index 9cf15571be..584364b8af 100644 --- a/harbour/source/vm/arrayshb.c +++ b/harbour/source/vm/arrayshb.c @@ -50,9 +50,6 @@ * */ -#include - -#include "hbvmopt.h" #include "hbapi.h" #include "hbstack.h" #include "hbapiitm.h" @@ -133,8 +130,8 @@ HB_FUNC( HB_ARRAYID ) /* for debugging: returns the array's "address" so dual r { PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY ); - if( HB_IS_ARRAY(pArray) ) - hb_retnl( (long) pArray->item.asArray.value ); + if( pArray ) + hb_retnl( ( long ) hb_arrayId( pArray ) ); else hb_retnl( -1 ); } @@ -313,6 +310,54 @@ HB_FUNC( HB_RASCAN ) hb_retni( 0 ); } +HB_FUNC( HB_AINS ) +{ + PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY ); + + if( pArray ) + { + long lPos = hb_parnl( 2 ); + + if( lPos == 0 ) + lPos = 1; + + if( hb_pcount() >= 4 && ISLOG( 4 ) && hb_parl( 4 ) ) + { + ULONG ulLen = hb_arrayLen( pArray ) + 1; + if( lPos >= 1 && ( ULONG ) lPos <= ulLen ) + hb_arraySize( pArray, ulLen ); + } + + if( hb_arrayIns( pArray, lPos ) ) + { + if( hb_pcount() >= 3 && !ISNIL( 3 ) ) + hb_arraySet( pArray, lPos, hb_param( 3, HB_IT_ANY ) ); + } + hb_itemReturn( pArray ); /* AIns() returns the array itself */ + } +} + +HB_FUNC( HB_ADEL ) +{ + PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY ); + + if( pArray ) + { + long lPos = hb_parnl( 2 ); + + if( lPos == 0 ) + lPos = 1; + + if( hb_arrayDel( pArray, lPos ) ) + { + if( hb_pcount() >= 3 && ISLOG( 3 ) && hb_parl( 3 ) ) + hb_arraySize( pArray, hb_arrayLen( pArray ) - 1 ); + } + hb_itemReturn( pArray ); /* ADel() returns the array itself */ + } +} + + /* TODO: In Xbase++ fifth parameter determines whether array elements are passed by reference to the code block. [vszakats] */ diff --git a/harbour/source/vm/classes.c b/harbour/source/vm/classes.c index ff5f42fba2..9d4ea38a36 100644 --- a/harbour/source/vm/classes.c +++ b/harbour/source/vm/classes.c @@ -165,11 +165,12 @@ typedef struct { PHB_DYNS pMessage; /* Method symbolic name */ PHB_SYMB pFuncSym; /* Function symbol */ + PHB_DYNS pAccMsg; /* Corresponding access method symbolic name */ + HB_TYPE itemType; /* Type of item in restricted assignment */ USHORT uiSprClass; /* Originalclass'handel (super or current class'handel if not herited). */ /*Added by RAC&JF*/ USHORT uiScope; /* Scoping value */ USHORT uiData; /* Item position for instance data, class data and shared data (Harbour like, begin from 1) or delegated message index object */ USHORT uiOffset; /* position in pInitData for class datas (from 1) or offset to instance area in inherited instance data and supercast messages (from 0) */ - HB_TYPE itemType; /* Type of item in restricted assignment */ USHORT uiPrevCls; USHORT uiPrevMth; #ifndef HB_NO_PROFILER @@ -1977,10 +1978,18 @@ BOOL hb_objGetVarRef( PHB_ITEM pObject, PHB_SYMB pMessage, pMethod->uiData, hb_stackReturnItem() ); } else if( pExecSym->value.pFunPtr == hb___msgScopeErr ) - (pExecSym->value.pFunPtr)(); + { + pExecSym->value.pFunPtr(); + } else { - return hb_vmMsgReference( pObject, pMessage ); + PCLASS pClass = &s_pClasses[ pStack->uiClass ]; + PMETHOD pMethod = pClass->pMethods + pStack->uiMethod; + + if( !pMethod->pAccMsg ) + pMethod->pAccMsg = hb_dynsymGetCase( pMessage->szName + 1 ); + + return hb_vmMsgReference( pObject, pMessage->pDynSym, pMethod->pAccMsg ); } } @@ -4094,7 +4103,8 @@ static HARBOUR hb___msgSetClsData( void ) else { - if( pMethod->itemType && ! ( pMethod->itemType & pReturn->type ) ) + if( pMethod->itemType && + ! ( pMethod->itemType & HB_ITEM_TYPERAW( pReturn ) ) ) { if( pMethod->itemType == HB_IT_NUMINT && HB_IS_NUMERIC( pReturn ) ) hb_itemPutNInt( pReturn, hb_itemGetNInt( pReturn ) ); @@ -4144,7 +4154,8 @@ static HARBOUR hb___msgSetShrData( void ) pMethod->uiData, hb_stackReturnItem() ); else { - if( pMethod->itemType && ! ( pMethod->itemType & pReturn->type ) ) + if( pMethod->itemType && + ! ( pMethod->itemType & HB_ITEM_TYPERAW( pReturn ) ) ) { if( pMethod->itemType == HB_IT_NUMINT && HB_IS_NUMERIC( pReturn ) ) hb_itemPutNInt( pReturn, hb_itemGetNInt( pReturn ) ); @@ -4227,7 +4238,8 @@ static HARBOUR hb___msgSetData( void ) else { - if( pMethod->itemType && ! ( pMethod->itemType & pReturn->type ) ) + if( pMethod->itemType && + ! ( pMethod->itemType & HB_ITEM_TYPERAW( pReturn ) ) ) { if( pMethod->itemType == HB_IT_NUMINT && HB_IS_NUMERIC( pReturn ) ) hb_itemPutNInt( pReturn, hb_itemGetNInt( pReturn ) ); diff --git a/harbour/source/vm/cmdarg.c b/harbour/source/vm/cmdarg.c index 25396202ef..3b68ca68ca 100644 --- a/harbour/source/vm/cmdarg.c +++ b/harbour/source/vm/cmdarg.c @@ -309,10 +309,6 @@ ULONG hb_cmdargProcessVM( int *pCancelKey, int *pCancelKeyEx ) char * cFlags; ULONG ulFlags = HB_VMFLAG_HARBOUR; -#if defined( HB_COMPAT_XHB ) - ulFlags |= HB_VMFLAG_ARRSTR; -#endif - if( hb_cmdargCheck( "INFO" ) ) { { diff --git a/harbour/source/vm/extend.c b/harbour/source/vm/extend.c index ed9fd92c83..7a10cb5ed0 100644 --- a/harbour/source/vm/extend.c +++ b/harbour/source/vm/extend.c @@ -695,17 +695,13 @@ HB_EXPORT ULONG hb_parinfo( int iParam ) return ( ULONG ) hb_pcount(); else { - if( ( iParam > 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) ) + if( iParam >= -1 && iParam <= hb_pcount() ) { - HB_TYPE uiType = ( iParam == -1 ) ? hb_stackReturnItem()->type : ( hb_stackItemFromBase( iParam ) )->type; + PHB_ITEM pItem = ( iParam == -1 ) ? hb_stackReturnItem() : hb_stackItemFromBase( iParam ); + HB_TYPE uiType = HB_ITEM_TYPE( pItem ); if( uiType & HB_IT_BYREF ) - { - PHB_ITEM pItem = hb_itemUnRef( ( iParam == -1 ) ? hb_stackReturnItem() : hb_stackItemFromBase( iParam ) ); - - if( pItem ) - uiType |= pItem->type; - } + uiType |= HB_ITEM_TYPE( hb_itemUnRef( pItem ) ); return ( ULONG ) uiType; } diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 76a04513f4..033466ed5a 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -221,7 +221,6 @@ 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 @@ -2314,7 +2313,7 @@ static void hb_vmAddInt( HB_ITEM_PTR pResult, LONG lAdd ) pResult->item.asDate.value += lAdd; return; } - else if( pResult->type & HB_IT_DOUBLE ) + else if( HB_IS_DOUBLE( pResult ) ) { dNewVal = pResult->item.asDouble.value + lAdd; } @@ -2380,6 +2379,7 @@ static void hb_vmNegate( void ) else #endif { + pItem->type = HB_IT_INTEGER; pItem->item.asInteger.value = -pItem->item.asInteger.value; pItem->item.asInteger.length = HB_INT_LENGTH( pItem->item.asInteger.value ); } @@ -2397,12 +2397,14 @@ static void hb_vmNegate( void ) else #endif { + pItem->type = HB_IT_LONG; pItem->item.asLong.value = -pItem->item.asLong.value; pItem->item.asLong.length = HB_LONG_LENGTH( pItem->item.asLong.value ); } } else if( HB_IS_DOUBLE( pItem ) ) { + pItem->type = HB_IT_DOUBLE; pItem->item.asDouble.value = -pItem->item.asDouble.value; pItem->item.asDouble.length = HB_DBL_LENGTH( pItem->item.asDouble.value ); } @@ -2439,11 +2441,12 @@ static void hb_vmPlus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIte } else if( HB_IS_NUMERIC( pItem1 ) && HB_IS_NUMERIC( pItem2 ) ) { - int iDec2, iDec1, iType2 = pItem2->type, iType1 = pItem2->type; + int iDec1, iDec2; double dNumber1 = hb_itemGetNDDec( pItem1, &iDec1 ); double dNumber2 = hb_itemGetNDDec( pItem2, &iDec2 ); - hb_itemPutNumType( pResult, dNumber1 + dNumber2, ( ( iDec1 > iDec2 ) ? iDec1 : iDec2 ), iType1, iType2 ); + hb_itemPutNumType( pResult, dNumber1 + dNumber2, HB_MAX( iDec1, iDec2 ), + HB_ITEM_TYPERAW( pItem1 ), HB_ITEM_TYPERAW( pItem2 ) ); } else if( HB_IS_STRING( pItem1 ) && HB_IS_STRING( pItem2 ) ) { @@ -2473,7 +2476,7 @@ static void hb_vmPlus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIte } else if( pResult != pItem1 ) hb_itemCopy( pResult, pItem1 ); - pResult->type &= ~HB_IT_MEMOFLAG; + pResult->type &= ~( HB_IT_MEMOFLAG | HB_IT_DEFAULT ); } else if( HB_IS_DATE( pItem1 ) && HB_IS_DATE( pItem2 ) ) { @@ -2488,28 +2491,6 @@ static void hb_vmPlus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIte { hb_itemPutDL( pResult, hb_itemGetNL( pItem1 ) + hb_itemGetDL( pItem2 ) ); } -#if defined( HB_COMPAT_XHB ) - else if( HB_IS_HASH( pItem1 ) && HB_IS_HASH( pItem2 ) ) - { - /* - * This is not xHarbour compatible but the idea of using +/- operators - * for complex items like hashes with automatic cloning is horrible - * for me. People may expect that it will be faster then calling - * function like HMERGE() when it fact it can be many times slower due - * to cost of clone operation so I added this to reduce the overhead - * for += / -= operations, [druzus] - */ - if( pResult == pItem1 ) - hb_hashJoin( pItem1, pItem2, HB_HASH_UNION ); - else - { - PHB_ITEM pHash = hb_hashClone( pItem1 ); - hb_hashJoin( pHash, pItem2, HB_HASH_UNION ); - hb_itemMove( pResult, pHash ); - hb_itemRelease( pHash ); - } - } -#endif else if( ! hb_objOperatorCall( HB_OO_OP_PLUS, pResult, pItem1, pItem2, NULL ) ) { PHB_ITEM pSubst = hb_errRT_BASE_Subst( EG_ARG, 1081, NULL, "+", 2, pItem1, pItem2 ); @@ -2543,11 +2524,12 @@ static void hb_vmMinus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIt } else if( HB_IS_NUMERIC( pItem1 ) && HB_IS_NUMERIC( pItem2 ) ) { - int iDec2, iDec1, iType2 = pItem2->type, iType1 = pItem2->type; + int iDec1, iDec2; double dNumber1 = hb_itemGetNDDec( pItem1, &iDec1 ); double dNumber2 = hb_itemGetNDDec( pItem2, &iDec2 ); - hb_itemPutNumType( pResult, dNumber1 - dNumber2, ( ( iDec1 > iDec2 ) ? iDec1 : iDec2 ), iType1, iType2 ); + hb_itemPutNumType( pResult, dNumber1 - dNumber2, HB_MAX( iDec1, iDec2 ), + HB_ITEM_TYPERAW( pItem1 ), HB_ITEM_TYPERAW( pItem2 ) ); } else if( HB_IS_DATE( pItem1 ) && HB_IS_DATE( pItem2 ) ) { @@ -2565,13 +2547,13 @@ static void hb_vmMinus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIt if( ulLen1 == 0 ) { hb_itemCopy( pResult, pItem2 ); - pResult->type &= ~HB_IT_MEMOFLAG; + pResult->type &= ~( HB_IT_MEMOFLAG | HB_IT_DEFAULT ); } else if( ulLen2 == 0 ) { if( pResult != pItem1 ) hb_itemCopy( pResult, pItem1 ); - pResult->type &= ~HB_IT_MEMOFLAG; + pResult->type &= ~( HB_IT_MEMOFLAG | HB_IT_DEFAULT ); } else if( ulLen1 < ULONG_MAX - ulLen2 ) { @@ -2591,22 +2573,6 @@ static void hb_vmMinus( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIt else hb_errRT_BASE( EG_STROVERFLOW, 1210, NULL, "-", 2, pItem1, pItem2 ); } -#if defined( HB_COMPAT_XHB ) - else if( HB_IS_HASH( pItem1 ) ) - { - /* This is not xHarbour compatible - see note above in hb_vmPlus() */ - if( pResult == pItem1 ) - hb_hashRemove( pItem1, pItem2 ); - else - { - PHB_ITEM pHash = hb_hashClone( pItem1 ); - - hb_hashRemove( pHash, pItem2 ); - hb_itemMove( pResult, pHash ); - hb_itemRelease( pHash ); - } - } -#endif else if( ! hb_objOperatorCall( HB_OO_OP_MINUS, pResult, pItem1, pItem2, NULL ) ) { PHB_ITEM pSubst = hb_errRT_BASE_Subst( EG_ARG, 1082, NULL, "-", 2, pItem1, pItem2 ); @@ -2635,11 +2601,12 @@ static void hb_vmMult( HB_ITEM_PTR pResult, HB_ITEM_PTR pItem1, HB_ITEM_PTR pIte } else */ if( HB_IS_NUMERIC( pItem1 ) && HB_IS_NUMERIC( pItem2 ) ) { - int iDec2, iDec1, iType2 = pItem2->type, iType1 = pItem2->type; + int iDec1, iDec2; double dNumber1 = hb_itemGetNDDec( pItem1, &iDec1 ); double dNumber2 = hb_itemGetNDDec( pItem2, &iDec2 ); - hb_itemPutNumType( pResult, dNumber1 * dNumber2, iDec1 + iDec2, iType1, iType2 ); + hb_itemPutNumType( pResult, dNumber1 * dNumber2, iDec1 + iDec2, + HB_ITEM_TYPERAW( pItem1 ), HB_ITEM_TYPERAW( pItem2 ) ); } else if( ! hb_objOperatorCall( HB_OO_OP_MULT, pResult, pItem1, pItem2, NULL ) ) @@ -2809,6 +2776,7 @@ static void hb_vmInc( PHB_ITEM pItem ) { if( pItem->item.asInteger.value < HB_INT_MAX ) { + pItem->type = HB_IT_INTEGER; pItem->item.asInteger.value++; pItem->item.asInteger.length = HB_INT_LENGTH( pItem->item.asInteger.value ); } @@ -2828,6 +2796,7 @@ static void hb_vmInc( PHB_ITEM pItem ) } else if( pItem->item.asLong.value < HB_LONG_MAX ) { + pItem->type = HB_IT_LONG; pItem->item.asLong.value++; pItem->item.asLong.length = HB_LONG_LENGTH( pItem->item.asLong.value ); } @@ -2841,11 +2810,13 @@ static void hb_vmInc( PHB_ITEM pItem ) } else if( HB_IS_DOUBLE( pItem ) ) { + pItem->type = HB_IT_DOUBLE; pItem->item.asDouble.value++; pItem->item.asDouble.length = HB_DBL_LENGTH( pItem->item.asDouble.value ); } else if( HB_IS_DATE( pItem ) ) { + pItem->type = HB_IT_DATE; pItem->item.asDate.value++; } else if( ! hb_objOperatorCall( HB_OO_OP_INC, pItem, pItem, NULL, NULL ) ) @@ -2870,6 +2841,7 @@ static void hb_vmDec( PHB_ITEM pItem ) { if( pItem->item.asInteger.value > HB_INT_MIN ) { + pItem->type = HB_IT_INTEGER; pItem->item.asInteger.value--; pItem->item.asInteger.length = HB_INT_LENGTH( pItem->item.asInteger.value ); } @@ -2889,6 +2861,7 @@ static void hb_vmDec( PHB_ITEM pItem ) } else if( pItem->item.asLong.value > HB_LONG_MIN ) { + pItem->type = HB_IT_LONG; pItem->item.asLong.value--; pItem->item.asLong.length = HB_LONG_LENGTH( pItem->item.asLong.value ); } @@ -2902,11 +2875,13 @@ static void hb_vmDec( PHB_ITEM pItem ) } else if( HB_IS_DOUBLE( pItem ) ) { + pItem->type = HB_IT_DOUBLE; pItem->item.asDouble.value--; pItem->item.asDouble.length = HB_DBL_LENGTH( pItem->item.asDouble.value ); } else if( HB_IS_DATE( pItem ) ) { + pItem->type = HB_IT_DATE; pItem->item.asDate.value--; } else if( ! hb_objOperatorCall( HB_OO_OP_DEC, pItem, pItem, NULL, NULL ) ) @@ -3443,15 +3418,6 @@ static void hb_vmInstring( void ) hb_stackPop(); hb_vmPushLogical( fResult ); } -#if defined( HB_COMPAT_XHB ) - else if( HB_IS_ARRAY( pItem2 ) ) - { - BOOL fResult = hb_arrayScan( pItem2, pItem1, NULL, NULL, TRUE ) != 0; - - hb_stackPop(); - hb_stackPop(); - hb_vmPushLogical( fResult ); - } else if( HB_IS_HASH( pItem2 ) && ( HB_IS_HASHKEY( pItem1 ) || hb_hashLen( pItem1 ) == 1 ) ) { @@ -3461,7 +3427,6 @@ static void hb_vmInstring( void ) hb_stackPop(); hb_vmPushLogical( fResult ); } -#endif else if( hb_objOperatorCall( HB_OO_OP_INCLUDE, pItem1, pItem2, pItem1, NULL ) ) hb_stackPop(); @@ -4011,7 +3976,10 @@ static void hb_vmNot( void ) pItem = hb_stackItemFromTop( -1 ); if( HB_IS_LOGICAL( pItem ) ) + { + pItem->type = HB_IT_LOGICAL; pItem->item.asLogical.value = ! pItem->item.asLogical.value; + } else if( ! hb_objOperatorCall( HB_OO_OP_NOT, pItem, pItem, NULL, NULL ) ) { PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1077, NULL, ".NOT.", 1, pItem ); @@ -4036,6 +4004,7 @@ static void hb_vmAnd( void ) if( HB_IS_LOGICAL( pItem1 ) && HB_IS_LOGICAL( pItem2 ) ) { + pItem1->type = HB_IT_LOGICAL; pItem1->item.asLogical.value = pItem1->item.asLogical.value && pItem2->item.asLogical.value; pItem2->type = HB_IT_NIL; hb_stackDec(); @@ -4068,6 +4037,7 @@ static void hb_vmOr( void ) if( HB_IS_LOGICAL( pItem1 ) && HB_IS_LOGICAL( pItem2 ) ) { + pItem1->type = HB_IT_LOGICAL; pItem1->item.asLogical.value = pItem1->item.asLogical.value || pItem2->item.asLogical.value; pItem2->type = HB_IT_NIL; hb_stackDec(); @@ -4176,26 +4146,6 @@ static void hb_vmArrayPush( void ) 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 ) ) - { - UCHAR uc = ( UCHAR ) pArray->item.asString.value[ ulIndex - 1 ]; -#if defined( HB_COMPAT_XHB ) - hb_itemPutCL( pArray, hb_szAscii[ uc ], 1 ); -#else - hb_itemPutNI( pArray, uc ); -#endif - hb_stackPop(); - } - else if( hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pArray, pArray, pIndex, NULL ) ) - hb_stackPop(); - else - hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), - 2, pArray, pIndex ); - - return; - } else if( hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pArray, pArray, pIndex, NULL ) ) hb_stackPop(); @@ -4287,24 +4237,6 @@ static void hb_vmArrayPushRef( void ) 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 */ @@ -4337,7 +4269,7 @@ static void hb_vmArrayPop( void ) PHB_ITEM pDest = hb_hashGetItemPtr( pArray, pIndex, HB_HASH_AUTOADD_ASSIGN ); if( pDest ) { - pValue->type &= ~HB_IT_MEMOFLAG; + pValue->type &= ~( HB_IT_MEMOFLAG | HB_IT_DEFAULT ); hb_itemMoveFromRef( pDest, pValue ); hb_stackPop(); hb_stackPop(); @@ -4385,7 +4317,7 @@ static void hb_vmArrayPop( void ) if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asArray.value->ulLen ) ) { - pValue->type &= ~HB_IT_MEMOFLAG; + pValue->type &= ~( HB_IT_MEMOFLAG | HB_IT_DEFAULT ); hb_itemMoveRef( pArray->item.asArray.value->pItems + ulIndex - 1, pValue ); hb_stackPop(); hb_stackPop(); @@ -4401,43 +4333,6 @@ static void hb_vmArrayPop( void ) else hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 1, pIndex ); } -#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 ) ) - { - char cValue = HB_IS_STRING( pValue ) ? pValue->item.asString.value[ 0 ] : - hb_itemGetNI( pValue ); - if( pArray->item.asString.length == 1 ) - { - hb_itemPutCL( pArray, hb_szAscii[ ( unsigned char ) cValue ], 1 ); - } - else - { - hb_itemUnShareString( pArray ); - pArray->item.asString.value[ ulIndex - 1 ] = ( char ) cValue; - } - - hb_stackPop(); - hb_stackPop(); - hb_stackPop(); /* remove the value from the stack just like other POP operations */ - } - else if( hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pArray, pArray, pIndex, pValue ) ) - { - hb_stackPop(); - hb_stackPop(); - hb_stackPop(); - } - else - hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), - 3, pArray, pIndex, pValue ); - } else if( hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pArray, pArray, pIndex, pValue ) ) { hb_stackPop(); @@ -4466,7 +4361,7 @@ static void hb_vmArrayGen( ULONG ulElements ) /* generates an ulElements Array a for( ulPos = 0; ulPos < ulElements; ulPos++ ) { PHB_ITEM pValue = hb_stackItemFromTop( ( int ) ( ulPos - ulElements - 1 ) ); - pValue->type &= ~HB_IT_MEMOFLAG; + pValue->type &= ~( HB_IT_MEMOFLAG | HB_IT_DEFAULT ); hb_itemMove( pArray->item.asArray.value->pItems + ulPos, pValue ); } /* move the new array to position of first parameter */ @@ -4490,28 +4385,18 @@ static void hb_vmArrayNew( HB_ITEM_PTR pArray, USHORT uiDimension ) pDim = hb_stackItemFromTop( ( int ) ( -1 - uiDimension ) ); /* use the proper type of number of elements */ - switch( pDim->type ) - { - case HB_IT_INTEGER: - ulElements = ( ULONG ) pDim->item.asInteger.value; - break; - - case HB_IT_LONG: - ulElements = pDim->item.asLong.value; - break; - - case HB_IT_DOUBLE: - ulElements = ( ULONG ) pDim->item.asDouble.value; - break; - - default: - /* NOTE: Clipper creates empty array if non-numeric value is - * specified as dimension and stops further processing. - * There is no runtime error generated. - */ - ulElements = 0; - break; - } + if( HB_IS_INTEGER( pDim ) ) + ulElements = ( ULONG ) pDim->item.asInteger.value; + else if( HB_IS_LONG( pDim ) ) + ulElements = pDim->item.asLong.value; + else if( HB_IS_DOUBLE( pDim ) ) + ulElements = ( ULONG ) pDim->item.asDouble.value; + else + /* NOTE: Clipper creates empty array if non-numeric value is + * specified as dimension and stops further processing. + * There is no runtime error generated. + */ + ulElements = 0; /* create an array */ hb_arrayNew( pArray, ulElements ); @@ -4734,7 +4619,7 @@ static ERRCODE hb_vmSelectWorkarea( PHB_ITEM pAlias, PHB_SYMB pField ) fRepeat = FALSE; errCode = SUCCESS; - switch( pAlias->type ) + switch( HB_ITEM_TYPE( pAlias ) ) { case HB_IT_INTEGER: /* Alias was used as integer value, for example: 4->field @@ -5404,6 +5289,7 @@ static void hb_vmRetValue( void ) HB_TRACE(HB_TR_DEBUG, ("hb_vmRetValue()")); hb_stackPopReturn(); + hb_stackReturnItem()->type &= ~HB_IT_MEMOFLAG; } /* ------------------------------- */ @@ -6055,23 +5941,19 @@ static double hb_vmPopNumber( void ) pItem = hb_stackItemFromTop( -1 ); - switch( pItem->type ) + if( HB_IS_INTEGER( pItem ) ) + dNumber = ( double ) pItem->item.asInteger.value; + + else if( HB_IS_LONG( pItem ) ) + dNumber = ( double ) pItem->item.asLong.value; + + else if( HB_IS_DOUBLE( pItem ) ) + dNumber = pItem->item.asDouble.value; + + else { - case HB_IT_INTEGER: - dNumber = ( double ) pItem->item.asInteger.value; - break; - - case HB_IT_LONG: - dNumber = ( double ) pItem->item.asLong.value; - break; - - case HB_IT_DOUBLE: - dNumber = pItem->item.asDouble.value; - break; - - default: - hb_errInternal( HB_EI_VMPOPINVITEM, NULL, "hb_vmPopNumber()", NULL ); - dNumber = 0.0; /* To avoid GCC -O2 warning */ + hb_errInternal( HB_EI_VMPOPINVITEM, NULL, "hb_vmPopNumber()", NULL ); + dNumber = 0.0; /* To avoid GCC -O2 warning */ } hb_stackDec(); @@ -6161,7 +6043,7 @@ static void hb_vmPopLocal( int iLocal ) pVal = hb_stackItemFromTop( -1 ); /* Remove MEMOFLAG if exists (assignment from field). */ - pVal->type &= ~HB_IT_MEMOFLAG; + pVal->type &= ~( HB_IT_MEMOFLAG | HB_IT_DEFAULT ); if( iLocal >= 0 ) { @@ -6190,7 +6072,7 @@ static void hb_vmPopStatic( USHORT uiStatic ) pVal = hb_stackItemFromTop( -1 ); /* Remove MEMOFLAG if exists (assignment from field). */ - pVal->type &= ~HB_IT_MEMOFLAG; + pVal->type &= ~( HB_IT_MEMOFLAG | HB_IT_DEFAULT ); pStatic = s_aStatics.item.asArray.value->pItems + hb_stackGetStaticsBase() + uiStatic - 1; hb_itemMoveToRef( pStatic, pVal ); @@ -6876,7 +6758,6 @@ typedef struct PHB_DYNS assign; HB_ITEM object; HB_ITEM value; - BOOL init; } HB_MSGREF, * PHB_MSGREF; /* @@ -6886,21 +6767,33 @@ static PHB_ITEM hb_vmMsgRefRead( PHB_ITEM pRefer ) { PHB_MSGREF pMsgRef = ( PHB_MSGREF ) pRefer->item.asExtRef.value; - if( !pMsgRef->init ) + if( hb_vmRequestQuery() == 0 ) { - pMsgRef->init = TRUE; + if( !pMsgRef->access ) + pMsgRef->access = hb_dynsymGetCase( pMsgRef->assign->pSymbol->szName + 1 ); hb_vmPushDynSym( pMsgRef->access ); hb_vmPush( &pMsgRef->object ); hb_vmSend( 0 ); hb_itemMove( &pMsgRef->value, hb_stackReturnItem() ); + pMsgRef->value.type |= HB_IT_DEFAULT; } return &pMsgRef->value; } static PHB_ITEM hb_vmMsgRefWrite( PHB_ITEM pRefer, PHB_ITEM pSource ) { - HB_SYMBOL_UNUSED( pSource ); - return hb_vmMsgRefRead( pRefer ); + PHB_MSGREF pMsgRef = ( PHB_MSGREF ) pRefer->item.asExtRef.value; + + if( hb_vmRequestQuery() == 0 ) + { + hb_vmPushDynSym( pMsgRef->assign ); + hb_vmPush( &pMsgRef->object ); + hb_vmPush( pSource ); + hb_vmSend( 1 ); + hb_itemCopy( &pMsgRef->value, pSource ); + pMsgRef->value.type |= HB_IT_DEFAULT; + } + return &pMsgRef->value; } static void hb_vmMsgRefCopy( PHB_ITEM pDest ) @@ -6913,7 +6806,10 @@ static void hb_vmMsgRefClear( void * value ) if( hb_xRefDec( value ) ) { PHB_MSGREF pMsgRef = ( PHB_MSGREF ) value; - if( pMsgRef->init ) + /* value were change by C code without calling RefWrite(), + * f.e. hb_stor*() function + */ + if( ( pMsgRef->value.type & HB_IT_DEFAULT ) == 0 ) { if( hb_vmRequestReenter() ) { @@ -6943,7 +6839,7 @@ static void hb_vmMsgRefMark( void * value ) /* * create extended message reference */ -BOOL hb_vmMsgReference( PHB_ITEM pObject, PHB_SYMB pMessage ) +BOOL hb_vmMsgReference( PHB_ITEM pObject, PHB_DYNS pMessage, PHB_DYNS pAccMsg ) { static const HB_EXTREF s_MsgExtRef = { hb_vmMsgRefRead, @@ -6953,28 +6849,23 @@ BOOL hb_vmMsgReference( PHB_ITEM pObject, PHB_SYMB pMessage ) hb_vmMsgRefMark }; PHB_MSGREF pMsgRef; - PHB_DYNS pAccess; PHB_ITEM pRefer; - HB_TRACE(HB_TR_DEBUG, ("hb_vmMsgReference(%p,%p)", pObject, pMessage)); + HB_TRACE(HB_TR_DEBUG, ("hb_vmMsgReference(%p,%p,%p)", pObject, pMessage,pAccMsg)); - 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; + pMsgRef = ( PHB_MSGREF ) hb_xgrab( sizeof( HB_MSGREF ) ); + pMsgRef->access = pAccMsg; + pMsgRef->assign = pMessage; + pMsgRef->value.type = HB_IT_NIL | HB_IT_DEFAULT; + pMsgRef->object.type = HB_IT_NIL; + hb_itemMove( &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; } /* ------------------------------- */ @@ -6987,7 +6878,6 @@ typedef struct HB_ITEM object; HB_ITEM value; HB_ITEM index; - BOOL init; } HB_MSGIDXREF, * PHB_MSGIDXREF; /* @@ -6997,21 +6887,33 @@ static PHB_ITEM hb_vmMsgIdxRefRead( PHB_ITEM pRefer ) { PHB_MSGIDXREF pMsgIdxRef = ( PHB_MSGIDXREF ) pRefer->item.asExtRef.value; - if( !pMsgIdxRef->init ) + if( hb_vmRequestQuery() == 0 ) { - 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 ); + pMsgIdxRef->value.type |= HB_IT_DEFAULT; } return &pMsgIdxRef->value; } static PHB_ITEM hb_vmMsgIdxRefWrite( PHB_ITEM pRefer, PHB_ITEM pSource ) { - HB_SYMBOL_UNUSED( pSource ); - return hb_vmMsgIdxRefRead( pRefer ); + PHB_MSGIDXREF pMsgIdxRef = ( PHB_MSGIDXREF ) pRefer->item.asExtRef.value; + + if( hb_vmRequestQuery() == 0 ) + { + PHB_ITEM pObject = HB_IS_BYREF( &pMsgIdxRef->object ) ? + hb_itemUnRef( &pMsgIdxRef->object ) : + &pMsgIdxRef->object; + hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pObject, pObject, + &pMsgIdxRef->index, pSource ); + hb_vmRequestRestore(); + pMsgIdxRef->value.type |= HB_IT_DEFAULT; + } + + return &pMsgIdxRef->value; } static void hb_vmMsgIdxRefCopy( PHB_ITEM pDest ) @@ -7024,13 +6926,16 @@ static void hb_vmMsgIdxRefClear( void * value ) if( hb_xRefDec( value ) ) { PHB_MSGIDXREF pMsgIdxRef = ( PHB_MSGIDXREF ) value; - if( pMsgIdxRef->init ) + /* value were change by C code without calling RefWrite(), + * f.e. hb_stor*() function + */ + if( ( pMsgIdxRef->value.type & HB_IT_DEFAULT ) == 0 ) { - PHB_ITEM pObject = HB_IS_BYREF( &pMsgIdxRef->object ) ? - hb_itemUnRef( &pMsgIdxRef->object ) : - &pMsgIdxRef->object; if( hb_vmRequestReenter() ) { + PHB_ITEM pObject = HB_IS_BYREF( &pMsgIdxRef->object ) ? + hb_itemUnRef( &pMsgIdxRef->object ) : + &pMsgIdxRef->object; hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pObject, pObject, &pMsgIdxRef->index, &pMsgIdxRef->value ); hb_vmRequestRestore(); @@ -7073,8 +6978,7 @@ static void hb_vmMsgIndexReference( PHB_ITEM pRefer, PHB_ITEM pObject, PHB_ITEM 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->value.type = HB_IT_NIL | HB_IT_DEFAULT; pMsgIdxRef->object.type = HB_IT_NIL; pMsgIdxRef->index.type = HB_IT_NIL; hb_itemCopy( &pMsgIdxRef->object, HB_IS_STRING( pObject ) ? pRefer : pObject ); @@ -7086,127 +6990,6 @@ static void hb_vmMsgIndexReference( PHB_ITEM pRefer, PHB_ITEM pObject, PHB_ITEM 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 */ /* ------------------------------- */ @@ -7665,6 +7448,7 @@ HB_EXPORT void hb_xvmRetValue( void ) HB_TRACE(HB_TR_DEBUG, ("hb_xvmRetValue()")); hb_stackPopReturn(); + hb_stackReturnItem()->type &= ~HB_IT_MEMOFLAG; } HB_EXPORT void hb_xvmStatics( PHB_SYMB pSymbol, USHORT uiStatics ) @@ -8865,10 +8649,11 @@ HB_EXPORT BOOL hb_xvmMultByInt( LONG lValue ) if( HB_IS_NUMERIC( pValue ) ) { - int iDec, iType = pValue->type; + int iDec; double dValue = hb_itemGetNDDec( pValue, &iDec ); - hb_itemPutNumType( pValue, dValue * lValue, iDec, iType, HB_IT_INTEGER ); + hb_itemPutNumType( pValue, dValue * lValue, iDec, + HB_ITEM_TYPERAW( pValue ), HB_IT_INTEGER ); } else if( hb_objHasOperator( pValue, HB_OO_OP_MULT ) ) { @@ -9273,28 +9058,6 @@ static void hb_vmArrayItemPush( ULONG ulIndex ) else hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), 2, pArray, hb_stackItemFromTop( -1 ) ); } - else if( HB_IS_STRING( pArray ) && hb_vmFlagEnabled( HB_VMFLAG_ARRSTR ) ) - { - if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asString.length ) ) - { - UCHAR uc = ( UCHAR ) pArray->item.asString.value[ ulIndex - 1 ]; -#if defined( HB_COMPAT_XHB ) - hb_itemPutCL( pArray, hb_szAscii[ uc ], 1 ); -#else - hb_itemPutNI( pArray, uc ); -#endif - } - else - { - hb_vmPushNumInt( ulIndex ); - if( hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pArray, pArray, - hb_stackItemFromTop( -1 ), NULL ) ) - hb_stackPop(); - else - hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), - 2, pArray, hb_stackItemFromTop( -1 ) ); - } - } else { hb_vmPushNumInt( ulIndex ); @@ -9334,7 +9097,7 @@ static void hb_vmArrayItemPop( ULONG ulIndex ) if( HB_IS_VALID_INDEX( ulIndex, pArray->item.asArray.value->ulLen ) ) { - pValue->type &= ~HB_IT_MEMOFLAG; + pValue->type &= ~( HB_IT_MEMOFLAG | HB_IT_DEFAULT ); hb_itemMoveRef( pArray->item.asArray.value->pItems + ulIndex - 1, pValue ); hb_stackPop(); hb_stackDec(); /* value was moved above hb_stackDec() is enough */ @@ -9364,7 +9127,7 @@ static void hb_vmArrayItemPop( ULONG ulIndex ) if( pDest ) { - pValue->type &= ~HB_IT_MEMOFLAG; + pValue->type &= ~( HB_IT_MEMOFLAG | HB_IT_DEFAULT ); hb_itemMoveRef( pDest, pValue ); hb_stackPop(); hb_stackPop(); @@ -9380,46 +9143,6 @@ static void hb_vmArrayItemPop( ULONG ulIndex ) else hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRASSIGN ), 3, pArray, hb_stackItemFromTop( -1 ), pValue ); } -#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 ) ) - { - char cValue = HB_IS_STRING( pValue ) ? pValue->item.asString.value[ 0 ] : - hb_itemGetNI( pValue ); - if( pArray->item.asString.length == 1 ) - { - hb_itemPutCL( pArray, hb_szAscii[ ( unsigned char ) cValue ], 1 ); - } - else - { - hb_itemUnShareString( pArray ); - pArray->item.asString.value[ ulIndex - 1 ] = ( char ) cValue; - } - hb_stackPop(); - hb_stackPop(); /* remove the value from the stack just like other POP operations */ - } - else - { - hb_vmPushNumInt( ulIndex ); - if( hb_objOperatorCall( HB_OO_OP_ARRAYINDEX, pArray, pArray, - hb_stackItemFromTop( -1 ), pValue ) ) - { - hb_stackPop(); - hb_stackPop(); - hb_stackPop(); - } - else - hb_errRT_BASE( EG_BOUND, 1133, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ), - 3, pArray, hb_stackItemFromTop( -1 ), pValue ); - } - } else { hb_vmPushNumInt( ulIndex ); diff --git a/harbour/source/vm/itemapi.c b/harbour/source/vm/itemapi.c index e29b43e069..7c0a974458 100644 --- a/harbour/source/vm/itemapi.c +++ b/harbour/source/vm/itemapi.c @@ -443,20 +443,17 @@ HB_EXPORT BOOL hb_itemGetL( PHB_ITEM pItem ) if( pItem ) { - switch( pItem->type ) - { - case HB_IT_LOGICAL: - return pItem->item.asLogical.value; + if( HB_IS_LOGICAL( pItem ) ) + return pItem->item.asLogical.value; - case HB_IT_INTEGER: - return pItem->item.asInteger.value != 0; + else if( HB_IS_INTEGER( pItem ) ) + return pItem->item.asInteger.value != 0; - case HB_IT_LONG: - return pItem->item.asLong.value != 0; + else if( HB_IS_LONG( pItem ) ) + return pItem->item.asLong.value != 0; - case HB_IT_DOUBLE: - return pItem->item.asDouble.value != 0.0; - } + else if( HB_IS_DOUBLE( pItem ) ) + return pItem->item.asDouble.value != 0.0; } return FALSE; @@ -468,17 +465,14 @@ HB_EXPORT double hb_itemGetND( PHB_ITEM pItem ) if( pItem ) { - switch( pItem->type ) - { - case HB_IT_DOUBLE: - return pItem->item.asDouble.value; + if( HB_IS_DOUBLE( pItem ) ) + return pItem->item.asDouble.value; - case HB_IT_INTEGER: - return ( double ) pItem->item.asInteger.value; + else if( HB_IS_INTEGER( pItem ) ) + return ( double ) pItem->item.asInteger.value; - case HB_IT_LONG: - return ( double ) pItem->item.asLong.value; - } + else if( HB_IS_LONG( pItem ) ) + return ( double ) pItem->item.asLong.value; } return 0; @@ -490,17 +484,14 @@ HB_EXPORT int hb_itemGetNI( PHB_ITEM pItem ) if( pItem ) { - switch( pItem->type ) - { - case HB_IT_INTEGER: - return pItem->item.asInteger.value; + if( HB_IS_INTEGER( pItem ) ) + return pItem->item.asInteger.value; - case HB_IT_LONG: - return ( int ) pItem->item.asLong.value; + else if( HB_IS_LONG( pItem ) ) + return ( int ) pItem->item.asLong.value; - case HB_IT_DOUBLE: - return ( int ) pItem->item.asDouble.value; - } + else if( HB_IS_DOUBLE( pItem ) ) + return ( int ) pItem->item.asDouble.value; } return 0; @@ -512,23 +503,21 @@ HB_EXPORT LONG hb_itemGetNL( PHB_ITEM pItem ) if( pItem ) { - switch( pItem->type ) - { - case HB_IT_LONG: - return ( LONG ) pItem->item.asLong.value; + if( HB_IS_LONG( pItem ) ) + return ( LONG ) pItem->item.asLong.value; - case HB_IT_INTEGER: - return ( LONG ) pItem->item.asInteger.value; + else if( HB_IS_INTEGER( pItem ) ) + return ( LONG ) pItem->item.asInteger.value; - case HB_IT_DOUBLE: + else if( HB_IS_DOUBLE( pItem ) ) #ifdef __GNUC__ - return ( LONG ) ( ULONG ) pItem->item.asDouble.value; + return ( LONG ) ( ULONG ) pItem->item.asDouble.value; #else - return ( LONG ) pItem->item.asDouble.value; + return ( LONG ) pItem->item.asDouble.value; #endif - case HB_IT_DATE: - return ( LONG ) pItem->item.asDate.value; - } + + else if( HB_IS_DATE( pItem ) ) + return ( LONG ) pItem->item.asDate.value; } return 0; @@ -540,23 +529,21 @@ HB_EXPORT HB_LONG hb_itemGetNInt( PHB_ITEM pItem ) if( pItem ) { - switch( pItem->type ) - { - case HB_IT_LONG: - return ( HB_LONG ) pItem->item.asLong.value; + if( HB_IS_LONG( pItem ) ) + return ( HB_LONG ) pItem->item.asLong.value; - case HB_IT_INTEGER: - return ( LONG ) pItem->item.asInteger.value; + else if( HB_IS_INTEGER( pItem ) ) + return ( HB_LONG ) pItem->item.asInteger.value; - case HB_IT_DOUBLE: + else if( HB_IS_DOUBLE( pItem ) ) #ifdef __GNUC__ - return ( HB_LONG ) ( HB_ULONG ) pItem->item.asDouble.value; + return ( HB_LONG ) ( HB_ULONG ) pItem->item.asDouble.value; #else - return ( HB_LONG ) pItem->item.asDouble.value; + return ( HB_LONG ) pItem->item.asDouble.value; #endif - case HB_IT_DATE: - return ( HB_LONG ) pItem->item.asDate.value; - } + + else if( HB_IS_DATE( pItem ) ) + return ( LONG ) pItem->item.asDate.value; } return 0; @@ -569,24 +556,21 @@ HB_EXPORT LONGLONG hb_itemGetNLL( PHB_ITEM pItem ) if( pItem ) { - switch( pItem->type ) - { - case HB_IT_LONG: - return ( LONGLONG ) pItem->item.asLong.value; + if( HB_IS_LONG( pItem ) ) + return ( LONGLONG ) pItem->item.asLong.value; - case HB_IT_INTEGER: - return ( LONGLONG ) pItem->item.asInteger.value; + else if( HB_IS_INTEGER( pItem ) ) + return ( LONGLONG ) pItem->item.asInteger.value; - case HB_IT_DOUBLE: + else if( HB_IS_DOUBLE( pItem ) ) #ifdef __GNUC__ - return ( LONGLONG ) ( ULONGLONG ) pItem->item.asDouble.value; + return ( LONGLONG ) ( ULONGLONG ) pItem->item.asDouble.value; #else - return ( LONGLONG ) pItem->item.asDouble.value; + return ( LONGLONG ) pItem->item.asDouble.value; #endif - case HB_IT_DATE: - return ( LONGLONG ) pItem->item.asDate.value; - } + else if( HB_IS_DATE( pItem ) ) + return ( LONGLONG ) pItem->item.asDate.value; } return 0; @@ -947,39 +931,31 @@ HB_EXPORT PHB_ITEM hb_itemPutNDDec( PHB_ITEM pItem, double dNumber, int iDec ) HB_EXPORT double hb_itemGetNDDec( PHB_ITEM pItem, int * piDec ) { - double dNumber; - HB_TRACE(HB_TR_DEBUG, ("hb_itemGetNDDec(%p,p%)", pItem, piDec)); - switch( pItem->type ) + if( HB_IS_INTEGER( pItem ) ) { - case HB_IT_INTEGER: - dNumber = ( double ) pItem->item.asInteger.value; - *piDec = 0; - break; - - case HB_IT_LONG: - dNumber = ( double ) pItem->item.asLong.value; - *piDec = 0; - break; - - case HB_IT_DOUBLE: - dNumber = pItem->item.asDouble.value; - *piDec = pItem->item.asDouble.decimal; - break; - - case HB_IT_DATE: - dNumber = (double) pItem->item.asDate.value; - *piDec = 0; - break; - - default: - dNumber = 0; /* To avoid GCC -O2 warning */ - *piDec = 0; - break; + *piDec = 0; + return ( double ) pItem->item.asInteger.value; + } + else if( HB_IS_LONG( pItem ) ) + { + *piDec = 0; + return ( double ) pItem->item.asLong.value; + } + else if( HB_IS_DOUBLE( pItem ) ) + { + *piDec = pItem->item.asDouble.decimal; + return pItem->item.asDouble.value; + } + else if( HB_IS_DATE( pItem ) ) + { + *piDec = 0; + return ( double ) pItem->item.asDate.value; } - return dNumber; + *piDec = 0; + return 0.0; } @@ -1162,26 +1138,25 @@ HB_EXPORT void hb_itemGetNLen( PHB_ITEM pItem, int * piWidth, int * piDecimal ) if( pItem ) { - switch( pItem->type ) + if( HB_IS_DOUBLE( pItem ) ) { - case HB_IT_DOUBLE: - if( piWidth ) *piWidth = ( int ) pItem->item.asDouble.length; - if( piDecimal ) *piDecimal = ( int ) pItem->item.asDouble.decimal; - break; - - case HB_IT_LONG: - if( piWidth ) *piWidth = ( int ) pItem->item.asLong.length; - if( piDecimal ) *piDecimal = 0; - break; - - case HB_IT_INTEGER: - if( piWidth ) *piWidth = ( int ) pItem->item.asInteger.length; - if( piDecimal ) *piDecimal = 0; - break; - - default: - if( piWidth ) *piWidth = 0; - if( piDecimal ) *piDecimal = 0; + if( piWidth ) *piWidth = ( int ) pItem->item.asDouble.length; + if( piDecimal ) *piDecimal = ( int ) pItem->item.asDouble.decimal; + } + else if( HB_IS_INTEGER( pItem ) ) + { + if( piWidth ) *piWidth = ( int ) pItem->item.asInteger.length; + if( piDecimal ) *piDecimal = 0; + } + else if( HB_IS_LONG( pItem ) ) + { + if( piWidth ) *piWidth = ( int ) pItem->item.asLong.length; + if( piDecimal ) *piDecimal = 0; + } + else + { + if( piWidth ) *piWidth = 0; + if( piDecimal ) *piDecimal = 0; } } } @@ -1192,17 +1167,12 @@ HB_EXPORT ULONG hb_itemSize( PHB_ITEM pItem ) if( pItem ) { - switch( pItem->type ) - { - case HB_IT_STRING: - return pItem->item.asString.length; - - case HB_IT_ARRAY: - return hb_arrayLen( pItem ); - - case HB_IT_HASH: - return hb_hashLen( pItem ); - } + if( HB_IS_STRING( pItem ) ) + return pItem->item.asString.length; + else if( HB_IS_ARRAY( pItem ) ) + return hb_arrayLen( pItem ); + else if( HB_IS_HASH( pItem ) ) + return hb_hashLen( pItem ); } return 0; @@ -1213,7 +1183,7 @@ HB_EXPORT HB_TYPE hb_itemType( PHB_ITEM pItem ) HB_TRACE(HB_TR_DEBUG, ("hb_itemType(%p)", pItem)); if( pItem ) - return ( HB_TYPE ) pItem->type; + return ( HB_TYPE ) HB_ITEM_TYPE( pItem ); else return HB_IT_NIL; } @@ -1222,7 +1192,7 @@ HB_EXPORT char * hb_itemTypeStr( PHB_ITEM pItem ) { HB_TRACE(HB_TR_DEBUG, ("hb_itemTypeStr(%p)", pItem)); - switch( pItem->type ) + switch( HB_ITEM_TYPE( pItem ) ) { case HB_IT_ARRAY: return ( char * ) ( hb_arrayIsObject( pItem ) ? "O" : "A" ); @@ -1276,7 +1246,7 @@ HB_EXPORT void hb_itemClear( PHB_ITEM pItem ) HB_TRACE(HB_TR_DEBUG, ("hb_itemClear(%p)", pItem)); - type = pItem->type; + type = HB_ITEM_TYPERAW( pItem ); pItem->type = HB_IT_NIL; if( type & HB_IT_STRING ) @@ -1328,6 +1298,7 @@ HB_EXPORT void hb_itemCopy( PHB_ITEM pDest, PHB_ITEM pSource ) hb_itemClear( pDest ); memcpy( pDest, pSource, sizeof( HB_ITEM ) ); + pDest->type &= ~HB_IT_DEFAULT; if( HB_IS_COMPLEX( pSource ) ) { @@ -1437,6 +1408,7 @@ HB_EXPORT void hb_itemMove( PHB_ITEM pDest, PHB_ITEM pSource ) hb_itemClear( pDest ); memcpy( pDest, pSource, sizeof( HB_ITEM ) ); + pDest->type &= ~HB_IT_DEFAULT; pSource->type = HB_IT_NIL; } @@ -1465,6 +1437,7 @@ void hb_itemMoveRef( PHB_ITEM pDest, PHB_ITEM pSource ) hb_itemClear( pDest ); memcpy( pDest, pSource, sizeof( HB_ITEM ) ); + pDest->type &= ~HB_IT_DEFAULT; pSource->type = HB_IT_NIL; } @@ -1511,6 +1484,7 @@ void hb_itemMoveToRef( PHB_ITEM pDest, PHB_ITEM pSource ) hb_itemClear( pDest ); memcpy( pDest, pSource, sizeof( HB_ITEM ) ); + pDest->type &= ~HB_IT_DEFAULT; pSource->type = HB_IT_NIL; } @@ -1545,6 +1519,8 @@ HB_EXPORT void hb_itemSwap( PHB_ITEM pItem1, PHB_ITEM pItem2 ) memcpy( &temp, pItem2, sizeof( HB_ITEM ) ); memcpy( pItem2, pItem1, sizeof( HB_ITEM ) ); memcpy( pItem1, &temp, sizeof( HB_ITEM ) ); + pItem1->type &= ~HB_IT_DEFAULT; + pItem2->type &= ~HB_IT_DEFAULT; } /* Internal API, not standard Clipper */ @@ -1777,6 +1753,7 @@ PHB_ITEM hb_itemReSizeString( PHB_ITEM pItem, ULONG ulSize ) pItem->item.asString.allocated = ulAlloc; pItem->item.asString.value[ ulSize ] = '\0'; } + pItem->type &= ~HB_IT_DEFAULT; return pItem; } @@ -1800,6 +1777,7 @@ PHB_ITEM hb_itemUnShareString( PHB_ITEM pItem ) pItem->item.asString.value = szText; pItem->item.asString.allocated = ulLen; } + pItem->type &= ~HB_IT_DEFAULT; return pItem; } @@ -2209,28 +2187,22 @@ HB_EXPORT BOOL hb_itemStrBuf( char *szResult, PHB_ITEM pNumber, int iSize, int i { HB_LONG lNumber; - switch( pNumber->type ) + if( HB_IS_INTEGER( pNumber ) ) + lNumber = pNumber->item.asInteger.value; + + else if( HB_IS_LONG( pNumber ) ) + lNumber = pNumber->item.asLong.value; + + else if( HB_IS_DATE( pNumber ) ) + lNumber = pNumber->item.asDate.value; + + else if( HB_IS_STRING( pNumber ) ) + lNumber = pNumber->item.asString.value[0]; + + else { - case HB_IT_INTEGER: - lNumber = pNumber->item.asInteger.value; - break; - - case HB_IT_LONG: - lNumber = pNumber->item.asLong.value; - break; - - case HB_IT_DATE: - lNumber = pNumber->item.asDate.value; - break; - - case HB_IT_STRING: - lNumber = pNumber->item.asString.value[0]; - break; - - default: - lNumber = 0; - iPos = -1; - break; + lNumber = 0; + iPos = -1; } fNeg = ( lNumber < 0 ); @@ -2339,7 +2311,7 @@ HB_EXPORT char * hb_itemString( PHB_ITEM pItem, ULONG * ulLen, BOOL * bFreeReq ) HB_TRACE(HB_TR_DEBUG, ("hb_itemString(%p, %p, %p)", pItem, ulLen, bFreeReq)); - switch( pItem->type ) + switch( HB_ITEM_TYPE( pItem ) ) { case HB_IT_STRING: case HB_IT_MEMO: @@ -2445,7 +2417,7 @@ HB_EXPORT char * hb_itemPadConv( PHB_ITEM pItem, ULONG * pulSize, BOOL * bFreeRe if( pItem ) { - switch( pItem->type ) + switch( HB_ITEM_TYPE( pItem ) ) { case HB_IT_STRING: case HB_IT_MEMO: diff --git a/harbour/source/vm/macro.c b/harbour/source/vm/macro.c index 101d9704ff..e6bac4090c 100644 --- a/harbour/source/vm/macro.c +++ b/harbour/source/vm/macro.c @@ -957,8 +957,7 @@ HB_FUNC( HB_SETMACRO ) hb_retl( s_macroFlags & ulFlags ); pValue = hb_param( 2, HB_IT_LOGICAL ); if( pValue ) - hb_macroSetMacro( hb_itemGetL( pValue ) && - hb_vmFlagEnabled(HB_VMFLAG_ARRSTR), ulFlags ); + hb_macroSetMacro( hb_itemGetL( pValue ), ulFlags ); break; case HB_SM_SHORTCUTS: diff --git a/harbour/source/vm/memvars.c b/harbour/source/vm/memvars.c index 24c072fb90..b79918201e 100644 --- a/harbour/source/vm/memvars.c +++ b/harbour/source/vm/memvars.c @@ -190,9 +190,16 @@ static HB_HANDLE hb_memvarValueNew( HB_ITEM_PTR pSource, HB_HANDLE hPrevMemvar ) if( pSource ) { if( hPrevMemvar == ( HB_HANDLE ) -1 ) /* detached local - copy its body only */ + { memcpy( pValue->pVarItem, pSource, sizeof( HB_ITEM ) ); + pValue->pVarItem->type &= ~HB_IT_DEFAULT; + } else + { hb_itemCopy( pValue->pVarItem, pSource ); + /* Remove MEMOFLAG if exists (assignment from field). */ + pValue->pVarItem->type &= ~HB_IT_MEMOFLAG; + } } HB_TRACE(HB_TR_INFO, ("hb_memvarValueNew: memvar item created with handle %i", hValue)); @@ -284,7 +291,7 @@ static void hb_memvarDetachDynSym( PHB_DYNS pDynSym, BOOL fRestore ) */ HB_ITEM_PTR hb_memvarDetachLocal( HB_ITEM_PTR pLocal ) { - HB_TRACE(HB_TR_DEBUG, ("hb_memvarDetachLocal(%p, %d)", pLocal, pLocal->type )); + HB_TRACE(HB_TR_DEBUG, ("hb_memvarDetachLocal(%p)", pLocal)); if( HB_IS_BYREF( pLocal ) ) { @@ -421,6 +428,9 @@ void hb_memvarSetValue( PHB_SYMB pMemvarSymb, HB_ITEM_PTR pItem ) { /* value is already created */ hb_itemCopyToRef( s_globalTable[ pDyn->hMemvar ].pVarItem, pItem ); + + /* Remove MEMOFLAG if exists (assignment from field). */ + s_globalTable[ pDyn->hMemvar ].pVarItem->type &= ~HB_IT_MEMOFLAG; } else { @@ -428,8 +438,6 @@ void hb_memvarSetValue( PHB_SYMB pMemvarSymb, HB_ITEM_PTR pItem ) hb_memvarCreateFromDynSymbol( pDyn, VS_PRIVATE, pItem ); } - /* Remove MEMOFLAG if exists (assignment from field). */ - s_globalTable[ pDyn->hMemvar ].pVarItem->type &= ~HB_IT_MEMOFLAG; } else hb_errInternal( HB_EI_MVBADSYMBOL, NULL, pMemvarSymb->szName, NULL );