diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 50ceb98b17..a76aa27618 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,30 @@ The license applies to all entries newer than 2009-04-28. */ +2012-06-11 17:17 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) + * harbour/contrib/hbct/misc1.c + % optimized XTOC() + + * harbour/doc/xhb-diff.txt + * added some additional description to the section + OOP AND CLASS OBJECT/CLASS MESSAGES + + * harbour/doc/Makefile + * added xhb-diff.txt + + * harbour/include/hbapi.h + * harbour/src/vm/arrays.c + + added new C function hb_arrayFromId() + + * harbour/contrib/hbqt/qtcore/hbqt_bind.cpp + * use hb_arrayFromId() instead of local hb_arrayCreateClone() + with hb_arrayPushBase() inside + * do not use hbvmint.h + ! fixed few bugs in this code. I haven't analyzed this code deeply + and how it's used so I cannot say it's correct. I only fixed few + completly wrong places which caused HVM stack corruption, internal + GC item list corruption or were completly dummy calls. + 2012-06-11 16:33 UTC+0200 Viktor Szakats (harbour syenar.net) * utils/hbmk2/hbmk2.prg * utils/hbmk2/hbmk2.es_PE.po diff --git a/harbour/contrib/hbct/misc1.c b/harbour/contrib/hbct/misc1.c index 4b5bdc7d78..356f195438 100644 --- a/harbour/contrib/hbct/misc1.c +++ b/harbour/contrib/hbct/misc1.c @@ -54,25 +54,31 @@ HB_FUNC( XTOC ) { - if( HB_ISCHAR( 1 ) ) - hb_retc( hb_parc( 1 ) ); - else if( HB_ISDATE( 1 ) ) - hb_retc( hb_pards( 1 ) ); - else if( HB_ISTIMESTAMP( 1 ) ) - { - char szDateTime[ 18 ]; - hb_retc( hb_itemGetTS( hb_param( 1, HB_IT_TIMESTAMP ), szDateTime ) ); - } - else if( HB_ISNUM( 1 ) ) - { - char buf[ sizeof( double ) ]; - double d = hb_parnd( 1 ); + PHB_ITEM pItem = hb_param( 1, HB_IT_ANY ); - HB_PUT_LE_DOUBLE( buf, d ); - hb_retclen( buf, sizeof( buf ) ); + if( pItem ) + { + if( HB_IS_DATE( pItem ) ) + { + char szDate[ 9 ]; + hb_retc( hb_itemGetDS( pItem, szDate ) ); + } + else if( HB_IS_TIMESTAMP( pItem ) ) + { + char szDateTime[ 18 ]; + hb_retc( hb_itemGetTS( pItem, szDateTime ) ); + } + else if( HB_IS_NUMERIC( pItem ) ) + { + char buf[ sizeof( double ) ]; + double d = hb_parnd( 1 ); + + HB_PUT_LE_DOUBLE( buf, d ); + hb_retclen( buf, sizeof( buf ) ); + } + else if( HB_IS_LOGICAL( pItem ) ) + hb_retclen( hb_itemGetL( pItem ) ? "T" : "F", 1 ); + else + hb_itemReturn( pItem ); } - else if( HB_ISLOG( 1 ) ) - hb_retclen( hb_parl( 1 ) ? "T" : "F", 1 ); - else - hb_itemReturn( hb_param( 1, HB_IT_ANY ) ); } diff --git a/harbour/contrib/hbqt/qtcore/hbqt_bind.cpp b/harbour/contrib/hbqt/qtcore/hbqt_bind.cpp index eb813dfba3..d7eb24b016 100644 --- a/harbour/contrib/hbqt/qtcore/hbqt_bind.cpp +++ b/harbour/contrib/hbqt/qtcore/hbqt_bind.cpp @@ -52,7 +52,6 @@ */ /*----------------------------------------------------------------------*/ -#include "hbvmint.h" #include "hbapi.h" #include "hbapiitm.h" #include "hbstack.h" @@ -108,17 +107,6 @@ static void hbqt_bind_init( void* cargo ) s_dynsym_SETSLOTS = hb_dynsymGetCase( "SETSLOTS" ); } -static PHB_ITEM hb_arrayCreateClone( PHB_ITEM pItem, PHB_BASEARRAY pBaseArray ) -{ - hb_arrayPushBase( pBaseArray ); - if( pItem == NULL ) - pItem = hb_itemNew( NULL ); - hb_itemMove( pItem, hb_stackItemFromTop( -1 ) ); - hb_stackPop(); - - return pItem; -} - PHB_ITEM hbqt_bindGetHbObject( PHB_ITEM pItem, void * qtObject, const char * szClassName, PHBQT_DEL_FUNC pDelFunc, int iFlags ) { #if 0 @@ -147,7 +135,7 @@ PHB_ITEM hbqt_bindGetHbObject( PHB_ITEM pItem, void * qtObject, const char * szC if( bind->qtObject == qtObject ) { HB_TRACE( HB_TR_DEBUG, ( "hbqt_bindGetHbObject( %p ):if( bind->qtObject == qtObject )", qtObject ) ); - pObject = hb_arrayCreateClone( pItem, ( PHB_BASEARRAY ) bind->hbObject ); + pObject = hb_arrayFromId( pItem, bind->hbObject ); break; } bind = bind->next; @@ -272,27 +260,25 @@ PHB_ITEM hbqt_bindSetHbObject( PHB_ITEM pItem, void * qtObject, const char * szC PHB_ITEM hbqt_bindGetHbObjectBYqtObject( void * qtObject ) { PHB_ITEM pObject = NULL; - PHB_ITEM pItem = NULL; - + if( qtObject != NULL ) { PHBQT_BIND bind; - + HBQT_BIND_LOCK bind = s_hbqt_binds; while( bind ) { if( bind->qtObject == qtObject ) { - pObject = hb_arrayCreateClone( pItem, ( PHB_BASEARRAY ) bind->hbObject ); + pObject = hb_arrayFromId( NULL, bind->hbObject ); break; } bind = bind->next; } HBQT_BIND_UNLOCK } - hb_itemRelease( pItem ); - return pObject; + return pObject; } void * hbqt_bindGetQtObject( PHB_ITEM pObject ) @@ -672,21 +658,18 @@ void hbqt_bindDelSlots( PHB_ITEM pSenderObject ) hb_vmSend( 0 ); if( hb_vmRequestQuery() == 0 ) { - HB_TRACE( HB_TR_DEBUG, ( "hbqt_bindDelSlots( PHB_ITEM pSenderObject 1 )" ) ); - PHB_ITEM pArray = hb_stackReturnItem(); - if( pArray ) - { - HB_TRACE( HB_TR_DEBUG, ( "hbqt_bindDelSlots( PHB_ITEM pSenderObject )" ) ); - hb_itemRelease( pArray ); - } + HB_TRACE( HB_TR_DEBUG, ( "hbqt_bindDelSlots( PHB_ITEM pSenderObject )" ) ); + hb_hashClear( hb_stackReturnItem() ); } hb_vmRequestRestore(); } - } + } } PHB_ITEM hbqt_bindGetSlots( PHB_ITEM pSenderObject, int iSignalid ) { + PHB_ITEM pSlots = NULL; + if( hb_vmRequestReenter() ) { hb_vmPushDynSym( s_dynsym___SLOTS ); @@ -701,11 +684,11 @@ PHB_ITEM hbqt_bindGetSlots( PHB_ITEM pSenderObject, int iSignalid ) hb_stackPop(); if( pArray && HB_IS_ARRAY( pArray ) && hb_arrayLen( pArray ) > 0 ) - return hb_itemNew( pArray ); + pSlots = hb_itemNew( pArray ); } hb_vmRequestRestore(); } - return NULL; + return pSlots; } HB_CALL_ON_STARTUP_BEGIN( _hbqt_bind_init_ ) diff --git a/harbour/doc/Makefile b/harbour/doc/Makefile index b83f8362b8..9d3c589024 100644 --- a/harbour/doc/Makefile +++ b/harbour/doc/Makefile @@ -30,5 +30,6 @@ DOC_FILES := \ transfrm.txt \ vm.txt \ windll.txt \ + xhb-diff.txt \ include $(TOP)$(ROOT)config/doc.mk diff --git a/harbour/doc/xhb-diff.txt b/harbour/doc/xhb-diff.txt index 2cd0fac606..d9bea0f2ac 100644 --- a/harbour/doc/xhb-diff.txt +++ b/harbour/doc/xhb-diff.txt @@ -1422,14 +1422,79 @@ without class object) though xHarbour wrongly use class messages as normal messages. In the future we plan to introduce real class objects like in Class(y) and -some other languages (i.e. XBASE++) so it's important for portability to write -code which is Class(y) friendly and never use class function directly as -constructor, i.e. instead of writing code like: +some other languages (i.e. XBASE++) so it's important for portability to +rite code which is Class(y) friendly and never use class function directly +as constructor, i.e. instead of writing code like: o := mycls( p1, p2, p3 ) programmer should use: o := mycls():new( p1, p2, p3 ) otherwise the code will not work with future Harbour versions supporting -real class objects. +real class objects. Even if programmer do not plan to pass any parameters +to constructor then he shold call :NEW() method: + o := mycls():new() +and please remember that :NEW() will be class method so it should not +be redefined as constructor in user class. Instead :INIT() method should +be used as constructor. It's executed automatically when object is +created from the :NEW() method. + +In Class(y) and xBase++ class function never returns final object. +It returns class object which is completely different and this object +understands few messages which allow to manage class, check inheritance +scheme, check object definition and access many different information +about the class and object. It also understands message :NEW() which +creates final object so programmer can make something like: + + oClass := myclass() + oObj1 := oClass:new() + oObj2 := oClass:new() + +It's very powerful system which allows to easy create constructions +which are still not available for Harbour and xHarbour users, i.e. +it's possible to write fully functional object inspector in just +few lines. +It also resolves many internal problems, i.e. now in many places we +have to create dummy objects just to extract some information about +the class. Each call to class function creates new object in current +implementation. In Class(y) class function returns exactly the same +class object on each call so it's very fast and programmer can call +this function as many times as he need without creating new objects. +Current Harbour and xHarbour implementation blocks writing some more +complicated code which needs to precisely follow each object instance +overloading constructors and destructors or even implement dynamic +initialization code because it will be activated in hidden way when +dummy objects are created. + +In xHarbour when parameters are passed to class function then :NEW() +method is executed inside class function. +I plan to eliminate current limitations and open new possibilities +adding class object functionality and it's the reason why I haven't +tried to replicate xHarbour behavior in Harbour. It simply won't work +in the future. + +Anyhow if someone wants to simulate xHarbour like behavior in Harbour +then he can modify hbclass.ch from Harbour. It's enough to change +ENDCLASS definition to: + +#xcommand ENDCLASS [] => ; + oClass:Create() ; [<-lck-> __clsLock( oClass:hClass ) ] ;; + always ;; + __clsUnlockDef( @s_oClass, oClass ) ;; + end sequence ;; + oInstance := oClass:Instance() ;; + if __ObjHasMsg( oInstance, "InitClass" ) ;; + oInstance:InitClass( HB_CLS_PARAM_LIST ) ;; + end ;; + else ;; + oInstance := s_oClass:Instance() ;; + end ;; + if PCount() > 0 ;; + return oInstance:new( HB_CLS_PARAM_LIST ) ;; + endif ;; + return oInstance AS CLASS _CLASS_NAME_ ;; + #undef _CLASS_MODE_ ; #define _CLASS_MODE_ _CLASS_IMPLEMENTATION_ + +But please remember it's not supported by Harbour and it may stop to +work in the future. @@ -1718,7 +1783,7 @@ loading and executing external code like support for thread local public symbols. It should greatly help to improve some programs like HTTP servers. Probably this code should also help in implementing dynamic namespace support so maybe we introduce it but seems that it will be -completely different thing then in current xHarbour. +completely different thing then namespaces in current xHarbour. @@ -1926,7 +1991,7 @@ far from current Harbour functionality and quality. ### HARBOUR TASKS AND MT SUPPORT IN DOS ### ================================================= -Harbour supports threads also in system without native thread support. +Harbour supports threads also in systems without native thread support. It has special code which emulates task switching so Harbour MT programs can be compiled and executed in systems like DOS. Harbour tasks are used by default in DOS builds in MT HVM. diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 2cbb59fb17..93f6ef207b 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -791,6 +791,7 @@ extern HB_EXPORT HB_BOOL hb_arrayNew( PHB_ITEM pItem, HB_SIZE nLen ); /* cr extern HB_EXPORT HB_SIZE hb_arrayLen( PHB_ITEM pArray ); /* retrieves the array len */ extern HB_EXPORT HB_BOOL hb_arrayIsObject( PHB_ITEM pArray ); /* retrieves if the array is an object */ extern HB_EXPORT void * hb_arrayId( PHB_ITEM pArray ); /* retrieves the array unique ID */ +extern HB_EXPORT PHB_ITEM hb_arrayFromId( PHB_ITEM pItem, void * pArrayId ); extern HB_EXPORT HB_BOOL hb_arrayAdd( PHB_ITEM pArray, PHB_ITEM pItemValue ); /* add a new item to the end of an array item */ extern HB_EXPORT HB_BOOL hb_arrayAddForward( PHB_ITEM pArray, PHB_ITEM pValue ); /* add a new item to the end of an array item with no incrementing of reference counters */ extern HB_EXPORT HB_BOOL hb_arrayIns( PHB_ITEM pArray, HB_SIZE nIndex ); /* insert a nil item into an array, without changing the length */ diff --git a/harbour/src/vm/arrays.c b/harbour/src/vm/arrays.c index dd3790351c..6039c3015c 100644 --- a/harbour/src/vm/arrays.c +++ b/harbour/src/vm/arrays.c @@ -321,6 +321,19 @@ void * hb_arrayId( PHB_ITEM pArray ) return NULL; } +PHB_ITEM hb_arrayFromId( PHB_ITEM pItem, void * pArrayId ) +{ + HB_STACK_TLS_PRELOAD + + hb_arrayPushBase( ( PHB_BASEARRAY ) pArrayId ); + if( pItem == NULL ) + pItem = hb_itemNew( NULL ); + hb_itemMove( pItem, hb_stackItemFromTop( -1 ) ); + hb_stackPop(); + + return pItem; +} + HB_BOOL hb_arrayAdd( PHB_ITEM pArray, PHB_ITEM pValue ) { HB_TRACE(HB_TR_DEBUG, ("hb_arrayAdd(%p, %p)", pArray, pValue));