goblins/misc/perf-tests.rkt

#lang racket

;;; Copyright 2019-2021 Christine Lemmer-Webber
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

(require goblins
         racket/match)

(define (do-actors-gc [actormap (make-whactormap)])
  (define ((simple-actor bcom))
    'hello)
  (time
   (actormap-run!
    actormap
    (lambda ()
      (for ([i 1000000])
        (define friend
          (spawn simple-actor))
        (call friend))))))

;; (collect-garbage 'major)

(define (do-self-referential-actors-gc [actormap (make-whactormap)])
  (define (^simple-actor bcom)
    (define self
      (match-lambda*
        [(list 'self) self]
        [(list 'oop) 'boop]))
    self)
  (time
   (actormap-run!
    actormap
    (lambda ()
      (for ([i 1000000])
        (define friend
          (spawn ^simple-actor))
        (call friend 'oop))))))

;;; 2019-10-29
;; perf-tests.rkt> (call-a-lot)
;; cpu time: 991 real time: 990 gc time: 5

(define (call-a-lot [actormap (make-whactormap)])
  (define ((^simple-actor bcom))
    'hello)
  (time
   (actormap-run!
    actormap
    (lambda ()
      (define friend
        (spawn ^simple-actor))
      (for ([i 1000000])
        (call friend))))))

;;; 2019-11-03
;; perf-tests.rkt> (bcom-a-lot)
;; cpu time: 1473 real time: 1472 gc time: 49
;; perf-tests.rkt> (bcom-a-lot #:reckless? #t)
;; cpu time: 1262 real time: 1262 gc time: 24
;;; 2021-07-17
;; perf-tests.rkt> (bcom-a-lot #:reckless? #t)
;; cpu time: 1057 real time: 1058 gc time: 52

;; A bunch of actors updating themselves
(define (bcom-a-lot [actormap (make-whactormap)]
                    #:num-actors [num-actors 1000]
                    #:iterations [iterations 1000]
                    #:reckless? [reckless? #f])
  (define ((^incrementing-actor bcom [i 0]))
    (bcom (^incrementing-actor bcom (add1 i))
          i))
  (define i-as
    (for/list ([i num-actors])
      (actormap-spawn! actormap ^incrementing-actor)))
  (time
   (for ([_ iterations])
     (actormap-run!
      actormap
      (lambda ()
        (for ([i-a i-as])
          ($ i-a)))
      #:reckless? reckless?))))

;;; 2019-10-29
;; perf-tests.rkt> (set!-a-lot)
;; cpu time: 1106 real time: 1105 gc time: 13

(define (set!-a-lot [actormap (make-whactormap)]
                    #:num-actors [num-actors 1000]
                    #:iterations [iterations 1000])
  (define (^incrementing-actor bcom)
    (define i 0)
    (lambda ()
      (define old-i i)
      (set! i (add1 i))
      old-i))
  (define i-as
    (for/list ([i num-actors])
      (actormap-spawn! actormap ^incrementing-actor)))
  (time
   (for ([_ iterations])
     (actormap-run!
      actormap
      (lambda ()
        (for ([i-a i-as])
          ($ i-a)))))))

;;; 2021-07-17
;; perf-tests.rkt> (send-a-lot)
;; cpu time: 12261 real time: 12261 gc time: 257
;; perf-tests.rkt> (send-a-lot #:promise? #t)
;; cpu time: 50629 real time: 50631 gc time: 2482
;;
;; So that's about 81.5k messages per second when using <-np,
;; about 20k messages per second when using <-
;;
;; perf-tests.rkt> (send-a-lot #:spawn-cell? #t)
;; cpu time: 19289 real time: 19289 gc time: 550
;;
;; So, not that much bigger of an increase when "merely" spawning a
;; cell.  Promises with <- seem to be expensive.  I do wonder if
;; there's room for optimization somewhere.

(define (send-a-lot #:promise? [promise? #f]
                    #:iterations [iterations 1000000]
                    #:spawn-cell? [spawn-cell? #f])
  (time
   (define vat (make-vat))
   (define sph (make-semaphore))
   (define (^cell bcom val)
     (case-lambda
       [() val]
       [(v) (bcom (^cell bcom v))]))
   (vat 'run
        (lambda ()
          (define ((^self-looper bcom) n)
            (when spawn-cell?
              (spawn ^cell 8))
            (if (not (zero? n))
                ((if promise? <- <-np) self-looper (sub1 n))
                (semaphore-post sph))
            (void))
          (define self-looper (spawn ^self-looper))
          (<-np self-looper iterations)))
   (sync sph)))