conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Minor performance fix to previous deoptimization 

* Appended current timelog.
This commit is contained in:
Abdulaziz Ghuloum 2007-11-17 12:53:37 -05:00
parent 245203eaa0
commit 499115a226
5 changed files with 3393 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
benchmarks/benchall.ss
View File

@ -17,7 +17,8 @@
(fprintf (standard-error-port) "running ~s\n" x) (fprintf (standard-error-port) "running ~s\n" x)
(for-each (for-each
(lambda (_) (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))) (fprintf (standard-error-port) "ERROR: ~s failed\n" x)))
(make-list 5))) (make-list 5)))
all-benchmarks) all-benchmarks)

9
benchmarks/rnrs-benchmarks.ss
View File

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

3376
benchmarks/timelog
View File

File diff suppressed because it is too large Load Diff

6
scheme/ikarus.compiler.ss
View File

@ -651,6 +651,8 @@
(let ([rhs* (do-rhs* 0 lhs* rhs* ref comp vref vcomp)]) (let ([rhs* (do-rhs* 0 lhs* rhs* ref comp vref vcomp)])
(let-values ([(slhs* srhs* llhs* lrhs* clhs* crhs*) (let-values ([(slhs* srhs* llhs* lrhs* clhs* crhs*)
(partition-rhs* 0 lhs* rhs* vref vcomp)]) (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*)]) (let ([v* (map (lambda (x) (make-constant (void))) clhs*)])
(make-bind slhs* srhs* (make-bind slhs* srhs*
(make-bind clhs* v* (make-bind clhs* v*
@ -1436,7 +1438,7 @@
[(var-global-loc x) => [(var-global-loc x) =>
(lambda (loc) (lambda (loc)
(make-funcall (make-funcall
(make-primref 'top-level-value) (make-primref '$symbol-value)
(list (make-constant loc))))] (list (make-constant loc))))]
[else [else
(make-funcall (make-primref '$vector-ref) (make-funcall (make-primref '$vector-ref)
@ -1475,7 +1477,7 @@
(cond (cond
[(var-global-loc lhs) => [(var-global-loc lhs) =>
(lambda (loc) (lambda (loc)
(make-funcall (make-primref '$init-symbol-value!) (make-funcall (make-primref '$set-symbol-value!)
(list (make-constant loc) (Expr rhs))))] (list (make-constant loc) (Expr rhs))))]
[else [else
(make-funcall (make-primref '$vector-set!) (make-funcall (make-primref '$vector-set!)

10
scheme/makefile.ss
View File

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