1.0.10.5: dynamic-extent CONS

[sbcl.git] / src / compiler / generic / objdef.lisp

diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp
index 7b9b242..5bdd76a 100644 (file)
--- 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
@@ -207,6 +209,11 @@
         :ref-trans %simple-fun-type
         :set-known (unsafe)
         :set-trans (setf %simple-fun-type))
+  (xrefs :init :null
+         :ref-trans %simple-fun-xrefs
+         :ref-known (flushable)
+         :set-trans (setf %simple-fun-xrefs)
+         :set-known ())
   ;; the SB!C::DEBUG-FUN object corresponding to this object, or NIL for none
   #+nil ; FIXME: doesn't work (gotcha, lowly maintenoid!) See notes on bug 137.
   (debug-fun :ref-known (flushable)
@@ -234,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)
@@ -274,13 +283,17 @@
   (current-uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32")
   (current-cont :c-type #!-alpha "lispobj *" #!+alpha "u32")
   #!-(or x86 x86-64) current-code
-  entry-pc)
+  entry-pc
+  #!+win32 next-seh-frame
+  #!+win32 seh-frame-handler)
 
 (define-primitive-object (catch-block)
   (current-uwp :c-type #!-alpha "struct unwind_block *" #!+alpha "u32")
   (current-cont :c-type #!-alpha "lispobj *" #!+alpha "u32")
   #!-(or x86 x86-64) current-code
   entry-pc
+  #!+win32 next-seh-frame
+  #!+win32 seh-frame-handler
   tag
   (previous-catch :c-type #!-alpha "struct catch_block *" #!+alpha "u32")
   size)
@@ -312,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
@@ -343,6 +358,8 @@
   (prev :c-type "struct lutex *" :length 1)
   (mutex :c-type "pthread_mutex_t *"
          :length 1)
+  (mutexattr :c-type "pthread_mutexattr_t *"
+             :length 1)
   (condition-variable :c-type "pthread_cond_t *"
                       :length 1))
 
@@ -359,6 +376,11 @@
   ;; 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)
   (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)