From 024cb80a8aa8ec058b2aa35e94d3808f9a981ad4 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Thu, 6 Jan 1994 16:32:43 +0000 Subject: [PATCH] Fix LOAD-TN-CONFLICTS-IN-SC to work for multi-location SCs. Moved bind-to-nil of *LIVE-BLOCK* and *LIVE-VOP* into PACK-LOAD-TNS to better ensure the live-tns are invalidated between two packings of the same block (e.g. for repacking.) --- compiler/pack.lisp | 56 ++++++++++++++++++++++------------------------ 1 file changed, 27 insertions(+), 29 deletions(-) diff --git a/compiler/pack.lisp b/compiler/pack.lisp index b19d0dfd1..8e8cb5eef 100644 --- a/compiler/pack.lisp +++ b/compiler/pack.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/pack.lisp,v 1.49 1993/08/12 20:46:35 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/pack.lisp,v 1.50 1994/01/06 16:32:43 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1077,7 +1077,7 @@ (declare (type index i end)) (let ((res (or (when (>= i size) :overflow) (and (not ignore-live) - (svref (finite-sb-live-tns sb) offset)) + (svref (finite-sb-live-tns sb) i)) (load-tn-offset-conflicts-in-sb op sb i)))) (when res (return res)))))) @@ -1285,13 +1285,15 @@ ;;; (defun pack-load-tns (block) (catch 'unpacked-tn - (do ((vop (ir2-block-last-vop block) (vop-prev vop))) - ((null vop)) - (let ((info (vop-info vop))) - (check-operand-restrictions (vop-info-result-load-scs info) - (vop-results vop)) - (check-operand-restrictions (vop-info-arg-load-scs info) - (vop-args vop))))) + (let ((*live-block* nil) + (*live-vop* nil)) + (do ((vop (ir2-block-last-vop block) (vop-prev vop))) + ((null vop)) + (let ((info (vop-info vop))) + (check-operand-restrictions (vop-info-result-load-scs info) + (vop-results vop)) + (check-operand-restrictions (vop-info-arg-load-scs info) + (vop-args vop)))))) (undefined-value)) @@ -1594,26 +1596,22 @@ ;; ;; Do load TN packing and emit saves. (let ((*repack-blocks* nil)) - (let ((*live-block* nil) - (*live-vop* nil)) - (cond ((and optimize pack-optimize-saves) - (optimized-emit-saves component) - (do-ir2-blocks (block component) - (pack-load-tns block))) - (t - (do-ir2-blocks (block component) - (emit-saves block) - (pack-load-tns block))))) + (cond ((and optimize pack-optimize-saves) + (optimized-emit-saves component) + (do-ir2-blocks (block component) + (pack-load-tns block))) + (t + (do-ir2-blocks (block component) + (emit-saves block) + (pack-load-tns block)))) (when *repack-blocks* (loop (when (zerop (hash-table-count *repack-blocks*)) (return)) - (let ((*live-block* nil) - (*live-vop* nil)) - (maphash #'(lambda (block v) - (declare (ignore v)) - (remhash block *repack-blocks*) - (event repack-block) - (pack-load-tns block)) - *repack-blocks*))))) - - (undefined-value))) + (maphash #'(lambda (block v) + (declare (ignore v)) + (remhash block *repack-blocks*) + (event repack-block) + (pack-load-tns block)) + *repack-blocks*))))) + + (undefined-value)) -- GitLab