X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fmacros.lisp;h=dd15d8c2144fab06bdd1c4294122733675e64523;hb=c7de1989d006e0b3a4f26143b7a81c9bdb754101;hp=1dd4bbc70415ec8f4f61fd3fe0f1b4cf8547d778;hpb=05525d3a5906d7a89fcb689c26177732493c40ce;p=sbcl.git

diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp
index 1dd4bbc..dd15d8c 100644
--- a/src/compiler/macros.lisp
+++ b/src/compiler/macros.lisp
@@ -54,7 +54,8 @@
     (multiple-value-bind (body decls doc)
 	(parse-defmacro lambda-list n-form body name "special form"
 			:environment n-env
-			:error-fun 'convert-condition-into-compiler-error)
+			:error-fun 'convert-condition-into-compiler-error
+                        :wrap-block nil)
       `(progn
 	 (declaim (ftype (function (continuation continuation t) (values))
 			 ,fn-name))
@@ -110,7 +111,8 @@
 			:error-fun `(lambda (&rest stuff)
 				      (declare (ignore stuff))
 				      (return-from ,name
-					(values nil t))))
+					(values nil t)))
+                        :wrap-block nil)
       `(lambda (,n-form &aux (,n-env *lexenv*))
          ,@decls
          (block ,name
@@ -159,7 +161,8 @@
   (def!macro !def-boolean-attribute (name &rest attribute-names)
 
     (let ((translations-name (symbolicate "*" name "-ATTRIBUTE-TRANSLATIONS*"))
-	  (test-name (symbolicate name "-ATTRIBUTEP")))
+	  (test-name (symbolicate name "-ATTRIBUTEP"))
+          (decoder-name (symbolicate "DECODE-" name "-ATTRIBUTES")))
       (collect ((alist))
         (do ((mask 1 (ash mask 1))
 	     (names attribute-names (cdr names)))
@@ -184,7 +187,11 @@
 	   ;; building the xc and when building the target compiler.
 	   (!def-boolean-attribute-setter ,test-name
 					  ,translations-name
-					  ,@attribute-names)))))
+					  ,@attribute-names)
+           (defun ,decoder-name (attributes)
+             (loop for (name . mask) in ,translations-name
+                   when (logtest mask attributes)
+                     collect name))))))
 
   ;; It seems to be difficult to express in DEF!MACRO machinery what
   ;; to do with target-vs-host GET-SETF-EXPANSION in here, so we just
@@ -616,7 +623,8 @@
          (declare (type node ,node-var))
 	 ,@body
 	 (when ,(if restart-p
-		    `(eq ,node-var (block-last ,n-block))
+		    `(or (eq ,node-var (block-last ,n-block))
+                         (block-delete-p ,n-block))
 		    `(eq ,cont-var ,n-last-cont))
 	   (return nil))))))
 ;;; like DO-NODES, only iterating in reverse order
@@ -636,6 +644,16 @@
 	 (when (eq ,n-next ,n-start)
 	   (return nil))))))
 
+(defmacro do-nodes-carefully ((node-var cont-var block) &body body)
+  (with-unique-names (n-block n-last)
+    `(loop with ,n-block = ,block
+           with ,n-last = (block-last ,n-block)
+           for ,cont-var = (block-start ,n-block) then (node-cont ,node-var)
+           for ,node-var = (and ,cont-var (continuation-next ,cont-var))
+           while ,node-var
+           do (progn ,@body)
+           until (eq ,node-var ,n-last))))
+
 ;;; Bind the IR1 context variables to the values associated with NODE,
 ;;; so that new, extra IR1 conversion related to NODE can be done
 ;;; after the original conversion pass has finished.