Skip to content
Snippets Groups Projects
Commit 28f77b96 authored by ram's avatar ram
Browse files

Changed ADJOIN-TEMPLATE to operate on a list arg, rather than always

hacking on function-info-templates.
Made the SC-MOVE-VOPS be a sorted list of VOPS that can be used for moves
with that particular SC pair.
parent a30599e4
No related branches found
No related tags found
No related merge requests found
...@@ -151,9 +151,9 @@ ...@@ -151,9 +151,9 @@
:Alternate-SCs (SC*) :Alternate-SCs (SC*)
Indicates other SCs that can be used to hold values from this SC across Indicates other SCs that can be used to hold values from this SC across
calls or when storage in this SC is exhausted. The SCs should be calls or when storage in this SC is exhausted. The SCs should be
specified in order of decreasing \"goodness\". Unless this SC is only specified in order of decreasing \"goodness\". There must be at least
used for restricted or wired TNs, then there must be a last SC in an one SC in an unbounded SB, unless this SC is only used for restricted or
unbounded SB. wired TNs.
:Constant-SCs (SC*) :Constant-SCs (SC*)
A list of the names of all the constant SCs that can be loaded into this A list of the names of all the constant SCs that can be loaded into this
...@@ -319,12 +319,14 @@ ...@@ -319,12 +319,14 @@
(do-sc-pairs (from-sc to-sc ',scs) (do-sc-pairs (from-sc to-sc ',scs)
(dolist (dest-sc (cons to-sc (sc-alternate-scs to-sc))) (dolist (dest-sc (cons to-sc (sc-alternate-scs to-sc)))
(let ((vec (,accessor dest-sc))) (let ((vec (,accessor dest-sc)))
(setf (svref vec (sc-number from-sc)) vop) (let ((scn (sc-number from-sc)))
(setf (svref vec scn)
(adjoin-template vop (svref vec scn))))
(dolist (sc (append (sc-alternate-scs from-sc) (dolist (sc (append (sc-alternate-scs from-sc)
(sc-constant-scs from-sc))) (sc-constant-scs from-sc)))
(let ((scn (sc-number sc))) (let ((scn (sc-number sc)))
(unless (svref vec scn) (setf (svref vec scn)
(setf (svref vec scn) vop))))))))))) (adjoin-template vop (svref vec scn))))))))))))
;;;; Primitive type definition: ;;;; Primitive type definition:
...@@ -1682,19 +1684,16 @@ ...@@ -1682,19 +1684,16 @@
;;; Adjoin-Template -- Internal ;;; Adjoin-Template -- Internal
;;; ;;;
;;; Add Template into Info's Templates, removing any old template with the ;;; Add Template into List, removing any old template with the same name.
;;; same name. ;;; We also maintain the increasing cost ordering.
;;; ;;;
(defun adjoin-template (info template) (defun adjoin-template (template list)
(declare (type function-info info) (type template template)) (declare (type template template) (list list))
(setf (function-info-templates info) (sort (cons template
(sort (cons template (remove (template-name template) list
(remove (template-name template) :key #'template-name))
(function-info-templates info) #'<=
:key #'template-name)) :key #'template-cost))
#'<=
:key #'template-cost))
(undefined-value))
;;; Set-Up-Function-Translation -- Internal ;;; Set-Up-Function-Translation -- Internal
...@@ -1709,7 +1708,9 @@ ...@@ -1709,7 +1708,9 @@
(declare (type vop-parse parse)) (declare (type vop-parse parse))
(mapcar #'(lambda (name) (mapcar #'(lambda (name)
`(let ((info (function-info-or-lose ',name))) `(let ((info (function-info-or-lose ',name)))
(adjoin-template info ,n-template) (setf (function-info-templates info)
(adjoin-template ,n-template
(function-info-templates info)))
,@(when (vop-parse-conditional-p parse) ,@(when (vop-parse-conditional-p parse)
'((setf (function-info-attributes info) '((setf (function-info-attributes info)
(attributes-union (attributes-union
......
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