* enhancement: more informative compile-time warnings and runtime
errors for type-errors detected at compile-time.
* enhancement: deadlock detection for mutexes and spinlocks.
+ * enhancement: dynamic-extent for &rest lists stack allocate only their
+ spines, not their argumets. While portable code should not rely on this,
+ particularly in combination with inlining, it should make dynamic-extent
+ easier and safer to use.
* bug fix: blocking reads from FIFOs created by RUN-PROGRAM were
uninterruptible, as well as blocking reads from socket streams created
with for which :SERVE-EVENTS NIL. (regression from 1.0.42.43)
@cindex @code{dynamic-extent} declaration
@cindex declaration, @code{dynamic-extent}
-SBCL has limited support for performing allocation on the stack when a
-variable is declared @code{dynamic-extent}. The @code{dynamic-extent}
-declarations are not verified, but are simply trusted as long as
-@code{sb-ext:*stack-allocate-dynamic-extent*} is true.
+SBCL has fairly extensive support for performing allocation on the
+stack when a variable is declared @code{dynamic-extent}. The
+@code{dynamic-extent} declarations are not verified, but are simply
+trusted as long as @code{sb-ext:*stack-allocate-dynamic-extent*} is
+true.
+
+@include var-sb-ext-star-stack-allocate-dynamic-extent-star.texinfo
If dynamic extent constraints specified in the Common Lisp standard
are violated, the best that can happen is for the program to have
garbage in variables and return values; more commonly, the system will
crash.
-@include var-sb-ext-star-stack-allocate-dynamic-extent-star.texinfo
+In particular, it is important to realize that dynamic extend is
+contagious:
+
+@lisp
+(let* ((a (list 1 2 3))
+ (b (cons a a)))
+ (declare (dynamic-extent b))
+ ;; Unless A is accessed elsewhere as well, SBCL will consider
+ ;; it to be otherwise inaccessible -- it can only be accessed
+ ;; through B, after all -- and stack allocate it as well.
+ ;;
+ ;; Hence returning (CAR B) here is unsafe.
+ ...)
+@end lisp
+
+This allows stack allocation of complex structures. As a notable
+exception to this, SBCL does not as of 1.0.48.21 propagate
+dynamic-extentness through @code{&rest} arguments -- but another
+conforming implementation might, so portable code should not rely on
+this.
+
+@lisp
+(declaim (inline foo))
+(defun foo (fun &rest arguments)
+ (declare (dynamic-extent arguments))
+ (apply fun arguments))
+
+(defun bar (a)
+ ;; SBCL will heap allocate the result of (LIST A), and stack allocate
+ ;; only the spine of the &rest list -- so this is safe, but unportable.
+ ;;
+ ;; Another implementation, including earlier versions of SBCL might consider
+ ;; (LIST A) to be otherwise inaccessible and stack-allocate it as well!
+ (foo #'car (list a)))
+@end lisp
There are many cases when @code{dynamic-extent} declarations could be
useful. At present, SBCL implements stack allocation for
@cindex @code{safety} optimization quality
@cindex optimization quality, @code{safety}
closures defined with @code{flet} or @code{labels}, with a bound
-@code{dynamic-extent} declaration. Closed-over variables, which are
-assigned to (either inside or outside the closure) are still allocated
-on the heap. Blocks and tags are also allocated on the heap, unless
-all non-local control transfers to them are compiled with zero
-@code{safety}.
+@code{dynamic-extent} declaration. Blocks and tags are also allocated
+on the heap, unless all non-local control transfers to them are
+compiled with zero @code{safety}.
@item
user-defined structures when the structure constructor defined using
@itemize
@item
-Stack allocation of assigned-to closed-over variables, where these are
-declared @code{dynamic-extent};
-
-@item
Automatic detection of the common idiom of applying a function to some
defaults and a @code{&rest} list, even when this is not declared
@code{dynamic-extent};
(progn
(defoptimizer (allocate-vector stack-allocate-result)
((type length words) node dx)
- (or (eq dx :truly)
+ (or (eq dx :always-dynamic)
(zerop (policy node safety))
;; a vector object should fit in one page -- otherwise it might go past
;; stack guard pages.
(setf (lambda-var-ignorep var) t)))))
(values))
-(defun process-dx-decl (names vars fvars kind)
- (let ((dx (cond ((eq 'truly-dynamic-extent kind)
- :truly)
- ((and (eq 'dynamic-extent kind)
- *stack-allocate-dynamic-extent*)
- t))))
- (if dx
+(defun process-extent-decl (names vars fvars kind)
+ (let ((extent
+ (ecase kind
+ (truly-dynamic-extent
+ :always-dynamic)
+ (dynamic-extent
+ (when *stack-allocate-dynamic-extent*
+ :maybe-dynamic))
+ (indefinite-extent
+ :indefinite))))
+ (if extent
(dolist (name names)
(cond
((symbolp name)
(etypecase var
(leaf
(if bound-var
- (setf (leaf-dynamic-extent var) dx)
+ (if (and (leaf-extent var) (neq extent (leaf-extent var)))
+ (warn "Multiple incompatible extent declarations for ~S?" name)
+ (setf (leaf-extent var) extent))
(compiler-notify
- "Ignoring free DYNAMIC-EXTENT declaration: ~S" name)))
+ "Ignoring free ~S declaration: ~S" kind name)))
(cons
- (compiler-error "DYNAMIC-EXTENT on symbol-macro: ~S" name))
+ (compiler-error "~S on symbol-macro: ~S" kind name))
(heap-alien-info
- (compiler-error "DYNAMIC-EXTENT on alien-variable: ~S"
- name))
+ (compiler-error "~S on alien-variable: ~S" kind name))
(null
(compiler-style-warn
- "Unbound variable declared DYNAMIC-EXTENT: ~S" name)))))
+ "Unbound variable declared ~S: ~S" kind name)))))
((and (consp name)
(eq (car name) 'function)
(null (cddr name))
- (valid-function-name-p (cadr name)))
+ (valid-function-name-p (cadr name))
+ (neq :indefinite extent))
(let* ((fname (cadr name))
(bound-fun (find fname fvars
:key #'leaf-source-name
(leaf
(if bound-fun
#!+stack-allocatable-closures
- (setf (leaf-dynamic-extent bound-fun) dx)
+ (setf (leaf-extent bound-fun) extent)
#!-stack-allocatable-closures
(compiler-notify
"Ignoring DYNAMIC-EXTENT declaration on function ~S ~
(compiler-style-warn
"Unbound function declared DYNAMIC-EXTENT: ~S" name)))))
(t
- (compiler-error "DYNAMIC-EXTENT on a weird thing: ~S" name))))
+ (compiler-error "~S on a weird thing: ~S" kind name))))
(when (policy *lexenv* (= speed 3))
(compiler-notify "Ignoring DYNAMIC-EXTENT declarations: ~S" names)))))
(car types)
`(values ,@types)))))
res))
- ((dynamic-extent truly-dynamic-extent)
- (process-dx-decl (cdr spec) vars fvars (first spec))
+ ((dynamic-extent truly-dynamic-extent indefinite-extent)
+ (process-extent-decl (cdr spec) vars fvars (first spec))
res)
((disable-package-locks enable-package-locks)
(make-lexenv
(compiler-notify "could not stack allocate the result of ~S"
(find-original-source (node-source-path use)))))))
-(declaim (ftype (sfunction (node (member nil t :truly) &optional (or null component))
- boolean) use-good-for-dx-p))
-(declaim (ftype (sfunction (lvar (member nil t :truly) &optional (or null component))
- boolean) lvar-good-for-dx-p))
(defun use-good-for-dx-p (use dx &optional component)
;; FIXME: Can casts point to LVARs in other components?
;; RECHECK-DYNAMIC-EXTENT-LVARS assumes that they can't -- that is, that the
(defun trivial-lambda-var-ref-p (use)
(and (ref-p use)
(let ((var (ref-leaf use)))
- ;; lambda-var, no SETS
- (when (and (lambda-var-p var) (not (lambda-var-sets var)))
+ ;; lambda-var, no SETS, not explicitly indefinite-extent.
+ (when (and (lambda-var-p var) (not (lambda-var-sets var))
+ (neq :indefinite (lambda-var-extent var)))
(let ((home (lambda-var-home var))
(refs (lambda-var-refs var)))
;; bound by a system lambda, no other REFS
dx arg recheck-component)))
(ref
(let* ((other (trivial-lambda-var-ref-lvar use)))
+ (print (list :ref use other))
(unless (eq other lvar)
(handle-nested-dynamic-extent-lvars
dx other recheck-component)))))))
(declare (type combination call) (type clambda fun))
(loop for arg in (basic-combination-args call)
for var in (lambda-vars fun)
- for dx = (lambda-var-dynamic-extent var)
+ for dx = (leaf-dynamic-extent var)
when (and dx arg (not (lvar-dynamic-extent arg)))
append (handle-nested-dynamic-extent-lvars dx arg) into dx-lvars
finally (when dx-lvars
;;; function that rearranges the arguments and calls the entry point.
;;; We analyze the new function and the entry point immediately so
;;; that everything gets converted during the single pass.
-(defun convert-hairy-fun-entry (ref call entry vars ignores args)
+(defun convert-hairy-fun-entry (ref call entry vars ignores args indef)
(declare (list vars ignores args) (type ref ref) (type combination call)
(type clambda entry))
(let ((new-fun
(with-ir1-environment-from-node call
(ir1-convert-lambda
`(lambda ,vars
- (declare (ignorable ,@ignores))
+ (declare (ignorable ,@ignores)
+ (indefinite-extent ,@indef))
(%funcall ,entry ,@args))
:debug-name (debug-name 'hairy-function-entry
(lvar-fun-debug-name
(convert-hairy-fun-entry ref call (optional-dispatch-main-entry fun)
(append temps more-temps)
- (ignores) (call-args)))))
+ (ignores) (call-args)
+ more-temps))))
(values))
\f
;; be true when REFS and SETS are null, since code can be deleted.
(ever-used nil :type boolean)
;; is it declared dynamic-extent, or truly-dynamic-extent?
- (dynamic-extent nil :type (member nil t :truly))
+ (extent nil :type (member nil :maybe-dynamic :always-dynamic :indefinite))
;; some kind of info used by the back end
(info nil))
+(defun leaf-dynamic-extent (leaf)
+ (let ((extent (leaf-extent leaf)))
+ (unless (member extent '(nil :indefinite))
+ extent)))
+
;;; LEAF name operations
;;;
;;; KLUDGE: wants CLOS..
(cond (closure
(setq dx t))
(t
- (setf (leaf-dynamic-extent fun) nil)))))
+ (setf (leaf-extent fun) nil)))))
(when dx
(setf (lvar-dynamic-extent arg) cleanup)
(real-dx-lvars arg))))))
(return (bar))))))
(with-test (:name :bug-681092)
(assert (= 10 (bug-681092))))
+
+;;;; &REST lists should stop DX propagation -- not required by ANSI,
+;;;; but required by sanity.
+
+(declaim (inline rest-stops-dx))
+(defun-with-dx rest-stops-dx (&rest args)
+ (declare (dynamic-extent args))
+ (apply #'opaque-identity args))
+
+(defun-with-dx rest-stops-dx-ok ()
+ (equal '(:foo) (rest-stops-dx (list :foo))))
+
+(with-test (:name :rest-stops-dynamic-extent)
+ (assert (rest-stops-dx-ok)))
+
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.48.20"
+"1.0.48.21"
projects / sbcl.git / commitdiff