3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB!BYTECODE")
14 ;;; Note: This is defined here, but it's visible in SB-KERNEL, since
15 ;;; various magical things need to happen to it, e.g. initialization
16 ;;; early in cold load, and save/restore in nonlocal exit logic.
17 (defvar *eval-stack-top* 0)
19 ;;; general case of EVAL (except in that it can't handle toplevel
20 ;;; EVAL-WHEN magic properly): Delegate to the byte compiler.
22 (funcall (compile (gensym "EVAL-TMPFUN-")
25 ;; SPEED=0,DEBUG=1 => byte-compile
26 (declare (optimize (speed 0) (debug 1)))
28 ;; Other than that, basically we care about
29 ;; compilation speed, compilation speed, and
30 ;; compilation speed. (There are cases where
31 ;; the user wants something else, but we don't
32 ;; know enough to guess that; and if he is
33 ;; unhappy about our guessed emphasis, he
34 ;; should explicitly compile his code, with
35 ;; explicit declarations to tell us what to
37 (declare (optimize (space 1) (safety 1)))
38 (declare (optimize (compilation-speed 3)))
42 ;;; Pick off a few easy cases, and the various top-level EVAL-WHEN
43 ;;; magical cases, and call %EVAL for the rest.
44 (defun eval (original-exp)
46 "Evaluate the argument in a null lexical environment, returning the
48 (declare (optimize (safety 1)))
49 (let ((exp (macroexpand original-exp)))
52 (ecase (info :variable :kind exp)
54 (values (info :variable :constant-value exp)))
57 ;; FIXME: This special case here is a symptom of non-ANSI
58 ;; weirdness in SBCL's ALIEN implementation, which could
59 ;; cause problems for e.g. code walkers. It'd probably be
60 ;; good to ANSIfy it by making alien variable accessors into
61 ;; ordinary forms, e.g. (SB-UNIX:ENV) and (SETF SB-UNIX:ENV),
62 ;; instead of magical symbols, e.g. plain SB-UNIX:ENV. Then
63 ;; if the old magical-symbol syntax is to be retained for
64 ;; compatibility, it can be implemented with
65 ;; DEFINE-SYMBOL-MACRO, keeping the code walkers happy.
67 (%eval original-exp))))
69 (let ((name (first exp))
70 (args (1- (length exp))))
74 (error "wrong number of args to FUNCTION:~% ~S" exp))
75 (let ((name (second exp)))
78 (eq (car name) 'setf)))
80 (%eval original-exp))))
83 (error "wrong number of args to QUOTE:~% ~S" exp))
87 (error "odd number of args to SETQ:~% ~S" exp))
89 (do ((name (cdr exp) (cddr name)))
91 (do ((args (cdr exp) (cddr args)))
93 ;; We duplicate the call to SET so that the
94 ;; correct value gets returned.
95 (set (first args) (eval (second args))))
96 (set (first args) (eval (second args)))))
97 (let ((symbol (first name)))
98 (case (info :variable :kind symbol)
99 ;; FIXME: I took out the *TOP-LEVEL-AUTO-DECLARE*
100 ;; test here, and removed the *TOP-LEVEL-AUTO-DECLARE*
101 ;; variable; the code should now act as though that
102 ;; variable is NIL. This should be tested..
104 (t (return (%eval original-exp))))))))
107 (dolist (x (butlast (rest exp)) (eval (car (last exp))))
111 (or (member 'eval (second exp))
112 (member :execute (second exp))))
114 (dolist (x (butlast (cddr exp)) (eval (car (last exp))))
116 (%eval original-exp)))
118 (if (and (symbolp name)
119 (eq (info :function :kind name) :function))
121 (dolist (arg (rest exp))
123 (apply (symbol-function name) (args)))
124 (%eval original-exp))))))
128 ;;; Given a function, return three values:
129 ;;; 1] A lambda expression that could be used to define the function,
130 ;;; or NIL if the definition isn't available.
131 ;;; 2] NIL if the function was definitely defined in a null lexical
132 ;;; environment, and T otherwise.
133 ;;; 3] Some object that \"names\" the function. Although this is
134 ;;; allowed to be any object, CMU CL always returns a valid
135 ;;; function name or a string.
137 ;;; If interpreted, use the interpreter interface. Otherwise, see
138 ;;; whether it was compiled with COMPILE. If that fails, check for an
139 ;;; inline expansion.
140 (defun function-lambda-expression (fun)
141 (declare (type function fun))
142 (let* ((fun (%function-self fun))
143 (name (%function-name fun))
144 (code (sb!di::function-code-header fun))
145 (info (sb!kernel:%code-debug-info code)))
147 (let ((source (first (sb!c::compiled-debug-info-source info))))
148 (cond ((and (eq (sb!c::debug-source-from source) :lisp)
149 (eq (sb!c::debug-source-info source) fun))
150 (values (second (svref (sb!c::debug-source-name source) 0))
155 (let ((exp (info :function :inline-expansion name)))
157 (values exp nil name)
158 (values nil t name))))))
159 (values nil t name))))
161 ;;; miscellaneous full function definitions of things which are
162 ;;; ordinarily handled magically by the compiler
164 (defun apply (function arg &rest arguments)
166 "Apply FUNCTION to a list of arguments produced by evaluating ARGUMENTS in
167 the manner of LIST*. That is, a list is made of the values of all but the
168 last argument, appended to the value of the last argument, which must be a
170 (cond ((atom arguments)
171 (apply function arg))
172 ((atom (cdr arguments))
173 (apply function (cons arg (car arguments))))
174 (t (do* ((a1 arguments a2)
175 (a2 (cdr arguments) (cdr a2)))
178 (apply function (cons arg arguments)))))))
180 (defun funcall (function &rest arguments)
182 "Call FUNCTION with the given ARGUMENTS."
183 (apply function arguments))
185 (defun values (&rest values)
187 "Return all arguments, in order, as values."
188 (values-list values))
190 (defun values-list (list)
192 "Return all of the elements of LIST, in order, as values."