From: Nikodemus S. <de...@us...> - 2008-07-30 17:58:49
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv20769/src/code Modified Files: array.lisp backq.lisp defboot.lisp early-extensions.lisp eval.lisp list.lisp numbers.lisp profile.lisp seq.lisp sort.lisp step.lisp target-char.lisp target-error.lisp target-signal.lisp Added Files: cross-early.lisp Log Message: 1.0.19.7: refactor stack allocation decisions * Remove SB-C::STACK-ALLOCATE-* policies. * Obey DYNAMIC-EXTENT declarations if SB-EXT:*STACK-ALLOCATE-DYNAMIC-EXTENT* is true (the default), with the following exceptions: ** Value cells are not stack allocated. ** Vectors that may be longer then a single page are stack allocated only in SAFETY 0 policies. * New declaration: SB-INT:TRULY-DYNAMIC-EXTENT. Always stack-allocates, regardless of SB-EXT:*STACK-ALLOCATE-DYNAMIC-EXTENT*. Also causes stack allocation of value cells and potentially large vectors. Used exclusively inside SBCL. * Move STACK-ALLOCATE-RESULT optimizers from backends to src/compiler/generic/vm-ir2tran.lisp. * Documentation. --- NEW FILE: cross-early.lisp --- ;;;; cross-compile-time-only stuff that is needed before anything else ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. ;;;; ;;;; This software is derived from the CMU CL system, which was ;;;; written at Carnegie Mellon University and released into the ;;;; public domain. The software is in the public domain and is ;;;; provided with absolutely no warranty. See the COPYING and CREDITS ;;;; files for more information. (in-package "SB!IMPL") (declaim (declaration truly-dynamic-extent)) Index: array.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/array.lisp,v retrieving revision 1.74 retrieving revision 1.75 diff -u -d -r1.74 -r1.75 --- array.lisp 28 Jan 2008 15:11:00 -0000 1.74 +++ array.lisp 30 Jul 2008 17:58:40 -0000 1.75 @@ -527,17 +527,17 @@ t)) (defun array-row-major-index (array &rest subscripts) - (declare (dynamic-extent subscripts)) + (declare (truly-dynamic-extent subscripts)) (%array-row-major-index array subscripts)) (defun aref (array &rest subscripts) #!+sb-doc "Return the element of the ARRAY specified by the SUBSCRIPTS." - (declare (dynamic-extent subscripts)) + (declare (truly-dynamic-extent subscripts)) (row-major-aref array (%array-row-major-index array subscripts))) (defun %aset (array &rest stuff) - (declare (dynamic-extent stuff)) + (declare (truly-dynamic-extent stuff)) (let ((subscripts (butlast stuff)) (new-value (car (last stuff)))) (setf (row-major-aref array (%array-row-major-index array subscripts)) @@ -570,7 +570,7 @@ #!-sb-fluid (declaim (inline (setf aref))) (defun (setf aref) (new-value array &rest subscripts) - (declare (dynamic-extent subscripts)) + (declare (truly-dynamic-extent subscripts)) (declare (type array array)) (setf (row-major-aref array (%array-row-major-index array subscripts)) new-value)) Index: backq.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/backq.lisp,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- backq.lisp 16 Sep 2007 12:05:17 -0000 1.14 +++ backq.lisp 30 Jul 2008 17:58:40 -0000 1.15 @@ -208,7 +208,7 @@ ;; whether there's still an optimizer bug, and fix it if so, and ;; then make these INLINE. `(defun ,b-name (&rest ,args) - (declare (dynamic-extent ,args)) + (declare (truly-dynamic-extent ,args)) (apply #',name ,args))))) (def backq-list list) (def backq-list* list*) Index: defboot.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/defboot.lisp,v retrieving revision 1.62 retrieving revision 1.63 diff -u -d -r1.62 -r1.63 --- defboot.lisp 8 Jul 2008 21:31:53 -0000 1.62 +++ defboot.lisp 30 Jul 2008 17:58:40 -0000 1.63 @@ -573,31 +573,27 @@ (let* ((local-funs nil) (mapped-bindings (mapcar (lambda (binding) (destructuring-bind (type handler) binding - (let (lambda-form) + (let ((lambda-form handler)) (if (and (consp handler) - (or (prog1 (eq 'lambda (car handler)) - (setf lambda-form handler)) + (or (eq 'lambda (car handler)) (and (eq 'function (car handler)) (consp (cdr handler)) - (consp (cadr handler)) - (prog1 (eq 'lambda (caadr handler)) - (setf lambda-form (cadr handler))))) - ;; KLUDGE: DX-FLET doesn't handle non-required arguments yet. - (not (intersection (second lambda-form) sb!xc:lambda-list-keywords))) + (let ((x (second handler))) + (and (consp x) + (eq 'lambda (car x)) + (setf lambda-form x)))))) (let ((name (gensym "LAMBDA"))) (push `(,name ,@(cdr lambda-form)) local-funs) (list type `(function ,name))) binding)))) - bindings)) - (form-fun (gensym "FORM-FUN"))) - `(dx-flet (,@(reverse local-funs) - (,form-fun () (progn ,form))) + bindings))) + `(dx-flet (,@(reverse local-funs)) (let ((*handler-clusters* (cons (list ,@(mapcar (lambda (x) `(cons ',(car x) ,(cadr x))) mapped-bindings)) *handler-clusters*))) - (declare (dynamic-extent *handler-clusters*)) - (,form-fun))))) + (declare (truly-dynamic-extent *handler-clusters*)) + (progn ,form))))) (defmacro-mundanely handler-bind (bindings &body forms) #!+sb-doc Index: early-extensions.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/early-extensions.lisp,v retrieving revision 1.95 retrieving revision 1.96 diff -u -d -r1.95 -r1.96 --- early-extensions.lisp 30 Jul 2008 13:51:55 -0000 1.95 +++ early-extensions.lisp 30 Jul 2008 17:58:40 -0000 1.96 @@ -1225,53 +1225,19 @@ ;;; Helper for making the DX closure allocation in macros expanding ;;; to CALL-WITH-FOO less ugly. -;;; -;;; This expands to something like -;;; -;;; (flet ((foo (...) <body-of-foo>)) -;;; (declare (optimize stack-allocate-dynamic-extent)) -;;; (flet ((foo (...) -;;; (foo ...)) -;;; (declare (dynamic-extent #'foo)) -;;; <body-of-dx-flet>))) -;;; -;;; The outer FLETs are inlined into the inner ones, and the inner ones -;;; are DX-allocated. The double-fletting is done to keep the bodies of -;;; the functions in an environment with correct policy: we don't want -;;; to force DX allocation in their bodies, which would be bad eg. -;;; in safe code. (defmacro dx-flet (functions &body forms) - (let ((names (mapcar #'car functions))) - `(flet ,functions - #-sb-xc-host - (declare (optimize sb!c::stack-allocate-dynamic-extent)) - (flet ,(mapcar - (lambda (f) - (let ((args (cadr f)) - (name (car f))) - (when (intersection args sb!xc:lambda-list-keywords) - ;; No fundamental reason not to support them, but we - ;; don't currently need them here. - (error "Non-required arguments not implemented for DX-FLET.")) - `(,name ,args - (,name ,@args)))) - functions) - (declare (dynamic-extent ,@(mapcar (lambda (x) `(function ,x)) names))) - ,@forms)))) + `(flet ,functions + (declare (#+sb-xc-host dynamic-extent #-sb-xc-host truly-dynamic-extent + ,@(mapcar (lambda (func) `(function ,(car func))) functions))) + ,@forms)) -;;; Another similar one -- but actually touches the policy of the body, -;;; so take care with this one... +;;; Another similar one. (defmacro dx-let (bindings &body forms) - `(locally - (declare (optimize #-sb-xc-host sb!c::stack-allocate-dynamic-extent - #-sb-xc-host sb!c::stack-allocate-value-cells)) - (let ,bindings - (declare (dynamic-extent ,@(mapcar (lambda (bind) - (if (consp bind) - (car bind) - bind)) - bindings))) - ,@forms))) + `(let ,bindings + (declare (#+sb-xc-host dynamic-extent #-sb-xc-host truly-dynamic-extent + ,@(mapcar (lambda (bind) (if (consp bind) (car bind) bind)) + bindings))) + ,@forms)) (in-package "SB!KERNEL") Index: eval.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/eval.lisp,v retrieving revision 1.42 retrieving revision 1.43 diff -u -d -r1.42 -r1.43 --- eval.lisp 4 Jun 2008 12:39:40 -0000 1.42 +++ eval.lisp 30 Jul 2008 17:58:40 -0000 1.43 @@ -295,7 +295,7 @@ (defun values (&rest values) #!+sb-doc "Return all arguments, in order, as values." - (declare (dynamic-extent values)) + (declare (truly-dynamic-extent values)) (values-list values)) (defun values-list (list) Index: list.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/list.lisp,v retrieving revision 1.44 retrieving revision 1.45 diff -u -d -r1.44 -r1.45 --- list.lisp 31 May 2008 17:43:12 -0000 1.44 +++ list.lisp 30 Jul 2008 17:58:40 -0000 1.45 @@ -341,7 +341,7 @@ (defun append (&rest lists) #!+sb-doc "Construct a new list by concatenating the list arguments" - (declare (dynamic-extent lists) (optimize speed)) + (declare (truly-dynamic-extent lists) (optimize speed)) (labels ((fail (object) (error 'type-error :datum object @@ -471,7 +471,7 @@ (defun nconc (&rest lists) #!+sb-doc "Concatenates the lists given as arguments (by changing them)" - (declare (dynamic-extent lists) (optimize speed)) + (declare (truly-dynamic-extent lists) (optimize speed)) (flet ((fail (object) (error 'type-error :datum object Index: numbers.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/numbers.lisp,v retrieving revision 1.52 retrieving revision 1.53 diff -u -d -r1.52 -r1.53 --- numbers.lisp 30 Jun 2008 09:00:38 -0000 1.52 +++ numbers.lisp 30 Jul 2008 17:58:40 -0000 1.53 @@ -742,7 +742,7 @@ (defun = (number &rest more-numbers) #!+sb-doc "Return T if all of its arguments are numerically equal, NIL otherwise." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (the number number) (do ((nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -752,7 +752,7 @@ (defun /= (number &rest more-numbers) #!+sb-doc "Return T if no two of its arguments are numerically equal, NIL otherwise." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (do* ((head (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -766,7 +766,7 @@ (defun < (number &rest more-numbers) #!+sb-doc "Return T if its arguments are in strictly increasing order, NIL otherwise." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (do* ((n (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -776,7 +776,7 @@ (defun > (number &rest more-numbers) #!+sb-doc "Return T if its arguments are in strictly decreasing order, NIL otherwise." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (do* ((n (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -786,7 +786,7 @@ (defun <= (number &rest more-numbers) #!+sb-doc "Return T if arguments are in strictly non-decreasing order, NIL otherwise." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (do* ((n (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -796,7 +796,7 @@ (defun >= (number &rest more-numbers) #!+sb-doc "Return T if arguments are in strictly non-increasing order, NIL otherwise." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (do* ((n (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -807,7 +807,7 @@ #!+sb-doc "Return the greatest of its arguments; among EQUALP greatest, return the first." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (do ((nlist more-numbers (cdr nlist)) (result number)) ((null nlist) (return result)) @@ -819,7 +819,7 @@ #!+sb-doc "Return the least of its arguments; among EQUALP least, return the first." - (declare (dynamic-extent more-numbers)) + (declare (truly-dynamic-extent more-numbers)) (do ((nlist more-numbers (cdr nlist)) (result number)) ((null nlist) (return result)) Index: profile.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/profile.lisp,v retrieving revision 1.38 retrieving revision 1.39 diff -u -d -r1.38 -r1.39 --- profile.lisp 19 Nov 2007 01:04:41 -0000 1.38 +++ profile.lisp 30 Jul 2008 17:58:40 -0000 1.39 @@ -145,7 +145,7 @@ (values ;; ENCAPSULATION-FUN (lambda (&more arg-context arg-count) - (declare (optimize speed safety sb-c::stack-allocate-dynamic-extent)) + (declare (optimize speed safety)) ;; Make sure that we're not recursing infinitely. (when (boundp '*computing-profiling-data-for*) (unprofile-all) ; to avoid further recursion Index: seq.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/seq.lisp,v retrieving revision 1.84 retrieving revision 1.85 diff -u -d -r1.84 -r1.85 --- seq.lisp 3 Jun 2008 15:07:03 -0000 1.84 +++ seq.lisp 30 Jul 2008 17:58:40 -0000 1.85 @@ -673,7 +673,7 @@ #!+sb-doc "The target sequence is destructively modified by copying successive elements into it from the source sequence." - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let* (;; KLUDGE: absent either rewriting FOO-REPLACE-FROM-BAR, or ;; excessively polluting DEFINE-SEQUENCE-TRAVERSER, we rebind ;; these things here so that legacy code gets the names it's @@ -961,9 +961,9 @@ (type list sequences)) (let ((result nil)) (flet ((f (&rest args) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (push (apply fun args) result))) - (declare (dynamic-extent #'f)) + (declare (truly-dynamic-extent #'f)) (%map-for-effect #'f sequences)) (nreverse result))) (defun %map-to-vector (output-type-spec fun sequences) @@ -971,19 +971,19 @@ (type list sequences)) (let ((min-len 0)) (flet ((f (&rest args) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (declare (ignore args)) (incf min-len))) - (declare (dynamic-extent #'f)) + (declare (truly-dynamic-extent #'f)) (%map-for-effect #'f sequences)) (let ((result (make-sequence output-type-spec min-len)) (i 0)) (declare (type (simple-array * (*)) result)) (flet ((f (&rest args) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (setf (aref result i) (apply fun args)) (incf i))) - (declare (dynamic-extent #'f)) + (declare (truly-dynamic-extent #'f)) (%map-for-effect #'f sequences)) result))) (defun %map-to-sequence (result-type fun sequences) @@ -991,20 +991,20 @@ (type list sequences)) (let ((min-len 0)) (flet ((f (&rest args) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (declare (ignore args)) (incf min-len))) - (declare (dynamic-extent #'f)) + (declare (truly-dynamic-extent #'f)) (%map-for-effect #'f sequences)) (let ((result (make-sequence result-type min-len))) (multiple-value-bind (state limit from-end step endp elt setelt) (sb!sequence:make-sequence-iterator result) (declare (ignore limit endp elt)) (flet ((f (&rest args) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (funcall setelt (apply fun args) result state) (setq state (funcall step result state from-end)))) - (declare (dynamic-extent #'f)) + (declare (truly-dynamic-extent #'f)) (%map-for-effect #'f sequences))) result))) @@ -1234,7 +1234,7 @@ (define-sequence-traverser reduce (function sequence &rest args &key key from-end start end (initial-value nil ivp)) (declare (type index start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((start start) (end (or end length))) (declare (type index start end)) @@ -1377,7 +1377,7 @@ "Return a sequence formed by destructively removing the specified ITEM from the given SEQUENCE." (declare (fixnum start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((end (or end length))) (declare (type index end)) (seq-dispatch sequence @@ -1415,7 +1415,7 @@ "Return a sequence formed by destructively removing the elements satisfying the specified PREDICATE from the given SEQUENCE." (declare (fixnum start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((end (or end length))) (declare (type index end)) (seq-dispatch sequence @@ -1453,7 +1453,7 @@ "Return a sequence formed by destructively removing the elements not satisfying the specified PREDICATE from the given SEQUENCE." (declare (fixnum start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((end (or end length))) (declare (type index end)) (seq-dispatch sequence @@ -1602,7 +1602,7 @@ "Return a copy of SEQUENCE with elements satisfying the test (default is EQL) with ITEM removed." (declare (fixnum start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((end (or end length))) (declare (type index end)) (seq-dispatch sequence @@ -1619,7 +1619,7 @@ #!+sb-doc "Return a copy of sequence with elements satisfying PREDICATE removed." (declare (fixnum start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((end (or end length))) (declare (type index end)) (seq-dispatch sequence @@ -1636,7 +1636,7 @@ #!+sb-doc "Return a copy of sequence with elements not satisfying PREDICATE removed." (declare (fixnum start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((end (or end length))) (declare (type index end)) (seq-dispatch sequence @@ -1788,7 +1788,7 @@ The :TEST-NOT argument is deprecated." (declare (fixnum start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (seq-dispatch sequence (if sequence (list-remove-duplicates* sequence test test-not @@ -1861,7 +1861,7 @@ given sequence, is returned. The :TEST-NOT argument is deprecated." - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (seq-dispatch sequence (if sequence (list-delete-duplicates* sequence test test-not @@ -1981,7 +1981,7 @@ "Return a sequence of the same kind as SEQUENCE with the same elements, except that all elements equal to OLD are replaced with NEW." (declare (fixnum start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((end (or end length))) (declare (type index end)) (subst-dispatch 'normal))) @@ -1993,7 +1993,7 @@ #!+sb-doc "Return a sequence of the same kind as SEQUENCE with the same elements except that all elements satisfying the PRED are replaced with NEW." - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (declare (fixnum start)) (let ((end (or end length)) (test predicate) @@ -2007,7 +2007,7 @@ #!+sb-doc "Return a sequence of the same kind as SEQUENCE with the same elements except that all elements not satisfying the PRED are replaced with NEW." - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (declare (fixnum start)) (let ((end (or end length)) (test predicate) @@ -2026,7 +2026,7 @@ except that all elements equal to OLD are replaced with NEW. SEQUENCE may be destructively modified." (declare (fixnum start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((end (or end length))) (seq-dispatch sequence (if from-end @@ -2079,7 +2079,7 @@ except that all elements satisfying PREDICATE are replaced with NEW. SEQUENCE may be destructively modified." (declare (fixnum start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((end (or end length))) (declare (fixnum end)) (seq-dispatch sequence @@ -2121,7 +2121,7 @@ except that all elements not satisfying PREDICATE are replaced with NEW. SEQUENCE may be destructively modified." (declare (fixnum start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((end (or end length))) (declare (fixnum end)) (seq-dispatch sequence @@ -2212,7 +2212,7 @@ (defun find (item sequence &rest args &key from-end (start 0) end key test test-not) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (seq-dispatch sequence (nth-value 0 (%find-position item sequence from-end start end @@ -2225,7 +2225,7 @@ (apply #'sb!sequence:find item sequence args))) (defun position (item sequence &rest args &key from-end (start 0) end key test test-not) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (seq-dispatch sequence (nth-value 1 (%find-position item sequence from-end start end @@ -2238,7 +2238,7 @@ (apply #'sb!sequence:position item sequence args))) (defun find-if (predicate sequence &rest args &key from-end (start 0) end key) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (seq-dispatch sequence (nth-value 0 (%find-position-if (%coerce-callable-to-fun predicate) @@ -2251,7 +2251,7 @@ (apply #'sb!sequence:find-if predicate sequence args))) (defun position-if (predicate sequence &rest args &key from-end (start 0) end key) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (seq-dispatch sequence (nth-value 1 (%find-position-if (%coerce-callable-to-fun predicate) @@ -2265,7 +2265,7 @@ (defun find-if-not (predicate sequence &rest args &key from-end (start 0) end key) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (seq-dispatch sequence (nth-value 0 (%find-position-if-not (%coerce-callable-to-fun predicate) @@ -2278,7 +2278,7 @@ (apply #'sb!sequence:find-if-not predicate sequence args))) (defun position-if-not (predicate sequence &rest args &key from-end (start 0) end key) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (seq-dispatch sequence (nth-value 1 (%find-position-if-not (%coerce-callable-to-fun predicate) @@ -2327,7 +2327,7 @@ #!+sb-doc "Return the number of elements in SEQUENCE satisfying PRED(el)." (declare (fixnum start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((end (or end length)) (pred (%coerce-callable-to-fun pred))) (declare (type index end)) @@ -2345,7 +2345,7 @@ #!+sb-doc "Return the number of elements in SEQUENCE not satisfying TEST(el)." (declare (fixnum start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((end (or end length)) (pred (%coerce-callable-to-fun pred))) (declare (type index end)) @@ -2365,7 +2365,7 @@ "Return the number of elements in SEQUENCE satisfying a test with ITEM, which defaults to EQL." (declare (fixnum start)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (when (and test-p test-not-p) ;; ANSI Common Lisp has left the behavior in this situation unspecified. ;; (CLHS 17.2.1) @@ -2473,7 +2473,7 @@ :FROM-END argument is given, then one plus the index of the rightmost position in which the sequences differ is returned." (declare (fixnum start1 start2)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let* ((end1 (or end1 length1)) (end2 (or end2 length2))) (declare (type index end1 end2)) @@ -2583,7 +2583,7 @@ (sequence1 sequence2 &rest args &key from-end test test-not start1 end1 start2 end2 key) (declare (fixnum start1 start2)) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((end1 (or end1 length1)) (end2 (or end2 length2))) (seq-dispatch sequence2 Index: sort.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/sort.lisp,v retrieving revision 1.24 retrieving revision 1.25 diff -u -d -r1.24 -r1.25 --- sort.lisp 28 Jan 2008 15:11:00 -0000 1.24 +++ sort.lisp 30 Jul 2008 17:58:41 -0000 1.25 @@ -23,7 +23,7 @@ #!+sb-doc "Destructively sort SEQUENCE. PREDICATE should return non-NIL if ARG1 is to precede ARG2." - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((predicate-fun (%coerce-callable-to-fun predicate))) (seq-dispatch sequence (stable-sort-list sequence @@ -43,7 +43,7 @@ #!+sb-doc "Destructively sort SEQUENCE. PREDICATE should return non-NIL if ARG1 is to precede ARG2." - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (let ((predicate-fun (%coerce-callable-to-fun predicate))) (seq-dispatch sequence (stable-sort-list sequence Index: step.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/step.lisp,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- step.lisp 1 Nov 2006 13:00:41 -0000 1.7 +++ step.lisp 30 Jul 2008 17:58:41 -0000 1.8 @@ -41,7 +41,7 @@ t))) (defun step-values (form &rest values) - (declare (dynamic-extent values)) + (declare (truly-dynamic-extent values)) (signal 'step-values-condition :form form :result values) (values-list values)) Index: target-char.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/target-char.lisp,v retrieving revision 1.18 retrieving revision 1.19 diff -u -d -r1.18 -r1.19 --- target-char.lisp 10 Dec 2007 05:42:47 -0000 1.18 +++ target-char.lisp 30 Jul 2008 17:58:41 -0000 1.19 @@ -372,7 +372,7 @@ (defun char= (character &rest more-characters) #!+sb-doc "Return T if all of the arguments are the same character." - (declare (dynamic-extent more-characters)) + (declare (truly-dynamic-extent more-characters)) (dolist (c more-characters t) (declare (type character c)) (unless (eq c character) (return nil)))) @@ -380,7 +380,7 @@ (defun char/= (character &rest more-characters) #!+sb-doc "Return T if no two of the arguments are the same character." - (declare (dynamic-extent more-characters)) + (declare (truly-dynamic-extent more-characters)) (do* ((head character (car list)) (list more-characters (cdr list))) ((null list) t) @@ -392,7 +392,7 @@ (defun char< (character &rest more-characters) #!+sb-doc "Return T if the arguments are in strictly increasing alphabetic order." - (declare (dynamic-extent more-characters)) + (declare (truly-dynamic-extent more-characters)) (do* ((c character (car list)) (list more-characters (cdr list))) ((null list) t) @@ -403,7 +403,7 @@ (defun char> (character &rest more-characters) #!+sb-doc "Return T if the arguments are in strictly decreasing alphabetic order." - (declare (dynamic-extent more-characters)) + (declare (truly-dynamic-extent more-characters)) (do* ((c character (car list)) (list more-characters (cdr list))) ((null list) t) @@ -414,7 +414,7 @@ (defun char<= (character &rest more-characters) #!+sb-doc "Return T if the arguments are in strictly non-decreasing alphabetic order." - (declare (dynamic-extent more-characters)) + (declare (truly-dynamic-extent more-characters)) (do* ((c character (car list)) (list more-characters (cdr list))) ((null list) t) @@ -425,7 +425,7 @@ (defun char>= (character &rest more-characters) #!+sb-doc "Return T if the arguments are in strictly non-increasing alphabetic order." - (declare (dynamic-extent more-characters)) + (declare (truly-dynamic-extent more-characters)) (do* ((c character (car list)) (list more-characters (cdr list))) ((null list) t) @@ -450,7 +450,7 @@ #!+sb-doc "Return T if all of the arguments are the same character. Font, bits, and case are ignored." - (declare (dynamic-extent more-characters)) + (declare (truly-dynamic-extent more-characters)) (do ((clist more-characters (cdr clist))) ((null clist) t) (unless (two-arg-char-equal (car clist) character) @@ -463,7 +463,7 @@ #!+sb-doc "Return T if no two of the arguments are the same character. Font, bits, and case are ignored." - (declare (dynamic-extent more-characters)) + (declare (truly-dynamic-extent more-characters)) (do* ((head character (car list)) (list more-characters (cdr list))) ((null list) t) @@ -480,7 +480,7 @@ #!+sb-doc "Return T if the arguments are in strictly increasing alphabetic order. Font, bits, and case are ignored." - (declare (dynamic-extent more-characters)) + (declare (truly-dynamic-extent more-characters)) (do* ((c character (car list)) (list more-characters (cdr list))) ((null list) t) @@ -494,7 +494,7 @@ #!+sb-doc "Return T if the arguments are in strictly decreasing alphabetic order. Font, bits, and case are ignored." - (declare (dynamic-extent more-characters)) + (declare (truly-dynamic-extent more-characters)) (do* ((c character (car list)) (list more-characters (cdr list))) ((null list) t) @@ -508,7 +508,7 @@ #!+sb-doc "Return T if the arguments are in strictly non-decreasing alphabetic order. Font, bits, and case are ignored." - (declare (dynamic-extent more-characters)) + (declare (truly-dynamic-extent more-characters)) (do* ((c character (car list)) (list more-characters (cdr list))) ((null list) t) @@ -522,7 +522,7 @@ #!+sb-doc "Return T if the arguments are in strictly non-increasing alphabetic order. Font, bits, and case are ignored." - (declare (dynamic-extent more-characters)) + (declare (truly-dynamic-extent more-characters)) (do* ((c character (car list)) (list more-characters (cdr list))) ((null list) t) Index: target-error.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/target-error.lisp,v retrieving revision 1.20 retrieving revision 1.21 diff -u -d -r1.20 -r1.21 --- target-error.lisp 30 Jul 2008 13:53:12 -0000 1.20 +++ target-error.lisp 30 Jul 2008 17:58:41 -0000 1.21 @@ -56,7 +56,6 @@ (setq other (append (cdr alist) other)))) (collect ((res)) (let ((stack *restart-test-stack*)) - (declare (optimize sb!c::stack-allocate-dynamic-extent)) (dolist (restart-cluster *restart-clusters*) (dolist (restart restart-cluster) (when (and (or (not condition) @@ -69,7 +68,7 @@ ;; duraction of the test call. (not (memq restart stack)) (let ((*restart-test-stack* (cons restart stack))) - (declare (dynamic-extent *restart-test-stack*)) + (declare (truly-dynamic-extent *restart-test-stack*)) (funcall (restart-test-function restart) condition))) (res restart))))) (res)))) Index: target-signal.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/target-signal.lisp,v retrieving revision 1.43 retrieving revision 1.44 diff -u -d -r1.43 -r1.44 --- target-signal.lisp 19 May 2008 14:06:28 -0000 1.43 +++ target-signal.lisp 30 Jul 2008 17:58:41 -0000 1.44 @@ -92,7 +92,7 @@ (declare (type (or function fixnum (member :default :ignore)) handler)) (/show0 "enable-interrupt") (flet ((run-handler (&rest args) - (declare (dynamic-extent args)) + (declare (truly-dynamic-extent args)) (in-interruption () (apply handler args)))) (without-gcing |