Last active
May 23, 2021 12:16
-
-
Save fakedrake/33bd7160a68bdf0b5cb737b433985944 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
> (test) | |
; loading /opt/homebrew/Cellar/chicken/5.2.0/lib/chicken/11/format.so ... | |
; loading /opt/homebrew/Cellar/chicken/5.2.0/lib/chicken/11/simple-loops.so ... | |
A:start | |
B:start | |
A 0:pre | |
B 0:pre | |
A 0:post | |
A 1:pre | |
B 0:post | |
B 1:pre | |
A 1:post | |
A 2:pre | |
B 1:post | |
B 2:pre | |
A 2:post | |
A 3:pre | |
B 2:post | |
B 3:pre | |
A 3:post | |
End! A | |
B 3:post | |
End! B |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(define (test) | |
(import format) | |
(import simple-loops) | |
(define final-cont 0) | |
; A continuation queue | |
(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 | |
(cont #f))) | |
; Suspend a job. Since we are capturing the continuation make sure it is not left | |
; over in the stack. | |
(define (suspend) | |
(call/cc (lambda (cont) | |
(##sys#call-with-cthulhu | |
(lambda () | |
(cont-push cont) | |
(cont-pop)))))) | |
; Spawn a job. When the spawned job finishes the leftover continuation | |
; will be the continuation of the first suspend. The call-with-cthulhu | |
; call is a chicken specific way of replacing that continuation with the | |
; final-cont that we have made sure to be the right way to drop off after | |
; finishing a job. (xxx: this might be redundant since we are calling cthulu | |
; in suspend) | |
(define (spawn f) | |
(cont-push (lambda is-nil (f) (##sys#call-with-cthulhu | |
(lambda () (final-cont #f)))))) | |
; Pop the continuation the queue until it's empty. | |
(define (run) | |
(do-while (> (cont-queue-size) 0) | |
(call/cc | |
(lambda (fin) | |
(set! final-cont fin) | |
(cont-pop))))) | |
; Make a simple job tha prints stuff and suspends | |
(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))))) | |
; Here we interleave job A and job B. When one suspends the other wakes up. | |
(spawn (mk-job "A")) | |
(spawn (mk-job "B")) | |
; (spawn (mk-job "C")) | |
(run)) | |
(test) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment