scheduler.scm

(define (test)
  (import chicken.format simple-loops micro-benchmark vector-lib random-mtzig)

  (define workload-size 10)
  (define concurrent-workers 20)


  (define lookup-array (vector-unfold values 1000000))

  (define final-cont 0)
  (define cont-queue (make-vector concurrent-workers))
  (define cont-queue-front 0)
  (define cont-queue-back 0)

  (define (cont-queue-size)
    (- cont-queue-front cont-queue-back))

  (define (cont-push c)
    (assert (< (cont-queue-size) concurrent-workers))
    (set! (vector-ref cont-queue
                      (modulo cont-queue-front concurrent-workers))
      c)
    (set! cont-queue-front (+ cont-queue-front 1)))

  (define (cont-pop)
    (assert (> (cont-queue-size) 0))
    (set! cont-queue-back (+ cont-queue-back 1))
    (let* ((index (modulo (- cont-queue-back 1) 10))
           (cont (vector-ref cont-queue  index)))
      (set! (vector-ref cont-queue index) 0)
      ; Forget the last continuation
      (cont #f)))

  (define (rand-lookup)
    (suspend)
    (vector-ref lookup-array (random-st)))

  (define (suspend)
    (call/cc (lambda (cont)
               (##sys#call-with-cthulhu
                (lambda ()
                  (cont-push cont)
                  (cont-pop))))))

  (define (spawn f)
    (cont-push (lambda is-nil (f) (##sys#call-with-cthulhu
                              (lambda () (final-cont #f))))))

  (define (run)
    (do-while (> (cont-queue-size) 0)
              (call/cc
               (lambda (fin)
                 (set! final-cont fin)
                 (cont-pop)))))

  (define (mk-job job-name)
    (let ((ended #f))
      (lambda ()
        (printf "~A:start\n" job-name)
        (suspend)
        (do-for i (0 workload-size)
                (printf "~A.~A:pre\n" job-name i)
                (rand-lookup)
                (printf "~A.~A:post\n" job-name i))
        (assert (not ended))
        (set! ended #t)
        (printf "~A.End!\n" job-name))))

  (do-for i (0 concurrent-workers)
          (spawn (mk-job i)))

  (benchmark-run (run)))
(test)