From: Christophe Rhodes Date: Tue, 9 Mar 2004 12:08:39 +0000 (+0000) Subject: 0.8.8.21: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=2912f5f6c2acb2da3b9fcc0f5afd1ca89782a9f8;p=sbcl.git 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 --- 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) + * 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: diff --git a/build-order.lisp-expr b/build-order.lisp-expr index 17e290b..3b5b727 100644 --- 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-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/primordial-type") ("src/code/early-defbangmethod") ("src/code/defbangtype") @@ -159,6 +161,7 @@ ("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 @@ -188,7 +191,8 @@ ("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". @@ -443,7 +447,6 @@ ;; (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") diff --git a/src/code/class.lisp b/src/code/class.lisp index 14532ed..fd13983 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -1380,11 +1380,6 @@ 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* diff --git a/src/code/early-float.lisp b/src/code/early-float.lisp new file mode 100644 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") + +;;;; 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 + +;;;; 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 --- 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* - *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* diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp index 53137ba..6f34191 100644 --- a/src/code/early-type.lisp +++ b/src/code/early-type.lisp @@ -11,10 +11,6 @@ (!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) - ;;;; 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 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -15,165 +15,6 @@ (in-package "SB!KERNEL") -;;;; 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 - -;;;; 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)))) - ;;;; float predicates and environment query #!-sb-fluid @@ -671,8 +512,12 @@ :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. diff --git a/src/code/gc.lisp b/src/code/gc.lisp index 10f4bce..1a221d6 100644 --- 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.") -(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. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index c22fd93..f2947a7 100644 --- 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 -;;; 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) @@ -681,7 +683,8 @@ (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 @@ -727,7 +730,10 @@ (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 diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index ff45e57..0c920c7 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -1031,11 +1031,6 @@ (!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 diff --git a/src/code/primordial-type.lisp b/src/code/primordial-type.lisp new file mode 100644 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 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -286,6 +286,12 @@ ;;;; 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*." diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index acf013e..d1d5daa 100644 --- 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 - (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*)) ;;; specials initialized by !COLD-INIT @@ -409,7 +409,7 @@ ;; 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." diff --git a/src/compiler/backend.lisp b/src/compiler/backend.lisp index cf140b1..afc2e50 100644 --- 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*)) - -;;; the maximum number of bytes per page on this system (used by GENESIS) -(defvar *backend-page-size* 0) -(declaim (type index *backend-page-size*)) ;;;; VM support routines diff --git a/src/compiler/early-backend.lisp b/src/compiler/early-backend.lisp new file mode 100644 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") + +;;; 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 --- a/src/compiler/early-c.lisp +++ b/src/compiler/early-c.lisp @@ -116,6 +116,11 @@ (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 diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index fce01cf..301d162 100644 --- 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)) - (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)) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 137f74d..06067d1 100644 --- 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) -;;; 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*) @@ -205,23 +200,34 @@ 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))) - (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 - (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*) diff --git a/src/pcl/combin.lisp b/src/pcl/combin.lisp index 54306ca..31141b4 100644 --- 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))) +(defvar *in-precompute-effective-methods-p* nil) + (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 --- a/src/pcl/defs.lisp +++ b/src/pcl/defs.lisp @@ -83,51 +83,6 @@ (parse-gspec spec (name (fdefine-carefully name new-value)))) -(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*)) - ;;;; type specifier hackery ;;; internal to this file diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp index 5723f6c..6337b61 100644 --- 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)))))) -(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)))) diff --git a/src/pcl/early-low.lisp b/src/pcl/early-low.lisp index abca534..5db39e8 100644 --- 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)))) +(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*)) + (/show "finished with early-low.lisp") diff --git a/tests/compiler.test.sh b/tests/compiler.test.sh index fd948bf..c7a4d57 100644 --- a/tests/compiler.test.sh +++ b/tests/compiler.test.sh @@ -151,6 +151,24 @@ cat > $tmpfilename < $tmpfilename < $tmpfilename < $tmpfilename <