(defun reset-current-conflict (component)
(do-packed-tns (tn component)
(setf (tn-current-conflict tn) (tn-global-conflicts tn))))
+
+;;; Cache the results of BLOCK-PHYSENV during lifetime analysis.
+;;;
+;;; Fetching the home-lambda of a block (needed in block-physenv) can
+;;; be an expensive operation under some circumstances, and it needs
+;;; to be done a lot during lifetime analysis when compiling with high
+;;; DEBUG (e.g. 30% of the total compilation time for CL-PPCRE with
+;;; DEBUG 3 just for that).
+(defun cached-block-physenv (block)
+ (let ((physenv (block-physenv-cache block)))
+ (if (eq physenv :none)
+ (setf (block-physenv-cache block)
+ (block-physenv block))
+ physenv)))
\f
;;;; pre-pass
(convert-to-global tn))
(setf (tn-current-conflict tn) (tn-global-conflicts tn))
(do-blocks-backwards (block component)
- (when (eq (block-physenv block) env)
+ (when (eq (cached-block-physenv block) env)
(let* ((2block (block-info block))
(last (do ((b (ir2-block-next 2block) (ir2-block-next b))
(prev 2block b))
(setf (svref (ir2-block-local-tns block1)
(global-conflicts-number current))
nil)
- (setf (global-conflicts-number current) nil)
- (setf (tn-current-conflict tn) current))
+ (setf (global-conflicts-number current) nil))
(t
(setf (sbit live-in (global-conflicts-number current)) 1)))
+ (setf (tn-current-conflict tn) current)
(return)))))
(:write)))
did-something))
(num (global-conflicts-number conf)))
(when (and num (zerop (sbit live-bits num))
(eq (tn-kind tn) :debug-environment)
- (eq (tn-physenv tn) (block-physenv 1block))
+ (eq (tn-physenv tn) (cached-block-physenv 1block))
(saved-after-read tn block))
(note-conflicts live-bits live-list tn num)
(setf (sbit live-bits num) 1)
(unless (eq (tn-kind tn) :environment)
(convert-to-environment-tn
tn
- (block-physenv (ir2-block-block block))))))))
+ (cached-block-physenv (ir2-block-block block))))))))
(values))
;;; FIXME: The next 3 macros aren't needed in the target runtime.
(setf (tn-global-conflicts tn) nil)))
(values))
+
+;;; On high debug levels, for all variables that a lambda closes over
+;;; convert the TNs to :ENVIRONMENT TNs (in the physical environment
+;;; of that lambda). This way the debugger can display the variables.
+(defun maybe-environmentalize-closure-tns (component)
+ (dolist (lambda (component-lambdas component))
+ (when (policy lambda (>= debug 2))
+ (let ((physenv (lambda-physenv lambda)))
+ (dolist (closure-var (physenv-closure physenv))
+ (let ((tn (find-in-physenv closure-var physenv)))
+ (when (member (tn-kind tn) '(:normal :debug-environment))
+ (convert-to-environment-tn tn physenv))))))))
+
\f
(defun lifetime-analyze (component)
(lifetime-pre-pass component)
+ (maybe-environmentalize-closure-tns component)
(setup-environment-live-conflicts component)
(lifetime-flow-analysis component)
(lifetime-post-pass component)