From e72b4d1eb82b5eea1cfc45cf9d708a41b50b9a02 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Sun, 11 Nov 1990 00:02:53 +0000
Subject: [PATCH] Added new :TN arg to OPERAND-RESTRICTION-OK so that we can
 use it at IR2 time.

---
 compiler/ltn.lisp | 26 +++++++++++++++++---------
 1 file changed, 17 insertions(+), 9 deletions(-)

diff --git a/compiler/ltn.lisp b/compiler/ltn.lisp
index c34c7492d..3dd20960f 100644
--- a/compiler/ltn.lisp
+++ b/compiler/ltn.lisp
@@ -518,18 +518,20 @@
 
 ;;;; Known call annotation:
 
-;;; OPERAND-RESTRICTION-OK  --  Internal
+;;; OPERAND-RESTRICTION-OK  --  Interface
 ;;;
-;;;    Return true if Restr is satisfied by Type.  Cont is continuation used to
-;;; test for constant arguments.  If T-OK is true, then a T restriction allows
-;;; any operand type.  This is also called by IR2tran when it determines
-;;; whether a result temporary needs to be made.
+;;;    Return true if Restr is satisfied by Type.  If T-OK is true, then a T
+;;; restriction allows any operand type.  This is also called by IR2tran when
+;;; it determines whether a result temporary needs to be made, and by
+;;; representation selection when it is deciding which move VOP to use.
+;;; Cont and TN are used to test for constant arguments.
 ;;;
 (proclaim '(inline operand-restriction-ok))
-(defun operand-restriction-ok (restr type &key cont (t-ok t))
+(defun operand-restriction-ok (restr type &key cont tn (t-ok t))
   (declare (type (or (member *) cons) restr)
 	   (type primitive-type type)
-	   (type (or continuation null) cont))
+	   (type (or continuation null) cont)
+	   (type (or tn null) tn))
   (if (eq restr '*)
       t
       (ecase (first restr)
@@ -539,8 +541,14 @@
 		     (eq mem type))
 	     (return t))))
 	(:constant
-	 (and (constant-continuation-p cont)
-	      (funcall (second restr) (continuation-value cont)))))))
+	 (cond (cont
+		(and (constant-continuation-p cont)
+		     (funcall (second restr) (continuation-value cont))))
+	       (tn
+		(and (eq (tn-kind tn) :constant)
+		     (funcall (second restr) (tn-value tn))))
+	       (t
+		(error "Neither CONT nor TN supplied.")))))))
 
   
 ;;; Template-Args-OK  --  Internal
-- 
GitLab