1  (defpackage "POPCNT"
 2    (:use :cl)
 3    (:export "POPCNT"))
 4  
 5  (in-package "POPCNT")
 6  
 7  (sb-c:defknown popcnt ((unsigned-byte 64)) (integer 0 64)
 8      (sb-c:foldable sb-c:flushable sb-c:movable)
 9    :overwrite-fndb-silently t)
10  
11  (sb-c:defknown test ((unsigned-byte 64) (unsigned-byte 64)) (unsigned-byte 64)
12      (sb-c:foldable sb-c:flushable sb-c:movable)
13    :overwrite-fndb-silently t)
14  
15  (in-package "SB-VM")
16  
17  (define-vop (popcnt:popcnt)
18    (:policy :fast-safe)
19    (:translate popcnt:popcnt)
20    (:args (x :scs (unsigned-reg) :target r))
21    (:arg-types unsigned-num)
22    (:results (r :scs (unsigned-reg)))
23    (:result-types unsigned-num)
24    (:generator 3
25       (unless (location= r x)
26  	(inst xor r r))
27       (inst popcnt r x)))
28    
29  (define-vop (popcnt:popcnt)
30    (:policy :fast-safe)
31    (:translate popcnt:popcnt)
32    (:args (x :scs (unsigned-reg) :target r))
33    (:arg-types unsigned-num)
34    (:results (r :scs (unsigned-reg)))
35    (:result-types unsigned-num)
36    (:generator 3
37       (unless (location= r x)
38  	(inst xor r r))
39       (inst popcnt r x)))
40  
41  (define-vop (popcnt::testillo)
42    (:policy :fast-safe)
43    (:translate popcnt::test)
44    (:args (x :scs (any-reg) :target r)
45  	 (y :scs (any-reg)))
46    (:arg-types positive-fixnum positive-fixnum)
47    (:results (r :scs (unsigned-reg)))
48    (:result-types unsigned-num)
49    (:generator 0
50       (move r x)
51       (inst nop)
52       (inst nop)
53       (inst nop)
54       (inst add r y)))
55  
56  (in-package "POPCNT")
57  
58  (defun popcnt (x)
59    (popcnt x))
60  
61  (defun testillo (x y)
62    (test x y))