contrib/sb-gmp/bench.lisp

   1 (defpackage :sb-gmp-bench (:use "COMMON-LISP"))
   2
   3 (in-package :sb-gmp-bench)
   4
   5 (defparameter *stream* t)
   6
   7 (defparameter *state* nil)
   8
   9 (defun bench-+ () ; limbs: never
  10   (macrolet ((tstfun (f a b)
  11                `(lambda ()
  12                   (loop for i in ,a
  13                         for j in ,b
  14                         collect (,f i j)))))
  15     (loop for limbs fixnum from 2
  16           with gmp-win = 0
  17           until (or (= gmp-win 5)
  18                     (= limbs 78)) ; > 78 exhausts default heap size
  19           do
  20              (loop
  21                for i below 100000
  22                collect (sb-gmp::bassert (sb-gmp:random-bitcount *state* (* limbs sb-vm:n-word-bits)))
  23                  into list-a
  24                collect (sb-gmp::bassert (sb-gmp:random-bitcount *state* (* limbs sb-vm:n-word-bits)))
  25                  into list-b
  26                finally
  27                   (let (time1 time2)
  28                     (let ((r-sbcl (progn (sb-ext:gc)
  29                                          (sb-ext:call-with-timing
  30                                           (lambda (&rest plist)
  31                                             (setf time1 plist))
  32                                           (tstfun + list-a list-b))))
  33                           (r-gmp (progn (sb-ext:gc)
  34                                         (sb-ext:call-with-timing
  35                                          (lambda (&rest plist)
  36                                            (setf time2 plist))
  37                                          (tstfun sb-gmp:mpz-add list-a list-b)))))
  38                       (format *stream* "limbs: ~s~%Time SBCL: ~s~%Time GMP:  ~s~%"
  39                               limbs time1 time2)
  40                       (when (< (getf time2 :PROCESSOR-CYCLES)
  41                                (getf time1 :PROCESSOR-CYCLES))
  42                         (incf gmp-win))
  43                       (if (= (length r-sbcl) (length r-gmp))
  44                           (format *stream* "Test PASSED~2%")
  45                           (format *stream* "Test FAILED~2%"))))))))
  46
  47
  48 (defun bench-* () ; limbs 6
  49   (macrolet ((tstfun (f a b)
  50                `(lambda ()
  51                   (loop for i in ,a
  52                         for j in ,b
  53                         collect (,f i j)))))
  54     (loop for limbs fixnum from 2
  55           with gmp-win = 0
  56           until (or (= gmp-win 3)
  57                     (= limbs 100))
  58           do
  59              (loop
  60                for i below 10000
  61                collect (sb-gmp::bassert (sb-gmp:random-bitcount *state* (* limbs sb-vm:n-word-bits)))
  62                  into list-a
  63                collect (sb-gmp::bassert (sb-gmp:random-bitcount *state* (* limbs sb-vm:n-word-bits)))
  64                  into list-b
  65                finally
  66                   (let (time1 time2)
  67                     (let ((r-sbcl (progn (sb-ext:gc)
  68                                          (sb-ext:call-with-timing
  69                                           (lambda (&rest plist)
  70                                             (setf time1 plist))
  71                                           (tstfun * list-a list-b))))
  72                           (r-gmp (progn (sb-ext:gc)
  73                                         (sb-ext:call-with-timing
  74                                          (lambda (&rest plist)
  75                                            (setf time2 plist))
  76                                          (tstfun sb-gmp:mpz-mul list-a list-b)))))
  77                       (format *stream* "limbs: ~s~%Time SBCL: ~s~%Time GMP:  ~s~%"
  78                               limbs time1 time2)
  79                       (when (< (getf time2 :PROCESSOR-CYCLES)
  80                                (getf time1 :PROCESSOR-CYCLES))
  81                         (incf gmp-win))
  82                       (if (= (length r-sbcl) (length r-gmp))
  83                           (format *stream* "Test PASSED~2%")
  84                           (format *stream* "Test FAILED~2%"))))))))
  85
  86 (defun bench-/ () ; limbs 3 / 2
  87   (macrolet ((tstfun (f a b)
  88                `(lambda ()
  89                   (loop for i in ,a
  90                         for j in ,b
  91                         collect (,f i j)))))
  92     (loop for limbs fixnum from 2
  93           for limbs_b fixnum from 1
  94           with gmp-win = 0
  95           until (or (= gmp-win 3)
  96                     (= limbs 100))
  97           do
  98              (loop
  99                for i below 100
 100                collect (sb-gmp::bassert (sb-gmp:random-bitcount *state* (* limbs sb-vm:n-word-bits)))
 101                  into list-a
 102                collect (sb-gmp::bassert (sb-gmp:random-bitcount *state* (* limbs_b sb-vm:n-word-bits)))
 103                  into list-b
 104                finally
 105                   (let (time1 time2)
 106                     (format t "bench it~%")
 107                     (let ((r-sbcl (progn (sb-ext:gc)
 108                                          (sb-ext:call-with-timing
 109                                           (lambda (&rest plist)
 110                                             (setf time1 plist))
 111                                           (tstfun truncate list-a list-b))))
 112                           (r-gmp (progn (sb-ext:gc)
 113                                         (sb-ext:call-with-timing
 114                                          (lambda (&rest plist)
 115                                            (setf time2 plist))
 116                                          (tstfun sb-gmp:mpz-tdiv list-a list-b)))))
 117                       (format *stream* "limbs: ~s~%Time SBCL: ~s~%Time GMP:  ~s~%"
 118                               limbs time1 time2)
 119                       (when (< (getf time2 :PROCESSOR-CYCLES)
 120                                (getf time1 :PROCESSOR-CYCLES))
 121                         (incf gmp-win))
 122                       (if (= (length r-sbcl) (length r-gmp))
 123                           (format *stream* "Test PASSED~2%")
 124                           (format *stream* "Test FAILED~2%"))))))))
 125
 126 (defun bench-gcd () ; limbs: always
 127   (macrolet ((tstfun (f a b)
 128                `(lambda ()
 129                   (loop for i in ,a
 130                         for j in ,b
 131                         collect (,f i j)))))
 132     (loop for limbs fixnum from 2
 133           for limbs_b fixnum from 1
 134           with gmp-win = 0
 135           until (or (= gmp-win 3)
 136                     (= limbs 100))
 137           do
 138              (loop
 139                for i below 100
 140                collect (sb-gmp::bassert (sb-gmp:random-bitcount *state* (* limbs sb-vm:n-word-bits)))
 141                  into list-a
 142                collect (sb-gmp::bassert (sb-gmp:random-bitcount *state* (* limbs_b sb-vm:n-word-bits)))
 143                  into list-b
 144                finally
 145                   (let (time1 time2)
 146                     (format t "bench it~%")
 147                     (let ((r-sbcl (progn (sb-ext:gc)
 148                                          (sb-ext:call-with-timing
 149                                           (lambda (&rest plist)
 150                                             (setf time1 plist))
 151                                           (tstfun gcd list-a list-b))))
 152                           (r-gmp (progn (sb-ext:gc)
 153                                         (sb-ext:call-with-timing
 154                                          (lambda (&rest plist)
 155                                            (setf time2 plist))
 156                                          (tstfun sb-gmp:mpz-gcd list-a list-b)))))
 157                       (format *stream* "limbs: ~s~%Time SBCL: ~s~%Time GMP:  ~s~%"
 158                               limbs time1 time2)
 159                       (when (< (getf time2 :PROCESSOR-CYCLES)
 160                                (getf time1 :PROCESSOR-CYCLES))
 161                         (incf gmp-win))
 162                       (if (= (length r-sbcl) (length r-gmp))
 163                           (format *stream* "Test PASSED~2%")
 164                           (format *stream* "Test FAILED~2%"))))))))
 165
 166 (defun bench-isqrt () ; limbs: always
 167   (macrolet ((tstfun (f a)
 168                `(lambda ()
 169                   (loop for i in ,a
 170                         collect (,f i)))))
 171     (loop for limbs fixnum from 1
 172           with gmp-win = 0
 173           until (or (= gmp-win 3)
 174                     (= limbs 100))
 175           do
 176              (loop
 177                for i below 100
 178                collect (sb-gmp::bassert (sb-gmp:random-bitcount *state* (* limbs sb-vm:n-word-bits)))
 179                  into list-a
 180                finally
 181                   (let (time1 time2)
 182                     (format t "bench it~%")
 183                     (let ((r-sbcl (progn (sb-ext:gc)
 184                                          (sb-ext:call-with-timing
 185                                           (lambda (&rest plist)
 186                                             (setf time1 plist))
 187                                           (tstfun isqrt list-a))))
 188                           (r-gmp (progn (sb-ext:gc)
 189                                         (sb-ext:call-with-timing
 190                                          (lambda (&rest plist)
 191                                            (setf time2 plist))
 192                                          (tstfun sb-gmp:mpz-sqrt list-a)))))
 193                       (format *stream* "limbs: ~s~%Time SBCL: ~s~%Time GMP:  ~s~%"
 194                               limbs time1 time2)
 195                       (when (< (getf time2 :PROCESSOR-CYCLES)
 196                                (getf time1 :PROCESSOR-CYCLES))
 197                         (incf gmp-win))
 198                       (if (= (length r-sbcl) (length r-gmp))
 199                           (format *stream* "Test PASSED~2%")
 200                           (format *stream* "Test FAILED~2%"))))))))
 201
 202 (defun bench-q+ () ; limbs: always
 203   (macrolet ((tstfun (f a b)
 204                `(lambda ()
 205                   (loop for i in ,a
 206                         for j in ,b
 207                         collect (,f i j)))))
 208     (loop for limbsa fixnum from 2
 209           for limbsb fixnum from 1
 210           with gmp-win = 0
 211           until (or (= gmp-win 5)
 212                     (= limbsa 50))
 213           do
 214              (loop
 215                for i below 10000
 216                collect (/ (sb-gmp:random-bitcount *state* (* limbsa sb-vm:n-word-bits))
 217                           (sb-gmp:random-bitcount *state* (* limbsb sb-vm:n-word-bits)))
 218                  into list-a
 219                collect (/ (sb-gmp:random-bitcount *state* (* limbsa sb-vm:n-word-bits))
 220                           (sb-gmp:random-bitcount *state* (* limbsb sb-vm:n-word-bits)))
 221                  into list-b
 222                finally
 223                   (let (time1 time2)
 224                     (let ((r-sbcl (progn (sb-ext:gc)
 225                                          (sb-ext:call-with-timing
 226                                           (lambda (&rest plist)
 227                                             (setf time1 plist))
 228                                           (tstfun + list-a list-b))))
 229                           (r-gmp (progn (sb-ext:gc)
 230                                         (sb-ext:call-with-timing
 231                                          (lambda (&rest plist)
 232                                            (setf time2 plist))
 233                                          (tstfun sb-gmp:mpq-add list-a list-b)))))
 234                       (format *stream* "limbs: ~s~%Time SBCL: ~s~%Time GMP:  ~s~%"
 235                               limbsa time1 time2)
 236                       (when (< (getf time2 :PROCESSOR-CYCLES)
 237                                (getf time1 :PROCESSOR-CYCLES))
 238                         (incf gmp-win))
 239                       (if (= (length r-sbcl) (length r-gmp))
 240                           (format *stream* "Test PASSED~2%")
 241                           (format *stream* "Test FAILED~2%"))))))))
 242
 243 (defun bench-q* () ; limbs: always
 244   (macrolet ((tstfun (f a b)
 245                `(lambda ()
 246                   (loop for i in ,a
 247                         for j in ,b
 248                         collect (,f i j)))))
 249     (loop for limbsa fixnum from 2
 250           for limbsb fixnum from 1
 251           with gmp-win = 0
 252           until (or (= gmp-win 5)
 253                     (= limbsa 50))
 254           do
 255              (loop
 256                for i below 10000
 257                collect (/ (sb-gmp:random-bitcount *state* (* limbsa sb-vm:n-word-bits))
 258                           (sb-gmp:random-bitcount *state* (* limbsb sb-vm:n-word-bits)))
 259                  into list-a
 260                collect (/ (sb-gmp:random-bitcount *state* (* limbsa sb-vm:n-word-bits))
 261                           (sb-gmp:random-bitcount *state* (* limbsb sb-vm:n-word-bits)))
 262                  into list-b
 263                finally
 264                   (let (time1 time2)
 265                     (let ((r-sbcl (progn (sb-ext:gc)
 266                                          (sb-ext:call-with-timing
 267                                           (lambda (&rest plist)
 268                                             (setf time1 plist))
 269                                           (tstfun * list-a list-b))))
 270                           (r-gmp (progn (sb-ext:gc)
 271                                         (sb-ext:call-with-timing
 272                                          (lambda (&rest plist)
 273                                            (setf time2 plist))
 274                                          (tstfun sb-gmp:mpq-mul list-a list-b)))))
 275                       (format *stream* "limbs: ~s~%Time SBCL: ~s~%Time GMP:  ~s~%"
 276                               limbsa time1 time2)
 277                       (when (< (getf time2 :PROCESSOR-CYCLES)
 278                                (getf time1 :PROCESSOR-CYCLES))
 279                         (incf gmp-win))
 280                       (if (= (length r-sbcl) (length r-gmp))
 281                           (format *stream* "Test PASSED~2%")
 282                           (format *stream* "Test FAILED~2%"))))))))
 283
 284 (defun bench ()
 285   (let ((*state* (sb-gmp:make-gmp-rstate)))
 286     (sb-gmp:rand-seed *state* 1234)
 287     (bench-q*)))