1.0.41.37: ppc: allocation fixes for threaded builds.

[sbcl.git] / src / compiler / ppc / macros.lisp

diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp
index e8de508..7921078 100644 (file)
--- a/src/compiler/ppc/macros.lisp
+++ b/src/compiler/ppc/macros.lisp
@@ -55,7 +55,37 @@
                         (ash ,',offset word-shift)
                         (- other-pointer-lowtag))))))))
   (frob value)
-  (frob function))
+  (frob function)
+
+  ;; FIXME: These are only good for static-symbols, so why not
+  ;; statically-allocate the static-symbol TLS slot indices at
+  ;; cross-compile time so we can just use a fixed offset within the
+  ;; TLS block instead of mucking about with the extra memory access
+  ;; (and temp register, for stores)?
+  #!+sb-thread
+  (defmacro load-tl-symbol-value (reg symbol)
+    `(progn
+       (inst lwz ,reg null-tn
+             (+ (static-symbol-offset ',symbol)
+                (ash symbol-tls-index-slot word-shift)
+                (- other-pointer-lowtag)))
+       (inst lwzx ,reg thread-base-tn ,reg)))
+  #!-sb-thread
+  (defmacro load-tl-symbol-value (reg symbol)
+    `(load-symbol-value ,reg ,symbol))
+
+  #!+sb-thread
+  (defmacro store-tl-symbol-value (reg symbol temp)
+    `(progn
+       (inst lwz ,temp null-tn
+             (+ (static-symbol-offset ',symbol)
+                (ash symbol-tls-index-slot word-shift)
+                (- other-pointer-lowtag)))
+       (inst stwx ,reg thread-base-tn ,temp)))
+  #!-sb-thread
+  (defmacro store-tl-symbol-value (reg symbol temp)
+    (declare (ignore temp))
+    `(store-symbol-value ,reg ,symbol)))
 
 (defmacro load-type (target source &optional (offset 0))
   "Loads the type bits of a pointer into target independent of
@@ -79,16 +109,13 @@
     ;; (loadw ,lip ,function function-code-offset function-pointer-type)
     (inst addi ,lip ,function (- (* n-word-bytes simple-fun-code-offset) fun-pointer-lowtag))
     (inst mtctr ,lip)
-    (move code-tn ,function)
     (inst bctr)))
 
-(defmacro lisp-return (return-pc lip &key (offset 0) (frob-code t))
+(defmacro lisp-return (return-pc lip &key (offset 0))
   "Return to RETURN-PC."
   `(progn
      (inst addi ,lip ,return-pc (- (* (1+ ,offset) n-word-bytes) other-pointer-lowtag))
      (inst mtlr ,lip)
-     ,@(if frob-code
-         `((move code-tn ,return-pc)))
      (inst blr)))
 
 (defmacro emit-return-pc (label)
@@ -184,14 +211,23 @@
                (t
                 (move ,temp-tn ,size)))
 
+         #!-sb-thread
          (inst lr ,flag-tn (make-fixup "boxed_region" :foreign))
+         #!-sb-thread
          (inst lwz ,result-tn ,flag-tn 0)
+         #!+sb-thread
+         (inst lwz ,result-tn thread-base-tn (* thread-alloc-region-slot
+                                                n-word-bytes))
 
          ;; we can optimize this to only use one fixup here, once we get
          ;; it working
          ;; (inst lr ,flag-tn (make-fixup "boxed_region" :foreign 4))
          ;; (inst lwz ,flag-tn ,flag-tn 0)
+         #!-sb-thread
          (inst lwz ,flag-tn ,flag-tn 4)
+         #!+sb-thread
+         (inst lwz ,flag-tn thread-base-tn (* (1+ thread-alloc-region-slot)
+                                              n-word-bytes))
 
          (without-scheduling ()
            ;; CAUTION: The C code depends on the exact order of
@@ -212,8 +248,13 @@
          (inst b ,fix-addr)
 
          (emit-label ,inline-alloc)
+         #!-sb-thread
          (inst lr ,flag-tn (make-fixup "boxed_region" :foreign))
+         #!-sb-thread
          (inst stw ,result-tn ,flag-tn 0)
+         #!+sb-thread
+         (inst stw ,result-tn thread-base-tn (* thread-alloc-region-slot
+                                                n-word-bytes))
 
          (emit-label ,fix-addr)
          ;; At this point, result-tn points at the end of the object.