diff --git a/harbour/ChangeLog b/harbour/ChangeLog index f562193cb7..bf6373673a 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -7,6 +7,12 @@ For example: 2002-12-01 23:12 UTC+0100 Foo Bar */ + * include/hbapiitm.h + + Add definition for hb_itemUnRefOnce(). + * source/vm/itemapi.c + * Subdivision of the function hb_itemUnRef() in + hb_itemUnRef() and hb_itemUnRefOnce(). + * source/rtl/valtype.c + Add function: IS_VARBYREF(). This function allows in PRGs to know if a parameter has been passed by value or by reference. diff --git a/harbour/contrib/libct/Makefile b/harbour/contrib/libct/Makefile index c74afac58a..88a6d5e894 100644 --- a/harbour/contrib/libct/Makefile +++ b/harbour/contrib/libct/Makefile @@ -32,6 +32,7 @@ C_SOURCES = \ ctchksum.c \ ctcolton.c \ ctcrypt.c \ + exponent.c \ files.c \ finan.c \ ftoc.c \ diff --git a/harbour/contrib/libct/ctflist.txt b/harbour/contrib/libct/ctflist.txt index f092f65622..5e76f9bb36 100644 --- a/harbour/contrib/libct/ctflist.txt +++ b/harbour/contrib/libct/ctflist.txt @@ -276,7 +276,7 @@ CLEARBIT ;S; CTOBIT ;S; CTOF ;S; CTON ;S; -EXPONENT ;N; +EXPONENT ;S; FAHRENHEIT ;R; FTOC ;S; INFINITY ;R; @@ -284,7 +284,7 @@ INTNEG ;N; INTPOS ;N; ISBIT ;S; LTON ;N; -MANTISSA ;N; +MANTISSA ;S; NTOC ;S; NUMAND ;S; NUMANDX ;S; !NEW! diff --git a/harbour/contrib/libct/exponent.c b/harbour/contrib/libct/exponent.c new file mode 100644 index 0000000000..ee5f3f988b --- /dev/null +++ b/harbour/contrib/libct/exponent.c @@ -0,0 +1,254 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 Number and bit manipulation functions: - MANTISSA() + * - EXPONENT() + * + * Copyright 2002 Walter Negro - FOEESITRA" + * 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 + +/* undefine the following if you want to evaluate the mantissa and exponent from the doubles' bit representation */ +/* #define CT_EXPONENT_MANTISSA_BIT 1 */ + +/* $DOC$ + * $FUNCNAME$ + * MANTISSA() + * $CATEGORY$ + * CT3 number and bit manipulation functions + * $ONELINER$ + * Evaluate the mantissa of a floating point number + * $SYNTAX$ + * MANTISSA( ) --> nMantissa + * $ARGUMENTS$ + * Designate any Harbour number. + * $RETURNS$ + * MANTISSA() returns the mantissa of the number. + * $DESCRIPTION$ + * This function supplements EXPONENT() to return the mantissa of the + * number. + * + * Note: The mantissa value can be 0 or in the range of 1 to 2. + * + * The following calculation reproduces the original value: + * + * MANTISSA()* 2^EXPONENT() = + * + * + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * MANTISSA() is compatible with CT3's MANTISSA(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is exponent.c, library is libct. + * $SEEALSO$ + * EXPONENT() + * $END$ + */ + +HB_FUNC( MANTISSA ) +{ + +#ifdef CT_EXPONENT_MANTISSA_BIT + + union + { + double value; + char string[ sizeof( double )]; + } xConvert; + + xConvert.value = hb_parnd( 1 ); + + if( xConvert.value != 0 ) + { + xConvert.string[6] |= 0xF0; + xConvert.string[7] |= 0x3F; + xConvert.string[7] &= 0xBF; + } + + hb_retnd( xConvert.value ); + +#else + + double dValue; + + dValue = hb_parnd( 1 ); + + if (dValue == 0.0) + { + hb_retnd( 0.0 ); + return; + } + + if (fabs(dValue)<1.0) + { + while (fabs(dValue)<1.0) + dValue *= 2.0; + } + else if (fabs(dValue)>=2.0) + { + while (fabs(dValue)>=2.0) + dValue /= 2.0; + } + hb_retnd( dValue ); + +#endif + +} + + +/* $DOC$ + * $FUNCNAME$ + * EXPONENT() + * $CATEGORY$ + * CT3 number and bit manipulation functions + * $ONELINER$ + * Evaluate the exponent of a floating point number + * $SYNTAX$ + * EXPONENT( ) --> nExponent + * $ARGUMENTS$ + * Designate any Harbour number. + * $RETURNS$ + * EXPONENT() returns the exponent of the number + * in base 2. + * $DESCRIPTION$ + * This function supplements MANTISSA() to return the exponent of the + * number. + * + * Values > 1 or values < -1 return a positive number 0 to 1023. + * + * Values < 1 or values > -1 return a negative number -1 to -1023. + * + * The EXPONENT( 0 ), return 0. + * + * The following calculation reproduces the original value: + * + * 2^EXPONENT() * MANTISSA() = + * + * + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * EXPONENT() is compatible with CT3's EXPONENT() + * $PLATFORMS$ + * All + * $FILES$ + * Source is exponent.c, library is libct. + * $SEEALSO$ + * MANTISSA() + * $END$ + */ + +HB_FUNC( EXPONENT ) +{ + +#ifdef CT_EXPONENT_MANTISSA_BIT + + int iExponent = 0; + + union + { + double value; + char string[ sizeof( double )]; + } xConvert; + + xConvert.value = hb_parnd( 1 ); + + if( xConvert.value != 0 ) + { + iExponent = ( int ) ( xConvert.string[7] & 0x07F ); + iExponent = iExponent << 4; + iExponent += ( int ) ( ( xConvert.string[6] & 0xF0 ) >> 4 ); + iExponent -= 1023; + } + + hb_retni( iExponent ); + +#else + + int iExponent = 0; + double dValue; + + dValue = hb_parnd( 1 ); + + if (dValue == 0.0) + { + hb_retni( 0 ); + return; + } + + if( fabs( dValue ) < 1.0 ) + { + while ( fabs( dValue ) < 1.0 ) + { + dValue *= 2.0; + iExponent--; + } + } + else if ( fabs( dValue ) >= 2.0 ) + { + while ( fabs( dValue ) >= 2.0 ) + { + dValue /= 2.0; + iExponent++; + } + } + hb_retni( iExponent ); + +#endif + +} + diff --git a/harbour/contrib/libct/makefile.bc b/harbour/contrib/libct/makefile.bc index 15ce8794cf..4ea6c09505 100644 --- a/harbour/contrib/libct/makefile.bc +++ b/harbour/contrib/libct/makefile.bc @@ -117,6 +117,7 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\ctchksum.obj \ $(OBJ_DIR)\ctcolton.obj \ $(OBJ_DIR)\ctcrypt.obj \ + $(OBJ_DIR)\exponent.obj \ $(OBJ_DIR)\files.obj \ $(OBJ_DIR)\finan.obj \ $(OBJ_DIR)\ftoc.obj \ @@ -273,6 +274,10 @@ $(OBJ_DIR)\ctcrypt.obj : $(TOOLS_DIR)\ctcrypt.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\ctcrypt.obj : $(TOOLS_DIR)\exponent.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\files.obj : $(TOOLS_DIR)\files.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/contrib/libct/makefile.vc b/harbour/contrib/libct/makefile.vc index 1e08262db0..caaeb17709 100644 --- a/harbour/contrib/libct/makefile.vc +++ b/harbour/contrib/libct/makefile.vc @@ -137,6 +137,7 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\ctchksum.obj \ $(OBJ_DIR)\ctcolton.obj \ $(OBJ_DIR)\ctcrypt.obj \ + $(OBJ_DIR)\exponent.obj \ $(OBJ_DIR)\finan.obj \ $(OBJ_DIR)\ftoc.obj \ $(OBJ_DIR)\justify.obj \ @@ -203,6 +204,7 @@ CLEAN: -@if exist $(OBJ_DIR)\ctchksum.* del $(OBJ_DIR)\ctchksum.* -@if exist $(OBJ_DIR)\ctcolton.* del $(OBJ_DIR)\ctcolton.* -@if exist $(OBJ_DIR)\ctcrypt.* del $(OBJ_DIR)\ctcrypt.* + -@if exist $(OBJ_DIR)\exponent.* del $(OBJ_DIR)\exponent.* -@if exist $(OBJ_DIR)\finan.* del $(OBJ_DIR)\finan.* -@if exist $(OBJ_DIR)\ftoc.* del $(OBJ_DIR)\ftoc.* -@if exist $(OBJ_DIR)\justify.* del $(OBJ_DIR)\justify.* diff --git a/harbour/contrib/libct/tests/Makefile b/harbour/contrib/libct/tests/Makefile index f413fffb13..d147c143ab 100644 --- a/harbour/contrib/libct/tests/Makefile +++ b/harbour/contrib/libct/tests/Makefile @@ -66,6 +66,7 @@ PRG_SOURCES=\ csetatmu.prg \ csetarge.prg \ csetref.prg \ + expomant.prg \ finan.prg \ math.prg \ num1.prg \ @@ -84,7 +85,7 @@ PRG_SOURCES=\ wordrepl.prg \ wordrem.prg \ wordswap.prg \ - + PRG_HEADERS=\ diff --git a/harbour/contrib/libct/tests/expomant.prg b/harbour/contrib/libct/tests/expomant.prg new file mode 100644 index 0000000000..5d18c0678f --- /dev/null +++ b/harbour/contrib/libct/tests/expomant.prg @@ -0,0 +1,78 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 function test for + * - EXPONENT + * - MANTISSA + * + * Copyright 2002 Walter Negro - FOEESITRA" + * 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. + * + */ + + +PROCEDURE MAIN + +local n + + CTINIT() + + SET DECIMALS TO 15 + + for n=1 to 1000 + outstd (str(n,20,15)+": "+str(mantissa(n),20,15)+" "+str(exponent(n),4) + hb_osnewline()) + outstd (str(sqrt(n),20,15)+": "+str(mantissa(sqrt(n)),20,15)+" "+str(exponent(sqrt(n)),4) + hb_osnewline()) + next n + +// The call to str( infinity(.t.) ), generate a GPF. +// outstd (str(infinity(.t.))+str(mantissa( infinity(.t.) ))+str(exponent( infinity(.t.) ))) +// outstd (str(infinity(.t.)) ) + + outstd (" infinity(.t.): "+str(mantissa(infinity(.t.)),20,15)+" ") + outstd (str(exponent(infinity(.t.)),4)+hb_osnewline()) + + CTEXIT() + +RETURN