From a455bf0d4c8697acf79832357714a3cc86975629 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Sat, 25 Aug 2007 10:20:35 +0000 Subject: [PATCH] 2007-08-25 12:20 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbapi.h * harbour/source/vm/arrays.c * harbour/source/vm/extend.c ! fixed hb_stor*() functions return value to be Clipper compatible. These functions should return 1 _ONLY_ when the operation is really successful; otherwise, they return zero. + added hb_storclen_buffer(), hb_arraySetPtrGC() * harbour/config/darwin/gcc.cf * harbour/config/hpux/gcc.cf * harbour/config/dos/rsx32.cf * harbour/config/os2/gcc.cf * harbour/config/sunos/gcc.cf * harbour/config/w32/gcc.cf * harbour/config/w32/rsxnt.cf + added rtl library after gt drivers for linker which do not support backward references --- harbour/ChangeLog | 19 ++++++ harbour/config/darwin/gcc.cf | 2 +- harbour/config/dos/rsx32.cf | 2 +- harbour/config/hpux/gcc.cf | 2 +- harbour/config/os2/gcc.cf | 2 +- harbour/config/sunos/gcc.cf | 41 +++-------- harbour/config/w32/gcc.cf | 2 +- harbour/config/w32/rsxnt.cf | 2 +- harbour/include/hbapi.h | 2 + harbour/source/vm/arrays.c | 13 ++++ harbour/source/vm/extend.c | 128 +++++++++++++++++------------------ 11 files changed, 114 insertions(+), 101 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 2181fae1cf..cb887c54ff 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,25 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-08-25 12:20 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/hbapi.h + * harbour/source/vm/arrays.c + * harbour/source/vm/extend.c + ! fixed hb_stor*() functions return value to be Clipper compatible. + These functions should return 1 _ONLY_ when the operation is really + successful; otherwise, they return zero. + + added hb_storclen_buffer(), hb_arraySetPtrGC() + + * harbour/config/darwin/gcc.cf + * harbour/config/hpux/gcc.cf + * harbour/config/dos/rsx32.cf + * harbour/config/os2/gcc.cf + * harbour/config/sunos/gcc.cf + * harbour/config/w32/gcc.cf + * harbour/config/w32/rsxnt.cf + + added rtl library after gt drivers for linker which do not support + backward references + 2007-08-24 22:45 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/utils/hbdot/hbdot.prg * some minor modifications for GT drivers which allow to change diff --git a/harbour/config/darwin/gcc.cf b/harbour/config/darwin/gcc.cf index eedef2751b..e91f38aae6 100644 --- a/harbour/config/darwin/gcc.cf +++ b/harbour/config/darwin/gcc.cf @@ -55,7 +55,7 @@ endif ifeq ($(findstring rtl,$(LIBS)),rtl) LINKPATHS += $(foreach gt, $(HB_GT_LIBS), -L$(TOP)$(ROOT)source/rtl/$(gt)/$(HB_ARCH)) -LINKLIBS += $(foreach gt, $(HB_GT_LIBS), -l$(gt)) +LINKLIBS += $(foreach gt, $(HB_GT_LIBS), -l$(gt)) -lrtl # screen driver libraries ifneq ($(findstring gtcrs, $(HB_GT_LIBS)),) diff --git a/harbour/config/dos/rsx32.cf b/harbour/config/dos/rsx32.cf index 0511d06d4d..5b15e21c2b 100644 --- a/harbour/config/dos/rsx32.cf +++ b/harbour/config/dos/rsx32.cf @@ -45,7 +45,7 @@ endif # Add the specified GT driver library and other RTLs ifeq ($(findstring rtl,$(LIBS)),rtl) LINKPATHS += $(foreach gt, $(HB_GT_LIBS), -L$(TOP)$(ROOT)source/rtl/$(gt)/$(HB_ARCH)) -LINKLIBS += $(foreach gt, $(HB_GT_LIBS), -l$(gt)) +LINKLIBS += $(foreach gt, $(HB_GT_LIBS), -l$(gt)) -lrtl endif # The -) option could be appropriate to link against libraries with diff --git a/harbour/config/hpux/gcc.cf b/harbour/config/hpux/gcc.cf index bec6c2654f..188641ed29 100644 --- a/harbour/config/hpux/gcc.cf +++ b/harbour/config/hpux/gcc.cf @@ -44,7 +44,7 @@ endif ifeq ($(findstring rtl,$(LIBS)),rtl) LINKPATHS += $(foreach gt, $(HB_GT_LIBS), -L$(TOP)$(ROOT)source/rtl/$(gt)/$(HB_ARCH)) -LINKLIBS += $(foreach gt, $(HB_GT_LIBS), -l$(gt)) +LINKLIBS += $(foreach gt, $(HB_GT_LIBS), -l$(gt)) -lrtl # screen driver libraries ifneq ($(findstring gtcrs, $(HB_GT_LIBS)),) diff --git a/harbour/config/os2/gcc.cf b/harbour/config/os2/gcc.cf index b467fe3844..9da2201d55 100644 --- a/harbour/config/os2/gcc.cf +++ b/harbour/config/os2/gcc.cf @@ -63,7 +63,7 @@ LINKLIBS += -lgtos2 else LINKPATHS += $(foreach gt, $(HB_GT_LIBS), -L$(TOP)$(ROOT)source/rtl/$(gt)/$(HB_ARCH)) -LINKLIBS += $(foreach gt, $(HB_GT_LIBS), -l$(gt)) +LINKLIBS += $(foreach gt, $(HB_GT_LIBS), -l$(gt)) -lrtl endif endif diff --git a/harbour/config/sunos/gcc.cf b/harbour/config/sunos/gcc.cf index e5b83e21c5..dc7bc53735 100644 --- a/harbour/config/sunos/gcc.cf +++ b/harbour/config/sunos/gcc.cf @@ -43,42 +43,23 @@ endif # Add the specified GT driver library and other RTLs ifeq ($(findstring rtl,$(LIBS)),rtl) -LINKPATHS += -L$(TOP)$(ROOT)source/rtl/$(HB_GT_LIB)/$(HB_ARCH) -LINKLIBS += -l$(HB_GT_LIB) +LINKPATHS += $(foreach gt, $(HB_GT_LIBS), -L$(TOP)$(ROOT)source/rtl/$(gt)/$(HB_ARCH)) +LINKLIBS += $(foreach gt, $(HB_GT_LIBS), -l$(gt)) -lrtl -ifneq ($(HB_GT_DEFAULT),) -ifneq ($(HB_GT_DEFAULT),$(HB_GT_LIB)) -LINKPATHS += -L$(TOP)$(ROOT)source/rtl/$(HB_GT_DEFAULT)/$(HB_ARCH) -LINKLIBS += -l$(HB_GT_DEFAULT) +# screen driver libraries +ifneq ($(findstring gtcrs, $(HB_GT_LIBS)),) +LINKLIBS += -lcurses endif +ifneq ($(findstring gtsln, $(HB_GT_LIBS)),) +LINKLIBS += -lslang endif - -# HB_SCREEN_LIB: empty, or one of curses, slang -ifeq ($(HB_GT_LIB),gtcrs) -HB_SCREEN_LIB:=curses -else -ifeq ($(HB_GT_LIB),gtsln) -HB_SCREEN_LIB:=slang -else -ifeq ($(HB_GT_LIB),gtalleg) -HB_GTALLEG:=yes +ifneq ($(findstring gtalleg, $(HB_GT_LIBS)),) LINKLIBS += `allegro-config --static` endif -endif -endif - -ifneq ($(HB_SCREEN_LIB),) -LINKLIBS += -l$(HB_SCREEN_LIB) -endif - -ifeq ($(HB_GT_LIB),gtxvt) +ifneq ($(findstring gtxwc, $(HB_GT_LIBS)),) LINKLIBS += -lX11 -LINKPATHS +=-L/usr/X11R6/lib -else -ifeq ($(HB_GT_LIB),gtxwc) -LINKLIBS += -lX11 -LINKPATHS +=-L/usr/X11R6/lib -endif +#LINKPATHS += -L/usr/X11R6/lib64 +LINKPATHS += -L/usr/X11R6/lib endif # HB_GPM_MOUSE: use gpm mouse driver diff --git a/harbour/config/w32/gcc.cf b/harbour/config/w32/gcc.cf index eaf294d919..355bcabc05 100644 --- a/harbour/config/w32/gcc.cf +++ b/harbour/config/w32/gcc.cf @@ -45,7 +45,7 @@ endif # Add the specified GT driver library ifeq ($(findstring rtl,$(LIBS)),rtl) LINKPATHS += $(foreach gt, $(HB_GT_LIBS), -L$(TOP)$(ROOT)source/rtl/$(gt)/$(HB_ARCH)) -LINKLIBS += $(foreach gt, $(HB_GT_LIBS), -l$(gt)) +LINKLIBS += $(foreach gt, $(HB_GT_LIBS), -l$(gt)) -lrtl endif # HB_SCREEN_LIB: empty, or one of ncurses, slang diff --git a/harbour/config/w32/rsxnt.cf b/harbour/config/w32/rsxnt.cf index f42a53b8c5..69a6279527 100644 --- a/harbour/config/w32/rsxnt.cf +++ b/harbour/config/w32/rsxnt.cf @@ -48,7 +48,7 @@ endif # Add the specified GT driver library ifeq ($(findstring rtl,$(LIBS)),rtl) LINKPATHS += $(foreach gt, $(HB_GT_LIBS), -L$(TOP)$(ROOT)source/rtl/$(gt)/$(HB_ARCH)) -LINKLIBS += $(foreach gt, $(HB_GT_LIBS), -l$(gt)) +LINKLIBS += $(foreach gt, $(HB_GT_LIBS), -l$(gt)) -lrtl endif # HB_SCREEN_LIB: empty, or one of ncurses, slang diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 7463bc9086..09aad84873 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -633,6 +633,7 @@ extern HB_EXPORT void hb_retnlllen( LONGLONG lNumber, int iWidth ); /* returns extern HB_EXPORT int hb_storc( char * szText, int iParam, ... ); /* stores a szString on a variable by reference */ extern HB_EXPORT int hb_storclen( char * szText, ULONG ulLength, int iParam, ... ); /* stores a fixed length string on a variable by reference */ +extern HB_EXPORT int hb_storclen_buffer( char * szText, ULONG ulLength, int iParam, ... ); /* stores a fixed length string buffer on a variable by reference */ extern HB_EXPORT int hb_stords( char * szDate, int iParam, ... ); /* szDate must have yyyymmdd format */ extern HB_EXPORT int hb_storl( int iLogical, int iParam, ... ); /* stores a logical integer on a variable by reference */ extern HB_EXPORT int hb_storni( int iValue, int iParam, ... ); /* stores an integer on a variable by reference */ @@ -687,6 +688,7 @@ extern HB_EXPORT BOOL hb_arraySetC( PHB_ITEM pArray, ULONG ulIndex, const c extern HB_EXPORT BOOL hb_arraySetCL( PHB_ITEM pArray, ULONG ulIndex, const char * szText, ULONG ulLen ); extern HB_EXPORT BOOL hb_arraySetCPtr( PHB_ITEM pArray, ULONG ulIndex, char * szText, ULONG ulLen ); extern HB_EXPORT BOOL hb_arraySetPtr( PHB_ITEM pArray, ULONG ulIndex, void * pValue ); +extern HB_EXPORT BOOL hb_arraySetPtrGC( PHB_ITEM pArray, ULONG ulIndex, void * pValue ); extern HB_EXPORT BOOL hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG * pulCount ); /* fill an array with a given item */ extern HB_EXPORT ULONG hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG * pulCount, BOOL fExact ); /* scan an array for a given item, or until code-block item returns TRUE */ extern HB_EXPORT ULONG hb_arrayRevScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG * pulCount, BOOL fExact ); /* scan an array for a given item, or until code-block item returns TRUE in reverted order */ diff --git a/harbour/source/vm/arrays.c b/harbour/source/vm/arrays.c index ec3770f244..4702cf24c3 100644 --- a/harbour/source/vm/arrays.c +++ b/harbour/source/vm/arrays.c @@ -767,6 +767,19 @@ HB_EXPORT BOOL hb_arraySetPtr( PHB_ITEM pArray, ULONG ulIndex, void * pValue ) return FALSE; } +HB_EXPORT BOOL hb_arraySetPtrGC( PHB_ITEM pArray, ULONG ulIndex, void * pValue ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_arraySetPtrGC(%p, %lu, %p)", pArray, ulIndex, pValue)); + + if( HB_IS_ARRAY( pArray ) && ulIndex > 0 && ulIndex <= pArray->item.asArray.value->ulLen ) + { + hb_itemPutPtrGC( pArray->item.asArray.value->pItems + ulIndex - 1, pValue ); + return TRUE; + } + else + return FALSE; +} + BOOL hb_arrayLast( PHB_ITEM pArray, PHB_ITEM pResult ) { HB_TRACE(HB_TR_DEBUG, ("hb_arrayLast(%p, %p)", pArray, pResult)); diff --git a/harbour/source/vm/extend.c b/harbour/source/vm/extend.c index 04bb8f98ec..e74e7a03a4 100644 --- a/harbour/source/vm/extend.c +++ b/harbour/source/vm/extend.c @@ -927,21 +927,18 @@ HB_EXPORT int hb_storc( char * szText, int iParam, ... ) if( HB_IS_ARRAY( pItem ) ) { + int iRetVal; va_list va; - PHB_ITEM pItemNew = hb_itemPutC( NULL, szText ); va_start( va, iParam ); - hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew ); + iRetVal = hb_arraySetC( pItem, va_arg( va, ULONG ), szText ) ? 1 : 0; va_end( va ); - hb_itemRelease( pItemNew ); - return 1; + return iRetVal; } else if( bByRef || iParam == -1 ) { hb_itemPutC( pItem, szText ); return 1; } - - return 0; } return 0; @@ -961,21 +958,49 @@ HB_EXPORT int hb_storclen( char * szText, ULONG ulLen, int iParam, ... ) if( HB_IS_ARRAY( pItem ) ) { + int iRetVal; va_list va; - PHB_ITEM pItemNew = hb_itemPutCL( NULL, szText, ulLen ); va_start( va, iParam ); - hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew ); + iRetVal = hb_arraySetCL( pItem, va_arg( va, ULONG ), szText, ulLen ) ? 1 : 0; va_end( va ); - hb_itemRelease( pItemNew ); - return 1; + return iRetVal; } else if( bByRef || iParam == -1 ) { hb_itemPutCL( pItem, szText, ulLen ); return 1; } + } - return 0; + return 0; +} + +HB_EXPORT int hb_storclen_buffer( char * szText, ULONG ulLen, int iParam, ... ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_storclen_buffer(%s, %lu, %d, ...)", szText, ulLen, iParam)); + + if( ( iParam >= 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) ) + { + PHB_ITEM pItem = ( iParam == -1 ) ? hb_stackReturnItem() : hb_stackItemFromBase( iParam ); + BOOL bByRef = HB_IS_BYREF( pItem ); + + if( bByRef ) + pItem = hb_itemUnRef( pItem ); + + if( HB_IS_ARRAY( pItem ) ) + { + int iRetVal; + va_list va; + va_start( va, iParam ); + iRetVal = hb_arraySetCPtr( pItem, va_arg( va, ULONG ), szText, ulLen ) ? 1 : 0; + va_end( va ); + return iRetVal; + } + else if( bByRef || iParam == -1 ) + { + hb_itemPutCPtr( pItem, szText, ulLen ); + return 1; + } } return 0; @@ -997,21 +1022,18 @@ HB_EXPORT int hb_stords( char * szDate, int iParam, ... ) if( HB_IS_ARRAY( pItem ) ) { + int iRetVal; va_list va; - PHB_ITEM pItemNew = hb_itemPutDS( NULL, szDate ); va_start( va, iParam ); - hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew ); + iRetVal = hb_arraySetDS( pItem, va_arg( va, ULONG ), szDate ) ? 1 : 0; va_end( va ); - hb_itemRelease( pItemNew ); - return 1; + return iRetVal; } else if( bByRef || iParam == -1 ) { hb_itemPutDS( pItem, szDate ); return 1; } - - return 0; } return 0; @@ -1031,21 +1053,18 @@ HB_EXPORT int hb_storl( int iLogical, int iParam, ... ) if( HB_IS_ARRAY( pItem ) ) { + int iRetVal; va_list va; - PHB_ITEM pItemNew = hb_itemPutL( NULL, iLogical ? TRUE : FALSE ); va_start( va, iParam ); - hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew ); + iRetVal = hb_arraySetL( pItem, va_arg( va, ULONG ), iLogical ? TRUE : FALSE ) ? 1 : 0; va_end( va ); - hb_itemRelease( pItemNew ); - return 1; + return iRetVal; } else if( bByRef || iParam == -1 ) { hb_itemPutL( pItem, iLogical ? TRUE : FALSE ); return 1; } - - return 0; } return 0; @@ -1065,21 +1084,18 @@ HB_EXPORT int hb_storni( int iValue, int iParam, ... ) if( HB_IS_ARRAY( pItem ) ) { + int iRetVal; va_list va; - PHB_ITEM pItemNew = hb_itemPutNI( NULL, iValue ); va_start( va, iParam ); - hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew ); + iRetVal = hb_arraySetNI( pItem, va_arg( va, ULONG ), iValue ) ? 1 : 0; va_end( va ); - hb_itemRelease( pItemNew ); - return 1; + return iRetVal; } else if( bByRef || iParam == -1 ) { hb_itemPutNI( pItem, iValue ); return 1; } - - return 0; } return 0; @@ -1099,21 +1115,18 @@ HB_EXPORT int hb_stornl( long lValue, int iParam, ... ) if( HB_IS_ARRAY( pItem ) ) { + int iRetVal; va_list va; - PHB_ITEM pItemNew = hb_itemPutNL( NULL, lValue ); va_start( va, iParam ); - hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew ); + iRetVal = hb_arraySetNL( pItem, va_arg( va, ULONG ), lValue ) ? 1 : 0; va_end( va ); - hb_itemRelease( pItemNew ); - return 1; + return iRetVal; } else if( bByRef || iParam == -1 ) { hb_itemPutNL( pItem, lValue ); return 1; } - - return 0; } return 0; @@ -1134,21 +1147,18 @@ HB_EXPORT int hb_stornll( LONGLONG llValue, int iParam, ... ) if( HB_IS_ARRAY( pItem ) ) { + int iRetVal; va_list va; - PHB_ITEM pItemNew = hb_itemPutNLL( NULL, llValue ); va_start( va, iParam ); - hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew ); + iRetVal = hb_arraySetNLL( pItem, va_arg( va, ULONG ), llValue ) ? 1 : 0; va_end( va ); - hb_itemRelease( pItemNew ); - return 1; + return iRetVal; } else if( bByRef || iParam == -1 ) { hb_itemPutNLL( pItem, llValue ); return 1; } - - return 0; } return 0; @@ -1169,21 +1179,18 @@ HB_EXPORT int hb_stornint( HB_LONG lValue, int iParam, ... ) if( HB_IS_ARRAY( pItem ) ) { + int iRetVal; va_list va; - PHB_ITEM pItemNew = hb_itemPutNInt( NULL, lValue ); va_start( va, iParam ); - hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew ); + iRetVal = hb_arraySetNInt( pItem, va_arg( va, ULONG ), lValue ) ? 1 : 0; va_end( va ); - hb_itemRelease( pItemNew ); - return 1; + return iRetVal; } else if( bByRef || iParam == -1 ) { hb_itemPutNInt( pItem, lValue ); return 1; } - - return 0; } return 0; @@ -1203,21 +1210,18 @@ HB_EXPORT int hb_stornd( double dNumber, int iParam, ... ) if( HB_IS_ARRAY( pItem ) ) { + int iRetVal; va_list va; - PHB_ITEM pItemNew = hb_itemPutND( NULL, dNumber ); va_start( va, iParam ); - hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew ); + iRetVal = hb_arraySetND( pItem, va_arg( va, ULONG ), dNumber ) ? 1 : 0; va_end( va ); - hb_itemRelease( pItemNew ); - return 1; + return iRetVal; } else if( bByRef || iParam == -1 ) { hb_itemPutND( pItem, dNumber ); return 1; } - - return 0; } return 0; @@ -1237,21 +1241,18 @@ HB_EXPORT int hb_storptr( void * pointer, int iParam, ... ) if( HB_IS_ARRAY( pItem ) ) { + int iRetVal; va_list va; - PHB_ITEM pItemNew = hb_itemPutPtr( NULL, pointer ); va_start( va, iParam ); - hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew ); + iRetVal = hb_arraySetPtr( pItem, va_arg( va, ULONG ), pointer ) ? 1 : 0; va_end( va ); - hb_itemRelease( pItemNew ); - return 1; + return iRetVal; } else if( bByRef || iParam == -1 ) { hb_itemPutPtr( pItem, pointer ); return 1; } - - return 0; } return 0; @@ -1271,21 +1272,18 @@ HB_EXPORT int hb_storptrGC( void * pointer, int iParam, ... ) if( HB_IS_ARRAY( pItem ) ) { + int iRetVal; va_list va; - PHB_ITEM pItemNew = hb_itemPutPtrGC( NULL, pointer ); va_start( va, iParam ); - hb_arraySet( pItem, va_arg( va, ULONG ), pItemNew ); + iRetVal = hb_arraySetPtrGC( pItem, va_arg( va, ULONG ), pointer ) ? 1 : 0; va_end( va ); - hb_itemRelease( pItemNew ); - return 1; + return iRetVal; } else if( bByRef || iParam == -1 ) { hb_itemPutPtrGC( pItem, pointer ); return 1; } - - return 0; } return 0;