fixing various numeric operations

eval.c

@@ -1678,13 +1678,20 @@ sexp sexp_vm (sexp ctx, sexp proc) {
     top--;
     break;
   case OP_DIV:
-    if (_ARG2 == sexp_make_integer(0))
+    if (_ARG2 == sexp_make_integer(0)) {
-      sexp_raise("divide by zero", SEXP_NULL);
+#if USE_FLONUMS
-    if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) {
+      if (sexp_flonump(_ARG1) && sexp_flonum_value(_ARG1) == 0.0)
+        _ARG2 = sexp_make_flonum(ctx, 0.0/0.0);
+      else
+#endif
+        sexp_raise("divide by zero", SEXP_NULL);
+    } else if (sexp_integerp(_ARG1) && sexp_integerp(_ARG2)) {
 #if USE_FLONUMS
       _ARG1 = sexp_integer_to_flonum(ctx, _ARG1);
       _ARG2 = sexp_integer_to_flonum(ctx, _ARG2);
       _ARG2 = sexp_fp_div(ctx, _ARG1, _ARG2);
+      if (sexp_flonum_value(_ARG2) == trunc(sexp_flonum_value(_ARG2)))
+        _ARG2 = sexp_make_integer(sexp_flonum_value(_ARG2));
 #else
       _ARG2 = sexp_fx_div(_ARG1, _ARG2);
 #endif
@@ -1849,10 +1856,18 @@ sexp sexp_vm (sexp ctx, sexp proc) {
       sexp_raise("exact->inexact: not a number", sexp_list1(ctx, _ARG1));
     break;
   case OP_FLO2FIX:
-    if (sexp_flonump(_ARG1))
+    if (sexp_flonump(_ARG1)) {
-      _ARG1 = sexp_make_integer((sexp_sint_t)sexp_flonum_value(_ARG1));
+      if (sexp_flonum_value(_ARG1) != trunc(sexp_flonum_value(_ARG1))) {
-    else if (! sexp_integerp(_ARG1))
+        sexp_raise("inexact->exact: not an integer", sexp_list1(ctx, _ARG1));
+      } else if ((sexp_flonum_value(_ARG1) > SEXP_MAX_FIXNUM)
+                 || sexp_flonum_value(_ARG1) < SEXP_MIN_FIXNUM) {
+        _ARG1 = sexp_double_to_bignum(ctx, sexp_flonum_value(_ARG1));
+      } else {
+        _ARG1 = sexp_make_integer((sexp_sint_t)sexp_flonum_value(_ARG1));
+      }
+    } else if (! sexp_integerp(_ARG1) && ! sexp_bignump(_ARG1)) {
       sexp_raise("inexact->exact: not a number", sexp_list1(ctx, _ARG1));
+    }
     break;
   case OP_CHAR2INT:
     _ARG1 = sexp_make_integer(sexp_unbox_character(_ARG1));

init.scm

@@ -391,6 +391,13 @@
 
 (define (abs x) (if (< x 0) (- x) x))
 
+(define (numerator x)
+  (if (integer? x) x (numerator (* x 10))))
+(define (denominator x)
+  (if (exact? x)
+      1
+      (let lp ((x x) (r 1.0)) (if (integer? x) r (lp (* x 10) (* r 10))))))
+
 (define (modulo a b)
   (let ((res (remainder a b)))
     (if (< b 0)

opcodes.c

@@ -126,24 +126,7 @@ _FN1(SEXP_OPORT, "get-output-string", 0, sexp_get_output_string),
 _FN2(SEXP_PROCEDURE, SEXP_OPORT, "disasm", 0, sexp_disasm),
 #endif
 #if PLAN9
-_FN0("random-integer", 0, sexp_rand),
+#include "opt/plan9-opcodes.c"
-_FN1(SEXP_FIXNUM, "random-seed", 0, sexp_srand),
-_FN0("current-directory", 0, sexp_getwd),
-_FN0("current-user", 0, sexp_getuser),
-_FN0("system-name", 0, sexp_sysname),
-_FN1(SEXP_IPORT, "port-fileno", 0, sexp_fileno),
-_FN2(SEXP_FIXNUM, SEXP_STRING, "fileno->port", 0, sexp_fdopen),
-_FN0("fork", 0, sexp_fork),
-_FN2(SEXP_STRING, SEXP_PAIR, "exec", 0, sexp_exec),
-_FN1(SEXP_STRING, "exits", 0, sexp_exits),
-_FN2(SEXP_FIXNUM, SEXP_FIXNUM, "dup", 0, sexp_dup),
-_FN0("pipe", 0, sexp_pipe),
-_FN1(SEXP_FIXNUM, "sleep", 0, sexp_sleep),
-_FN1(SEXP_STRING, "getenv", 0, sexp_getenv),
-_FN1(SEXP_STRING, "change-directory", 0, sexp_chdir),
-_FN0("wait", 0, sexp_wait),
-_FN2(SEXP_FIXNUM, SEXP_STRING, "post-note", 0, sexp_postnote),
-_FN4(SEXP_PAIR, SEXP_STRING, "%postmountsrv", 0, sexp_postmountsrv),
 #endif
 };
 

opt/bignum.c

@@ -25,6 +25,30 @@ sexp sexp_fixnum_to_bignum (sexp ctx, sexp a) {
   return res;
 }
 
+#define double_trunc_10s_digit(f) (trunc((f)/10.0)*10.0)
+#define double_10s_digit(f) ((f)-double_trunc_10s_digit(f))
+
+sexp sexp_double_to_bignum (sexp ctx, double f) {
+  int sign;
+  sexp_gc_var(ctx, res, s_res);
+  sexp_gc_var(ctx, scale, s_scale);
+  sexp_gc_var(ctx, tmp, s_tmp);
+  sexp_gc_preserve(ctx, res, s_res);
+  sexp_gc_preserve(ctx, scale, s_scale);
+  sexp_gc_preserve(ctx, tmp, s_tmp);
+  res = sexp_fixnum_to_bignum(ctx, sexp_make_integer(0));
+  scale = sexp_fixnum_to_bignum(ctx, sexp_make_integer(1));
+  sign = (f < 0 ? -1 : 1);
+  for (f=fabs(f); f >= 1.0; f=trunc(f/10)) {
+    tmp = sexp_bignum_fxmul(ctx, NULL, scale, double_10s_digit(f), 0);
+    res = sexp_bignum_add(ctx, res, res, tmp);
+    scale = sexp_bignum_fxmul(ctx, NULL, scale, 10, 0);
+  }
+  sexp_bignum_sign(res) = sign;
+  sexp_gc_release(ctx, res, s_res);
+  return res;
+}
+
 sexp sexp_copy_bignum (sexp ctx, sexp dst, sexp a, sexp_uint_t len0) {
   sexp_uint_t len = (len0 > 0) ? len0 : sexp_bignum_length(a), size;
   size = sexp_sizeof(bignum) + len*sizeof(sexp_uint_t);
@@ -514,7 +538,7 @@ sexp sexp_sub (sexp ctx, sexp a, sexp b) {
     r = sexp_fx_sub(a, b);      /* XXXX check overflow */
     break;
   case SEXP_NUM_FIX_FLO:
-    r = sexp_make_flonum(ctx, sexp_integer_to_double(a)+sexp_flonum_value(b));
+    r = sexp_make_flonum(ctx, sexp_integer_to_double(a)-sexp_flonum_value(b));
     break;
   case SEXP_NUM_FIX_BIG:
     r = sexp_bignum_sub(ctx, NULL, b, sexp_fixnum_to_bignum(ctx, a));
@@ -528,13 +552,13 @@ sexp sexp_sub (sexp ctx, sexp a, sexp b) {
     r = sexp_fp_sub(ctx, a, b);
     break;
   case SEXP_NUM_FLO_BIG:
-    r = sexp_make_flonum(ctx, sexp_flonum_value(a) + sexp_bignum_to_double(b));
+    r = sexp_make_flonum(ctx, sexp_flonum_value(a) - sexp_bignum_to_double(b));
     break;
   case SEXP_NUM_BIG_FIX:
     r = sexp_bignum_normalize(sexp_bignum_sub(ctx, NULL, a, sexp_fixnum_to_bignum(ctx, b)));
     break;
   case SEXP_NUM_BIG_FLO:
-    r = sexp_make_flonum(ctx, sexp_flonum_value(b) + sexp_bignum_to_double(a));
+    r = sexp_make_flonum(ctx, sexp_flonum_value(b) - sexp_bignum_to_double(a));
   case SEXP_NUM_BIG_BIG:
     r = sexp_bignum_normalize(sexp_bignum_sub(ctx, NULL, a, b));
     break;
@@ -555,7 +579,7 @@ sexp sexp_mul (sexp ctx, sexp a, sexp b) {
     r = sexp_fx_mul(a, b);
     break;
   case SEXP_NUM_FIX_FLO:
-    r = sexp_make_flonum(ctx, sexp_integer_to_double(a)+sexp_flonum_value(b));
+    r = sexp_make_flonum(ctx, sexp_integer_to_double(a)*sexp_flonum_value(b));
     break;
   case SEXP_NUM_FIX_BIG:
     r = sexp_bignum_fxmul(ctx, NULL, b, sexp_unbox_integer(sexp_fx_abs(a)), 0);
@@ -565,7 +589,7 @@ sexp sexp_mul (sexp ctx, sexp a, sexp b) {
     r = sexp_fp_mul(ctx, a, b);
     break;
   case SEXP_NUM_FLO_BIG:
-    r = sexp_make_flonum(ctx, sexp_flonum_value(a) + sexp_bignum_to_double(b));
+    r = sexp_make_flonum(ctx, sexp_flonum_value(a) * sexp_bignum_to_double(b));
     break;
   case SEXP_NUM_BIG_BIG:
     r = sexp_bignum_mul(ctx, NULL, a, b);

sexp.c

@@ -844,9 +844,14 @@ void sexp_write (sexp ctx, sexp obj, sexp out) {
 #if ! USE_IMMEDIATE_FLONUMS
     case SEXP_FLONUM:
       f = sexp_flonum_value(obj);
-      i = sprintf(numbuf, "%.15g", f);
+      if (isinf(f) || isnan(f)) {
-      if (f == trunc(f)) {
+        numbuf[0] = (isinf(f) && f < 0 ? '-' : '+');
-        numbuf[i++] = '.'; numbuf[i++] = '0'; numbuf[i++] = '\0';
+        strcpy(numbuf+1, isinf(f) ? "inf.0" : "nan.0");
+      } else {
+        i = sprintf(numbuf, "%.15g", f);
+        if (f == trunc(f) && ! strchr(numbuf, '.')) {
+          numbuf[i++] = '.'; numbuf[i++] = '0'; numbuf[i++] = '\0';
+        }
       }
       sexp_write_string(ctx, numbuf, out);
       break;
@@ -902,9 +907,14 @@ void sexp_write (sexp ctx, sexp obj, sexp out) {
 #if USE_IMMEDIATE_FLONUMS
   } else if (sexp_flonump(obj)) {
     f = sexp_flonum_value(obj);
-    i = sprintf(numbuf, "%.15g", f);
+    if (isinf(f) || isnan(f)) {
-    if (f == trunc(f)) {
+      numbuf[0] = (isinf(f) && f < 0 ? '-' : '+');
-      numbuf[i++] = '.'; numbuf[i++] = '0'; numbuf[i++] = '\0';
+      strcpy(numbuf+1, isinf(f) ? "inf.0" : "nan.0");
+    } else {
+      i = sprintf(numbuf, "%.15g", f);
+      if (f == trunc(f) && ! strchr(numbuf, '.')) {
+        numbuf[i++] = '.'; numbuf[i++] = '0'; numbuf[i++] = '\0';
+      }
     }
     sexp_write_string(ctx, numbuf, out);
 #endif
@@ -1029,15 +1039,17 @@ sexp sexp_read_float_tail(sexp ctx, sexp in, sexp_uint_t whole, int negp) {
        isdigit(c);
        c=sexp_read_char(ctx, in), scale*=0.1)
     res += digit_value(c)*scale;
-  sexp_push_char(ctx, c, in);
   if (c=='e' || c=='E') {
     exponent = sexp_read_number(ctx, in, 10);
     if (sexp_exceptionp(exponent)) return exponent;
     e = (sexp_integerp(exponent) ? sexp_unbox_integer(exponent)
          : sexp_flonump(exponent) ? sexp_flonum_value(exponent) : 0.0);
-  } else if ((c!=EOF) && ! is_separator(c))
+  } else if ((c!=EOF) && ! is_separator(c)) {
     return sexp_read_error(ctx, "invalid numeric syntax",
                            sexp_make_character(c), in);
+  } else {
+    sexp_push_char(ctx, c, in);
+  }
   res = ((double)whole + res) * pow(10, e);
   if (negp) res *= -1;
   if ((scale == 0.1) && (exponent != SEXP_VOID) && (res == round(res)))