Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl

Commits:

2 changed files:

Changes:

  • src/assembly/sparc64/array.lisp
    ... ... @@ -32,8 +32,12 @@
    32 32 
     			  (:temp ndescr non-descriptor-reg nl0-offset)
    33 33 
     			  (:temp gc-temp non-descriptor-reg nl1-offset)
    34 34 
     			  (:temp vector descriptor-reg a3-offset))
    35 
    +  (not-implemented "ALLOCATE-VECTOR")
    35 36 
       (pseudo-atomic ()
    36 
    -    (inst add ndescr words (* (1+ vm:vector-data-offset) vm:word-bytes))
    37 
    +    ;; words is a fixnum.  Multiply by 2 to get the actual number of
    38 
    +    ;; bytes to allocate.
    39 
    +    (inst sllx ndescr words 1)
    40 
    +    (inst add ndescr ndescr (* (1+ vm:vector-data-offset) vm:word-bytes))
    37 41 
         (inst andn ndescr vm:lowtag-mask)
    38 42 
         (allocation vector ndescr other-pointer-type :temp-tn gc-temp)
    39 43 
         #+gencgc
    ... ... @@ -42,7 +46,7 @@
    42 46 
           ;; space.  Fill the last word with a zero.
    43 47 
           (inst add ndescr vector)
    44 48 
           (storew zero-tn ndescr -1 vm:other-pointer-type))
    45 
    -    (inst srl ndescr type vm:word-shift)
    49 
    +    (inst srl ndescr type vm:fixnum-tag-bits)
    46 50 
         (storew ndescr vector 0 vm:other-pointer-type)
    47 51 
         (storew length vector vm:vector-length-slot vm:other-pointer-type))
    48 52 
       ;; This makes sure the zero byte at the end of a string is paged in so

  • src/compiler/sparc64/arith.lisp
    ... ... @@ -555,15 +555,9 @@
    555 555 
     	      (let ((amt (tn-value amount)))
    556 556 
     		(inst ,shift-inst result number amt))))))))
    557 557 
       (frob ash-right-signed fast-ash-right/signed=>signed
    558 
    -	signed-reg signed-num sra 3)
    558 
    +	signed-reg signed-num sran 3)
    559 559 
       (frob ash-right-unsigned fast-ash-right/unsigned=>unsigned
    560 
    -	unsigned-reg unsigned-num srl 3)
    561 
    -  #+(and sparc-v9 sparc-v8plus)
    562 
    -  (frob ash-right-signed fast-ash-right/signed64=>signed64
    563 
    -	signed64-reg signed64-num srax 3)
    564 
    -  #+(and sparc-v9 sparc-v8plus)
    565 
    -  (frob ash-right-unsigned fast-ash-right/unsigned64=>unsigned64
    566 
    -	unsigned64-reg unsigned64-num srlx 3)
    560 
    +	unsigned-reg unsigned-num srln 3)
    567 561 
       )
    568 562
    569 563 
     ;; Constant right shift.
    ... ... @@ -585,32 +579,11 @@
    585 579 
     	       (move result number)
    586 580 
     	       (inst ,shift-inst result number amount))))))
    587 581 
       (frob ash-right-signed fast-ash-right-c/signed=>signed
    588 
    -	signed-reg signed-num sra 1 31)
    582 
    +	signed-reg signed-num sran 1 63)
    589 583 
       (frob ash-right-unsigned fast-ash-right-c/unsigned=>unsigned
    590 
    -	unsigned-reg unsigned-num srl 1 31)
    591 
    -  #+(and sparc-v9 sparc-v8plus)
    592 
    -  (frob ash-right-signed fast-ash-right-c/signed64=>signed64
    593 
    -	signed64-reg signed64-num srax 1 63)
    594 
    -  #+(and sparc-v9 sparc-v8plus)
    595 
    -  (frob ash-right-unsigned fast-ash-right-c/unsigned64=>unsigned64
    596 
    -	unsigned64-reg unsigned64-num srlx 1 63)
    584 
    +	unsigned-reg unsigned-num srln 1 63)
    597 585 
       )
    598 586
    599 
    -#+nil
    600 
    -(define-vop (fash-ash-right-c/signed=>signed fast-signed-binop-c)
    601 
    -  (:args (x :target r :scs (signed-reg zero)))
    602 
    -  (:arg-types signed-num
    603 
    -	      (:constant (integer 0 31)))
    604 
    -  (:results (r :scs (signed-reg)))
    605 
    -  (:result-types signed-num)
    606 
    -  (:translate ash-right-signed)
    607 
    -  (:note _N"inline (signed-byte 32) arithmetic")
    608 
    -  (:generator 1
    609 
    -    (if (zerop y)
    610 
    -	(move r x)
    611 
    -	(inst srln r x y))))
    612 
    -
    613 
    -
    614 587 
     (define-vop (fast-ash-right/fixnum=>fixnum)
    615 588 
         (:note _N"inline right ASH")
    616 589 
       (:translate ash-right-signed)

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. If you'd like to receive fewer emails, you can adjust your notification settings.