From 28f77b96d2ffb525f25d4d23e1720d31fc81b6a9 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Sun, 11 Nov 1990 00:00:33 +0000 Subject: [PATCH] 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. --- compiler/vmdef.lisp | 41 +++++++++++++++++++++-------------------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/compiler/vmdef.lisp b/compiler/vmdef.lisp index 9f3849684..470ce2a8e 100644 --- a/compiler/vmdef.lisp +++ b/compiler/vmdef.lisp @@ -151,9 +151,9 @@ :Alternate-SCs (SC*) 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 - specified in order of decreasing \"goodness\". Unless this SC is only - used for restricted or wired TNs, then there must be a last SC in an - unbounded SB. + specified in order of decreasing \"goodness\". There must be at least + one SC in an unbounded SB, unless this SC is only used for restricted or + wired TNs. :Constant-SCs (SC*) A list of the names of all the constant SCs that can be loaded into this @@ -319,12 +319,14 @@ (do-sc-pairs (from-sc to-sc ',scs) (dolist (dest-sc (cons to-sc (sc-alternate-scs to-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) (sc-constant-scs from-sc))) (let ((scn (sc-number sc))) - (unless (svref vec scn) - (setf (svref vec scn) vop))))))))))) + (setf (svref vec scn) + (adjoin-template vop (svref vec scn)))))))))))) ;;;; Primitive type definition: @@ -1682,19 +1684,16 @@ ;;; Adjoin-Template -- Internal ;;; -;;; Add Template into Info's Templates, removing any old template with the -;;; same name. -;;; -(defun adjoin-template (info template) - (declare (type function-info info) (type template template)) - (setf (function-info-templates info) - (sort (cons template - (remove (template-name template) - (function-info-templates info) - :key #'template-name)) - #'<= - :key #'template-cost)) - (undefined-value)) +;;; Add Template into List, removing any old template with the same name. +;;; We also maintain the increasing cost ordering. +;;; +(defun adjoin-template (template list) + (declare (type template template) (list list)) + (sort (cons template + (remove (template-name template) list + :key #'template-name)) + #'<= + :key #'template-cost)) ;;; Set-Up-Function-Translation -- Internal @@ -1709,7 +1708,9 @@ (declare (type vop-parse parse)) (mapcar #'(lambda (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) '((setf (function-info-attributes info) (attributes-union -- GitLab