Skip to content
Snippets Groups Projects
Commit f1a737c5 authored by ram's avatar ram
Browse files

Added SIGCONTEXT-FLOATING-POINT-MODES for finding the floating-point

hardware state when there is a floating-point error.
parent ca4c7f29
No related branches found
No related tags found
No related merge requests found
......@@ -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)))))
......@@ -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)))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment