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

2012-06-11 17:17 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)

Browse Source 
* 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.
This commit is contained in:
Przemyslaw Czerpak
2012-06-11 15:18:06 +00:00
parent 9e9544e2db
commit 8789944a3d
7 changed files with 147 additions and 54 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
harbour/ChangeLog
View File

@@ -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

44
harbour/contrib/hbct/misc1.c
View File

@@ -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 ) );
}

41
harbour/contrib/hbqt/qtcore/hbqt_bind.cpp
View File

@@ -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_ )

1
harbour/doc/Makefile
View File

@@ -30,5 +30,6 @@ DOC_FILES := \
transfrm.txt \
vm.txt \
windll.txt \
xhb-diff.txt \
include $(TOP)$(ROOT)config/doc.mk

77
harbour/doc/xhb-diff.txt
View File

@@ -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 [<lck: LOCK, LOCKED>] => ;
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.

1
harbour/include/hbapi.h
View File

@@ -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 */

13
harbour/src/vm/arrays.c
View File

@@ -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));