Silence notes about being specialised EQ templates on x86oids
[sbcl.git] / src / code / late-cas.lisp
1 (in-package "SB!IMPL")
2
3 (defcas car (cons) %compare-and-swap-car)
4 (defcas cdr (cons) %compare-and-swap-cdr)
5 (defcas first (cons) %compare-and-swap-car)
6 (defcas rest (cons) %compare-and-swap-cdr)
7 (defcas symbol-plist (symbol) %compare-and-swap-symbol-plist)
8
9 (define-cas-expander symbol-value (name &environment env)
10   (multiple-value-bind (tmp val cname)
11       (if (sb!xc:constantp name env)
12           (values nil nil (constant-form-value name env))
13           (values (gensymify name) name nil))
14     (with-unique-names (old new)
15       (values (when tmp (list tmp))
16               (when val (list val))
17               old
18               new
19               (let ((slow
20                       `(locally
21                            (declare (symbol ,tmp))
22                          (about-to-modify-symbol-value ,tmp 'compare-and-swap ,new)
23                          (%compare-and-swap-symbol-value ,tmp ,old ,new))))
24                 (if cname
25                     (if (member (info :variable :kind cname) '(:special :global))
26                         ;; We can generate the type-check reasonably.
27                         `(%compare-and-swap-symbol-value
28                           ',cname ,old (the ,(info :variable :type cname) ,new))
29                         slow)
30                     slow))
31               `(symbol-global-value ,(or tmp `',cname))))))
32
33 (define-cas-expander svref (vector index)
34   (with-unique-names (v i old new)
35     (values (list v i)
36             (list vector index)
37             old
38             new
39             `(locally (declare (simple-vector ,v))
40                (%compare-and-swap-svref ,v (%check-bound ,v (length ,v) ,i) ,old ,new))
41             `(svref ,v ,i))))