[Sbcl-commits] CVS: sbcl/src/compiler/x86 vm.lisp,1.23,1.24 arith.lisp,1.38,1.39

[Nathan F. <nf...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/x86
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21887/src/compiler/x86

Modified Files:
	vm.lisp arith.lisp 
Log Message:
0.9.9.18:
	Introduce new vm-support-routine COMBINATION-IMPLEMENTATION-STYLE
	  for letting the backend have a crack at implementing certain
	  functions directly (cf. OPTIMIZATIONS, #29);
	...implement a few efficient cases for PPC and x86.


Index: vm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/vm.lisp,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- vm.lisp	14 Jul 2005 19:13:49 -0000	1.23
+++ vm.lisp	7 Feb 2006 02:35:25 -0000	1.24
@@ -449,3 +449,34 @@
       (immediate-constant "Immed")
       (noise (symbol-name (sc-name sc))))))
 ;;; FIXME: Could this, and everything that uses it, be made #!+SB-SHOW?
+
+(!def-vm-support-routine combination-implementation-style (node)
+  (declare (type sb!c::combination node))
+  (flet ((valid-funtype (args result)
+           (sb!c::valid-fun-use node
+                                (sb!c::specifier-type
+                                 `(function ,args ,result)))))
+    (case (sb!c::combination-fun-source-name node)
+      (logtest
+       (cond
+         ((valid-funtype '(fixnum fixnum) '*)
+          (values :direct nil))
+         ((valid-funtype '((signed-byte 32) (signed-byte 32)) '*)
+          (values :direct nil))
+         ((valid-funtype '((unsigned-byte 32) (unsigned-byte 32)) '*)
+          (values :direct nil))
+         (t (values :default nil))))
+      (logbitp
+       (cond
+         ((and (valid-funtype '((integer 0 29) fixnum) '*)
+               (sb!c::constant-lvar-p (first (sb!c::basic-combination-args node))))
+          (values :transform '(lambda (index integer)
+                               (%logbitp integer index))))
+         ((valid-funtype '((integer 0 31) (signed-byte 32)) '*)
+          (values :transform '(lambda (index integer)
+                               (%logbitp integer index))))
+         ((valid-funtype '((integer 0 31) (unsigned-byte 32)) '*)
+          (values :transform '(lambda (index integer)
+                               (%logbitp integer index))))
+         (t (values :default nil))))
+      (t (values :default nil)))))

Index: arith.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/arith.lisp,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -d -r1.38 -r1.39
--- arith.lisp	6 Nov 2005 04:00:39 -0000	1.38
+++ arith.lisp	7 Feb 2006 02:35:25 -0000	1.39
@@ -1039,6 +1039,57 @@
   (:arg-types unsigned-num (:constant (unsigned-byte 32)))
   (:info target not-p y))
 
+(macrolet ((define-logtest-vops ()
+             `(progn
+               ,@(loop for suffix in '(/fixnum -c/fixnum
+                                       /signed -c/signed
+                                       /unsigned -c/unsigned)
+                       for cost in '(4 3 6 5 6 5)
+                       collect
+                       `(define-vop (,(symbolicate "FAST-LOGTEST" suffix)
+                                     ,(symbolicate "FAST-CONDITIONAL" suffix))
+                         (:translate logtest)
+                         (:generator ,cost
+                          (inst test x ,(if (eq suffix '-c/fixnum)
+                                            '(fixnumize y)
+                                            'y))
+                          (inst jmp (if not-p :e :ne) target)))))))
+  (define-logtest-vops))
+
+(defknown %logbitp (integer unsigned-byte) boolean
+  (movable foldable flushable))
+
+;;; too much work to do the non-constant case (maybe?)
+(define-vop (fast-logbitp-c/fixnum fast-conditional-c/fixnum)
+  (:translate %logbitp)
+  (:generator 4
+    (aver (< y 29))
+    (inst bt x (+ y n-fixnum-tag-bits))
+    (inst jmp (if not-p :nc :c) target)))
+
+(define-vop (fast-logbitp/signed fast-conditional/signed)
+  (:translate %logbitp)
+  (:generator 6
+    (inst bt x y)
+    (inst jmp (if not-p :nc :c) target)))
+
+(define-vop (fast-logbitp-c/signed fast-conditional-c/signed)
+  (:translate %logbitp)
+  (:generator 5
+    (inst bt x y)
+    (inst jmp (if not-p :nc :c) target)))
+
+(define-vop (fast-logbitp/unsigned fast-conditional/unsigned)
+  (:translate %logbitp)
+  (:generator 6
+    (inst bt x y)
+    (inst jmp (if not-p :nc :c) target)))
+
+(define-vop (fast-logbitp-/unsigned fast-conditional-c/unsigned)
+  (:translate %logbitp)
+  (:generator 5
+    (inst bt x y)
+    (inst jmp (if not-p :nc :c) target)))
 
 (macrolet ((define-conditional-vop (tran cond unsigned not-cond not-unsigned)
              `(progn