0.8.3.5:
[sbcl.git] / src / compiler / macros.lisp
index fd533a0..dd15d8c 100644 (file)
   (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)))
           ;; 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
         (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.