mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
Don't use NOTINLINE to suppress compiler macros inside define-c-m.
It forces the compiler to think that it's a function. Invent a compiler-macro specific way, to be used only by define-compiler-macro. Reported by Robert Smith.
This commit is contained in:
parent
3be22b0ea4
commit
bdfad76893
|
|
@ -164,7 +164,13 @@
|
|||
;; FIXME: this seems to omit FUNCTIONAL
|
||||
(when (defined-fun-p fun)
|
||||
(return-from fun-lexically-notinline-p
|
||||
(eq (defined-fun-inlinep fun) 'notinline))))))))
|
||||
(eq (defined-fun-inlinep fun) 'notinline)))
|
||||
(loop for data in (lexenv-user-data env)
|
||||
when (and (eq (car data) 'no-compiler-macro)
|
||||
(eq (cdr data) name))
|
||||
do
|
||||
(return-from fun-lexically-notinline-p
|
||||
t)))))))
|
||||
;; If ANSWER is NIL, go for the global value
|
||||
(eq (or answer (info :function :inlinep name)) 'notinline)))
|
||||
|
||||
|
|
@ -1557,6 +1563,11 @@ the stack without triggering overflow protection.")
|
|||
(process-ftype-decl (second spec) res (cddr spec) fvars context))
|
||||
((inline notinline maybe-inline)
|
||||
(process-inline-decl spec res fvars))
|
||||
(no-compiler-macro
|
||||
(make-lexenv :default res
|
||||
:user-data (list*
|
||||
(cons 'no-compiler-macro (second spec))
|
||||
(lexenv-user-data res))))
|
||||
(optimize
|
||||
(multiple-value-bind (new-policy specified-qualities)
|
||||
(process-optimize-decl spec (lexenv-policy res))
|
||||
|
|
|
|||
|
|
@ -1233,8 +1233,7 @@
|
|||
;; Avoid warnings about emitted full calls
|
||||
;; inside the body of a compiler macro itself.
|
||||
,@(and (eq kind 'define-compiler-macro)
|
||||
(not (memq (info :function :kind name) '(:macro :special-form)))
|
||||
`((notinline ,name))))
|
||||
`((no-compiler-macro ,name))))
|
||||
|
||||
,@decls
|
||||
,@(if wrap-block
|
||||
|
|
|
|||
|
|
@ -588,8 +588,7 @@
|
|||
(declare (ignore x))))))
|
||||
(dolist (form forms)
|
||||
(assert (nth-value
|
||||
1 (checked-compile `(lambda () ,form) :allow-failure t
|
||||
:allow-style-warnings t))))))
|
||||
1 (checked-compile `(lambda () ,form) :allow-failure t))))))
|
||||
|
||||
(with-test (:name (compile make-array svref :derive-type))
|
||||
(multiple-value-bind (fun failurep warnings)
|
||||
|
|
|
|||
|
|
@ -23,9 +23,6 @@
|
|||
(+ (eval x) 19)
|
||||
form))
|
||||
|
||||
(defun foo-expander (x)
|
||||
x)
|
||||
|
||||
(defun way1 (x)
|
||||
(fruitbat x))
|
||||
|
||||
|
|
|
|||
|
|
@ -366,7 +366,7 @@
|
|||
*illegal-double-forms*)
|
||||
:key #'first))
|
||||
(with-error-info ("locked illegal runtime form: ~S~%" form)
|
||||
(let ((fun (checked-compile `(lambda () ,form) :allow-style-warnings t)))
|
||||
(let ((fun (checked-compile `(lambda () ,form))))
|
||||
(assert-error (funcall fun) sb-ext:package-lock-violation))
|
||||
(assert-error (eval form) sb-ext:package-lock-violation))))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue