~ chicken-core (chicken-5) 6b23185d5d3e69eb851391607db6947b51245c0c
commit 6b23185d5d3e69eb851391607db6947b51245c0c Author: felix <felix@call-with-current-continuation.org> AuthorDate: Fri Aug 12 08:18:45 2011 +0200 Commit: felix <felix@call-with-current-continuation.org> CommitDate: Fri Aug 12 08:18:45 2011 +0200 also straighten ##core#inline_unboxed diff --git a/compiler.scm b/compiler.scm index b7ca7b03..20c88f32 100644 --- a/compiler.scm +++ b/compiler.scm @@ -2410,7 +2410,7 @@ (debugging 'p "closure conversion transformation phase...") (let ((node2 (transform node #f #f))) (unless (zero? direct-calls) - (debugging 'o "calls to known targets" direct-calls (delay (length direct-call-ids))) ) + (debugging 'o "calls to known targets" direct-calls)) node2) ) ) diff --git a/unboxing.scm b/unboxing.scm index e12b3f03..000812b7 100644 --- a/unboxing.scm +++ b/unboxing.scm @@ -294,15 +294,17 @@ (when f (d "straightening form (~a): ~a" class params) (let ((n2 (straighten-binding! n2))) +#| (print "---\n") (pp (build-expression-tree n)) (print " ->\n") +|# (copy-node! n2 n) - (pp (build-expression-tree n)) - (print "---\n"))) + #;(pp (build-expression-tree n)) + #;(print "---\n"))) n)) ((memq (node-class (car args)) '(let ##core#let_unboxed)) - (printf "~s:~s~%~!" class (node-class (car args))) + ;(printf "~s:~s~%~!" class (node-class (car args))) (let* ((arg (car args)) (subs2 (node-subexpressions arg))) (set! f #t) @@ -357,7 +359,7 @@ ((not udest) (boxed! v))) a)) - ((##core#inline ##core#inline_allocate) + ((##core#inline ##core#inline_allocate ##core#inline_unboxed) (let* ((rw1 (##sys#get (symbolify (first params)) '##compiler#unboxed-op)) (rw (and unsafe rw1)) (args (map (cut walk <> #f rw pass2?) subs)))Trap