1478 lines
26 KiB
C
1478 lines
26 KiB
C
/*
|
|
* Copyright (c) 2001 by The XFree86 Project, Inc.
|
|
*
|
|
* Permission is hereby granted, free of charge, to any person obtaining a
|
|
* copy of this software and associated documentation files (the "Software"),
|
|
* to deal in the Software without restriction, including without limitation
|
|
* the rights to use, copy, modify, merge, publish, distribute, sublicense,
|
|
* and/or sell copies of the Software, and to permit persons to whom the
|
|
* Software is furnished to do so, subject to the following conditions:
|
|
*
|
|
* The above copyright notice and this permission notice shall be included in
|
|
* all copies or substantial portions of the Software.
|
|
*
|
|
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
|
* THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
|
|
* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
|
|
* OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
|
* SOFTWARE.
|
|
*
|
|
* Except as contained in this notice, the name of the XFree86 Project shall
|
|
* not be used in advertising or otherwise to promote the sale, use or other
|
|
* dealings in this Software without prior written authorization from the
|
|
* XFree86 Project.
|
|
*
|
|
* Author: Paulo César Pereira de Andrade
|
|
*/
|
|
|
|
/* $XFree86: xc/programs/xedit/lisp/math.c,v 1.23tsi Exp $ */
|
|
|
|
#include "lisp/math.h"
|
|
#include "lisp/private.h"
|
|
|
|
#ifdef __UNIXOS2__
|
|
# define finite(x) isfinite(x)
|
|
#endif
|
|
|
|
/*
|
|
* Prototypes
|
|
*/
|
|
static LispObj *LispDivide(LispBuiltin*, int, int);
|
|
|
|
/*
|
|
* Initialization
|
|
*/
|
|
static LispObj *obj_zero, *obj_one;
|
|
LispObj *Ocomplex, *Oequal_;
|
|
|
|
LispObj *Oshort_float, *Osingle_float, *Odouble_float, *Olong_float;
|
|
|
|
Atom_id Sdefault_float_format;
|
|
|
|
/*
|
|
* Implementation
|
|
*/
|
|
#include "lisp/mathimp.c"
|
|
|
|
void
|
|
LispMathInit(void)
|
|
{
|
|
LispObj *object, *result;
|
|
|
|
mp_set_malloc(LispMalloc);
|
|
mp_set_calloc(LispCalloc);
|
|
mp_set_realloc(LispRealloc);
|
|
mp_set_free(LispFree);
|
|
|
|
number_init();
|
|
obj_zero = FIXNUM(0);
|
|
obj_one = FIXNUM(1);
|
|
|
|
Oequal_ = STATIC_ATOM("=");
|
|
Ocomplex = STATIC_ATOM(Scomplex->value);
|
|
Oshort_float = STATIC_ATOM("SHORT-FLOAT");
|
|
LispExportSymbol(Oshort_float);
|
|
Osingle_float = STATIC_ATOM("SINGLE-FLOAT");
|
|
LispExportSymbol(Osingle_float);
|
|
Odouble_float = STATIC_ATOM("DOUBLE-FLOAT");
|
|
LispExportSymbol(Odouble_float);
|
|
Olong_float = STATIC_ATOM("LONG-FLOAT");
|
|
LispExportSymbol(Olong_float);
|
|
|
|
object = STATIC_ATOM("*DEFAULT-FLOAT-FORMAT*");
|
|
LispProclaimSpecial(object, Odouble_float, NIL);
|
|
LispExportSymbol(object);
|
|
Sdefault_float_format = ATOMID(object);
|
|
|
|
object = STATIC_ATOM("PI");
|
|
result = number_pi();
|
|
LispProclaimSpecial(object, result, NIL);
|
|
LispExportSymbol(object);
|
|
|
|
object = STATIC_ATOM("MOST-POSITIVE-FIXNUM");
|
|
LispDefconstant(object, FIXNUM(MOST_POSITIVE_FIXNUM), NIL);
|
|
LispExportSymbol(object);
|
|
|
|
object = STATIC_ATOM("MOST-NEGATIVE-FIXNUM");
|
|
LispDefconstant(object, FIXNUM(MOST_NEGATIVE_FIXNUM), NIL);
|
|
LispExportSymbol(object);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Mul(LispBuiltin *builtin)
|
|
/*
|
|
* &rest numbers
|
|
*/
|
|
{
|
|
n_number num;
|
|
LispObj *number, *numbers;
|
|
|
|
numbers = ARGUMENT(0);
|
|
|
|
if (CONSP(numbers)) {
|
|
number = CAR(numbers);
|
|
|
|
numbers = CDR(numbers);
|
|
if (!CONSP(numbers)) {
|
|
CHECK_NUMBER(number);
|
|
return (number);
|
|
}
|
|
}
|
|
else
|
|
return (FIXNUM(1));
|
|
|
|
set_number_object(&num, number);
|
|
do {
|
|
mul_number_object(&num, CAR(numbers));
|
|
numbers = CDR(numbers);
|
|
} while (CONSP(numbers));
|
|
|
|
return (make_number_object(&num));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Plus(LispBuiltin *builtin)
|
|
/*
|
|
+ &rest numbers
|
|
*/
|
|
{
|
|
n_number num;
|
|
LispObj *number, *numbers;
|
|
|
|
numbers = ARGUMENT(0);
|
|
|
|
if (CONSP(numbers)) {
|
|
number = CAR(numbers);
|
|
|
|
numbers = CDR(numbers);
|
|
if (!CONSP(numbers)) {
|
|
CHECK_NUMBER(number);
|
|
return (number);
|
|
}
|
|
}
|
|
else
|
|
return (FIXNUM(0));
|
|
|
|
set_number_object(&num, number);
|
|
do {
|
|
add_number_object(&num, CAR(numbers));
|
|
numbers = CDR(numbers);
|
|
} while (CONSP(numbers));
|
|
|
|
return (make_number_object(&num));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Minus(LispBuiltin *builtin)
|
|
/*
|
|
- number &rest more_numbers
|
|
*/
|
|
{
|
|
n_number num;
|
|
LispObj *number, *more_numbers;
|
|
|
|
more_numbers = ARGUMENT(1);
|
|
number = ARGUMENT(0);
|
|
|
|
set_number_object(&num, number);
|
|
if (!CONSP(more_numbers)) {
|
|
neg_number(&num);
|
|
|
|
return (make_number_object(&num));
|
|
}
|
|
do {
|
|
sub_number_object(&num, CAR(more_numbers));
|
|
more_numbers = CDR(more_numbers);
|
|
} while (CONSP(more_numbers));
|
|
|
|
return (make_number_object(&num));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Div(LispBuiltin *builtin)
|
|
/*
|
|
/ number &rest more_numbers
|
|
*/
|
|
{
|
|
n_number num;
|
|
LispObj *number, *more_numbers;
|
|
|
|
more_numbers = ARGUMENT(1);
|
|
number = ARGUMENT(0);
|
|
|
|
if (CONSP(more_numbers))
|
|
set_number_object(&num, number);
|
|
else {
|
|
num.complex = 0;
|
|
num.real.type = N_FIXNUM;
|
|
num.real.data.fixnum = 1;
|
|
goto div_one_argument;
|
|
}
|
|
|
|
for (;;) {
|
|
number = CAR(more_numbers);
|
|
more_numbers = CDR(more_numbers);
|
|
|
|
div_one_argument:
|
|
div_number_object(&num, number);
|
|
if (!CONSP(more_numbers))
|
|
break;
|
|
}
|
|
|
|
return (make_number_object(&num));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_OnePlus(LispBuiltin *builtin)
|
|
/*
|
|
1+ number
|
|
*/
|
|
{
|
|
n_number num;
|
|
LispObj *number;
|
|
|
|
number = ARGUMENT(0);
|
|
num.complex = 0;
|
|
num.real.type = N_FIXNUM;
|
|
num.real.data.fixnum = 1;
|
|
add_number_object(&num, number);
|
|
|
|
return (make_number_object(&num));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_OneMinus(LispBuiltin *builtin)
|
|
/*
|
|
1- number
|
|
*/
|
|
{
|
|
n_number num;
|
|
LispObj *number;
|
|
|
|
number = ARGUMENT(0);
|
|
num.complex = 0;
|
|
num.real.type = N_FIXNUM;
|
|
num.real.data.fixnum = -1;
|
|
add_number_object(&num, number);
|
|
|
|
return (make_number_object(&num));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Less(LispBuiltin *builtin)
|
|
/*
|
|
< number &rest more-numbers
|
|
*/
|
|
{
|
|
LispObj *compare, *number, *more_numbers;
|
|
|
|
more_numbers = ARGUMENT(1);
|
|
compare = ARGUMENT(0);
|
|
|
|
if (CONSP(more_numbers)) {
|
|
do {
|
|
number = CAR(more_numbers);
|
|
if (cmp_object_object(compare, number, 1) >= 0)
|
|
return (NIL);
|
|
compare = number;
|
|
more_numbers = CDR(more_numbers);
|
|
} while (CONSP(more_numbers));
|
|
}
|
|
else {
|
|
CHECK_REAL(compare);
|
|
}
|
|
|
|
return (T);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_LessEqual(LispBuiltin *builtin)
|
|
/*
|
|
<= number &rest more-numbers
|
|
*/
|
|
{
|
|
LispObj *compare, *number, *more_numbers;
|
|
|
|
more_numbers = ARGUMENT(1);
|
|
compare = ARGUMENT(0);
|
|
|
|
if (CONSP(more_numbers)) {
|
|
do {
|
|
number = CAR(more_numbers);
|
|
if (cmp_object_object(compare, number, 1) > 0)
|
|
return (NIL);
|
|
compare = number;
|
|
more_numbers = CDR(more_numbers);
|
|
} while (CONSP(more_numbers));
|
|
}
|
|
else {
|
|
CHECK_REAL(compare);
|
|
}
|
|
|
|
return (T);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Equal_(LispBuiltin *builtin)
|
|
/*
|
|
= number &rest more-numbers
|
|
*/
|
|
{
|
|
LispObj *compare, *number, *more_numbers;
|
|
|
|
more_numbers = ARGUMENT(1);
|
|
compare = ARGUMENT(0);
|
|
|
|
if (CONSP(more_numbers)) {
|
|
do {
|
|
number = CAR(more_numbers);
|
|
if (cmp_object_object(compare, number, 0) != 0)
|
|
return (NIL);
|
|
compare = number;
|
|
more_numbers = CDR(more_numbers);
|
|
} while (CONSP(more_numbers));
|
|
}
|
|
else {
|
|
CHECK_REAL(compare);
|
|
}
|
|
|
|
return (T);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Greater(LispBuiltin *builtin)
|
|
/*
|
|
> number &rest more-numbers
|
|
*/
|
|
{
|
|
LispObj *compare, *number, *more_numbers;
|
|
|
|
more_numbers = ARGUMENT(1);
|
|
compare = ARGUMENT(0);
|
|
|
|
if (CONSP(more_numbers)) {
|
|
do {
|
|
number = CAR(more_numbers);
|
|
if (cmp_object_object(compare, number, 1) <= 0)
|
|
return (NIL);
|
|
compare = number;
|
|
more_numbers = CDR(more_numbers);
|
|
} while (CONSP(more_numbers));
|
|
}
|
|
else {
|
|
CHECK_REAL(compare);
|
|
}
|
|
|
|
return (T);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_GreaterEqual(LispBuiltin *builtin)
|
|
/*
|
|
>= number &rest more-numbers
|
|
*/
|
|
{
|
|
LispObj *compare, *number, *more_numbers;
|
|
|
|
more_numbers = ARGUMENT(1);
|
|
compare = ARGUMENT(0);
|
|
|
|
if (CONSP(more_numbers)) {
|
|
do {
|
|
number = CAR(more_numbers);
|
|
if (cmp_object_object(compare, number, 1) < 0)
|
|
return (NIL);
|
|
compare = number;
|
|
more_numbers = CDR(more_numbers);
|
|
} while (CONSP(more_numbers));
|
|
}
|
|
else {
|
|
CHECK_REAL(compare);
|
|
}
|
|
|
|
return (T);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_NotEqual(LispBuiltin *builtin)
|
|
/*
|
|
/= number &rest more-numbers
|
|
*/
|
|
{
|
|
LispObj *object, *compare, *number, *more_numbers;
|
|
|
|
more_numbers = ARGUMENT(1);
|
|
number = ARGUMENT(0);
|
|
|
|
if (!CONSP(more_numbers)) {
|
|
CHECK_REAL(number);
|
|
|
|
return (T);
|
|
}
|
|
|
|
/* compare all numbers */
|
|
while (1) {
|
|
compare = number;
|
|
for (object = more_numbers; CONSP(object); object = CDR(object)) {
|
|
number = CAR(object);
|
|
|
|
if (cmp_object_object(compare, number, 0) == 0)
|
|
return (NIL);
|
|
}
|
|
if (CONSP(more_numbers)) {
|
|
number = CAR(more_numbers);
|
|
more_numbers = CDR(more_numbers);
|
|
}
|
|
else
|
|
break;
|
|
}
|
|
|
|
return (T);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Min(LispBuiltin *builtin)
|
|
/*
|
|
min number &rest more-numbers
|
|
*/
|
|
{
|
|
LispObj *result, *number, *more_numbers;
|
|
|
|
more_numbers = ARGUMENT(1);
|
|
result = ARGUMENT(0);
|
|
|
|
if (CONSP(more_numbers)) {
|
|
do {
|
|
number = CAR(more_numbers);
|
|
if (cmp_object_object(result, number, 1) > 0)
|
|
result = number;
|
|
more_numbers = CDR(more_numbers);
|
|
} while (CONSP(more_numbers));
|
|
}
|
|
else {
|
|
CHECK_REAL(result);
|
|
}
|
|
|
|
return (result);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Max(LispBuiltin *builtin)
|
|
/*
|
|
max number &rest more-numbers
|
|
*/
|
|
{
|
|
LispObj *result, *number, *more_numbers;
|
|
|
|
more_numbers = ARGUMENT(1);
|
|
result = ARGUMENT(0);
|
|
|
|
if (CONSP(more_numbers)) {
|
|
do {
|
|
number = CAR(more_numbers);
|
|
if (cmp_object_object(result, number, 1) < 0)
|
|
result = number;
|
|
more_numbers = CDR(more_numbers);
|
|
} while (CONSP(more_numbers));
|
|
}
|
|
else {
|
|
CHECK_REAL(result);
|
|
}
|
|
|
|
return (result);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Abs(LispBuiltin *builtin)
|
|
/*
|
|
abs number
|
|
*/
|
|
{
|
|
LispObj *result, *number;
|
|
|
|
result = number = ARGUMENT(0);
|
|
|
|
switch (OBJECT_TYPE(number)) {
|
|
case LispFixnum_t:
|
|
case LispInteger_t:
|
|
case LispBignum_t:
|
|
case LispDFloat_t:
|
|
case LispRatio_t:
|
|
case LispBigratio_t:
|
|
if (cmp_real_object(&zero, number) > 0) {
|
|
n_real real;
|
|
|
|
set_real_object(&real, number);
|
|
neg_real(&real);
|
|
result = make_real_object(&real);
|
|
}
|
|
break;
|
|
case LispComplex_t: {
|
|
n_number num;
|
|
|
|
set_number_object(&num, number);
|
|
abs_number(&num);
|
|
result = make_number_object(&num);
|
|
} break;
|
|
default:
|
|
fatal_builtin_object_error(builtin, number, NOT_A_NUMBER);
|
|
break;
|
|
}
|
|
|
|
return (result);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Complex(LispBuiltin *builtin)
|
|
/*
|
|
complex realpart &optional imagpart
|
|
*/
|
|
{
|
|
LispObj *realpart, *imagpart;
|
|
|
|
imagpart = ARGUMENT(1);
|
|
realpart = ARGUMENT(0);
|
|
|
|
CHECK_REAL(realpart);
|
|
|
|
if (imagpart == UNSPEC)
|
|
return (realpart);
|
|
else {
|
|
CHECK_REAL(imagpart);
|
|
}
|
|
if (!FLOATP(imagpart) && cmp_real_object(&zero, imagpart) == 0)
|
|
return (realpart);
|
|
|
|
return (COMPLEX(realpart, imagpart));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Complexp(LispBuiltin *builtin)
|
|
/*
|
|
complexp object
|
|
*/
|
|
{
|
|
LispObj *object;
|
|
|
|
object = ARGUMENT(0);
|
|
|
|
return (COMPLEXP(object) ? T : NIL);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Conjugate(LispBuiltin *builtin)
|
|
/*
|
|
conjugate number
|
|
*/
|
|
{
|
|
n_number num;
|
|
LispObj *number, *realpart, *imagpart;
|
|
|
|
number = ARGUMENT(0);
|
|
|
|
CHECK_NUMBER(number);
|
|
|
|
if (REALP(number))
|
|
return (number);
|
|
|
|
realpart = OCXR(number);
|
|
num.complex = 0;
|
|
num.real.type = N_FIXNUM;
|
|
num.real.data.fixnum = -1;
|
|
mul_number_object(&num, OCXI(number));
|
|
imagpart = make_number_object(&num);
|
|
|
|
return (COMPLEX(realpart, imagpart));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Decf(LispBuiltin *builtin)
|
|
/*
|
|
decf place &optional delta
|
|
*/
|
|
{
|
|
n_number num;
|
|
LispObj *place, *delta, *number;
|
|
|
|
delta = ARGUMENT(1);
|
|
place = ARGUMENT(0);
|
|
|
|
if (SYMBOLP(place)) {
|
|
number = LispGetVar(place);
|
|
if (number == NULL)
|
|
LispDestroy("EVAL: the variable %s is unbound", STROBJ(place));
|
|
}
|
|
else
|
|
number = EVAL(place);
|
|
|
|
if (delta != UNSPEC) {
|
|
LispObj *operand;
|
|
|
|
operand = EVAL(delta);
|
|
set_number_object(&num, number);
|
|
sub_number_object(&num, operand);
|
|
number = make_number_object(&num);
|
|
}
|
|
else {
|
|
num.complex = 0;
|
|
num.real.type = N_FIXNUM;
|
|
num.real.data.fixnum = -1;
|
|
add_number_object(&num, number);
|
|
number = make_number_object(&num);
|
|
}
|
|
|
|
if (SYMBOLP(place)) {
|
|
CHECK_CONSTANT(place);
|
|
LispSetVar(place, number);
|
|
}
|
|
else {
|
|
GC_ENTER();
|
|
|
|
GC_PROTECT(number);
|
|
(void)APPLY2(Osetf, place, number);
|
|
GC_LEAVE();
|
|
}
|
|
|
|
return (number);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Denominator(LispBuiltin *builtin)
|
|
/*
|
|
denominator rational
|
|
*/
|
|
{
|
|
LispObj *result, *rational;
|
|
|
|
rational = ARGUMENT(0);
|
|
|
|
switch (OBJECT_TYPE(rational)) {
|
|
case LispFixnum_t:
|
|
case LispInteger_t:
|
|
case LispBignum_t:
|
|
result = FIXNUM(1);
|
|
break;
|
|
case LispRatio_t:
|
|
result = INTEGER(OFRD(rational));
|
|
break;
|
|
case LispBigratio_t:
|
|
if (mpi_fiti(OBRD(rational)))
|
|
result = INTEGER(mpi_geti(OBRD(rational)));
|
|
else {
|
|
mpi *den = XALLOC(mpi);
|
|
|
|
mpi_init(den);
|
|
mpi_set(den, OBRD(rational));
|
|
result = BIGNUM(den);
|
|
}
|
|
break;
|
|
default:
|
|
LispDestroy("%s: %s is not a rational number",
|
|
STRFUN(builtin), STROBJ(rational));
|
|
/*NOTREACHED*/
|
|
result = NIL;
|
|
}
|
|
|
|
return (result);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Evenp(LispBuiltin *builtin)
|
|
/*
|
|
evenp integer
|
|
*/
|
|
{
|
|
LispObj *result, *integer;
|
|
|
|
integer = ARGUMENT(0);
|
|
|
|
switch (OBJECT_TYPE(integer)) {
|
|
case LispFixnum_t:
|
|
result = FIXNUM_VALUE(integer) % 2 ? NIL : T;
|
|
break;
|
|
case LispInteger_t:
|
|
result = INT_VALUE(integer) % 2 ? NIL : T;
|
|
break;
|
|
case LispBignum_t:
|
|
result = mpi_remi(OBI(integer), 2) ? NIL : T;
|
|
break;
|
|
default:
|
|
fatal_builtin_object_error(builtin, integer, NOT_AN_INTEGER);
|
|
/*NOTREACHED*/
|
|
result = NIL;
|
|
}
|
|
|
|
return (result);
|
|
}
|
|
|
|
/* only one float format */
|
|
LispObj *
|
|
Lisp_Float(LispBuiltin *builtin)
|
|
/*
|
|
float number &optional other
|
|
*/
|
|
{
|
|
LispObj *number, *other;
|
|
|
|
other = ARGUMENT(1);
|
|
number = ARGUMENT(0);
|
|
|
|
if (other != UNSPEC) {
|
|
CHECK_DFLOAT(other);
|
|
}
|
|
|
|
return (LispFloatCoerce(builtin, number));
|
|
}
|
|
|
|
LispObj *
|
|
LispFloatCoerce(LispBuiltin *builtin, LispObj *number)
|
|
{
|
|
double value;
|
|
|
|
switch (OBJECT_TYPE(number)) {
|
|
case LispFixnum_t:
|
|
value = FIXNUM_VALUE(number);
|
|
break;
|
|
case LispInteger_t:
|
|
value = INT_VALUE(number);
|
|
break;
|
|
case LispBignum_t:
|
|
value = mpi_getd(OBI(number));
|
|
break;
|
|
case LispDFloat_t:
|
|
return (number);
|
|
case LispRatio_t:
|
|
value = (double)OFRN(number) / (double)OFRD(number);
|
|
break;
|
|
case LispBigratio_t:
|
|
value = mpr_getd(OBR(number));
|
|
break;
|
|
default:
|
|
value = 0.0;
|
|
fatal_builtin_object_error(builtin, number, NOT_A_REAL_NUMBER);
|
|
break;
|
|
}
|
|
|
|
if (!finite(value))
|
|
fatal_error(FLOATING_POINT_OVERFLOW);
|
|
|
|
return (DFLOAT(value));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Floatp(LispBuiltin *builtin)
|
|
/*
|
|
floatp object
|
|
*/
|
|
{
|
|
LispObj *object;
|
|
|
|
object = ARGUMENT(0);
|
|
|
|
return (FLOATP(object) ? T : NIL);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Gcd(LispBuiltin *builtin)
|
|
/*
|
|
gcd &rest integers
|
|
*/
|
|
{
|
|
n_real real;
|
|
LispObj *integers, *integer, *operand;
|
|
|
|
integers = ARGUMENT(0);
|
|
|
|
if (!CONSP(integers))
|
|
return (FIXNUM(0));
|
|
|
|
integer = CAR(integers);
|
|
|
|
CHECK_INTEGER(integer);
|
|
set_real_object(&real, integer);
|
|
integers = CDR(integers);
|
|
|
|
for (; CONSP(integers); integers = CDR(integers)) {
|
|
operand = CAR(integers);
|
|
gcd_real_object(&real, operand);
|
|
}
|
|
abs_real(&real);
|
|
|
|
return (make_real_object(&real));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Imagpart(LispBuiltin *builtin)
|
|
/*
|
|
imagpart number
|
|
*/
|
|
{
|
|
LispObj *number;
|
|
|
|
number = ARGUMENT(0);
|
|
|
|
if (COMPLEXP(number))
|
|
return (OCXI(number));
|
|
else {
|
|
CHECK_REAL(number);
|
|
}
|
|
|
|
return (FIXNUM(0));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Incf(LispBuiltin *builtin)
|
|
/*
|
|
incf place &optional delta
|
|
*/
|
|
{
|
|
n_number num;
|
|
LispObj *place, *delta, *number;
|
|
|
|
delta = ARGUMENT(1);
|
|
place = ARGUMENT(0);
|
|
|
|
if (SYMBOLP(place)) {
|
|
number = LispGetVar(place);
|
|
if (number == NULL)
|
|
LispDestroy("EVAL: the variable %s is unbound", STROBJ(place));
|
|
}
|
|
else
|
|
number = EVAL(place);
|
|
|
|
if (delta != UNSPEC) {
|
|
LispObj *operand;
|
|
|
|
operand = EVAL(delta);
|
|
set_number_object(&num, number);
|
|
add_number_object(&num, operand);
|
|
number = make_number_object(&num);
|
|
}
|
|
else {
|
|
num.complex = 0;
|
|
num.real.type = N_FIXNUM;
|
|
num.real.data.fixnum = 1;
|
|
add_number_object(&num, number);
|
|
number = make_number_object(&num);
|
|
}
|
|
|
|
if (SYMBOLP(place)) {
|
|
CHECK_CONSTANT(place);
|
|
LispSetVar(place, number);
|
|
}
|
|
else {
|
|
GC_ENTER();
|
|
|
|
GC_PROTECT(number);
|
|
(void)APPLY2(Osetf, place, number);
|
|
GC_LEAVE();
|
|
}
|
|
|
|
return (number);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Integerp(LispBuiltin *builtin)
|
|
/*
|
|
integerp object
|
|
*/
|
|
{
|
|
LispObj *object;
|
|
|
|
object = ARGUMENT(0);
|
|
|
|
return (INTEGERP(object) ? T : NIL);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Isqrt(LispBuiltin *builtin)
|
|
/*
|
|
isqrt natural
|
|
*/
|
|
{
|
|
LispObj *natural, *result;
|
|
|
|
natural = ARGUMENT(0);
|
|
|
|
if (cmp_object_object(natural, obj_zero, 1) < 0)
|
|
goto not_a_natural_number;
|
|
|
|
switch (OBJECT_TYPE(natural)) {
|
|
case LispFixnum_t:
|
|
result = FIXNUM((long)floor(sqrt(FIXNUM_VALUE(natural))));
|
|
break;
|
|
case LispInteger_t:
|
|
result = INTEGER((long)floor(sqrt(INT_VALUE(natural))));
|
|
break;
|
|
case LispBignum_t: {
|
|
mpi *bigi;
|
|
|
|
bigi = XALLOC(mpi);
|
|
mpi_init(bigi);
|
|
mpi_sqrt(bigi, OBI(natural));
|
|
if (mpi_fiti(bigi)) {
|
|
result = INTEGER(mpi_geti(bigi));
|
|
mpi_clear(bigi);
|
|
XFREE(bigi);
|
|
}
|
|
else
|
|
result = BIGNUM(bigi);
|
|
} break;
|
|
default:
|
|
goto not_a_natural_number;
|
|
}
|
|
|
|
return (result);
|
|
|
|
not_a_natural_number:
|
|
LispDestroy("%s: %s is not a natural number",
|
|
STRFUN(builtin), STROBJ(natural));
|
|
/*NOTREACHED*/
|
|
return (NIL);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Lcm(LispBuiltin *builtin)
|
|
/*
|
|
lcm &rest integers
|
|
*/
|
|
{
|
|
n_real real, gcd;
|
|
LispObj *integers, *operand;
|
|
|
|
integers = ARGUMENT(0);
|
|
|
|
if (!CONSP(integers))
|
|
return (FIXNUM(1));
|
|
|
|
operand = CAR(integers);
|
|
|
|
CHECK_INTEGER(operand);
|
|
set_real_object(&real, operand);
|
|
integers = CDR(integers);
|
|
|
|
gcd.type = N_FIXNUM;
|
|
gcd.data.fixnum = 0;
|
|
|
|
for (; CONSP(integers); integers = CDR(integers)) {
|
|
operand = CAR(integers);
|
|
|
|
if (real.type == N_FIXNUM && real.data.fixnum == 0)
|
|
break;
|
|
|
|
/* calculate gcd before changing integer */
|
|
clear_real(&gcd);
|
|
set_real_real(&gcd, &real);
|
|
gcd_real_object(&gcd, operand);
|
|
|
|
/* calculate lcm */
|
|
mul_real_object(&real, operand);
|
|
div_real_real(&real, &gcd);
|
|
}
|
|
clear_real(&gcd);
|
|
abs_real(&real);
|
|
|
|
return (make_real_object(&real));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Logand(LispBuiltin *builtin)
|
|
/*
|
|
logand &rest integers
|
|
*/
|
|
{
|
|
n_real real;
|
|
|
|
LispObj *integers;
|
|
|
|
integers = ARGUMENT(0);
|
|
|
|
real.type = N_FIXNUM;
|
|
real.data.fixnum = -1;
|
|
|
|
for (; CONSP(integers); integers = CDR(integers))
|
|
and_real_object(&real, CAR(integers));
|
|
|
|
return (make_real_object(&real));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Logeqv(LispBuiltin *builtin)
|
|
/*
|
|
logeqv &rest integers
|
|
*/
|
|
{
|
|
n_real real;
|
|
|
|
LispObj *integers;
|
|
|
|
integers = ARGUMENT(0);
|
|
|
|
real.type = N_FIXNUM;
|
|
real.data.fixnum = -1;
|
|
|
|
for (; CONSP(integers); integers = CDR(integers))
|
|
eqv_real_object(&real, CAR(integers));
|
|
|
|
return (make_real_object(&real));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Logior(LispBuiltin *builtin)
|
|
/*
|
|
logior &rest integers
|
|
*/
|
|
{
|
|
n_real real;
|
|
|
|
LispObj *integers;
|
|
|
|
integers = ARGUMENT(0);
|
|
|
|
real.type = N_FIXNUM;
|
|
real.data.fixnum = 0;
|
|
|
|
for (; CONSP(integers); integers = CDR(integers))
|
|
ior_real_object(&real, CAR(integers));
|
|
|
|
return (make_real_object(&real));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Lognot(LispBuiltin *builtin)
|
|
/*
|
|
lognot integer
|
|
*/
|
|
{
|
|
n_real real;
|
|
|
|
LispObj *integer;
|
|
|
|
integer = ARGUMENT(0);
|
|
|
|
CHECK_INTEGER(integer);
|
|
|
|
set_real_object(&real, integer);
|
|
not_real(&real);
|
|
|
|
return (make_real_object(&real));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Logxor(LispBuiltin *builtin)
|
|
/*
|
|
logxor &rest integers
|
|
*/
|
|
{
|
|
n_real real;
|
|
|
|
LispObj *integers;
|
|
|
|
integers = ARGUMENT(0);
|
|
|
|
real.type = N_FIXNUM;
|
|
real.data.fixnum = 0;
|
|
|
|
for (; CONSP(integers); integers = CDR(integers))
|
|
xor_real_object(&real, CAR(integers));
|
|
|
|
return (make_real_object(&real));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Minusp(LispBuiltin *builtin)
|
|
/*
|
|
minusp number
|
|
*/
|
|
{
|
|
LispObj *number;
|
|
|
|
number = ARGUMENT(0);
|
|
|
|
CHECK_REAL(number);
|
|
|
|
return (cmp_real_object(&zero, number) > 0 ? T : NIL);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Mod(LispBuiltin *builtin)
|
|
/*
|
|
mod number divisor
|
|
*/
|
|
{
|
|
LispObj *result;
|
|
|
|
LispObj *number, *divisor;
|
|
|
|
divisor = ARGUMENT(1);
|
|
number = ARGUMENT(0);
|
|
|
|
if (INTEGERP(number) && INTEGERP(divisor)) {
|
|
n_real real;
|
|
|
|
set_real_object(&real, number);
|
|
mod_real_object(&real, divisor);
|
|
result = make_real_object(&real);
|
|
}
|
|
else {
|
|
n_number num;
|
|
|
|
set_number_object(&num, number);
|
|
divide_number_object(&num, divisor, NDIVIDE_FLOOR, 0);
|
|
result = make_real_object(&(num.imag));
|
|
clear_real(&(num.real));
|
|
}
|
|
|
|
return (result);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Numberp(LispBuiltin *builtin)
|
|
/*
|
|
numberp object
|
|
*/
|
|
{
|
|
LispObj *object;
|
|
|
|
object = ARGUMENT(0);
|
|
|
|
return (NUMBERP(object) ? T : NIL);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Numerator(LispBuiltin *builtin)
|
|
/*
|
|
numerator rational
|
|
*/
|
|
{
|
|
LispObj *result, *rational;
|
|
|
|
rational = ARGUMENT(0);
|
|
|
|
switch (OBJECT_TYPE(rational)) {
|
|
case LispFixnum_t:
|
|
case LispInteger_t:
|
|
case LispBignum_t:
|
|
result = rational;
|
|
break;
|
|
case LispRatio_t:
|
|
result = INTEGER(OFRN(rational));
|
|
break;
|
|
case LispBigratio_t:
|
|
if (mpi_fiti(OBRN(rational)))
|
|
result = INTEGER(mpi_geti(OBRN(rational)));
|
|
else {
|
|
mpi *num = XALLOC(mpi);
|
|
|
|
mpi_init(num);
|
|
mpi_set(num, OBRN(rational));
|
|
result = BIGNUM(num);
|
|
}
|
|
break;
|
|
default:
|
|
LispDestroy("%s: %s is not a rational number",
|
|
STRFUN(builtin), STROBJ(rational));
|
|
/*NOTREACHED*/
|
|
result = NIL;
|
|
}
|
|
|
|
return (result);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Oddp(LispBuiltin *builtin)
|
|
/*
|
|
oddp integer
|
|
*/
|
|
{
|
|
LispObj *result, *integer;
|
|
|
|
integer = ARGUMENT(0);
|
|
|
|
switch (OBJECT_TYPE(integer)) {
|
|
case LispFixnum_t:
|
|
result = FIXNUM_VALUE(integer) % 2 ? T : NIL;
|
|
break;
|
|
case LispInteger_t:
|
|
result = INT_VALUE(integer) % 2 ? T : NIL;
|
|
break;
|
|
case LispBignum_t:
|
|
result = mpi_remi(OBI(integer), 2) ? T : NIL;
|
|
break;
|
|
default:
|
|
fatal_builtin_object_error(builtin, integer, NOT_AN_INTEGER);
|
|
/*NOTREACHED*/
|
|
result = NIL;
|
|
}
|
|
|
|
return (result);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Plusp(LispBuiltin *builtin)
|
|
/*
|
|
plusp number
|
|
*/
|
|
{
|
|
LispObj *number;
|
|
|
|
number = ARGUMENT(0);
|
|
|
|
CHECK_REAL(number);
|
|
|
|
return (cmp_real_object(&zero, number) < 0 ? T : NIL);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Rational(LispBuiltin *builtin)
|
|
/*
|
|
rational number
|
|
*/
|
|
{
|
|
LispObj *number;
|
|
|
|
number = ARGUMENT(0);
|
|
|
|
if (DFLOATP(number)) {
|
|
double numerator = ODF(number);
|
|
|
|
if ((long)numerator == numerator)
|
|
number = INTEGER(numerator);
|
|
else {
|
|
n_real real;
|
|
mpr *bigr = XALLOC(mpr);
|
|
|
|
mpr_init(bigr);
|
|
mpr_setd(bigr, numerator);
|
|
real.type = N_BIGRATIO;
|
|
real.data.bigratio = bigr;
|
|
rbr_canonicalize(&real);
|
|
number = make_real_object(&real);
|
|
}
|
|
}
|
|
else {
|
|
CHECK_REAL(number);
|
|
}
|
|
|
|
return (number);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Rationalp(LispBuiltin *builtin)
|
|
/*
|
|
rationalp object
|
|
*/
|
|
{
|
|
LispObj *object;
|
|
|
|
object = ARGUMENT(0);
|
|
|
|
return (RATIONALP(object) ? T : NIL);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Realpart(LispBuiltin *builtin)
|
|
/*
|
|
realpart number
|
|
*/
|
|
{
|
|
LispObj *number;
|
|
|
|
number = ARGUMENT(0);
|
|
|
|
if (COMPLEXP(number))
|
|
return (OCXR(number));
|
|
else {
|
|
CHECK_REAL(number);
|
|
}
|
|
|
|
return (number);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Rem(LispBuiltin *builtin)
|
|
/*
|
|
rem number divisor
|
|
*/
|
|
{
|
|
LispObj *result;
|
|
|
|
LispObj *number, *divisor;
|
|
|
|
divisor = ARGUMENT(1);
|
|
number = ARGUMENT(0);
|
|
|
|
if (INTEGERP(number) && INTEGERP(divisor)) {
|
|
n_real real;
|
|
|
|
set_real_object(&real, number);
|
|
rem_real_object(&real, divisor);
|
|
result = make_real_object(&real);
|
|
}
|
|
else {
|
|
n_number num;
|
|
|
|
set_number_object(&num, number);
|
|
divide_number_object(&num, divisor, NDIVIDE_TRUNC, 0);
|
|
result = make_real_object(&(num.imag));
|
|
clear_real(&(num.real));
|
|
}
|
|
|
|
return (result);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Sqrt(LispBuiltin *builtin)
|
|
/*
|
|
sqrt number
|
|
*/
|
|
{
|
|
n_number num;
|
|
LispObj *number;
|
|
|
|
number = ARGUMENT(0);
|
|
|
|
set_number_object(&num, number);
|
|
sqrt_number(&num);
|
|
|
|
return (make_number_object(&num));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Zerop(LispBuiltin *builtin)
|
|
/*
|
|
zerop number
|
|
*/
|
|
{
|
|
LispObj *result, *number;
|
|
|
|
number = ARGUMENT(0);
|
|
|
|
switch (OBJECT_TYPE(number)) {
|
|
case LispFixnum_t:
|
|
case LispInteger_t:
|
|
case LispBignum_t:
|
|
case LispDFloat_t:
|
|
case LispRatio_t:
|
|
case LispBigratio_t:
|
|
result = cmp_real_object(&zero, number) == 0 ? T : NIL;
|
|
break;
|
|
case LispComplex_t:
|
|
result = cmp_real_object(&zero, OCXR(number)) == 0 &&
|
|
cmp_real_object(&zero, OCXI(number)) == 0 ? T : NIL;
|
|
break;
|
|
default:
|
|
fatal_builtin_object_error(builtin, number, NOT_A_NUMBER);
|
|
/*NOTREACHED*/
|
|
result = NIL;
|
|
}
|
|
|
|
return (result);
|
|
}
|
|
|
|
static LispObj *
|
|
LispDivide(LispBuiltin *builtin, int fun, int flo)
|
|
{
|
|
n_number num;
|
|
LispObj *number, *divisor;
|
|
|
|
divisor = ARGUMENT(1);
|
|
number = ARGUMENT(0);
|
|
|
|
RETURN_COUNT = 1;
|
|
|
|
if (cmp_real_object(&zero, number) == 0) {
|
|
if (divisor != NIL) {
|
|
CHECK_REAL(divisor);
|
|
}
|
|
|
|
return (RETURN(0) = obj_zero);
|
|
}
|
|
|
|
if (divisor == UNSPEC)
|
|
divisor = obj_one;
|
|
|
|
set_number_object(&num, number);
|
|
if (num.complex)
|
|
fatal_builtin_object_error(builtin, divisor, NOT_A_REAL_NUMBER);
|
|
|
|
divide_number_object(&num, divisor, fun, flo);
|
|
RETURN(0) = make_real_object(&(num.imag));
|
|
|
|
return (make_real_object(&(num.real)));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Ceiling(LispBuiltin *builtin)
|
|
/*
|
|
ceiling number &optional divisor
|
|
*/
|
|
{
|
|
return (LispDivide(builtin, NDIVIDE_CEIL, 0));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Fceiling(LispBuiltin *builtin)
|
|
/*
|
|
fceiling number &optional divisor
|
|
*/
|
|
{
|
|
return (LispDivide(builtin, NDIVIDE_CEIL, 1));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Floor(LispBuiltin *builtin)
|
|
/*
|
|
floor number &optional divisor
|
|
*/
|
|
{
|
|
return (LispDivide(builtin, NDIVIDE_FLOOR, 0));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Ffloor(LispBuiltin *builtin)
|
|
/*
|
|
ffloor number &optional divisor
|
|
*/
|
|
{
|
|
return (LispDivide(builtin, NDIVIDE_FLOOR, 1));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Round(LispBuiltin *builtin)
|
|
/*
|
|
round number &optional divisor
|
|
*/
|
|
{
|
|
return (LispDivide(builtin, NDIVIDE_ROUND, 0));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Fround(LispBuiltin *builtin)
|
|
/*
|
|
fround number &optional divisor
|
|
*/
|
|
{
|
|
return (LispDivide(builtin, NDIVIDE_ROUND, 1));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Truncate(LispBuiltin *builtin)
|
|
/*
|
|
truncate number &optional divisor
|
|
*/
|
|
{
|
|
return (LispDivide(builtin, NDIVIDE_TRUNC, 0));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Ftruncate(LispBuiltin *builtin)
|
|
/*
|
|
ftruncate number &optional divisor
|
|
*/
|
|
{
|
|
return (LispDivide(builtin, NDIVIDE_TRUNC, 1));
|
|
}
|