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

2002-04-08 19:10 UTC+0100 Martin Vogel <vogel@inttec.de>

Browse Source
This commit is contained in:
Martin Vogel
2002-04-08 17:08:01 +00:00
parent e3f89dfa7f
commit 0706d50b29
8 changed files with 350 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
harbour/ChangeLog
View File

@@ -7,6 +7,12 @@
For example:
2002-12-01 23:12 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
* 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.

1
harbour/contrib/libct/Makefile
View File

@@ -32,6 +32,7 @@ C_SOURCES = \
ctchksum.c \
ctcolton.c \
ctcrypt.c \
exponent.c \
files.c \
finan.c \
ftoc.c \

4
harbour/contrib/libct/ctflist.txt
View File

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

254
harbour/contrib/libct/exponent.c Normal file
View File

@@ -0,0 +1,254 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 Number and bit manipulation functions: - MANTISSA()
* - EXPONENT()
*
* Copyright 2002 Walter Negro - FOEESITRA" <waltern@foeesitra.org.ar>
* 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 <ct.h>
/* 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( <nFloatingPointNumber> ) --> nMantissa
* $ARGUMENTS$
* <nFloatingPointNumber> Designate any Harbour number.
* $RETURNS$
* MANTISSA() returns the mantissa of the <nFloatingPointNumber> number.
* $DESCRIPTION$
* This function supplements EXPONENT() to return the mantissa of the
* <nFloatingPointNumber> number.
*
* Note: The mantissa value can be 0 or in the range of 1 to 2.
*
* The following calculation reproduces the original value:
*
* MANTISSA(<nFloatingPointNumber>)* 2^EXPONENT(<nFloatingPointNumber>) =
* <nFloatingPointNumber>
*
* 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( <nFloatingPointNumber> ) --> nExponent
* $ARGUMENTS$
* <nFloatingPointNumber> Designate any Harbour number.
* $RETURNS$
* EXPONENT() returns the exponent of the <nFloatingPointNumber> number
* in base 2.
* $DESCRIPTION$
* This function supplements MANTISSA() to return the exponent of the
* <nFloatingPointNumber> 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(<nFloatingPointNumber>) * MANTISSA(<nFloatingPointNumber>) =
* <nFloatingPointNumber>
*
* 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
}

5
harbour/contrib/libct/makefile.bc
View File

@@ -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) -+$@,,

2
harbour/contrib/libct/makefile.vc
View File

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

3
harbour/contrib/libct/tests/Makefile
View File

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

78
harbour/contrib/libct/tests/expomant.prg Normal file
View File

@@ -0,0 +1,78 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 function test for
* - EXPONENT
* - MANTISSA
*
* Copyright 2002 Walter Negro - FOEESITRA" <waltern@foeesitra.org.ar>
* 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