IABSD.fr/xenocara/app/xedit/lisp/math.c

Branch : - branch - master - tag -

• Show log

  Commit

• Author : matthieu
  Date : 2006-11-25 20:07:29
  Hash : 616b6f15
  Message : Importing from X.Org 7.2RC2

• app/xedit/lisp/math.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);
      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));
  }