From f1a737c5852fdd85ab5430a37c930e55bf881899 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Thu, 6 Dec 1990 17:40:17 +0000
Subject: [PATCH] Added SIGCONTEXT-FLOATING-POINT-MODES for finding the
 floating-point hardware state when there is a floating-point error.

---
 code/pmax-vm.lisp  | 15 ++++++++++++++-
 code/sparc-vm.lisp | 16 +++++++++++++++-
 2 files changed, 29 insertions(+), 2 deletions(-)

diff --git a/code/pmax-vm.lisp b/code/pmax-vm.lisp
index 835797135..ef364a041 100644
--- a/code/pmax-vm.lisp
+++ b/code/pmax-vm.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pmax-vm.lisp,v 1.4 1990/11/26 18:55:08 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pmax-vm.lisp,v 1.5 1990/12/06 17:39:33 ram Exp $
 ;;;
 ;;; This file contains the PMAX specific runtime stuff.
 ;;;
@@ -83,3 +83,16 @@
 	      (sc-offsets (c::read-var-integer vector index)))
 	    (values error-number (sc-offsets))))))))
 
+
+;;; SIGCONTEXT-FLOATING-POINT-MODES  --  Interface
+;;;
+;;;    Given a sigcontext pointer, return the floating point modes word in the
+;;; same format as returned by FLOATING-POINT-MODES.
+;;;
+(defun sigcontext-floating-point-modes (scp)
+  (alien-bind ((sc (make-alien 'mach:sigcontext
+					     #.(ext:c-sizeof 'mach:sigcontext)
+					     scp)
+			  mach:sigcontext
+			  t))
+    (alien-access (mach:sigcontext-fpc_csr (alien-value sc)))))
diff --git a/code/sparc-vm.lisp b/code/sparc-vm.lisp
index bf4b6fc15..72ec513e6 100644
--- a/code/sparc-vm.lisp
+++ b/code/sparc-vm.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sparc-vm.lisp,v 1.4 1990/11/27 08:45:47 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sparc-vm.lisp,v 1.5 1990/12/06 17:40:17 ram Exp $
 ;;;
 ;;; This file contains the SPARC specific runtime stuff.
 ;;;
@@ -73,3 +73,17 @@
 	      (return))
 	    (sc-offsets (c::read-var-integer vector index)))
 	  (values error-number (sc-offsets)))))))
+
+
+;;; SIGCONTEXT-FLOATING-POINT-MODES  --  Interface
+;;;
+;;;    Given a sigcontext pointer, return the floating point modes word in the
+;;; same format as returned by FLOATING-POINT-MODES.
+;;;
+(defun sigcontext-floating-point-modes (scp)
+  (alien-bind ((sc (make-alien 'mach:sigcontext
+					     #.(ext:c-sizeof 'mach:sigcontext)
+					     scp)
+			  mach:sigcontext
+			  t))
+    (alien-access (mach:sigcontext-fsr (alien-value sc)))))
-- 
GitLab