they're structure slot accessors) won't be so
nasty in the debugger
* outstanding embarrassments
- ** cut-and-pasted DEF-BOOLEAN-ATTRIBUTE (maybe easier to fix
- now that EVAL-WHEN works correctly..)
** :IGNORE-ERRORS-P cruft in stems-and-flags.lisp-expr. (It's
reasonable to support this as a crutch when initially
bootstrapping from balky xc hosts with their own
"COMPUTE-OLD-NFP" "COPY-MORE-ARG"
"CURRENT-BINDING-POINTER" "CURRENT-NFP-TN"
"CURRENT-STACK-POINTER" "DEALLOC-ALIEN-STACK-SPACE"
- "DEALLOC-NUMBER-STACK-SPACE" "DEF-BOOLEAN-ATTRIBUTE"
+ "DEALLOC-NUMBER-STACK-SPACE"
"DEF-IR1-TRANSLATOR"
"!DEF-PRIMITIVE-TYPE" "!DEF-PRIMITIVE-TYPE-ALIAS"
"DEFINE-SOURCE-TRANSFORM" "!DEF-VM-SUPPORT-ROUTINE"
"DEFPRINTER"
"AVER" "ENFORCE-TYPE"
"AWHEN" "ACOND" "IT"
+ "!DEF-BOOLEAN-ATTRIBUTE"
;; ..and CONDITIONs..
"BUG"
\f
;;;; structures/types used by the scheduler
-(sb!c:def-boolean-attribute instruction
+(!def-boolean-attribute instruction
;; This attribute is set if the scheduler can freely flush this
;; instruction if it thinks it is not needed. Examples are NOP and
;; instructions that have no side effect not described by the
;;; FIXME: The way this macro uses MACROEXPAND internally breaks my
;;; old assumptions about macros which are needed both in the host and
;;; the target. (This is more or less the same way that PUSH-IN,
-;;; DELETEF-IN, and DEF-BOOLEAN-ATTRIBUTE break my old assumptions,
+;;; DELETEF-IN, and !DEF-BOOLEAN-ATTRIBUTE break my old assumptions,
;;; except that they used GET-SETF-EXPANSION instead of MACROEXPAND to
;;; do the dirty deed.) The quick and dirty "solution" here is the
;;; same as there: use cut and paste to duplicate the defmacro in a
;;; breakdown of side effects, since we do very little code motion on
;;; IR1. We are interested in some deeper semantic properties such as
;;; whether it is safe to pass stack closures to.
-(def-boolean-attribute ir1
+(!def-boolean-attribute ir1
;; may call functions that are passed as arguments. In order to
;; determine what other effects are present, we must find the
;; effects of all arguments that may be functions.
;;;; macros which use GET-SETF-EXPANSION in their macroexpander code,
;;;; and hence need special treatment. Currently (19990806) this
-;;;; special treatment involves bare calls to SB!XC:DEFMACRO, and so
-;;;; this code can't appear in the build sequence until after
-;;;; SB!XC:DEFMACRO has been defined, and so this stuff is separated
-;;;; out of the main compiler/macros.lisp file (which has to appear
-;;;; earlier).
+;;;; special treatment involves bare calls to SB!XC:DEFMACRO or
+;;;; DEFMACRO-MUNDANELY and so this code can't appear in the build
+;;;; sequence until after xc DEFMACRO machinery has been set up, and
+;;;; so this stuff is separated out of the main compiler/macros.lisp
+;;;; file (which has to appear earlier).
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
(in-package "SB!C")
-;;; Def-Boolean-Attribute Name Attribute-Name*
-;;;
-;;; Define a new class of Boolean attributes, with the attributes
-;;; having the specified ATTRIBUTE-NAMES. NAME is the name of the
-;;; class, which is used to generate some macros to manipulate sets of
-;;; the attributes:
-;;;
-;;; NAME-attributep attributes attribute-name*
-;;; Return true if any of the named attributes are present, false
-;;; otherwise. When set with SETF, updates the place Attributes
-;;; setting or clearing the specified attributes.
-;;;
-;;; NAME-attributes attribute-name*
-;;; Return a set of the named attributes.
-#+sb-xc-host
-(sb!xc:defmacro def-boolean-attribute (name &rest attribute-names)
- (let ((translations-name (symbolicate "*" name "-ATTRIBUTE-TRANSLATIONS*"))
- (test-name (symbolicate name "-ATTRIBUTEP")))
- (collect ((alist))
- (do ((mask 1 (ash mask 1))
- (names attribute-names (cdr names)))
- ((null names))
- (alist (cons (car names) mask)))
-
- `(progn
-
- (eval-when (:compile-toplevel :load-toplevel :execute)
- (defparameter ,translations-name ',(alist)))
-
- (defmacro ,test-name (attributes &rest attribute-names)
- "Automagically generated Boolean attribute test function. See
- DEF-BOOLEAN-ATTRIBUTE."
- `(logtest ,(compute-attribute-mask attribute-names
- ,translations-name)
- (the attributes ,attributes)))
-
- (define-setf-expander ,test-name (place &rest attributes
- &environment env)
- "Automagically generated Boolean attribute setter. See
- DEF-BOOLEAN-ATTRIBUTE."
- (boolean-attribute-setter--target place
- attributes
- env
- (compute-attribute-mask
- attributes
- ,translations-name
- )
- ',test-name))
-
- (defmacro ,(symbolicate name "-ATTRIBUTES") (&rest attribute-names)
- "Automagically generated Boolean attribute creation function. See
- DEF-BOOLEAN-ATTRIBUTE."
- (compute-attribute-mask attribute-names ,translations-name))))))
-
-;;; a helper function for the cross-compilation target Lisp code which
-;;; DEF-BOOLEAN-ATTRIBUTE expands into
-;;;
-;;; KLUDGE: Eventually I'd like to rewrite the mainstream DEF-BOOLEAN-ATTRIBUTE
-;;; to use code like this, to factor out some shared functionality for clarity
-;;; and for economy. But the motivation for splitting out this code here is
-;;; much weirder. In the current version of the code, the cross-compiler calls
-;;; UNCROSS on each top level form before processing it. Ordinarily, UNCROSS
-;;; isn't called on macro expansions, but since DEF-BOOLEAN-ATTRIBUTE expands
-;;; into a PROGN, the cross-compiler does end up calling UNCROSS on (the
-;;; components of) its macroexpansion, since they're separate top level forms.
-;;; In the classic CMU CL macroexpansion, the call to GET-SETF-EXPANSION is in
-;;; the macroexpansion, and even when I translate it to
-;;; SB!XC:GET-SETF-MACROEXPANSION so that it will work on target code, my
-;;; damned, damned UNCROSS kludge unconverts it before processing it. Moving
-;;; this shared logic (which includes the troublesome
-;;; SB!XC:GET-SETF-EXPANSION code) out of the macroexpansion and into this
-;;; helper function works around this problem. -- WHN 19990812
-(defun boolean-attribute-setter--target (place attributes env mask test-name)
- (multiple-value-bind (temps values stores set get)
- (sb!xc:get-setf-expansion place env)
- (when (cdr stores)
- (error "multiple store variables for ~S" place))
- (let ((newval (gensym))
- (n-place (gensym)))
- (values `(,@temps ,n-place)
- `(,@values ,get)
- `(,newval)
- `(let ((,(first stores)
- (if ,newval
- (logior ,n-place ,mask)
- (logand ,n-place ,(lognot mask)))))
- ,set
- ,newval)
- `(,test-name ,n-place ,@attributes)))))
-
#+sb-xc-host
(sb!xc:defmacro deletef-in (next place item &environment env)
(multiple-value-bind (temps vals stores store access)
(setf (,next ,(first stores)) ,access)
,store
(values))))
+
+;;; the target-code case of setting boolean attributes
+#+sb-xc-host
+(defmacro-mundanely !def-boolean-attribute-setter (test-name
+ translations-name
+ &rest attribute-names)
+ (guts-of-!def-boolean-attribute-setter test-name
+ translations-name
+ attribute-names
+ 'sb!xc:get-setf-expansion))
;;;
;;; NAME-attributes attribute-name*
;;; Return a set of the named attributes.
-;;;
-;;; KLUDGE: This is expanded out twice, by cut-and-paste, in a
-;;; (DEF!MACRO FOO (..) .. CL:GET-SETF-EXPANSION ..)
-;;; #+SB-XC-HOST
-;;; (SB!XC:DEFMACRO FOO (..) .. SB!XC:GET-SETF-EXPANSION ..)
-;;; arrangement, in order to get it to work in cross-compilation. This
-;;; duplication should be removed, perhaps by rewriting the macro in a
-;;; more cross-compiler-friendly way, or perhaps just by using some
-;;; (MACROLET ((FROB ..)) .. FROB .. FROB) form, but I don't want to
-;;; do it now, because the system isn't running yet, so it'd be too
-;;; hard to check that my changes were correct -- WHN 19990806
-(def!macro def-boolean-attribute (name &rest attribute-names)
-
- (let ((translations-name (symbolicate "*" name "-ATTRIBUTE-TRANSLATIONS*"))
- (test-name (symbolicate name "-ATTRIBUTEP")))
- (collect ((alist))
- (do ((mask 1 (ash mask 1))
- (names attribute-names (cdr names)))
- ((null names))
- (alist (cons (car names) mask)))
-
- `(progn
-
- (eval-when (:compile-toplevel :load-toplevel :execute)
- (defparameter ,translations-name ',(alist)))
-
- (defmacro ,test-name (attributes &rest attribute-names)
- "Automagically generated boolean attribute test function. See
- Def-Boolean-Attribute."
- `(logtest ,(compute-attribute-mask attribute-names
- ,translations-name)
- (the attributes ,attributes)))
-
- (define-setf-expander ,test-name (place &rest attributes
- &environment env)
- "Automagically generated boolean attribute setter. See
- Def-Boolean-Attribute."
- #-sb-xc-host (declare (type sb!c::lexenv env))
- ;; FIXME: It would be better if &ENVIRONMENT arguments
- ;; were automatically declared to have type LEXENV by the
- ;; hairy-argument-handling code.
- (multiple-value-bind (temps values stores set get)
- (get-setf-expansion place env)
- (when (cdr stores)
- (error "multiple store variables for ~S" place))
- (let ((newval (gensym))
- (n-place (gensym))
- (mask (compute-attribute-mask attributes
- ,translations-name)))
- (values `(,@temps ,n-place)
- `(,@values ,get)
- `(,newval)
- `(let ((,(first stores)
- (if ,newval
- (logior ,n-place ,mask)
- (logand ,n-place ,(lognot mask)))))
- ,set
- ,newval)
- `(,',test-name ,n-place ,@attributes)))))
-
- (defmacro ,(symbolicate name "-ATTRIBUTES") (&rest attribute-names)
- "Automagically generated boolean attribute creation function. See
- Def-Boolean-Attribute."
- (compute-attribute-mask attribute-names ,translations-name))))))
-;;; #+SB-XC-HOST SB!XC:DEFMACRO version is in late-macros.lisp. -- WHN 19990806
+#+sb-xc-host
+(progn
+ (def!macro !def-boolean-attribute (name &rest attribute-names)
+
+ (let ((translations-name (symbolicate "*" name "-ATTRIBUTE-TRANSLATIONS*"))
+ (test-name (symbolicate name "-ATTRIBUTEP")))
+ (collect ((alist))
+ (do ((mask 1 (ash mask 1))
+ (names attribute-names (cdr names)))
+ ((null names))
+ (alist (cons (car names) mask)))
+ `(progn
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter ,translations-name ',(alist)))
+ (defmacro ,(symbolicate name "-ATTRIBUTES") (&rest attribute-names)
+ "Automagically generated boolean attribute creation function.
+ See !DEF-BOOLEAN-ATTRIBUTE."
+ (compute-attribute-mask attribute-names ,translations-name))
+ (defmacro ,test-name (attributes &rest attribute-names)
+ "Automagically generated boolean attribute test function.
+ See !DEF-BOOLEAN-ATTRIBUTE."
+ `(logtest ,(compute-attribute-mask attribute-names
+ ,translations-name)
+ (the attributes ,attributes)))
+ ;; This definition transforms strangely under UNCROSS, in a
+ ;; way that DEF!MACRO doesn't understand, so we delegate it
+ ;; to a submacro then define the submacro differently when
+ ;; building the xc and when building the target compiler.
+ (!def-boolean-attribute-setter ,test-name
+ ,translations-name
+ ,@attribute-names)))))
+
+ ;; 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
+ ;; hack it by hand, passing a different GET-SETF-EXPANSION-FUN-NAME
+ ;; in the host DEFMACRO and target DEFMACRO-MUNDANELY cases.
+ (defun guts-of-!def-boolean-attribute-setter (test-name
+ translations-name
+ attribute-names
+ get-setf-expansion-fun-name)
+ `(define-setf-expander ,test-name (place &rest attributes
+ &environment env)
+ "Automagically generated boolean attribute setter. See
+ !DEF-BOOLEAN-ATTRIBUTE."
+ #-sb-xc-host (declare (type sb!c::lexenv env))
+ ;; FIXME: It would be better if &ENVIRONMENT arguments were
+ ;; automatically declared to have type LEXENV by the
+ ;; hairy-argument-handling code.
+ (multiple-value-bind (temps values stores set get)
+ (,get-setf-expansion-fun-name place env)
+ (when (cdr stores)
+ (error "multiple store variables for ~S" place))
+ (let ((newval (gensym))
+ (n-place (gensym))
+ (mask (compute-attribute-mask attributes ,translations-name)))
+ (values `(,@temps ,n-place)
+ `(,@values ,get)
+ `(,newval)
+ `(let ((,(first stores)
+ (if ,newval
+ (logior ,n-place ,mask)
+ (logand ,n-place ,(lognot mask)))))
+ ,set
+ ,newval)
+ `(,',test-name ,n-place ,@attributes))))))
+ ;; We define the host version here, and the just-like-it-but-different
+ ;; target version later, after DEFMACRO-MUNDANELY has been defined.
+ (defmacro !def-boolean-attribute-setter (test-name
+ translations-name
+ &rest attribute-names)
+ (guts-of-!def-boolean-attribute-setter test-name
+ translations-name
+ attribute-names
+ 'get-setf-expansion)))
;;; And now for some gratuitous pseudo-abstraction...
;;;
;;; ATTRIBUTES-INTERSECTION
;;; Return the intersection of all the sets of boolean attributes which
;;; are its arguments.
-;;; ATTRIBUTES=
-;;; True if the attributes present in Attr1 are identical to
-;;; those in Attr2.
+;;; ATTRIBUTES
+;;; True if the attributes present in ATTR1 are identical to
+;;; those in ATTR2.
(defmacro attributes-union (&rest attributes)
`(the attributes
(logior ,@(mapcar (lambda (x) `(the attributes ,x)) attributes))))
;;; type specifier for the function by wrapping (FUNCTION ...) around
;;; the ARG-TYPES and RESULT-TYPE. ATTRIBUTES is an unevaluated list
;;; of boolean attributes of the function. See their description in
-;;; (DEF-BOOLEAN-ATTRIBUTE IR1). NAME may also be a list of names, in
+;;; (!DEF-BOOLEAN-ATTRIBUTE IR1). NAME may also be a list of names, in
;;; which case the same information is given to all the names. The
;;; keywords specify the initial values for various optimizers that
;;; the function might have.
compile-time-too))))))
(if (atom form)
#+sb-xc-host
- ;; (There are no EVAL-WHEN issues in the ATOM case until
- ;; SBCL gets smart enough to handle global
- ;; DEFINE-SYMBOL-MACRO or SYMBOL-MACROLET.)
+ ;; (There are no xc EVAL-WHEN issues in the ATOM case until
+ ;; (1) SBCL gets smart enough to handle global
+ ;; DEFINE-SYMBOL-MACRO or SYMBOL-MACROLET and (2) SBCL
+ ;; implementors start using symbol macros in a way which
+ ;; interacts with SB-XC/CL distinction.)
(convert-and-maybe-compile form path)
#-sb-xc-host
(default-processor form)
;;; is set when a continuation type assertion is strengthened.
;;; TEST-MODIFIED is set whenever the test for the ending IF has
;;; changed (may be true when there is no IF.)
-(def-boolean-attribute block
+(!def-boolean-attribute block
reoptimize flush-p type-check delete-p type-asserted test-modified)
;;; FIXME: Tweak so that definitions of e.g. BLOCK-DELETE-P is
\f
;;;; side effect classes
-(def-boolean-attribute vop
+(!def-boolean-attribute vop
any)
\f
;;;; move/coerce definition
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.7.10.5"
+"0.7.10.6"
projects / sbcl.git / commitdiff