Changeset 13819


Ignore:
Timestamp:
Jun 14, 2010, 10:13:09 AM (9 years ago)
Author:
gb
Message:

Need %NORMALIZE-BIGNUM-2, %FLOOR-LOOP-QUO.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/arm/level-0/ARM/arm-bignum.lisp

    r13805 r13819  
    984984    (bx lr)))
    985985
    986 #+notyet
    987986(defarmlapfunction %normalize-bignum-2 ((fixp arg_y)(res arg_z))
    988987  (let ((idx imm0)
     
    991990        (len arg_x)
    992991        (oldlen temp0))
    993     (ldr imm4 res (:$ (- arm::fulltag-misc)))
    994     (header-length len imm4)
    995     (cmpwi len 0)
    996     (mr oldlen len)
    997     (addi idx len (- arm::misc-data-offset 4)) 
    998     (beqlr) ; huh - can this ever happen?
     992    (vector-length len res imm0)
     993    (cmp len (:$ 0))
     994    (mov oldlen len)
     995    (add idx len (:$ (- arm::misc-data-offset 4))  )
     996    (bxeq lr) ; huh - can this ever happen?
    999997    (ldr val (:@ res idx)) ; high order word
    1000     (srawi usign val 31) ; get sign
     998    (mov usign (:asr val (:$ 31))) ; get sign
    1001999    @loop
    10021000    (ldr val (:@ res idx))
    1003     (cmpw  val usign)   
    1004     (subi idx idx '1)
     1001    (cmp  val usign)   
     1002    (sub idx idx '1)
    10051003    (bne @neq)   
    1006     (subic. len len '1)
     1004    (subs len len '1)
    10071005    (bgt @loop)
    10081006    ; fall through - its all sign - return 1
    1009     (li len '1)
    1010     (rlwinm usign usign 0 0 0) ; hi bit
     1007    (mov len '1)
     1008    (and usign usign (:$ #x80000000))
    10111009    (b @more)
    10121010    @neq
    1013     (rlwinm usign usign 0 0 0) ; hi bit
    1014     (rlwinm val val 0 0 0)
    1015     (cmpw usign val)  ; is hi bit = sign, if so then done   
     1011    (and usign usign (:$ #x80000000))
     1012    (and val val (:$ #x80000000))
     1013    (cmp usign val)  ; is hi bit = sign, if so then done   
    10161014    (beq @more)
    1017     (addi len len '1) ; if not, need 1 more
     1015    (add len len '1) ; if not, need 1 more
    10181016    (b @big)
    10191017    @more
    1020     (cmpwi :cr1 fixp arm::nil-value)
    1021     (cmpwi len '1)
    1022     (beq :cr1 @big)  ; dont return fixnum
     1018    (cmp  fixp 'nil)
     1019    (beq @big)                          ; dont return fixnum
     1020    (cmp len '1)
    10231021    (bgt @big)
    10241022    ;; stuff for maybe fixnum
    10251023    ;(dbg t)
    1026     (ldr val res (:$ arm::misc-data-offset))
    1027     (rlwinm imm4 val 0 0 2) ; hi 3 bits same? - we assume fixnumshift is 2
    1028     (srawi usign usign 2)
    1029     (cmpw usign imm4)
    1030     (bne @big)   
     1024    (ldr val (:@ res (:$ arm::misc-data-offset)))
    10311025    (box-fixnum arg_z val)
    1032     (bx lr)
     1026    (cmp val (:asr arg_z (:$ arm::fixnumshift)))
     1027    (bxeq lr)
    10331028    @big
    1034     (cmpw oldlen len)
    1035     (beqlr) ; same length - done
    1036     (li imm4 arm::subtag-bignum) ; set new length
    1037     (rlwimi imm4 len (- arm::num-subtag-bits arm::fixnumshift) 0 (- 31 arm::num-subtag-bits))
    1038     (str imm4 res  (:$ arm::misc-header-offset))
    1039     ; 0 to tail if negative
    1040     (cmpwi usign 0)
    1041     (beqlr)
    1042      ; zero from len inclusive to oldlen exclusive
    1043     ;(dbg t)
    1044     (addi idx len arm::misc-data-offset)
     1029    (cmp oldlen len)
     1030    (bxeq lr) ; same length - done
     1031    (mov imm2 (:$ arm::subtag-bignum))
     1032    (cmp usign (:$ 0))
     1033    (orr imm2 imm2 (:lsl len (:$ (- arm::num-subtag-bits arm::fixnumshift))))
     1034    (str imm2 (:@ res (:$ arm::misc-header-offset)))
     1035    ;; 0 to tail if negative
     1036    (bxeq lr)
     1037    ;; zero from len inclusive to oldlen exclusive
     1038    (mov temp0 (:$ 0))
     1039    (add idx len (:$ arm::misc-data-offset))
    10451040    @loop2
    1046     (str rzero (:@ idx res))
    1047     (addi len len '1)
    1048     (cmpw len oldlen)
    1049     (addi idx idx '1)
     1041    (str temp0 (:@ idx res))
     1042    (add len len '1)
     1043    (cmp len oldlen)
     1044    (add idx idx '1)
    10501045    (blt @loop2)
    10511046    (bx lr)))
     
    11271122    (str header (:@ bignum  (:$ arm::misc-header-offset)))
    11281123    (bx lr)))
     1124
     1125;;; Divide bignum x by single digit y (passed as two halves).
     1126;;; The quotient in stored in q, and the remainder is returned
     1127;;; in two halves.  (cf. Knuth, 4.3.1, exercise 16)
     1128(defarmlapfunction %floor-loop-quo ((x 0) (res arg_x) (yhi arg_y) (ylo arg_z))
     1129  (let ((bignum temp0)
     1130        (len temp2))                    ;not nfn here.
     1131    (ldr bignum (:@ vsp (:$ x)))
     1132    (add imm1 vsp (:$ arm::node-size))
     1133    (build-lisp-frame imm0 imm1)
     1134    (vector-length len bignum imm0)
     1135    (mov imm2 (:$ 0))
     1136    (b @next)
     1137    @loop
     1138    (add imm0 len (:$ arm::misc-data-offset))
     1139    (ldr imm0 (:@ bignum imm0))
     1140    (mov imm1 imm2)
     1141    (compose-digit imm2 yhi ylo)
     1142    (bl .SPudiv64by32)
     1143    (add imm1 len (:$ arm::misc-data-offset))
     1144    (str imm0 (:@ res imm1))
     1145    @next
     1146    (subs len len '1)
     1147    (bge @loop)
     1148    (digit-h yhi imm2)
     1149    (digit-l ylo imm2)
     1150    (vpush1 yhi)
     1151    (vpush1 ylo)
     1152    (set-nargs 2)
     1153    (ba .SPnvalret)))
    11291154   
     1155   
     1156
    11301157
    11311158; End of arm-bignum.lisp
Note: See TracChangeset for help on using the changeset viewer.