~ 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