/[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.38 by rtoy, Mon Apr 19 15:08:20 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 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.38  
changed lines
  Added in v.1.39

  ViewVC Help
Powered by ViewVC 1.1.5