* Minor performance fix to previous deoptimization

* Appended current timelog.

benchmarks/benchall.ss

@@ -17,7 +17,8 @@
     (fprintf (standard-error-port) "running ~s\n" x)
     (for-each 
       (lambda (_)
-        (unless (zero? (system (format "ikarus --r6rs-script bench.ss ~a" x)))
+        (define cmd "ikarus -b ../scheme/ikarus.boot --r6rs-script bench.ss ~a")
+        (unless (zero? (system (format cmd x)))
           (fprintf (standard-error-port) "ERROR: ~s failed\n" x)))
       (make-list 5)))
   all-benchmarks)

benchmarks/rnrs-benchmarks.ss

@@ -92,12 +92,13 @@
   (define fast-run (make-parameter #f))
   
   (define (run-bench count run)
-    (unless (= count 0)
-      (let f ([count (- count 1)])
+    (import (ikarus system $fx))
+    (unless ($fx= count 0)
+      (let f ([count ($fx- count 1)] [run run])
         (cond
-          [(= count 0) (run)]
+          [($fx= count 0) (run)]
           [else 
-           (begin (run) (f (- count 1)))]))))
+           (begin (run) (f ($fx- count 1) run))]))))
 
   (define (run-benchmark name count ok? run-maker . args)
     (let ([run (apply run-maker args)])

scheme/ikarus.compiler.ss

@@ -651,6 +651,8 @@
         (let ([rhs* (do-rhs* 0 lhs* rhs* ref comp vref vcomp)])
           (let-values ([(slhs* srhs* llhs* lrhs* clhs* crhs*)
                         (partition-rhs* 0 lhs* rhs* vref vcomp)])
+            ;(unless (null? clhs*)
+            ;  (printf "CLHS* = ~s\n" (map unparse clhs*)))
             (let ([v* (map (lambda (x) (make-constant (void))) clhs*)])
               (make-bind slhs* srhs*
                 (make-bind clhs* v*
@@ -1436,7 +1438,7 @@
             [(var-global-loc x) =>
              (lambda (loc) 
                (make-funcall 
-                 (make-primref 'top-level-value) 
+                 (make-primref '$symbol-value)
                  (list (make-constant loc))))]
             [else
              (make-funcall (make-primref '$vector-ref)
@@ -1475,7 +1477,7 @@
        (cond
          [(var-global-loc lhs) =>
           (lambda (loc) 
-            (make-funcall (make-primref '$init-symbol-value!)
+            (make-funcall (make-primref '$set-symbol-value!)
                (list (make-constant loc) (Expr rhs))))]
          [else
           (make-funcall (make-primref '$vector-set!)

scheme/makefile.ss

@@ -1571,10 +1571,12 @@
               [else 
                (error 'bootstrap "no location for primitive" x)])))
         (let ([p (open-output-file "ikarus.boot" 'replace)])
-          (for-each 
-            (lambda (x) 
-              (compile-core-expr-to-port x p))
-            core*)
+          (time-it "code generation and serialization"
+            (lambda ()
+              (for-each 
+                (lambda (x) 
+                  (compile-core-expr-to-port x p))
+                core*)))
           (close-output-port p)))))
 
 (printf "Happy Happy Joy Joy\n")