;;; .EnTete "Le-Lisp (c) version 15.2" " " "Test des fonctions flottantes"
;;; .EnPied "testfloat.ll" "%" " "
;;;
;;; .SuperTitre "Test des fonctions flottantes"
;;;
;;;
;;; .Centre "*****************************************************************"
;;; .Centre " Ce fichier est en lecture seule hors du projet ALE de l'INRIA.  "
;;; .Centre " Il est maintenu par ILOG SA, 2 Avenue Gallie'ni, 94250 Gentilly "
;;; .Centre " (c) Le-Lisp est une marque de'pose'e de l'INRIA                 "
;;; .Centre "*****************************************************************"
;;;
;;; .Centre "$Header: testfloat.ll,v 4.3 88/12/19 20:07:43 kuczynsk Exp $"


; Ce fichier teste et mesure les performances des fonctions
; en virgule flottante des syste`mes Le-Lisp > 15.2

; Ce fichier fait partie de la recette standard.

(unless (>= (version) 15.2)
        (error 'load 'erricf 'testfloat))

(setq #:sys-package:colon 'testfloat)

; Charge la fonction de comparaison et les constantes flottantes.
(unless (featurep 'testcomm)
       (libload testcomm t))
; Pour les 64bitfloats
(unless (or (featurep '64bitfloats)
            (eq 0. 0.))
	(add-feature '64bitfloats))

(defvar :counter 10000)            ; compteur (nb de boucles par test)

(defvar :speak ())                 ; pour faire causer le compilateur

(defvar :liste-de-test '(
			 
	  (fadd 10. 20.)                30.
          (fadd 10. -30.)               -20.
	  (fadd 1000. 12000.)           13000.
	  (fadd -1000. 2000.)           1000.
          (fsub 20. 1.)                 19.
          (fsub 10. -30.)               40.
	  (fsub 1000. 12000.)           -11000.
	  (fsub -1000. 2000.)           -3000.
          (fmul 10. 20.)                200.
          (fmul 100. -10.)              -1000.
          (fmul 100. 1.234)             123.4
	  (fmul -1000. 2000.)           -2000000.
	  (fdiv 10. 2.)                 5.
	  (fdiv 11. 2.)                 5.5
	  (fdiv 11. -10.)               -1.1
	  (fdiv -1000. 2000.)           -0.5

          (feqn 10. 10.)                10.
          (feqn 10. 9.)                 ()
	  (fneqn 10. 10.)               ()
          (fneqn 10. 9.)                10.
          (fgt 9. 9.)                   ()
          (fgt 10. 9.)                  10.
          (fge 9. 9.)                   9.
          (fge 10. 9.)                  10.
          (flt 9. 9.)                   ()
          (flt 10. 9.)                  ()
          (fle 9. 9.)                   9.
          (fle 10. 9.)                  ()

	  (sin pi/2)                    1.
	  (cos pi/2)                    0
	  (asin (sin 1.2))              1.2
	  (acos (cos 1.2))              1.2
	  (fmul 4. (atan 1))            #.pi

	  (fix 10.6)                    10
	  (fix -10.4)                   -10
	  (float 2)                     2.
	  (float -11)                   -11.
	  
          (log #.eNeper)                1.
          (log (exp 1.))                1.
          (log10 10)                    1.
	  (log10 10000.)                4.

          (sqrt 1000000.)               1000.
          (sqrt 16.)                    4.
          (sqrt 2.)                     1.4142135623730951
	  (power 10. 3.)                1000.
	  (power 2. 0.5)                1.4142135623730951
))

(de testfloat (l)
    (let ((tti 0.)                      ; temps total interpre'te'
          (ttc 0.)                      ; temps total compile'
	                                ; nombres flottants de 64 bits.
          (64bitfloatp (featurep '64bitfloats)))
      (while l
           (let* ((form (nextl l))
                  (formeval `(repeat :counter ,form))
                  (trueval (nextl l))
                  timi
                  timc
                  nam
                  val)
                 (setq val (eval form))
                 (unless (#:testcomm:equalp val trueval)
                         (print "**** la valeur de " form
                                " est " trueval " pas " val))
                 (when 64bitfloatp (gc))
                 (setq timi (fsub (time formeval) :ovhi))
                 (setq tti (fadd tti timi))
		 (if (featurep 'compiler)
		    (progn (setq nam (concat "testfloat" (gensym)))
			   (eval `(de ,nam () ,formeval))
			   (compiler nam () :speak :speak)
			   (when 64bitfloatp (gc))
			   (setq timc (fsub (time '(funcall nam)) :ovhc))
			   (setq ttc (fadd ttc timc)))
		   (setq ttc 0.))
                 (print (format ()  
                     "~S~20T= ~@? : ~5,2F ~40Tinterprete,  ~5,2F ~58Tcompile."
                     form
		     (if 64bitfloatp
			 (if (numberp val) "~19@F" "~S~41T")
		         (if (numberp val) "~9@F" "~S~31T"))
		     val timi timc) )))
       (print)
       (print "temps total interprete = " tti)
       (print "temps total compile    = " ttc)))

(de :ovhc ()
    (repeat :counter 'ok))

(when (featurep 'compiler)
      (compiler ':ovhc () :speak :speak))

(gc)
(defvar :ovhi (time '(repeat :counter 'ok)))         ; overhead interprete
(gc)
(if (featurep 'compiler)
    (defvar :ovhc (time '(:ovhc)))                   ; overhead compile
    (defvar :ovhc 0.))

(print "Test des flottants:")
(print)
(print "Type du systeme: " (system) " " (version))
(print "Traits presents: " #:system:features-list)
(print "Nombre de boucles   = " :counter)
(print "Overhead interprete = " :ovhi)
(print "Overhead compile    = " :ovhc)
(print)

(testfloat :liste-de-test)