more progress on the AMD64 front, fixing more numeric and more cogen

64-bit bugs.

scheme/ikarus.compiler.altcogen.ss

@@ -2348,13 +2348,11 @@
                    [else x]))])]
            [(fl:load fl:store fl:add! fl:sub! fl:mul! fl:div!
              fl:load-single fl:store-single) 
-            (cond
+            (check-disp-arg a
-              [(mem? a) 
+              (lambda (a)
-               (let ([u (mku)])
+                (check-disp-arg b
-                 (make-seq
+                  (lambda (b)
-                   (E (make-asm-instr 'move u a))
+                    (make-asm-instr op a b)))))]
-                   (E (make-asm-instr op u b))))]
-              [else x])]
            [(fl:from-int fl:shuffle) x]
            [else (error who "invalid effect op" op)])]
         [(primcall op rands) 

scheme/ikarus.main.ss

@@ -27,11 +27,14 @@
     (printf "Ikarus Scheme version ~a\n" 
       (if (zero? (string-length ikarus-revision))
           ikarus-version
-          (format "~a+ (revision ~a, build ~a)"
+          (format "~a+ (revision ~a, build ~a~a)"
             ikarus-version
             (+ 1 (string->number ikarus-revision))
             (let-syntax ([ds (lambda (x) (date-string))])
-              ds))))
+              ds)
+            (if (= (fixnum-width) 30)
+                ""
+                ", 64-bit"))))
     (display "Copyright (c) 2006-2008 Abdulaziz Ghuloum\n\n"))
 
   (define (init-library-path) 

scheme/ikarus.numerics.ss

@@ -3470,13 +3470,25 @@
     (define (pos-fxbitcount n)
       ;;; nifty parrallel count from:
       ;;; http://infolab.stanford.edu/~manku/bitcount/bitcount.html
-      (let ([m0 #x15555555]
+      (case (fixnum-width)
-            [m1 #x13333333]
+        [(30)
-            [m2 #x0f0f0f0f])
+         (let ([m0 #x15555555]
-        (let* ([n ($fx+ ($fxlogand n m0) ($fxlogand ($fxsra n 1) m0))]
+               [m1 #x13333333]
-               [n ($fx+ ($fxlogand n m1) ($fxlogand ($fxsra n 2) m1))]
+               [m2 #x0f0f0f0f])
-               [n ($fx+ ($fxlogand n m2) ($fxlogand ($fxsra n 4) m2))])
+           (let* ([n ($fx+ ($fxlogand n m0) ($fxlogand ($fxsra n 1) m0))]
-          ($fxmodulo n 255))))
+                  [n ($fx+ ($fxlogand n m1) ($fxlogand ($fxsra n 2) m1))]
+                  [n ($fx+ ($fxlogand n m2) ($fxlogand ($fxsra n 4) m2))])
+             ($fxmodulo n 255)))]
+        [else
+         (let ([m0 #x0555555555555555]
+               [m1 #x0333333333333333]
+               [m2 #x0f0f0f0f0f0f0f0f]
+               [m3 #x00ff00ff00ff00ff])
+           (let* ([n ($fx+ ($fxlogand n m0) ($fxlogand ($fxsra n 1) m0))]
+                  [n ($fx+ ($fxlogand n m1) ($fxlogand ($fxsra n 2) m1))]
+                  [n ($fx+ ($fxlogand n m2) ($fxlogand ($fxsra n 4) m2))]
+                  [n ($fx+ ($fxlogand n m3) ($fxlogand ($fxsra n 8) m3))])
+             ($fxmodulo n 255)))]))
     (define ($fxbitcount n)
       (if ($fx< n 0)
           (fxlognot (pos-fxbitcount (fxlognot n)))
@@ -3510,15 +3522,24 @@
         [else (die 'bitwise-bit-count "not an exact integer" n)])))
   
   (define (fxlength x) 
+    (define (fxlength32 x)
+      (let ([fl ($fixnum->flonum x)])
+         (let ([sbe ($fxlogor 
+                      ($fxsll ($flonum-u8-ref fl 0) 4)
+                      ($fxsra ($flonum-u8-ref fl 1) 4))])
+           (cond
+             [($fx= sbe 0) 0]
+             [else ($fx- sbe 1022)]))))
+    (define (fxlength64 x)
+      (if ($fx> x #x7FFFFFFF)
+          ($fx+ 31 (fxlength32 ($fxsra x 31)))
+          (fxlength32 x)))
     (if (fixnum? x) 
-        (let ([fl ($fixnum->flonum
+        (case (fixnum-width)
-                    (if ($fx< x 0) ($fxlognot x) x))])
+          [(30)
-          (let ([sbe ($fxlogor 
+           (fxlength32 (if ($fx< x 0) ($fxlognot x) x))]
-                       ($fxsll ($flonum-u8-ref fl 0) 4)
+          [else
-                       ($fxsra ($flonum-u8-ref fl 1) 4))])
+           (fxlength64 (if ($fx< x 0) ($fxlognot x) x))])
-            (cond
-              [($fx= sbe 0) 0]
-              [else ($fx- sbe 1022)])))
         (die 'fxlength "not a fixnum" x)))
 
   (define (fxbit-set? x i)

scheme/last-revision

@@ -1 +1 @@
-1541
+1542

scheme/pass-specify-rep-primops.ss

@@ -1070,13 +1070,19 @@
 
 (define-primop $fixnum->flonum unsafe
   [(V fx) 
-   (with-tmp ([x (prm 'alloc (K (align flonum-size)) (K vector-tag))])
+   (case wordsize
-     (prm 'mset x (K (- vector-tag)) (K flonum-tag))
+     [(4)
-     (prm 'fl:from-int
+      (with-tmp ([x (prm 'alloc (K (align flonum-size)) (K vector-tag))])
-          (K 0) ; dummy
+        (prm 'mset x (K (- vector-tag)) (K flonum-tag))
-          (prm 'sra (T fx) (K fx-shift)))
+        (prm 'fl:from-int
-     (prm 'fl:store x (K (- disp-flonum-data vector-tag)))
+             (K 0) ; dummy
-     x)])
+             (prm 'sra (T fx) (K fx-shift)))
+        (prm 'fl:store x (K (- disp-flonum-data vector-tag)))
+        x)]
+     [else 
+      (with-tmp ([f (cogen-value-$make-flonum)])
+        (make-forcall "ikrt_fixnum_to_flonum" (list (T fx) f)))])])
+
 
 (define (check-flonums ls code)
   (cond

scheme/run-tests.64.ss

@@ -53,33 +53,34 @@
   (f 0 536870911000 536870911)
   (printf "[exact-integer-sqrt] Happy Happy Joy Joy\n"))
 
-;(test-bitwise-op)
+(test-bitwise-op)
-  ;(test-parse-flonums)
+(test-parse-flonums)
-;(test-case-folding)
+(test-case-folding)
-  ;(test-reader)
+(test-reader)
-;(test-char-syntax)
+(test-char-syntax)
   ;(test-bytevectors)
-;(test-strings)
+(test-strings)
   ;(test-exact-integer-sqrt)
-  ;(test-bignum-to-flonum)
+(test-bignum-to-flonum)
-  ;(test-bignum->flonum)
+;(test-bignum->flonum)
-  ;(test-string-to-number)
+(test-string-to-number)
-  ;(test-div-and-mod)
+(test-div-and-mod)
-  ;(test-bignums)
+(test-bignums)
-  ;(test-bignum-length)
+(test-bignum-length)
-  ;(test-fxcarry)
+(test-fxcarry)
-  ;(test-lists)
+(test-lists)
-  ;(test-hashtables)
+(test-hashtables)
-  ;(test-input-ports)
+(test-input-ports)
-  ;(test-bignum-conversion)
+(test-bignum-conversion)
-  ;(test-fldiv-and-mod)
+(test-fldiv-and-mod)
-  ;(test-fldiv0-and-mod0)
+(test-fldiv0-and-mod0)
-  ;(test-fxdiv-and-mod)
+(test-fxdiv-and-mod)
-  ;(test-fxdiv0-and-mod0)
+(test-fxdiv0-and-mod0)
-  ;(test-fxlength)
+(test-fxlength)
-  (test-bitwise-bit-count)
+(test-bitwise-bit-count)
   ;(test-io)
-;(test-sorting)
+(test-sorting)
   ;(test-fasl)
-  ;(test-numerics)
+(test-numerics)
+
 (printf "Happy Happy Joy Joy\n")

scheme/tests/bignum-to-flonum.ss

@@ -16,11 +16,11 @@
 
   (define (testnum x) 
     (define precision 53)
-    (assert (bignum? x)) 
+    ;(assert (bignum? x)) 
     (let ([fl (inexact x)])
       (let ([n (if (> x 0) x (- x))])
         (let ([bits (bitwise-length n)])
-          (printf "bits = ~s\n" bits)
+          (printf "bits(~s) = ~s\n" n bits)
           (cond
             [(<= bits precision) 
              (unless (= x (exact fl))

scheme/tests/bignums.ss

@@ -200,10 +200,6 @@
     (test #x-1000000000000001))
 
 
-
-
-
-
   (define (test-bitwise-bit-count)
     (define (test n)
       (define (pos-count-bits n)
@@ -219,13 +215,15 @@
             [bc1 (count-bits n)])
         (unless (= bc0 bc1)
           (error 'test-bitcount "failed/expected/got" n bc1 bc0))))
-    (define (test-fx n)
+    (define (test-fx count n inc)
       (when (fixnum? n) 
-        (when (zero? (fxlogand n #x7FFFFFF))
+        (when (zero? (fxlogand count #xFFFF))
           (printf "bitwise-bit-count ~s\n" n))
         (test n)
-        (test-fx (+ n 512))))
+        (test-fx (+ count 1) (+ n inc) inc)))
-    (test-fx (least-fixnum))
+    (if (= (fixnum-width) 30)
+        (test-fx 0 (least-fixnum) #xFF)
+        (test-fx 0 (least-fixnum) #xFF00000000))
     (test 28472347823493290482390849023840928390482309480923840923840983)
     (test -847234234903290482390849023840928390482309480923840923840983))
 

scheme/tests/fixnums.ss

@@ -98,12 +98,12 @@
             [c1 (fxlength x)])
         (unless (= c0 c1) 
           (error 'test-fxlength "failed/expected/got" x c0 c1))))
-    (define (fxtest x)
+    (define (test-fx count n inc)
-      (when (fixnum? x) 
+      (when (fixnum? n) 
-        (when (zero? (bitwise-and x #xFFFFFFF)) 
+        (when (zero? (fxlogand count #xFFFF))
-          (printf "fxlength ~s\n" x))
+          (printf "bitwise-bit-count ~s\n" n))
-        (test x) 
+        (test n)
-        (fxtest (+ x #x100))))
+        (test-fx (+ count 1) (+ n inc) inc)))
     (test 0)
     (test 1)
     (test 2)
@@ -111,6 +111,8 @@
     (test -1)
     (test -2)
     (test -3)
-    (fxtest (least-fixnum)))
+    (if (= (fixnum-width) 30)
+        (test-fx 0 (least-fixnum) #xFF)
+        (test-fx 0 (least-fixnum) #xFF00000000)) )
   )
 

src/ikarus-collect.c

@@ -374,6 +374,7 @@ extern void verify_integrity(ikpcb* pcb, char*);
 
 ikpcb* 
 ik_collect(unsigned long int mem_req, ikpcb* pcb){
+//  fprintf(stderr, "ik_collect ...\n");
 #ifndef NDEBUG
   verify_integrity(pcb, "entry");
 #endif
@@ -562,7 +563,7 @@ ik_collect(unsigned long int mem_req, ikpcb* pcb){
   }
  
 
-//  fprintf(stderr, "ik_collect\n");
+  //fprintf(stderr, "ik_collect done\n");
   return pcb;
 }
 

src/ikarus-data.h

@@ -206,7 +206,7 @@ ikptr ik_unsafe_alloc(ikpcb* pcb, int size);
 ikptr ik_safe_alloc(ikpcb* pcb, int size);
 
 #define IK_HEAP_EXT_SIZE  (32 * 4096)
-#define IK_HEAPSIZE       (1024 * ((wordsize==4)?1:16) * 4096) /* 4/8 MB */
+#define IK_HEAPSIZE       (1024 * ((wordsize==4)?1:32) * 4096) /* 4/8 MB */
 
 #define wordsize ((int)(sizeof(ikptr)))
 #define wordshift ((wordsize == 4)?2:3)

src/ikarus-flonums.c

@@ -238,9 +238,7 @@ ikrt_fx_log(ikptr x, ikpcb* pcb){
 
 
 ikptr
-ikrt_fixnum_to_flonum(ikptr x, ikpcb* pcb){
+ikrt_fixnum_to_flonum(ikptr x, ikptr r, ikpcb* pcb){
-  ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
-  ref(r, -vector_tag) = (ikptr)flonum_tag;
   flonum_data(r) = unfix(x);
   return r;
 }

src/ikarus-numerics.c

@@ -1825,7 +1825,7 @@ ikrt_bnfx_modulo(ikptr x, ikptr y /*, ikpcb* pcb */){
 
 
 static int
-limb_length(unsigned int n){
+limb_length(unsigned long int n){
   int i=0;
   while(n != 0){
     n = n >> 1;
@@ -1844,7 +1844,7 @@ ikrt_bignum_length(ikptr x){
   int n0 = limb_length(last);
   if(((unsigned long int) fst) & bignum_sign_mask){
     /* negative */
-    if (last == (mp_limb_t)(1<<(n0-1))){
+    if (last == (mp_limb_t)(1L<<(n0-1))){
       /* single bit set in last limb */
       int i;
       for(i=0; i<(sn-1); i++){
@@ -1966,47 +1966,37 @@ ikrt_bignum_to_flonum64(ikptr bn, ikptr more_bits, ikptr fl){
   double pos_result;
   if(limb_count == 1){
     pos_result = sp[0];
-  } else if (limb_count == 2){
-    mp_limb_t lo = sp[0];
-    mp_limb_t hi = sp[1];
-    pos_result = hi;
-    pos_result = pos_result * 4294967296.0;
-    pos_result = pos_result + lo;
   } else {
     mp_limb_t hi = sp[limb_count-1];
-    mp_limb_t mi = sp[limb_count-2];
     int bc = limb_size(hi);
-    if(bc < 32){
+    if(bc < 64){
-      mp_limb_t lo = sp[limb_count-3];
+      mp_limb_t mi = sp[limb_count-2];
-      hi = (hi << (32-bc)) | (mi >> bc);
+      hi = (hi << (64-bc)) | (mi >> bc);
-      mi = (mi << (32-bc)) | (lo >> bc);
     }
-    /* now hi has 32 full bits, and mi has 32 full bits */
+    /* now hi has 64 full bits */
-    mp_limb_t mask = ((1<<(64-PRECISION)) - 1);
+    mp_limb_t mask = ((1L<<(64-PRECISION)) - 1);
-    if((mi & mask) == ((mask+1)>>1)){
+    if((hi & mask) == ((mask+1)>>1)){
       /* exactly at break point */
-      if(((sp[limb_count-3] << (32-bc)) == 0) &&
+      if(((sp[limb_count-2] << (64-bc)) == 0) &&
-          all_zeros(sp, sp+limb_count-4) &&
+          all_zeros(sp, sp+limb_count-3) &&
           (more_bits == 0)){
-        if(mi & (1<<(64-PRECISION))){
+        if(hi & (1L<<(64-PRECISION))){
           /* odd number, round to even */
-          mi = mi | mask;
+          hi = hi | mask;
         }
       } else {
         /* round up */
-        mi = mi | mask;
+        hi = hi | mask;
       }
-    } else if ((mi & mask) > ((mask+1)>>1)){
+    } else if ((hi & mask) > ((mask+1)>>1)){
       /* also round up */
-      mi = mi | mask;
+      hi = hi | mask;
     } else {
       /* keep it to round down */
     }
     pos_result = hi;
-    pos_result = pos_result * 4294967296.0;
-    pos_result = pos_result + mi;
     int bignum_bits = bc + (mp_bits_per_limb * (limb_count-1));
-    int exponent = bignum_bits - (2 * mp_bits_per_limb);
+    int exponent = bignum_bits - mp_bits_per_limb;
     while(exponent){
       pos_result *= 2.0;
       exponent -= 1;