X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmacros.lisp;h=7ec86bdf5d0f2469cb2e52d2ab30f2da7cdf397d;hb=16f861fd9d7c9246a22a212c26d97fb2e3712607;hp=015768c573fa848fef55ac6a515b1fe0ab12fd30;hpb=8bcffb407835ff680d5ee2ba1f7ce97839bbae3e;p=sbcl.git

diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp
index 015768c..7ec86bd 100644
--- a/src/compiler/macros.lisp
+++ b/src/compiler/macros.lisp
@@ -193,6 +193,7 @@
                                                 translations-name
                                                 attribute-names
                                                 get-setf-expansion-fun-name)
+    (declare (ignore attribute-names))
     `(define-setf-expander ,test-name (place &rest attributes
                                              &environment env)
        "Automagically generated boolean attribute setter. See
@@ -205,8 +206,8 @@
            (,get-setf-expansion-fun-name place env)
          (when (cdr stores)
            (error "multiple store variables for ~S" place))
-         (let ((newval (gensym))
-               (n-place (gensym))
+         (let ((newval (sb!xc:gensym))
+               (n-place (sb!xc:gensym))
                (mask (compute-attribute-mask attributes ,translations-name)))
            (values `(,@temps ,n-place)
                    `(,@values ,get)
@@ -228,6 +229,12 @@
                                            attribute-names
                                            'get-setf-expansion)))
 
+;;; Otherwise the source locations for DEFTRANSFORM, DEFKNOWN, &c
+;;; would be off by one toplevel form as their source locations are
+;;; determined before cross-compiling where the above PROGN is not
+;;; seen.
+#+sb-xc (progn)
+
 ;;; And now for some gratuitous pseudo-abstraction...
 ;;;
 ;;; ATTRIBUTES-UNION
@@ -397,10 +404,10 @@
   (when (and eval-name defun-only)
     (error "can't specify both DEFUN-ONLY and EVAL-NAME"))
   (multiple-value-bind (body decls doc) (parse-body body-decls-doc)
-    (let ((n-args (gensym))
-          (n-node (or node (gensym)))
-          (n-decls (gensym))
-          (n-lambda (gensym))
+    (let ((n-args (sb!xc:gensym))
+          (n-node (or node (sb!xc:gensym)))
+          (n-decls (sb!xc:gensym))
+          (n-lambda (sb!xc:gensym))
           (decls-body `(,@decls ,@body)))
       (multiple-value-bind (parsed-form vars)
           (parse-deftransform lambda-list
@@ -456,7 +463,7 @@
 ;;; keywords specify the initial values for various optimizers that
 ;;; the function might have.
 (defmacro defknown (name arg-types result-type &optional (attributes '(any))
-                    &rest keys)
+                    &body keys)
   (when (and (intersection attributes '(any call unwind))
              (intersection attributes '(movable)))
     (error "function cannot have both good and bad attributes: ~S" attributes))
@@ -495,7 +502,7 @@
 ;;; the rest of the optimizer function's lambda-list. LTN-ANNOTATE
 ;;; methods are passed an additional POLICY argument, and IR2-CONVERT
 ;;; methods are passed an additional IR2-BLOCK argument.
-(defmacro defoptimizer (what (lambda-list &optional (n-node (gensym))
+(defmacro defoptimizer (what (lambda-list &optional (n-node (sb!xc:gensym))
                                           &rest vars)
                              &body body)
   (let ((name (if (symbolp what) what
@@ -559,17 +566,17 @@
 
 ;;; Iterate over the uses of LVAR, binding NODE to each one
 ;;; successively.
-;;;
-;;; XXX Could change it not to replicate the code someday perhaps...
 (defmacro do-uses ((node-var lvar &optional result) &body body)
   (with-unique-names (uses)
     `(let ((,uses (lvar-uses ,lvar)))
-       (if (listp ,uses)
-           (dolist (,node-var ,uses ,result)
-             ,@body)
-           (block nil
-             (let ((,node-var ,uses))
-               ,@body))))))
+       (block nil
+         (flet ((do-1-use (,node-var)
+                  ,@body))
+           (if (listp ,uses)
+               (dolist (node ,uses)
+                 (do-1-use node))
+               (do-1-use ,uses)))
+         ,result))))
 
 ;;; Iterate over the nodes in BLOCK, binding NODE-VAR to the each node
 ;;; and LVAR-VAR to the node's LVAR. The only keyword option is