miscellaneous post-IR1-interpreter cleanup..
..put all of eval.lisp into the SB-BYTECODE package
..made SB-BYTECODE package use SB-EXT, as other packages do
..deleted INTERPRETED-FUNCTION stuff
..renamed INTERNAL-EVAL (external) to %EVAL (internal)
..moved eval.lisp after globaldb.lisp in
stems-and-flags.lisp-expr, so that it can use the
compiler macro form of INFO instead of full call
..moved FIND-IF-IN-CLOSURE from SB!SYS (which is supposed to
be system-dependent stuff) into SB!KERNEL; and then
made it a private function, since it's only used in
one place anyway
#s(sb-cold:package-data
:name "SB!BYTECODE"
:doc "private: stuff related to the bytecode interpreter"
- :use ("CL" "SB!KERNEL" "SB!INT")
- :export ("INTERNAL-EVAL"))
+ :use ("CL" "SB!EXT" "SB!INT" "SB!KERNEL")
+ :export ())
#s(sb-cold:package-data
:name "SB!EXT"
necessary for system interfacing\" (said cmu-user.tex at the time
of the SBCL code fork). That probably was and is a good idea, but in
practice, the distinctions between this package and SB-KERNEL
-and even SB-VM seem to have become somewhat blurred over the years."
+and even SB-VM seem to have become somewhat blurred over the years.
+Some anomalies (e.g. FIND-IF-IN-CLOSURE being in SB-SYS instead of
+SB-KERNEL) have been undone, but probably more remain."
:use ("CL" "SB!EXT" "SB!INT")
:export ("%ASSEMBLER-CODE-TYPE" "%BIND-ALIGNED-SAP"
;; FIXME: %PRIMITIVE shouldn't be here. (I now know that %SYS
"DO-DO-BODY" "DOUBLE-FLOAT-RADIX"
"ENABLE-INTERRUPT" "ENUMERATION"
"FD-STREAM" "FD-STREAM-FD"
- "FD-STREAM-P" "FIND-IF-IN-CLOSURE"
+ "FD-STREAM-P"
"FOREIGN-SYMBOL-ADDRESS" "FOREIGN-SYMBOL-ADDRESS-AS-INTEGER"
"GET-PAGE-SIZE" "GET-SYSTEM-INFO"
"IGNORE-INTERRUPT"
+;;;; EVAL and friends
+
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
(in-package "SB!BYTECODE")
-;;; This is defined here so that the printer etc. can call
-;;; INTERPRETED-FUNCTION-P before the full interpreter is loaded.
-
-;;; an interpreted function
-(defstruct (interpreted-function
- (:alternate-metaclass sb!kernel:funcallable-instance
- sb!kernel:funcallable-structure-class
- sb!kernel:make-funcallable-structure-class)
- (:type sb!kernel:funcallable-structure)
- (:constructor %make-interpreted-function)
- (:copier nil)
- ;; FIXME: Binding PRINT-OBJECT isn't going to help unless
- ;; we fix the print-a-funcallable-instance code so that
- ;; it calls PRINT-OBJECT in this case.
- (:print-object
- (lambda (x stream)
- (print-unreadable-object (x stream :identity t)
- (interpreted-function-%name x)))))
- ;; The name of this interpreted function, or NIL if none specified.
- (%name nil)
- ;; This function's debug arglist.
- (arglist nil)
- ;; A lambda that can be converted to get the definition.
- (lambda nil)
- ;; If this function has been converted, then this is the XEP. If this is
- ;; false, then the function is not in the cache (or is in the process of
- ;; being removed.)
- (definition nil :type (or sb!c::clambda null))
- ;; The number of consecutive GCs that this function has been unused.
- ;; This is used to control cache replacement.
- (gcs 0 :type sb!c::index)
- ;; True if Lambda has been converted at least once, and thus warnings should
- ;; be suppressed on additional conversions.
- (converted-once nil)
- ;; For a closure, the closure date vector.
- (closure nil :type (or null simple-vector)))
-\f
-;;; FIXME: Could we make this extra IN-PACKAGE go away, so that all
-;;; this bytecode interpreter implementation stuff was in the
-;;; SB!BYTECODE package?
-(in-package "SB!IMPL")
-
-;;;; EVAL and friends
-
;;; This needs to be initialized in the cold load, since the top-level
;;; catcher will always restore the initial value.
(defvar *eval-stack-top* 0)
;;; general case of EVAL (except in that it can't handle toplevel
;;; EVAL-WHEN magic properly): Delegate to the byte compiler.
-(defun sb!bytecode:internal-eval (expr)
+(defun %eval (expr)
(funcall (compile (gensym "EVAL-TMPFUN-")
`(lambda ()
,expr))))
-;;; Pick off a few easy cases, and call INTERNAL-EVAL for the rest. If
-;;; *ALREADY-EVALED-THIS* is true, then we bind it to NIL before doing
-;;; a call so that the effect is confined to the lexical scope of the
-;;; EVAL-WHEN.
+;;; Pick off a few easy cases, and the various top-level EVAL-WHEN
+;;; magical cases, and call %EVAL for the rest.
(defun eval (original-exp)
#!+sb-doc
"Evaluate the argument in a null lexical environment, returning the
(values (info :variable :constant-value exp)))
((:special :global)
(symbol-value exp))
+ ;; FIXME: This special case here is a symptom of non-ANSI
+ ;; weirdness in SBCL's ALIEN implementation, which could
+ ;; cause problems for e.g. code walkers. It'd probably be
+ ;; good to ANSIfy it by making alien variable accessors into
+ ;; ordinary forms, e.g. (SB-UNIX:ENV) and (SETF SB-UNIX:ENV),
+ ;; instead of magical symbols, e.g. plain SB-UNIX:ENV. Then
+ ;; if the old magical-symbol syntax is to be retained for
+ ;; compatibility, it can be implemented with
+ ;; DEFINE-SYMBOL-MACRO, keeping the code walkers happy.
(:alien
- (sb!bytecode:internal-eval original-exp))))
+ (%eval original-exp))))
(list
(let ((name (first exp))
(args (1- (length exp))))
(and (consp name)
(eq (car name) 'setf)))
(fdefinition name)
- (sb!bytecode:internal-eval original-exp))))
+ (%eval original-exp))))
(quote
(unless (= args 1)
(error "wrong number of args to QUOTE:~% ~S" exp))
;; variable; the code should now act as though that
;; variable is NIL. This should be tested..
(:special)
- (t (return (sb!bytecode:internal-eval original-exp))))))))
+ (t (return (%eval original-exp))))))))
((progn)
(when (> args 0)
(dolist (x (butlast (rest exp)) (eval (car (last exp))))
(when (> args 1)
(dolist (x (butlast (cddr exp)) (eval (car (last exp))))
(eval x)))
- (sb!bytecode:internal-eval original-exp)))
+ (%eval original-exp)))
(t
(if (and (symbolp name)
(eq (info :function :kind name) :function))
(dolist (arg (rest exp))
(args (eval arg)))
(apply (symbol-function name) (args)))
- (sb!bytecode:internal-eval original-exp))))))
+ (%eval original-exp))))))
(t
exp))))
(values exp nil name)
(values nil t name))))))
(values nil t name))))
-
-;;; This is like FIND-IF, except that we do it on a compiled closure's
-;;; environment.
-(defun find-if-in-closure (test fun)
- (dotimes (index (1- (get-closure-length fun)))
- (let ((elt (%closure-index-ref fun index)))
- (when (funcall test elt)
- (return elt)))))
\f
;;; miscellaneous full function definitions of things which are
;;; ordinarily handled magically by the compiler
;; replaced by an encapsulation of type TYPE.
(definition nil :type function))
-;;; We must bind and close over info. Consider the case where we
-;;; encapsulate (the second) an encapsulated (the first) definition,
-;;; and later someone unencapsulates the encapsulated (first)
-;;; definition. We don't want our encapsulation (second) to bind
-;;; basic-definition to the encapsulated (first) definition when it no
-;;; longer exists. When unencapsulating, we make sure to clobber the
-;;; appropriate info structure to allow basic-definition to be bound
-;;; to the next definition instead of an encapsulation that no longer
-;;; exists.
+;;; Replace the definition of NAME with a function that binds NAME's
+;;; arguments a variable named argument-list, binds name's definition
+;;; to a variable named basic-definition, and evaluates BODY in that
+;;; context. TYPE is whatever you would like to associate with this
+;;; encapsulation for identification in case you need multiple
+;;; encapsulations of the same name.
(defun encapsulate (name type body)
- #!+sb-doc
- "Replaces the definition of NAME with a function that binds name's arguments
- a variable named argument-list, binds name's definition to a variable named
- basic-definition, and evaluates BODY in that context. TYPE is
- whatever you would like to associate with this encapsulation for
- identification in case you need multiple encapsuations of the same name."
(let ((fdefn (fdefinition-object name nil)))
(unless (and fdefn (fdefn-function fdefn))
(error 'undefined-function :name name))
+ ;; We must bind and close over INFO. Consider the case where we
+ ;; encapsulate (the second) an encapsulated (the first)
+ ;; definition, and later someone unencapsulates the encapsulated
+ ;; (first) definition. We don't want our encapsulation (second) to
+ ;; bind basic-definition to the encapsulated (first) definition
+ ;; when it no longer exists. When unencapsulating, we make sure to
+ ;; clobber the appropriate INFO structure to allow
+ ;; basic-definition to be bound to the next definition instead of
+ ;; an encapsulation that no longer exists.
(let ((info (make-encapsulation-info type (fdefn-function fdefn))))
(setf (fdefn-function fdefn)
- #'(lambda (&rest argument-list)
- (declare (special argument-list))
- (let ((basic-definition (encapsulation-info-definition info)))
- (declare (special basic-definition))
- (eval body)))))))
+ (lambda (&rest argument-list)
+ (declare (special argument-list))
+ (let ((basic-definition (encapsulation-info-definition info)))
+ (declare (special basic-definition))
+ (eval body)))))))
+
+;;; This is like FIND-IF, except that we do it on a compiled closure's
+;;; environment.
+(defun find-if-in-closure (test fun)
+ (dotimes (index (1- (get-closure-length fun)))
+ (let ((elt (%closure-index-ref fun index)))
+ (when (funcall test elt)
+ (return elt)))))
-;;; Finds the encapsulation info that has been closed over.
+;;; Find the encapsulation info that has been closed over.
(defun encapsulation-info (fun)
(and (functionp fun)
(= (get-type fun) sb!vm:closure-header-type)
("src/code/module" :not-host) ; maybe should be :BYTE-COMPILE T
- ("src/code/eval" :not-host) ; FIXME: uses INFO, wants compiler macro
-
("src/code/interr" :not-host)
("src/code/query" :not-host) ; maybe should be :BYTE-COMPILE T
;; (directly or indirectly) on stuff compiled as part of the compiler
("src/compiler/generic/target-core" :not-host) ; uses stuff from
- ; "compiler/generic/core"
+ ; "compiler/generic/core"
+ ("src/code/eval" :not-host) ; uses INFO, wants compiler macro
("src/code/target-sap" :not-host) ; uses SAP-INT-TYPE
("src/code/target-package" :not-host) ; needs "code/package"
("src/code/target-random" :not-host) ; needs "code/random"
("src/code/target-hash-table" :not-host) ; needs "code/hash-table"
("src/code/reader" :not-host) ; needs "code/readtable"
("src/code/target-pathname" :not-host) ; needs "code/pathname", maybe
- ; should be :BYTE-COMPILE T
+ ; should be :BYTE-COMPILE T
("src/code/filesys" :not-host) ; needs HOST from "code/pathname",
- ; maybe should be :BYTE-COMPILE T
+ ; maybe should be :BYTE-COMPILE T
("src/code/save" :not-host) ; uses the definition of PATHNAME
- ; from "code/pathname"
+ ; from "code/pathname"
("src/code/sharpm" :not-host) ; uses stuff from "code/reader"
;; stuff for byte compilation
;;; Conventionally a string like "0.6.6", with three numeric fields,
;;; is used for released versions, and a string like "0.6.5.12", with
;;; four numeric fields, is used for versions which aren't released
-;;; but correspond only to CVS tags or snapshots. (And occasionally for
-;;; internal versions I end up with more complicated stuff, like
-;;; "0.pre7.14.flaky4.13".)
-"0.pre7.16"
+;;; but correspond only to CVS tags or snapshots. (And occasionally
+;;; for internal versions, especially for internal versions off the
+;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
+"0.pre7.18"
projects / sbcl.git / commitdiff