X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fir1-translators.lisp;h=eb93a2e4dfc0a533e25c7db295503fcfa6de5f67;hb=e73a30c901ab234291aefc9f1e73507650628892;hp=7252c64ec263f9993aaab0a8bcd4318a0fe36f27;hpb=6053e7f804b430144bb09e2d107ad4ab3fb97db4;p=sbcl.git

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index 7252c64..eb93a2e 100644
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -69,6 +69,7 @@
   result of Value-Form."
   (unless (symbolp name)
     (compiler-error "The block name ~S is not a symbol." name))
+  (start-block start)
   (ctran-starts-block next)
   (let* ((dummy (make-ctran))
 	 (entry (make-entry))
@@ -162,6 +163,7 @@
   to the next statement following that tag. A Tag must an integer or a
   symbol. A statement must be a list. Other objects are illegal within the
   body."
+  (start-block start)
   (ctran-starts-block next)
   (let* ((dummy (make-ctran))
 	 (entry (make-entry))
@@ -428,7 +430,7 @@
 		 '(lambda named-lambda instance-lambda lambda-with-lexenv))
 	 (ir1-convert-lambdalike
 			  thing
-			  :debug-name (debug-namify "#'~S" thing)
+			  :debug-name (debug-namify "#'" thing)
 			  :allow-debug-catch-tag t))
 	((legal-fun-name-p thing)
 	 (find-lexically-apparent-fun
@@ -542,8 +544,8 @@
                       (processing-decls (decls vars nil next result)
                         (let ((fun (ir1-convert-lambda-body
                                     forms vars
-                                    :debug-name (debug-namify "LET ~S"
-                                                              bindings))))
+                                    :debug-name (debug-namify "LET "
+							      bindings))))
                           (reference-leaf start ctran fun-lvar fun))
                         (values next result))))
             (ir1-convert-combination-args fun-lvar ctran next result values))))))
@@ -623,7 +625,7 @@
                              (ir1-convert-lambda d
                                                  :source-name n
                                                  :debug-name (debug-namify
-                                                              "FLET ~S" n)
+                                                              "FLET " n)
                                                  :allow-debug-catch-tag t))
                            names defs)))
         (processing-decls (decls nil fvars next result)
@@ -645,7 +647,7 @@
 					 (make-functional
 					  :%source-name name
 					  :%debug-name (debug-namify
-							"LABELS placeholder ~S"
+							"LABELS placeholder "
 							name)))
 				       names))
 	     ;; (like PAIRLIS but guaranteed to preserve ordering:)
@@ -658,7 +660,7 @@
 			  (ir1-convert-lambda def
 					      :source-name name
 					      :debug-name (debug-namify
-							   "LABELS ~S" name)
+							   "LABELS " name)
 					      :allow-debug-catch-tag t))
 			names defs))))
 
@@ -831,7 +833,7 @@
   (let ((fun (ir1-convert-lambda
 	      `(lambda ()
 		 (return-from ,tag (%unknown-values)))
-	      :debug-name (debug-namify "escape function for ~S" tag))))
+	      :debug-name (debug-namify "escape function for " tag))))
     (setf (functional-kind fun) :escape)
     (reference-leaf start next result fun)))
 
@@ -939,6 +941,7 @@
   Evaluate Values-Form and then the Forms, but return all the values of
   Values-Form."
   (let ((dummy (make-ctran)))
+    (ctran-starts-block dummy)
     (ir1-convert start dummy result values-form)
     (ir1-convert-progn-body dummy next nil forms)))