(in-package :cl-user)



;;; see
;;; http://www.franz.com/support/documentation/6.0/doc/compiling.htm#opt-for-fast-fp-2
;;;
;;; notes:
;;;
;;; for allegro, the optimize declaration must apply to the entire function
;;; body. it has a negligible effect if placed inside the let.

(defun test-single-heap (short count)
    (declare (type short-float short) (type fixnum count))
    (let ((result 1.0s0))
      (declare (type short-float result))
      (declare (optimize (speed 3) (safety 0)))
      (dotimes (x count)
        (setf result (* result short))
        (setf result (/ result 2.0s0)))
      (* result 1.0s0)))

(defun test-single-stack (short count)
    (declare (type short-float short) (type fixnum count))
    (declare (optimize (speed 3) (safety 0)))
    (let ((result 1.0s0))
      (declare (type short-float result) (dynamic-extent result))
      (dotimes (x count)
        (setf result (* result short))
        (setf result (/ result 2.0s0)))
      (* result 1.0s0)))

(defun test-double-heap (float count)
    (declare (type double-float float) (type fixnum count))
    (let ((result 1.0d0))
      (declare (type double-float result))
      (declare (optimize (speed 3) (safety 0)))
      (dotimes (x count)
        (setf result (* result float))
        (setf result (/ result 2.0d0)))
      (* result 1.0d0)))

(defun test-double-stack (float count)
    (declare (type double-float float) (type fixnum count)
             #+allegro (:explain :boxing :variables))
    (declare (optimize (speed 3) (safety 0)))
    (let ((result 1.0d0))
      (declare (type double-float result) (dynamic-extent result))
      (dotimes (x count)
        (setf result (* result float))
        (setf result (/ result 2.0d0)))
      (type-of result)))
;; explain should indicate that float and result are stored on the stack

(time (test-single-heap 1.0s0 1000000))
(time (test-single-stack 1.0s0 1000000))
(time (test-double-heap 1.0d0 1000000))
;; nb. mcl5.0 a factor 10 more overflows the byte count
(time (test-double-stack 1.0d0 1000000))