X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1tran.lisp;h=a583be1829f0a438c06027791ff80a477c2b7b21;hb=ec066d84dd46611428943d152749b3891a3f4b7c;hp=a1df32b2e4a09a09e631df743f97722ee81559d9;hpb=6053e7f804b430144bb09e2d107ad4ab3fb97db4;p=sbcl.git

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index a1df32b..a583be1 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -619,7 +619,12 @@
 	 (when (lambda-var-ignorep var)
 	   ;; (ANSI's specification for the IGNORE declaration requires
 	   ;; that this be a STYLE-WARNING, not a full WARNING.)
-	   (compiler-style-warn "reading an ignored variable: ~S" name)))
+	   #-sb-xc-host
+	   (compiler-style-warn "reading an ignored variable: ~S" name)
+	   ;; there's no need for us to accept ANSI's lameness when
+	   ;; processing our own code, though.
+	   #+sb-xc-host
+	   (compiler-warn "reading an ignored variable: ~S" name)))
        (reference-leaf start next result var))
       (cons
        (aver (eq (car var) 'MACRO))
@@ -1104,6 +1109,38 @@
 	(setf (lambda-var-ignorep var) t)))))
   (values))
 
+(defun process-dx-decl (names vars)
+  (flet ((maybe-notify (control &rest args)
+	   (when (policy *lexenv* (> speed inhibit-warnings))
+	     (apply #'compiler-notify control args))))
+    (if (policy *lexenv* (= stack-allocate-dynamic-extent 3))
+	(dolist (name names)
+	  (cond
+	    ((symbolp name)
+	     (let* ((bound-var (find-in-bindings vars name))
+		    (var (or bound-var
+			     (lexenv-find name vars)
+			     (find-free-var name))))
+	       (etypecase var
+		 (leaf
+		  (if bound-var
+		      (setf (leaf-dynamic-extent var) t)
+		      (maybe-notify
+		       "ignoring DYNAMIC-EXTENT declaration for free ~S"
+		       name)))
+		 (cons
+		  (compiler-error "DYNAMIC-EXTENT on symbol-macro: ~S" name))
+		 (heap-alien-info
+		  (compiler-error "DYNAMIC-EXTENT on heap-alien-info: ~S"
+				  name)))))
+	    ((and (consp name)
+		  (eq (car name) 'function)
+		  (null (cddr name))
+		  (valid-function-name-p (cadr name)))
+	     (maybe-notify "ignoring DYNAMIC-EXTENT declaration for ~S" name))
+	    (t (compiler-error "DYNAMIC-EXTENT on a weird thing: ~S" name))))
+      (maybe-notify "ignoring DYNAMIC-EXTENT declarations for ~S" names))))
+
 ;;; FIXME: This is non-ANSI, so the default should be T, or it should
 ;;; go away, I think.
 (defvar *suppress-values-declaration* nil
@@ -1146,10 +1183,7 @@
                        `(values ,@types)))))
           res))
        (dynamic-extent
-        (when (policy *lexenv* (> speed inhibit-warnings))
-          (compiler-notify
-           "compiler limitation: ~
-          ~%  There's no special support for DYNAMIC-EXTENT (so it's ignored)."))
+	(process-dx-decl (cdr spec) vars)
         res)
        (t
         (unless (info :declaration :recognized (first spec))