From 43768aadc8444cdbc6e113d0b8affb7b81e98919 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Fri, 9 Feb 1990 11:47:49 +0000
Subject: [PATCH] Changed the interpreted function caching policy so that any
 function used more than *INTERPRETED-FUNCTION-CACHE-THRESHOLD* times since
 the last GC is retained.

---
 compiler/eval.lisp | 65 +++++++++++++++++++++++++---------------------
 1 file changed, 36 insertions(+), 29 deletions(-)

diff --git a/compiler/eval.lisp b/compiler/eval.lisp
index 8ce02db68..3f575dde7 100644
--- a/compiler/eval.lisp
+++ b/compiler/eval.lisp
@@ -15,7 +15,8 @@
 (in-package "EVAL")
 
 (export '(internal-eval *eval-stack-trace* *internal-apply-node-trace*
-			*interpreted-function-cache-size*
+			*interpreted-function-cache-minimum-size*
+			*interpreted-function-cache-threshold*
 			trace-eval interpreted-function-p
 			interpreted-function-lambda-expression
 			interpreted-function-closure
@@ -147,28 +148,33 @@
   ;; being removed.)
   (definition nil :type (or c::clambda null))
   ;;
-  ;; Timestamp for the last time this function was called.
-  (timestamp 0 :type c::index)
+  ;; Number of times this function was called since the last GC.
+  (count 0 :type c::index)
   ;;
   ;; True if Lambda has been converted at least once, and thus warnings should
   ;; be suppressed on additional conversions.
   (converted-once nil))
 
 
-(defvar *interpreted-function-cache-size* 25
-  "This many most-recently-used interpreted functions are retained across GC.
-  Any other functions must be reconverted as needed.")
+(defvar *interpreted-function-cache-minimum-size* 25
+  "If the interpreted function cache has more functions than this come GC time,
+  then attempt to prune it according to
+  *INTERPRETED-FUNCTION-CACHE-THRESHOLD*.")
+
+(defvar *interpreted-function-cache-threshold* 2
+  "If an interpreted function has been called fewer than this number of times
+  since the last GC, then it is eligible for flushing from the cache.")
+
+(proclaim '(type c::index
+		 *interpreted-function-cache-minimum-size*
+		 *interpreted-function-cache-threshold*))
+
 
 ;;; The list of EVAL-FUNCTIONS that have translated definitions.
 ;;;
 (defvar *interpreted-function-cache* nil)
 (proclaim '(type list *interpreted-function-cache*))
 
-;;; Timer used to create timestamps to determine the most recently used
-;;; interpreted functions.
-;;; 
-(defvar *interpreted-function-cache-tick* 0)
-
 
 ;;; MAKE-INTERPRETED-FUNCTION  --  Interface
 ;;;
@@ -180,11 +186,11 @@
     #'(lambda (&rest args)
 	(let ((fun (eval-function-definition eval-fun))
 	      (args (cons (length args) args)))
-	  (setf (eval-function-timestamp eval-fun)
-		(incf *interpreted-function-cache-tick*))
+	  (incf (eval-function-count eval-fun))
 	  (internal-apply (or fun (convert-eval-fun eval-fun))
 			  args '#())))))
 
+
 ;;; GET-EVAL-FUNCTION  --  Internal
 ;;;
 (defun get-eval-function (x)
@@ -192,13 +198,13 @@
     (assert res)
     res))
 
+
 ;;; CONVERT-EVAL-FUN  --  Internal
 ;;;
 ;;;    Eval a FUNCTION form, grab the definition and stick it in.
 ;;;
 (defun convert-eval-fun (eval-fun)
   (declare (type eval-function eval-fun))
-  (push eval-fun *interpreted-function-cache*)
   (let* ((new (eval-function-definition
 	       (get-eval-function
 		(internal-eval `#',(eval-function-lambda eval-fun)
@@ -206,6 +212,7 @@
 				     eval-fun)))))))
     (setf (eval-function-definition eval-fun) new)
     (setf (eval-function-converted-once eval-fun) t)
+    (push eval-fun *interpreted-function-cache*)
     new))
 
 
@@ -275,21 +282,21 @@
 	((= i len))
       (setf (svref *eval-stack* i) nil)))
 
-  (setq *interpreted-function-cache*
-	(sort *interpreted-function-cache*
-	      #'(lambda (x y)
-		  (> (eval-function-timestamp x)
-		     (eval-function-timestamp y)))))
-  
-  (do ((fun *interpreted-function-cache* (cdr fun))
-       (i 0 (1+ i)))
-      ((or (null fun) (> i *interpreted-function-cache-size*))
-       (dolist (nf (cdr fun))
-	 (setf (eval-function-definition nf) nil))
-       (when fun
-	 (setf (cdr fun) nil))))
-  
-  (setq *interpreted-function-cache-tick* 0))
+  (let ((num (- (length *intepreted-function-cache*)
+		*interpreted-function-cache-minimum-size*)))
+    (when (plusp num)
+      (setq *interpreted-function-cache*
+	    (delete-if #'(lambda (x)
+			   (when (< (eval-function-count x)
+				    *interpreted-function-cache-threshold*)
+			     (setf (eval-function-count x) 0)
+			     (setf (eval-function-definition x) nil)
+			     t))
+		       *interpreted-function-cache*
+		       :count num))))
+
+  (dolist (x *interpreted-function-cache*)
+    (setf (eval-function-count x) 0)))
 ;;;
 (pushnew 'interpreter-gc-hook ext:*before-gc-hooks*)
 
-- 
GitLab