[armedbear-cvs] r14075 - trunk/abcl/src/org/armedbear/lisp
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Sun Aug 12 20:42:50 UTC 2012
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)
More information about the armedbear-cvs
mailing list