Skip to content
Snippets Groups Projects
Commit 43768aad authored by ram's avatar ram
Browse files

Changed the interpreted function caching policy so that any function used more

than *INTERPRETED-FUNCTION-CACHE-THRESHOLD* times since the last GC is
retained.
parent 9056d1de
No related branches found
No related tags found
No related merge requests found
...@@ -15,7 +15,8 @@ ...@@ -15,7 +15,8 @@
(in-package "EVAL") (in-package "EVAL")
(export '(internal-eval *eval-stack-trace* *internal-apply-node-trace* (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 trace-eval interpreted-function-p
interpreted-function-lambda-expression interpreted-function-lambda-expression
interpreted-function-closure interpreted-function-closure
...@@ -147,28 +148,33 @@ ...@@ -147,28 +148,33 @@
;; being removed.) ;; being removed.)
(definition nil :type (or c::clambda null)) (definition nil :type (or c::clambda null))
;; ;;
;; Timestamp for the last time this function was called. ;; Number of times this function was called since the last GC.
(timestamp 0 :type c::index) (count 0 :type c::index)
;; ;;
;; True if Lambda has been converted at least once, and thus warnings should ;; True if Lambda has been converted at least once, and thus warnings should
;; be suppressed on additional conversions. ;; be suppressed on additional conversions.
(converted-once nil)) (converted-once nil))
(defvar *interpreted-function-cache-size* 25 (defvar *interpreted-function-cache-minimum-size* 25
"This many most-recently-used interpreted functions are retained across GC. "If the interpreted function cache has more functions than this come GC time,
Any other functions must be reconverted as needed.") 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. ;;; The list of EVAL-FUNCTIONS that have translated definitions.
;;; ;;;
(defvar *interpreted-function-cache* nil) (defvar *interpreted-function-cache* nil)
(proclaim '(type list *interpreted-function-cache*)) (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 ;;; MAKE-INTERPRETED-FUNCTION -- Interface
;;; ;;;
...@@ -180,11 +186,11 @@ ...@@ -180,11 +186,11 @@
#'(lambda (&rest args) #'(lambda (&rest args)
(let ((fun (eval-function-definition eval-fun)) (let ((fun (eval-function-definition eval-fun))
(args (cons (length args) args))) (args (cons (length args) args)))
(setf (eval-function-timestamp eval-fun) (incf (eval-function-count eval-fun))
(incf *interpreted-function-cache-tick*))
(internal-apply (or fun (convert-eval-fun eval-fun)) (internal-apply (or fun (convert-eval-fun eval-fun))
args '#()))))) args '#())))))
;;; GET-EVAL-FUNCTION -- Internal ;;; GET-EVAL-FUNCTION -- Internal
;;; ;;;
(defun get-eval-function (x) (defun get-eval-function (x)
...@@ -192,13 +198,13 @@ ...@@ -192,13 +198,13 @@
(assert res) (assert res)
res)) res))
;;; CONVERT-EVAL-FUN -- Internal ;;; CONVERT-EVAL-FUN -- Internal
;;; ;;;
;;; Eval a FUNCTION form, grab the definition and stick it in. ;;; Eval a FUNCTION form, grab the definition and stick it in.
;;; ;;;
(defun convert-eval-fun (eval-fun) (defun convert-eval-fun (eval-fun)
(declare (type eval-function eval-fun)) (declare (type eval-function eval-fun))
(push eval-fun *interpreted-function-cache*)
(let* ((new (eval-function-definition (let* ((new (eval-function-definition
(get-eval-function (get-eval-function
(internal-eval `#',(eval-function-lambda eval-fun) (internal-eval `#',(eval-function-lambda eval-fun)
...@@ -206,6 +212,7 @@ ...@@ -206,6 +212,7 @@
eval-fun))))))) eval-fun)))))))
(setf (eval-function-definition eval-fun) new) (setf (eval-function-definition eval-fun) new)
(setf (eval-function-converted-once eval-fun) t) (setf (eval-function-converted-once eval-fun) t)
(push eval-fun *interpreted-function-cache*)
new)) new))
...@@ -275,21 +282,21 @@ ...@@ -275,21 +282,21 @@
((= i len)) ((= i len))
(setf (svref *eval-stack* i) nil))) (setf (svref *eval-stack* i) nil)))
(setq *interpreted-function-cache* (let ((num (- (length *intepreted-function-cache*)
(sort *interpreted-function-cache* *interpreted-function-cache-minimum-size*)))
#'(lambda (x y) (when (plusp num)
(> (eval-function-timestamp x) (setq *interpreted-function-cache*
(eval-function-timestamp y))))) (delete-if #'(lambda (x)
(when (< (eval-function-count x)
(do ((fun *interpreted-function-cache* (cdr fun)) *interpreted-function-cache-threshold*)
(i 0 (1+ i))) (setf (eval-function-count x) 0)
((or (null fun) (> i *interpreted-function-cache-size*)) (setf (eval-function-definition x) nil)
(dolist (nf (cdr fun)) t))
(setf (eval-function-definition nf) nil)) *interpreted-function-cache*
(when fun :count num))))
(setf (cdr fun) nil))))
(dolist (x *interpreted-function-cache*)
(setq *interpreted-function-cache-tick* 0)) (setf (eval-function-count x) 0)))
;;; ;;;
(pushnew 'interpreter-gc-hook ext:*before-gc-hooks*) (pushnew 'interpreter-gc-hook ext:*before-gc-hooks*)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment