From 5d1cfe59f602edaf9cd799a98a90d8e0cabb527d Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Sat, 20 Apr 1991 16:59:34 +0000
Subject: [PATCH] Fixed move-from-sap to call with-fixed-allocation with the
 correct type. Hacked over the sap-ref and -set VOPs to no longer flame out by
 running out of registers.  Fixed the costs of the variable offset versions to
 be more than the constant offset versions.

---
 compiler/rt/sap.lisp | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

diff --git a/compiler/rt/sap.lisp b/compiler/rt/sap.lisp
index 37c9225f9..dd2626488 100644
--- a/compiler/rt/sap.lisp
+++ b/compiler/rt/sap.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/rt/sap.lisp,v 1.2 1991/04/13 13:44:11 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/rt/sap.lisp,v 1.3 1991/04/20 16:59:34 wlott Exp $
 ;;;
 ;;; This file contains the IBM RT VM definition of SAP operations.
 ;;;
@@ -44,8 +44,8 @@
   (:temporary (:sc word-pointer-reg) alloc)
   (:results (y :scs (descriptor-reg)))
   (:generator 1
-    (with-fixed-allocation (y header alloc vm:other-pointer-type vm:sap-size)
-      (storew sap y vm:sap-pointer-slot vm:other-pointer-type))))
+    (with-fixed-allocation (y header alloc sap-type sap-size)
+      (storew sap y sap-pointer-slot other-pointer-type))))
 ;;;
 (define-move-vop move-from-sap :move
   (sap-reg) (descriptor-reg))
@@ -222,7 +222,7 @@
 	 (:ignore bogus1 bogus2)
 	 (:variant-vars signed)
 	 (:variant nil)
-	 (:generator 5
+	 (:generator 7
 	   (move base offset)
 	   ;;
 	   ;; We shift right because the offset has fixnum lowtag.  Effectively
@@ -294,8 +294,8 @@
 	 (:args (base :scs (sap-reg))
 		(data :scs (,@data-scs) :target result :to (:result 0)))
 	 (:arg-types system-area-pointer
-		     ,data-type
-		     (:constant (signed-byte ,(- 16 shift))))
+		     (:constant (signed-byte ,(- 16 shift)))
+		     ,data-type)
 	 (:results (result :scs (,@data-scs)))
 	 (:result-types ,data-type)
 	 (:info offset)
@@ -315,12 +315,16 @@
 	 (:temporary (:scs (sap-reg) :from (:eval 0) :to (:eval 2)) base)
 	 (:temporary (:scs (non-descriptor-reg)
 			   :from (:argument 1) :to (:eval 0)) temp)
+	 ;; Add some bullshit temporaries because of human understanding about
+	 ;; a peculiarity in compiler register allocation, so this will trick
+	 ;; the compiler into giving us enough non-descriptor-regs.
+	 ;; Bill did not write this!
 	 (:temporary (:scs (non-descriptor-reg) :from (:eval 1) :to (:eval 2))
-		     bogus)
-	 (:ignore bogus)
+		     bogus1 bogus2)
+	 (:ignore bogus1 bogus2)
 	 (:results (result :scs (,@data-scs)))
 	 (:result-types ,data-type)
-	 (:generator 5
+	 (:generator 7
 	   (move temp offset)
 	   ;;
 	   ;; We shift right because the offset has fixnum lowtag.  Effectively
-- 
GitLab