From 5a3328b5d4ce3031cc28cb8330b509067acfe62c Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Tue, 13 Nov 1990 22:54:50 +0000
Subject: [PATCH] Supply the backend arg to sc-or-lose and friends when
 necessary to get at the runtime info.

---
 compiler/generic/primtype.lisp | 24 +++++++++++++++---------
 1 file changed, 15 insertions(+), 9 deletions(-)

diff --git a/compiler/generic/primtype.lisp b/compiler/generic/primtype.lisp
index 327a85936..64fce00d9 100644
--- a/compiler/generic/primtype.lisp
+++ b/compiler/generic/primtype.lisp
@@ -7,7 +7,7 @@
 ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU)
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/primtype.lisp,v 1.2 1990/11/03 15:35:27 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/primtype.lisp,v 1.3 1990/11/13 22:54:50 wlott Exp $
 ;;;
 ;;; This file contains the machine independent aspects of the object
 ;;; representation and primitive types.
@@ -113,7 +113,7 @@
   (let ((type (ctype-of object)))
     (cond ((not (member-type-p type)) (primitive-type type))
 	  ((equal (member-type-members type) '(nil))
-	   (primitive-type-or-lose 'list))
+	   (primitive-type-or-lose 'list *backend*))
 	  (t
 	   *any-primitive-type*))))
 
@@ -156,8 +156,10 @@
 	      ((type eq))
   (declare (type ctype type))
   (macrolet ((any () '(values *any-primitive-type* nil))
-	     (exactly (type) `(values (primitive-type-or-lose ',type) t))
-	     (part-of (type) `(values (primitive-type-or-lose ',type) nil)))
+	     (exactly (type)
+	       `(values (primitive-type-or-lose ',type *backend*) t))
+	     (part-of (type)
+	       `(values (primitive-type-or-lose ',type *backend*) nil)))
     (etypecase type
       (numeric-type
        (let ((lo (numeric-type-low type))
@@ -182,7 +184,8 @@
 			      (min (cadr spec))
 			      (max (caddr spec)))
 			  (when (<= min lo hi max)
-			    (return (values (primitive-type-or-lose type)
+			    (return (values (primitive-type-or-lose type
+								    *backend*)
 					    (and (= lo min) (= hi max))))))))
 		     ((or (and hi (< hi most-negative-fixnum))
 			  (and lo (> lo most-positive-fixnum)))
@@ -193,9 +196,11 @@
 	       (let ((exact (and (null lo) (null hi))))
 		 (case (numeric-type-format type)
 		   ((short-float single-float)
-		    (values (primitive-type-or-lose 'single-float) exact))
+		    (values (primitive-type-or-lose 'single-float *backend*)
+			    exact))
 		   ((double-float long-float)
-		    (values (primitive-type-or-lose 'double-float) exact))
+		    (values (primitive-type-or-lose 'double-float *backend*)
+			    exact))
 		   (t
 		    (any)))))
 	      (t
@@ -213,7 +218,8 @@
 		  (ptype (cdr (assoc type-spec *simple-array-primitive-types*
 				     :test #'equal))))
 	     (if (and (consp dims) (null (rest dims)) ptype)
-		 (values (primitive-type-or-lose ptype) (eq (first dims) '*))
+		 (values (primitive-type-or-lose ptype *backend*)
+			 (eq (first dims) '*))
 		 (any)))))
       (union-type
        (if (type= type (specifier-type 'list))
@@ -237,7 +243,7 @@
        (case (named-type-name type)
 	 ((t bignum ratio complex function structure
 	     system-area-pointer weak-pointer)
-	  (values (primitive-type-or-lose (named-type-name type)) t))
+	  (values (primitive-type-or-lose (named-type-name type) *backend*) t))
 	 ((character base-character string-char)
 	  (exactly base-character))
 	 (standard-char
-- 
GitLab