From: William Harold Newman Date: Fri, 17 Aug 2001 15:10:47 +0000 (+0000) Subject: 0.pre7.14: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=31361af9eb64344f521abbb245ea784c76c746e5;p=sbcl.git 0.pre7.14: (Oops, I was wrong before -- I made a typo when I thought I was deleting :SB-INTERPRETER from target *FEATURES*, so I didn't test what I thought I tested, and 0.pre7.13 didn't actually work without :SB-INTERPRETER.) So, now to make things actually work without :SB-INTERPRETER.. ..saved a few things * CL:LAMBDA-PARAMETERS-LIMIT * CL:MULTIPLE-VALUES-LIMIT * CL:CALL-ARGUMENTS-LIMIT from src/compiler/eval.lisp in early-c.lisp ..SB!EVAL can't be conditional on :SB-INTERPRETER, since it's the home of stuff like the 'eval stack' (also used by the byte interpreter). ..made INTERPRETED-FUNCTION-NAME hacking conditional on :SB-INTERPRETER ..made other SB!EVAL:FOO stuff conditional on :SB-INTERPRETER ..s/#+!sb-show/#!+sb-show/ (Isn't it Perl that Lispers slam for accepting line noise as valid input?) ..raised make-target-2.sh *PRINT-LENGTH* and *PRINT-LEVEL* to 10 so that compilation aborted because of input error: #S(SB-C::INPUT-ERROR-IN-COMPILE-FILE :ACTUAL-INITARGS (ERROR #S(READER-ERROR :ACTUAL-INITARGS (STREAM # FORMAT-CONTROL no dispatch function defined for ~S FORMAT-ARGUMENTS ...) :ASSIGNED-SLOTS NIL)) :ASSIGNED-SLOTS NIL) would no longer have key information elided ..s/failed-aver-type/failed-enforce-type/ ..(This version still doesn't work without :SB-INTERPRETER, but it does have some progress, and at least it still works with :SB-INTERPRETER, so I'm checking it in.) --- diff --git a/make-target-2.sh b/make-target-2.sh index a819188..4431c60 100644 --- a/make-target-2.sh +++ b/make-target-2.sh @@ -32,8 +32,8 @@ echo //doing warm init (sb!int:/show "hello, world!") ;; Do warm init. - (let ((*print-length* 5) - (*print-level* 5)) + (let ((*print-length* 10) + (*print-level* 10)) (sb!int:/show "about to LOAD warm.lisp") (load "src/cold/warm.lisp")) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 074958c..0a621fb 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -474,14 +474,19 @@ like *STACK-TOP-HINT*" "ADD-OFFS-NOTE-HOOK" "ADD-OFFS-COMMENT-HOOK" "DSTATE-CUR-ADDR" "DSTATE-NEXT-ADDR")) - #!+sb-interpreter #s(sb-cold:package-data :name "SB!EVAL" - :doc "private: the implementation of the IR1 interpreter" + :doc "private: originally the implementation of the IR1 interpreter, +and now that the IR1 interpreter is gone, home to some stuff which is still +used by the bytecode interpreter" :use ("CL" "SB!KERNEL" "SB!INT") - :export (#!+sb-show "*EVAL-STACK-TRACE*" + :export #!-sb-interpreter + ("INTERNAL-EVAL") + #!+sb-interpreter + ("INTERNAL-EVAL" + #!+sb-show "*EVAL-STACK-TRACE*" #!+sb-show "*INTERNAL-APPLY-NODE-TRACE*" - "FLUSH-INTERPRETED-FUNCTION-CACHE" "INTERNAL-EVAL" + "FLUSH-INTERPRETED-FUNCTION-CACHE" "INTERPRETED-FUNCTION" "INTERPRETED-FUNCTION-ARGLIST" "INTERPRETED-FUNCTION-CLOSURE" diff --git a/src/code/byte-interp.lisp b/src/code/byte-interp.lisp index 2de7dfd..738f901 100644 --- a/src/code/byte-interp.lisp +++ b/src/code/byte-interp.lisp @@ -50,16 +50,13 @@ ((nil))) `(function ,(res) *)))))) -;;;; the evaluation stack +;;;; the 'evaluation stack' +;;;; +;;;; (The name dates back to CMU CL, when it was used for the IR1 +;;;; interpreted implementation of EVAL. In SBCL >=0.7.0, it's just +;;;; the byte interpreter stack.) -;;; the interpreter's evaluation stack (defvar *eval-stack* (make-array 100)) ; will grow as needed -;;; FIXME: This seems to be used by the ordinary (non-byte) interpreter -;;; too, judging from a crash I had when I removed byte-interp.lisp from -;;; the cold build sequence. It would probably be clearer to pull the -;;; shared interpreter machinery out of the byte interpreter and ordinary -;;; interpreter files and put them into their own file shared-interp.lisp -;;; or something. ;;; the index of the next free element of the interpreter's evaluation stack (defvar *eval-stack-top* 0) diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index d01cafd..c61ab78 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -967,6 +967,7 @@ ;;; to replace FRAME. The interpreted frame points to FRAME. (defun possibly-an-interpreted-frame (frame up-frame) (if (or (not frame) + #!+sb-interpreter (not (eq (debug-function-name (frame-debug-function frame)) 'sb!eval::internal-apply-loop)) *debugging-interpreter* @@ -1449,7 +1450,8 @@ (#.sb!vm:closure-header-type (function-debug-function (%closure-function fun))) (#.sb!vm:funcallable-instance-header-type - (cond ((sb!eval:interpreted-function-p fun) + (cond #!+sb-interpreter + ((sb!eval:interpreted-function-p fun) (make-interpreted-debug-function (or (sb!eval::interpreted-function-definition fun) (sb!eval::convert-interpreted-fun fun)))) @@ -2471,6 +2473,7 @@ (if (indirect-value-cell-p res) (sb!c:value-cell-ref res) res))) + #!+sb-interpreter (interpreted-debug-var (aver (typep frame 'interpreted-frame)) (sb!eval::leaf-value-lambda-var @@ -2814,6 +2817,7 @@ (if (indirect-value-cell-p current-value) (sb!c:value-cell-set current-value value) (set-compiled-debug-var-slot debug-var frame value)))) + #!+sb-interpreter (interpreted-debug-var (aver (typep frame 'interpreted-frame)) (sb!eval::set-leaf-value-lambda-var diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index ccc2c4b..6e8b838 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -184,7 +184,7 @@ ;;; ordinary function definition is only appropriate in the target Lisp. (defun sb!c::%defun (name def doc source) (declare (ignore source)) - (setf (sb!eval:interpreted-function-name def) name) + #!+sb-interpreter (setf (sb!eval:interpreted-function-name def) name) (ecase (info :function :where-from name) (:assumed (setf (info :function :where-from name) :defined) diff --git a/src/code/describe.lisp b/src/code/describe.lisp index 3b650bc..fc7bb94 100644 --- a/src/code/describe.lisp +++ b/src/code/describe.lisp @@ -135,6 +135,7 @@ ;;; Interpreted function describing; handles both closure and ;;; non-closure functions. Instead of printing the compiled-from info, ;;; we print the definition. +#+sb-interpreter (defun %describe-function-interpreted (x s kind name) (declare (type stream s)) (multiple-value-bind (exp closure-p dname) @@ -256,6 +257,7 @@ (let ((data (byte-closure-data x))) (dotimes (i (length data)) (format s "~@:_~S: ~S" i (svref data i)))))) + #+sb-interpreter (sb-eval:interpreted-function (%describe-function-interpreted x s kind name)) (standard-generic-function diff --git a/src/code/extensions.lisp b/src/code/extensions.lisp index cde7c9b..6d25386 100644 --- a/src/code/extensions.lisp +++ b/src/code/extensions.lisp @@ -638,7 +638,7 @@ (defmacro enforce-type (value type) (once-only ((value value)) `(unless (typep ,value ',type) - (%failed-aver-type ,value ',type)))) + (%failed-enforce-type ,value ',type)))) (defun %failed-enforce-type (value type) (error 'simple-type-error :value value diff --git a/src/code/float.lisp b/src/code/float.lisp index be2fc98..3af6c79 100644 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -19,9 +19,10 @@ (eval-when (:compile-toplevel :load-toplevel :execute) -;;; These functions let us create floats from bits with the significand -;;; uniformly represented as an integer. This is less efficient for double -;;; floats, but is more convenient when making special values, etc. +;;; These functions let us create floats from bits with the +;;; significand uniformly represented as an integer. This is less +;;; efficient for double floats, but is more convenient when making +;;; special values, etc. (defun single-from-bits (sign exp sig) (declare (type bit sign) (type (unsigned-byte 24) sig) (type (unsigned-byte 8) exp)) diff --git a/src/code/macros.lisp b/src/code/macros.lisp index d94900c..006459d 100644 --- a/src/code/macros.lisp +++ b/src/code/macros.lisp @@ -204,12 +204,10 @@ the usual naming convention (names like *FOO*) for special variables" ,body)))) `(sb!c::%define-compiler-macro ',name #',def ',lambda-list ,doc))))) (defun sb!c::%define-compiler-macro (name definition lambda-list doc) - ;; FIXME: Why does this have to be an interpreted function? Shouldn't - ;; it get compiled? - (aver (sb!eval:interpreted-function-p definition)) - (setf (sb!eval:interpreted-function-name definition) - (format nil "DEFINE-COMPILER-MACRO ~S" name)) - (setf (sb!eval:interpreted-function-arglist definition) lambda-list) + #!+sb-interpreter (setf (sb!eval:interpreted-function-name definition) + (format nil "DEFINE-COMPILER-MACRO ~S" name)) + #!+sb-interpreter (setf (sb!eval:interpreted-function-arglist definition) + lambda-list) (sb!c::%%define-compiler-macro name definition doc)) (defun sb!c::%%define-compiler-macro (name definition doc) (setf (sb!xc:compiler-macro-function name) definition) diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp index 56573c8..c1e5eeb 100644 --- a/src/code/ntrace.lisp +++ b/src/code/ntrace.lisp @@ -125,7 +125,8 @@ (values (fdefinition x) t)))) (function x) (t (values (fdefinition x) t))) - (if (sb-eval:interpreted-function-p res) + (if (or #+sb-interpreter (sb-eval:interpreted-function-p res) + nil) (values res named-p (if (sb-eval:interpreted-function-closure res) :interpreted-closure :interpreted)) (case (sb-kernel:get-type res) diff --git a/src/code/print.lisp b/src/code/print.lisp index ba9bb3b..da66712 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -1557,7 +1557,8 @@ #(#.sb!vm:closure-header-type #.sb!vm:byte-code-closure-type)) "CLOSURE") - ((sb!eval::interpreted-function-p object) + (#!+sb-interpreter + (sb!eval::interpreted-function-p object) (or (sb!eval::interpreted-function-%name object) (sb!eval:interpreted-function-lambda-expression object))) diff --git a/src/code/save.lisp b/src/code/save.lisp index 2fd6bd7..8b3f62a 100644 --- a/src/code/save.lisp +++ b/src/code/save.lisp @@ -64,6 +64,7 @@ saved core is loaded." #!+mp (sb!mp::shutdown-multi-processing) + #!+sb-interpreter (when (fboundp 'sb!eval:flush-interpreted-function-cache) (sb!eval:flush-interpreted-function-cache)) ;; FIXME: What is this for? Explain. diff --git a/src/code/target-eval.lisp b/src/code/target-eval.lisp index 00a0200..acb2ed5 100644 --- a/src/code/target-eval.lisp +++ b/src/code/target-eval.lisp @@ -63,11 +63,10 @@ ;;;; anyway). In that environment, a stub no-op version of this ;;;; function is used. (defun try-to-rename-interpreted-function-as-macro (f name lambda-list) - (aver (sb!eval:interpreted-function-p f)) - (setf (sb!eval:interpreted-function-name f) - (format nil "DEFMACRO ~S" name) - (sb!eval:interpreted-function-arglist f) - lambda-list) + #!+sb-interpreter (setf (sb!eval:interpreted-function-name f) + (format nil "DEFMACRO ~S" name) + (sb!eval:interpreted-function-arglist f) + lambda-list) (values)) ;;;; EVAL and friends @@ -107,7 +106,10 @@ (and (consp name) (eq (car name) 'setf))) (fdefinition name) - (sb!eval:make-interpreted-function name)))) + #!+sb-interpreter + (sb!eval:make-interpreted-function name) + #!-sb-interpreter + (sb!eval:internal-eval original-exp)))) (quote (unless (= args 1) (error "wrong number of args to QUOTE:~% ~S" exp)) @@ -150,6 +152,9 @@ (collect ((args)) (dolist (arg (rest exp)) (args (eval arg))) + #!-sb-interpreter + (apply (symbol-function name) (args)) + #!+sb-interpreter (if sb!eval::*already-evaled-this* (let ((sb!eval::*already-evaled-this* nil)) (apply (symbol-function name) (args))) @@ -192,26 +197,28 @@ ;;; inline expansion. (defun function-lambda-expression (fun) (declare (type function fun)) - (if (sb!eval:interpreted-function-p fun) - (sb!eval:interpreted-function-lambda-expression fun) - (let* ((fun (%function-self fun)) - (name (%function-name fun)) - (code (sb!di::function-code-header fun)) - (info (sb!kernel:%code-debug-info code))) - (if info - (let ((source (first (sb!c::compiled-debug-info-source info)))) - (cond ((and (eq (sb!c::debug-source-from source) :lisp) - (eq (sb!c::debug-source-info source) fun)) - (values (second (svref (sb!c::debug-source-name source) 0)) - nil name)) - ((stringp name) - (values nil t name)) - (t - (let ((exp (info :function :inline-expansion name))) - (if exp - (values exp nil name) - (values nil t name)))))) - (values nil t name))))) + (cond #!+sb-interpreter + ((sb!eval:interpreted-function-p fun) + (sb!eval:interpreted-function-lambda-expression fun)) + (t + (let* ((fun (%function-self fun)) + (name (%function-name fun)) + (code (sb!di::function-code-header fun)) + (info (sb!kernel:%code-debug-info code))) + (if info + (let ((source (first (sb!c::compiled-debug-info-source info)))) + (cond ((and (eq (sb!c::debug-source-from source) :lisp) + (eq (sb!c::debug-source-info source) fun)) + (values (second (svref (sb!c::debug-source-name source) 0)) + nil name)) + ((stringp name) + (values nil t name)) + (t + (let ((exp (info :function :inline-expansion name))) + (if exp + (values exp nil name) + (values nil t name)))))) + (values nil t name)))))) ;;; Like FIND-IF, only we do it on a compiled closure's environment. (defun find-if-in-closure (test fun) diff --git a/src/code/target-misc.lisp b/src/code/target-misc.lisp index 20ea613..66d24e8 100644 --- a/src/code/target-misc.lisp +++ b/src/code/target-misc.lisp @@ -28,6 +28,7 @@ (sb!c::byte-function-name x)) (byte-closure (sb!c::byte-function-name (byte-closure-function x))) + #!+sb-interpreter (sb!eval:interpreted-function (multiple-value-bind (exp closure-p dname) (sb!eval:interpreted-function-lambda-expression x) diff --git a/src/code/target-type.lisp b/src/code/target-type.lisp index 0a9e068..91757e6 100644 --- a/src/code/target-type.lisp +++ b/src/code/target-type.lisp @@ -128,13 +128,15 @@ ;;; Pull the type specifier out of a function object. (defun extract-function-type (fun) - (if (sb!eval:interpreted-function-p fun) - (sb!eval:interpreted-function-type fun) - (typecase fun - (byte-function (byte-function-type fun)) - (byte-closure (byte-function-type (byte-closure-function fun))) + (cond #!+sb-interpreter + ((sb!eval:interpreted-function-p fun) + (sb!eval:interpreted-function-type fun)) (t - (specifier-type (%function-type (%closure-function fun))))))) + (typecase fun + (byte-function (byte-function-type fun)) + (byte-closure (byte-function-type (byte-closure-function fun))) + (t + (specifier-type (%function-type (%closure-function fun)))))))) ;;;; miscellaneous interfaces diff --git a/src/code/time.lisp b/src/code/time.lisp index e0d001f..4781333 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -240,6 +240,7 @@ ;;; Try to compile the closure arg to %TIME if it is interpreted. (defun massage-time-function (fun) (cond + #!+sb-interpreter ((sb!eval:interpreted-function-p fun) (multiple-value-bind (def env-p) (function-lambda-expression fun) (declare (ignore def)) diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp index c748a0c..0ff7820 100644 --- a/src/compiler/early-c.lisp +++ b/src/compiler/early-c.lisp @@ -15,6 +15,21 @@ (in-package "SB!C") +;;; ANSI limits on compilation +(defconstant sb!xc:call-arguments-limit most-positive-fixnum + #!+sb-doc + "The exclusive upper bound on the number of arguments which may be passed + to a function, including &REST args.") +(defconstant sb!xc:lambda-parameters-limit most-positive-fixnum + #!+sb-doc + "The exclusive upper bound on the number of parameters which may be specifed + in a given lambda list. This is actually the limit on required and &OPTIONAL + parameters. With &KEY and &AUX you can get more.") +(defconstant sb!xc:multiple-values-limit most-positive-fixnum + #!+sb-doc + "The exclusive upper bound on the number of multiple VALUES that you can + return.") + ;;; FIXME: Shouldn't SB!C::&MORE be in this list? (defconstant-eqx sb!xc:lambda-list-keywords '(&optional &rest &key &aux &body &whole &allow-other-keys &environment) diff --git a/src/compiler/eval.lisp b/src/compiler/eval.lisp index d3ab8b9..e932367 100644 --- a/src/compiler/eval.lisp +++ b/src/compiler/eval.lisp @@ -32,9 +32,11 @@ ;;; The list of INTERPRETED-FUNCTIONS that have translated definitions. (defvar *interpreted-function-cache* nil) (declaim (type list *interpreted-function-cache*)) + +;;;; eval stack stuff ;;; Setting this causes the stack operations to dump a trace. -#+!sb-show +#!+sb-show (defvar *eval-stack-trace* nil) ;;; Push value on *EVAL-STACK*, growing the stack if necessary. This @@ -47,13 +49,13 @@ (defun eval-stack-push (value) (let ((len (length (the simple-vector *eval-stack*)))) (when (= len *eval-stack-top*) - #+!sb-show (when *eval-stack-trace* + #!+sb-show (when *eval-stack-trace* (format t "[PUSH: growing stack.]~%")) (let ((new-stack (make-array (ash len 1)))) (replace new-stack *eval-stack* :end1 len :end2 len) (setf *eval-stack* new-stack)))) (let ((top *eval-stack-top*)) - #+!sb-show (when *eval-stack-trace* (format t "pushing ~D.~%" top)) + #!+sb-show (when *eval-stack-trace* (format t "pushing ~D.~%" top)) (incf *eval-stack-top*) (setf (svref *eval-stack* top) value))) @@ -69,7 +71,7 @@ (error "attempt to pop empty eval stack")) (let* ((new-top (1- *eval-stack-top*)) (value (svref *eval-stack* new-top))) - #+!sb-show (when *eval-stack-trace* + #!+sb-show (when *eval-stack-trace* (format t "popping ~D --> ~S.~%" new-top value)) (setf *eval-stack-top* new-top) value)) @@ -81,13 +83,13 @@ (defun eval-stack-extend (n) (let ((len (length (the simple-vector *eval-stack*)))) (when (> (+ n *eval-stack-top*) len) - #+!sb-show (when *eval-stack-trace* + #!+sb-show (when *eval-stack-trace* (format t "[EXTEND: growing stack.]~%")) (let ((new-stack (make-array (+ n (ash len 1))))) (replace new-stack *eval-stack* :end1 len :end2 len) (setf *eval-stack* new-stack)))) (let ((new-top (+ *eval-stack-top* n))) - #+!sb-show (when *eval-stack-trace* + #!+sb-show (when *eval-stack-trace* (format t "extending to ~D.~%" new-top)) (do ((i *eval-stack-top* (1+ i))) ((= i new-top)) @@ -96,13 +98,13 @@ ;;; the antithesis of EVAL-STACK-EXTEND (defun eval-stack-shrink (n) - #+!sb-show (when *eval-stack-trace* + #!+sb-show (when *eval-stack-trace* (format t "shrinking to ~D.~%" (- *eval-stack-top* n))) (decf *eval-stack-top* n)) ;;; This is used to shrink the stack back to a previous frame pointer. (defun eval-stack-reset-top (ptr) - #+!sb-show (when *eval-stack-trace* + #!+sb-show (when *eval-stack-trace* (format t "setting top to ~D.~%" ptr)) (setf *eval-stack-top* ptr)) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 4e1bd73..6c6cbe7 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -2035,7 +2035,8 @@ deprecated-names))) (let* ((do-eval (and (intersection '(compile :compile-toplevel) situations) - (not sb!eval::*already-evaled-this*))) + #!+sb-interpreter (not sb!eval::*already-evaled-this*))) + #!+sb-interpreter (sb!eval::*already-evaled-this* t)) (when do-eval diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index c1b15cb..611992e 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -13,20 +13,6 @@ (in-package "SB!C") -(defconstant sb!xc:call-arguments-limit most-positive-fixnum - #!+sb-doc - "The exclusive upper bound on the number of arguments which may be passed - to a function, including &REST args.") -(defconstant sb!xc:lambda-parameters-limit most-positive-fixnum - #!+sb-doc - "The exclusive upper bound on the number of parameters which may be specifed - in a given lambda list. This is actually the limit on required and &OPTIONAL - parameters. With &KEY and &AUX you can get more.") -(defconstant sb!xc:multiple-values-limit most-positive-fixnum - #!+sb-doc - "The exclusive upper bound on the number of multiple VALUES that you can - return.") - ;;; FIXME: Doesn't this belong somewhere else, like early-c.lisp? (declaim (special *constants* *free-variables* *component-being-compiled* *code-vector* *next-location* *result-fixups* diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp index 8f30618..1473562 100644 --- a/src/compiler/target-disassem.lisp +++ b/src/compiler/target-disassem.lisp @@ -1521,6 +1521,7 @@ (and (listp thing) (eq (car thing) 'setf))) (compiled-function-or-lose (fdefinition thing) thing)) + #!+sb-interpreter ((sb!eval:interpreted-function-p thing) (compile-function-lambda-expr thing)) ((functionp thing) diff --git a/src/pcl/early-low.lisp b/src/pcl/early-low.lisp index 4c470cc..40cdf1d 100644 --- a/src/pcl/early-low.lisp +++ b/src/pcl/early-low.lisp @@ -37,8 +37,8 @@ ;;; could be made less viciously brittle when SB-FLUID.) ;;; (Or perhaps just define a macro ;;; (DEFMACRO PKG (NAME) -;;; #!-SB-FLUID (FIND-PACKAGE NAME) -;;; #!+SB-FLUID `(FIND-PACKAGE ,NAME)) +;;; #-SB-FLUID (FIND-PACKAGE NAME) +;;; #+SB-FLUID `(FIND-PACKAGE ,NAME)) ;;; and use that to replace all three variables.) (defvar *pcl-package* (find-package "SB-PCL")) (defvar *slot-accessor-name-package* (find-package "SB-SLOT-ACCESSOR-NAME")) diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp index 98174f3..e825431 100644 --- a/src/pcl/low.lisp +++ b/src/pcl/low.lisp @@ -156,6 +156,10 @@ ;;; In all cases, SET-FUNCTION-NAME must return the new (or same) ;;; function. (Unlike other functions to set stuff, it does not return ;;; the new value.) +;;; +;;; FIXME: A similar operation is done in +;;; TRY-TO-RENAME-INTERPRETED-FUNCTION-AS-MACRO. The code should be +;;; shared. (defun set-function-name (fcn new-name) #+sb-doc "Set the name of a compiled function object. Return the function." @@ -167,12 +171,13 @@ (typep fcn 'generic-function) (eq (class-of fcn) *the-class-standard-generic-function*)) (setf (sb-kernel:%funcallable-instance-info fcn 1) new-name) - (typecase fcn + (etypecase fcn (sb-kernel:byte-closure (set-function-name (sb-kernel:byte-closure-function fcn) new-name)) (sb-kernel:byte-function (setf (sb-kernel:byte-function-name fcn) new-name)) + #+sb-interpreter (sb-eval:interpreted-function (setf (sb-eval:interpreted-function-name fcn) new-name)))) fcn) diff --git a/version.lisp-expr b/version.lisp-expr index 62be2c1..7a577e7 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -16,4 +16,4 @@ ;;; four numeric fields, is used for versions which aren't released ;;; but correspond only to CVS tags or snapshots. -"0.pre7.13" +"0.pre7.14"