[Openmcl-cvs-notifications] r14939 - in /trunk/source: compiler/ARM/arm-vinsns.lisp compiler/ARM/arm2.lisp lisp-kernel/arm-gc.c
gb at clozure.com
gb at clozure.com
Sun Aug 14 02:24:19 CDT 2011
Author: gb
Date: Sun Aug 14 02:24:19 2011
New Revision: 14939
Log:
Change the rules a bit to allow the LR to point to arbitrary
word-aligned locations inside a vector of single- or double-floats.
The old (well, few months old) trick of allowing the LR to point
to the (0-valued) pad word at the beginning of a DOUBLE-FLOAT or
DOUBLE-FLOAT vector isn't supported anymore (if we can point the lr
at any word in the vector, we can't tell whether that's the pad
word or not.)
This is GC safe as long as the containing vector is marked before
the LR is (and that's true of the ARM version of mark_xp()).
Having the LR point into an ivector (other than a CODE-VECTOR) isn't
sufficient to mark the ivector, so we generally have to be careful
to ensure that the LR doesn't point into an ivector that becomes
garbage. Vinsns that use the LR as a locative zero it out after
use; that's correct but overly conservative. (We -could- have the
compiler watch the vinsn stream and only zero the LR if the register
containing the LR changes/might change and cause the vector to get
GCed before the LR itself changes. We might want that sort of
vinsn-watching mechanism for other reasons, but zeroing the LR isn't
incredibly expensive and it's much better to be safe than sorry.)
The point(s) of all this is/are to avoid the mandatory use of
imm0/imm1 in fp vector references and to make it practical to (at
least in LAP) use NEON vector instructions in some cases. (Because of
addressing limitations in the ARM's coprocessor load/store
instructions, we pretty much have to have a way to point "into"
floating-point vectors; we won't have the option of loading/storing
GPR pairs when using quadword NEON instructions.)
This is an ABI change, though I don't plan to change image/fasl
versions in the trunk. To be safe, recompile any FP-intensive =
ARM code after doing a full rebuild.
Modified:
trunk/source/compiler/ARM/arm-vinsns.lisp
trunk/source/compiler/ARM/arm2.lisp
trunk/source/lisp-kernel/arm-gc.c
Modified: trunk/source/compiler/ARM/arm-vinsns.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/ARM/arm-vinsns.lisp (original)
+++ trunk/source/compiler/ARM/arm-vinsns.lisp Sun Aug 14 02:24:19 2011
@@ -143,30 +143,31 @@
(str val (:+@ v scaled-idx)))
=
=
-(define-arm-vinsn (misc-ref-single-float :predicatable)
+(define-arm-vinsn (misc-ref-single-float :predicatable :sets-lr)
(((dest :single-float))
((v :lisp)
- (scaled-idx :u32))
- ((temp :u32)))
- (ldr temp (:@ v scaled-idx))
- (fmsr dest temp))
-
-(define-arm-vinsn (misc-ref-c-single-float :predicatable)
+ (scaled-idx :u32)))
+ (add lr v scaled-idx)
+ (flds dest (:@ lr (:$ 0)))
+ (mov lr (:$ 0)))
+
+(define-arm-vinsn (misc-ref-c-single-float :predicatable :sets-lr)
(((dest :single-float))
((v :lisp)
(idx :u32const))
- ((temp :u32)))
- (ldr temp (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2)))=
))
- (fmsr dest temp))
-
-(define-arm-vinsn (misc-ref-double-float :predicatable)
+ ())
+ (add lr v (:$ arm::misc-data-offset))
+ (flds dest (:@ lr (:$ (:apply ash idx 2))))
+ (mov lr (:$ 0)))
+
+(define-arm-vinsn (misc-ref-double-float :predicatable :sets-lr)
(((dest :double-float))
((v :lisp)
- (scaled-idx :u32))
- ((low (:u32 #.arm::imm0))
- (high (:u32 #.arm::imm1))))
- (ldrd low (:@ v scaled-idx))
- (fmdrr dest low high))
+ (unscaled-idx :imm)))
+ (add arm::lr v (:$ arm::misc-dfloat-offset))
+ (add arm::lr arm::lr (:lsl unscaled-idx (:$ 1)))
+ (fldd dest (:@ arm::lr (:$ 0)))
+ (mov lr (:$ 0)))
=
=
=
@@ -175,34 +176,37 @@
(((dest :double-float))
((v :lisp)
(idx :u32const)))
- (add lr v (:$ arm::double-float.pad))
- (fldd dest (:@ lr (:$ (:apply + (:apply ash idx 3) (- arm::double-float.=
value arm::double-float.pad))))))
-
-(define-arm-vinsn (misc-set-c-double-float :predicatable)
+ (add lr v (:$ arm::double-float.value))
+ (fldd dest (:@ lr (:$ (:apply ash idx 3))))
+ (mov lr (:$ 0)))
+
+(define-arm-vinsn (misc-set-c-double-float :predicatable :sets-lr)
(((val :double-float))
((v :lisp)
(idx :u32const)))
- (add lr v (:$ arm::double-float.pad))
- (fstd val (:@ lr (:$ (:apply + (:apply ash idx 3) (- arm::double-float.v=
alue arm::double-float.pad))))))
-
-(define-arm-vinsn (misc-set-double-float :predicatable)
+ (add lr v (:$ arm::double-float.value))
+ (fstd val (:@ lr (:$ (:apply ash idx 3))))
+ (mov lr (:$ 0)))
+
+(define-arm-vinsn (misc-set-double-float :predicatable :sets-lr)
(()
((val :double-float)
(v :lisp)
- (scaled-idx :u32))
- ((low (:u32 #.arm::imm0))
- (high (:u32 #.arm::imm1))))
- (fmrrd low high val)
- (strd low (:@ v scaled-idx)))
+ (unscaled-idx :imm))) ; a fixnum
+ (add lr v (:$ arm::misc-dfloat-offset))
+ (add lr lr (:lsl unscaled-idx (:$ 1)))
+ (fstd val (:@ lr (:$ 0)))
+ (mov lr (:$ 0)))
=
(define-arm-vinsn (misc-set-c-single-float :predicatable)
(()
((val :single-float)
(v :lisp)
- (idx :u32const))
- ((temp :u32)))
- (fmrs temp val)
- (str temp (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2)))=
)))
+ (idx :u32const)))
+ (add lr v (:$ arm::misc-data-offset))
+ (fsts val (:@ lr (:$ (:apply ash idx 2))))
+ (mov lr (:$ 0)))
+
=
=
=
@@ -2427,7 +2431,7 @@
=
;;; Heap-cons a double-float to store contents of FPREG. Hope that we don=
't do
;;; this blindly.
-(define-arm-vinsn double->heap (((result :lisp)) ; tagged as a double-float
+(define-arm-vinsn (double->heap :sets-lr) (((result :lisp)) ; tagged as a =
double-float
((fpreg :double-float)) =
((header-temp (:u32 #.arm::imm0))
(high (:u32 #.arm::imm1))))
@@ -2441,8 +2445,9 @@
(str header-temp (:@ allocptr (:$ arm::misc-header-offset)))
(mov result allocptr)
(bic allocptr allocptr (:$ arm::fulltagmask))
- (add lr result (:$ arm::double-float.pad))
- (fstd fpreg (:@ lr (:$ (- arm::double-float.value arm::double-float.pad)=
))))
+ (add lr result (:$ arm::double-float.value))
+ (fstd fpreg (:@ lr (:$ 0)))
+ (mov lr (:$ 0)))
=
=
;;; This is about as bad as heap-consing a double-float. (In terms of
@@ -2462,26 +2467,27 @@
(str header-temp (:@ allocptr (:$ arm::misc-header-offset)))
(mov result allocptr)
(bic allocptr allocptr (:$ arm::fulltagmask))
+ (add lr result (:$ arm::single-float.value))
(fmrs header-temp fpreg)
(str header-temp (:@ result (:$ arm::single-float.value))))
=
=
=
;;; "dest" is preallocated, presumably on a stack somewhere.
-(define-arm-vinsn (store-double :predicatable)
+(define-arm-vinsn (store-double :predicatable :sets-lr)
(()
((dest :lisp)
- (source :double-float))
- ((low (:u32 #.arm::imm0))
- (high (:u32 #.arm::imm1))))
- (fmrrd low high source)
- (strd low (:@ dest (:$ arm::double-float.value))))
+ (source :double-float)))
+ (add lr dest (:$ arm::double-float.value))
+ (fstd source (:@ lr (:$ 0)))
+ (mov lr (:$ 0)))
=
(define-arm-vinsn (get-double :predicatable :sets-lr)
(((target :double-float))
((source :lisp)))
- (add lr source (:$ arm::double-float.pad))
- (fldd target (:@ lr (:$ (- arm::double-float.value arm::double-float.pad=
)))))
+ (add lr source (:$ arm::double-float.value))
+ (fldd target (:@ lr (:$ 0)))
+ (mov lr (:$ 0)))
=
;;; Extract a double-float value, typechecking in the process.
;;; IWBNI we could simply call the "trap-unless-typecode=3D" vinsn here,
Modified: trunk/source/compiler/ARM/arm2.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/ARM/arm2.lisp (original)
+++ trunk/source/compiler/ARM/arm2.lisp Sun Aug 14 02:24:19 2011
@@ -1581,9 +1581,10 @@
(! misc-ref-c-double-float fp-val src index-known-fixn=
um)
(with-imm-target () idx-reg
(if index-known-fixnum
- (arm2-absolute-natural seg idx-reg nil (+ (arch::t=
arget-misc-data-offset arch) (ash index-known-fixnum 3)))
- (! scale-64bit-misc-index idx-reg unscaled-idx))
- (! misc-ref-double-float fp-val src idx-reg)))
+ (unless unscaled-idx
+ (setq unscaled-idx idx-reg)
+ (arm2-absolute-natural seg unscaled-idx nil (ash=
index-known-fixnum arm::fixnumshift))))
+ (! misc-ref-double-float fp-val src unscaled-idx)))
(if (eq vreg-class hard-reg-class-fpr)
(<- fp-val)
(ensuring-node-target (target vreg)
@@ -2153,9 +2154,10 @@
(! misc-set-c-double-float unboxed-val-reg src index-k=
nown-fixnum)
(progn
(if index-known-fixnum
- (arm2-absolute-natural seg scaled-idx nil (+ (arch=
::target-misc-dfloat-offset arch) (ash index-known-fixnum 3)))
- (! scale-64bit-misc-index scaled-idx unscaled-idx))
- (! misc-set-double-float unboxed-val-reg src scaled-=
idx)))))
+ (unless unscaled-idx
+ (setq unscaled-idx scaled-idx)
+ (arm2-absolute-natural seg unscaled-idx nil (ash=
index-known-fixnum arm::fixnumshift))))
+ (! misc-set-double-float unboxed-val-reg src unscale=
d-idx)))))
(t
(with-imm-target (unboxed-val-reg) scaled-idx
(cond
Modified: trunk/source/lisp-kernel/arm-gc.c
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lisp-kernel/arm-gc.c (original)
+++ trunk/source/lisp-kernel/arm-gc.c Sun Aug 14 02:24:19 2011
@@ -1054,8 +1054,6 @@
mark_xp(ExceptionInformation *xp)
{
natural *regs =3D (natural *) xpGPRvector(xp);
- LispObj lr_value;
-
int r;
/* registers between arg_z and Rfn should be tagged and marked as
roots. the PC, and LR should be treated as "pc_locatives".
@@ -1074,12 +1072,7 @@
=
=
mark_pc_root(ptr_to_lispobj(xpPC(xp)));
- lr_value =3D ptr_to_lispobj(xpLR(xp));
- if (*((LispObj *)lr_value) =3D=3D 0) { /* pointing into a double-float/d=
ouble-float vector */
- mark_root(untag(lr_value)+fulltag_misc);
- } else {
- mark_pc_root(lr_value);
- }
+ mark_pc_root(ptr_to_lispobj(xpLR(xp)));
}
=
/* A "pagelet" contains 32 doublewords. The relocation table contains
More information about the Openmcl-cvs-notifications
mailing list