fixnum.c 4.89 KB
Newer Older
Erick Gallesio's avatar
Erick Gallesio committed
1 2
/*
 * fixnum.c	-- Fixnum operations
3 4 5 6
 *
 * Copyright © 2007 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
 *
 *
Erick Gallesio's avatar
Erick Gallesio committed
7 8 9 10
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
11
 *
Erick Gallesio's avatar
Erick Gallesio committed
12 13 14 15
 * This program 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 General Public License for more details.
16
 *
Erick Gallesio's avatar
Erick Gallesio committed
17 18
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
19
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
Erick Gallesio's avatar
Erick Gallesio committed
20
 * USA.
21
 *
Erick Gallesio's avatar
Erick Gallesio committed
22 23
 *           Author: Erick Gallesio [eg@essi.fr]
 *    Creation date:  9-May-2007 17:15 (eg)
Erick Gallesio's avatar
Erick Gallesio committed
24
 * Last file update:  6-Jun-2007 09:21 (eg)
Erick Gallesio's avatar
Erick Gallesio committed
25 26 27 28 29 30 31 32 33
 */

#include <stklos.h>

static void error_bad_fixnum(SCM obj)
{
  STk_error("bad fixnum ~S", obj);
}

34 35 36 37 38 39 40 41 42
static void error_division_by_0(void)
{
  STk_error("division by 0");
}


/*
<doc EXT fixnum?
 * (fixnum? obj)
43 44
 *
 * Returns |#t| if obj is an exact integer within the fixnum range,
45 46 47
 * |#f| otherwise.
doc>
*/
Erick Gallesio's avatar
Erick Gallesio committed
48 49 50 51 52
DEFINE_PRIMITIVE("fixnum?", fixnump, subr1, (SCM obj))
{
  return MAKE_BOOLEAN(INTP(obj));
}

53 54 55
/*
<doc EXT fixnum-width
 * (fixnum-width)
56
 *
57 58 59
 * Returns the number of bits used to represent a fixnum number
doc>
*/
Erick Gallesio's avatar
Erick Gallesio committed
60 61 62 63 64
DEFINE_PRIMITIVE("fixnum-width", fixnum_width, subr0, (void))
{
  return MAKE_INT(sizeof(long)* 8 - 2);
}

65 66 67 68
/*
<doc EXT least-fixnum greatest-fixnum
 * (least-fixnum)
 * (greatest-fixnum)
69
 *
70 71 72 73
 * These procedures return the minimum value and the maximum value of
 * the fixnum range.
doc>
*/
Erick Gallesio's avatar
Erick Gallesio committed
74 75 76 77 78 79 80 81 82 83 84 85
DEFINE_PRIMITIVE("least-fixnum", least_fixnum, subr0, (void))
{
  return MAKE_INT(INT_MIN_VAL);
}

DEFINE_PRIMITIVE("greatest-fixnum", greatest_fixnum, subr0, (void))
{
  return MAKE_INT(INT_MAX_VAL);
}


/*
86
<doc EXT fx+ fx- fx* fxdiv fxrem fxmod
87 88 89 90 91 92 93
 * (fx+ fx1 fx2)
 * (fx- fx1 fx2)
 * (fx* fx1 fx2)
 * (fxdiv fx1 fx2)
 * (fxrem fx1 fx2)
 * (fxmod fx1 fx2)
 * (fx- fx)
94 95 96
 *
 * These procedures compute (respectively) the sum, the difference, the product,
 * the quotient and the remainder and modulp of the fixnums |fx1| and |fx2|.
97 98
 * The call of  |fx-| with one parameter |fx| computes the opposite of |fx|.
doc>
Erick Gallesio's avatar
Erick Gallesio committed
99
 */
100 101 102 103 104 105
DEFINE_PRIMITIVE("fx+", fxplus, subr2, (SCM o1, SCM o2))
{
  if (!INTP(o1)) error_bad_fixnum(o1);
  if (!INTP(o2)) error_bad_fixnum(o2);
  return MAKE_INT(INT_VAL(o1) + INT_VAL(o2));
}
Erick Gallesio's avatar
Erick Gallesio committed
106

107 108 109
DEFINE_PRIMITIVE("fx-", fxminus, subr12, (SCM o1, SCM o2))
{
  if (!INTP(o1)) error_bad_fixnum(o1);
110
  if (!o2)
111 112
    return MAKE_INT(-INT_VAL(o1));
  if (!INTP(o2)) error_bad_fixnum(o2);
Erick Gallesio's avatar
Erick Gallesio committed
113
  return MAKE_INT(INT_VAL(o1) - INT_VAL(o2));
Erick Gallesio's avatar
Erick Gallesio committed
114 115
}

116 117 118 119 120 121 122 123 124 125 126 127 128 129 130
DEFINE_PRIMITIVE("fx*", fxtime, subr2, (SCM o1, SCM o2))
{
  if (!INTP(o1)) error_bad_fixnum(o1);
  if (!INTP(o2)) error_bad_fixnum(o2);
  return MAKE_INT(INT_VAL(o1) * INT_VAL(o2));
}

DEFINE_PRIMITIVE("fxdiv", fxdiv, subr2, (SCM o1, SCM o2))
{
  int n;

  if (!INTP(o1)) error_bad_fixnum(o1);
  if (!INTP(o2)) error_bad_fixnum(o2);

  n = INT_VAL(o2);
131

132 133 134 135 136 137 138 139 140 141 142 143
  if (!n) error_division_by_0();
  return MAKE_INT(INT_VAL(o1) / n);
}

DEFINE_PRIMITIVE("fxrem", fxrem, subr2, (SCM o1, SCM o2))
{
  int n;

  if (!INTP(o1)) error_bad_fixnum(o1);
  if (!INTP(o2)) error_bad_fixnum(o2);

  n = INT_VAL(o2);
144

145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
  if (!n) error_division_by_0();
  return MAKE_INT(INT_VAL(o1) % n);
}


DEFINE_PRIMITIVE("fxmod", fxmod, subr2, (SCM o1, SCM o2))
{
  if (!INTP(o1)) error_bad_fixnum(o1);
  if (!INTP(o2)) error_bad_fixnum(o2);
  {
    int n1 = INT_VAL(o1);
    int n2 = INT_VAL(o2);
    int r;

    if (!n2) error_division_by_0();
    r = n1 % n2;

    /* (negativep(n1) != negativep(n2) && !zerop(r)) */
    if ((((n1 < 0) && (n2 >= 0)) || ((n1 >= 0) && (n2 < 0))) &&
	r)
      r += n2;
166

167 168 169
    return MAKE_INT(r);
  }
}
Erick Gallesio's avatar
Erick Gallesio committed
170 171

/*
172
<doc EXT fx< fx<= fx> fx>= fx=
173 174 175 176 177
 * (fx< fx1 fx2)
 * (fx<= fx1 fx2)
 * (fx> fx1 fx2)
 * (fx>= fx1 fx2)
 * (fx= fx1 fx2)
178 179
 *
 * These procedures compare the fixnums |fx1| and |fx2| and retun |#t| if
180 181
 * the comparison is true and |#f| otherwise.
doc>
Erick Gallesio's avatar
Erick Gallesio committed
182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210
 */
#define SIMPLE_COMP(name, func, op) \
DEFINE_PRIMITIVE(name, func, subr2, (SCM o1, SCM o2))		\
{								\
  if (!INTP(o1)) error_bad_fixnum(o1);				\
  if (!INTP(o2)) error_bad_fixnum(o2);				\
  return MAKE_BOOLEAN(INT_VAL(o1) op INT_VAL(o2));		\
}

SIMPLE_COMP("fx<",  fxlt, <)
SIMPLE_COMP("fx<=", fxle, <=)
SIMPLE_COMP("fx>",  fxgt, >)
SIMPLE_COMP("fx>=", fxge, >=)
SIMPLE_COMP("fx=",  fxeq, ==)


int STk_init_fixnum(void)
{
  ADD_PRIMITIVE(fixnump);
  ADD_PRIMITIVE(fixnum_width);
  ADD_PRIMITIVE(least_fixnum);
  ADD_PRIMITIVE(greatest_fixnum);


  ADD_PRIMITIVE(fxplus);
  ADD_PRIMITIVE(fxminus);
  ADD_PRIMITIVE(fxtime);
  ADD_PRIMITIVE(fxdiv);
  ADD_PRIMITIVE(fxmod);
211
  ADD_PRIMITIVE(fxrem);
Erick Gallesio's avatar
Erick Gallesio committed
212 213 214 215 216 217 218 219 220

  ADD_PRIMITIVE(fxlt);
  ADD_PRIMITIVE(fxle);
  ADD_PRIMITIVE(fxgt);
  ADD_PRIMITIVE(fxge);
  ADD_PRIMITIVE(fxeq);

  return TRUE;
}