projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
1.0.31.22: improved SAP-{REF,SET}-* for x86-64
[sbcl.git]
/
src
/
code
/
eval.lisp
diff --git
a/src/code/eval.lisp
b/src/code/eval.lisp
index
56ea38c
..
ac9718f
100644
(file)
--- a/
src/code/eval.lisp
+++ b/
src/code/eval.lisp
@@
-11,6
+11,15
@@
(in-package "SB!IMPL")
(in-package "SB!IMPL")
+(defparameter *eval-calls* 0)
+
+(defun !eval-cold-init ()
+ (setf *eval-calls* 0
+ *evaluator-mode* :compile)
+ #!+sb-eval
+ (setf sb!eval::*eval-level* -1
+ sb!eval::*eval-verbose* nil))
+
;;; general case of EVAL (except in that it can't handle toplevel
;;; EVAL-WHEN magic properly): Delegate to #'COMPILE.
(defun %simple-eval (expr lexenv)
;;; general case of EVAL (except in that it can't handle toplevel
;;; EVAL-WHEN magic properly): Delegate to #'COMPILE.
(defun %simple-eval (expr lexenv)
@@
-20,9
+29,14
@@
;; to be careful about not muffling warnings arising from inner
;; evaluations/compilations, though [e.g. the ignored variable in
;; (DEFUN FOO (X) 1)]. -- CSR, 2003-05-13
;; to be careful about not muffling warnings arising from inner
;; evaluations/compilations, though [e.g. the ignored variable in
;; (DEFUN FOO (X) 1)]. -- CSR, 2003-05-13
+ ;;
+ ;; As of 1.0.21.6 we muffle compiler notes lexically here, which seems
+ ;; always safe. --NS
(let* (;; why PROGN? So that attempts to eval free declarations
;; signal errors rather than return NIL. -- CSR, 2007-05-01
(let* (;; why PROGN? So that attempts to eval free declarations
;; signal errors rather than return NIL. -- CSR, 2007-05-01
- (lambda `(lambda () (progn ,expr)))
+ (lambda `(lambda ()
+ (declare (muffle-conditions compiler-note))
+ (progn ,expr)))
(fun (sb!c:compile-in-lexenv nil lambda lexenv)))
(funcall fun)))
(fun (sb!c:compile-in-lexenv nil lambda lexenv)))
(funcall fun)))
@@
-93,6
+107,7
@@
(defun simple-eval-in-lexenv (original-exp lexenv)
(declare (optimize (safety 1)))
;; (aver (lexenv-simple-p lexenv))
(defun simple-eval-in-lexenv (original-exp lexenv)
(declare (optimize (safety 1)))
;; (aver (lexenv-simple-p lexenv))
+ (incf *eval-calls*)
(handler-bind
((sb!c:compiler-error
(lambda (c)
(handler-bind
((sb!c:compiler-error
(lambda (c)
@@
-115,9
+130,7
@@
(typecase exp
(symbol
(ecase (info :variable :kind exp)
(typecase exp
(symbol
(ecase (info :variable :kind exp)
- (:constant
- (values (info :variable :constant-value exp)))
- ((:special :global)
+ ((:special :global :constant :unknown)
(symbol-value exp))
;; FIXME: This special case here is a symptom of non-ANSI
;; weirdness in SBCL's ALIEN implementation, which could
(symbol-value exp))
;; FIXME: This special case here is a symptom of non-ANSI
;; weirdness in SBCL's ALIEN implementation, which could
@@
-143,7
+156,7
@@
(not (consp (let ((sb!c:*lexenv* lexenv))
(sb!c:lexenv-find name funs)))))
(%coerce-name-to-fun name)
(not (consp (let ((sb!c:*lexenv* lexenv))
(sb!c:lexenv-find name funs)))))
(%coerce-name-to-fun name)
- (%simple-eval original-exp lexenv))))
+ (%simple-eval original-exp lexenv))))
((quote)
(unless (= n-args 1)
(error "wrong number of args to QUOTE:~% ~S" exp))
((quote)
(unless (= n-args 1)
(error "wrong number of args to QUOTE:~% ~S" exp))
@@
-198,9
+211,9
@@
;; PROGN; otherwise, the EVAL-WHEN form returns NIL.
(declare (ignore ct lt))
(when e
;; PROGN; otherwise, the EVAL-WHEN form returns NIL.
(declare (ignore ct lt))
(when e
- (simple-eval-progn-body body lexenv)))))
+ (simple-eval-progn-body body lexenv)))))
((locally)
((locally)
- (simple-eval-locally exp lexenv))
+ (simple-eval-locally exp lexenv))
((macrolet)
(destructuring-bind (definitions &rest body)
(rest exp)
((macrolet)
(destructuring-bind (definitions &rest body)
(rest exp)
@@
-212,7
+225,7
@@
(declare (ignore funs))
sb!c:*lexenv*)
:eval))))
(declare (ignore funs))
sb!c:*lexenv*)
:eval))))
- (simple-eval-locally `(locally ,@body) lexenv))))
+ (simple-eval-locally `(locally ,@body) lexenv))))
((symbol-macrolet)
(destructuring-bind (definitions &rest body) (rest exp)
(multiple-value-bind (lexenv vars)
((symbol-macrolet)
(destructuring-bind (definitions &rest body) (rest exp)
(multiple-value-bind (lexenv vars)
@@
-287,7
+300,7
@@
(defun values (&rest values)
#!+sb-doc
"Return all arguments, in order, as values."
(defun values (&rest values)
#!+sb-doc
"Return all arguments, in order, as values."
- (declare (dynamic-extent values))
+ (declare (truly-dynamic-extent values))
(values-list values))
(defun values-list (list)
(values-list values))
(defun values-list (list)