Skip to content
Snippets Groups Projects
Commit 024cb80a authored by ram's avatar ram
Browse files

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.)
parent 55796a74
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -1077,7 +1077,7 @@
(declare (type index i end)) (declare (type index i end))
(let ((res (or (when (>= i size) :overflow) (let ((res (or (when (>= i size) :overflow)
(and (not ignore-live) (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)))) (load-tn-offset-conflicts-in-sb op sb i))))
(when res (return res)))))) (when res (return res))))))
...@@ -1285,13 +1285,15 @@ ...@@ -1285,13 +1285,15 @@
;;; ;;;
(defun pack-load-tns (block) (defun pack-load-tns (block)
(catch 'unpacked-tn (catch 'unpacked-tn
(do ((vop (ir2-block-last-vop block) (vop-prev vop))) (let ((*live-block* nil)
((null vop)) (*live-vop* nil))
(let ((info (vop-info vop))) (do ((vop (ir2-block-last-vop block) (vop-prev vop)))
(check-operand-restrictions (vop-info-result-load-scs info) ((null vop))
(vop-results vop)) (let ((info (vop-info vop)))
(check-operand-restrictions (vop-info-arg-load-scs info) (check-operand-restrictions (vop-info-result-load-scs info)
(vop-args vop))))) (vop-results vop))
(check-operand-restrictions (vop-info-arg-load-scs info)
(vop-args vop))))))
(undefined-value)) (undefined-value))
...@@ -1594,26 +1596,22 @@ ...@@ -1594,26 +1596,22 @@
;; ;;
;; Do load TN packing and emit saves. ;; Do load TN packing and emit saves.
(let ((*repack-blocks* nil)) (let ((*repack-blocks* nil))
(let ((*live-block* nil) (cond ((and optimize pack-optimize-saves)
(*live-vop* nil)) (optimized-emit-saves component)
(cond ((and optimize pack-optimize-saves) (do-ir2-blocks (block component)
(optimized-emit-saves component) (pack-load-tns block)))
(do-ir2-blocks (block component) (t
(pack-load-tns block))) (do-ir2-blocks (block component)
(t (emit-saves block)
(do-ir2-blocks (block component) (pack-load-tns block))))
(emit-saves block)
(pack-load-tns block)))))
(when *repack-blocks* (when *repack-blocks*
(loop (loop
(when (zerop (hash-table-count *repack-blocks*)) (return)) (when (zerop (hash-table-count *repack-blocks*)) (return))
(let ((*live-block* nil) (maphash #'(lambda (block v)
(*live-vop* nil)) (declare (ignore v))
(maphash #'(lambda (block v) (remhash block *repack-blocks*)
(declare (ignore v)) (event repack-block)
(remhash block *repack-blocks*) (pack-load-tns block))
(event repack-block) *repack-blocks*)))))
(pack-load-tns block))
*repack-blocks*))))) (undefined-value))
(undefined-value)))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment