[Sbcl-commits] master: Implement :symbol-info-vops on ARM.

[stassats <sta...@us...>]

The branch "master" has been updated in SBCL:
       via  ebcbcdd8cd47c035abae6cbea9f1ec61eb1708d0 (commit)
      from  39e000b2a83e4777c76a8f5a77b129c79954c7fd (commit)

- Log -----------------------------------------------------------------
commit ebcbcdd8cd47c035abae6cbea9f1ec61eb1708d0
Author: Stas Boukarev <sta...@gm...>
Date:   Sat May 17 23:10:01 2014 +0400

    Implement :symbol-info-vops on ARM.
---
 make-config.sh               |    2 +-
 src/compiler/arm/system.lisp |   28 ++++++++++++++++++++++++++++
 2 files changed, 29 insertions(+), 1 deletions(-)

diff --git a/make-config.sh b/make-config.sh
index 8fdb70f..53b635b 100755
--- a/make-config.sh
+++ b/make-config.sh
@@ -680,7 +680,7 @@ elif [ "$sbcl_arch" = "arm" ]; then
     # possibly VFPv2 and higher only), but we'll leave the obvious
     # hooks in for someone to add the support later.
     printf ' :arm-vfp :arm-vfpv2' >> $ltf
-    printf ' :ash-right-vops :multiply-high-vops' >> $ltf
+    printf ' :ash-right-vops :multiply-high-vops :symbol-info-vops' >> $ltf
     printf ' :stack-allocatable-lists :stack-allocatable-fixed-objects' >> $ltf
     printf ' :stack-allocatable-vectors :stack-allocatable-closures' >> $ltf
 else
diff --git a/src/compiler/arm/system.lisp b/src/compiler/arm/system.lisp
index a729c37..e59f72c 100644
--- a/src/compiler/arm/system.lisp
+++ b/src/compiler/arm/system.lisp
@@ -201,6 +201,34 @@
     (inst add ndescr offset (lsr ndescr (- n-widetag-bits word-shift)))
     (inst sub ndescr ndescr (- other-pointer-lowtag fun-pointer-lowtag))
     (inst add func code ndescr)))
+;;;
+#!+symbol-info-vops
+(define-vop (symbol-info-vector)
+  (:policy :fast-safe)
+  (:translate symbol-info-vector)
+  (:args (x :scs (descriptor-reg)))
+  (:results (res :scs (descriptor-reg)))
+  (:temporary (:sc unsigned-reg) temp)
+  (:generator 1
+    (loadw res x symbol-info-slot other-pointer-lowtag)
+    ;; If RES has list-pointer-lowtag, take its CDR. If not, use it as-is.
+    (inst and temp res lowtag-mask)
+    (inst cmp temp list-pointer-lowtag)
+    (loadw res res cons-cdr-slot list-pointer-lowtag :eq)))
+
+#!+symbol-info-vops
+(define-vop (symbol-plist)
+  (:policy :fast-safe)
+  (:translate symbol-plist)
+  (:args (x :scs (descriptor-reg)))
+  (:results (res :scs (descriptor-reg)))
+  (:generator 1
+    (loadw res x symbol-info-slot other-pointer-lowtag)
+    ;; Instruction pun: (CAR x) is the same as (VECTOR-LENGTH x)
+    ;; so if the info slot holds a vector, this gets a fixnum- it's not a plist.
+    (loadw res res cons-car-slot list-pointer-lowtag)
+    (inst tst res fixnum-tag-mask)
+    (inst mov :eq res null-tn)))
 
 ;;;; other miscellaneous VOPs
 

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL