mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
04d1655a6a
Modified thread-start! to initiate a GC prior to running the thread, in case thunk contains any closures on the "parent" thread's stack. Otherwise when the parent thread goes to collect them, the contents will be corrupted when the spawned thread attempts to access them.
48 lines
1.6 KiB
Scheme
48 lines
1.6 KiB
Scheme
(define-library (srfi 18)
|
|
(import (scheme base))
|
|
(export
|
|
thread?
|
|
make-thread
|
|
thread-name
|
|
thread-specific
|
|
thread-specific-set!
|
|
thread-start!
|
|
thread-yield!
|
|
; thread-terminate!
|
|
; For now, these are built-ins. No need for them here: make-mutex mutex-lock! mutex-unlock!
|
|
)
|
|
(begin
|
|
;; Threading
|
|
(define (thread? obj)
|
|
(and (vector? obj)
|
|
(> (vector-length obj) 0)
|
|
(equal? 'cyc-thread-obj (vector-ref obj 0))))
|
|
|
|
(define (make-thread thunk . name)
|
|
(let ((name-str (if (pair? name)
|
|
(car name)
|
|
"")))
|
|
;; Fields supported so far:
|
|
;; - type marker (implementation-specific)
|
|
;; - thunk
|
|
;; - internal thread id (implementation-specific)
|
|
;; - name
|
|
;; - specific
|
|
(vector 'cyc-thread-obj thunk #f name-str #f)))
|
|
|
|
(define (thread-name t) (vector-ref t 3))
|
|
(define (thread-specific t) (vector-ref t 4))
|
|
(define (thread-specific-set! t obj) (vector-set! t 4 obj))
|
|
; TODO:
|
|
; current-thread - not sure how to look this up yet... may need a global list of running threads
|
|
(define (thread-start! t)
|
|
;; Initiate a GC prior to running the thread, in case
|
|
;; t contains any closures on the "parent" thread's stack
|
|
(Cyc-minor-gc)
|
|
(let* ((thunk (vector-ref t 1))
|
|
(mutator-id (Cyc-spawn-thread! thunk)))
|
|
(vector-set! t 2 mutator-id)))
|
|
(define (thread-yield!) (thread-sleep! 1))
|
|
; (define (thread-terminate!) (Cyc-end-thread!))
|
|
;; TODO: thread-join!
|
|
))
|