X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcold%2Fansify.lisp;h=5bfa6d2415271cdd8391dd28587a32d5091012d8;hb=f1407e424f1063203af07d2e61ceef58515a4797;hp=f11a6e150329afbaeb37a57c272240255a665689;hpb=78a057624fecd10d0fb2ead4ef02ffc361b1ee22;p=sbcl.git

diff --git a/src/cold/ansify.lisp b/src/cold/ansify.lisp
index f11a6e1..5bfa6d2 100644
--- a/src/cold/ansify.lisp
+++ b/src/cold/ansify.lisp
@@ -1,4 +1,4 @@
-;;;; patches to hide some implementation idiosyncrasies in our
+;;;; patches to work around implementation idiosyncrasies in our
 ;;;; cross-compilation host
 
 ;;;; This software is part of the SBCL system. See the README file for
@@ -40,7 +40,10 @@
     ;; These problems don't seem deep, and could probably be worked
     ;; around.
     #+nil (clisp-ouch "no (DOCUMENTATION X) when X is a PACKAGE")
-    #+nil (clisp-ouch "no (FUNCTION (SETF SYMBOL-FUNCTION))")))
+    #+nil (clisp-ouch "no (FUNCTION (SETF SYMBOL-FUNCTION))"))
+  
+  (ext:without-package-lock ("SYSTEM")
+    (setf system::*inhibit-floating-point-underflow* t)))
 
 ;;;; CMU CL issues
 
@@ -80,6 +83,11 @@
 
 (in-package :sb-cold)
 
+(defmacro munging-cl-package (&body body)
+  #-clisp `(progn ,@body)
+  #+clisp `(ext:without-package-lock ("CL")
+	     ,@body))
+
 ;;; Do the exports of COMMON-LISP conform to the standard? If not, try
 ;;; to make them conform. (Of course, ANSI says that bashing symbols
 ;;; in the COMMON-LISP package like this is undefined, but then if the
@@ -96,17 +104,15 @@
 	     (declare (ignore value))
 	     (unless (gethash key standard-ht)
 	       (warn "removing non-ANSI export from package CL: ~S" key)
-	       #+CLISP (ext:without-package-lock ("CL")
-						 (unexport (intern key cl) cl))
-	       #-CLISP (unexport (intern key cl) cl)))
+	       (munging-cl-package
+		(unexport (intern key cl) cl))))
 	   host-ht)
   (maphash (lambda (key value)
 	     (declare (ignore value))
 	     (unless (gethash key host-ht)
 	       (warn "adding required-by-ANSI export to package CL: ~S" key)
-	       #+CLISP (ext:without-package-lock ("CL")
-						 (export (intern key cl) cl))
-	       #-CLISP (export (intern key cl) cl))
+	       (munging-cl-package 
+		(export (intern key cl) cl)))
 	     
 	     ;; FIXME: My righteous indignation below was misplaced. ANSI sez
 	     ;; (in 11.1.2.1, "The COMMON-LISP Package") that it's OK for