From d02e9fe035f6789cfe00eb86ae6643c18d1dd74f Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Sat, 12 Apr 2008 15:06:55 -0400
Subject: [PATCH] Passing 709 tests in 64-bit mode

---
 scheme/ikarus.compiler.altcogen.ss | 15 +++++----
 scheme/last-revision               |  2 +-
 scheme/pass-specify-rep-primops.ss | 14 ++++----
 scheme/test64.ss                   |  5 +++
 scheme/tests/tests-1.9-req.scm     | 54 ++++++++++++++++++++++++++++++
 src/ikarus-data.h                  |  2 +-
 src/ikarus-enter.S                 | 29 ++++++++++++++--
 src/ikarus-fasl.c                  |  8 ++---
 src/ikarus-io.c                    | 16 +++++++++
 src/ikarus-print.c                 | 14 ++++++++
 10 files changed, 135 insertions(+), 24 deletions(-)

diff --git a/scheme/ikarus.compiler.altcogen.ss b/scheme/ikarus.compiler.altcogen.ss
index 9ee0af0..cf3a814 100644
--- a/scheme/ikarus.compiler.altcogen.ss
+++ b/scheme/ikarus.compiler.altcogen.ss
@@ -576,7 +576,7 @@
        (do-bind lhs* rhs* (E e))]
       [(primcall op rands)
        (case op
-         [(mset bset/c bset/h mset32)
+         [(mset bset bset/c bset/h mset32)
           (S* rands
               (lambda (s*)
                 (make-asm-instr op
@@ -1464,9 +1464,9 @@
          [(cltd) 
           (mark-reg/vars-conf! edx vs)
           (R s vs (rem-reg edx rs) fs ns)]
-         [(mset mset32 bset/c bset/h fl:load fl:store fl:add! fl:sub!
-                fl:mul! fl:div! fl:from-int fl:shuffle
-                fl:load-single fl:store-single) 
+         [(mset mset32 bset bset/c bset/h 
+           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)]
          [else (error who "invalid effect op" (unparse x))])]
       [(ntcall target value args mask size)
@@ -1667,7 +1667,7 @@
                  (make-primcall 'nop '())]
                 [else
                  (make-asm-instr op d s)]))]
-           [(logand logor logxor int+ int- int* mset mset32 bset/c bset/h 
+           [(logand logor logxor int+ int- int* mset bset mset32 bset/c bset/h 
               sll sra srl bswap!
               cltd idiv int-/overflow int+/overflow int*/overflow
               fl:load fl:store fl:add! fl:sub! fl:mul! fl:div!
@@ -1902,7 +1902,7 @@
               (set-union (set-union (R v) (R d)) s))]
            [(bset/c)
             (set-union (set-union (R v) (R d)) s)]
-           [(bset/h)
+           [(bset/h bset)
             (when (var? v)
               (for-each (lambda (r) (add-edge! g v r))
                 non-8bit-registers))
@@ -2272,7 +2272,7 @@
                         (eq? b ecx))
               (error who "invalid shift" b))
             x]
-           [(mset mset32 bset/c bset/h) 
+           [(mset mset32 bset bset/c bset/h) 
             (cond
               [(not (small-operand? b))
                (let ([u (mku)])
@@ -2582,6 +2582,7 @@
               (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)]
          [(srl)  (cons `(shrl ,(R/cl s) ,(R d)) ac)]
diff --git a/scheme/last-revision b/scheme/last-revision
index b9f85c2..b1cff30 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1446
+1447
diff --git a/scheme/pass-specify-rep-primops.ss b/scheme/pass-specify-rep-primops.ss
index c0c76dc..6b57c88 100644
--- a/scheme/pass-specify-rep-primops.ss
+++ b/scheme/pass-specify-rep-primops.ss
@@ -1668,9 +1668,9 @@
                    [(<= 128 c 255) (- c 256)]
                    [else (interrupt)])))]
         [else
-         (prm 'bset/h (T x)
+         (prm 'bset (T x)
                (K (+ i (- disp-bytevector-data bytevector-tag)))
-               (prm 'sll (T c) (K (- 8 fx-shift))))])]
+               (prm 'sra (T c) (K fx-shift)))])]
      [else
       (struct-case c
         [(constant c)
@@ -1684,11 +1684,11 @@
                    [(<= 128 c 255) (- c 256)]
                    [else (interrupt)])))]
         [else
-         (prm 'bset/h (T x)
-               (prm 'int+ 
-                    (prm 'sra (T i) (K fx-shift))
-                    (K (- disp-bytevector-data bytevector-tag)))
-               (prm 'sll (T c) (K (- 8 fx-shift))))])])])
+         (prm 'bset (T x)
+              (prm 'int+ 
+                   (prm 'sra (T i) (K fx-shift))
+                   (K (- disp-bytevector-data bytevector-tag)))
+              (prm 'sra (T c) (K fx-shift)))])])])
 
 (define-primop $bytevector-ieee-double-native-ref unsafe
   [(V bv i)
diff --git a/scheme/test64.ss b/scheme/test64.ss
index 76f6eb3..9fff590 100755
--- a/scheme/test64.ss
+++ b/scheme/test64.ss
@@ -107,6 +107,11 @@
     [fxzero? $fxzero?]
     [vector vector]
     [symbol? symbol?]
+    [make-bytevector $make-bytevector]
+    [bytevector? bytevector?]
+    [bytevector-set! $bytevector-set!]
+    [bytevector-ref $bytevector-u8-ref]
+    [bytevector-length $bytevector-length]
     ))
 
 
diff --git a/scheme/tests/tests-1.9-req.scm b/scheme/tests/tests-1.9-req.scm
index 3dc03c2..1f0d5f7 100644
--- a/scheme/tests/tests-1.9-req.scm
+++ b/scheme/tests/tests-1.9-req.scm
@@ -227,3 +227,57 @@
      (string-set! s 0 #\\)
      s) => "\"\\\\\"\n"]
 )
+
+(add-tests-with-string-output "bytevectors"
+  [(bytevector? (make-bytevector 0)) => "#t\n"]
+  [(make-bytevector 0) => "#vu8()\n"]
+  [(let ([s (make-bytevector 1)]) 
+     (bytevector-set! s 0 12)
+     (bytevector-ref s 0)) => "12\n"]
+  [(let ([s (make-bytevector 2)]) 
+     (bytevector-set! s 0 12)
+     (bytevector-set! s 1 13)
+     (cons (bytevector-ref s 0) (bytevector-ref s 1))) => "(12 . 13)\n"]
+  [(let ([i (let ([f (lambda () 0)]) (f))])
+    (let ([s (make-bytevector 1)]) 
+     (bytevector-set! s i 12)
+     (bytevector-ref s i))) => "12\n"]
+  [(let ([i (let ([f (lambda () 0)]) (f))]
+         [j (let ([f (lambda () 1)]) (f))])
+    (let ([s (make-bytevector 2)]) 
+     (bytevector-set! s i 12)
+     (bytevector-set! s j 13)
+     (cons (bytevector-ref s i) (bytevector-ref s j)))) => "(12 . 13)\n"]
+  [(let ([i (lambda () 0)])
+    (let ([s (make-bytevector 1)]) 
+     (bytevector-set! s 0 12)
+     (bytevector-ref s (i)))) => "12\n"]
+  [(let ([c (lambda () 12)])
+     (let ([s (make-bytevector 1)]) 
+       (bytevector-set! s 0 (c))
+       s)) => "#vu8(12)\n"] 
+  [(let ([i (lambda () 0)])
+    (let ([s (make-bytevector 1)]) 
+     (bytevector-set! s (i) 12)
+     (bytevector-ref s 0))) => "12\n"] 
+  [(let ([c (lambda () 12)])
+    (let ([s (make-bytevector 1)]) 
+     (bytevector-set! s 0 (c))
+     (bytevector-ref s 0))) => "12\n"] 
+  [(let ([i (lambda () 0)] [c (lambda () 12)])
+    (let ([s (make-bytevector 1)]) 
+     (bytevector-set! s (i) (c))
+     (bytevector-ref s (i)))) => "12\n"]
+  [(bytevector-length (make-bytevector 12)) => "12\n"]
+  [(bytevector? (make-vector 12)) => "#f\n"]
+  [(bytevector? (cons 1 2)) => "#f\n"]
+  [(bytevector? 1287) => "#f\n"]
+  [(bytevector? ()) => "#f\n"]
+  [(bytevector? #t) => "#f\n"]
+  [(bytevector? #f) => "#f\n"]
+  [(pair? (make-bytevector 12)) => "#f\n"]
+  [(null? (make-bytevector 12)) => "#f\n"]
+  [(boolean? (make-bytevector 12)) => "#f\n"]
+  [(vector? (make-bytevector 12)) => "#f\n"]
+)
+
diff --git a/src/ikarus-data.h b/src/ikarus-data.h
index efdd1fe..f666c9a 100644
--- a/src/ikarus-data.h
+++ b/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 * 4096) /* 4 MB */
+#define IK_HEAPSIZE       (1024 * ((wordsize==4)?1:2) * 4096) /* 4/8 MB */
 
 #define wordsize (sizeof(ikptr))
 #define wordshift ((wordsize == 4)?2:3)
diff --git a/src/ikarus-enter.S b/src/ikarus-enter.S
index b54827b..50e8d41 100644
--- a/src/ikarus-enter.S
+++ b/src/ikarus-enter.S
@@ -147,8 +147,33 @@ _ik_foreign_call:
   je L_zero_args
   cmpq $-8, %rax
   je L_one_arg
-  movq $0, %rax
-  movq %rax,0(%rax)
+  cmpq $-16, %rax
+  je L_two_args
+  cmpq $-24, %rax
+  je L_three_args
+  cmpq $-32, %rax
+  je L_four_args
+
+  movq $0, %rbx
+  movq %rbx,0(%rbx)
+L_four_args:
+  movq %rdi, %r8        # pcb
+  movq -8(%rbx), %rdi
+  movq -16(%rbx), %rsi
+  movq -24(%rbx), %rdx
+  movq -32(%rbx), %rcx
+  jmp L_set
+L_three_args:
+  movq %rdi, %rcx        # pcb
+  movq -8(%rbx), %rdi
+  movq -16(%rbx), %rsi
+  movq -24(%rbx), %rdx
+  jmp L_set
+L_two_args:
+  movq %rdi, %rdx        # pcb
+  movq -8(%rbx), %rdi
+  movq -16(%rbx), %rsi
+  jmp L_set
 L_one_arg:
   movq %rdi, %rsi
   movq -8(%rbx), %rdi
diff --git a/src/ikarus-fasl.c b/src/ikarus-fasl.c
index 23741dd..a3a0259 100644
--- a/src/ikarus-fasl.c
+++ b/src/ikarus-fasl.c
@@ -110,12 +110,8 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
       }
       close(fd);
     }
-    if(wordsize == 4){
-      ik_exec_code(pcb, v);
-    } else {
-      fprintf(stderr, ";;; EXECING ...\n");
-      ikptr val = ik_exec_code(pcb, v);
-      fprintf(stderr, ";;; RETURNED ...\n");
+    ikptr val = ik_exec_code(pcb, v);
+    if(val != void_object){
       ik_print(val);
     }
   }
diff --git a/src/ikarus-io.c b/src/ikarus-io.c
index e8385e9..2e30032 100644
--- a/src/ikarus-io.c
+++ b/src/ikarus-io.c
@@ -136,6 +136,22 @@ ikrt_read_fd(ikptr fd, ikptr bv, ikptr off, ikptr cnt, ikpcb* pcb){
 
 ikptr
 ikrt_write_fd(ikptr fd, ikptr bv, ikptr off, ikptr cnt, ikpcb* pcb){
+#if 0
+  if (0) {
+    fprintf(stderr, "WRITE %d, %p %d %d %d\n", 
+         unfix(fd),
+         bv,
+         unfix(ref(bv, off_bytevector_length)),
+         unfix(off),
+        unfix(cnt));
+    int i;
+    for(i=0; i<100; i++){
+      fprintf(stderr, "bv[%d]=0x%02x ", i,
+             ((char*)(bv+off_bytevector_data))[i]);
+    }
+    fprintf(stderr, "\n");
+  }
+#endif
   ssize_t bytes = 
    write(unfix(fd),
          (char*)(long)(bv+off_bytevector_data+unfix(off)), 
diff --git a/src/ikarus-print.c b/src/ikarus-print.c
index 17ec413..28a0126 100644
--- a/src/ikarus-print.c
+++ b/src/ikarus-print.c
@@ -156,6 +156,20 @@ print(FILE* fh, ikptr x){
     }
     fprintf(fh, "\"");
   }
+  else if(tagof(x) == bytevector_tag){
+    ikptr fxlen = ref(x, off_bytevector_length);
+    int len = unfix(fxlen);
+    unsigned char* data = (unsigned char*)(x + off_bytevector_data);
+    fprintf(fh, "#vu8(");
+    int i;
+    for(i=0; i<(len-1); i++){
+      fprintf(fh, "%d ", data[i]);
+    }
+    if(i < len){
+      fprintf(fh, "%d", data[i]);
+    }
+    fprintf(fh, ")");
+  }
   else {
     fprintf(fh, "#<unknown>");
   }