;------------------------------------------------------------------------------

(define (run-bench name count ok? run)
  (let loop ((i count) (result '(undefined)))
    (if (< 0 i)
      (loop (- i 1) (run))
      result)))

(define (run-benchmark name count ok? run-maker . args)
  (newline)
  (let* ((run (apply run-maker args))
         (result (run-bench name count ok? run)))
    (if (not (ok? result))
      (begin
        (display "*** wrong result ***")
        (newline)
        (display "*** got: ")
        (write result)
        (newline)))))

(define (fatal-error . args)
  (for-each display args)
  (newline)
  (exit 1))

 (define (call-with-output-file/truncate filename proc)
   (call-with-output-file filename proc))

;------------------------------------------------------------------------------

; Macros...

; Specialize fixnum and flonum arithmetic.

;; This code should be used when f64vectors are available.
;(def-macro (FLOATvector-const . lst)   `',(list->f64vector lst))
;(def-macro (FLOATvector? x)            `(f64vector? ,x))
;(def-macro (FLOATvector . lst)         `(f64vector ,@lst))
;(def-macro (FLOATmake-vector n . init) `(make-f64vector ,n ,@init))
;(def-macro (FLOATvector-ref v i)       `(f64vector-ref ,v ,i))
;(def-macro (FLOATvector-set! v i x)    `(f64vector-set! ,v ,i ,x))
;(def-macro (FLOATvector-length v)      `(f64vector-length ,v))
;
;(def-macro (nuc-const . lst)
;  `',(list->vector
;       (map (lambda (x)
;              (if (vector? x)
;                (list->f64vector (vector->list x))
;                x))
;            lst)))

(define make-thread call-with-new-thread)
(define thread-join! join-thread)
(define (thread-start! x) #f)
(define-macro (bitwise-or . lst) `(logior ,@lst))
(define-macro (bitwise-and . lst) `(logand ,@lst))
(define-macro (bitwise-not . lst) `(lognot ,@lst))


; Don't specialize fixnum and flonum arithmetic.

(define-macro (FLOATvector-const . lst)   `',(list->vector lst))
(define-macro (FLOATvector? x)            `(vector? ,x))
(define-macro (FLOATvector . lst)         `(vector ,@lst))
(define-macro (FLOATmake-vector n . init) `(make-vector ,n ,@init))
(define-macro (FLOATvector-ref v i)       `(vector-ref ,v ,i))
(define-macro (FLOATvector-set! v i x)    `(vector-set! ,v ,i ,x))
(define-macro (FLOATvector-length v)      `(vector-length ,v))

(define-macro (nuc-const . lst)
  `',(list->vector lst))

(define-macro (FLOAT+ . lst) `(+ ,@lst))
(define-macro (FLOAT- . lst) `(- ,@lst))
(define-macro (FLOAT* . lst) `(* ,@lst))
(define-macro (FLOAT/ . lst) `(/ ,@lst))
(define-macro (FLOAT= . lst)  `(= ,@lst))
(define-macro (FLOAT< . lst)  `(< ,@lst))
(define-macro (FLOAT<= . lst) `(<= ,@lst))
(define-macro (FLOAT> . lst)  `(> ,@lst))
(define-macro (FLOAT>= . lst) `(>= ,@lst))
(define-macro (FLOATnegative? . lst) `(negative? ,@lst))
(define-macro (FLOATpositive? . lst) `(positive? ,@lst))
(define-macro (FLOATzero? . lst)     `(zero? ,@lst))
(define-macro (FLOATabs . lst) `(abs ,@lst))
(define-macro (FLOATsin . lst) `(sin ,@lst))
(define-macro (FLOATcos . lst) `(cos ,@lst))
(define-macro (FLOATatan . lst) `(atan ,@lst))
(define-macro (FLOATsqrt . lst) `(sqrt ,@lst))
(define-macro (FLOATmin . lst) `(min ,@lst))
(define-macro (FLOATmax . lst) `(max ,@lst))
(define-macro (FLOATround . lst) `(round ,@lst))
(define-macro (FLOATinexact->exact . lst) `(inexact->exact ,@lst))

(define-macro (GENERIC+ . lst) `(+ ,@lst))
(define-macro (GENERIC- . lst) `(- ,@lst))
(define-macro (GENERIC* . lst) `(* ,@lst))
(define-macro (GENERIC/ . lst) `(/ ,@lst))
(define-macro (GENERICquotient . lst)  `(quotient ,@lst))
(define-macro (GENERICremainder . lst) `(remainder ,@lst))
(define-macro (GENERICmodulo . lst)    `(modulo ,@lst))
(define-macro (GENERIC= . lst)  `(= ,@lst))
(define-macro (GENERIC< . lst)  `(< ,@lst))
(define-macro (GENERIC<= . lst) `(<= ,@lst))
(define-macro (GENERIC> . lst)  `(> ,@lst))
(define-macro (GENERIC>= . lst) `(>= ,@lst))
(define-macro (GENERICexpt . lst) `(expt ,@lst))


;------------------------------------------------------------------------------
; Gabriel benchmarks
(define boyer-iters         2)
(define browse-iters       60)
(define cpstak-iters      100)
(define ctak-iters         1)
(define dderiv-iters   200000)
(define deriv-iters    200000)
(define destruc-iters      50)
(define diviter-iters  100000)
(define divrec-iters   100000)
(define puzzle-iters       10)
(define tak-iters         200)
(define takl-iters         30)
(define trav1-iters        10)
(define trav2-iters         2)
(define triangl-iters       1)

; Kernighan and Van Wyk benchmarks
(define ack-iters           1)
(define array1-iters        1)
(define cat-iters           1)
(define string-iters        1)
(define sum1-iters          1)
(define sumloop-iters       1)
(define tail-iters          1)
(define wc-iters            1)

; C benchmarks
(define fft-iters        2000)
(define fib-iters           5)
(define fibfp-iters         2)
(define mbrot-iters       100)
(define nucleic-iters       5)
(define pnpoly-iters   100000)
(define sum-iters       10000)
(define sumfp-iters      5000)
(define tfib-iters         20)

; Other benchmarks
(define conform-iters       4)
(define dynamic-iters       2)
(define earley-iters       20)
(define fibc-iters         50)
(define graphs-iters       30)
(define lattice-iters       1)
(define matrix-iters       40)
(define maze-iters        400)
(define mazefun-iters     100)
(define nqueens-iters     200)
(define paraffins-iters   100)
(define peval-iters        20)
(define pi-iters            1)
(define primes-iters    10000)
(define ray-iters           1)
(define scheme-iters     20000)
(define simplex-iters   10000)
(define slatex-iters        2)
(define perm9-iters         1)
(define nboyer-iters       10)
(define sboyer-iters       10)
(define gcbench-iters       1)
(define compiler-iters     30)
;;; TFIB -- Like FIB but using threads.

(define (tfib n)
  (if (< n 2)
      1
      (let ((x (make-thread (lambda () (tfib (- n 2))))))
        (thread-start! x)
        (let ((y (tfib (- n 1))))
          (+ (thread-join! x) y)))))

(define (go n repeat)
  (let loop ((repeat repeat)
             (result '()))
    (if (> repeat 0)
        (let ((x (make-thread (lambda () (tfib n)))))
          (thread-start! x)
          (let ((r (thread-join! x)))
            (loop (- repeat 1) r)))
        result)))

(define (main . args)
  (run-benchmark
   "tfib"
   tfib-iters
   (lambda (result) (equal? result 610))
   (lambda (n repeat) (lambda () (go n repeat)))
   14
   100))
(main)