external/oct/timing.lisp

   1 ;;;; -*- Mode: lisp -*-
   2 ;;;;
   3 ;;;; Copyright (c) 2007 Raymond Toy
   4 ;;;;
   5 ;;;; Permission is hereby granted, free of charge, to any person
   6 ;;;; obtaining a copy of this software and associated documentation
   7 ;;;; files (the "Software"), to deal in the Software without
   8 ;;;; restriction, including without limitation the rights to use,
   9 ;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell
  10 ;;;; copies of the Software, and to permit persons to whom the
  11 ;;;; Software is furnished to do so, subject to the following
  12 ;;;; conditions:
  13 ;;;;
  14 ;;;; The above copyright notice and this permission notice shall be
  15 ;;;; included in all copies or substantial portions of the Software.
  16 ;;;;
  17 ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  18 ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
  19 ;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  20 ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  21 ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  22 ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  23 ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
  24 ;;;; OTHER DEALINGS IN THE SOFTWARE.
  25
  26
  27 ;;; Some simple timing tests
  28 (in-package #:oct)
  29
  30 (defun time-add (&optional (n 100000))
  31   (declare (fixnum n))
  32   (flet ((sum-double ()
  33            (let ((sum 0d0))
  34              (declare (double-float sum)
  35                       (optimize (speed 3)))
  36              (dotimes (k n)
  37                (declare (fixnum k))
  38                (setf sum (cl:+ sum 1d0)))
  39              sum))
  40          (sum-%qd ()
  41            (let ((sum (qdi::make-qd-d 0d0))
  42                  (one (qdi::make-qd-d 1d0)))
  43              (declare (type qdi::%quad-double sum)
  44                       (optimize (speed 3)))
  45              (dotimes (k n)
  46                (declare (fixnum k))
  47                (setf sum (add-qd sum one)))
  48              sum))
  49          (sum-qd ()
  50            (let ((sum #q0))
  51              (declare (type qd-real sum)
  52                       (optimize (speed 3)))
  53              (dotimes (k n)
  54                (declare (fixnum k))
  55                (setf sum (+ sum #q1)))
  56              sum)))
  57     (format t "Add double-floats ~d times~%" n)
  58     #+cmu (ext:gc :full t)
  59     (time (sum-double))
  60     (format t "Add %quad-double (internal) ~d times~%" n)
  61     #+cmu (ext:gc :full t)
  62     (time (sum-%qd))
  63     (format t "Add QD-REAL (method) ~d times~%" n)
  64     #+cmu (ext:gc :full t)
  65     (time (sum-qd))))
  66
  67
  68 (defun time-mul (&optional (n 100000))
  69   (declare (fixnum n))
  70   (flet ((mul-double ()
  71            (let ((sum 0d0))
  72              (declare (double-float sum)
  73                       (optimize (speed 3)))
  74              (dotimes (k n)
  75                (declare (fixnum k))
  76                (setf sum (cl:* sum 1d0)))
  77              sum))
  78          (mul-%qd ()
  79            (let ((sum (qdi::make-qd-d 0d0))
  80                  (one (qdi::make-qd-d 1d0)))
  81              (declare (type qdi::%quad-double sum)
  82                       (optimize (speed 3)))
  83              (dotimes (k n)
  84                (declare (fixnum k))
  85                (setf sum (mul-qd sum one)))
  86              sum))
  87          (mul-qd ()
  88            (let ((sum #q0))
  89              (declare (type qd-real sum)
  90                       (optimize (speed 3)))
  91              (dotimes (k n)
  92                (declare (fixnum k))
  93                (setf sum (* sum #q1)))
  94              sum)))
  95     (format t "Multiply double-floats ~d times~%" n)
  96     #+cmu (ext:gc :full t)
  97     (time (mul-double))
  98     (format t "Multiply %quad-double (internal) ~d times~%" n)
  99     #+cmu (ext:gc :full t)
 100     (time (mul-%qd))
 101     (format t "Multiply QD-REAL (method) ~d times~%" n)
 102     #+cmu (ext:gc :full t)
 103     (time (mul-qd))))
 104
 105 (defun time-div (&optional (n 100000))
 106   (declare (fixnum n))
 107   (flet ((div-double ()
 108            (let ((sum 7d0))
 109              (declare (double-float sum)
 110                       (optimize (speed 3)))
 111              (dotimes (k n)
 112                (declare (fixnum k))
 113                (setf sum (cl:/ sum 1d0)))
 114              sum))
 115          (div-%qd ()
 116            (let ((sum (qdi::make-qd-d 7d0))
 117                  (one (qdi::make-qd-d 1d0)))
 118              (declare (type qdi::%quad-double sum)
 119                       (optimize (speed 3)))
 120              (dotimes (k n)
 121                (declare (fixnum k))
 122                (setf sum (div-qd sum one)))
 123              sum))
 124          (div-qd ()
 125            (let ((sum #q7))
 126              (declare (type qd-real sum)
 127                       (optimize (speed 3)))
 128              (dotimes (k n)
 129                (declare (fixnum k))
 130                (setf sum (/ sum #q1)))
 131              sum)))
 132     (format t "Divide double-floats ~d times~%" n)
 133     #+cmu (ext:gc :full t)
 134     (time (div-double))
 135     (format t "Divide %quad-double (internal) ~d times~%" n)
 136     #+cmu (ext:gc :full t)
 137     (time (div-%qd))
 138     (format t "Divide QD-REAL (method) ~d times~%" n)
 139     #+cmu (ext:gc :full t)
 140     (time (div-qd))))
 141
 142 (defun time-sqrt (&optional (n 100000))
 143   (declare (fixnum n))
 144   (flet ((sqrt-double ()
 145            (let ((sum 7d0))
 146              (declare (double-float sum)
 147                       (optimize (speed 3)))
 148              (dotimes (k n)
 149                (declare (fixnum k))
 150                (setf sum (cl:sqrt sum)))
 151              sum))
 152          (sqrt-%qd ()
 153            (let ((sum (qdi::make-qd-d 7d0)))
 154              (declare (type qdi::%quad-double sum)
 155                       (optimize (speed 3)))
 156              (dotimes (k n)
 157                (declare (fixnum k))
 158                (setf sum (sqrt-qd sum)))
 159              sum))
 160          (sqrt-qd-real ()
 161            (let ((sum #q7))
 162              (declare (type qd-real sum)
 163                       (optimize (speed 3)))
 164              (dotimes (k n)
 165                (declare (fixnum k))
 166                (setf sum (sqrt sum)))
 167              sum)))
 168     (format t "Sqrt double-floats ~d times~%" n)
 169     #+cmu (ext:gc :full t)
 170     (time (sqrt-double))
 171     (format t "Sqrt %quad-double (internal) ~d times~%" n)
 172     #+cmu (ext:gc :full t)
 173     (time (sqrt-%qd))
 174     (format t "Sqrt QD-REAL (method) ~d times~%" n)
 175     #+cmu (ext:gc :full t)
 176     (time (sqrt-qd-real))))