From b5d010fbeb4ddcf0af33f3fc11d44f8bb2a2fdcf Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Mon, 1 Oct 2007 17:43:52 +0000 Subject: [PATCH] 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 --- harbour/ChangeLog | 91 +++++ harbour/contrib/Makefile | 7 +- harbour/contrib/bmdbfcdx/bmdbfcdx1.c | 2 +- harbour/contrib/xhb/Makefile | 1 + harbour/contrib/xhb/xhb.ch | 16 +- harbour/contrib/xhb/xhbenum.c | 71 ++++ harbour/contrib/xhb/xhbfunc.c | 52 +-- harbour/contrib/xhb/xhbmsgs.c | 5 + harbour/harbour.spec | 15 +- harbour/include/hbapi.h | 57 ++- harbour/include/hbexpra.c | 5 +- harbour/include/hbexprb.c | 23 +- harbour/include/hbsetup.ch | 1 - harbour/include/hbvm.h | 2 +- harbour/include/hbvmpub.h | 21 +- harbour/make_rpm.sh | 5 - harbour/source/common/hbverdsp.c | 8 - harbour/source/compiler/hbcomp.c | 3 - harbour/source/compiler/hbusage.c | 4 +- harbour/source/compiler/ppcomp.c | 53 ++- harbour/source/pp/ppcore.c | 8 +- harbour/source/rdd/workarea.c | 2 + harbour/source/rtl/errorapi.c | 8 +- harbour/source/vm/arrayshb.c | 55 ++- harbour/source/vm/classes.c | 24 +- harbour/source/vm/cmdarg.c | 4 - harbour/source/vm/extend.c | 12 +- harbour/source/vm/hvm.c | 527 +++++++-------------------- harbour/source/vm/itemapi.c | 270 ++++++-------- harbour/source/vm/macro.c | 3 +- harbour/source/vm/memvars.c | 14 +- 31 files changed, 636 insertions(+), 733 deletions(-) create mode 100644 harbour/contrib/xhb/xhbenum.c 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 );