; .EnTete "Le-Lisp (c) version 15.2" " " "Les Benchmarks de Le-Lisp"
; .EnPied "benchmarks.ll" "%" " "
; .Annexe x "Les benchmarks de Le-Lisp"
; .nr % 1
;
; .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: benchmarks.ll,v 1.7 88/12/27 14:48:52 kuczynsk Exp $"

;;; Cet utilitaire lance tous les tests dits "de Gabriel"
;;; de mesure de performances des syste`mes Lisp.

(unless (>= (version) 15.21)
        (error 'load 'erricf 'benchmarks))

; Tous les symboles pre'ce'de's de : seront cre'e's dans le package BENCHMARKS

(defvar #:sys-package:colon 'benchmarks)

(unless (or (featurep '64bitfloats)
	    (eq 0. 0.))
	(add-feature '64bitfloats))

(defvar :in-test-p ())

(defmacro push (val var) `(setq ,var (cons ,val ,var)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; La configuration Le-Lisp minimale ne'ce'ssaire a' ces mesures:
;;;  pour un processeur classique (ex: 68000)
;;;  % lelispbin -stack 6 -code 384 -heap 128  -number 0 -float 0 \
;;;              -vector 4 -string 7 -symbol 6 -cons 24
;;;  ? (load-cpl () t ()()t t)
;;;  ? ↑L../benchmarks/benchmarks
;;;
;;;  pour un processeur RISC (ex: SPARC)
;;;  % lelispbin -stack 6 -code 512 -heap 128 -number 0 -float 0 \
;;;              -vector 4 -string 7 -symbol 6 -cons 24 
;;;  ? (load-cpl () t ()()t t)
;;;  ? ↑L../benchmarks/benchmarks
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;

(nconc1 #:system:path (catenate #:system:directory "benchmarks/"))

(libload checkmet t)

(unless (featurep 'setf)        (loadmodule 'setf t))
(unless (featurep 'countcalls)  (loadmodule 'countcalls t))
(unless (featurep 'format)      (loadmodule 'format t))
(unless (featurep 'date)        (loadmodule 'date t))


(defvar :runtime-in-gc 0.)
(defvar :gc-count 0)

(de gc-before-alarm ();; Attention en 64bitfloats: si on fait un GC sur les
    (when :in-test-p  ;;  flottants(cf fft): (RUNTIME) consomme un flottant!
	  (setq :runtime-in-gc (runtime))))

(de gcalarm ()
    (if :in-test-p
	(print "GC done (" (- (runtime) :runtime-in-gc) " seconds)")
      (incr :gc-count)))

(compile-all-in-core)

(defun do-test ()
   (let ((:testnumber 0)
	 (:list-of-results ()))
        (print)
        (print "; =========================================")
        (print ";  Benchmarks Le-Lisp version 15.22 : TEST ")
        (print "; =========================================")
	(print)
	(herald)
	(print "; " (list-features))
	(print "; " (date))
	(mapc (lambda ((file name test check meter rep-factor))
		; <file> est le nom du module
		; <name> est le nom du test
		; <expr> est une expression de type (<fnt> <rep-factor>)
		; <rep-factor> le nb de fois que le tst est execute'
		(print)
		(when file (loadmodule file))
		(gc)
		(print "Test " (incr :testnumber) " : " name)
		(let ((:in-test-p (not (and (eq name 'fft) ; cf gc-before-alarm
					    (featurep '64bitfloats))) )
		      (:runtime 0.)
		      (:gc-count 0))
		  (setq :runtime (runtime))
		  (funcall test rep-factor)
		  (setq :runtime (fsub (runtime) :runtime))
		  (setq :runtime (/ :runtime rep-factor))
		  (print "Total time for " name " = " :runtime " seconds.")
		  (unless :in-test-p
			  (print "with " :gc-count " GCs."))
		  (newl :list-of-results (list name :runtime))))
	      :test-list)
	:list-of-results))


(defun do-check ()
   (let ((:testnumber 0))
        (print)
        (print "; ==========================================")
        (print ";  Benchmarks Le-Lisp version 15.22 : CHECK ")
        (print "; ==========================================")
	(print)
	(mapc (lambda ((file name test check meter rep-factor))
		; <file> est le nom du module
		; <name> est le nom du test
		; <expr> est une expression de type (<fnt> <rep-factor>)
		; <rep-factor> le nb de fois que le tst est execute'
		(when file (loadmodule file))
		(print "Checking " (incr :testnumber) " : " name)
		(funcall check))
	      :test-list))
   'do-check)

(defun do-meter ()
   (let ((:testnumber 0))
        (print)
        (print "; ==========================================")
        (print ";  Benchmarks Le-Lisp version 15.22 : METER ")
        (print "; ==========================================")
	(print)
	(mapc (lambda ((file name test check meter rep-factor))
		; <file> est le nom du module
		; <name> est le nom du test
		; <expr> est une expression de type (<fnt> <rep-factor>)
		; <rep-factor> le nb de fois que le tst est execute'
		(when file
		      (setq file (catenate file #:system:lelisp-extension))
		      (print "Loading ... " file)
		      (libloadfile file t))
		(gc)
		(print "Metering " (incr :testnumber) " : " name)
		(funcall meter))
	      :test-list))
   'do-meter)


(defvar :test-list  '(

    ; file or   test     test          check         meter         repetition
    ; module    name     function      function      function      factor

    (fib20      fib20     test-fib20    check-fib20    meter-fib20   10)
    (tak        tak       test-tak      check-tak      meter-tak      5)
    (stak       stak      test-stak     check-stak     meter-stak     5)
    (ctak       ctak      test-ctak     check-ctak     meter-ctak     5)
    (takl       takl      test-takl     check-takl     meter-takl     5)
    (takr       takr      test-takr     check-takr     meter-takr     5)
    (boyer      boyer     test-boyer    check-boyer    meter-boyer    1)
    (browse     browse    test-browse   check-browse   meter-browse   1)
    (destru     destru    test-destru   check-destru   meter-destru   1)
    (traverse   trav-init test-travinit check-travinit meter-travinit 1)
    ( ()        trav-run  test-travrun  check-travrun  meter-travrun  1)
    (deriv      deriv     test-deriv    check-deriv    meter-deriv    1)
    (dderiv     dderiv    test-dderiv   check-dderiv   meter-deriv    1)
    (div        div2iter  test-div2iter check-div2iter meter-div2iter 1)
    ( ()        div2recur test-div2rec  check-div2rec  meter-div2rec  1)
    (fft        fft       test-fft      check-fft      meter-fft      1)
    (puzzle     puzzle    test-puzzle   check-puzzle   meter-puzzle   1)
    (triang     triang    test-triang   check-triang   meter-triang   1)


))

(defun do-modules ()
   ; compile all the files of the benchmarks
   (mapc (lambda (x) (when (and (car x) (symbolp (car x)))
			   (print "Compiling .. " (car x))
			   (let ((#:complice:parano-flag ()))
			     (compilemodule (car x)))))
	 (cons '(checkmet) :test-list)))

(compile-all-in-core)

(print "(do-test)    to run the tests.")
(print "(do-check)   to check the tests.")
(print "(do-meter)   to perform meterings.")
(print "(do-modules) to build the modules (if cmplc is present).")

#|
 Les temps obtenus avec (do-test), proviennent de la commande Le-Lisp
 (runtime) qui exprime le temps CPU e'coule' depuis le lancement de Le-Lisp.
 Des soustractions successives nous permettent de calculer le temps CPU
 qu'a mis une fonction a` s'e'valuer.

  Le temps des GCs est inclu dans les temps exprime's.
  Les temps de SWAP sur certaines machines sont inclus.
  Les temps d'entre'es/sorties ne sont pas inclus.
|#