0.8.8.21:

	Make unknown variables signal a compile-time warning.
	... slightly hacky (if (eq kind :variable) ...) in the
		warning logic itself;
	... rearrange bits of the build to eliminate technically
		undefined forward references;
	... fix for multiple *CURRENT-CATCH-BLOCK* and
		*CURRENT-UNWIND-PROTECT-BLOCK*: we now have one and
		only one of each variable, rather than three

diff --git a/NEWS b/NEWS
index 04f7666..1d40778 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2323,6 +2323,10 @@ changes in sbcl-0.8.9 relative to sbcl-0.8.8:
   * The runtime build system has been tweaked to support building
     (on SPARC/SunOS) using a C compiler which invokes Sun's own
     assembler and linker.  (thanks to Nikodemus Siivola)
   * The runtime build system has been tweaked to support building
     (on SPARC/SunOS) using a C compiler which invokes Sun's own
     assembler and linker.  (thanks to Nikodemus Siivola)

+  * Unbound, undefined, undeclared variables now trigger full
+    WARNINGs, not just STYLE-WARNINGs, on the assumption that this is
+    more often programmer error than deliberate exploitation of undefined
+    behaviour.

   * optimization: implemented multiplication as a modular
     (UNSIGNED-BYTE 32) operation on the PPC backend.
   * fixed some bugs revealed by Paul Dietz' test suite:
   * optimization: implemented multiplication as a modular
     (UNSIGNED-BYTE 32) operation on the PPC backend.
   * fixed some bugs revealed by Paul Dietz' test suite:

diff --git a/build-order.lisp-expr b/build-order.lisp-expr
index 17e290b..3b5b727 100644 (file)
--- a/build-order.lisp-expr
+++ b/build-order.lisp-expr
@@ -79,12 +79,14 @@
  ("src/code/cross-float" :not-target)
  ("src/code/cross-io"    :not-target)
  ("src/code/cross-sap"   :not-target)
  ("src/code/cross-float" :not-target)
  ("src/code/cross-io"    :not-target)
  ("src/code/cross-sap"   :not-target)

+ ("src/code/cross-thread" :not-target)

  ("src/code/cross-make-load-form" :not-target)
 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;; stuff needed early both in cross-compilation host and in target Lisp
 
  ("src/code/uncross")
  ("src/code/cross-make-load-form" :not-target)
 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;; stuff needed early both in cross-compilation host and in target Lisp
 
  ("src/code/uncross")

+ ("src/code/primordial-type")

  ("src/code/early-defbangmethod")
 
  ("src/code/defbangtype")
  ("src/code/early-defbangmethod")
 
  ("src/code/defbangtype")

@@ -159,6 +161,7 @@
 
  ("src/code/target-error" :not-host)
 
 
  ("src/code/target-error" :not-host)
 

+ ("src/compiler/early-backend")

  ;; a comment from classic CMU CL:
  ;;   "These guys can supposedly come in any order, but not really.
  ;;    Some are put at the end so that macros don't run interpreted
  ;; a comment from classic CMU CL:
  ;;   "These guys can supposedly come in any order, but not really.
  ;;    Some are put at the end so that macros don't run interpreted

@@ -188,7 +191,8 @@
  ("src/code/misc-aliens" :not-host)
 
  ("src/code/array"         :not-host)
  ("src/code/misc-aliens" :not-host)
 
  ("src/code/array"         :not-host)

- ("src/code/target-sxhash" :not-host)
+ ("src/code/early-float"   :not-host)
+ ("src/code/target-sxhash" :not-host) ; needs most-fooative-foo-float constants

 
  ("src/code/list"   :not-host)
  ("src/code/seq"    :not-host) ; "code/seq" should come after "code/list".
 
  ("src/code/list"   :not-host)
  ("src/code/seq"    :not-host) ; "code/seq" should come after "code/list".

@@ -443,7 +447,6 @@
  ;; (and so that they don't cause lots of annoying compiler warnings
  ;; about undefined types). 
  ("src/compiler/generic/core")
  ;; (and so that they don't cause lots of annoying compiler warnings
  ;; about undefined types). 
  ("src/compiler/generic/core")

- ("src/code/cross-thread" :not-target)

  ("src/code/thread")
  ("src/code/load")
 
  ("src/code/thread")
  ("src/code/load")
 

diff --git a/src/code/class.lisp b/src/code/class.lisp
index 14532ed..fd13983 100644 (file)
--- a/src/code/class.lisp
+++ b/src/code/class.lisp
@@ -1380,11 +1380,6 @@
                   name
                   layout))))))
 
                   name
                   layout))))))
 

-;;; a vector that maps type codes to layouts, used for quickly finding
-;;; the layouts of built-in classes
-(defvar *built-in-class-codes*) ; initialized in cold load
-(declaim (type simple-vector *built-in-class-codes*))
-

 (!cold-init-forms
   #-sb-xc-host (/show0 "about to set *BUILT-IN-CLASS-CODES*")
   (setq *built-in-class-codes*
 (!cold-init-forms
   #-sb-xc-host (/show0 "about to set *BUILT-IN-CLASS-CODES*")
   (setq *built-in-class-codes*

diff --git a/src/code/early-float.lisp b/src/code/early-float.lisp
new file mode 100644 (file)
index 0000000..35d3d15
--- /dev/null
+++ b/src/code/early-float.lisp
@@ -0,0 +1,183 @@
+;;;; This file contains the definitions of float-specific number
+;;;; support (other than irrational stuff, which is in irrat.) There is
+;;;; code in here that assumes there are only two float formats: IEEE
+;;;; single and double. (LONG-FLOAT support has been added, but bugs
+;;;; may still remain due to old code which assumes this dichotomy.)
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package "SB!KERNEL")
+\f
+;;;; utilities
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+;;; These functions let us create floats from bits with the
+;;; significand uniformly represented as an integer. This is less
+;;; efficient for double floats, but is more convenient when making
+;;; special values, etc.
+(defun single-from-bits (sign exp sig)
+  (declare (type bit sign) (type (unsigned-byte 24) sig)
+          (type (unsigned-byte 8) exp))
+  (make-single-float
+   (dpb exp sb!vm:single-float-exponent-byte
+       (dpb sig sb!vm:single-float-significand-byte
+            (if (zerop sign) 0 -1)))))
+(defun double-from-bits (sign exp sig)
+  (declare (type bit sign) (type (unsigned-byte 53) sig)
+          (type (unsigned-byte 11) exp))
+  (make-double-float (dpb exp sb!vm:double-float-exponent-byte
+                         (dpb (ash sig -32)
+                              sb!vm:double-float-significand-byte
+                              (if (zerop sign) 0 -1)))
+                    (ldb (byte 32 0) sig)))
+#!+(and long-float x86)
+(defun long-from-bits (sign exp sig)
+  (declare (type bit sign) (type (unsigned-byte 64) sig)
+          (type (unsigned-byte 15) exp))
+  (make-long-float (logior (ash sign 15) exp)
+                  (ldb (byte 32 32) sig)
+                  (ldb (byte 32 0) sig)))
+
+) ; EVAL-WHEN
+\f
+;;;; float parameters
+
+(defconstant least-positive-single-float (single-from-bits 0 0 1))
+(defconstant least-positive-short-float (single-from-bits 0 0 1))
+(defconstant least-negative-single-float (single-from-bits 1 0 1))
+(defconstant least-negative-short-float (single-from-bits 1 0 1))
+(defconstant least-positive-double-float (double-from-bits 0 0 1))
+#!-long-float
+(defconstant least-positive-long-float (double-from-bits 0 0 1))
+#!+(and long-float x86)
+(defconstant least-positive-long-float (long-from-bits 0 0 1))
+(defconstant least-negative-double-float (double-from-bits 1 0 1))
+#!-long-float
+(defconstant least-negative-long-float (double-from-bits 1 0 1))
+#!+(and long-float x86)
+(defconstant least-negative-long-float (long-from-bits 1 0 1))
+
+(defconstant least-positive-normalized-single-float
+  (single-from-bits 0 sb!vm:single-float-normal-exponent-min 0))
+(defconstant least-positive-normalized-short-float
+  least-positive-normalized-single-float)
+(defconstant least-negative-normalized-single-float
+  (single-from-bits 1 sb!vm:single-float-normal-exponent-min 0))
+(defconstant least-negative-normalized-short-float
+  least-negative-normalized-single-float)
+(defconstant least-positive-normalized-double-float
+  (double-from-bits 0 sb!vm:double-float-normal-exponent-min 0))
+#!-long-float
+(defconstant least-positive-normalized-long-float
+  least-positive-normalized-double-float)
+#!+(and long-float x86)
+(defconstant least-positive-normalized-long-float
+  (long-from-bits 0 sb!vm:long-float-normal-exponent-min
+                 (ash sb!vm:long-float-hidden-bit 32)))
+(defconstant least-negative-normalized-double-float
+  (double-from-bits 1 sb!vm:double-float-normal-exponent-min 0))
+#!-long-float
+(defconstant least-negative-normalized-long-float
+  least-negative-normalized-double-float)
+#!+(and long-float x86)
+(defconstant least-negative-normalized-long-float
+  (long-from-bits 1 sb!vm:long-float-normal-exponent-min
+                 (ash sb!vm:long-float-hidden-bit 32)))
+
+(defconstant most-positive-single-float
+  (single-from-bits 0 sb!vm:single-float-normal-exponent-max
+                   (ldb sb!vm:single-float-significand-byte -1)))
+(defconstant most-positive-short-float most-positive-single-float)
+(defconstant most-negative-single-float
+  (single-from-bits 1 sb!vm:single-float-normal-exponent-max
+                   (ldb sb!vm:single-float-significand-byte -1)))
+(defconstant most-negative-short-float most-negative-single-float)
+(defconstant most-positive-double-float
+  (double-from-bits 0 sb!vm:double-float-normal-exponent-max
+                   (ldb (byte sb!vm:double-float-digits 0) -1)))
+#!-long-float
+(defconstant most-positive-long-float most-positive-double-float)
+#!+(and long-float x86)
+(defconstant most-positive-long-float
+  (long-from-bits 0 sb!vm:long-float-normal-exponent-max
+                 (ldb (byte sb!vm:long-float-digits 0) -1)))
+(defconstant most-negative-double-float
+  (double-from-bits 1 sb!vm:double-float-normal-exponent-max
+                   (ldb (byte sb!vm:double-float-digits 0) -1)))
+#!-long-float
+(defconstant most-negative-long-float most-negative-double-float)
+#!+(and long-float x86)
+(defconstant most-negative-long-float
+  (long-from-bits 1 sb!vm:long-float-normal-exponent-max
+                 (ldb (byte sb!vm:long-float-digits 0) -1)))
+
+;;; We don't want to do these DEFCONSTANTs at cross-compilation time,
+;;; because the cross-compilation host might not support floating
+;;; point infinities. Putting them inside a LET removes
+;;; toplevel-formness, so that any EVAL-WHEN trickiness in the
+;;; DEFCONSTANT forms is suppressed.
+;;;
+;;; Note that it might be worth performing a similar MAKE-LOAD-FORM
+;;; trick as with -0.0 (see the UNPORTABLE-FLOAT structure).  CSR,
+;;; 2004-03-09
+(let ()
+(defconstant single-float-positive-infinity
+  (single-from-bits 0 (1+ sb!vm:single-float-normal-exponent-max) 0))
+(defconstant short-float-positive-infinity
+  (single-from-bits 0 (1+ sb!vm:single-float-normal-exponent-max) 0))
+(defconstant single-float-negative-infinity
+  (single-from-bits 1 (1+ sb!vm:single-float-normal-exponent-max) 0))
+(defconstant short-float-negative-infinity
+  (single-from-bits 1 (1+ sb!vm:single-float-normal-exponent-max) 0))
+(defconstant double-float-positive-infinity
+  (double-from-bits 0 (1+ sb!vm:double-float-normal-exponent-max) 0))
+#!+(not long-float)
+(defconstant long-float-positive-infinity
+  (double-from-bits 0 (1+ sb!vm:double-float-normal-exponent-max) 0))
+#!+(and long-float x86)
+(defconstant long-float-positive-infinity
+  (long-from-bits 0 (1+ sb!vm:long-float-normal-exponent-max)
+                 (ash sb!vm:long-float-hidden-bit 32)))
+(defconstant double-float-negative-infinity
+  (double-from-bits 1 (1+ sb!vm:double-float-normal-exponent-max) 0))
+#!+(not long-float)
+(defconstant long-float-negative-infinity
+  (double-from-bits 1 (1+ sb!vm:double-float-normal-exponent-max) 0))
+#!+(and long-float x86)
+(defconstant long-float-negative-infinity
+  (long-from-bits 1 (1+ sb!vm:long-float-normal-exponent-max)
+                 (ash sb!vm:long-float-hidden-bit 32)))
+) ; LET-to-suppress-possible-EVAL-WHENs
+
+(defconstant single-float-epsilon
+  (single-from-bits 0 (- sb!vm:single-float-bias
+                        (1- sb!vm:single-float-digits)) 1))
+(defconstant short-float-epsilon single-float-epsilon)
+(defconstant single-float-negative-epsilon
+  (single-from-bits 0 (- sb!vm:single-float-bias sb!vm:single-float-digits) 1))
+(defconstant short-float-negative-epsilon single-float-negative-epsilon)
+(defconstant double-float-epsilon
+  (double-from-bits 0 (- sb!vm:double-float-bias
+                        (1- sb!vm:double-float-digits)) 1))
+#!-long-float
+(defconstant long-float-epsilon double-float-epsilon)
+#!+(and long-float x86)
+(defconstant long-float-epsilon
+  (long-from-bits 0 (- sb!vm:long-float-bias (1- sb!vm:long-float-digits))
+                 (+ 1 (ash sb!vm:long-float-hidden-bit 32))))
+(defconstant double-float-negative-epsilon
+  (double-from-bits 0 (- sb!vm:double-float-bias sb!vm:double-float-digits) 1))
+#!-long-float
+(defconstant long-float-negative-epsilon double-float-negative-epsilon)
+#!+(and long-float x86)
+(defconstant long-float-negative-epsilon
+  (long-from-bits 0 (- sb!vm:long-float-bias sb!vm:long-float-digits)
+                 (+ 1 (ash sb!vm:long-float-hidden-bit 32))))

diff --git a/src/code/early-impl.lisp b/src/code/early-impl.lisp
index f533cf7..84fdee8 100644 (file)
--- a/src/code/early-impl.lisp
+++ b/src/code/early-impl.lisp
@@ -19,8 +19,8 @@
                  *read-only-space-free-pointer*
                  sb!vm:*static-space-free-pointer*
                  sb!vm:*initial-dynamic-space-free-pointer*
                  *read-only-space-free-pointer*
                  sb!vm:*static-space-free-pointer*
                  sb!vm:*initial-dynamic-space-free-pointer*

-                 *current-catch-block*
-                 *current-unwind-protect-block*
+                 sb!vm::*current-catch-block*
+                 sb!vm::*current-unwind-protect-block*

                  sb!vm::*alien-stack*
                  #!+sb-thread sb!thread::*foreground-thread-stack*
                  sb!vm::*control-stack-start*
                  sb!vm::*alien-stack*
                  #!+sb-thread sb!thread::*foreground-thread-stack*
                  sb!vm::*control-stack-start*

diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp
index 53137ba..6f34191 100644 (file)
--- a/src/code/early-type.lisp
+++ b/src/code/early-type.lisp
@@ -11,10 +11,6 @@
 
 (!begin-collecting-cold-init-forms)
 
 
 (!begin-collecting-cold-init-forms)
 

-;;; Has the type system been properly initialized? (I.e. is it OK to
-;;; use it?)
-(defvar *type-system-initialized* #+sb-xc-host nil) ; (set in cold load)
-\f

 ;;;; representations of types
 
 ;;; A HAIRY-TYPE represents anything too weird to be described
 ;;;; representations of types
 
 ;;; A HAIRY-TYPE represents anything too weird to be described

diff --git a/src/code/float.lisp b/src/code/float.lisp
index 6f46ab2..d5ea0b9 100644 (file)
--- a/src/code/float.lisp
+++ b/src/code/float.lisp
@@ -15,165 +15,6 @@
 
 (in-package "SB!KERNEL")
 \f
 
 (in-package "SB!KERNEL")
 \f

-;;;; utilities
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-
-;;; These functions let us create floats from bits with the
-;;; significand uniformly represented as an integer. This is less
-;;; efficient for double floats, but is more convenient when making
-;;; special values, etc.
-(defun single-from-bits (sign exp sig)
-  (declare (type bit sign) (type (unsigned-byte 24) sig)
-          (type (unsigned-byte 8) exp))
-  (make-single-float
-   (dpb exp sb!vm:single-float-exponent-byte
-       (dpb sig sb!vm:single-float-significand-byte
-            (if (zerop sign) 0 -1)))))
-(defun double-from-bits (sign exp sig)
-  (declare (type bit sign) (type (unsigned-byte 53) sig)
-          (type (unsigned-byte 11) exp))
-  (make-double-float (dpb exp sb!vm:double-float-exponent-byte
-                         (dpb (ash sig -32)
-                              sb!vm:double-float-significand-byte
-                              (if (zerop sign) 0 -1)))
-                    (ldb (byte 32 0) sig)))
-#!+(and long-float x86)
-(defun long-from-bits (sign exp sig)
-  (declare (type bit sign) (type (unsigned-byte 64) sig)
-          (type (unsigned-byte 15) exp))
-  (make-long-float (logior (ash sign 15) exp)
-                  (ldb (byte 32 32) sig)
-                  (ldb (byte 32 0) sig)))
-
-) ; EVAL-WHEN
-\f
-;;;; float parameters
-
-(defconstant least-positive-single-float (single-from-bits 0 0 1))
-(defconstant least-positive-short-float (single-from-bits 0 0 1))
-(defconstant least-negative-single-float (single-from-bits 1 0 1))
-(defconstant least-negative-short-float (single-from-bits 1 0 1))
-(defconstant least-positive-double-float (double-from-bits 0 0 1))
-#!-long-float
-(defconstant least-positive-long-float (double-from-bits 0 0 1))
-#!+(and long-float x86)
-(defconstant least-positive-long-float (long-from-bits 0 0 1))
-(defconstant least-negative-double-float (double-from-bits 1 0 1))
-#!-long-float
-(defconstant least-negative-long-float (double-from-bits 1 0 1))
-#!+(and long-float x86)
-(defconstant least-negative-long-float (long-from-bits 1 0 1))
-
-(defconstant least-positive-normalized-single-float
-  (single-from-bits 0 sb!vm:single-float-normal-exponent-min 0))
-(defconstant least-positive-normalized-short-float
-  least-positive-normalized-single-float)
-(defconstant least-negative-normalized-single-float
-  (single-from-bits 1 sb!vm:single-float-normal-exponent-min 0))
-(defconstant least-negative-normalized-short-float
-  least-negative-normalized-single-float)
-(defconstant least-positive-normalized-double-float
-  (double-from-bits 0 sb!vm:double-float-normal-exponent-min 0))
-#!-long-float
-(defconstant least-positive-normalized-long-float
-  least-positive-normalized-double-float)
-#!+(and long-float x86)
-(defconstant least-positive-normalized-long-float
-  (long-from-bits 0 sb!vm:long-float-normal-exponent-min
-                 (ash sb!vm:long-float-hidden-bit 32)))
-(defconstant least-negative-normalized-double-float
-  (double-from-bits 1 sb!vm:double-float-normal-exponent-min 0))
-#!-long-float
-(defconstant least-negative-normalized-long-float
-  least-negative-normalized-double-float)
-#!+(and long-float x86)
-(defconstant least-negative-normalized-long-float
-  (long-from-bits 1 sb!vm:long-float-normal-exponent-min
-                 (ash sb!vm:long-float-hidden-bit 32)))
-
-(defconstant most-positive-single-float
-  (single-from-bits 0 sb!vm:single-float-normal-exponent-max
-                   (ldb sb!vm:single-float-significand-byte -1)))
-(defconstant most-positive-short-float most-positive-single-float)
-(defconstant most-negative-single-float
-  (single-from-bits 1 sb!vm:single-float-normal-exponent-max
-                   (ldb sb!vm:single-float-significand-byte -1)))
-(defconstant most-negative-short-float most-negative-single-float)
-(defconstant most-positive-double-float
-  (double-from-bits 0 sb!vm:double-float-normal-exponent-max
-                   (ldb (byte sb!vm:double-float-digits 0) -1)))
-#!-long-float
-(defconstant most-positive-long-float most-positive-double-float)
-#!+(and long-float x86)
-(defconstant most-positive-long-float
-  (long-from-bits 0 sb!vm:long-float-normal-exponent-max
-                 (ldb (byte sb!vm:long-float-digits 0) -1)))
-(defconstant most-negative-double-float
-  (double-from-bits 1 sb!vm:double-float-normal-exponent-max
-                   (ldb (byte sb!vm:double-float-digits 0) -1)))
-#!-long-float
-(defconstant most-negative-long-float most-negative-double-float)
-#!+(and long-float x86)
-(defconstant most-negative-long-float
-  (long-from-bits 1 sb!vm:long-float-normal-exponent-max
-                 (ldb (byte sb!vm:long-float-digits 0) -1)))
-
-;;; We don't want to do these DEFCONSTANTs at cross-compilation time,
-;;; because the cross-compilation host might not support floating
-;;; point infinities. Putting them inside a LET removes
-;;; toplevel-formness, so that any EVAL-WHEN trickiness in the
-;;; DEFCONSTANT forms is suppressed.
-(let ()
-(defconstant single-float-positive-infinity
-  (single-from-bits 0 (1+ sb!vm:single-float-normal-exponent-max) 0))
-(defconstant short-float-positive-infinity single-float-positive-infinity)
-(defconstant single-float-negative-infinity
-  (single-from-bits 1 (1+ sb!vm:single-float-normal-exponent-max) 0))
-(defconstant short-float-negative-infinity single-float-negative-infinity)
-(defconstant double-float-positive-infinity
-  (double-from-bits 0 (1+ sb!vm:double-float-normal-exponent-max) 0))
-#!+(not long-float)
-(defconstant long-float-positive-infinity double-float-positive-infinity)
-#!+(and long-float x86)
-(defconstant long-float-positive-infinity
-  (long-from-bits 0 (1+ sb!vm:long-float-normal-exponent-max)
-                 (ash sb!vm:long-float-hidden-bit 32)))
-(defconstant double-float-negative-infinity
-  (double-from-bits 1 (1+ sb!vm:double-float-normal-exponent-max) 0))
-#!+(not long-float)
-(defconstant long-float-negative-infinity double-float-negative-infinity)
-#!+(and long-float x86)
-(defconstant long-float-negative-infinity
-  (long-from-bits 1 (1+ sb!vm:long-float-normal-exponent-max)
-                 (ash sb!vm:long-float-hidden-bit 32)))
-) ; LET-to-suppress-possible-EVAL-WHENs
-
-(defconstant single-float-epsilon
-  (single-from-bits 0 (- sb!vm:single-float-bias
-                        (1- sb!vm:single-float-digits)) 1))
-(defconstant short-float-epsilon single-float-epsilon)
-(defconstant single-float-negative-epsilon
-  (single-from-bits 0 (- sb!vm:single-float-bias sb!vm:single-float-digits) 1))
-(defconstant short-float-negative-epsilon single-float-negative-epsilon)
-(defconstant double-float-epsilon
-  (double-from-bits 0 (- sb!vm:double-float-bias
-                        (1- sb!vm:double-float-digits)) 1))
-#!-long-float
-(defconstant long-float-epsilon double-float-epsilon)
-#!+(and long-float x86)
-(defconstant long-float-epsilon
-  (long-from-bits 0 (- sb!vm:long-float-bias (1- sb!vm:long-float-digits))
-                 (+ 1 (ash sb!vm:long-float-hidden-bit 32))))
-(defconstant double-float-negative-epsilon
-  (double-from-bits 0 (- sb!vm:double-float-bias sb!vm:double-float-digits) 1))
-#!-long-float
-(defconstant long-float-negative-epsilon double-float-negative-epsilon)
-#!+(and long-float x86)
-(defconstant long-float-negative-epsilon
-  (long-from-bits 0 (- sb!vm:long-float-bias sb!vm:long-float-digits)
-                 (+ 1 (ash sb!vm:long-float-hidden-bit 32))))
-\f

 ;;;; float predicates and environment query
 
 #!-sb-fluid
 ;;;; float predicates and environment query
 
 #!-sb-fluid

@@ -671,8 +512,12 @@
             :operands (list x exp)))
     (* (float-sign x)
        (etypecase x
             :operands (list x exp)))
     (* (float-sign x)
        (etypecase x

-        (single-float single-float-positive-infinity)
-        (double-float double-float-positive-infinity))))))
+        (single-float
+         ;; SINGLE-FLOAT-POSITIVE-INFINITY
+         (single-from-bits 0 (1+ sb!vm:single-float-normal-exponent-max) 0))
+        (double-float
+         ;; DOUBLE-FLOAT-POSITIVE-INFINITY
+         (double-from-bits 0 (1+ sb!vm:double-float-normal-exponent-max) 0)))))))

 
 ;;; Scale a single or double float, calling the correct over/underflow
 ;;; functions.
 
 ;;; Scale a single or double float, calling the correct over/underflow
 ;;; functions.

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index 10f4bce..1a221d6 100644 (file)
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -152,12 +152,6 @@ and submit it as a patch."
   The functions are run with interrupts disabled and all other threads
   paused.  They should take no arguments.")
 
   The functions are run with interrupts disabled and all other threads
   paused.  They should take no arguments.")
 

-(defvar *gc-run-time* 0
-  #!+sb-doc
-  "the total CPU time spent doing garbage collection (as reported by
-   GET-INTERNAL-RUN-TIME)")
-(declaim (type index *gc-run-time*))
-

 ;;;; The following specials are used to control when garbage
 ;;;; collection occurs.
 
 ;;;; The following specials are used to control when garbage
 ;;;; collection occurs.
 

diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index c22fd93..f2947a7 100644 (file)
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -637,7 +637,9 @@
 ;;; they're effectively implemented as special variable references,
 ;;; and the code below which uses them might be unnecessarily
 ;;; inefficient. Perhaps some sort of MAKE-LOAD-TIME-VALUE hackery
 ;;; they're effectively implemented as special variable references,
 ;;; and the code below which uses them might be unnecessarily
 ;;; inefficient. Perhaps some sort of MAKE-LOAD-TIME-VALUE hackery

-;;; should be used instead?
+;;; should be used instead?  (KLUDGED 2004-03-08 CSR, by replacing the
+;;; special variable references with (probably equally slow)
+;;; constructors)

 
 (declaim (inline square))
 (defun square (x)
 
 (declaim (inline square))
 (defun square (x)

@@ -681,7 +683,8 @@
   (cond ((float-nan-p x)
         x)
        ((float-infinity-p x)
   (cond ((float-nan-p x)
         x)
        ((float-infinity-p x)

-        sb!ext:double-float-positive-infinity)
+        ;; DOUBLE-FLOAT-POSITIVE-INFINITY
+        (double-from-bits 0 (1+ sb!vm:double-float-normal-exponent-max) 0))

        ((zerop x)
         ;; The answer is negative infinity, but we are supposed to
           ;; signal divide-by-zero, so do the actual division
        ((zerop x)
         ;; The answer is negative infinity, but we are supposed to
           ;; signal divide-by-zero, so do the actual division

@@ -727,7 +730,10 @@
                      (float-infinity-p rho))
                  (or (float-infinity-p (abs x))
                      (float-infinity-p (abs y))))
                      (float-infinity-p rho))
                  (or (float-infinity-p (abs x))
                      (float-infinity-p (abs y))))

-              (values sb!ext:double-float-positive-infinity 0))
+            ;; DOUBLE-FLOAT-POSITIVE-INFINITY
+            (values
+             (double-from-bits 0 (1+ sb!vm:double-float-normal-exponent-max) 0)
+             0))

            ((let ((threshold #.(/ least-positive-double-float
                                   double-float-epsilon))
                   (traps (ldb sb!vm::float-sticky-bits
            ((let ((threshold #.(/ least-positive-double-float
                                   double-float-epsilon))
                   (traps (ldb sb!vm::float-sticky-bits

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index ff45e57..0c920c7 100644 (file)
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -1031,11 +1031,6 @@
 
 (!define-type-class named)
 
 
 (!define-type-class named)
 

-(defvar *wild-type*)
-(defvar *empty-type*)
-(defvar *universal-type*)
-(defvar *universal-fun-type*)
-

 (!cold-init-forms
  (macrolet ((frob (name var)
              `(progn
 (!cold-init-forms
  (macrolet ((frob (name var)
              `(progn

diff --git a/src/code/primordial-type.lisp b/src/code/primordial-type.lisp
new file mode 100644 (file)
index 0000000..b6420d7
--- /dev/null
+++ b/src/code/primordial-type.lisp
@@ -0,0 +1,24 @@
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package "SB!KERNEL")
+
+;;; Has the type system been properly initialized? (I.e. is it OK to
+;;; use it?)
+(defvar *type-system-initialized* #+sb-xc-host nil) ; (set in cold load)
+
+(defvar *wild-type*)
+(defvar *empty-type*)
+(defvar *universal-type*)
+(defvar *universal-fun-type*)
+
+;;; a vector that maps type codes to layouts, used for quickly finding
+;;; the layouts of built-in classes
+(defvar *built-in-class-codes*) ; initialized in cold load
+(declaim (type simple-vector *built-in-class-codes*))

diff --git a/src/code/time.lisp b/src/code/time.lisp
index e467daf..667a0ce 100644 (file)
--- a/src/code/time.lisp
+++ b/src/code/time.lisp
@@ -286,6 +286,12 @@
 \f
 ;;;; TIME
 
 \f
 ;;;; TIME
 

+(defvar *gc-run-time* 0
+  #!+sb-doc
+  "the total CPU time spent doing garbage collection (as reported by
+   GET-INTERNAL-RUN-TIME)")
+(declaim (type index *gc-run-time*))
+

 (defmacro time (form)
   #!+sb-doc
   "Execute FORM and print timing information on *TRACE-OUTPUT*."
 (defmacro time (form)
   #!+sb-doc
   "Execute FORM and print timing information on *TRACE-OUTPUT*."

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index acf013e..d1d5daa 100644 (file)
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -18,8 +18,8 @@
 ;;; FIXME: The DEFVAR here is redundant with the (DECLAIM (SPECIAL ..))
 ;;; of all static symbols in early-impl.lisp.
 (progn
 ;;; FIXME: The DEFVAR here is redundant with the (DECLAIM (SPECIAL ..))
 ;;; of all static symbols in early-impl.lisp.
 (progn

-  (defvar *current-catch-block*)
-  (defvar *current-unwind-protect-block*)
+  (defvar sb!vm::*current-catch-block*)
+  (defvar sb!vm::*current-unwind-protect-block*)

   (defvar *free-interrupt-context-index*))
 \f
 ;;; specials initialized by !COLD-INIT
   (defvar *free-interrupt-context-index*))
 \f
 ;;; specials initialized by !COLD-INIT

@@ -409,7 +409,7 @@
             ;; USERINITish files
              (probe-init-files (explicitly-specified-init-file-name
                                &rest default-init-file-names)
             ;; USERINITish files
              (probe-init-files (explicitly-specified-init-file-name
                                &rest default-init-file-names)

-               (declare (type list possible-init-file-names))
+               (declare (type list default-init-file-names))

               (if explicitly-specified-init-file-name
                   (or (probe-file explicitly-specified-init-file-name)
                         (startup-error "The file ~S was not found."
               (if explicitly-specified-init-file-name
                   (or (probe-file explicitly-specified-init-file-name)
                         (startup-error "The file ~S was not found."

diff --git a/src/compiler/backend.lisp b/src/compiler/backend.lisp
index cf140b1..afc2e50 100644 (file)
--- a/src/compiler/backend.lisp
+++ b/src/compiler/backend.lisp
@@ -133,10 +133,6 @@
 ;;; they haven't been installed yet
 (defvar *backend-internal-errors* nil)
 (declaim (type (or simple-vector null) *backend-internal-errors*))
 ;;; they haven't been installed yet
 (defvar *backend-internal-errors* nil)
 (declaim (type (or simple-vector null) *backend-internal-errors*))

-
-;;; the maximum number of bytes per page on this system (used by GENESIS)
-(defvar *backend-page-size* 0)
-(declaim (type index *backend-page-size*))

 \f
 ;;;; VM support routines
 
 \f
 ;;;; VM support routines
 

diff --git a/src/compiler/early-backend.lisp b/src/compiler/early-backend.lisp
new file mode 100644 (file)
index 0000000..54baf6d
--- /dev/null
+++ b/src/compiler/early-backend.lisp
@@ -0,0 +1,14 @@
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package "SB!C")
+\f
+;;; the maximum number of bytes per page on this system (used by GENESIS)
+(defvar *backend-page-size* 0)
+(declaim (type index *backend-page-size*))

diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp
index f3c7319..6b793b7 100644 (file)
--- a/src/compiler/early-c.lisp
+++ b/src/compiler/early-c.lisp
@@ -116,6 +116,11 @@
 (defvar *undefined-warnings*)
 (defvar *warnings-p*)
 
 (defvar *undefined-warnings*)
 (defvar *warnings-p*)
 

+;;; This lock is seized in the compiler, and related areas: the
+;;; compiler is not presently thread-safe
+(defvar *big-compiler-lock*
+  (sb!thread:make-mutex :name "big compiler lock"))
+

 ;;; unique ID for the next object created (to let us track object
 ;;; identity even across GC, useful for understanding weird compiler
 ;;; bugs where something is supposed to be unique but is instead
 ;;; unique ID for the next object created (to let us track object
 ;;; identity even across GC, useful for understanding weird compiler
 ;;; bugs where something is supposed to be unique but is instead

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index fce01cf..301d162 100644 (file)
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -1272,8 +1272,8 @@
     (frob sb!di::handle-fun-end-breakpoint)
     (frob sb!thread::handle-thread-exit))
 
     (frob sb!di::handle-fun-end-breakpoint)
     (frob sb!thread::handle-thread-exit))
 

-  (cold-set '*current-catch-block*          (make-fixnum-descriptor 0))
-  (cold-set '*current-unwind-protect-block* (make-fixnum-descriptor 0))
+  (cold-set 'sb!vm::*current-catch-block*          (make-fixnum-descriptor 0))
+  (cold-set 'sb!vm::*current-unwind-protect-block* (make-fixnum-descriptor 0))

 
   (cold-set '*free-interrupt-context-index* (make-fixnum-descriptor 0))
 
 
   (cold-set '*free-interrupt-context-index* (make-fixnum-descriptor 0))
 

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 137f74d..06067d1 100644 (file)
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -91,11 +91,6 @@
 ;;; normally causes nested uses to be no-ops).
 (defvar *in-compilation-unit* nil)
 
 ;;; normally causes nested uses to be no-ops).
 (defvar *in-compilation-unit* nil)
 

-;;; This lock is siezed in the same situation: the compiler is not
-;;; presently thread-safe
-(defvar *big-compiler-lock*
-  (sb!thread:make-mutex :name "big compiler lock"))
-

 ;;; Count of the number of compilation units dynamically enclosed by
 ;;; the current active WITH-COMPILATION-UNIT that were unwound out of.
 (defvar *aborted-compilation-unit-count*)
 ;;; Count of the number of compilation units dynamically enclosed by
 ;;; the current active WITH-COMPILATION-UNIT that were unwound out of.
 (defvar *aborted-compilation-unit-count*)

@@ -205,23 +200,34 @@
                        defined later, the code doing so would not be ~
                        portable.~:@>"
                      kind name)))
                        defined later, the code doing so would not be ~
                        portable.~:@>"
                      kind name)))

-                  (compiler-style-warn "undefined ~(~A~): ~S" kind name)))
+                 (if (eq kind :variable)
+                     (compiler-warn "undefined ~(~A~): ~S" kind name)
+                     (compiler-style-warn "undefined ~(~A~): ~S" kind name))))

            (let ((warn-count (length warnings)))
              (when (and warnings (> undefined-warning-count warn-count))
                (let ((more (- undefined-warning-count warn-count)))
            (let ((warn-count (length warnings)))
              (when (and warnings (> undefined-warning-count warn-count))
                (let ((more (- undefined-warning-count warn-count)))

-                 (compiler-style-warn
-                  "~W more use~:P of undefined ~(~A~) ~S"
-                  more kind name))))))
+                 (if (eq kind :variable)
+                     (compiler-warn
+                      "~W more use~:P of undefined ~(~A~) ~S"
+                      more kind name)
+                     (compiler-style-warn
+                      "~W more use~:P of undefined ~(~A~) ~S"
+                      more kind name)))))))

 
        (dolist (kind '(:variable :function :type))
          (let ((summary (mapcar #'undefined-warning-name
                                 (remove kind undefs :test-not #'eq
                                         :key #'undefined-warning-kind))))
            (when summary
 
        (dolist (kind '(:variable :function :type))
          (let ((summary (mapcar #'undefined-warning-name
                                 (remove kind undefs :test-not #'eq
                                         :key #'undefined-warning-kind))))
            (when summary

-             (compiler-style-warn
-              "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
-               ~%  ~{~<~%  ~1:;~S~>~^ ~}"
-              (cdr summary) kind summary)))))))
+             (if (eq kind :variable)
+                 (compiler-warn
+                  "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
+                   ~%  ~{~<~%  ~1:;~S~>~^ ~}"
+                  (cdr summary) kind summary)
+                 (compiler-style-warn
+                  "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
+                  ~%  ~{~<~%  ~1:;~S~>~^ ~}"
+                  (cdr summary) kind summary))))))))

 
   (unless (and (not abort-p)
               (zerop *aborted-compilation-unit-count*)
 
   (unless (and (not abort-p)
               (zerop *aborted-compilation-unit-count*)

diff --git a/src/pcl/combin.lisp b/src/pcl/combin.lisp
index 54306ca..31141b4 100644 (file)
--- a/src/pcl/combin.lisp
+++ b/src/pcl/combin.lisp
@@ -358,6 +358,8 @@
 (defun gf-requires-emf-keyword-checks (generic-function)
   (member '&key (gf-lambda-list generic-function)))
 
 (defun gf-requires-emf-keyword-checks (generic-function)
   (member '&key (gf-lambda-list generic-function)))
 

+(defvar *in-precompute-effective-methods-p* nil)
+

 (defun standard-compute-effective-method
     (generic-function combin applicable-methods)
   (collect ((before) (primary) (after) (around))
 (defun standard-compute-effective-method
     (generic-function combin applicable-methods)
   (collect ((before) (primary) (after) (around))

diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp
index 84811bd..d78d02c 100644 (file)
--- a/src/pcl/defs.lisp
+++ b/src/pcl/defs.lisp
@@ -83,51 +83,6 @@
   (parse-gspec spec
     (name (fdefine-carefully name new-value))))
 \f
   (parse-gspec spec
     (name (fdefine-carefully name new-value))))
 \f

-(declaim (special *the-class-t*
-                 *the-class-vector* *the-class-symbol*
-                 *the-class-string* *the-class-sequence*
-                 *the-class-rational* *the-class-ratio*
-                 *the-class-number* *the-class-null* *the-class-list*
-                 *the-class-integer* *the-class-float* *the-class-cons*
-                 *the-class-complex* *the-class-character*
-                 *the-class-bit-vector* *the-class-array*
-                 *the-class-stream*
-
-                 *the-class-slot-object*
-                 *the-class-structure-object*
-                 *the-class-std-object*
-                 *the-class-standard-object*
-                 *the-class-funcallable-standard-object*
-                 *the-class-class*
-                 *the-class-generic-function*
-                 *the-class-built-in-class*
-                 *the-class-slot-class*
-                 *the-class-condition-class*
-                 *the-class-structure-class*
-                 *the-class-std-class*
-                 *the-class-standard-class*
-                 *the-class-funcallable-standard-class*
-                 *the-class-method*
-                 *the-class-standard-method*
-                 *the-class-standard-reader-method*
-                 *the-class-standard-writer-method*
-                 *the-class-standard-boundp-method*
-                 *the-class-standard-generic-function*
-                 *the-class-standard-effective-slot-definition*
-
-                 *the-eslotd-standard-class-slots*
-                 *the-eslotd-funcallable-standard-class-slots*))
-
-(declaim (special *the-wrapper-of-t*
-                 *the-wrapper-of-vector* *the-wrapper-of-symbol*
-                 *the-wrapper-of-string* *the-wrapper-of-sequence*
-                 *the-wrapper-of-rational* *the-wrapper-of-ratio*
-                 *the-wrapper-of-number* *the-wrapper-of-null*
-                 *the-wrapper-of-list* *the-wrapper-of-integer*
-                 *the-wrapper-of-float* *the-wrapper-of-cons*
-                 *the-wrapper-of-complex* *the-wrapper-of-character*
-                 *the-wrapper-of-bit-vector* *the-wrapper-of-array*))
-\f

 ;;;; type specifier hackery
 
 ;;; internal to this file
 ;;;; type specifier hackery
 
 ;;; internal to this file

diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp
index 5723f6c..6337b61 100644 (file)
--- a/src/pcl/dfun.lisp
+++ b/src/pcl/dfun.lisp
@@ -1476,9 +1476,7 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
                        (return (setf (third c) t))))
              (return nil))))))
 
                        (return (setf (third c) t))))
              (return nil))))))
 

-(defvar *in-precompute-effective-methods-p* nil)
-
-;used only in map-all-orders
+;;; CMUCL comment: used only in map-all-orders

 (defun class-might-precede-p (class1 class2)
   (if (not *in-precompute-effective-methods-p*)
       (not (member class1 (cdr (class-precedence-list class2))))
 (defun class-might-precede-p (class1 class2)
   (if (not *in-precompute-effective-methods-p*)
       (not (member class1 (cdr (class-precedence-list class2))))

diff --git a/src/pcl/early-low.lisp b/src/pcl/early-low.lisp
index abca534..5db39e8 100644 (file)
--- a/src/pcl/early-low.lisp
+++ b/src/pcl/early-low.lisp
@@ -64,4 +64,49 @@
   (and (symbolp type)
        (condition-classoid-p (find-classoid type nil))))
 \f
   (and (symbolp type)
        (condition-classoid-p (find-classoid type nil))))
 \f

+(declaim (special *the-class-t*
+                 *the-class-vector* *the-class-symbol*
+                 *the-class-string* *the-class-sequence*
+                 *the-class-rational* *the-class-ratio*
+                 *the-class-number* *the-class-null* *the-class-list*
+                 *the-class-integer* *the-class-float* *the-class-cons*
+                 *the-class-complex* *the-class-character*
+                 *the-class-bit-vector* *the-class-array*
+                 *the-class-stream*
+
+                 *the-class-slot-object*
+                 *the-class-structure-object*
+                 *the-class-std-object*
+                 *the-class-standard-object*
+                 *the-class-funcallable-standard-object*
+                 *the-class-class*
+                 *the-class-generic-function*
+                 *the-class-built-in-class*
+                 *the-class-slot-class*
+                 *the-class-condition-class*
+                 *the-class-structure-class*
+                 *the-class-std-class*
+                 *the-class-standard-class*
+                 *the-class-funcallable-standard-class*
+                 *the-class-method*
+                 *the-class-standard-method*
+                 *the-class-standard-reader-method*
+                 *the-class-standard-writer-method*
+                 *the-class-standard-boundp-method*
+                 *the-class-standard-generic-function*
+                 *the-class-standard-effective-slot-definition*
+
+                 *the-eslotd-standard-class-slots*
+                 *the-eslotd-funcallable-standard-class-slots*))
+
+(declaim (special *the-wrapper-of-t*
+                 *the-wrapper-of-vector* *the-wrapper-of-symbol*
+                 *the-wrapper-of-string* *the-wrapper-of-sequence*
+                 *the-wrapper-of-rational* *the-wrapper-of-ratio*
+                 *the-wrapper-of-number* *the-wrapper-of-null*
+                 *the-wrapper-of-list* *the-wrapper-of-integer*
+                 *the-wrapper-of-float* *the-wrapper-of-cons*
+                 *the-wrapper-of-complex* *the-wrapper-of-character*
+                 *the-wrapper-of-bit-vector* *the-wrapper-of-array*))
+\f

 (/show "finished with early-low.lisp")
 (/show "finished with early-low.lisp")

diff --git a/tests/compiler.test.sh b/tests/compiler.test.sh
index fd948bf..c7a4d57 100644 (file)
--- a/tests/compiler.test.sh
+++ b/tests/compiler.test.sh
@@ -151,6 +151,24 @@ cat > $tmpfilename <<EOF
 EOF
 expect_clean_compile $tmpfilename
 
 EOF
 expect_clean_compile $tmpfilename
 

+# undeclared unbound variables should cause a full warning, as they
+# invoke undefined behaviour
+cat > $tmpfilename <<EOF
+    (defun foo () x)
+EOF
+expect_failed_compile $tmpfilename
+
+cat > $tmpfilename <<EOF
+    (declaim (special *x*))
+    (defun foo () *x*)
+EOF
+expect_clean_compile $tmpfilename
+
+cat > $tmpfilename <<EOF
+    (defun foo () (declare (special x)) x)
+EOF
+expect_clean_compile $tmpfilename
+

 rm $tmpfilename
 rm $compiled_tmpfilename
 
 rm $tmpfilename
 rm $compiled_tmpfilename
 

diff --git a/version.lisp-expr b/version.lisp-expr
index 60cb633..5203d4e 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)

-"0.8.8.20"
+"0.8.8.21"