Changeset 13906

Timestamp:

Jul 1, 2010, 6:25:40 AM (14 years ago)

Author:

Gary Byers

Message:

arm-spentry.s: 32-bit misc-set: arg_y is the index, not arg_z.

arm-bignum.lisp: %FLOOR-99.

arm-float.lisp: several fixes.

arm-asm.lisp: fmrrd and fmdrr were encoded wrong. fabss and fabsd need
to mask more bits in disassembler.

arm-vinsns.lisp: zero-single-float-register, zero-double-float-register
were backwards.

Location:

branches/arm

Files:

• compiler/ARM/arm-asm.lisp (modified) (2 diffs)
• compiler/ARM/arm-vinsns.lisp (modified) (2 diffs)
• level-0/ARM/arm-bignum.lisp (modified) (1 diff)
• level-0/ARM/arm-float.lisp (modified) (3 diffs)
• lisp-kernel/arm-spentry.s (modified) (4 diffs)

branches/arm/compiler/ARM/arm-asm.lisp

@@ -596 +596 @@
    (define-arm-instruction fabsd (:dd :dm)
      #x0eb00bc0
-     #x0ff00ff0
+     #x0fff0ff0
      ())
    (define-arm-instruction fabss (:sd :sm)
      #x0eb00ac0
-     #x0fb00fb0
+     #x0fbf0fb0
      ())
    (define-arm-instruction fnegd (:dd :dm)
@@ -635 +635 @@
      ())
    (define-arm-instruction fmrrd (:rd :rn :dm)
-     #x0e500b10
+     #x0c500b10
      #x0ff00ff0
      ())
    (define-arm-instruction fmdrr (:dm :rd :rn)
-     #x0e400b10
+     #x0c400b10
      #x0ff00ff0
      ())

branches/arm/compiler/ARM/arm-vinsns.lisp

@@ -2754 +2754 @@
 (define-arm-vinsn zero-double-float-register (((dest :double-float))
                                               ()
-                                              ((temp :imm)))
-  (mov temp (:$ 0))
-  (fmsr dest temp))
+                                              ((low (:u32 #.arm::imm0))))
+  (mov low (:$ 0))
+  (fmdrr dest low low))
 
 (define-arm-vinsn zero-single-float-register (((dest :single-float))
@@ -2762 +2762 @@
                                               ((temp :imm)))
   (mov temp (:$ 0))
-  (fmdrr dest temp temp))
+  (fmsr dest temp))
 
 (define-arm-vinsn load-double-float-constant (((dest :double-float))

branches/arm/level-0/ARM/arm-bignum.lisp

@@ -1229 +1229 @@
     (bx lr)))
 
+;;; If x[i] = y[j], return the all ones digit (as two halves).
+;;; Otherwise, compute floor x[i]x[i-1] / y[j].
+(defarmlapfunction %floor-99 ((x-stk 0) (xidx arg_x) (yptr arg_y) (yidx arg_z))
+  (add imm1 vsp (:$ 4))
+  (build-lisp-frame imm0 imm1)
+  (ldr temp0 (:@ vsp (:$ x-stk)))
+  (add imm0 xidx (:$ arm::misc-data-offset))
+  (add imm1 yidx (:$ arm::misc-data-offset))
+  (ldr imm0 (:@ temp0 imm0))
+  (ldr imm2 (:@ yptr imm1))
+  (cmp imm0 imm2)
+  (bne @more)
+  (mov imm0 (:$ (ash #xff arm::fixnumshift)))
+  (orr imm0 imm0 (:$ (ash #xff00 arm::fixnumshift)))
+  (vpush1 imm0)
+  (vpush1 imm0)
+  (set-nargs 2)
+  (ba .SPnvalret)
+  @more
+  (add imm1 xidx (:$ (- arm::misc-data-offset arm::node-size)))
+  (ldr imm0 (:@ temp0 imm1))
+  (add imm1 imm1 (:$ arm::node-size))
+  (ldr imm1 (:@ temp0 imm1))
+  (bl .SPudiv64by32)
+  (mov arg_y '-1)
+  (and arg_y arg_y (:lsr imm0 (:$ (- 16 arm::fixnumshift))))
+  (mov imm0 (:lsl imm0 (:$ 16)))
+  (mov arg_z '-1)
+  (and arg_z arg_z (:lsr imm0 (:$ (- 16 arm::fixnumshift))))
+  (stmdb (:! vsp) (arg_z arg_y))
+  (set-nargs 2)
+  (ba .SPnvalret))
+
+
 ; End of arm-bignum.lisp

branches/arm/level-0/ARM/arm-float.lisp

@@ -32 +32 @@
 
 (defarmlapfunction %make-float-from-fixnums ((float 4)(hi 0) (lo arg_x) (exp arg_y) (sign arg_z))
-  (and imm0 sign (:$ #x80000000))  ; just leave sign bit 
-  (ldr imm1 (:@ vsp (:$ hi)))
+  (ldr imm0 (:@ vsp (:$ hi)))
+  (unbox-fixnum imm0 imm0)
+  (unbox-fixnum imm1 lo)
+  (cmp sign (:$ 0))
+  (orr imm1 imm1 (:lsl imm0 (:$ 28)))
+  (mov imm0 (:lsr imm0 (:$ 4)))
   (orr imm0 imm0 (:lsl exp (:$ (- 20 arm::fixnumshift)))) ;  exp left 20 right 2 keep 11 bits
-  (unbox-fixnum imm1 imm1)
-  (orr imm0 imm0 (:lsr imm1 (:$ 4)))
-  (and imm1 imm1 (:$ #xf0000000))
-  (orr imm1 imm1 (:lsr lo (:$ arm::fixnumshift)))
-  (ldr temp0 (:@ vsp (:$ float)))         ; the float
-  (str imm0 (:@ temp0 (:$ arm::double-float.val-high)))
-  (str imm1 (:@ temp0 (:$ arm::double-float.val-low)))
+  (ldr arg_z (:@ vsp (:$ float)))
+  (orrmi imm0 imm0 (:$ #x80000000))
+  (str imm0 (:@ arg_z (:$ arm::double-float.val-high)))
+  (str imm1 (:@ arg_z (:$ arm::double-float.val-low)))
   (add vsp vsp '2)
   (bx lr))
@@ -86 +87 @@
 
 ;;; rets hi (25 bits) lo (28 bits) exp sign
-#+later
 (defarmlapfunction %integer-decode-double-float ((n arg_z))
-  (ldr imm0  (:@ n (:$ arm::double-float.value)))
-  (rlwinm imm1 imm0 (+ 1 arm::fixnumshift) (- 32 arm::fixnumshift 1) ; sign boxed
-                                           (- 32 arm::fixnumshift 1))
-  (add imm1 imm1 imm1)  ; imm1 = (fixnum 2) (neg) or 0 (pos)
-  (subfic temp0 imm1 '1)  ; sign boxed
-  (rlwinm. imm2 imm0 (- 32 20)  21  31)   ; right 20, keep 11 bits exp - test for 0
-  ;(subi imm2 imm2 (+ 53 1022))            ; unbias and scale
-  (slwi imm2 imm2 arm::fixnumshift)      ; box
-  (mr temp1 imm2)                        ; boxed unbiased exponent
-  (rlwinm imm0 imm0 12  0 19)            ; 20 bits of hi float left 12
-  (beq @denorm)                          ; cr set way back
-  (addi imm0 imm0 1)                     ;  add implied 1
-  @denorm
-  (rlwinm imm0 imm0 (+ (- 32 12) 4 arm::fixnumshift) 0 31)
-  (ldr imm1 (:@ n (:$ arm::double-float.val-low))) ; 
-  (rlwimi imm0 imm1 (+ 4 arm::fixnumshift)
-                    (1+ (- 31 4 arm::fixnumshift))
-                    (- 31 arm::fixnumshift))  ; high 4 bits in fixnum pos
-  (rlwinm imm1 imm1 (- 4 arm::fixnumshift) 
-                    (- 4 arm::fixnumshift)
-                    (- 31 arm::fixnum-shift)) ; 28 bits  thats 2 2 29
-  (vpush imm0)   ; hi 25 bits of mantissa (includes implied 1)
-  (vpush imm1)   ; lo 28 bits of mantissa
-  (vpush temp1)  ; exp
-  (vpush temp0)  ; sign
+  (ldr imm0  (:@ n (:$ arm::double-float.val-high)))
+  (mov temp0 '1)
+  (tst imm0 (:$ #x80000000))
+  (movne temp0 '-1)
+  (bic imm1 imm0 (:$ #x80000000))
+  (mov temp1 '-1)
+  (ands temp1 temp1 (:lsr imm1 (:$ (- (- IEEE-double-float-exponent-offset 32)
+                                      arm::fixnumshift))))
+  (mov imm0 (:lsl imm0 (:$ 12)))
+  (mov imm0 (:lsr imm0 (:$ 12)))
+  (ldr imm1 (:@ n (:$ arm::double-float.val-low)))
+  (orrne imm0 imm0 (:$ (ash 1 (- IEEE-double-float-hidden-bit 32))))
+  (mov imm0 (:lsl imm0 (:$ 4)))
+  (orr imm0 imm0 (:lsr imm1 (:$ (- 32 4))))
+  (box-fixnum imm0 imm0)
+  (mov imm1 (:lsl imm1 (:$ 4)))
+  (mov imm1 (:lsr imm1 (:$ (- 4 arm::fixnumshift))))
+  (vpush1 imm0)   ; hi 25 bits of mantissa (includes implied 1)
+  (vpush1 imm1)   ; lo 28 bits of mantissa
+  (vpush1 temp1)  ; exp
+  (vpush1 temp0)  ; sign
   (set-nargs 4)
-  (la temp0 '4 vsp)
+  (add temp0 vsp '4)
   (ba .SPvalues))
 
@@ -120 +116 @@
 ;;; hi is 25 bits lo is 28 bits
 ;;; big is 32 lo, 21 hi right justified
-
-#+later
 (defarmlapfunction make-big-53 ((hi arg_x)(lo arg_y)(big arg_z))
-  (rlwinm imm0 lo (- 32 arm::fixnumshift) 4 31)
-  (rlwimi imm0 hi (- 32 4 arm::fixnumshift) 0 3)
-  (stw imm0 (+ arm::misc-data-offset 0) big)   ; low goes in 1st wd
-  (rlwinm imm0 hi (- 32 (+ arm::fixnumshift 4)) 11 31)  ; high in second
-  (stw imm0 (+ arm::misc-data-offset 4) big)
-  (bx lr))
-
-
-#+later
+  (unbox-fixnum imm0 hi)
+  (unbox-fixnum imm1 lo)
+  (orr imm1 imm1 (:lsl imm0 (:$ 28)))
+  (mov imm0 (:lsr imm0 (:$ 4)))
+  (str imm0 (:@ big (:$ arm::double-float.val-high)))
+  (str imm1 (:@ big (:$ arm::double-float.val-low)))
+  (bx lr))
+
+
 (defarmlapfunction dfloat-significand-zeros ((dfloat arg_z))
   (ldr imm1 (:@ dfloat (:$ arm::double-float.value)))
-  (rlwinm. imm1 imm1 12 0 19)
-  (cntlzw imm1 imm1)
-  (beq @golo)
-  (box-fixnum arg_z imm1)
-  (bx lr)
+  (movs imm1 (:lsl imm1 (:$ 12)))
+  (clz imm1 imm1)
+  (movne arg_z (:lsl imm1 (:$ arm::fixnumshift)))
+  (bxne lr)
   @golo
   (ldr imm1 (:@ dfloat (:$ arm::double-float.val-low)))
-  (cntlzw imm1 imm1)
-  (addi imm1 imm1 20)
+  (clz imm1 imm1)
+  (add imm1 imm1 (:$ 20))
   (box-fixnum arg_z imm1)
   (bx lr))
 
-#+later
 (defarmlapfunction sfloat-significand-zeros ((sfloat arg_z))
-   (ldr imm1 (:@ sfloat (:$ arm::single-float.value)))
-  (rlwinm imm1 imm1 9 0 22)
-  (cntlzw imm1 imm1)
+  (ldr imm1 (:@ sfloat (:$ arm::single-float.value)))
+  (mov imm1 (:lsl imm1 (:$ 9)))
+  (clz imm1 imm1)
   (box-fixnum arg_z imm1)
   (bx lr))

branches/arm/lisp-kernel/arm-spentry.s

@@ -3689 +3689 @@
         __(b _SPksignalerr)
 local_label(misc_set_fixnum_vector):   
-        __(add imm0,arg_z,#misc_data_offset)
+        __(add imm0,arg_y,#misc_data_offset)
         __(test_fixnum(arg_z))
         __(bne local_label(set_bad))
@@ -3696 +3696 @@
         __(bx lr)
 local_label(misc_set_new_string):   
-        __(add imm0,arg_z,#misc_data_offset)
+        __(add imm0,arg_y,#misc_data_offset)
         __(extract_lowbyte(imm2,arg_z))
         __(cmp imm2,#subtag_character)
@@ -3704 +3704 @@
         __(bx lr)
 local_label(misc_set_s32):
-        __(add imm0,arg_z,#misc_data_offset)
+        __(add imm0,arg_y,#misc_data_offset)
         __(test_fixnum(arg_z))
         __(moveq imm1,arg_z,asr #fixnumshift)
@@ -3718 +3718 @@
         __(b local_label(set_bad))
 local_label(misc_set_single_float_vector):
-        __(add imm0,arg_z,#misc_data_offset)
+        __(add imm0,arg_y,#misc_data_offset)
         __(extract_typecode(imm2,arg_z))
         __(cmp imm2,#subtag_single_float)