Racket FFI mini benchmarks

draw.rkt

#lang racket/base
(require racket/class
         racket/draw)

(define bm (make-bitmap 100 100))
(define dc (send bm make-dc))

(send dc set-brush "white" 'solid)

(time
 (for ([i (in-range 10000)])
   (send dc draw-rectangle 0 0 100 100)
   (send dc draw-text "Hello" 0 0)))
   

math.rkt

#lang racket/base
(require math/bigfloat)

(define one (real->bigfloat 1.0))

(time (for/fold ([v one]) ([i (in-range 100000)])
        (bf+ v one)))

plus.c

int plus(int a, int b) {
  return a + b;
}

plus.rkt

#lang racket/base
(require ffi/unsafe)

(define lib (ffi-lib "/tmp/plus.dylib"))

(define plus (get-ffi-obj 'plus #f (_fun _int _int -> _int)))

(time
 (for/fold ([v 1]) ([i (in-range 1000000)])
   (plus v 0)))

plus.ss

(load-shared-object "/tmp/plus.dylib")

(define plus
  (foreign-procedure "plus" (int int) int))

(time
 (let loop ([v 0] [i 0])
   (if (= i 1000000)
       v
       (loop (plus v 0) (fx+ i 1)))))

ref-stress-test.rkt

#lang racket/base
(require ffi/unsafe
         racket/fixnum
         racket/flonum)

(define len 10)
(define n-times 10000000)

;; Racket vectors
(collect-garbage)(collect-garbage)(collect-garbage)
(let ()
  (printf "~a: " 'vector)
  (define v (make-vector len))
  (time (for/fold ([r #f]) ([i (in-range n-times)]) (vector-ref v 0)))
  (void))

(define (bstr-malloc len type mode)
  (make-bytes (* len (ctype-sizeof type))))

(define-syntax-rule (ref-test malloc ctype ZERO)
  (begin
    (collect-garbage)(collect-garbage)(collect-garbage)
    (printf "~a: " 'ctype)
    (let ()
      (define ptr (malloc len ctype 'raw))
      (ptr-set! ptr ctype 0 ZERO) ; write a valid value
      (time (for/fold ([r #f]) ([i (in-range n-times)]) (ptr-ref ptr ctype 0))) ; stress test
      (unless (bytes? ptr)
        (free ptr)))))

(define-syntax-rule (set-test malloc ctype ZERO)
  (begin
    (collect-garbage)(collect-garbage)(collect-garbage)
    (printf "~a: " 'ctype)
    (let ()
      (define ptr (malloc len ctype 'raw))
      (ptr-set! ptr ctype 0 ZERO) ; write a valid value
      (time (for/fold ([r #f]) ([i (in-range n-times)]) (ptr-set! ptr ctype 0 ZERO))) ; stress test
      (unless (bytes? ptr)
        (free ptr)))))

(ref-test malloc _ulong 0)
(set-test malloc _ulong 0)
(ref-test bstr-malloc _ulong 0)
(set-test bstr-malloc _ulong 0)

(ref-test malloc _int 0)
(ref-test malloc _uint 0)
(ref-test malloc _double 0.)
(ref-test malloc _fixnum 0)
(ref-test malloc _racket 0)

(define-syntax-rule (sum-test ctype ZERO)
  (begin
    (collect-garbage)(collect-garbage)(collect-garbage)
    (printf "~a: " 'ctype)
    (let ()
      (define ptr (malloc len ctype 'raw))
      (ptr-set! ptr ctype 0 ZERO) ; write a valid value
      (time (let loop ([r ZERO] [i n-times])
              (if (fx= i 0)
                  (fl+ r)
                  (loop (fl+ r (ptr-ref ptr ctype 0))
                        (- i 1)))))
      (free ptr))))

(sum-test _double 0.)

strlen.rkt

#lang racket/base
(require ffi/unsafe)

(define strlen (get-ffi-obj 'strlen #f (_fun _pointer -> _size)))

(time
 (for/fold ([v #f]) ([i (in-range 1000000)])
   (strlen #"hello\0")))

struct.rkt

#lang racket/base
(require ffi/unsafe)

(define-cstruct _foo ([x _int]))

(define a-foo (make-foo 1))

(time
 (for/fold ([v 0]) ([i (in-range 10000000)])
   (foo-x a-foo)))

(time
 (for ([i (in-range 10000000)])
   (set-foo-x! a-foo i)))