X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fearly-c.lisp;h=978284fccaeaeeae89980b0fbde3b4c5ea127cff;hb=127fd3d2fb843c6bb7ad0763e143d81877e760e8;hp=1e3f6162329ff0939b4e5ebb551183deb2edb3a1;hpb=b0b168c08b31a748150f404398af754f26fd4813;p=sbcl.git

diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp
index 1e3f616..978284f 100644
--- a/src/compiler/early-c.lisp
+++ b/src/compiler/early-c.lisp
@@ -16,16 +16,16 @@
 (in-package "SB!C")
 
 ;;; ANSI limits on compilation
-(defconstant sb!xc:call-arguments-limit most-positive-fixnum
+(def!constant sb!xc:call-arguments-limit sb!xc:most-positive-fixnum
   #!+sb-doc
   "The exclusive upper bound on the number of arguments which may be passed
   to a function, including &REST args.")
-(defconstant sb!xc:lambda-parameters-limit most-positive-fixnum
+(def!constant sb!xc:lambda-parameters-limit sb!xc:most-positive-fixnum
   #!+sb-doc
   "The exclusive upper bound on the number of parameters which may be specifed
   in a given lambda list. This is actually the limit on required and &OPTIONAL
   parameters. With &KEY and &AUX you can get more.")
-(defconstant sb!xc:multiple-values-limit most-positive-fixnum
+(def!constant sb!xc:multiple-values-limit sb!xc:most-positive-fixnum
   #!+sb-doc
   "The exclusive upper bound on the number of multiple VALUES that you can
   return.")
@@ -86,6 +86,12 @@
 (defvar *constants*)
 (declaim (type hash-table *constants*))
 
+;;; *ALLOW-INSTRUMENTING* controls whether we should allow the
+;;; insertion of instrumenting code (like a (CATCH ...)) around code
+;;; to allow the debugger RETURN and STEP commands to function (we
+;;; disallow it for internal stuff).
+(defvar *allow-instrumenting*)
+
 ;;; miscellaneous forward declarations
 (defvar *code-segment*)
 #!+sb-dyncount (defvar *collect-dynamic-statistics*)
@@ -101,13 +107,15 @@
 (defvar *current-path*)
 (defvar *current-component*)
 (defvar *delayed-ir1-transforms*)
+(defvar *handled-conditions*)
+(defvar *disabled-package-locks*)
 (defvar *policy*)
 (defvar *dynamic-counts-tn*)
 (defvar *elsewhere*)
 (defvar *event-info*)
 (defvar *event-note-threshold*)
 (defvar *failure-p*)
-(defvar *fixups*)
+(defvar *fixup-notes*)
 (defvar *in-pack*)
 (defvar *info-environment*)
 (defvar *lexenv*)
@@ -116,6 +124,14 @@
 (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"))
+
+(declaim (type fixnum *compiler-sset-counter*))
+(defvar *compiler-sset-counter* 0)
+
 ;;; 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
@@ -125,7 +141,7 @@
   (defvar *object-id-counter* 0)
   (defun new-object-id ()
     (prog1
-	*object-id-counter*
+        *object-id-counter*
       (incf *object-id-counter*))))
 
 ;;;; miscellaneous utilities
@@ -134,16 +150,16 @@
 ;;; benefit of the compiler, but it's sometimes called from stuff like
 ;;; type-defining code which isn't logically part of the compiler.
 (declaim (ftype (function ((or symbol cons) keyword) (values))
-		note-name-defined))
+                note-name-defined))
 (defun note-name-defined (name kind)
   ;; We do this BOUNDP check because this function can be called when
   ;; not in a compilation unit (as when loading top level forms).
   (when (boundp '*undefined-warnings*)
     (setq *undefined-warnings*
-	  (delete-if (lambda (x)
-		       (and (equal (undefined-warning-name x) name)
-			    (eq (undefined-warning-kind x) kind)))
-		     *undefined-warnings*)))
+          (delete-if (lambda (x)
+                       (and (equal (undefined-warning-name x) name)
+                            (eq (undefined-warning-kind x) kind)))
+                     *undefined-warnings*)))
   (values))
 
 ;;; to be called when a variable is lexically bound
@@ -160,8 +176,30 @@
     ;;         (FOO 14)))
     ;; and then we happen to compile bar.lisp before foo.lisp.
   (when (looks-like-name-of-special-var-p symbol)
-      ;; FIXME: should be COMPILER-STYLE-WARNING?
-      (style-warn "using the lexical binding of the symbol ~S, not the~@
+    ;; FIXME: should be COMPILER-STYLE-WARNING?
+    (style-warn "using the lexical binding of the symbol ~S, not the~@
 dynamic binding, even though the symbol name follows the usual naming~@
 convention (names like *FOO*) for special variables" symbol))
   (values))
+
+(defvar *debug-name-level* 6)
+
+(defun debug-name (type thing)
+  (labels ((walk (x level)
+             (if (> *debug-name-level* (incf level))
+                 (typecase x
+                   (cons
+                    (cons (walk (car x) level) (walk (cdr x) level)))
+                   ((or symbol number string)
+                    x)
+                   (t
+                    (list 'of-type (type-of x))))
+                 "#<...>")))
+    ;; FIXME: It might be nice to put markers in the tree instead of
+    ;; this #<...> business, so that they would evantually be printed
+    ;; without the quotes.
+    (let ((name (list type (walk thing 0))))
+      (when (legal-fun-name-p name)
+        (bug "~S is a legal function name, and cannot be used as a ~
+              debug name." name))
+      name)))