Added thread stubs

This commit is contained in:
Justin Ethier 2015-12-16 22:54:34 -05:00
parent dfed77639a
commit 0e8129f5e6

View file

@ -1,7 +1,12 @@
(define-library (scheme base) (define-library (scheme base)
(export (export
;; Thread functions. these are not standard, and may be relocated ;; Thread functions. these are not standard, and may be relocated
thread?
make-thread make-thread
thread-name
thread-specific
thread-specific-set!
;thread-start!
;; END threads ;; END threads
; TODO: need filter for the next two. also, they really belong in SRFI-1, not here ; TODO: need filter for the next two. also, they really belong in SRFI-1, not here
;delete ;delete
@ -99,11 +104,34 @@
) )
(begin (begin
;; Threading ;; Threading
(define (thread? obj)
(and (vector? obj)
(> (vector-length obj) 0)
(equal? 'cyc-thread-obj (vector-ref obj 0))))
(define (make-thread thunk . name) (define (make-thread thunk . name)
(let ((name-str (if (pair? name) ; (let ((name-str (if (pair? name)
(car name) ; (car name)
""))) ; "")))
(list 'cyc-thread-obj thunk name-str))) ;; Fields supported so far:
;; - type marker (implementation-specific)
;; - thunk
;; - internal thread id (implementation-specific)
;; - name
;; - specific
(vector 'cyc-thread-obj thunk #f name #f))
; (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-thread-start! thunk)))
; (vector-set! t 2 mutator-id)))
;; Features implemented by this Scheme ;; Features implemented by this Scheme
(define (features) '(cyclone r7rs exact-closed)) (define (features) '(cyclone r7rs exact-closed))