fixed bug in ($make-vector 0)

scheme/ikarus.compiler.altcogen.ss

@@ -2864,7 +2864,6 @@
                       (parameterize ([exceptions-conc ac])
                         (T body ac))))
              (map Clambda code*))]))
-  ;;;
   ;;; (print-code x)
   (Program x))
 

scheme/last-revision

@@ -1 +1 @@
-1435
+1438

scheme/pass-specify-rep-primops.ss

@@ -45,10 +45,11 @@
     (prm 'mref x (K (- disp tag)))))
 
 (define (dirty-vector-set address)
+  (define shift-bits 2)
   (prm 'mset 
      (prm 'int+
           (prm 'mref pcr (K pcb-dirty-vector))
-          (prm 'sll (prm 'srl address (K pageshift)) (K wordshift)))
+          (prm 'sll (prm 'srl address (K pageshift)) (K shift-bits)))
      (K 0)
      (K dirty-word)))
 
@@ -391,7 +392,7 @@
                         (K vector-tag))])
           (prm 'mset v 
                (K (- disp-vector-length vector-tag))
-               (K (make-constant (* i fx-scale))))
+               (K (* i fx-scale)))
           v)]
      [else
       (with-tmp ([alen (align-code (T len) disp-vector-data)])

scheme/test64.ss

@@ -70,6 +70,7 @@
     [fx- $fx-]
     [fx* $fx*]
     [fxadd1 $fxadd1]
+    [fxsub1 $fxsub1]
     [fxlogor $fxlogor]
     [fxlogand $fxlogand]
     [fxlognot $fxlognot]
@@ -82,6 +83,22 @@
     [cons cons]
     [car $car]
     [cdr $cdr]
+    [set-car! $set-car!]
+    [set-cdr! $set-cdr!]
+    [eq? eq?]
+    [make-vector $make-vector]
+    [vector? vector?]
+    [vector-length $vector-length]
+    [vector-set! $vector-set!]
+    [vector-ref $vector-ref]
+    [string? string?]
+    [make-string $make-string]
+    [string-set! $string-set!]
+    [string-ref $string-ref]
+    [string-length $string-length]
+    [char= $char=]
+    [fixnum->char $fixnum->char]
+    [char->fixnum $char->fixnum]
     ))
 
 
@@ -102,12 +119,17 @@
        `((primitive ,(cadr (assq prim prims-alist))) ,args ...)]
       [(if ,[e0] ,[e1] ,[e2])
        `(if ,e0 ,e1 ,e2)]
-      [(let ([,lhs* ,[rhs*]] ...) ,body)
+      [(let ([,lhs* ,[rhs*]] ...) ,body ,body* ...)
        (let ([nlhs* (map gensym lhs*)])
          (let ([env (append (map cons lhs* nlhs*) env)])
            `((case-lambda 
-               [,nlhs* ,(Expr body env)])
+               [,nlhs* 
+                (begin ,(Expr body env)
+                       ,(map (lambda (x) (Expr x env)) body*)
+                       ...)])
              ,rhs* ...)))]
+      [(begin ,[e] ,[e*] ...) 
+       `(begin ,e ,e* ...)]
       [,_ (error 'fixup "invalid expression" _)]))
   (Expr x '()))
 
@@ -119,14 +141,15 @@
            (append all-tests 
               '([test string] ...)))])))
 
-(include "tests/tests-1.1-req.scm")
+; (include "tests/tests-1.1-req.scm")
-(include "tests/tests-1.2-req.scm")
+; (include "tests/tests-1.2-req.scm")
-(include "tests/tests-1.3-req.scm")
+; (include "tests/tests-1.3-req.scm")
-(include "tests/tests-1.4-req.scm")
+; (include "tests/tests-1.4-req.scm")
-(include "tests/tests-1.5-req.scm")
+; (include "tests/tests-1.5-req.scm")
-(include "tests/tests-1.6-req.scm")
+; (include "tests/tests-1.6-req.scm")
-(include "tests/tests-1.7-req.scm")
+; (include "tests/tests-1.7-req.scm")
-(include "tests/tests-1.8-req.scm")
+; (include "tests/tests-1.8-req.scm")
+(include "tests/tests-1.9-req.scm")
 
 
 (current-primitive-locations

src/ikarus-print.c

@@ -129,13 +129,11 @@ print(FILE* fh, ikptr x){
   else if(tagof(x) == string_tag){
     ikptr fxlen = ref(x, off_string_length);
     int len = unfix(fxlen);
-    fprintf(stderr, "bug: printer busted!\n");
+    long int * data = (long int*)(x + off_string_data);
-    exit(-1);
-    char* data = 0; //string_data(x);
     fprintf(fh, "\"");
     int i;
     for(i=0; i<len; i++){
-      char c = data[i];
+      char c = (data[i]) >> char_shift;
       if((c == '\\') || (c == '"')){
         fprintf(fh, "\\");
       }