X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fearly-c.lisp;h=b313fcc4f34a54e3a9393c7d8784ca526a5299d8;hb=2378406d6eda78090dfe05e372438495aeace5e0;hp=877d2c8fc8eb61cfd4b27c0d2cd94886aff1e572;hpb=95f17ca63742f8c164309716b35bc25545a849a6;p=sbcl.git diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp index 877d2c8..b313fcc 100644 --- a/src/compiler/early-c.lisp +++ b/src/compiler/early-c.lisp @@ -93,6 +93,7 @@ (defvar *current-path*) (defvar *current-component*) (defvar *delayed-ir1-transforms*) +(defvar *eval-tlf-index*) (defvar *handled-conditions*) (defvar *disabled-package-locks*) (defvar *policy*) @@ -104,8 +105,15 @@ (defvar *fixup-notes*) (defvar *in-pack*) (defvar *info-environment*) +#!+inline-constants +(progn + (defvar *constant-segment*) + (defvar *constant-table*) + (defvar *constant-vector*)) (defvar *lexenv*) (defvar *source-info*) +(defvar *source-plist*) +(defvar *source-namestring*) (defvar *trace-table*) (defvar *undefined-warnings*) (defvar *warnings-p*) @@ -121,13 +129,13 @@ the stack without triggering overflow protection.") (!begin-collecting-cold-init-forms) ;;; This lock is seized in the compiler, and related areas -- like the ;;; classoid/layout/class system. -(defvar *world-lock*) +(defglobal **world-lock** nil) (!cold-init-forms - (setf *world-lock* (sb!thread:make-mutex :name "World Lock"))) + (setf **world-lock** (sb!thread:make-mutex :name "World Lock"))) (!defun-from-collected-cold-init-forms !world-lock-cold-init) (defmacro with-world-lock (() &body body) - `(sb!thread:with-recursive-lock (*world-lock*) + `(sb!thread:with-recursive-lock (**world-lock**) ,@body)) (declaim (type fixnum *compiler-sset-counter*)) @@ -180,7 +188,8 @@ the stack without triggering overflow protection.") ;; FIXME: should be COMPILER-STYLE-WARNING? (style-warn 'sb!kernel:asterisks-around-lexical-variable-name :format-control - "using the lexical binding of the symbol ~S, not the~@ + "using the lexical binding of the symbol ~ + ~/sb-impl::print-symbol-with-prefix/, not the~@ dynamic binding" :format-arguments (list symbol))) (values)) @@ -194,7 +203,7 @@ the stack without triggering overflow protection.") (defvar *debug-name-sharp*) (defvar *debug-name-ellipsis*) -(eval-when (:compile-toplevel :load-toplevel :execute) +(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) (defun dump-debug-name-marker (marker &optional env) (declare (ignore env)) (cond ((eq marker *debug-name-sharp*) @@ -221,7 +230,7 @@ the stack without triggering overflow protection.") (setf *debug-name-sharp* (make-debug-name-marker) *debug-name-ellipsis* (make-debug-name-marker)) -(defun debug-name (type thing) +(defun debug-name (type thing &optional context) (let ((*debug-name-punt* nil)) (labels ((walk (x) (typecase x @@ -248,7 +257,7 @@ the stack without triggering overflow protection.") x) (t (type-of x))))) - (let ((name (list type (walk thing)))) + (let ((name (list* type (walk thing) (when context (name-context))))) (when (legal-fun-name-p name) (bug "~S is a legal function name, and cannot be used as a ~ debug name." name))