From: William Harold Newman Date: Mon, 27 Aug 2001 17:19:25 +0000 (+0000) Subject: 0.pre7.18: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=35edf441c6cd64127bdd96180e47b2d21e13edbd;p=sbcl.git 0.pre7.18: 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 --- diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 850e770..b47b182 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -483,8 +483,8 @@ like *STACK-TOP-HINT*" #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" @@ -1463,7 +1463,9 @@ definitely not guaranteed to be present in later versions of SBCL." 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 @@ -1487,7 +1489,7 @@ and even SB-VM seem to have become somewhat blurred over the years." "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" diff --git a/src/code/eval.lisp b/src/code/eval.lisp index cd5b0df..23af789 100644 --- a/src/code/eval.lisp +++ b/src/code/eval.lisp @@ -1,3 +1,5 @@ +;;;; EVAL and friends + ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. ;;;; @@ -9,57 +11,13 @@ (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))) - -;;; 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 () @@ -80,10 +38,8 @@ ,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 @@ -97,8 +53,17 @@ (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)))) @@ -111,7 +76,7 @@ (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)) @@ -135,7 +100,7 @@ ;; 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)))) @@ -147,7 +112,7 @@ (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)) @@ -155,7 +120,7 @@ (dolist (arg (rest exp)) (args (eval arg))) (apply (symbol-function name) (args))) - (sb!bytecode:internal-eval original-exp)))))) + (%eval original-exp)))))) (t exp)))) @@ -191,14 +156,6 @@ (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))))) ;;; miscellaneous full function definitions of things which are ;;; ordinarily handled magically by the compiler diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp index 607b8bb..7b627ef 100644 --- a/src/code/fdefinition.lisp +++ b/src/code/fdefinition.lisp @@ -180,34 +180,42 @@ ;; 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) diff --git a/stems-and-flags.lisp-expr b/stems-and-flags.lisp-expr index 2bf3a28..453ad3c 100644 --- a/stems-and-flags.lisp-expr +++ b/stems-and-flags.lisp-expr @@ -246,8 +246,6 @@ ("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 @@ -557,19 +555,20 @@ ;; (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 diff --git a/version.lisp-expr b/version.lisp-expr index 3395e40..33dbe70 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -14,7 +14,7 @@ ;;; 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"