fixing scheme bytevector for 32bit arch

Makefile

@@ -247,6 +247,7 @@ test-division: chibi-scheme$(EXE)
 	$(CHIBI) tests/division-tests.scm
 
 test-libs: chibi-scheme$(EXE)
+	@echo "\e[1mloading tests first, it may take a while to see output...\e[0m"
 	$(CHIBI) tests/lib-tests.scm
 
 test-r5rs: chibi-scheme$(EXE)

bignum.c

@@ -39,7 +39,7 @@ sexp sexp_make_integer_from_lsint (sexp ctx, sexp_lsint_t x) {
   sexp res;
   if (lsint_is_fixnum(x)) {
     res = sexp_make_fixnum(lsint_to_sint(x));
-  } else {
+  } else if (sexp_lsint_fits_sint(x)) {
     res = sexp_make_bignum(ctx, 1);
     if (lsint_lt_0(x)) {
       sexp_bignum_sign(res) = -1;
@@ -48,6 +48,17 @@ sexp sexp_make_integer_from_lsint (sexp ctx, sexp_lsint_t x) {
       sexp_bignum_sign(res) = 1;
       sexp_bignum_data(res)[0] = (sexp_uint_t)lsint_to_sint(x);
     }
+  } else {
+    res = sexp_make_bignum(ctx, 2);
+    if (lsint_lt_0(x)) {
+      sexp_bignum_sign(res) = -1;
+      sexp_bignum_data(res)[0] = (sexp_uint_t)-lsint_to_sint(x);
+      sexp_bignum_data(res)[1] = (sexp_uint_t)~lsint_to_sint_hi(x);
+    } else {
+      sexp_bignum_sign(res) = 1;
+      sexp_bignum_data(res)[0] = (sexp_uint_t)lsint_to_sint(x);
+      sexp_bignum_data(res)[1] = (sexp_uint_t)lsint_to_sint_hi(x);
+    }
   }
   return res;
 }
@@ -56,22 +67,53 @@ sexp sexp_make_unsigned_integer_from_luint (sexp ctx, sexp_luint_t x) {
   sexp res;
   if (luint_is_fixnum(x)) {
     res = sexp_make_fixnum(luint_to_uint(x));
-  } else {
+  } else if (sexp_luint_fits_uint(x)) {
     res = sexp_make_bignum(ctx, 1);
     sexp_bignum_sign(res) = 1;
     sexp_bignum_data(res)[0] = luint_to_uint(x);
+  } else {
+    res = sexp_make_bignum(ctx, 2);
+    sexp_bignum_sign(res) = 1;
+    sexp_bignum_data(res)[0] = luint_to_uint(x);
+    sexp_bignum_data(res)[1] = luint_to_uint_hi(x);
   }
   return res;
 }
 
-#if !SEXP_USE_CUSTOM_LONG_LONGS
+#if SEXP_USE_CUSTOM_LONG_LONGS
+sexp sexp_make_integer(sexp ctx, long long x) {
+  return sexp_make_integer_from_lsint(ctx, lsint_from_sint(x));
+}
+sexp sexp_make_unsigned_integer(sexp ctx, unsigned long long x) {
+  return sexp_make_unsigned_integer_from_luint(ctx, luint_from_uint(x));
+}
+#else
 sexp sexp_make_integer (sexp ctx, sexp_lsint_t x) {
   return sexp_make_integer_from_lsint(ctx, x);
 }
 sexp sexp_make_unsigned_integer (sexp ctx, sexp_luint_t x) {
   return sexp_make_unsigned_integer_from_luint(ctx, x);
 }
-#endif  /* !SEXP_USE_CUSTOM_LONG_LONGS */
+#endif
+
+#if !SEXP_64_BIT
+long long sexp_bignum_to_sint(sexp x) {
+  if (!sexp_bignump(x))
+    return 0;
+  if (sexp_bignum_length(x) > 1)
+    return sexp_bignum_sign(x) * (
+      (((long long)(sexp_bignum_data(x)[1]))<<(8*sizeof(sexp_bignum_data(x)[0]))) + sexp_bignum_data(x)[0]);
+  return sexp_bignum_sign(x) * sexp_bignum_data(x)[0];
+}
+
+unsigned long long sexp_bignum_to_uint(sexp x) {
+  if (!sexp_bignump(x))
+    return 0;
+  if (sexp_bignum_length(x) > 1)
+    return (((unsigned long long)(sexp_bignum_data(x)[1]))<<(8*sizeof(sexp_bignum_data(x)[0]))) + sexp_bignum_data(x)[0];
+  return sexp_bignum_data(x)[0];
+}
+#endif
 
 #define double_trunc_10s_digit(f) (trunc((f)/10.0)*10.0)
 #define double_10s_digit(f) ((f)-double_trunc_10s_digit(f))

include/chibi/bignum.h

@@ -31,10 +31,14 @@ typedef long long sexp_lsint_t;
 
 #if !SEXP_USE_CUSTOM_LONG_LONGS
 
+#define sexp_lsint_fits_sint(x) ((sexp_sint_t)x == x)
+#define sexp_luint_fits_uint(x) ((sexp_uint_t)x == x)
 #define lsint_from_sint(v) ((sexp_lsint_t)v)
 #define luint_from_uint(v) ((sexp_luint_t)v)
 #define lsint_to_sint(v) ((sexp_sint_t)v)
 #define luint_to_uint(v) ((sexp_uint_t)v)
+#define lsint_to_sint_hi(v) ((sexp_sint_t) ((v) >> (8*sizeof(sexp_sint_t))))
+#define luint_to_uint_hi(v) ((sexp_uint_t) ((v) >> (8*sizeof(sexp_uint_t))))
 #define lsint_negate(v) (-((sexp_lsint_t)v))
 #define luint_eq(a, b) (((sexp_luint_t)a)==((sexp_luint_t)b))
 #define luint_lt(a, b) (((sexp_luint_t)a)<((sexp_luint_t)b))
@@ -54,6 +58,17 @@ typedef long long sexp_lsint_t;
 
 #else
 
+static inline int lsint_lt_0(sexp_lsint_t a) {
+  return a.hi < 0;
+}
+
+static inline int sexp_lsint_fits_sint(sexp_lsint_t x) {
+  return x.hi == (((int64_t)x.lo)>>63) && ((sexp_sint_t)x.lo == x.lo);
+}
+static inline int sexp_luint_fits_uint(sexp_luint_t x) {
+  return x.hi == 0 && ((sexp_uint_t)x.lo == x.lo);
+}
+
 static inline sexp_luint_t luint_from_lsint(sexp_lsint_t v) {
   sexp_luint_t result;
   result.hi = v.hi;
@@ -83,13 +98,29 @@ static inline sexp_luint_t luint_from_uint(sexp_uint_t v) {
 }
 
 static inline sexp_sint_t lsint_to_sint(sexp_lsint_t v) {
-  return v.lo;
+  return lsint_lt_0(v) ? -v.lo : v.lo;
 }
 
 static inline sexp_uint_t luint_to_uint(sexp_luint_t v) {
   return v.lo;
 }
 
+static inline sexp_sint_t lsint_to_sint_hi(sexp_lsint_t v) {
+#if SEXP_64_BIT
+  return v.hi;
+#else
+  return v.lo >> 32;
+#endif
+}
+
+static inline sexp_uint_t luint_to_uint_hi(sexp_luint_t v) {
+#if SEXP_64_BIT
+  return v.hi;
+#else
+  return v.lo >> 32;
+#endif
+}
+
 static inline sexp_lsint_t lsint_negate(sexp_lsint_t v) {
   sexp_luint_t a;
   a.hi = ~v.hi;
@@ -115,7 +146,7 @@ static inline sexp_lsint_t lsint_negate(sexp_lsint_t v) {
 
   uint64_t sumHiHi = aHiHi + carry;
   uint64_t resultHiHi = sumHiHi & 0xFFFFFFFF;
-  //carry = sumHiHi >> 32;
+  /* carry = sumHiHi >> 32; */
 
   sexp_lsint_t result;
   result.hi = (resultHiHi << 32) | resultHiLo;
@@ -136,10 +167,6 @@ static inline int luint_lt(sexp_luint_t a, sexp_luint_t b) {
     return a.lo < b.lo;
 }
 
-static inline int lsint_lt_0(sexp_lsint_t a) {
-  return a.hi < 0;
-}
-
 static inline sexp_luint_t luint_shl(sexp_luint_t v, size_t shift) {
   if (shift == 0)
     return v;

include/chibi/sexp.h

@@ -961,8 +961,8 @@ SEXP_API int sexp_idp(sexp x);
 SEXP_API sexp sexp_make_integer_from_lsint(sexp ctx, sexp_lsint_t x);
 SEXP_API sexp sexp_make_unsigned_integer_from_luint(sexp ctx, sexp_luint_t x);
 #if SEXP_USE_CUSTOM_LONG_LONGS
-#define sexp_make_integer(ctx, x) sexp_make_fixnum(x)
+SEXP_API sexp sexp_make_integer(sexp ctx, long long x);
-#define sexp_make_unsigned_integer(ctx, x) sexp_make_fixnum(x)
+SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, unsigned long long x);
 #else
 SEXP_API sexp sexp_make_integer(sexp ctx, sexp_lsint_t x);
 SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
@@ -1046,12 +1046,24 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
     sexp_negate_exact(x)
 
 #if SEXP_USE_FLONUMS || SEXP_USE_BIGNUMS
-#define sexp_uint_value(x) ((sexp_uint_t)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignump(x) ? sexp_bignum_data(x)[0] : 0))
+
-#define sexp_sint_value(x) ((sexp_sint_t)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignump(x) ? sexp_bignum_sign(x)*sexp_bignum_data(x)[0] : 0))
+#if SEXP_64_BIT
+#define sexp_bignum_to_sint(x) (sexp_bignum_sign(x)*sexp_bignum_data(x)[0])
+#define sexp_bignum_to_uint(x) (sexp_bignum_data(x)[0])
 #else
+SEXP_API long long sexp_bignum_to_sint(sexp x);
+SEXP_API unsigned long long sexp_bignum_to_uint(sexp x);
+#endif
+
+#define sexp_uint_value(x) ((unsigned long long)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignump(x) ? sexp_bignum_to_uint(x) : 0))
+#define sexp_sint_value(x) ((long long)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignump(x) ? sexp_bignum_to_sint(x) : 0))
+
+#else
+
 #define sexp_uint_value(x) ((sexp_uint_t)sexp_unbox_fixnum(x))
 #define sexp_sint_value(x) ((sexp_sint_t)sexp_unbox_fixnum(x))
-#endif
+
+#endif	/* SEXP_USE_FLONUMS || SEXP_USE_BIGNUMS */
 
 #define sexp_shift_epoch(x) ((x)-SEXP_EPOCH_OFFSET)
 #define sexp_unshift_epoch(x) ((x)+SEXP_EPOCH_OFFSET)

lib/chibi/bytevector-test.sld

@@ -62,7 +62,9 @@
            ((null? ls))
          (let ((bv (make-bytevector 8 0)))
            (bytevector-ieee-double-native-set! bv 0 (car ls))
-           (test (bytevector-copy f64-le i (+ i 8)) (values bv)))))
+           ;;(test (bytevector-copy f64-le i (+ i 8)) (values bv))
+           (test (car ls)
+             (bytevector-ieee-double-native-ref bv 0)))))
 
       (test-group "ber integers"
         (do ((ls '(0 1 128 16383 32767

lib/chibi/bytevector.sld

@@ -35,7 +35,7 @@
    (else (import (srfi 60))))
   (include "bytevector.scm")
   (cond-expand
-   ;;(chibi
+   (chibi
-   ;; (include-shared "ieee-754-native"))
+    (import (except (scheme bytevector) bytevector-copy!)))
    (else
     (include "ieee-754.scm"))))

lib/scheme/bytevector-test.sld

@@ -280,41 +280,33 @@
 
       (test-begin "2.7 Operations on 64-bit Integers")
 
-      (test-assert "bytevector-u64-ref"
       (let ((b (u8-list->bytevector
                 '(255 255 255 255 255 255 255 255
                       255 255 255 255 255 255 255 253))))
-          (and (equal? (bytevector-u64-ref b 8 (endianness little))
+        (test #xfdffffffffffffff
-                       #xfdffffffffffffff)
+            (bytevector-u64-ref b 8 (endianness little)))
-               (equal? (bytevector-u64-ref b 8 (endianness big))
+        (test #xfffffffffffffffd
-                       #xfffffffffffffffd))))
+            (bytevector-u64-ref b 8 (endianness big)))
+        (test -144115188075855873
+            (bytevector-s64-ref b 8 (endianness little)))
+        (test -3
+            (bytevector-s64-ref b 8 (endianness big))))
 
-      (test-assert "bytevector-s64-ref"
-        (let ((b (u8-list->bytevector
-                  '(255 255 255 255 255 255 255 255
-                        255 255 255 255 255 255 255 253))))
-          (and (equal? (bytevector-s64-ref b 8 (endianness little))
-                       -144115188075855873)
-               (equal? (bytevector-s64-ref b 8 (endianness big))
-                       -3))))
-
-      (test-assert "bytevector-{u64,s64}-ref"
       (let ((b (make-bytevector 8))
             (big 9333333333333333333))
         (bytevector-u64-set! b 0 big (endianness little))
-          (and (equal? (bytevector-u64-ref b 0 (endianness little))
+        (test big
-                       big)
+            (bytevector-u64-ref b 0 (endianness little)))
-               (equal? (bytevector-s64-ref b 0 (endianness little))
+        (test (- big (expt 2 64))
-                       (- big (expt 2 64))))))
+            (bytevector-s64-ref b 0 (endianness little))))
 
-      (test-assert "bytevector-{u64,s64}-native-{ref,set!}"
       (let ((b (make-bytevector 8))
             (big 9333333333333333333))
         (bytevector-u64-native-set! b 0 big)
-          (and (equal? (bytevector-u64-native-ref b 0)
+        (test big
-                       big)
+            (bytevector-u64-native-ref b 0))
-               (equal? (bytevector-s64-native-ref b 0)
+        (test (- big (expt 2 64))
-                       (- big (expt 2 64))))))
+            (bytevector-s64-native-ref b 0)))
 
       (test-assert "ref/set! with zero"
         (let ((b (make-bytevector 8)))

sexp.c

@@ -3058,13 +3058,13 @@ sexp sexp_list_to_uvector_op(sexp ctx, sexp self, sexp_sint_t n, sexp etype, sex
         case SEXP_U16:
           ((unsigned short*)sexp_uvector_data(res))[i] = sexp_unbox_fixnum(sexp_car(ls)); break;
         case SEXP_S32:
-          ((signed int*)sexp_uvector_data(res))[i] = sexp_sint_value(sexp_car(ls)); break;
+          ((int32_t*)sexp_uvector_data(res))[i] = sexp_sint_value(sexp_car(ls)); break;
         case SEXP_U32:
-          ((unsigned int*)sexp_uvector_data(res))[i] = sexp_uint_value(sexp_car(ls)); break;
+          ((uint32_t*)sexp_uvector_data(res))[i] = sexp_uint_value(sexp_car(ls)); break;
         case SEXP_S64:
-          ((sexp_sint_t*)sexp_uvector_data(res))[i] = sexp_sint_value(sexp_car(ls)); break;
+          ((int64_t*)sexp_uvector_data(res))[i] = sexp_sint_value(sexp_car(ls)); break;
         case SEXP_U64:
-          ((sexp_uint_t*)sexp_uvector_data(res))[i] = sexp_uint_value(sexp_car(ls)); break;
+          ((uint64_t*)sexp_uvector_data(res))[i] = sexp_uint_value(sexp_car(ls)); break;
 #if SEXP_USE_FLONUMS
         case SEXP_F32:
           ((float*)sexp_uvector_data(res))[i] = sexp_to_double(ctx, sexp_car(ls)); break;

tests/build/build-opts.txt

@@ -35,5 +35,7 @@ CFLAGS=-DSEXP_USE_STATIC_LIBS_NO_INCLUDE=0;CPPFLAGS=-DSEXP_USE_STATIC_LIBS=1
 CPPFLAGS=-DSEXP_USE_MUTABLE_STRINGS=0
 CPPFLAGS=-DSEXP_USE_STRING_INDEX_TABLE=1
 CPPFLAGS=-DSEXP_USE_STRICT_TOPLEVEL_BINDINGS=1
+CPPFLAGS=-DSEXP_USE_FIXED_CHUNK_SIZE_HEAPS=1
 CPPFLAGS=-DSEXP_USE_NO_FEATURES=1
 CFLAGS=-std=c89
+CFLAGS=-m32;LDFLAGS=-m32