This is number.c in view mode; [Download] [Up]
/*
Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
This file is part of GNU Common Lisp, herein referred to as GCL
GCL is free software; you can redistribute it and/or modify it under
the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GCL 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 Library General Public
License for more details.
You should have received a copy of the GNU Library General Public License
along with GCL; see the file COPYING. If not, write to the Free Software
Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
/*
number.c
IMPLEMENTATION-DEPENDENT
This file creates some implementation dependent constants.
*/
#include "include.h"
#include "num_include.h"
int
fixint(x)
object x;
{
if (type_of(x) != t_fixnum)
FEerror("~S is not a fixnum.", 1, x);
return(fix(x));
}
int
fixnnint(x)
object x;
{
if (type_of(x) != t_fixnum || fix(x) < 0)
FEerror("~S is not a non-negative fixnum.", 1, x);
return(fix(x));
}
#define BIGGER_FIXNUM_RANGE
#ifdef BIGGER_FIXNUM_RANGE
struct {int min,max;} bigger_fixnums;
struct fixnum_struct *bigger_fixnum_table;
DEFUN("ALLOCATE-BIGGER-FIXNUM-RANGE",object,fSallocate_bigger_fixnum_range,
SI,2,2,NONE,OI,IO,OO,OO,"") (min,max)
int min,max;
{ int j;
if (min <= max); else {FEerror("Need Min < Max",0);}
bigger_fixnum_table= (void *) malloc(sizeof(struct fixnum_struct)*
(max - min));
for (j=min ; j < max ; j=j+1)
{ bigger_fixnum_table[j - min].t
= (short)t_fixnum;
bigger_fixnum_table[j - min].FIXVAL = j;
}
bigger_fixnums.min=min;
bigger_fixnums.max=max;
return Ct;
}
#endif
object
make_fixnum(i)
int i;
{
object x;
if (-SMALL_FIXNUM_LIMIT <= i && i < SMALL_FIXNUM_LIMIT)
return(small_fixnum(i));
#ifdef BIGGER_FIXNUM_RANGE
if (bigger_fixnum_table)
{ if (i >= bigger_fixnums.min
&& i < bigger_fixnums.max)
return (object)(bigger_fixnum_table +(i -bigger_fixnums.min));
}
#endif
x = alloc_object(t_fixnum);
fix(x) = i;
return(x);
}
object
make_ratio(num, den)
object num, den;
{
object g, r, integer_divide1(), get_gcd();
vs_mark;
if (number_zerop(den))
FEerror("Zero denominator.", 0);
if (number_zerop(num))
return(small_fixnum(0));
if (type_of(den) == t_fixnum && fix(den) == 1)
return(num);
if (number_minusp(den)) {
num = number_negate(num);
vs_push(num);
den = number_negate(den);
vs_push(den);
}
g = get_gcd(num, den);
vs_push(g);
num = integer_divide1(num, g);
vs_push(num);
den = integer_divide1(den, g);
vs_push(den);
if(type_of(den) == t_fixnum && fix(den) == 1) {
vs_reset;
return(num);
}
if(type_of(den) == t_fixnum && fix(den) == -1) {
num = number_negate(num);
vs_reset;
return(num);
}
r = alloc_object(t_ratio);
r->rat.rat_num = num;
r->rat.rat_den = den;
vs_reset;
return(r);
}
object
make_shortfloat(f)
double f;
{
object x;
if (f == (shortfloat)0.0)
return(shortfloat_zero);
x = alloc_object(t_shortfloat);
sf(x) = (shortfloat)f;
return(x);
}
object
make_longfloat(f)
longfloat f;
{
object x;
if (f == (longfloat)0.0)
return(longfloat_zero);
x = alloc_object(t_longfloat);
lf(x) = f;
return(x);
}
object
make_complex(r, i)
object r, i;
{
object c;
vs_mark;
switch (type_of(r)) {
case t_fixnum:
case t_bignum:
case t_ratio:
switch (type_of(i)) {
case t_fixnum:
if (fix(i) == 0)
return(r);
break;
case t_shortfloat:
r = make_shortfloat((shortfloat)number_to_double(r));
vs_push(r);
break;
case t_longfloat:
r = make_longfloat(number_to_double(r));
vs_push(r);
break;
}
break;
case t_shortfloat:
switch (type_of(i)) {
case t_fixnum:
case t_bignum:
case t_ratio:
i = make_shortfloat((shortfloat)number_to_double(i));
vs_push(i);
break;
case t_longfloat:
r = make_longfloat((double)(sf(r)));
vs_push(r);
break;
}
break;
case t_longfloat:
switch (type_of(i)) {
case t_fixnum:
case t_bignum:
case t_ratio:
case t_shortfloat:
i = make_longfloat(number_to_double(i));
vs_push(i);
break;
}
break;
}
c = alloc_object(t_complex);
c->cmp.cmp_real = r;
c->cmp.cmp_imag = i;
vs_reset;
return(c);
}
double
number_to_double(x)
object x;
{
switch(type_of(x)) {
case t_fixnum:
return((double)(fix(x)));
case t_bignum:
return(big_to_double((struct bignum *)x));
case t_ratio:
return(number_to_double(x->rat.rat_num) /
number_to_double(x->rat.rat_den));
case t_shortfloat:
return((double)(sf(x)));
case t_longfloat:
return(lf(x));
default:
wrong_type_argument(TSor_rational_float, x);
}
}
init_number()
{
int i;
object x;
for (i = -SMALL_FIXNUM_LIMIT; i < SMALL_FIXNUM_LIMIT; i++) {
small_fixnum_table[i + SMALL_FIXNUM_LIMIT].t
= (short)t_fixnum;
small_fixnum_table[i + SMALL_FIXNUM_LIMIT].FIXVAL = i;
}
shortfloat_zero = alloc_object(t_shortfloat);
sf(shortfloat_zero) = (shortfloat)0.0;
longfloat_zero = alloc_object(t_longfloat);
lf(longfloat_zero) = (longfloat)0.0;
enter_mark_origin(&shortfloat_zero);
enter_mark_origin(&longfloat_zero);
make_constant("MOST-POSITIVE-FIXNUM",
make_fixnum(MOST_POSITIVE_FIX));
make_constant("MOST-NEGATIVE-FIXNUM",
make_fixnum(MOST_NEGATIVE_FIX));
init_num_pred();
init_num_comp();
init_num_arith();
init_num_co();
init_num_log();
init_num_sfun();
init_num_rand();
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.