Baseline of ack benchmark file

tests/experimental/Makefile

@@ -1,13 +1,17 @@
-OPT=-g
-#OPT=-O2
+#OPT=-g
+OPT=-O2
 
 test-args: test-args.c
 	cc $(OPT) test-args.c -o test-args
 
+ack: ack.c
+	cc ack.c  $(OPT) -fPIC -Wall -I/usr/local/include -L/usr/local/lib -Wl,--export-dynamic -c -o ack.o
+	cc ack.o  /usr/local/share/cyclone/scheme/cyclone/common.o  /usr/local/share/cyclone/scheme/time.o /usr/local/share/cyclone/scheme/read.o /usr/local/share/cyclone/scheme/char.o /usr/local/share/cyclone/scheme/base.o  /usr/local/share/cyclone/scheme/write.o  -pthread -lcyclone -lck -lm -ltommath -ldl  $(OPT) -fPIC -Wall -I/usr/local/include -L/usr/local/lib -Wl,--export-dynamic -o ack
+
 fac-test: fac-test.c
 	cc fac-test.c  $(OPT) -fPIC -Wall -I/usr/local/include -L/usr/local/lib -Wl,--export-dynamic -c -o fac-test.o
 	cc fac-test.o  /usr/local/share/cyclone/scheme/cyclone/common.o  /usr/local/share/cyclone/scheme/base.o  /usr/local/share/cyclone/scheme/write.o  -pthread -lcyclone -lck -lm -ltommath -ldl  $(OPT) -fPIC -Wall -I/usr/local/include -L/usr/local/lib -Wl,--export-dynamic -o fac-test
  
 .PHONY: clean
 clean:
-	rm -f *.o fac-test test-args
+	rm -f *.o fac-test test-args ack

tests/experimental/ack.scm

@@ -0,0 +1,93 @@
+;;; ACK -- One of the Kernighan and Van Wyk benchmarks.
+
+(import (scheme base) (scheme read) (scheme write) (scheme time))
+
+(define (ack m n)
+  (cond ((= m 0) (+ n 1))
+        ((= n 0) (ack (- m 1) 1))
+        (else (ack (- m 1) (ack m (- n 1))))))
+
+(define (main)
+  (let* ((count 2)
+         (input1 3)
+         (input2 12)
+         (output 32765)
+         (s3 (number->string count))
+         (s2 (number->string input2))
+         (s1 (number->string input1))
+         (name "ack"))
+    (run-r7rs-benchmark
+     (string-append name ":" s1 ":" s2 ":" s3)
+     count
+     (lambda () (ack (hide count input1) (hide count input2)))
+     (lambda (result) (= result output)))))
+
+;;; The following code is appended to all benchmarks.
+
+;;; Given an integer and an object, returns the object
+;;; without making it too easy for compilers to tell
+;;; the object will be returned.
+
+(define (hide r x)
+  (call-with-values
+   (lambda ()
+     (values (vector values (lambda (x) x))
+             (if (< r 100) 0 1)))
+   (lambda (v i)
+     ((vector-ref v i) x))))
+
+;;; Given the name of a benchmark,
+;;; the number of times it should be executed,
+;;; a thunk that runs the benchmark once,
+;;; and a unary predicate that is true of the
+;;; correct results the thunk may return,
+;;; runs the benchmark for the number of specified iterations.
+
+(define (run-r7rs-benchmark name count thunk ok?)
+
+  ;; Rounds to thousandths.
+  (define (rounded x)
+    (/ (round (* 1000 x)) 1000))
+
+  (display "Running ")
+  (display name)
+  (newline)
+  (flush-output-port (current-output-port))
+  (let* ((j/s (jiffies-per-second))
+         (t0 (current-second))
+         (j0 (current-jiffy)))
+    (let loop ((i 0)
+               (result #f))
+      (cond ((< i count)
+             (loop (+ i 1) (thunk)))
+            ((ok? result)
+             (let* ((j1 (current-jiffy))
+                    (t1 (current-second))
+                    (jifs (- j1 j0))
+                    (secs (inexact (/ jifs j/s)))
+                    (secs2 (rounded (- t1 t0))))
+               (display "Elapsed time: ")
+               (write secs)
+               (display " seconds (")
+               (write secs2)
+               (display ") for ")
+               (display name)
+               (newline)
+               (display "+!CSVLINE!+")
+               (display (this-scheme-implementation-name))
+               (display ",")
+               (display name)
+               (display ",")
+               (display secs)
+               (newline)
+               (flush-output-port (current-output-port)))
+             result)
+            (else
+             (display "ERROR: returned incorrect result: ")
+             (write result)
+             (newline)
+             (flush-output-port (current-output-port))
+             result)))))
+(define (this-scheme-implementation-name)
+  (string-append "cyclone-" (Cyc-version)))
+(main)