[armedbear-cvs] r14075 - trunk/abcl/src/org/armedbear/lisp

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Sun Aug 12 13:42:48 2012
New Revision: 14075

Log:
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.

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

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	Sun Aug 12 12:57:53 2012	(r14074)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	Sun Aug 12 13:42:48 2012	(r14075)
@@ -489,10 +489,12 @@
       ;; Make free specials visible.
       (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)
   (let* ((*visible-variables* *visible-variables*)
@@ -504,9 +506,11 @@
 ;;       (format t "p1-locally ~S is special~%" name)
       (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)
 (defun p1-m-v-b (form)
@@ -538,10 +542,12 @@
       (dolist (special (m-v-b-free-specials block))
         (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)
   (let* ((block (make-block-node (cadr form)))
@@ -956,9 +962,11 @@
             (process-declarations-for-vars body nil block))
       (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)
 (defun p1-funcall (form)