1991-02-19 12:39:46 +00:00
|
|
|
/***********************************************************
|
1992-04-05 14:26:55 +00:00
|
|
|
Copyright 1991, 1992 by Stichting Mathematisch Centrum, Amsterdam, The
|
1991-02-19 12:39:46 +00:00
|
|
|
Netherlands.
|
|
|
|
|
|
|
|
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 12:07:46 +00:00
|
|
|
/* Float object implementation */
|
|
|
|
|
1990-10-21 22:15:08 +00: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 15:06:42 +00:00
|
|
|
#include "allobjects.h"
|
1990-10-14 12:07:46 +00:00
|
|
|
|
1990-12-20 23:06:26 +00:00
|
|
|
#include <errno.h>
|
|
|
|
#ifndef errno
|
|
|
|
extern int errno;
|
|
|
|
#endif
|
|
|
|
|
1990-12-20 15:06:42 +00:00
|
|
|
#include <ctype.h>
|
|
|
|
#include <math.h>
|
1990-10-14 12:07:46 +00:00
|
|
|
|
1991-12-16 15:43:14 +00: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-02 17:50:43 +00:00
|
|
|
#ifndef THINK_C
|
|
|
|
extern double fmod PROTO((double, double));
|
|
|
|
extern double pow PROTO((double, double));
|
|
|
|
#endif
|
|
|
|
|
1990-10-14 12:07:46 +00:00
|
|
|
object *
|
|
|
|
newfloatobject(fval)
|
|
|
|
double fval;
|
|
|
|
{
|
|
|
|
/* For efficiency, this code is copied from newobject() */
|
|
|
|
register floatobject *op = (floatobject *) malloc(sizeof(floatobject));
|
1990-10-21 22:15:08 +00:00
|
|
|
if (op == NULL)
|
|
|
|
return err_nomem();
|
|
|
|
NEWREF(op);
|
|
|
|
op->ob_type = &Floattype;
|
|
|
|
op->ob_fval = fval;
|
1990-10-14 12:07:46 +00:00
|
|
|
return (object *) op;
|
|
|
|
}
|
|
|
|
|
1992-03-27 17:28:44 +00:00
|
|
|
void
|
|
|
|
float_dealloc(op)
|
|
|
|
object *op;
|
|
|
|
{
|
|
|
|
DEL(op);
|
|
|
|
}
|
|
|
|
|
1990-10-14 12:07:46 +00:00
|
|
|
double
|
|
|
|
getfloatvalue(op)
|
|
|
|
object *op;
|
|
|
|
{
|
|
|
|
if (!is_floatobject(op)) {
|
1990-10-21 22:15:08 +00:00
|
|
|
err_badarg();
|
1990-10-14 12:07:46 +00:00
|
|
|
return -1;
|
|
|
|
}
|
|
|
|
else
|
|
|
|
return ((floatobject *)op) -> ob_fval;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* Methods */
|
|
|
|
|
1991-06-04 19:42:53 +00:00
|
|
|
void
|
1990-10-14 12:07:46 +00: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-27 17:28:44 +00:00
|
|
|
/* ARGSUSED */
|
1991-06-07 16:10:43 +00:00
|
|
|
static int
|
1990-10-14 12:07:46 +00:00
|
|
|
float_print(v, fp, flags)
|
|
|
|
floatobject *v;
|
|
|
|
FILE *fp;
|
1992-03-27 17:28:44 +00:00
|
|
|
int flags; /* Not used but required by interface */
|
1990-10-14 12:07:46 +00:00
|
|
|
{
|
|
|
|
char buf[100];
|
|
|
|
float_buf_repr(buf, v);
|
|
|
|
fputs(buf, fp);
|
1991-06-07 16:10:43 +00:00
|
|
|
return 0;
|
1990-10-14 12:07:46 +00: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;
|
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_add(v, w)
|
|
|
|
floatobject *v;
|
1992-01-26 18:16:35 +00:00
|
|
|
floatobject *w;
|
1990-10-14 12:07:46 +00:00
|
|
|
{
|
1992-01-26 18:16:35 +00:00
|
|
|
return newfloatobject(v->ob_fval + w->ob_fval);
|
1990-10-14 12:07:46 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_sub(v, w)
|
|
|
|
floatobject *v;
|
1992-01-26 18:16:35 +00:00
|
|
|
floatobject *w;
|
1990-10-14 12:07:46 +00:00
|
|
|
{
|
1992-01-26 18:16:35 +00:00
|
|
|
return newfloatobject(v->ob_fval - w->ob_fval);
|
1990-10-14 12:07:46 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_mul(v, w)
|
|
|
|
floatobject *v;
|
1992-01-26 18:16:35 +00:00
|
|
|
floatobject *w;
|
1990-10-14 12:07:46 +00:00
|
|
|
{
|
1992-01-26 18:16:35 +00:00
|
|
|
return newfloatobject(v->ob_fval * w->ob_fval);
|
1990-10-14 12:07:46 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_div(v, w)
|
|
|
|
floatobject *v;
|
1992-01-26 18:16:35 +00:00
|
|
|
floatobject *w;
|
1990-10-14 12:07:46 +00:00
|
|
|
{
|
1992-01-26 18:16:35 +00:00
|
|
|
if (w->ob_fval == 0) {
|
1991-12-10 13:56:55 +00:00
|
|
|
err_setstr(ZeroDivisionError, "float division");
|
1990-10-14 12:07:46 +00:00
|
|
|
return NULL;
|
|
|
|
}
|
1992-01-26 18:16:35 +00:00
|
|
|
return newfloatobject(v->ob_fval / w->ob_fval);
|
1990-10-14 12:07:46 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_rem(v, w)
|
|
|
|
floatobject *v;
|
1992-01-26 18:16:35 +00:00
|
|
|
floatobject *w;
|
1990-10-14 12:07:46 +00:00
|
|
|
{
|
1992-01-26 18:16:35 +00:00
|
|
|
double vx, wx;
|
1992-03-27 17:28:44 +00:00
|
|
|
double /* div, */ mod;
|
1992-01-26 18:16:35 +00:00
|
|
|
wx = w->ob_fval;
|
1990-10-14 12:07:46 +00:00
|
|
|
if (wx == 0.0) {
|
1992-01-26 18:16:35 +00:00
|
|
|
err_setstr(ZeroDivisionError, "float modulo");
|
1990-10-14 12:07:46 +00:00
|
|
|
return NULL;
|
|
|
|
}
|
1992-01-26 18:16:35 +00:00
|
|
|
vx = v->ob_fval;
|
|
|
|
mod = fmod(vx, wx);
|
1992-03-27 17:28:44 +00:00
|
|
|
/* div = (vx - mod) / wx; */
|
1992-01-26 18:16:35 +00:00
|
|
|
if (wx*mod < 0) {
|
|
|
|
mod += wx;
|
1992-03-27 17:28:44 +00:00
|
|
|
/* div -= 1.0; */
|
1992-01-26 18:16:35 +00:00
|
|
|
}
|
|
|
|
return newfloatobject(mod);
|
1990-10-14 12:07:46 +00:00
|
|
|
}
|
|
|
|
|
1991-05-05 20:07:00 +00:00
|
|
|
static object *
|
|
|
|
float_divmod(v, w)
|
|
|
|
floatobject *v;
|
1992-01-26 18:16:35 +00:00
|
|
|
floatobject *w;
|
1991-05-05 20:07:00 +00:00
|
|
|
{
|
1991-10-20 20:16:45 +00:00
|
|
|
double vx, wx;
|
|
|
|
double div, mod;
|
|
|
|
object *t;
|
1992-01-26 18:16:35 +00:00
|
|
|
wx = w->ob_fval;
|
1991-10-20 20:16:45 +00:00
|
|
|
if (wx == 0.0) {
|
1991-12-10 13:56:55 +00:00
|
|
|
err_setstr(ZeroDivisionError, "float divmod()");
|
1991-10-20 20:16:45 +00:00
|
|
|
return NULL;
|
|
|
|
}
|
|
|
|
vx = v->ob_fval;
|
|
|
|
mod = fmod(vx, wx);
|
|
|
|
div = (vx - mod) / wx;
|
|
|
|
if (wx*mod < 0) {
|
|
|
|
mod += wx;
|
|
|
|
div -= 1.0;
|
|
|
|
}
|
|
|
|
t = newtupleobject(2);
|
|
|
|
if (t != NULL) {
|
|
|
|
settupleitem(t, 0, newfloatobject(div));
|
|
|
|
settupleitem(t, 1, newfloatobject(mod));
|
|
|
|
if (err_occurred()) {
|
|
|
|
DECREF(t);
|
|
|
|
t = NULL;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return t;
|
1991-05-05 20:07:00 +00:00
|
|
|
}
|
|
|
|
|
1990-10-14 12:07:46 +00:00
|
|
|
static object *
|
|
|
|
float_pow(v, w)
|
|
|
|
floatobject *v;
|
1992-01-26 18:16:35 +00:00
|
|
|
floatobject *w;
|
1990-10-14 12:07:46 +00:00
|
|
|
{
|
|
|
|
double iv, iw, ix;
|
|
|
|
iv = v->ob_fval;
|
1992-01-26 18:16:35 +00:00
|
|
|
iw = w->ob_fval;
|
1991-05-28 21:57:39 +00:00
|
|
|
/* Sort out special cases here instead of relying on pow() */
|
1990-10-21 22:15:08 +00:00
|
|
|
if (iw == 0.0)
|
1991-05-05 20:07:00 +00:00
|
|
|
return newfloatobject(1.0); /* x**0 is 1, even 0**0 */
|
1991-05-28 21:57:39 +00:00
|
|
|
if (iv == 0.0) {
|
|
|
|
if (iw < 0.0) {
|
1991-12-10 13:56:55 +00:00
|
|
|
err_setstr(ValueError, "0.0 to the negative power");
|
1991-05-28 21:57:39 +00:00
|
|
|
return NULL;
|
|
|
|
}
|
|
|
|
return newfloatobject(0.0);
|
|
|
|
}
|
|
|
|
if (iv < 0.0) {
|
1991-12-10 13:56:55 +00:00
|
|
|
err_setstr(ValueError, "negative float to float power");
|
1991-05-28 21:57:39 +00:00
|
|
|
return NULL;
|
|
|
|
}
|
1990-10-14 12:07:46 +00:00
|
|
|
errno = 0;
|
|
|
|
ix = pow(iv, iw);
|
1991-12-16 15:43:14 +00:00
|
|
|
CHECK(ix);
|
1990-10-21 22:15:08 +00:00
|
|
|
if (errno != 0) {
|
|
|
|
/* XXX could it be another type of error? */
|
|
|
|
err_errno(OverflowError);
|
1990-10-14 12:07:46 +00:00
|
|
|
return NULL;
|
1990-10-21 22:15:08 +00:00
|
|
|
}
|
|
|
|
return newfloatobject(ix);
|
1990-10-14 12:07:46 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_neg(v)
|
|
|
|
floatobject *v;
|
|
|
|
{
|
|
|
|
return newfloatobject(-v->ob_fval);
|
|
|
|
}
|
|
|
|
|
|
|
|
static object *
|
|
|
|
float_pos(v)
|
|
|
|
floatobject *v;
|
|
|
|
{
|
1991-05-05 20:07:00 +00: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 12:07:46 +00:00
|
|
|
}
|
|
|
|
|
1991-05-14 11:57:01 +00:00
|
|
|
static int
|
|
|
|
float_nonzero(v)
|
|
|
|
floatobject *v;
|
|
|
|
{
|
|
|
|
return v->ob_fval != 0.0;
|
|
|
|
}
|
|
|
|
|
1992-08-14 12:06:52 +00:00
|
|
|
int
|
|
|
|
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 11:09:23 +00: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 12:07:46 +00:00
|
|
|
static number_methods float_as_number = {
|
1991-05-05 20:07:00 +00: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 11:57:01 +00:00
|
|
|
float_nonzero, /*nb_nonzero*/
|
1991-10-24 14:55:28 +00:00
|
|
|
0, /*nb_invert*/
|
|
|
|
0, /*nb_lshift*/
|
|
|
|
0, /*nb_rshift*/
|
|
|
|
0, /*nb_and*/
|
|
|
|
0, /*nb_xor*/
|
|
|
|
0, /*nb_or*/
|
1992-08-14 12:06:52 +00:00
|
|
|
float_coerce, /*nb_coerce*/
|
1992-09-12 11:09:23 +00:00
|
|
|
float_int, /*nb_int*/
|
|
|
|
float_long, /*nb_long*/
|
|
|
|
float_float, /*nb_float*/
|
|
|
|
0, /*nb_oct*/
|
|
|
|
0, /*nb_hex*/
|
1990-10-14 12:07:46 +00:00
|
|
|
};
|
|
|
|
|
|
|
|
typeobject Floattype = {
|
|
|
|
OB_HEAD_INIT(&Typetype)
|
|
|
|
0,
|
|
|
|
"float",
|
|
|
|
sizeof(floatobject),
|
|
|
|
0,
|
1992-03-27 17:28:44 +00:00
|
|
|
float_dealloc, /*tp_dealloc*/
|
1990-10-14 12:07:46 +00: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*/
|
|
|
|
};
|