From 2be165e46149cd3cd538aae3497e4e22f7096dfd Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Wed, 19 Dec 2007 17:48:57 +0000 Subject: [PATCH] 2007-12-19 18:48 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/contrib/xhb/Makefile * harbour/contrib/xhb/common.mak + harbour/contrib/xhb/xhbqself.c + added xHarbour compatible HB_QSELF() function * harbour/contrib/xhb/xhbfunc.c * removed HB_QSELF() redirecting to Class(y) compatible __SENDER() function * harbour/contrib/xhb/xhbcomp.prg ! fixed scalar classes overloading, do not enable extended messages for basic types if user haven't requested it (ENABLE TYPE CLASS ...), use scalar classes defined in RTL --- harbour/ChangeLog | 15 ++ harbour/contrib/xhb/Makefile | 1 + harbour/contrib/xhb/common.mak | 1 + harbour/contrib/xhb/xhbcomp.prg | 255 ++++++++------------------------ harbour/contrib/xhb/xhbfunc.c | 8 - harbour/contrib/xhb/xhbqself.c | 75 ++++++++++ 6 files changed, 155 insertions(+), 200 deletions(-) create mode 100644 harbour/contrib/xhb/xhbqself.c diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 12c77f354c..eb513eb076 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,21 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-12-19 18:48 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/contrib/xhb/Makefile + * harbour/contrib/xhb/common.mak + + harbour/contrib/xhb/xhbqself.c + + added xHarbour compatible HB_QSELF() function + + * harbour/contrib/xhb/xhbfunc.c + * removed HB_QSELF() redirecting to Class(y) compatible __SENDER() + function + + * harbour/contrib/xhb/xhbcomp.prg + ! fixed scalar classes overloading, do not enable extended messages + for basic types if user haven't requested it (ENABLE TYPE CLASS ...), + use scalar classes defined in RTL + 2007-12-19 13:05 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbmath.h * harbour/source/rtl/math.c diff --git a/harbour/contrib/xhb/Makefile b/harbour/contrib/xhb/Makefile index 13c5407d50..689ada47f9 100644 --- a/harbour/contrib/xhb/Makefile +++ b/harbour/contrib/xhb/Makefile @@ -12,6 +12,7 @@ C_SOURCES=\ xhbenum.c \ xhbfunc.c \ xhbmsgs.c \ + xhbqself.c \ xhbwith.c \ hbcomprs.c \ hbchksum.c \ diff --git a/harbour/contrib/xhb/common.mak b/harbour/contrib/xhb/common.mak index c80c4d60d4..09b4eb0375 100644 --- a/harbour/contrib/xhb/common.mak +++ b/harbour/contrib/xhb/common.mak @@ -28,6 +28,7 @@ LIB_OBJS = \ $(OBJ_DIR)\xhbenum$(OBJEXT) \ $(OBJ_DIR)\xhbfunc$(OBJEXT) \ $(OBJ_DIR)\xhbmsgs$(OBJEXT) \ + $(OBJ_DIR)\xhbqself$(OBJEXT) \ $(OBJ_DIR)\xhbwith$(OBJEXT) \ $(OBJ_DIR)\hbcomprs$(OBJEXT) \ $(OBJ_DIR)\hbchksum$(OBJEXT) \ diff --git a/harbour/contrib/xhb/xhbcomp.prg b/harbour/contrib/xhb/xhbcomp.prg index 2ba4eee2dd..dd5703fc4b 100644 --- a/harbour/contrib/xhb/xhbcomp.prg +++ b/harbour/contrib/xhb/xhbcomp.prg @@ -52,19 +52,39 @@ #include "common.ch" #include "hbclass.ch" -#include "xhb.ch" ANNOUNCE XHB_LIB INIT PROCEDURE xhb_Init() /* Add calls to do initial settings to Harbour to be more compatible with xhb. */ - ASSOCIATE CLASS xhb_Character WITH TYPE Character - ASSOCIATE CLASS xhb_Numeric WITH TYPE Numeric - ASSOCIATE CLASS xhb_Array WITH TYPE Array - ASSOCIATE CLASS xhb_Hash WITH TYPE Hash + + if type("HBCHARACTER()")=="UI" + ASSOCIATE CLASS _Character WITH TYPE Character + else + ASSOCIATE CLASS xhb_Character WITH TYPE Character + endif + + if type("HBNUMERIC()")=="UI" + ASSOCIATE CLASS _Numeric WITH TYPE Numeric + else + ASSOCIATE CLASS xhb_Numeric WITH TYPE Numeric + endif + + if type("HBARRAY()")=="UI" + ASSOCIATE CLASS _Array WITH TYPE Array + else + ASSOCIATE CLASS xhb_Array WITH TYPE Array + endif + + if type("HBHASH()")=="UI" + ASSOCIATE CLASS _Hash WITH TYPE Hash + else + ASSOCIATE CLASS xhb_Hash WITH TYPE Hash + endif + RETURN -CREATE CLASS Character INHERIT HBScalar FUNCTION xhb_Character +CREATE CLASS Character FUNCTION xhb_Character OPERATOR "[]" FUNCTION XHB_INDEX() OPERATOR "+" FUNCTION XHB_PLUS() OPERATOR "-" FUNCTION XHB_MINUS() @@ -74,11 +94,10 @@ CREATE CLASS Character INHERIT HBScalar FUNCTION xhb_Character OPERATOR "^" FUNCTION XHB_POW() OPERATOR "++" FUNCTION XHB_INC() OPERATOR "--" FUNCTION XHB_DEC() - - METHOD AsString INLINE HB_QSelf() ENDCLASS -CREATE CLASS Numeric INHERIT HBScalar FUNCTION xhb_Numeric +CREATE CLASS Character INHERIT __HBCharacter FUNCTION _Character + OPERATOR "[]" FUNCTION XHB_INDEX() OPERATOR "+" FUNCTION XHB_PLUS() OPERATOR "-" FUNCTION XHB_MINUS() OPERATOR "*" FUNCTION XHB_MULT() @@ -87,198 +106,50 @@ CREATE CLASS Numeric INHERIT HBScalar FUNCTION xhb_Numeric OPERATOR "^" FUNCTION XHB_POW() OPERATOR "++" FUNCTION XHB_INC() OPERATOR "--" FUNCTION XHB_DEC() - - METHOD AsString INLINE LTrim( Str( ( HB_QSelf() ) ) ) ENDCLASS -CREATE CLASS Array INHERIT HBScalar FUNCTION xhb_Array +CREATE CLASS Numeric FUNCTION xhb_Numeric + OPERATOR "+" FUNCTION XHB_PLUS() + OPERATOR "-" FUNCTION XHB_MINUS() + OPERATOR "*" FUNCTION XHB_MULT() + OPERATOR "/" FUNCTION XHB_DIV() + OPERATOR "%" FUNCTION XHB_MOD() + OPERATOR "^" FUNCTION XHB_POW() + OPERATOR "++" FUNCTION XHB_INC() + OPERATOR "--" FUNCTION XHB_DEC() +ENDCLASS + +CREATE CLASS Numeric INHERIT __HBNumeric FUNCTION _Numeric + OPERATOR "+" FUNCTION XHB_PLUS() + OPERATOR "-" FUNCTION XHB_MINUS() + OPERATOR "*" FUNCTION XHB_MULT() + OPERATOR "/" FUNCTION XHB_DIV() + OPERATOR "%" FUNCTION XHB_MOD() + OPERATOR "^" FUNCTION XHB_POW() + OPERATOR "++" FUNCTION XHB_INC() + OPERATOR "--" FUNCTION XHB_DEC() +ENDCLASS + +CREATE CLASS Array FUNCTION xhb_Array OPERATOR "[]" FUNCTION XHB_INDEX() OPERATOR "$$" FUNCTION XHB_INCLUDE() - - MESSAGE Add METHOD Append - METHOD AddAll - METHOD Append - METHOD asString INLINE '{...}' //ValtoPrg( HB_QSelf() ) - METHOD At( n ) INLINE Self[ n ] - METHOD AtIndex( n ) INLINE Self[ n ] - METHOD AtPut( n, x ) INLINE Self[ n ] := x - METHOD Collect - METHOD Copy INLINE aCopy( Self, Array( Len( Self ) ) ) - METHOD DeleteAt - METHOD Do - METHOD IndexOf - METHOD Init( nLen ) INLINE ::Size := IIF( nLen == NIL, 0, nLen ), Self - METHOD InsertAt - METHOD Remove - METHOD Scan( bScan ) INLINE aScan( Self, bScan ) - METHOD _Size( nLen ) INLINE aSize( Self, nLen ), nLen - ENDCLASS -CREATE CLASS Hash INHERIT HBScalar FUNCTION xhb_Hash +CREATE CLASS Array INHERIT __HBArray FUNCTION _Array + OPERATOR "[]" FUNCTION XHB_INDEX() + OPERATOR "$$" FUNCTION XHB_INCLUDE() +ENDCLASS + +CREATE CLASS Hash FUNCTION xhb_Hash ON ERROR FUNCTION XHB_HASHERROR() OPERATOR "+" FUNCTION XHB_PLUS() OPERATOR "-" FUNCTION XHB_MINUS() OPERATOR "$$" FUNCTION XHB_INCLUDE() - - METHOD Add( xKey, xValue ) INLINE Self[ xKey ] := xValue, Self - METHOD AddAll( oCollection ) - METHOD AtIndex( nPos ) INLINE HGetValueAt( Self, nPos ) - METHOD AtPut( nPos, xValue ) INLINE HSetValueAt( Self, nPos, xValue ) - METHOD Append( xKey, xValue ) INLINE Self[ xKey ] := xValue, Self - METHOD AsString() INLINE '...HASH...' // ValToPrg( HB_QSelf() ) - METHOD Collect( bCollect ) - METHOD Copy() INLINE hCopy( Self, Hash() ) - METHOD DeleteAt( nPos ) INLINE hDelat( Self, nPos ) - METHOD Do( bBlock ) - METHOD IndexOf( xValue ) INLINE hScan( Self, xValue ) - METHOD Init( nLen ) INLINE ::Size := IIF( nLen == NIL, 0, nLen ), Self - METHOD Remove( xValue ) INLINE hDel( Self, xValue ) - METHOD Scan( bScan ) INLINE hScan( Self, bScan ) - METHOD _Size( nLen ) - ENDCLASS -//----------------------------------------------------------------------------// - -METHOD AddAll( otherCollection ) CLASS Array - otherCollection:Do( {|x| ::Add(x) } ) - RETURN Self - -//----------------------------------------------------------------------------// - -METHOD Append( x ) CLASS Array - aAdd( Self, x ) - RETURN Self - -//----------------------------------------------------------------------------// - -METHOD Collect( bCollect ) CLASS Array - LOCAL xElement, aResult[0] - - FOR EACH xElement IN Self - IF Eval( bCollect, UnRef( xElement ) ) - aAdd( aResult, UnRef( xElement ) ) - END - NEXT - -RETURN aResult - -//----------------------------------------------------------------------------// - -METHOD deleteAt( nPos ) CLASS Array - - IF nPos > 0 .AND. nPos <= Len( Self ) - aDel( Self, nPos, .T. ) - ENDIF - -RETURN Self - -//----------------------------------------------------------------------------// - -METHOD Do( bEval ) CLASS Array - LOCAL xElement - - FOR EACH xElement IN Self - bEval:Eval( UnRef( xElement ), HB_EnumIndex() ) - NEXT - -RETURN Self - -//----------------------------------------------------------------------------// - -METHOD IndexOf( xValue ) CLASS Array - LOCAL xElement, cType := ValType( xValue ) - - FOR EACH xElement IN Self - IF ValType( xElement ) == cType .AND. xElement == xValue - RETURN HB_EnumIndex() - END - NEXT - -RETURN 0 - -//----------------------------------------------------------------------------// - -METHOD InsertAt( nPos, xValue ) CLASS Array - - IF nPos > Len( self ) - aSize( Self, nPos ) - Self[ nPos ] := xValue - ELSEIF nPos > 0 - aIns( Self, nPos, xValue, .T. ) - ENDIF - -RETURN Self - -//----------------------------------------------------------------------------// - -METHOD Remove( xValue ) CLASS Array - - ::DeleteAt( ::IndexOf( xValue ) ) - -RETURN Self - -//----------------------------------------------------------------------------// - -METHOD AddAll( oCollection ) CLASS HASH - - oCollection:Do( { |xKey, xValue| Self[ xKey ] := xValue } ) - -RETURN Self - -//----------------------------------------------------------------------------// - -METHOD Collect( bCollect ) CLASS HASH - LOCAL xElement, aResult[0] - - FOR EACH xElement IN Self:Values - IF Eval( bCollect, UnRef( xElement ) ) - aAdd( aResult, UnRef( xElement ) ) - END - NEXT - -RETURN aResult - -//----------------------------------------------------------------------------// - -METHOD Do( bDo ) CLASS HASH - - LOCAL xKey - - FOR EACH xKey IN Self:Keys - Eval( bDo, xKey, Self[ xKey ] ) - NEXT - -RETURN Self - -//----------------------------------------------------------------------------// - -METHOD _Size( nLen ) CLASS HASH - - LOCAL nOldLen := Len( Self ), Counter - - IF nLen == nOldLen - RETURN nLen - ELSEIF nLen > nOldLen - hAllocate( Self, nLen ) - - FOR Counter := nOldLen + 1 TO nLen - Self[ "_SIZED_" + LTrim( Str( Counter ) ) ] := NIL - NEXT - ELSE - FOR Counter := nOldLen TO nLen + 1 - hDelAt( Self, nLen + 1 ) - NEXT - ENDIF - -RETURN nLen - -//----------------------------------------------------------------------------// - -FUNCTION UnRef( xValue ) - -RETURN xValue - -//----------------------------------------------------------------------------// - +CREATE CLASS Hash INHERIT __HBHash FUNCTION _Hash + ON ERROR FUNCTION XHB_HASHERROR() + OPERATOR "+" FUNCTION XHB_PLUS() + OPERATOR "-" FUNCTION XHB_MINUS() + OPERATOR "$$" FUNCTION XHB_INCLUDE() +ENDCLASS diff --git a/harbour/contrib/xhb/xhbfunc.c b/harbour/contrib/xhb/xhbfunc.c index 90df0a1969..11e688bffa 100644 --- a/harbour/contrib/xhb/xhbfunc.c +++ b/harbour/contrib/xhb/xhbfunc.c @@ -251,11 +251,3 @@ HB_FUNC( ISINETSOCKET ) { HB_FUNC_EXEC( HB_INETISSOCKET ); } HB_FUNC( INETDESTROY ) { } #endif /* !HB_NO_DEFAULT_INET */ - - -HB_FUNC_EXTERN( __SENDER ); - -HB_FUNC( HB_QSELF ) -{ - HB_FUNC_EXEC( __SENDER ) -} diff --git a/harbour/contrib/xhb/xhbqself.c b/harbour/contrib/xhb/xhbqself.c new file mode 100644 index 0000000000..d47d4dcb1f --- /dev/null +++ b/harbour/contrib/xhb/xhbqself.c @@ -0,0 +1,75 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * xHarbour compatible HB_QSELF() 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 "hbapierr.h" +#include "hbstack.h" + +HB_FUNC( HB_QSELF ) +{ + LONG lOffset = hb_stackBaseProcOffset( 1 ); + + if( lOffset > 0 ) + { + PHB_ITEM pSelf = hb_stackItem( lOffset + 1 ); + + if( lOffset > 0 && HB_IS_BLOCK( pSelf ) && + hb_itemGetSymbol( hb_stackItem( lOffset ) ) == &hb_symEval ) + { + pSelf = hb_stackItem( hb_stackItem( lOffset )-> + item.asSymbol.stackstate->lBaseItem + 1 ); + } + hb_itemReturn( pSelf ); + } +}