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

* Optimize-closure-size is done. Code reduced to 1.686MB from 

1.82MB.  Bootstrap time down to 2.185s.
This commit is contained in:
Abdulaziz Ghuloum 2006-12-04 15:42:42 -05:00
parent 3906f165ff
commit ea44b68b7c
2 changed files with 10 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
lib/ikarus.boot
View File

Binary file not shown.

19
lib/libcompile.ss
View File

@ -1218,11 +1218,9 @@
(set! all-codes (set! all-codes
(cons (make-clambda-code label cls* free*) all-codes)) (cons (make-clambda-code label cls* free*) all-codes))
g))])) g))]))
(define (optimize-one-closure x) (define (optimize-one-closure code free)
(record-case x (let ([free (trim-vars free)])
[(closure code free*) (make-closure (trim/lift-code code free) free)))
(let ([free* (trim-vars free*)])
(make-closure (trim/lift-code code free*) free*))]))
(define (trim p? ls) (define (trim p? ls)
(cond (cond
[(null? ls) '()] [(null? ls) '()]
@ -1247,7 +1245,7 @@
(define-record node (name code deps whacked free)) (define-record node (name code deps whacked free))
(let ([node* (map (lambda (lhs rhs) (let ([node* (map (lambda (lhs rhs)
(let ([n (make-node lhs (closure-code rhs) '() #f '())]) (let ([n (make-node lhs (closure-code rhs) '() #f '())])
(make-thunk-var x n) (make-thunk-var lhs n)
n)) n))
lhs* rhs*)]) lhs* rhs*)])
;;; if x is free in y, then whenever x becomes a non-thunk, ;;; if x is free in y, then whenever x becomes a non-thunk,
@ -1297,7 +1295,9 @@
(for-each (for-each
(lambda (x) (lambda (x)
(set-closure-code! x (set-closure-code! x
(trim/lift-code (closure-code x)))) (trim/lift-code
(closure-code x)
(closure-free* x))))
rhs*) rhs*)
;;; ;;;
(make-fix (trim-vars lhs*) (make-fix (trim-vars lhs*)
@ -1871,6 +1871,7 @@
(define (check? x) (define (check? x)
(cond (cond
[(primref? x) #f] ;;;; PRIMREF CHECK [(primref? x) #f] ;;;; PRIMREF CHECK
[(closure? x) #f]
[else #t])) [else #t]))
(define (do-new-frame op rand* si r call-convention rp-convention orig-live) (define (do-new-frame op rand* si r call-convention rp-convention orig-live)
(make-new-frame (fxadd1 si) (fx+ (length rand*) 2) (make-new-frame (fxadd1 si) (fx+ (length rand*) 2)
@ -4030,8 +4031,8 @@
[p (copy-propagate p)] [p (copy-propagate p)]
[p (rewrite-assignments p)] [p (rewrite-assignments p)]
[p (convert-closures p)] [p (convert-closures p)]
;[p (optimize-closures p)] [p (optimize-closures/lift-codes p)]
[p (lift-codes p)] ;[p (lift-codes p)]
[p (introduce-primcalls p)] [p (introduce-primcalls p)]
[p (simplify-operands p)] [p (simplify-operands p)]
[p (insert-stack-overflow-checks p)] [p (insert-stack-overflow-checks p)]