[Git][cmucl/cmucl][sparc64-dev] 2 commits: Fix up the fast-ash-right vops

[Raymond Toy]

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/34f8edd9936a038e22820e6e359cfbe958f7578a...caa31bdf92d9c27668e9cc55fdd89ced85f2fb79

---
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/34f8edd9936a038e22820e6e359cfbe958f7578a...caa31bdf92d9c27668e9cc55fdd89ced85f2fb79
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20180104/8c3fd027/attachment-0001.html>