Changeset 14472

Timestamp:

Dec 8, 2010, 11:55:48 AM (14 years ago)

Author:

Gary Byers

Message:

lisp-kernel/linuxarm/Makefile: just use -mfpu=vfp (not vfpv2) in ASFLAGS.

lisp-kernel/arm-gc: in mark_xp(), if lr points to word of 0 (which we
don't think of as a valid instruction, even though it's a harmless
NOP), assume that it's pointing at the pad word of a DOUBLE-FLOAT or
DOUBLE-FLOAT-VECTOR and mark the vector. (This lets us use fldd to
access a double-float without using GPRs.)

lib/ffi-linuxarm: typo fix from Ivan Shvedunov.

compiler/vinsn.lisp: new :sets-lr vinsn attribute

compiler/ARM/arm-vinsns: several fixes from Ivan Shvedunov; use fldd/fstd
via LR where possible.

Location:

trunk/source

Files:

• compiler/ARM/arm-vinsns.lisp (modified) (7 diffs)
• compiler/vinsn.lisp (modified) (1 diff)
• lib/ffi-linuxarm.lisp (modified) (1 diff)
• lisp-kernel/arm-gc.c (modified) (2 diffs)
• lisp-kernel/linuxarm/Makefile (modified) (1 diff)

trunk/source/compiler/ARM/arm-vinsns.lisp

@@ -669 +669 @@
       (src :address)
       (index :s16const))
-     ((low (:u32 #.arm::imm0))
-      (high (:u32 #.arm::imm1))
-      (addr (:u32 #.arm::imm2))))       ; addr should be :address
+     ((addr :u32)))
   (add addr src (:$ index))
-  (fmrrd low high src)
-  (strd low (:@ addr (:$ 0))))
+  (fstd src (:@ addr (:$ 0))))
 
 (define-arm-vinsn (mem-set-double-float :predicatable)
@@ -681 +678 @@
       (src :address)
       (index :s32))                     
-     ((low (:u32 #.arm::imm0))
-      (high (:u32 #.arm::imm1))
-      (addr (:u32 #.arm::imm2))))       ; addr should be :address
+     ((addr :u32)))
   (add addr src index)
-  (fmrrd low high src)
-  (strd low (:@ addr (:$ 0))))
+  (fstd src (:@ addr (:$ 0))))
 
 (define-arm-vinsn (mem-ref-c-single-float :predicatable)
@@ -710 +704 @@
       (index :s16const))
      ((temp :u32)))
-  (fmrs temp src)
+  (fmrs temp val)
   (str temp (:@ src (:$ index))))
 
@@ -719 +713 @@
       (index :s32))
      ((temp :u32)))
-  (fmrs temp src)
-  (str temp (:@ src (:$ index))))
+  (fmrs temp val)
+  (str temp (:@ src  index)))
 
 
@@ -2211 +2205 @@
      ((val :s8)) 
      ())
-  (mov result (:lsr val (:$ 24)))
-  (mov result (:asr val (:$ (- 24 arm::fixnumshift)))))
+  (mov result (:lsl val (:$ 24)))
+  (mov result (:asr result (:$ (- 24 arm::fixnumshift)))))
 
 
@@ -2357 +2351 @@
   (strd low (:@ dest (:$ arm::double-float.value))))
 
-(define-arm-vinsn (get-double :predicatable)
+(define-arm-vinsn (get-double :predicatable :sets-lr)
     (((target :double-float))
-     ((source :lisp))
-     ((low (:u32 #.arm::imm0))
-      (high (:u32 #.arm::imm1))))
-  (ldrd low (:@ source (:$ arm::double-float.value)))
-  (fmdrr target low high))
+     ((source :lisp)))
+  (add lr source (:$ arm::double-float.pad))
+  (fldd target (:@ lr (:$ (- arm::double-float.value arm::double-float.pad)))))
 
 ;;; Extract a double-float value, typechecking in the process.
@@ -2369 +2361 @@
 ;;; instead of replicating it ..
 
-(define-arm-vinsn get-double? (((target :double-float))
-                               ((source :lisp))
-                               ((low (:u32 #.arm::imm0))
-                                (high (:u32 #.arm::imm1))))
-  (and low source (:$ arm::tagmask))
-  (cmp low (:$ arm::tag-misc))
-  (ldrbeq low (:@ source (:$ arm::misc-subtag-offset)))
-  (cmp imm0 (:$ arm::subtag-double-float))
+(define-arm-vinsn (get-double? :sets-lr)
+    (((target :double-float))
+     ((source :lisp))
+     ((tag :u8)))
+  (and tag source (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:@ source (:$ arm::misc-subtag-offset)))
+  (cmp tag (:$ arm::subtag-double-float))
   (uuo-error-reg-not-xtype (:? ne) source (:$ arm::subtag-double-float))
-  (ldrd imm0 (:@ source (:$ arm::double-float.value)))
-  (fmdrr target imm0 imm1))
+  (add lr source (:$ arm::double-float.pad))
+  (fldd target (:@ lr (:$ (- arm::double-float.value arm::double-float.pad)))))
   
 

trunk/source/compiler/vinsn.lisp

@@ -265 +265 @@
     :sp
     :predicatable                       ; all instructions can be predicated, no instructions set or test condition codes.
+    :sets-lr                            ; uses the link register, if there is one.
     ))
 

trunk/source/lib/ffi-linuxarm.lisp

@@ -148 +148 @@
                                       (cond ((<= bits 8)
                                              (if signed
-                                               '%get-signed-byte '
+                                               '%get-signed-byte
                                                '%get-unsigned-byte))
                                             ((<= bits 16)

trunk/source/lisp-kernel/arm-gc.c

@@ -1006 +1006 @@
 {
   natural *regs = (natural *) xpGPRvector(xp);
+  LispObj lr_value;
 
   int r;
@@ -1025 +1026 @@
 
   mark_pc_root(ptr_to_lispobj(xpPC(xp)));
-  mark_pc_root(ptr_to_lispobj(xpLR(xp)));
-
-
+  lr_value = ptr_to_lispobj(xpLR(xp));
+  if (*((LispObj *)lr_value) == 0) { /* pointing into a double-float */
+    mark_root(untag(lr_value)+fulltag_misc);
+  } else {
+    mark_pc_root(lr_value);
+  }
 }
 

trunk/source/lisp-kernel/linuxarm/Makefile

@@ -22 +22 @@
 AS = as
 M4 = m4
-ASFLAGS = -mfpu=vfpv2
+ASFLAGS = -mfpu=vfp
 M4FLAGS = -DLINUX -DARM
 CDEFINES = -DLINUX -DARM -D_REENTRANT -D_GNU_SOURCE -DUSE_FUTEX -DSVN_REVISION=$(SVN_REVISION)