X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fobjdef.lisp;h=2f455da8c3170a04d7f3764ea692ae764b83a198;hb=5d04a95274c9ddaebbcd6ddffc5d646e2c25598c;hp=15d86cc2417c2ab6f7662f630faf97cc3a05ca3d;hpb=45b5a21316381ecab98a0e5a5296294e044170e8;p=sbcl.git diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp index 15d86cc..2f455da 100644 --- a/src/compiler/generic/objdef.lisp +++ b/src/compiler/generic/objdef.lisp @@ -40,8 +40,10 @@ (define-primitive-object (cons :lowtag list-pointer-lowtag :alloc-trans cons) - (car :ref-trans car :set-trans sb!c::%rplaca :init :arg) - (cdr :ref-trans cdr :set-trans sb!c::%rplacd :init :arg)) + (car :ref-trans car :set-trans sb!c::%rplaca :init :arg + :cas-trans %compare-and-swap-car) + (cdr :ref-trans cdr :set-trans sb!c::%rplacd :init :arg + :cas-trans %compare-and-swap-cdr)) (define-primitive-object (instance :lowtag instance-pointer-lowtag :widetag instance-header-widetag @@ -239,6 +241,8 @@ (define-primitive-object (value-cell :lowtag other-pointer-lowtag :widetag value-cell-header-widetag + ;; FIXME: We also have an explicit VOP + ;; for this. Is this needed as well? :alloc-trans make-value-cell) (value :set-trans value-cell-set :set-known (unsafe) @@ -321,6 +325,8 @@ (plist :ref-trans symbol-plist :set-trans %set-symbol-plist + :cas-trans %compare-and-swap-symbol-plist + :type list :init :null) (name :ref-trans symbol-name :init :arg) (package :ref-trans symbol-package @@ -370,6 +376,13 @@ ;; of a symbol is initialized to zero (no-tls-value-marker) (os-thread :c-type "volatile os_thread_t") + ;; This is the original address at which the memory was allocated, + ;; which may have different alignment then what we prefer to use. + ;; Kept here so that when the thread dies we can releast the whole + ;; memory we reserved. + (os-address :c-type "void *" :length #!+alpha 2 #!-alpha 1) + #!+sb-thread + (os-attr :c-type "pthread_attr_t *" :length #!+alpha 2 #!-alpha 1) (binding-stack-start :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1) (binding-stack-pointer :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1) (control-stack-start :c-type "lispobj *" :length #!+alpha 2 #!-alpha 1)