test.scm

(define (test)
  (import format)
  (iqmport simple-loops)

  (define final-cont 0)
  (define cont-queue (make-vector 10))
  (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) 10))
    (set! (vector-ref cont-queue (modulo cont-queue-front 10)) 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
      (##sys#call-with-cthulhu (lambda () (cont #f)))))

  (define (suspend)
    (call/cc (lambda (cont)
               (cont-push cont)
               (cont-pop))))

  (define (spawn f)
    (cont-push (lambda is-nil (##sys#call-with-cthulhu (lambda () (f) (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 ()
        (display (format "~A:start\n" job-name))
        (suspend)
        (do-for i (0 4)
                (display (format "~A ~A:pre\n" job-name i))
                (suspend)
                (display (format "~A ~A:post\n" job-name i)))
        (assert (not ended))
        (set! ended #t)
        (display (format "End! ~A\n" job-name)))))

  (spawn (mk-job "A"))
  (spawn (mk-job "B"))
  ; (spawn (mk-job "C"))
  (run))
(test)