X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-extensions.lisp;h=e2950d6265868d2790f65c6bb600af148e1b868d;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=0d1febeece52465f2adcd48d7aa31621bf006a41;hpb=cccc20daac3d6d4e1086f387055aa0b6ff8f47d1;p=sbcl.git

diff --git a/src/code/late-extensions.lisp b/src/code/late-extensions.lisp
index 0d1febe..e2950d6 100644
--- a/src/code/late-extensions.lisp
+++ b/src/code/late-extensions.lisp
@@ -76,7 +76,7 @@
 (defmacro compare-and-swap (place old new &environment env)
   "Atomically stores NEW in PLACE if OLD matches the current value of PLACE.
 Two values are considered to match if they are EQ. Returns the previous value
-of PLACE: if the returned value if EQ to OLD, the swap was carried out.
+of PLACE: if the returned value is EQ to OLD, the swap was carried out.
 
 PLACE must be an accessor form whose CAR is one of the following:
 
@@ -108,7 +108,7 @@ EXPERIMENTAL: Interface subject to change."
                            (,n-old ,old)
                            (,n-new ,new))
                        (declare (symbol ,n-symbol))
-                       (about-to-modify-symbol-value ,n-symbol "compare-and-swap SYMBOL-VALUE of ~S" ,n-new)
+                       (about-to-modify-symbol-value ,n-symbol 'compare-and-swap ,n-new)
                        (%compare-and-swap-symbol-value ,n-symbol ,n-old ,n-new)))))
            (if (sb!xc:constantp name env)
                (let ((cname (constant-form-value name env)))
@@ -230,3 +230,42 @@ EXPERIMENTAL: Interface subject to change."
             (warn "Problem running ~A hook ~S:~%  ~A" kind hook c)
             (with-simple-restart (continue "Skip this ~A hook." kind)
               (error "Problem running ~A hook ~S:~%  ~A" kind hook c)))))))
+
+;;;; DEFGLOBAL
+
+(defmacro-mundanely defglobal (name value &optional (doc nil docp))
+  #!+sb-doc
+  "Defines NAME as a global variable that is always bound. VALUE is evaluated
+and assigned to NAME both at compile- and load-time, but only if NAME is not
+already bound.
+
+Global variables share their values between all threads, and cannot be
+locally bound, declared special, defined as constants, and neither bound
+nor defined as symbol macros.
+
+See also the declarations SB-EXT:GLOBAL and SB-EXT:ALWAYS-BOUND."
+  `(progn
+     (eval-when (:compile-toplevel)
+       (let ((boundp (boundp ',name)))
+         (%compiler-defglobal ',name (unless boundp ,value) boundp)))
+     (eval-when (:load-toplevel :execute)
+       (let ((boundp (boundp ',name)))
+         (%defglobal ',name (unless boundp ,value) boundp ',doc ,docp
+                     (sb!c:source-location))))))
+
+(defun %compiler-defglobal (name value boundp)
+  (sb!xc:proclaim `(global ,name))
+  (unless boundp
+    #-sb-xc-host
+    (set-symbol-global-value name value)
+    #+sb-xc-host
+    (set name value))
+  (sb!xc:proclaim `(always-bound ,name)))
+
+(defun %defglobal (name value boundp doc docp source-location)
+  (%compiler-defglobal name value boundp)
+  (when docp
+    (setf (fdocumentation name 'variable) doc))
+  (sb!c:with-source-location (source-location)
+    (setf (info :source-location :variable name) source-location))
+  name)