X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffloat-trap.lisp;h=ee10e9545a7263eaad669805d3553127e8a842b4;hb=b8f63d9b4e978bec3bfc1f4fc471e5ed946781fd;hp=a46d1577cc0f387bfb713c73e85542b8cb2938a2;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/float-trap.lisp b/src/code/float-trap.lisp
index a46d157..ee10e95 100644
--- a/src/code/float-trap.lisp
+++ b/src/code/float-trap.lisp
@@ -14,12 +14,9 @@
 
 (in-package "SB!VM")
 
-(file-comment
-  "$Header$")
-
 (eval-when (:compile-toplevel :load-toplevel :execute)
 
-(defconstant float-trap-alist
+(defparameter *float-trap-alist*
   (list (cons :underflow float-underflow-trap-bit)
 	(cons :overflow float-overflow-trap-bit)
 	(cons :inexact float-inexact-trap-bit)
@@ -27,20 +24,19 @@
 	(cons :divide-by-zero float-divide-by-zero-trap-bit)
 	#!+x86 (cons :denormalized-operand float-denormal-trap-bit)))
 
-;;; Return a mask with all the specified float trap bits set.
-(defun float-trap-mask (names)
-  (reduce #'logior
-	  (mapcar #'(lambda (x)
-		      (or (cdr (assoc x float-trap-alist))
-			  (error "Unknown float trap kind: ~S." x)))
-		  names)))
-
-(defconstant rounding-mode-alist
+(defparameter *rounding-mode-alist*
   (list (cons :nearest float-round-to-nearest)
 	(cons :zero float-round-to-zero)
 	(cons :positive-infinity float-round-to-positive)
 	(cons :negative-infinity float-round-to-negative)))
 
+;;; Return a mask with all the specified float trap bits set.
+(defun float-trap-mask (names)
+  (reduce #'logior
+	  (mapcar #'(lambda (x)
+		      (or (cdr (assoc x *float-trap-alist*))
+			  (error "unknown float trap kind: ~S" x)))
+		  names)))
 ); Eval-When (Compile Load Eval)
 
 ;;; interpreter stubs
@@ -85,8 +81,8 @@
       (setf (ldb float-traps-byte modes) (float-trap-mask traps)))
     (when round-p
       (setf (ldb float-rounding-mode modes)
-	    (or (cdr (assoc rounding-mode rounding-mode-alist))
-		(error "Unknown rounding mode: ~S." rounding-mode))))
+	    (or (cdr (assoc rounding-mode *rounding-mode-alist*))
+		(error "unknown rounding mode: ~S" rounding-mode))))
     (when current-x-p
       (setf (ldb float-exceptions-byte modes)
 	    (float-trap-mask current-exceptions)))
@@ -115,13 +111,13 @@
 			   ,@(mapcar #'(lambda (x)
 					 `(when (logtest bits ,(cdr x))
 					    (res ',(car x))))
-				     float-trap-alist)
+				     *float-trap-alist*)
 			   (res))))
 	     (frob))))
     (let ((modes (floating-point-modes)))
       `(:traps ,(exc-keys (ldb float-traps-byte modes))
 	:rounding-mode ,(car (rassoc (ldb float-rounding-mode modes)
-				     rounding-mode-alist))
+				     *rounding-mode-alist*))
 	:current-exceptions ,(exc-keys (ldb float-exceptions-byte modes))
 	:accrued-exceptions ,(exc-keys (ldb float-sticky-bits modes))
 	:fast-mode ,(logtest float-fast-bit modes)))))