X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmacros.lisp;h=a86bbc97984a806aa8510c065a440e56bd288826;hb=df679ed627975948b1cee190f4d79c397588c43e;hp=df8fb02defd4a4319e985af083dc3b0dbff0d2db;hpb=148e3820ad314a9b59d0133c1d60eaac4af9118b;p=sbcl.git diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp index df8fb02..a86bbc9 100644 --- a/src/compiler/macros.lisp +++ b/src/compiler/macros.lisp @@ -133,7 +133,7 @@ (deftype attributes () 'fixnum) -(eval-when (:compile-toplevel :load-toplevel :execute) +(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) ;;; Given a list of attribute names and an alist that translates them ;;; to masks, return the OR of the masks. @@ -263,7 +263,7 @@ ;;;; to parse the IR1 representation of a function call using a ;;;; standard function lambda-list. -(eval-when (:compile-toplevel :load-toplevel :execute) +(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) ;;; Given a DEFTRANSFORM-style lambda-list, generate code that parses ;;; the arguments of a combination with respect to that lambda-list. @@ -473,7 +473,7 @@ (pushnew 'unsafely-flushable attributes)) `(%defknown ',(if (and (consp name) - (not (eq (car name) 'setf))) + (not (legal-fun-name-p name))) name (list name)) '(function ,arg-types ,result-type) @@ -687,6 +687,19 @@ (defmacro with-continuation-type-assertion ((cont ctype context) &body body) `(let ((*lexenv* (ir1ize-the-or-values ,ctype ,cont *lexenv* ,context))) ,@body)) + +(defmacro with-component-last-block ((component block) &body body) + (with-unique-names (old-last-block) + (once-only ((component component) + (block block)) + `(let ((,old-last-block (component-last-block ,component))) + (unwind-protect + (progn (setf (component-last-block ,component) + ,block) + ,@body) + (setf (component-last-block ,component) + ,old-last-block)))))) + ;;;; the EVENT statistics/trace utility @@ -694,7 +707,7 @@ ;;; experimentation, not for ordinary use, so it should probably ;;; become conditional on SB-SHOW. -(eval-when (:compile-toplevel :load-toplevel :execute) +(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) (defstruct (event-info (:copier nil)) ;; The name of this event. @@ -756,8 +769,8 @@ new-value)) (defsetf event-level %set-event-level) -;;; Define a new kind of event. Name is a symbol which names the event -;;; and Description is a string which describes the event. Level +;;; Define a new kind of event. NAME is a symbol which names the event +;;; and DESCRIPTION is a string which describes the event. Level ;;; (default 0) is the level of significance associated with this ;;; event; it is used to determine whether to print a Note when the ;;; event happens. @@ -776,7 +789,7 @@ (declaim (type unsigned-byte *event-note-threshold*)) (defvar *event-note-threshold* 1) -;;; Note that the event with the specified Name has happened. Node is +;;; Note that the event with the specified NAME has happened. NODE is ;;; evaluated to determine the node to which the event happened. (defmacro event (name &optional node) ;; Increment the counter and do any action. Mumble about the event if @@ -813,8 +826,8 @@ #!-sb-fluid (declaim (inline find-in position-in)) -;;; Find Element in a null-terminated List linked by the accessor -;;; function Next. Key, Test and Test-Not are the same as for generic +;;; Find ELEMENT in a null-terminated LIST linked by the accessor +;;; function NEXT. KEY, TEST and TEST-NOT are the same as for generic ;;; sequence functions. (defun find-in (next element @@ -836,9 +849,9 @@ (when (funcall test (funcall key current) element) (return current))))) -;;; Return the position of Element (or NIL if absent) in a -;;; null-terminated List linked by the accessor function Next. Key, -;;; Test and Test-Not are the same as for generic sequence functions. +;;; Return the position of ELEMENT (or NIL if absent) in a +;;; null-terminated LIST linked by the accessor function NEXT. KEY, +;;; TEST and TEST-NOT are the same as for generic sequence functions. (defun position-in (next element list