Changeset 14075

Timestamp:

08/12/12 20:42:48 (9 years ago)

Author:

ehuelsmann

Message:

Fix #214: NOTINLINE declaration in expansion of compiler macro is ignored.

Note: The truth be told, but all optimization declarations (inline/

notinnline) were ignored in pass1, except in some rare cases.

File:

• trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp (modified) (4 diffs)

trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

@@ -490 +490 @@
       (dolist (variable (let-free-specials block))
         (push variable *visible-variables*)))
-    (let ((*blocks* (cons block *blocks*)))
-      (setf body (p1-body body)))
-    (setf (let-form block) (list* op varlist body))
-    block))
+    (with-saved-compiler-policy
+      (process-optimization-declarations body)
+      (let ((*blocks* (cons block *blocks*)))
+        (setf body (p1-body body)))
+      (setf (let-form block) (list* op varlist body))
+      block)))
 
 (defun p1-locally (form)
@@ -505 +507 @@
       (push special *visible-variables*))
     (let ((*blocks* (cons block *blocks*)))
-      (setf (locally-form block)
-            (list* 'LOCALLY (p1-body (cdr form))))
-      block)))
+      (with-saved-compiler-policy
+        (process-optimization-declarations (cdr form))
+        (setf (locally-form block)
+              (list* 'LOCALLY (p1-body (cdr form))))
+        block))))
 
 (defknown p1-m-v-b (t) t)
@@ -539 +543 @@
         (push special *visible-variables*))
       (setf (m-v-b-vars block) (nreverse vars)))
-    (setf body (p1-body body))
-    (setf (m-v-b-form block)
-          (list* 'MULTIPLE-VALUE-BIND varlist values-form body))
-    block))
+    (with-saved-compiler-policy
+      (process-optimization-declarations body)
+      (setf body (p1-body body))
+      (setf (m-v-b-form block)
+            (list* 'MULTIPLE-VALUE-BIND varlist values-form body))
+      block)))
 
 (defun p1-block (form)
@@ -957 +963 @@
       (dolist (special (labels-free-specials block))
         (push special *visible-variables*))
-      (setf (labels-form block)
-            (list* (car form) local-functions (p1-body (cddr form))))
-      block)))
+      (with-saved-compiler-policy
+        (process-optimization-declarations (cddr form))
+        (setf (labels-form block)
+              (list* (car form) local-functions (p1-body (cddr form))))
+        block))))
 
 (defknown p1-funcall (t) t)