projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
1.0.28.71: two regressions from the 1.0.28. series
[sbcl.git]
/
src
/
compiler
/
macros.lisp
diff --git
a/src/compiler/macros.lisp
b/src/compiler/macros.lisp
index
015768c
..
7ec86bd
100644
(file)
--- a/
src/compiler/macros.lisp
+++ b/
src/compiler/macros.lisp
@@
-193,6
+193,7
@@
translations-name
attribute-names
get-setf-expansion-fun-name)
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
`(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))
(,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)
(mask (compute-attribute-mask attributes ,translations-name)))
(values `(,@temps ,n-place)
`(,@values ,get)
@@
-228,6
+229,12
@@
attribute-names
'get-setf-expansion)))
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
;;; 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)
(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
(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))
;;; 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))
(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.
;;; 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
&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.
;;; 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)))
(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
;;; 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