From e83cb5462e65d3a81404c8bf4b7706dffb268d3f Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Mon, 1 Oct 1990 17:15:05 +0000
Subject: [PATCH] Added stuff to read and set floating-point modes, and added
 calls to NOTE-THIS-LOCATION for floating point instructions that could get
 exceptions.

---
 compiler/mips/float.lisp | 43 ++++++++++++++++++++++++++++++++++++++--
 1 file changed, 41 insertions(+), 2 deletions(-)

diff --git a/compiler/mips/float.lisp b/compiler/mips/float.lisp
index f545d7f25..a3ff4a170 100644
--- a/compiler/mips/float.lisp
+++ b/compiler/mips/float.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/float.lisp,v 1.6 1990/08/07 16:06:02 ram Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/float.lisp,v 1.7 1990/10/01 17:15:05 ram Exp $
 ;;;
 ;;;    This file contains floating point support for the MIPS.
 ;;;
@@ -140,7 +140,9 @@
   (:variant-vars format operation)
   (:policy :fast-safe)
   (:note "inline float arithmetic")
+  (:vop-var vop)
   (:generator 0
+    (note-this-location vop :internal-error)
     (inst float-op operation format r x y)))
 
 (macrolet ((frob (name sc ptype)
@@ -177,7 +179,9 @@
 		(:arg-types ,type)
 		(:result-types ,type)
 		(:note "inline float arithmetic")
+		(:vop-var vop)
 		(:generator 1
+		  (note-this-location vop :internal-error)
 		  (inst ,inst ,format y x)))))
   (frob abs/single-float fabs abs :single single-reg single-float)
   (frob abs/double-float fabs abs :double double-reg double-float)
@@ -194,7 +198,9 @@
   (:variant-vars format operation complement)
   (:policy :fast-safe)
   (:note "inline float comparison")
+  (:vop-var vop)
   (:generator 3
+    (note-this-location vop :internal-error)
     (inst fcmp operation format x y)
     (inst nop)
     (if (if complement (not not-p) not-p)
@@ -237,12 +243,15 @@
 		  (:policy :fast-safe)
 		  (:note "inline float coercion")
 		  (:translate ,translate)
+		  (:vop-var vop)
 		  (:generator ,(if word-p 3 2)
 		    ,@(if word-p
 			  `((inst mtc1 y x)
 			    (inst nop)
+			    (note-this-location vop :internal-error)
 			    (inst fcvt ,to-format :word y y))
-			  `((inst fcvt ,to-format ,from-format y x))))))))
+			  `((note-this-location vop :internal-error)
+			    (inst fcvt ,to-format ,from-format y x))))))))
   (frob %single-float/signed %single-float
     signed-reg signed-num :word
     single-reg single-float :single)
@@ -267,7 +276,9 @@
 		(:translate %unary-truncate)
 		(:policy :fast-safe)
 		(:note "inline float truncate")
+		(:vop-var vop)
 		(:generator 3
+		  (note-this-location vop :internal-error)
 		  (inst fcvt :word ,from-format temp x)
 		  (inst mfc1 y temp)
 		  (inst nop)))))
@@ -366,3 +377,31 @@
   (:results (result :scs (double-reg)))
   (:result-types double-float)
   (:variant :double))
+
+
+;;;; Float mode hackery:
+
+(deftype float-modes () '(unsigned-byte 24))
+(defknown floating-point-modes () float-modes (flushable))
+(defknown ((setf floating-point-modes)) (float-modes)
+  float-modes)
+
+(define-vop (floating-point-modes)
+  (:results (res :scs (unsigned-reg)))
+  (:result-types unsigned-num)
+  (:translate floating-point-modes)
+  (:policy :fast-safe)
+  (:generator 3
+    (inst cfc1 res 31)
+    (inst nop)))
+
+(define-vop (set-floating-point-modes)
+  (:args (new :scs (unsigned-reg) :target res))
+  (:results (res :scs (unsigned-reg)))
+  (:arg-types unsigned-num)
+  (:result-types unsigned-num)
+  (:translate (setf floating-point-modes))
+  (:policy :fast-safe)
+  (:generator 3
+    (inst ctc1 res 31)
+    (move res new)))
-- 
GitLab