diff --git a/make-config.sh b/make-config.sh index 8fdb70f52..53b635b6c 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 a729c3729..e59f72c3a 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