mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
Relocated threading functions
This commit is contained in:
parent
deae1693d5
commit
7db26c7d8c
2 changed files with 43 additions and 41 deletions
|
@ -1,16 +1,5 @@
|
|||
(define-library (scheme base)
|
||||
(export
|
||||
;; Thread functions. these are not standard, and may be relocated
|
||||
;; TODO: relocate to (scheme srfi 18) or such
|
||||
thread?
|
||||
make-thread
|
||||
thread-name
|
||||
thread-specific
|
||||
thread-specific-set!
|
||||
thread-start!
|
||||
thread-yield!
|
||||
; thread-terminate!
|
||||
;; END threads
|
||||
; TODO: need filter for the next two. also, they really belong in SRFI-1, not here
|
||||
;delete
|
||||
;delete-duplicates
|
||||
|
@ -657,34 +646,4 @@
|
|||
(else
|
||||
#f))))
|
||||
|
||||
;; 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)
|
||||
(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!
|
||||
))
|
||||
|
|
43
srfi/18.sld
Normal file
43
srfi/18.sld
Normal file
|
@ -0,0 +1,43 @@
|
|||
(define-library (srfi 18)
|
||||
(export
|
||||
thread?
|
||||
make-thread
|
||||
thread-name
|
||||
thread-specific
|
||||
thread-specific-set!
|
||||
thread-start!
|
||||
thread-yield!
|
||||
; thread-terminate!
|
||||
)
|
||||
(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)
|
||||
(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!
|
||||
))
|
Loading…
Add table
Reference in a new issue