From 338ebb8ec835c255109363cbdf381867084f72fe Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Tue, 12 Nov 2013 17:47:18 -0500 Subject: [PATCH] Parameterise ASSIGN-TN-COSTS to make writes more important *TN-WRITE-COST* determines the weight given to writes when computing the cost for allocating a TN on the stack. It defaults to 2, versus 1 for reads. Also, hoist some special lookups out of loops. --- src/compiler/pack.lisp | 51 +++++++++++++++++++++++++++--------------------- 1 file changed, 29 insertions(+), 22 deletions(-) diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp index 288a988..2255a9c 100644 --- a/src/compiler/pack.lisp +++ b/src/compiler/pack.lisp @@ -759,29 +759,36 @@ (setq block (ir2-block-prev block))))) ;;; Iterate over the normal TNs, finding the cost of packing on the -;;; stack in units of the number of references. We count all -;;; references as +1, and subtract out REGISTER-SAVE-PENALTY for each -;;; place where we would have to save a register. +;;; stack in units of the number of references. We count all read +;;; references as +1, write references as + *tn-write-cost*, and +;;; subtract out REGISTER-SAVE-PENALTY for each place where we would +;;; have to save a register. +;;; The subtraction reflects the fact that having a value in a +;;; register around a call means that code to spill and unspill must +;;; be inserted. +(defvar *tn-write-cost* 2) (defun assign-tn-costs (component) - (do-ir2-blocks (block component) - (do ((vop (ir2-block-start-vop block) (vop-next vop))) - ((null vop)) - (when (eq (vop-info-save-p (vop-info vop)) t) - (do-live-tns (tn (vop-save-set vop) block) - (decf (tn-cost tn) *backend-register-save-penalty*))))) - - (do ((tn (ir2-component-normal-tns (component-info component)) - (tn-next tn))) - ((null tn)) - (let ((cost (tn-cost tn))) - (declare (fixnum cost)) - (do ((ref (tn-reads tn) (tn-ref-next ref))) - ((null ref)) - (incf cost)) - (do ((ref (tn-writes tn) (tn-ref-next ref))) - ((null ref)) - (incf cost)) - (setf (tn-cost tn) cost)))) + (let ((save-penalty *backend-register-save-penalty*)) + (do-ir2-blocks (block component) + (do ((vop (ir2-block-start-vop block) (vop-next vop))) + ((null vop)) + (when (eq (vop-info-save-p (vop-info vop)) t) + (do-live-tns (tn (vop-save-set vop) block) + (decf (tn-cost tn) save-penalty)))))) + + (let ((write-cost *tn-write-cost*)) + (do ((tn (ir2-component-normal-tns (component-info component)) + (tn-next tn))) + ((null tn)) + (let ((cost (tn-cost tn))) + (declare (fixnum cost)) + (do ((ref (tn-reads tn) (tn-ref-next ref))) + ((null ref)) + (incf cost)) + (do ((ref (tn-writes tn) (tn-ref-next ref))) + ((null ref)) + (incf cost write-cost)) + (setf (tn-cost tn) cost))))) ;;; Iterate over the normal TNs, storing the depth of the deepest loop ;;; that the TN is used in TN-LOOP-DEPTH. -- 1.7.10.4