Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: d11ccfbf by Raymond Toy at 2018-01-03T20:55:23-08:00 Fix up the fast-ash-right vops Remove some nil'ed out code too. - - - - - caa31bdf by Raymond Toy at 2018-01-03T21:01:16-08:00 Mark allocate-vector and fix up length computation * Add NOT-IMPLEMENTED for this routine. * The number of words needs to be multiplied by 2 to get the actual number of bytes since fixnums are only shifted by 2, and words are now 8 bytes long. - - - - - 2 changed files: - src/assembly/sparc64/array.lisp - src/compiler/sparc64/arith.lisp Changes: ===================================== src/assembly/sparc64/array.lisp ===================================== --- a/src/assembly/sparc64/array.lisp +++ b/src/assembly/sparc64/array.lisp @@ -32,8 +32,12 @@ (:temp ndescr non-descriptor-reg nl0-offset) (:temp gc-temp non-descriptor-reg nl1-offset) (:temp vector descriptor-reg a3-offset)) + (not-implemented "ALLOCATE-VECTOR") (pseudo-atomic () - (inst add ndescr words (* (1+ vm:vector-data-offset) vm:word-bytes)) + ;; words is a fixnum. Multiply by 2 to get the actual number of + ;; bytes to allocate. + (inst sllx ndescr words 1) + (inst add ndescr ndescr (* (1+ vm:vector-data-offset) vm:word-bytes)) (inst andn ndescr vm:lowtag-mask) (allocation vector ndescr other-pointer-type :temp-tn gc-temp) #+gencgc @@ -42,7 +46,7 @@ ;; space. Fill the last word with a zero. (inst add ndescr vector) (storew zero-tn ndescr -1 vm:other-pointer-type)) - (inst srl ndescr type vm:word-shift) + (inst srl ndescr type vm:fixnum-tag-bits) (storew ndescr vector 0 vm:other-pointer-type) (storew length vector vm:vector-length-slot vm:other-pointer-type)) ;; This makes sure the zero byte at the end of a string is paged in so ===================================== src/compiler/sparc64/arith.lisp ===================================== --- a/src/compiler/sparc64/arith.lisp +++ b/src/compiler/sparc64/arith.lisp @@ -555,15 +555,9 @@ (let ((amt (tn-value amount))) (inst ,shift-inst result number amt)))))))) (frob ash-right-signed fast-ash-right/signed=>signed - signed-reg signed-num sra 3) + signed-reg signed-num sran 3) (frob ash-right-unsigned fast-ash-right/unsigned=>unsigned - unsigned-reg unsigned-num srl 3) - #+(and sparc-v9 sparc-v8plus) - (frob ash-right-signed fast-ash-right/signed64=>signed64 - signed64-reg signed64-num srax 3) - #+(and sparc-v9 sparc-v8plus) - (frob ash-right-unsigned fast-ash-right/unsigned64=>unsigned64 - unsigned64-reg unsigned64-num srlx 3) + unsigned-reg unsigned-num srln 3) ) ;; Constant right shift. @@ -585,32 +579,11 @@ (move result number) (inst ,shift-inst result number amount)))))) (frob ash-right-signed fast-ash-right-c/signed=>signed - signed-reg signed-num sra 1 31) + signed-reg signed-num sran 1 63) (frob ash-right-unsigned fast-ash-right-c/unsigned=>unsigned - unsigned-reg unsigned-num srl 1 31) - #+(and sparc-v9 sparc-v8plus) - (frob ash-right-signed fast-ash-right-c/signed64=>signed64 - signed64-reg signed64-num srax 1 63) - #+(and sparc-v9 sparc-v8plus) - (frob ash-right-unsigned fast-ash-right-c/unsigned64=>unsigned64 - unsigned64-reg unsigned64-num srlx 1 63) + unsigned-reg unsigned-num srln 1 63) ) -#+nil -(define-vop (fash-ash-right-c/signed=>signed fast-signed-binop-c) - (:args (x :target r :scs (signed-reg zero))) - (:arg-types signed-num - (:constant (integer 0 31))) - (:results (r :scs (signed-reg))) - (:result-types signed-num) - (:translate ash-right-signed) - (:note _N"inline (signed-byte 32) arithmetic") - (:generator 1 - (if (zerop y) - (move r x) - (inst srln r x y)))) - - (define-vop (fast-ash-right/fixnum=>fixnum) (:note _N"inline right ASH") (:translate ash-right-signed) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/34f8edd9936a038e22820e6e3... --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/34f8edd9936a038e22820e6e3... You're receiving this email because of your account on gitlab.common-lisp.net.