core: Prepare for M2-Planet: math.c.
* src/math.c: Rewrite C constructs not supported by M2-Planet.
This commit is contained in:
parent
ba83a177d2
commit
5d4976ccfb
49
src/math.c
49
src/math.c
|
@ -38,7 +38,7 @@ assert_number (char const *name, SCM x)
|
|||
}
|
||||
|
||||
SCM
|
||||
greater_p (SCM x) ///((name . ">") (arity . n))
|
||||
greater_p (SCM x) /*:((name . ">") (arity . n)) */
|
||||
{
|
||||
if (x == cell_nil)
|
||||
return cell_t;
|
||||
|
@ -57,7 +57,7 @@ greater_p (SCM x) ///((name . ">") (arity . n))
|
|||
}
|
||||
|
||||
SCM
|
||||
less_p (SCM x) ///((name . "<") (arity . n))
|
||||
less_p (SCM x) /*:((name . "<") (arity . n)) */
|
||||
{
|
||||
if (x == cell_nil)
|
||||
return cell_t;
|
||||
|
@ -76,7 +76,7 @@ less_p (SCM x) ///((name . "<") (arity . n))
|
|||
}
|
||||
|
||||
SCM
|
||||
is_p (SCM x) ///((name . "=") (arity . n))
|
||||
is_p (SCM x) /*:((name . "=") (arity . n)) */
|
||||
{
|
||||
if (x == cell_nil)
|
||||
return cell_t;
|
||||
|
@ -93,7 +93,7 @@ is_p (SCM x) ///((name . "=") (arity . n))
|
|||
}
|
||||
|
||||
SCM
|
||||
minus (SCM x) ///((name . "-") (arity . n))
|
||||
minus (SCM x) /*:((name . "-") (arity . n)) */
|
||||
{
|
||||
assert_number ("minus", CAR (x));
|
||||
long n = VALUE (CAR (x));
|
||||
|
@ -103,27 +103,27 @@ minus (SCM x) ///((name . "-") (arity . n))
|
|||
while (x != cell_nil)
|
||||
{
|
||||
assert_number ("minus", CAR (x));
|
||||
n -= VALUE (car (x));
|
||||
n = n - VALUE (car (x));
|
||||
x = cdr (x);
|
||||
}
|
||||
return MAKE_NUMBER (n);
|
||||
}
|
||||
|
||||
SCM
|
||||
plus (SCM x) ///((name . "+") (arity . n))
|
||||
plus (SCM x) /*:((name . "+") (arity . n)) */
|
||||
{
|
||||
long n = 0;
|
||||
while (x != cell_nil)
|
||||
{
|
||||
assert_number ("plus", CAR (x));
|
||||
n += VALUE (car (x));
|
||||
n = n + VALUE (car (x));
|
||||
x = cdr (x);
|
||||
}
|
||||
return MAKE_NUMBER (n);
|
||||
}
|
||||
|
||||
SCM
|
||||
divide (SCM x) ///((name . "/") (arity . n))
|
||||
divide (SCM x) /*:((name . "/") (arity . n)) */
|
||||
{
|
||||
long n = 1;
|
||||
if (x != cell_nil)
|
||||
|
@ -138,9 +138,9 @@ divide (SCM x) ///((name . "/") (arity . n))
|
|||
long y = VALUE (CAR (x));
|
||||
if (y == 0)
|
||||
error (cstring_to_symbol ("divide-by-zero"), x);
|
||||
if (!n)
|
||||
if (n == 0)
|
||||
break;
|
||||
n /= y;
|
||||
n = n / y;
|
||||
x = cdr (x);
|
||||
}
|
||||
return MAKE_NUMBER (n);
|
||||
|
@ -156,45 +156,47 @@ modulo (SCM a, SCM b)
|
|||
if (y == 0)
|
||||
error (cstring_to_symbol ("divide-by-zero"), a);
|
||||
while (x < 0)
|
||||
x += y;
|
||||
x = x ? x % y : 0;
|
||||
x = x + y;
|
||||
if (x != 0)
|
||||
x = x % y;
|
||||
|
||||
return MAKE_NUMBER (x);
|
||||
}
|
||||
|
||||
SCM
|
||||
multiply (SCM x) ///((name . "*") (arity . n))
|
||||
multiply (SCM x) /*:((name . "*") (arity . n)) */
|
||||
{
|
||||
long n = 1;
|
||||
while (x != cell_nil)
|
||||
{
|
||||
assert_number ("multiply", CAR (x));
|
||||
n *= VALUE (car (x));
|
||||
n = n * VALUE (car (x));
|
||||
x = cdr (x);
|
||||
}
|
||||
return MAKE_NUMBER (n);
|
||||
}
|
||||
|
||||
SCM
|
||||
logand (SCM x) ///((arity . n))
|
||||
logand (SCM x) /*:((arity . n)) */
|
||||
{
|
||||
long n = 0;
|
||||
while (x != cell_nil)
|
||||
{
|
||||
assert_number ("multiply", CAR (x));
|
||||
n &= VALUE (car (x));
|
||||
n = n & VALUE (car (x));
|
||||
x = cdr (x);
|
||||
}
|
||||
return MAKE_NUMBER (n);
|
||||
}
|
||||
|
||||
SCM
|
||||
logior (SCM x) ///((arity . n))
|
||||
logior (SCM x) /*:((arity . n)) */
|
||||
{
|
||||
long n = 0;
|
||||
while (x != cell_nil)
|
||||
{
|
||||
assert_number ("logior", CAR (x));
|
||||
n |= VALUE (car (x));
|
||||
n = n | VALUE (car (x));
|
||||
x = cdr (x);
|
||||
}
|
||||
return MAKE_NUMBER (n);
|
||||
|
@ -209,13 +211,13 @@ lognot (SCM x)
|
|||
}
|
||||
|
||||
SCM
|
||||
logxor (SCM x) ///((arity . n))
|
||||
logxor (SCM x) /*:((arity . n)) */
|
||||
{
|
||||
long n = 0;
|
||||
while (x != cell_nil)
|
||||
{
|
||||
assert_number ("logxor", CAR (x));
|
||||
n ^= VALUE (car (x));
|
||||
n = n ^ VALUE (car (x));
|
||||
x = cdr (x);
|
||||
}
|
||||
return MAKE_NUMBER (n);
|
||||
|
@ -228,5 +230,10 @@ ash (SCM n, SCM count)
|
|||
assert_number ("ash", count);
|
||||
long cn = VALUE (n);
|
||||
long ccount = VALUE (count);
|
||||
return MAKE_NUMBER ((ccount < 0) ? cn >> -ccount : cn << ccount);
|
||||
long result;
|
||||
if (ccount < 0)
|
||||
result = cn >> -ccount;
|
||||
else
|
||||
result = cn << ccount;
|
||||
return MAKE_NUMBER (result);
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue