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

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

Browse Source 
* harbour/include/hbclass.ch
    + added new commands for scalar classes:
         ASSOCIATE CLASS <ClassName> WITH TYPE
                           ARRAY|BLOCK|CHARACTER|DATE|HASH|LOGICAL|NIL|
                           NUMERIC|POINTER|SYMBOL
         ENABLE CLASS TYPE ALL
         ENABLE TYPE CLASS ARRAY|BLOCK|CHARACTER|DATE|HASH|LOGICAL|NIL|
                           NUMERIC|POINTER|SYMBOL
      Please remeber that:
          ENABLE CLASS TYPE ALL
      and:
          ENABLE TYPE CLASS ...
      can be used in any place of code - this commands are translated to
          REQUEST HB<TYPENAME>
      so are not executed

  * harbour/source/vm/classes.c
    + added __clsAssocType( <hClass>, <cType> ) => <lOK>

  * harbour/common.mak
  * harbour/source/rtl/tscalar.prg
  * harbour/source/rtl/Makefile
  + harbour/source/rtl/tscalars.c
  + harbour/source/rtl/tscalard.c
  + harbour/source/rtl/tscalarh.c
  + harbour/source/rtl/tscalarl.c
  + harbour/source/rtl/tscalarp.c
  + harbour/source/rtl/tscalara.c
  + harbour/source/rtl/tscalaru.c
  + harbour/source/rtl/tscalarb.c
  + harbour/source/rtl/tscalarn.c
  + harbour/source/rtl/tscalarc.c
    + added scalar classes for basic types,
      Now it's possible to define messages also for basic item types.
      It's even possible to overload some not defined in HVM operators,
      f.e. in this example we overload operator "+" so it makes
        AADD( <aValue>, <xValue> )
      for code like <aValue> + <xValue>:
        #include "hbclass.ch"
        PROC MAIN()
            LOCAL a:={}
            ASSOCIATE CLASS MyArray WITH TYPE ARRAY
            a := a + "elem1"
            a += "elem2"
            a := a + "elem3"
            a += "elem4"
            ? a:asString, a:isScalar
            AEVAL(a,{|x,i|QOUT(i,x)})
        RETURN
        CREATE CLASS MyArray INHERIT __HBArray
           OPERATOR "+" ARG xValue INLINE AADD( Self, xValue ), Self
        ENDCLASS
      Operators which have default actions for given types defined in HVM
      cannot be overloaded.
This commit is contained in:
Przemyslaw Czerpak
2007-09-18 12:40:49 +00:00
parent 9d4258aa47
commit f2b0c25e87
16 changed files with 922 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

56
harbour/ChangeLog
View File

@@ -8,6 +8,62 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-09-18 14:40 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/hbclass.ch
+ added new commands for scalar classes:
ASSOCIATE CLASS <ClassName> WITH TYPE
ARRAY|BLOCK|CHARACTER|DATE|HASH|LOGICAL|NIL|
NUMERIC|POINTER|SYMBOL
ENABLE CLASS TYPE ALL
ENABLE TYPE CLASS ARRAY|BLOCK|CHARACTER|DATE|HASH|LOGICAL|NIL|
NUMERIC|POINTER|SYMBOL
Please remeber that:
ENABLE CLASS TYPE ALL
and:
ENABLE TYPE CLASS ...
can be used in any place of code - this commands are translated to
REQUEST HB<TYPENAME>
so are not executed
* harbour/source/vm/classes.c
+ added __clsAssocType( <hClass>, <cType> ) => <lOK>
* harbour/common.mak
* harbour/source/rtl/tscalar.prg
* harbour/source/rtl/Makefile
+ harbour/source/rtl/tscalars.c
+ harbour/source/rtl/tscalard.c
+ harbour/source/rtl/tscalarh.c
+ harbour/source/rtl/tscalarl.c
+ harbour/source/rtl/tscalarp.c
+ harbour/source/rtl/tscalara.c
+ harbour/source/rtl/tscalaru.c
+ harbour/source/rtl/tscalarb.c
+ harbour/source/rtl/tscalarn.c
+ harbour/source/rtl/tscalarc.c
+ added scalar classes for basic types,
Now it's possible to define messages also for basic item types.
It's even possible to overload some not defined in HVM operators,
f.e. in this example we overload operator "+" so it makes
AADD( <aValue>, <xValue> )
for code like <aValue> + <xValue>:
#include "hbclass.ch"
PROC MAIN()
LOCAL a:={}
ASSOCIATE CLASS MyArray WITH TYPE ARRAY
a := a + "elem1"
a += "elem2"
a := a + "elem3"
a += "elem4"
? a:asString, a:isScalar
AEVAL(a,{|x,i|QOUT(i,x)})
RETURN
CREATE CLASS MyArray INHERIT __HBArray
OPERATOR "+" ARG xValue INLINE AADD( Self, xValue ), Self
ENDCLASS
Operators which have default actions for given types defined in HVM
cannot be overloaded.
2007-09-18 00:45 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/hbapicls.h
* harbour/source/vm/hvm.c

10
harbour/common.mak
View File

@@ -514,6 +514,16 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\trace$(OBJEXT) \
$(OBJ_DIR)\transfrm$(OBJEXT) \
$(OBJ_DIR)\trim$(OBJEXT) \
$(OBJ_DIR)\tscalara$(OBJEXT) \
$(OBJ_DIR)\tscalarb$(OBJEXT) \
$(OBJ_DIR)\tscalarc$(OBJEXT) \
$(OBJ_DIR)\tscalard$(OBJEXT) \
$(OBJ_DIR)\tscalarh$(OBJEXT) \
$(OBJ_DIR)\tscalarl$(OBJEXT) \
$(OBJ_DIR)\tscalarn$(OBJEXT) \
$(OBJ_DIR)\tscalarp$(OBJEXT) \
$(OBJ_DIR)\tscalars$(OBJEXT) \
$(OBJ_DIR)\tscalaru$(OBJEXT) \
$(OBJ_DIR)\type$(OBJEXT) \
$(OBJ_DIR)\val$(OBJEXT) \
$(OBJ_DIR)\valtostr$(OBJEXT) \

16
harbour/include/hbclass.ch
View File

@@ -535,4 +535,20 @@ DECLARE HBClass ;
_HB_MEMBER {[ AS <type>] <DataName1> [, <DataNameN>] } ;;
s_oClass:AddMultiClsData( <(type)>, <uValue>, __HB_CLS_SCOPE( <.export.>, <.protect.>, <.hidde.> ) + iif( <.ro.>, HB_OO_CLSTP_READONLY, 0 ) + iif( <.share.>, HB_OO_CLSTP_SHARED, 0 ) + iif( <.persistent.>, HB_OO_CLSTP_PERSIST, 0 ), {<(DataName1)> [, <(DataNameN)>]}, __HB_CLS_NOINI )
/* Scalar classes support */
#command ASSOCIATE CLASS <ClassFuncName> WITH TYPE <type: ;
ARRAY, BLOCK, CHARACTER, DATE, HASH, LOGICAL, NIL, NUMERIC, SYMBOL, POINTER> => ;
__clsAssocType( __clsInstSuper( @<ClassFuncName>() ), #<type> )
#command ENABLE TYPE CLASS <type: ;
ARRAY, BLOCK, CHARACTER, DATE, HASH, LOGICAL, NIL, NUMERIC, SYMBOL, POINTER> ;
[, <typeN: ;
ARRAY, BLOCK, CHARACTER, DATE, HASH, LOGICAL, NIL, NUMERIC, SYMBOL, POINTER>] => ;
REQUEST HB<type> [, HB<typeN>]
#command ENABLE TYPE CLASS ALL => ;
REQUEST HBArray, HBBlock, HBCharacter, HBDate, HBHash, ;
HBLogical, HBNil, HBNumeric, HBSymbol, HBPointer
#endif /* HB_CLASS_CH_ */

10
harbour/source/rtl/Makefile
View File

@@ -124,6 +124,16 @@ C_SOURCES=\
trace.c \
transfrm.c \
trim.c \
tscalara.c \
tscalarb.c \
tscalarc.c \
tscalard.c \
tscalarh.c \
tscalarl.c \
tscalarn.c \
tscalarp.c \
tscalars.c \
tscalaru.c \
type.c \
val.c \
valtostr.c \

20
harbour/source/rtl/tscalar.prg
View File

@@ -109,7 +109,7 @@ METHOD BecomeErr() CLASS ScalarObject
/* -------------------------------------------- */
CREATE CLASS Array INHERIT HBScalar FUNCTION HBArray
CREATE CLASS Array INHERIT HBScalar FUNCTION __HBArray
METHOD Init()
@@ -241,7 +241,7 @@ METHOD _Size( newSize ) CLASS Array
/* -------------------------------------------- */
CREATE CLASS Block INHERIT HBScalar FUNCTION HBBlock
CREATE CLASS Block INHERIT HBScalar FUNCTION __HBBlock
METHOD AsString()
@@ -252,7 +252,7 @@ METHOD AsString() CLASS Block
/* -------------------------------------------- */
CREATE CLASS Character INHERIT HBScalar FUNCTION HBCharacter
CREATE CLASS Character INHERIT HBScalar FUNCTION __HBCharacter
METHOD AsString()
METHOD AsExpStr()
@@ -267,7 +267,7 @@ METHOD AsExpStr() CLASS Character
/* -------------------------------------------- */
CREATE CLASS Date INHERIT HBScalar FUNCTION HBDate
CREATE CLASS Date INHERIT HBScalar FUNCTION __HBDate
METHOD AsString()
METHOD AsExpStr()
@@ -282,7 +282,7 @@ METHOD AsExpStr() CLASS Date
/* -------------------------------------------- */
CREATE CLASS Hash INHERIT HBScalar FUNCTION HBHash
CREATE CLASS Hash INHERIT HBScalar FUNCTION __HBHash
METHOD AsString()
@@ -293,7 +293,7 @@ METHOD AsString() CLASS Hash
/* -------------------------------------------- */
CREATE CLASS Logical INHERIT HBScalar FUNCTION HBLogical
CREATE CLASS Logical INHERIT HBScalar FUNCTION __HBLogical
METHOD AsString()
@@ -304,7 +304,7 @@ METHOD AsString() CLASS Logical
/* -------------------------------------------- */
CREATE CLASS Nil INHERIT HBScalar FUNCTION HBNil
CREATE CLASS Nil INHERIT HBScalar FUNCTION __HBNil
METHOD AsString()
@@ -315,7 +315,7 @@ METHOD AsString() CLASS Nil
/* -------------------------------------------- */
CREATE CLASS Numeric INHERIT HBScalar FUNCTION HBNumeric
CREATE CLASS Numeric INHERIT HBScalar FUNCTION __HBNumeric
METHOD AsString()
@@ -326,7 +326,7 @@ METHOD AsString() CLASS Numeric
/* -------------------------------------------- */
CREATE CLASS Symbol INHERIT HBScalar FUNCTION HBSymbol
CREATE CLASS Symbol INHERIT HBScalar FUNCTION __HBSymbol
METHOD AsString()
@@ -337,7 +337,7 @@ METHOD AsString() CLASS Symbol
/* -------------------------------------------- */
CREATE CLASS Pointer INHERIT HBScalar FUNCTION HBPointer
CREATE CLASS Pointer INHERIT HBScalar FUNCTION __HBPointer
METHOD AsString()

73
harbour/source/rtl/tscalara.c Normal file
View File

@@ -0,0 +1,73 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Array scalar class function
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* 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 "hbapi.h"
#include "hbvm.h"
HB_FUNC_EXTERN( __HBARRAY );
HB_FUNC( HBARRAY )
{
HB_FUNC_EXEC( __HBARRAY );
if( hb_vmRequestQuery() == 0 )
{
PHB_ITEM pItem = hb_param( -1, HB_IT_ANY );
if( HB_IS_OBJECT( pItem ) )
{
hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) );
hb_vmPush( pItem );
hb_vmSend( 0 );
}
}
}

73
harbour/source/rtl/tscalarb.c Normal file
View File

@@ -0,0 +1,73 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Block scalar class function
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* 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 "hbapi.h"
#include "hbvm.h"
HB_FUNC_EXTERN( __HBBLOCK );
HB_FUNC( HBBLOCK )
{
HB_FUNC_EXEC( __HBBLOCK );
if( hb_vmRequestQuery() == 0 )
{
PHB_ITEM pItem = hb_param( -1, HB_IT_ANY );
if( HB_IS_OBJECT( pItem ) )
{
hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) );
hb_vmPush( pItem );
hb_vmSend( 0 );
}
}
}

73
harbour/source/rtl/tscalarc.c Normal file
View File

@@ -0,0 +1,73 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Character scalar class function
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* 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 "hbapi.h"
#include "hbvm.h"
HB_FUNC_EXTERN( __HBCHARACTER );
HB_FUNC( HBCHARACTER )
{
HB_FUNC_EXEC( __HBCHARACTER );
if( hb_vmRequestQuery() == 0 )
{
PHB_ITEM pItem = hb_param( -1, HB_IT_ANY );
if( HB_IS_OBJECT( pItem ) )
{
hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) );
hb_vmPush( pItem );
hb_vmSend( 0 );
}
}
}

73
harbour/source/rtl/tscalard.c Normal file
View File

@@ -0,0 +1,73 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Date scalar class function
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* 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 "hbapi.h"
#include "hbvm.h"
HB_FUNC_EXTERN( __HBDATE );
HB_FUNC( HBDATE )
{
HB_FUNC_EXEC( __HBDATE );
if( hb_vmRequestQuery() == 0 )
{
PHB_ITEM pItem = hb_param( -1, HB_IT_ANY );
if( HB_IS_OBJECT( pItem ) )
{
hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) );
hb_vmPush( pItem );
hb_vmSend( 0 );
}
}
}

73
harbour/source/rtl/tscalarh.c Normal file
View File

@@ -0,0 +1,73 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Hash scalar class function
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* 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 "hbapi.h"
#include "hbvm.h"
HB_FUNC_EXTERN( __HBHASH );
HB_FUNC( HBHASH )
{
HB_FUNC_EXEC( __HBHASH );
if( hb_vmRequestQuery() == 0 )
{
PHB_ITEM pItem = hb_param( -1, HB_IT_ANY );
if( HB_IS_OBJECT( pItem ) )
{
hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) );
hb_vmPush( pItem );
hb_vmSend( 0 );
}
}
}

73
harbour/source/rtl/tscalarl.c Normal file
View File

@@ -0,0 +1,73 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Logical scalar class function
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* 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 "hbapi.h"
#include "hbvm.h"
HB_FUNC_EXTERN( __HBLOGICAL );
HB_FUNC( HBLOGICAL )
{
HB_FUNC_EXEC( __HBLOGICAL );
if( hb_vmRequestQuery() == 0 )
{
PHB_ITEM pItem = hb_param( -1, HB_IT_ANY );
if( HB_IS_OBJECT( pItem ) )
{
hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) );
hb_vmPush( pItem );
hb_vmSend( 0 );
}
}
}

73
harbour/source/rtl/tscalarn.c Normal file
View File

@@ -0,0 +1,73 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Numeric scalar class function
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* 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 "hbapi.h"
#include "hbvm.h"
HB_FUNC_EXTERN( __HBNUMERIC );
HB_FUNC( HBNUMERIC )
{
HB_FUNC_EXEC( __HBNUMERIC );
if( hb_vmRequestQuery() == 0 )
{
PHB_ITEM pItem = hb_param( -1, HB_IT_ANY );
if( HB_IS_OBJECT( pItem ) )
{
hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) );
hb_vmPush( pItem );
hb_vmSend( 0 );
}
}
}

73
harbour/source/rtl/tscalarp.c Normal file
View File

@@ -0,0 +1,73 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Pointer scalar class function
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* 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 "hbapi.h"
#include "hbvm.h"
HB_FUNC_EXTERN( __HBPOINTER );
HB_FUNC( HBPOINTER )
{
HB_FUNC_EXEC( __HBPOINTER );
if( hb_vmRequestQuery() == 0 )
{
PHB_ITEM pItem = hb_param( -1, HB_IT_ANY );
if( HB_IS_OBJECT( pItem ) )
{
hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) );
hb_vmPush( pItem );
hb_vmSend( 0 );
}
}
}

73
harbour/source/rtl/tscalars.c Normal file
View File

@@ -0,0 +1,73 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Symbol scalar class function
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* 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 "hbapi.h"
#include "hbvm.h"
HB_FUNC_EXTERN( __HBSYMBOL );
HB_FUNC( HBSYMBOL )
{
HB_FUNC_EXEC( __HBSYMBOL );
if( hb_vmRequestQuery() == 0 )
{
PHB_ITEM pItem = hb_param( -1, HB_IT_ANY );
if( HB_IS_OBJECT( pItem ) )
{
hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) );
hb_vmPush( pItem );
hb_vmSend( 0 );
}
}
}

73
harbour/source/rtl/tscalaru.c Normal file
View File

@@ -0,0 +1,73 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* NIL scalar class function
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* 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 "hbapi.h"
#include "hbvm.h"
HB_FUNC_EXTERN( __HBNIL );
HB_FUNC( HBNIL )
{
HB_FUNC_EXEC( __HBNIL );
if( hb_vmRequestQuery() == 0 )
{
PHB_ITEM pItem = hb_param( -1, HB_IT_ANY );
if( HB_IS_OBJECT( pItem ) )
{
hb_vmPushDynSym( hb_dynsymGetCase( "NEW" ) );
hb_vmPush( pItem );
hb_vmSend( 0 );
}
}
}

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

@@ -1315,6 +1315,20 @@ HB_EXPORT USHORT hb_clsFindClass( const char * szClass, const char * szFunc )
return 0;
}
static USHORT hb_clsFindClassByFunc( PHB_SYMB pClassFuncSym )
{
USHORT uiClass;
for( uiClass = 1; uiClass <= s_uiClasses; uiClass++ )
{
if( s_pClasses[ uiClass ].pClassFuncSym == pClassFuncSym )
{
return uiClass;
}
}
return 0;
}
/*
* Get the real class name of an object message
* Will return the class name from wich the message is inherited in case
@@ -1557,7 +1571,7 @@ PHB_SYMB hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage,
pStack->uiClass = pObject->item.asArray.value->uiClass;
if( pObject->item.asArray.value->uiPrevCls )
{
if( pObject->item.asArray.value->ulLen )
if( pObject->item.asArray.value->ulLen )
{
/*
* Copy real object - do not move! the same super casted
@@ -2228,7 +2242,7 @@ static USHORT hb_clsUpdateScope( USHORT uiScope, BOOL fAssign )
return uiScope;
}
static HB_TYPE hb_clsGetItemType( PHB_ITEM pItem )
static HB_TYPE hb_clsGetItemType( PHB_ITEM pItem, HB_TYPE nDefault )
{
if( pItem )
{
@@ -2269,7 +2283,10 @@ static HB_TYPE hb_clsGetItemType( PHB_ITEM pItem )
case 'N':
case 'n':
return HB_IT_NUMERIC;
if( hb_stricmp( hb_itemGetCPtr( pItem ), "nil" ) == 0 )
return HB_IT_NIL;
else
return HB_IT_NUMERIC;
case 'A':
case 'a':
@@ -2285,8 +2302,10 @@ static HB_TYPE hb_clsGetItemType( PHB_ITEM pItem )
}
}
else if( HB_IS_ARRAY( pItem ) )
return HB_IT_ARRAY;
{
if( pItem->item.asArray.value->uiClass == 0 )
return HB_IT_ARRAY;
}
else if( HB_IS_NUMINT( pItem ) )
return HB_IT_NUMINT;
@@ -2307,9 +2326,12 @@ static HB_TYPE hb_clsGetItemType( PHB_ITEM pItem )
else if( HB_IS_SYMBOL( pItem ) )
return HB_IT_SYMBOL;
else if( HB_IS_NIL( pItem ) )
return HB_IT_NIL;
}
return 0;
return nDefault;
}
/* ================================================ */
@@ -2570,7 +2592,7 @@ static BOOL hb_clsAddMsg( USHORT uiClass, const char * szMessage,
pNewMeth->pFuncSym = &s___msgSetData;
pNewMeth->uiData = uiIndex;
pNewMeth->uiOffset = pClass->uiDataFirst;
pNewMeth->itemType = hb_clsGetItemType( pInit );
pNewMeth->itemType = hb_clsGetItemType( pInit, 0 );
}
break;
@@ -2587,7 +2609,7 @@ static BOOL hb_clsAddMsg( USHORT uiClass, const char * szMessage,
case HB_OO_MSG_CLSASSIGN:
pNewMeth->uiData = uiIndex;
pNewMeth->itemType = hb_clsGetItemType( pInit );
pNewMeth->itemType = hb_clsGetItemType( pInit, 0 );
pNewMeth->uiScope = hb_clsUpdateScope( uiScope, TRUE );
/* Class(y) does not allow to write to HIDDEN+READONLY
instance variables, [druzus] */
@@ -3379,14 +3401,7 @@ HB_FUNC( __CLSINSTSUPER )
if( pClassFuncSym )
{
for( uiClass = 1; uiClass <= s_uiClasses; uiClass++ )
{
if( s_pClasses[ uiClass ].pClassFuncSym == pClassFuncSym )
{
uiClassH = uiClass;
break;
}
}
uiClassH = hb_clsFindClassByFunc( pClassFuncSym );
if( uiClassH == 0 )
{
hb_vmPushSymbol( pClassFuncSym );
@@ -3405,14 +3420,7 @@ HB_FUNC( __CLSINSTSUPER )
uiClassH = uiClass;
else
{
for( uiClass = 1; uiClass <= s_uiClasses; uiClass++ )
{
if( s_pClasses[ uiClass ].pClassFuncSym == pClassFuncSym )
{
uiClassH = uiClass;
break;
}
}
uiClassH = hb_clsFindClassByFunc( pClassFuncSym );
/* still not found, try to send NEW() message */
if( uiClassH == 0 )
{
@@ -3435,9 +3443,7 @@ HB_FUNC( __CLSINSTSUPER )
if( uiClassH && HB_IS_OBJECT( pObject ) )
pObject->item.asArray.value->uiClass = 0;
else if( hb_vmRequestQuery() == 0 )
{
hb_errRT_BASE( EG_ARG, 3002, "Super class does not return an object", "__CLSINSTSUPER", 0 );
}
}
}
}
@@ -3449,6 +3455,64 @@ HB_FUNC( __CLSINSTSUPER )
hb_retni( uiClassH );
}
/*
* <lOK> = __clsAssocType( <hClass>, <cType> )
*
* Associate class with given basic type
*/
HB_FUNC( __CLSASSOCTYPE )
{
USHORT uiClass = ( USHORT ) hb_parni( 1 );
PHB_ITEM pType = hb_param( 2, HB_IT_ANY );
BOOL fResult = FALSE;
if( uiClass && uiClass <= s_uiClasses && pType )
{
HB_TYPE nType = hb_clsGetItemType( pType, HB_IT_ANY );
if( nType != HB_IT_ANY )
{
switch( nType )
{
case HB_IT_ARRAY:
s_uiArrayClass = uiClass;
break;
case HB_IT_BLOCK:
s_uiBlockClass = uiClass;
break;
case HB_IT_STRING:
s_uiCharacterClass = uiClass;
break;
case HB_IT_DATE:
s_uiDateClass = uiClass;
break;
case HB_IT_HASH:
s_uiHashClass = uiClass;
break;
case HB_IT_LOGICAL:
s_uiLogicalClass = uiClass;
break;
case HB_IT_NIL:
s_uiNilClass = uiClass;
break;
case HB_IT_NUMERIC:
s_uiNumericClass = uiClass;
break;
case HB_IT_SYMBOL:
s_uiSymbolClass = uiClass;
break;
case HB_IT_POINTER:
s_uiPointerClass = uiClass;
break;
default:
uiClass = 0;
}
fResult = uiClass != 0;
}
}
hb_retl( fResult );
}
/*
* <nSeq> = __ClsCntClasses()
*