Welcome to the CHICKEN Scheme pasting service

::::::::::::::
gc-bench.scm
::::::::::::::
(import scheme)
(cond-expand
 [chicken-5 (import (chicken gc)
                    (chicken time)
                    (chicken format)
                    (srfi 1)
                    (chicken fixnum)
                    (chicken process-context)
                    matchable)]
 [else (use srfi-1)
       (use matchable)])

(define (fill s n) (string-append (make-string (max 0 (- n (string-length s)))
                                               #\.)
                                  " "
                                  s))
(define *gc-count* 1000)

(define (bench-gc msg)
  (gc #t)
  (let ([t (current-milliseconds)])
    (let l ([i *gc-count*])
      (unless (fx= i 0)
        (##sys#gc #t)
        (l (sub1 i))))
    (let ([per-gc (/ (* 1.0 (- (current-milliseconds) t)) *gc-count*)])
      (print (fill msg 20) ": " per-gc " ms/Mgc" )
      per-gc)))

(define (bench-empty-vec s)
  (print "-------------------- " `(bench-empty-vec ,s))
  (define baseline-per-gc (bench-gc "baseline"))
  (let* ([v (make-vector s #f)]
         [per-gc (bench-gc "empty vec")]
         [per-gc* (- per-gc baseline-per-gc)])
    (print "  - " (* 1000000 (/ per-gc* (vector-length v))) " ns/slot")
    per-gc))

(define (bench-vec s)
  (print "-------------------- " `(bench-vec ,s))
  (define baseline-per-gc (bench-gc "baseline"))
  (let* ([v (make-vector s #f)])
    (bench-gc "empty vec")
    (let l ([i (sub1 s)])
      (unless (= 0 i)
        (vector-set! v i (cons #f #f))
        (l (sub1 i))))
    (let ([per-gc (- (bench-gc "filled with pairs") baseline-per-gc)])
      (print "  - " (* 1000000 (/ per-gc (vector-length v))) " ns/pair"))))

(define (bench-list s)
  (print "-------------------- " `(bench-list ,s))
  (define baseline-per-gc (bench-gc "baseline"))
  (bench-gc "empty")
  (let ([l (make-list s #f)])
    (let ([per-gc (- (bench-gc "with list") baseline-per-gc)])
      (print "  - " (* 1000000 (/ per-gc (length l))) " ns/pair"))))

(match (command-line-arguments)
  [(gc-count size-s type)
   (set! *gc-count* (string->number gc-count))
   (bench-gc "start")
   (let ([size (string->number size-s)])
     (match type
       ["string" (bench-string size)]
       ["list" (bench-list size)]
       ["vec" (bench-vec size)]
       ["empty-vec" (bench-empty-vec size)]
       [_ (error "unknown type" type)])
     (bench-gc "end"))]
  [_ (print "usage: foo <gc-count> <size> <type>, where type in '(string list vec empty-vec)")
     (exit 1)])
::::::::::::::
Makefile
::::::::::::::
targets=bench5 bench bench4.13

all: $(targets)

bench5: gc-bench.scm
	csc5 $< -o $@

bench: gc-bench.scm
	csc $< -o $@

bench4.13: gc-bench.scm
	csc4.13 $< -o $@

.PHONY: clean

clean:
	rm -f $(targets)
::::::::::::::
run-schemes.sh
::::::::::::::
#!/usr/bin/env bash
set -euo pipefail

make

# ~/programs/chicken-5-simplify-gc/bin/csc gc-bench.scm -o bench5-simplify-gc

function bench-all () {
    echo -e "\n############################## $@ ##############################"
    echo -e "########## CHICKEN 4.13 ##########"
    ./bench4.13 $@
    echo -e "\n######### CHICKEN 5 ##########"
    ./bench5 $@
    # echo -e "\n######### CHICKEN 5 (simplify-gc) ##########"
    # ./bench5-simplify-gc $@
    echo -e "\n########## CHICKEN 4.13 with tweaks ##########"
    ./bench $@
}

# n_gcs=1000
# size=100000
n_gcs=1000
size=100000
# bench-all $n_gcs $size string
bench-all $n_gcs $size vec
bench-all $n_gcs $size empty-vec
bench-all $n_gcs $size list