~ 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