From e5c6851b27db85c3c4a464650322bd964786c90f Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Wed, 7 Feb 1990 14:49:20 +0000 Subject: [PATCH] Changed LEAF-VALUE to make a cached EVAL-FUNCTION when the lexical environment is null. Although we don't get lazy conversion, at least we can prevent excessive memory usage. Also, this result is cached in the new LAMBDA-EVAL-INFO-FUNCTION slot so that all references to a non-closure interpreted function will get the same EQ result (mainly to avoid having N copies of the IR1 if the conversion is decached and then reconverted.) --- compiler/eval.lisp | 45 +++++++++++++++++++++++++++++++-------------- 1 file changed, 31 insertions(+), 14 deletions(-) diff --git a/compiler/eval.lisp b/compiler/eval.lisp index ced81e0be..fe4e16379 100644 --- a/compiler/eval.lisp +++ b/compiler/eval.lisp @@ -927,7 +927,11 @@ ;;; that calls INTERNAL-APPLY, closing over the leaf. We also ;;; have to compute a closure, running environment, for the ;;; lambda in case it references stuff in the current -;;; environment. +;;; environment. If the closure is empty and there is no +;;; functional environment, then we use +;;; MAKE-INTERPRETED-FUNCTION to make a cached translation. +;;; Since it is too late to lazily convert, we set up the +;;; EVAL-FUNCTION to be already converted. ;;; (defun leaf-value (node frame-ptr closure) (let ((leaf (c::ref-leaf node))) @@ -954,19 +958,32 @@ (indirect-value temp) temp))) (c::functional - (let ((calling-closure (compute-closure node leaf frame-ptr closure)) - (eval-fun (make-eval-function - :definition leaf - :name (c::leaf-name leaf) - :arglist (c::functional-arg-documentation - (c::functional-entry-function leaf))))) - ;; Make interpreter IR1 thing be a real function that you can - ;; call anytime, anywhere. - #'(lambda (&rest args) - (declare (list args)) - (internal-apply (eval-function-definition eval-fun) - (cons (length args) args) - calling-closure))))))) + (let* ((calling-closure (compute-closure node leaf frame-ptr closure)) + (real-fun (c::functional-entry-function leaf)) + (arg-doc (c::functional-arg-documentation real-fun))) + (cond ((c:lambda-eval-info-function (c::leaf-info leaf))) + ((and (zerop (length closure)) + (null (c::functional-fenv real-fun))) + (let* ((res (make-interpreted-function + (c::functional-inline-expansion real-fun))) + (eval-fun (get-eval-function res))) + (push eval-fun *interpreted-function-cache*) + (setf (eval-function-definition eval-fun) leaf) + (setf (eval-function-converted-once eval-fun) t) + (setf (eval-function-arglist eval-fun) arg-doc) + (setf (eval-function-name eval-fun) (c::leaf-name real-fun)) + (setf (c:lambda-eval-info-function (c::leaf-info leaf)) res) + res)) + (t + (let ((eval-fun (make-eval-function + :definition leaf + :name (c::leaf-name real-fun) + :arglist arg-doc))) + #'(lambda (&rest args) + (declare (list args)) + (internal-apply (eval-function-definition eval-fun) + (cons (length args) args) + calling-closure)))))))))) ;;; COMPUTE-CLOSURE -- Internal. -- GitLab