all existing tests pass under 64-bit

scheme/ikarus.compiler.altcogen.ss

@@ -608,7 +608,7 @@
        (do-bind lhs* rhs* (E e))]
       [(primcall op rands)
        (case op
-         [(mset bset bset/c bset/h mset32)
+         [(mset bset bset/c mset32)
           (S* rands
               (lambda (s*)
                 (make-asm-instr op
@@ -1508,7 +1508,7 @@
          [(cltd) 
           (mark-reg/vars-conf! edx vs)
           (R s vs (rem-reg edx rs) fs ns)]
-         [(mset mset32 bset bset/c bset/h 
+         [(mset mset32 bset bset/c 
            fl:load fl:store fl:add! fl:sub! fl:mul! fl:div! fl:from-int
            fl:shuffle fl:load-single fl:store-single) 
           (R* (list s d) vs rs fs ns)]
@@ -1711,7 +1711,7 @@
                  (make-primcall 'nop '())]
                 [else
                  (make-asm-instr op d s)]))]
-           [(logand logor logxor int+ int- int* mset bset mset32 bset/c bset/h 
+           [(logand logor logxor int+ int- int* mset bset mset32 bset/c 
               sll sra srl bswap!
               cltd idiv int-/overflow int+/overflow int*/overflow
               fl:load fl:store fl:add! fl:sub! fl:mul! fl:div!
@@ -1946,7 +1946,7 @@
               (set-union (set-union (R v) (R d)) s))]
            [(bset/c)
             (set-union (set-union (R v) (R d)) s)]
-           [(bset/h bset)
+           [(bset)
             (when (var? v)
               (for-each (lambda (r) (add-edge! g v r))
                 non-8bit-registers))
@@ -2316,7 +2316,7 @@
                         (eq? b ecx))
               (error who "invalid shift" b))
             x]
-           [(mset mset32 bset bset/c bset/h) 
+           [(mset mset32 bset bset/c ) 
             (cond
               [(not (small-operand? b))
                (let ([u (mku)])
@@ -2646,7 +2646,6 @@
               ac
               (cons `(movb ,(R/l s) ,(R/l d)) ac))]
          [(bset/c) (cons `(movb ,(BYTE s) ,(R d)) ac)]
-         [(bset/h) (cons `(movb ,(reg/h s) ,(R d)) ac)]
          [(bset)   (cons `(movb ,(reg/l s) ,(R d)) ac)]
          [(sll)  (cons `(sall ,(R/cl s) ,(R d)) ac)]
          [(sra)  (cons `(sarl ,(R/cl s) ,(R d)) ac)]

scheme/ikarus.enumerations.ss

@@ -28,7 +28,7 @@
 
   (define-record-type enum
     (fields g univ values)
-    (opaque #t) (sealed #t)
+    (opaque #f) (sealed #t)
     (nongenerative))
   
   (define (remove-dups ls)
@@ -74,8 +74,12 @@
           (unless (memq s (enum-univ x))
             (die 'enum-set-constructor "not in the universe" s x)))
         ls)
+      (let ([idx (enum-set-indexer x)])
         (make-enum (enum-g x) (enum-univ x)
-        (remove-dups ls))))
+          (map car
+            (list-sort (lambda (a b) (< (cdr a) (cdr b)))
+              (map (lambda (x) (cons x (idx x)))
+                   ls)))))))
     
   (define (enum-set->list x)
     (unless (enum? x) 

scheme/ikarus.fasl.ss

@@ -90,7 +90,16 @@
         (char->integer x)
         (die who "unexpected eof inside a fasl object")))
 
+  (define (read-u32 p)
+    (let* ([c0 (read-u8 p)]
+           [c1 (read-u8 p)]
+           [c2 (read-u8 p)]
+           [c3 (read-u8 p)])
+      (bitwise-ior c0 (sll c1 8) (sll c2 16) (sll c3 24))))
+    
   (define (read-fixnum p)
+    (case (fixnum-width)
+      [(30)
        (let* ([c0 (read-u8 p)]
               [c1 (read-u8 p)]
               [c2 (read-u8 p)]
@@ -108,8 +117,20 @@
                 (fxlogor (fxlogor (fxsra c0 2) 
                                   (fxsll c1 6))
                          (fxlogor (fxsll c2 14) 
-                               (fxsll c3 22)))))])))
+                                  (fxsll c3 22)))))]))]
+      [else
+       (let* ([u0 (read-u32 p)]
+              [u1 (read-u32 p)])
+         (if (<= u1 #x7FFFFFF)
+             (sra (bitwise-ior u0 (sll u1 32)) 3)
+             (let ([u0 (fxlogand #xFFFFFFFF (fxlognot u0))]
+                   [u1 (fxlogand #xFFFFFFFF (fxlognot u1))])
+               (fx- -1 
+                  (fxlogor (fxsra u0 3) (fxsll u1 29))))))]))
+
   (define (read-int p)
+    (case (fixnum-width)
+      [(30)
        (let* ([c0 (char->int (read-u8-as-char p))]
               [c1 (char->int (read-u8-as-char p))]
               [c2 (char->int (read-u8-as-char p))]
@@ -127,7 +148,16 @@
                 (fxlogor (fxlogor c0 
                                   (fxsll c1 8))
                          (fxlogor (fxsll c2 16) 
-                               (fxsll c3 24)))))]))) 
+                                  (fxsll c3 24)))))]))]
+      [else
+       (let* ([u0 (read-u32 p)]
+              [u1 (read-u32 p)])
+         (if (<= u1 #x7FFFFFF)
+             (bitwise-ior u0 (sll u1 32))
+             (let ([u0 (fxlogand #xFFFFFFFF (fxlognot u0))]
+                   [u1 (fxlogand #xFFFFFFFF (fxlognot u1))])
+               (- -1 (bitwise-ior u0 (sll u1 32))))))]))
+
   (define (do-read p)
     (define marks (make-vector 1 #f))
     (define (max x y)
@@ -380,7 +410,9 @@
       (assert-eq? (read-u8-as-char p) #\I)
       (assert-eq? (read-u8-as-char p) #\K)
       (assert-eq? (read-u8-as-char p) #\0)
-      (assert-eq? (read-u8-as-char p) #\1)
+      (case (fixnum-width)
+        [(30) (assert-eq? (read-u8-as-char p) #\1)]
+        [else (assert-eq? (read-u8-as-char p) #\2)])
       (let ([v (do-read p)])
         (unless (port-eof? p)
           (printf "port did not reach eof\n"))

scheme/ikarus.intel-assembler.ss

@@ -532,8 +532,8 @@
   ;(CODE c0 (CODE c1 (RM r rm ac))))
   (REX+RM r rm (CODE c0 (CODE c1 (RM r rm ac)))))
 (define (CCR c0 c1 r ac)
-  (CODE c0 (CODE+r c1 r ac)))
+  ;(CODE c0 (CODE+r c1 r ac)))
-  ;(REX+r r (CODE c0 (CODE+r c1 r ac))))
+  (REX+r r (CODE c0 (CODE+r c1 r ac))))
 (define (CCCR* c0 c1 c2 r rm ac)
   ;(CODE c0 (CODE c1 (CODE c2 (RM r rm ac)))))
   (REX+RM r rm (CODE c0 (CODE c1 (CODE c2 (RM r rm ac))))))

scheme/ikarus.numerics.ss

@@ -2574,23 +2574,14 @@
   (define exact-integer-sqrt
     (lambda (x)
       (define who 'exact-integer-sqrt)
-      (define (fxsqrt x i k) 
-        (let ([j ($fxsra ($fx+ i k) 1)])
-          (let ([j^2 ($fx* j j)])
-             (if ($fx> j^2 x)
-                 (fxsqrt x i j)
-                 (if ($fx= i j) 
-                     (values j ($fx- x j^2))
-                     (fxsqrt x j k))))))
       (cond
         [(fixnum? x) 
          (cond
-           [($fx< x 0) (die who "invalid argument" x)]
            [($fx= x 0) (values 0 0)]
-           [($fx< x 4) (values 1 ($fx- x 1))]
+           [($fx< x 0) (die who "invalid argument" x)]
-           [($fx< x 9) (values 2 ($fx- x 4))]
+           [else
-           [($fx< x 46340) (fxsqrt x 3 ($fxsra x 1))]
+            (let ([s (foreign-call "ikrt_exact_fixnum_sqrt" x)])
-           [else           (fxsqrt x 215 23171)])]
+              (values s ($fx- x ($fx* s s))))])]
         [(bignum? x) 
          (cond
            [($bignum-positive? x) 

scheme/last-revision

@@ -1 +1 @@
-1542
+1543

scheme/pass-specify-rep-primops.ss

@@ -41,11 +41,9 @@
 
 (define (dirty-vector-set address)
   (define shift-bits 2)
-  (prm 'mset 
+  (prm 'mset32 
-     (prm 'int+
      (prm 'mref pcr (K pcb-dirty-vector))
-          (prm 'sll (prm 'srl address (K pageshift)) (K shift-bits)))
+     (prm 'sll (prm 'srl address (K pageshift)) (K shift-bits))
-     (K 0)
      (K dirty-word)))
 
 (define (smart-dirty-vector-set addr what)
@@ -1062,9 +1060,10 @@
      [(constant i)
       (unless (and (fixnum? i) (fx<= 0 i) (fx<= i 7))
         (interrupt))
-      (prm 'bset/h (T x)
+      (prm 'bset
+         (T x)
          (K (+ (- 7 i) (- disp-flonum-data vector-tag)))
-            (prm 'sll (T v) (K (- 8 fx-shift))))]
+         (prm 'sra (T v) (K fx-shift)))]
      [(known) (error 'translate "$flonum-set!")]
      [else (interrupt)])])
 
@@ -1967,6 +1966,8 @@
 
 (define-primop $bytevector-ieee-double-nonnative-ref unsafe
   [(V bv i)
+   (case wordsize
+     [(4)
       (let ([bvoff (- disp-bytevector-data bytevector-tag)]
             [floff (- disp-flonum-data vector-tag)])
         (with-tmp ([x (prm 'alloc (K (align flonum-size)) (K vector-tag))])
@@ -1979,7 +1980,16 @@
             (with-tmp ([x0 (prm 'mref t (K (+ bvoff wordsize)))])
               (prm 'bswap! x0 x0)
               (prm 'mset x (K floff) x0)))
-       x))])
+          x))]
+     [else
+      (let ([bvoff (- disp-bytevector-data bytevector-tag)]
+            [floff (- disp-flonum-data vector-tag)])
+        (with-tmp ([x (prm 'alloc (K (align flonum-size)) (K vector-tag))])
+          (prm 'mset x (K (- vector-tag)) (K flonum-tag))
+          (with-tmp ([x0 (prm 'mref (T bv) (K bvoff))])
+            (prm 'bswap! x0 x0)
+            (prm 'mset x (K floff) x0))
+          x))])])
 
 
 (define-primop $bytevector-ieee-double-native-set! unsafe
@@ -2021,7 +2031,7 @@
          (with-tmp ([x0 (prm 'mref t (K bvoff))])
            (prm 'bswap! x0 x0)
            (prm 'mset x (K floff) x0)))
-       (prm 'fl:load-single x (K floff))
+       (prm 'fl:load-single x (K (+ floff (- wordsize 4))))
        (prm 'fl:single->double)
        (prm 'fl:store x (K floff))
        x))])
@@ -2041,6 +2051,8 @@
 
 (define-primop $bytevector-ieee-double-nonnative-set! unsafe
   [(E bv i x)
+   (case wordsize
+     [(4)
       (let ([bvoff (- disp-bytevector-data bytevector-tag)]
             [floff (- disp-flonum-data vector-tag)])
         (with-tmp ([t (prm 'int+ (T bv)
@@ -2050,7 +2062,15 @@
             (prm 'mset t (K (+ bvoff wordsize)) x0))
           (with-tmp ([x0 (prm 'mref (T x) (K (+ floff wordsize)))])
             (prm 'bswap! x0 x0)
-         (prm 'mset t (K bvoff) x0))))])
+            (prm 'mset t (K bvoff) x0))))]
+     [else
+      (let ([bvoff (- disp-bytevector-data bytevector-tag)]
+            [floff (- disp-flonum-data vector-tag)])
+        (with-tmp ([t (prm 'int+ (T bv)
+                         (prm 'sra (T i) (K fx-shift)))])
+          (with-tmp ([x0 (prm 'mref (T x) (K floff))])
+            (prm 'bswap! x0 x0)
+            (prm 'mset t (K bvoff) x0))))])])
 
 (define-primop $bytevector-ieee-single-nonnative-set! unsafe
   [(E bv i x)
@@ -2062,9 +2082,15 @@
        (with-tmp ([t (prm 'int+ (T bv)
                         (prm 'sra (T i) (K fx-shift)))])
          (prm 'fl:store-single t (K bvoff))
+         (case wordsize
+           [(4)
             (with-tmp ([x0 (prm 'mref t (K bvoff))])
               (prm 'bswap! x0 x0)
-           (prm 'mset t (K bvoff) x0)))))])
+              (prm 'mset t (K bvoff) x0))]
+           [else
+            (with-tmp ([x0 (prm 'mref32 t (K bvoff))])
+              (prm 'bswap! x0 x0)
+              (prm 'mset32 t (K bvoff) (prm 'sra x0 (K 32))))]))))])
 /section)
 
 (section ;;; strings

scheme/run-tests.64.ss

@@ -58,11 +58,11 @@
 (test-case-folding)
 (test-reader)
 (test-char-syntax)
-  ;(test-bytevectors)
+(test-bytevectors)
 (test-strings)
-  ;(test-exact-integer-sqrt)
+(test-exact-integer-sqrt)
 (test-bignum-to-flonum)
-;(test-bignum->flonum)
+(test-bignum->flonum)
 (test-string-to-number)
 (test-div-and-mod)
 (test-bignums)
@@ -78,9 +78,9 @@
 (test-fxdiv0-and-mod0)
 (test-fxlength)
 (test-bitwise-bit-count)
-  ;(test-io)
+(test-io)
 (test-sorting)
-  ;(test-fasl)
+(test-fasl)
 (test-numerics)
 
 (printf "Happy Happy Joy Joy\n")

scheme/tests/fasl.ss

@@ -15,12 +15,14 @@
   (define (test-fasl) 
     (test 12)
     (test -12)
+    (test (greatest-fixnum))
+    (test (least-fixnum))
     (test 0)
     (test #t)
     (test #f)
     (test '())
-    (test 'hello)
     (test "Hello")
+    (test 'hello)
     (test '(Hello There))
     (test 3498798327498723894789237489324)
     (test -3498798327498723894789237489324)

scheme/tests/framework.ss

@@ -9,7 +9,7 @@
          (lambda ()
            (let ([p p0] [e e0])
              (unless (p e)
-               (error 'test-all "~s failed, got ~s" 
+               (error 'test-all "failed" 
                       '(p0 e0) e))) 
            ...
            (printf "[~s: ~s] Happy Happy Joy Joy\n" 

src/ikarus-collect.c

@@ -1334,6 +1334,11 @@ relocate_new_code(ikptr x, gc_t* gc){
       ikptr displaced_object = obj + obj_off;
       long int next_word = code + code_off + 4;
       ikptr relative_distance = displaced_object - (long int)next_word;
+      if(relative_distance != (int)relative_distance){
+        fprintf(stderr, "relocation error with relative=0x%016lx\n", 
+            relative_distance);
+        exit(-1);
+      }
       *((int*)(code+code_off)) = relative_distance;
       p += (3*wordsize);
     }

src/ikarus-numerics.c

@@ -35,7 +35,7 @@
 // #define most_positive_fixnum 0x1FFFFFFF
 // #define most_negative_fixnum 0x20000000
 
-#define max_digits_per_limb 10
+#define max_digits_per_limb ((wordsize==4)?10:20)
 
 #ifdef NDEBUG
 #define verify_bignum(x,caller) (x)
@@ -2075,6 +2075,15 @@ ikrt_bignum_to_flonum(ikptr bn, ikptr more_bits, ikptr fl){
   return fl;
 }
 
+ikptr 
+ikrt_exact_fixnum_sqrt(ikptr fx /*, ikpcb* pcb*/){
+  mp_limb_t x = unfix(fx);
+  mp_limb_t s;
+  mp_limb_t r;
+  mpn_sqrtrem(&s, &r, &x, 1);
+  return fix(s);
+}
+
 ikptr
 ikrt_exact_bignum_sqrt(ikptr bn, ikpcb* pcb){
   ikptr fst = ref(bn, -vector_tag);