1991-02-19 20:39:46 +08:00
|
|
|
/***********************************************************
|
1993-03-16 20:15:04 +08:00
|
|
|
Copyright 1991, 1992, 1993 by Stichting Mathematisch Centrum,
|
|
|
|
Amsterdam, The Netherlands.
|
1991-02-19 20:39:46 +08:00
|
|
|
|
|
|
|
All Rights Reserved
|
|
|
|
|
|
|
|
Permission to use, copy, modify, and distribute this software and its
|
|
|
|
documentation for any purpose and without fee is hereby granted,
|
|
|
|
provided that the above copyright notice appear in all copies and that
|
|
|
|
both that copyright notice and this permission notice appear in
|
|
|
|
supporting documentation, and that the names of Stichting Mathematisch
|
|
|
|
Centrum or CWI not be used in advertising or publicity pertaining to
|
|
|
|
distribution of the software without specific, written prior permission.
|
|
|
|
|
|
|
|
STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
|
|
|
|
THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
|
|
|
FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
|
|
|
|
FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
|
|
|
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
|
|
|
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
|
|
|
|
OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|
|
|
|
|
|
|
******************************************************************/
|
|
|
|
|
1990-10-14 20:07:46 +08:00
|
|
|
/* Float object implementation */
|
|
|
|
|
1990-10-22 06:15:08 +08:00
|
|
|
/* XXX There should be overflow checks here, but it's hard to check
|
|
|
|
for any kind of float exception without losing portability. */
|
|
|
|
|
1990-12-20 23:06:42 +08:00
|
|
|
#include "allobjects.h"
|
1993-03-16 20:15:04 +08:00
|
|
|
#include "modsupport.h"
|
1990-10-14 20:07:46 +08:00
|
|
|
|
1990-12-21 07:06:26 +08:00
|
|
|
#include <errno.h>
|
1990-12-20 23:06:42 +08:00
|
|
|
#include <ctype.h>
|
|
|
|
#include <math.h>
|
1990-10-14 20:07:46 +08:00
|
|
|
|
1993-04-07 22:06:14 +08:00
|
|
|
#ifdef i860
|
|
|
|
/* Cray APP has bogus definition of HUGE_VAL in <math.h> */
|
|
|
|
#undef HUGE_VAL
|
|
|
|
#endif
|
|
|
|
|
1991-12-16 23:43:14 +08:00
|
|
|
#ifdef HUGE_VAL
|
|
|
|
#define CHECK(x) if (errno != 0) ; \
|
|
|
|
else if (-HUGE_VAL <= (x) && (x) <= HUGE_VAL) ; \
|
|
|
|
else errno = ERANGE
|
|
|
|
#else
|
|
|
|
#define CHECK(x) /* Don't know how to check */
|
|
|
|
#endif
|
|
|
|
|
1990-11-03 01:50:43 +08:00
|
|
|
#ifndef THINK_C
|
|
|
|
extern double fmod PROTO((double, double));
|
|
|
|
extern double pow PROTO((double, double));
|
|
|
|
#endif
|
|
|
|
|
1990-10-14 20:07:46 +08:00
|
|
|
object *
|
|
|
|
newfloatobject(fval)
|
|
|
|
double fval;
|
|
|
|
{
|
|
|
|
/* For efficiency, this code is copied from newobject() */
|
|
|
|
register floatobject *op = (floatobject *) malloc(sizeof(floatobject));
|
1990-10-22 06:15:08 +08:00
|
|
|
if (op == NULL)
|
|
|
|
return err_nomem();
|
|
|
|
op->ob_type = &Floattype;
|
|
|
|
op->ob_fval = fval;
|
1993-10-11 20:54:31 +08:00
|
|
|
NEWREF(op);
|
1990-10-14 20:07:46 +08:00
|
|
|
return (object *) op;
|
|
|
|
}
|
|
|
|
|
1993-06-17 20:35:49 +08:00
|
|
|
static void
|
1992-03-28 01:28:44 +08:00
|
|
|
float_dealloc(op)
|
|
|
|
object *op;
|
|
|
|
{
|
|
|
|
DEL(op);
|
|
|
|
}
|
|
|
|
|
1990-10-14 20:07:46 +08:00
|
|
|
double
|
|
|
|
getfloatvalue(op)
|
|
|
|
object *op;
|
|
|
|
{
|
|
|
|
if (!is_floatobject(op)) {
|
1990-10-22 06:15:08 +08:00
|
|
|
err_badarg();
|
1990-10-14 20:07:46 +08:00
|
|
|
return -1;
|
|
|
|
}
|
|
|
|
else
|
|
|
|
return ((floatobject *)op) -> ob_fval;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* Methods */
|
|
|
|
|
1991-06-05 04:42:53 +09:00
|
|
|
void
|
1990-10-14 20:07:46 +08:00
|
|
|
float_buf_repr(buf, v)
|
|
|
|
char *buf;
|
|
|
|
floatobject *v;
|
|
|
|
{
|
|
|
|
register char *cp;
|
|
|
|
/* Subroutine for float_repr and float_print.
|
|
|
|
We want float numbers to be recognizable as such,
|
|
|
|
i.e., they should contain a decimal point or an exponent.
|
|
|
|
However, %g may print the number as an integer;
|
|
|
|
in such cases, we append ".0" to the string. */
|
|
|
|
sprintf(buf, "%.12g", v->ob_fval);
|
|
|
|
cp = buf;
|
|
|
|
if (*cp == '-')
|
|
|
|
cp++;
|
|
|
|
for (; *cp != '\0'; cp++) {
|
|
|
|
/* Any non-digit means it's not an integer;
|
|
|
|
this takes care of NAN and INF as well. */
|
|
|
|
if (!isdigit(*cp))
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
if (*cp == '\0') {
|
|
|
|
*cp++ = '.';
|
|
|
|
*cp++ = '0';
|
|
|
|
*cp++ = '\0';
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
1992-03-28 01:28:44 +08:00
|
|
|
/* ARGSUSED */
|
1991-06-08 01:10:43 +09:00
|
|
|
static int
|
1990-10-14 20:07:46 +08:00
|
|
|
float_print(v, fp, flags)
|
|
|
|
floatobject *v;
|
|
|
|
FILE *fp;
|
1992-03-28 01:28:44 +08:00
|
|
|
int flags; /* Not used but required by interface */
|
1990-10-14 20:07:46 +08:00
|
|
|
{
|
|
|
|
char buf[100];
|
|
|
|
float_buf_repr(buf, v);
|
|
|
|
fputs(buf, fp);
|
1991-06-08 01:10:43 +09:00
|
|
|
return 0;
|
1990-10-14 20:07:46 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_repr(v)
|
|
|
|
floatobject *v;
|
|
|
|
{
|
|
|
|
char buf[100];
|
|
|
|
float_buf_repr(buf, v);
|
|
|
|
return newstringobject(buf);
|
|
|
|
}
|
|
|
|
|
|
|
|
static int
|
|
|
|
float_compare(v, w)
|
|
|
|
floatobject *v, *w;
|
|
|
|
{
|
|
|
|
double i = v->ob_fval;
|
|
|
|
double j = w->ob_fval;
|
|
|
|
return (i < j) ? -1 : (i > j) ? 1 : 0;
|
|
|
|
}
|
|
|
|
|
1993-03-29 18:43:31 +08:00
|
|
|
static long
|
|
|
|
float_hash(v)
|
|
|
|
floatobject *v;
|
|
|
|
{
|
|
|
|
double intpart, fractpart;
|
|
|
|
int expo;
|
|
|
|
long x;
|
|
|
|
/* This is designed so that Python numbers with the same
|
|
|
|
value hash to the same value, otherwise comparisons
|
|
|
|
of mapping keys will turn out weird */
|
|
|
|
fractpart = modf(v->ob_fval, &intpart);
|
|
|
|
if (fractpart == 0.0) {
|
|
|
|
if (intpart > 0x7fffffffL || -intpart > 0x7fffffffL) {
|
|
|
|
/* Convert to long int and use its hash... */
|
|
|
|
object *w = dnewlongobject(v->ob_fval);
|
|
|
|
if (w == NULL)
|
|
|
|
return -1;
|
|
|
|
x = hashobject(w);
|
|
|
|
DECREF(w);
|
|
|
|
return x;
|
|
|
|
}
|
|
|
|
x = (long)intpart;
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
fractpart = frexp(fractpart, &expo);
|
1993-04-07 22:06:14 +08:00
|
|
|
fractpart = fractpart*4294967296.0; /* 2**32 */
|
1993-03-29 18:43:31 +08:00
|
|
|
x = (long) (intpart + fractpart) ^ expo; /* Rather arbitrary */
|
|
|
|
}
|
|
|
|
if (x == -1)
|
|
|
|
x = -2;
|
|
|
|
return x;
|
|
|
|
}
|
|
|
|
|
1990-10-14 20:07:46 +08:00
|
|
|
static object *
|
|
|
|
float_add(v, w)
|
|
|
|
floatobject *v;
|
1992-01-27 02:16:35 +08:00
|
|
|
floatobject *w;
|
1990-10-14 20:07:46 +08:00
|
|
|
{
|
1992-01-27 02:16:35 +08:00
|
|
|
return newfloatobject(v->ob_fval + w->ob_fval);
|
1990-10-14 20:07:46 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_sub(v, w)
|
|
|
|
floatobject *v;
|
1992-01-27 02:16:35 +08:00
|
|
|
floatobject *w;
|
1990-10-14 20:07:46 +08:00
|
|
|
{
|
1992-01-27 02:16:35 +08:00
|
|
|
return newfloatobject(v->ob_fval - w->ob_fval);
|
1990-10-14 20:07:46 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_mul(v, w)
|
|
|
|
floatobject *v;
|
1992-01-27 02:16:35 +08:00
|
|
|
floatobject *w;
|
1990-10-14 20:07:46 +08:00
|
|
|
{
|
1992-01-27 02:16:35 +08:00
|
|
|
return newfloatobject(v->ob_fval * w->ob_fval);
|
1990-10-14 20:07:46 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_div(v, w)
|
|
|
|
floatobject *v;
|
1992-01-27 02:16:35 +08:00
|
|
|
floatobject *w;
|
1990-10-14 20:07:46 +08:00
|
|
|
{
|
1992-01-27 02:16:35 +08:00
|
|
|
if (w->ob_fval == 0) {
|
1991-12-10 21:56:55 +08:00
|
|
|
err_setstr(ZeroDivisionError, "float division");
|
1990-10-14 20:07:46 +08:00
|
|
|
return NULL;
|
|
|
|
}
|
1992-01-27 02:16:35 +08:00
|
|
|
return newfloatobject(v->ob_fval / w->ob_fval);
|
1990-10-14 20:07:46 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_rem(v, w)
|
|
|
|
floatobject *v;
|
1992-01-27 02:16:35 +08:00
|
|
|
floatobject *w;
|
1990-10-14 20:07:46 +08:00
|
|
|
{
|
1992-01-27 02:16:35 +08:00
|
|
|
double vx, wx;
|
1992-03-28 01:28:44 +08:00
|
|
|
double /* div, */ mod;
|
1992-01-27 02:16:35 +08:00
|
|
|
wx = w->ob_fval;
|
1990-10-14 20:07:46 +08:00
|
|
|
if (wx == 0.0) {
|
1992-01-27 02:16:35 +08:00
|
|
|
err_setstr(ZeroDivisionError, "float modulo");
|
1990-10-14 20:07:46 +08:00
|
|
|
return NULL;
|
|
|
|
}
|
1992-01-27 02:16:35 +08:00
|
|
|
vx = v->ob_fval;
|
|
|
|
mod = fmod(vx, wx);
|
1992-03-28 01:28:44 +08:00
|
|
|
/* div = (vx - mod) / wx; */
|
1992-01-27 02:16:35 +08:00
|
|
|
if (wx*mod < 0) {
|
|
|
|
mod += wx;
|
1992-03-28 01:28:44 +08:00
|
|
|
/* div -= 1.0; */
|
1992-01-27 02:16:35 +08:00
|
|
|
}
|
|
|
|
return newfloatobject(mod);
|
1990-10-14 20:07:46 +08:00
|
|
|
}
|
|
|
|
|
1991-05-06 05:07:00 +09:00
|
|
|
static object *
|
|
|
|
float_divmod(v, w)
|
|
|
|
floatobject *v;
|
1992-01-27 02:16:35 +08:00
|
|
|
floatobject *w;
|
1991-05-06 05:07:00 +09:00
|
|
|
{
|
1991-10-21 04:16:45 +08:00
|
|
|
double vx, wx;
|
|
|
|
double div, mod;
|
|
|
|
object *t;
|
1992-01-27 02:16:35 +08:00
|
|
|
wx = w->ob_fval;
|
1991-10-21 04:16:45 +08:00
|
|
|
if (wx == 0.0) {
|
1991-12-10 21:56:55 +08:00
|
|
|
err_setstr(ZeroDivisionError, "float divmod()");
|
1991-10-21 04:16:45 +08:00
|
|
|
return NULL;
|
|
|
|
}
|
|
|
|
vx = v->ob_fval;
|
|
|
|
mod = fmod(vx, wx);
|
|
|
|
div = (vx - mod) / wx;
|
|
|
|
if (wx*mod < 0) {
|
|
|
|
mod += wx;
|
|
|
|
div -= 1.0;
|
|
|
|
}
|
1993-03-16 20:15:04 +08:00
|
|
|
return mkvalue("(dd)", div, mod);
|
1991-05-06 05:07:00 +09:00
|
|
|
}
|
|
|
|
|
1990-10-14 20:07:46 +08:00
|
|
|
static object *
|
|
|
|
float_pow(v, w)
|
|
|
|
floatobject *v;
|
1992-01-27 02:16:35 +08:00
|
|
|
floatobject *w;
|
1990-10-14 20:07:46 +08:00
|
|
|
{
|
|
|
|
double iv, iw, ix;
|
|
|
|
iv = v->ob_fval;
|
1992-01-27 02:16:35 +08:00
|
|
|
iw = w->ob_fval;
|
1991-05-29 06:57:39 +09:00
|
|
|
/* Sort out special cases here instead of relying on pow() */
|
1990-10-22 06:15:08 +08:00
|
|
|
if (iw == 0.0)
|
1991-05-06 05:07:00 +09:00
|
|
|
return newfloatobject(1.0); /* x**0 is 1, even 0**0 */
|
1991-05-29 06:57:39 +09:00
|
|
|
if (iv == 0.0) {
|
|
|
|
if (iw < 0.0) {
|
1991-12-10 21:56:55 +08:00
|
|
|
err_setstr(ValueError, "0.0 to the negative power");
|
1991-05-29 06:57:39 +09:00
|
|
|
return NULL;
|
|
|
|
}
|
|
|
|
return newfloatobject(0.0);
|
|
|
|
}
|
|
|
|
if (iv < 0.0) {
|
1991-12-10 21:56:55 +08:00
|
|
|
err_setstr(ValueError, "negative float to float power");
|
1991-05-29 06:57:39 +09:00
|
|
|
return NULL;
|
|
|
|
}
|
1990-10-14 20:07:46 +08:00
|
|
|
errno = 0;
|
|
|
|
ix = pow(iv, iw);
|
1991-12-16 23:43:14 +08:00
|
|
|
CHECK(ix);
|
1990-10-22 06:15:08 +08:00
|
|
|
if (errno != 0) {
|
|
|
|
/* XXX could it be another type of error? */
|
|
|
|
err_errno(OverflowError);
|
1990-10-14 20:07:46 +08:00
|
|
|
return NULL;
|
1990-10-22 06:15:08 +08:00
|
|
|
}
|
|
|
|
return newfloatobject(ix);
|
1990-10-14 20:07:46 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_neg(v)
|
|
|
|
floatobject *v;
|
|
|
|
{
|
|
|
|
return newfloatobject(-v->ob_fval);
|
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_pos(v)
|
|
|
|
floatobject *v;
|
|
|
|
{
|
1991-05-06 05:07:00 +09:00
|
|
|
INCREF(v);
|
|
|
|
return (object *)v;
|
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_abs(v)
|
|
|
|
floatobject *v;
|
|
|
|
{
|
|
|
|
if (v->ob_fval < 0)
|
|
|
|
return float_neg(v);
|
|
|
|
else
|
|
|
|
return float_pos(v);
|
1990-10-14 20:07:46 +08:00
|
|
|
}
|
|
|
|
|
1991-05-14 20:57:01 +09:00
|
|
|
static int
|
|
|
|
float_nonzero(v)
|
|
|
|
floatobject *v;
|
|
|
|
{
|
|
|
|
return v->ob_fval != 0.0;
|
|
|
|
}
|
|
|
|
|
1993-06-17 20:35:49 +08:00
|
|
|
static int
|
1992-08-14 20:06:52 +08:00
|
|
|
float_coerce(pv, pw)
|
|
|
|
object **pv;
|
|
|
|
object **pw;
|
|
|
|
{
|
|
|
|
if (is_intobject(*pw)) {
|
|
|
|
long x = getintvalue(*pw);
|
|
|
|
*pw = newfloatobject((double)x);
|
|
|
|
INCREF(*pv);
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
else if (is_longobject(*pw)) {
|
|
|
|
*pw = newfloatobject(dgetlongvalue(*pw));
|
|
|
|
INCREF(*pv);
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
return 1; /* Can't do it */
|
|
|
|
}
|
|
|
|
|
1992-09-12 19:09:23 +08:00
|
|
|
static object *
|
|
|
|
float_int(v)
|
|
|
|
object *v;
|
|
|
|
{
|
|
|
|
double x = getfloatvalue(v);
|
|
|
|
/* XXX should check for overflow */
|
|
|
|
/* XXX should define how we round */
|
|
|
|
return newintobject((long)x);
|
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_long(v)
|
|
|
|
object *v;
|
|
|
|
{
|
|
|
|
double x = getfloatvalue(v);
|
|
|
|
return dnewlongobject(x);
|
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_float(v)
|
|
|
|
object *v;
|
|
|
|
{
|
|
|
|
INCREF(v);
|
|
|
|
return v;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
1990-10-14 20:07:46 +08:00
|
|
|
static number_methods float_as_number = {
|
1991-05-06 05:07:00 +09:00
|
|
|
float_add, /*nb_add*/
|
|
|
|
float_sub, /*nb_subtract*/
|
|
|
|
float_mul, /*nb_multiply*/
|
|
|
|
float_div, /*nb_divide*/
|
|
|
|
float_rem, /*nb_remainder*/
|
|
|
|
float_divmod, /*nb_divmod*/
|
|
|
|
float_pow, /*nb_power*/
|
|
|
|
float_neg, /*nb_negative*/
|
|
|
|
float_pos, /*nb_positive*/
|
|
|
|
float_abs, /*nb_absolute*/
|
1991-05-14 20:57:01 +09:00
|
|
|
float_nonzero, /*nb_nonzero*/
|
1991-10-24 22:55:28 +08:00
|
|
|
0, /*nb_invert*/
|
|
|
|
0, /*nb_lshift*/
|
|
|
|
0, /*nb_rshift*/
|
|
|
|
0, /*nb_and*/
|
|
|
|
0, /*nb_xor*/
|
|
|
|
0, /*nb_or*/
|
1992-08-14 20:06:52 +08:00
|
|
|
float_coerce, /*nb_coerce*/
|
1992-09-12 19:09:23 +08:00
|
|
|
float_int, /*nb_int*/
|
|
|
|
float_long, /*nb_long*/
|
|
|
|
float_float, /*nb_float*/
|
|
|
|
0, /*nb_oct*/
|
|
|
|
0, /*nb_hex*/
|
1990-10-14 20:07:46 +08:00
|
|
|
};
|
|
|
|
|
|
|
|
typeobject Floattype = {
|
|
|
|
OB_HEAD_INIT(&Typetype)
|
|
|
|
0,
|
|
|
|
"float",
|
|
|
|
sizeof(floatobject),
|
|
|
|
0,
|
1992-03-28 01:28:44 +08:00
|
|
|
float_dealloc, /*tp_dealloc*/
|
1990-10-14 20:07:46 +08:00
|
|
|
float_print, /*tp_print*/
|
|
|
|
0, /*tp_getattr*/
|
|
|
|
0, /*tp_setattr*/
|
|
|
|
float_compare, /*tp_compare*/
|
|
|
|
float_repr, /*tp_repr*/
|
|
|
|
&float_as_number, /*tp_as_number*/
|
|
|
|
0, /*tp_as_sequence*/
|
|
|
|
0, /*tp_as_mapping*/
|
1993-03-29 18:43:31 +08:00
|
|
|
float_hash, /*tp_hash */
|
1990-10-14 20:07:46 +08:00
|
|
|
};
|