From 0558002e728323f0b3485cf045b32e0c9fa79500 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Fri, 12 Apr 1991 22:48:32 +0000
Subject: [PATCH] Added floating point constants.

---
 compiler/rt/params.lisp | 66 ++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 65 insertions(+), 1 deletion(-)

diff --git a/compiler/rt/params.lisp b/compiler/rt/params.lisp
index 248763d58..df4d90dd2 100644
--- a/compiler/rt/params.lisp
+++ b/compiler/rt/params.lisp
@@ -7,7 +7,7 @@
 ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU)
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/rt/params.lisp,v 1.2 1991/04/01 13:49:23 chiles Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/rt/params.lisp,v 1.3 1991/04/12 22:48:32 wlott Exp $
 ;;;
 ;;; This file contains some parameterizations of various VM attributes for the
 ;;; IBM RT.  This file is separate from other stuff, so we can compile and
@@ -109,6 +109,70 @@
 
 
 
+
+;;;; Status register formats, goes in parms.
+
+;;; We squeeze the two 68881 float status registers into a one-word result for
+;;; FLOATING-POINT-MODES.  We also canonicalize the exceptions so that the
+;;; "portable" float trap code will work.
+;;;
+
+(eval-when (compile eval load)
+
+;;; The actual positions of the info in the mc68881 FPCR and FPSR.
+;;;
+(defconstant mc68881-fpcr-rounding-mode-byte (byte 2 4))
+(defconstant mc68881-fpcr-rounding-precision-byte (byte 2 6))
+(defconstant mc68881-fpcr-traps-byte (byte 8 8))
+(defconstant mc68881-fpsr-accrued-exceptions-byte (byte 5 3))
+(defconstant mc68881-fpsr-current-exceptions-byte (byte 8 8))
+(defconstant mc68881-fpsr-condition-code-byte (byte 4 24))
+
+;;; Amount to shift by the get the condition code, - 16.
+;;;
+(defconstant mc68881-fpsr-condition-code-shift-16 8)
+
+;;; The condition code bits.
+;;;
+(defconstant mc68881-nan-condition (ash 1 0))
+(defconstant mc68881-infinity-condition (ash 1 1))
+(defconstant mc68881-zero-condition (ash 1 2))
+(defconstant mc68881-negative-condition (ash 1 3))
+
+;;; Masks that map the extended set of exceptions implemented by the 68881 to
+;;; the IEEE exceptions.  This extended format is used for the enabled traps
+;;; and the current exceptions.
+;;;
+(defconstant mc68881-invalid-exception (ash #b111 5))
+(defconstant mc68881-overflow-exception (ash 1 4))
+(defconstant mc68881-underflow-exception (ash 1 3))
+(defconstant mc68881-divide-zero-exception (ash 1 2))
+(defconstant mc68881-inexact-exception (ash #b11 0))
+
+;;; Encoding of float exceptions in the FLOATING-POINT-MODES result.  This is
+;;; also the encoding used in the mc68881 accrued exceptions.
+;;;
+(defconstant float-inexact-trap-bit (ash 1 0))
+(defconstant float-divide-by-zero-trap-bit (ash 1 1))
+(defconstant float-underflow-trap-bit (ash 1 2))
+(defconstant float-overflow-trap-bit (ash 1 3))
+(defconstant float-invalid-trap-bit (ash 1 4))
+
+(defconstant float-round-to-nearest 0)
+(defconstant float-round-to-zero 1)
+(defconstant float-round-to-negative 2)
+(defconstant float-round-to-positive 3)
+
+;;; Positions of bits in the FLOATING-POINT-MODES result.
+;;;
+(defconstant float-rounding-mode (byte 2 0))
+(defconstant float-sticky-bits (byte 5 2))
+(defconstant float-traps-byte (byte 5 7))
+(defconstant float-exceptions-byte (byte 5 12))
+(defconstant float-fast-bit 0)
+
+); eval-when
+
 
 ;;;; Description of the target address space.
 
-- 
GitLab