; MTL.SLA
;
; A SIMPLE non-preemptive multi-tasking module for slang
;
; (C) 1993 Tony Garnock-Jones
;
; Joy, Joy, Continuations work... :-D Yay!

'tasklist [[root 0]] define         ; List of tasks... assoc-list
'currname 'root define              ; Current task-name
'currnum 0 define                   ; Current task-num

'fork {
    'name swap define               ; Name of task to create
    {
        'cc swap define             ; The "return continuation"
        'tasklist mark name cc make-list tasklist cons set ; Add to list
        'currnum currnum 1 + set    ; Set numbers up
        name cc set-cc              ; Return correct result
    } call/cc
} define

'swap-tasks {
    {
        'cc swap define
        cc currname tasklist assq cdr set-car
        'currnum currnum 1 + tasklist length mod set
        'me currnum tasklist list-ref define
        'currname me car set
        #t me cdr car set-cc
    } call/cc drop                  ; Drop the "#t" from the switch
} define                            ; Switch tasks