/[cmucl]/src/compiler/eval.lisp
ViewVC logotype

Diff of /src/compiler/eval.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.36.52.2 by rtoy, Wed Feb 10 22:47:03 2010 UTC revision 1.39 by rtoy, Tue Apr 20 17:57:46 2010 UTC
# Line 50  Line 50 
50  (defun eval-stack-push (value)  (defun eval-stack-push (value)
51    (let ((len (length (the simple-vector *eval-stack*))))    (let ((len (length (the simple-vector *eval-stack*))))
52      (when (= len *eval-stack-top*)      (when (= len *eval-stack-top*)
53        (when *eval-stack-trace* (format t _"[PUSH: growing stack.]~%"))        (when *eval-stack-trace* (format t (intl:gettext "[PUSH: growing stack.]~%")))
54        (let ((new-stack (make-array (ash len 1))))        (let ((new-stack (make-array (ash len 1))))
55          (replace new-stack *eval-stack* :end1 len :end2 len)          (replace new-stack *eval-stack* :end1 len :end2 len)
56          (setf *eval-stack* new-stack))))          (setf *eval-stack* new-stack))))
57    (let ((top *eval-stack-top*))    (let ((top *eval-stack-top*))
58      (when *eval-stack-trace* (format t _"pushing ~D.~%" top))      (when *eval-stack-trace* (format t (intl:gettext "pushing ~D.~%") top))
59      (incf *eval-stack-top*)      (incf *eval-stack-top*)
60      (setf (svref *eval-stack* top) value)))      (setf (svref *eval-stack* top) value)))
61    
# Line 70  Line 70 
70  ;;;  ;;;
71  (defun eval-stack-pop ()  (defun eval-stack-pop ()
72    (when (zerop *eval-stack-top*)    (when (zerop *eval-stack-top*)
73      (error _"Attempt to pop empty eval stack."))      (error (intl:gettext "Attempt to pop empty eval stack.")))
74    (let* ((new-top (1- *eval-stack-top*))    (let* ((new-top (1- *eval-stack-top*))
75           (value (svref *eval-stack* new-top)))           (value (svref *eval-stack* new-top)))
76      (when *eval-stack-trace* (format t _"popping ~D --> ~S.~%" new-top value))      (when *eval-stack-trace* (format t (intl:gettext "popping ~D --> ~S.~%") new-top value))
77      (setf *eval-stack-top* new-top)      (setf *eval-stack-top* new-top)
78      value))      value))
79    
# Line 87  Line 87 
87  (defun eval-stack-extend (n)  (defun eval-stack-extend (n)
88    (let ((len (length (the simple-vector *eval-stack*))))    (let ((len (length (the simple-vector *eval-stack*))))
89      (when (> (+ n *eval-stack-top*) len)      (when (> (+ n *eval-stack-top*) len)
90        (when *eval-stack-trace* (format t _"[EXTEND: growing stack.]~%"))        (when *eval-stack-trace* (format t (intl:gettext "[EXTEND: growing stack.]~%")))
91        (let ((new-stack (make-array (+ n (ash len 1)))))        (let ((new-stack (make-array (+ n (ash len 1)))))
92          (replace new-stack *eval-stack* :end1 len :end2 len)          (replace new-stack *eval-stack* :end1 len :end2 len)
93          (setf *eval-stack* new-stack))))          (setf *eval-stack* new-stack))))
94    (let ((new-top (+ *eval-stack-top* n)))    (let ((new-top (+ *eval-stack-top* n)))
95    (when *eval-stack-trace* (format t _"extending to ~D.~%" new-top))    (when *eval-stack-trace* (format t (intl:gettext "extending to ~D.~%") new-top))
96      (do ((i *eval-stack-top* (1+ i)))      (do ((i *eval-stack-top* (1+ i)))
97          ((= i new-top))          ((= i new-top))
98        (setf (svref *eval-stack* i) nil))        (setf (svref *eval-stack* i) nil))
# Line 104  Line 104 
104  ;;;  ;;;
105  (defun eval-stack-shrink (n)  (defun eval-stack-shrink (n)
106    (when *eval-stack-trace*    (when *eval-stack-trace*
107      (format t _"shrinking to ~D.~%" (- *eval-stack-top* n)))      (format t (intl:gettext "shrinking to ~D.~%") (- *eval-stack-top* n)))
108    (decf *eval-stack-top* n))    (decf *eval-stack-top* n))
109    
110  ;;; EVAL-STACK-SET-TOP -- Internal.  ;;; EVAL-STACK-SET-TOP -- Internal.
# Line 112  Line 112 
112  ;;; This is used to shrink the stack back to a previous frame pointer.  ;;; This is used to shrink the stack back to a previous frame pointer.
113  ;;;  ;;;
114  (defun eval-stack-set-top (ptr)  (defun eval-stack-set-top (ptr)
115    (when *eval-stack-trace* (format t _"setting top to ~D.~%" ptr))    (when *eval-stack-trace* (format t (intl:gettext "setting top to ~D.~%") ptr))
116    (setf *eval-stack-top* ptr))    (setf *eval-stack-top* ptr))
117    
118    
# Line 129  Line 129 
129  ;;;; Interpreted functions:  ;;;; Interpreted functions:
130    
131  (defvar *interpreted-function-cache-minimum-size* 25  (defvar *interpreted-function-cache-minimum-size* 25
132    _N"If the interpreted function cache has more functions than this come GC time,    "If the interpreted function cache has more functions than this come GC time,
133    then attempt to prune it according to    then attempt to prune it according to
134    *INTERPRETED-FUNCTION-CACHE-THRESHOLD*.")    *INTERPRETED-FUNCTION-CACHE-THRESHOLD*.")
135    
136  (defvar *interpreted-function-cache-threshold* 3  (defvar *interpreted-function-cache-threshold* 3
137    _N"If an interpreted function goes uncalled for more than this many GCs, then    "If an interpreted function goes uncalled for more than this many GCs, then
138    it is eligible for flushing from the cache.")    it is eligible for flushing from the cache.")
139    
140  (declaim (type c::index  (declaim (type c::index
# Line 279  Line 279 
279  ;;; FLUSH-INTERPRETED-FUNCTION-CACHE  --  Interface  ;;; FLUSH-INTERPRETED-FUNCTION-CACHE  --  Interface
280  ;;;  ;;;
281  (defun flush-interpreted-function-cache ()  (defun flush-interpreted-function-cache ()
282    _N"Clear all entries in the eval function cache.  This allows the internal    "Clear all entries in the eval function cache.  This allows the internal
283    representation of the functions to be reclaimed, and also lazily forces    representation of the functions to be reclaimed, and also lazily forces
284    macroexpansions to be recomputed."    macroexpansions to be recomputed."
285    (dolist (fun *interpreted-function-cache*)    (dolist (fun *interpreted-function-cache*)
# Line 550  Line 550 
550              (assert (eq (c::continuation-info cont) :multiple))              (assert (eq (c::continuation-info cont) :multiple))
551              (eval-stack-push (list more-args (length more-args)))))              (eval-stack-push (list more-args (length more-args)))))
552           (c::%unknown-values           (c::%unknown-values
553            (error _"C::%UNKNOWN-VALUES should never be in interpreter's IR1."))            (error (intl:gettext "C::%UNKNOWN-VALUES should never be in interpreter's IR1.")))
554           (c::%lexical-exit-breakup           (c::%lexical-exit-breakup
555            ;; We see this whenever we locally exit the extent of a lexical            ;; We see this whenever we locally exit the extent of a lexical
556            ;; target.  That is, we are truly locally exiting an extent we could            ;; target.  That is, we are truly locally exiting an extent we could

Legend:
Removed from v.1.36.52.2  
changed lines
  Added in v.1.39

  ViewVC Help
Powered by ViewVC 1.1.5