Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-04 03:36:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP

Browse source
This commit is contained in:
Justin Ethier 2019-06-05 18:05:07 -04:00
parent 092409cb53
commit c47ee88589
1 changed files with 13 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
libs/cyclone/atomics.scm
View file

@ -25,12 +25,15 @@
;; ;;
;; Alloc on the heap since by definition atoms are used by multiple threads ;; Alloc on the heap since by definition atoms are used by multiple threads
;; ;;
(define-c make-atom (define-c %make-atom
"(void *data, int argc, closure _, object k, object obj)" "(void *data, int argc, closure _, object k, object obj)"
" int heap_grown; " int heap_grown;
atomic atm; atomic atm;
atomic_type tmp; atomic_type tmp;
Cyc_verify_immutable(data, obj); // TODO: verify obj is not on local stack??? Cyc_verify_immutable(data, obj); // TODO: verify obj is not on local stack???
if (gc_is_stack_obj(data, obj)){
Cyc_rt_raise2(data, \"Atom cannot be a thread-local object\", obj);
}
tmp.hdr.mark = gc_color_red; tmp.hdr.mark = gc_color_red;
tmp.hdr.grayed = 0; tmp.hdr.grayed = 0;
tmp.tag = atomic_tag; tmp.tag = atomic_tag;
@ -39,10 +42,13 @@
ck_pr_store_ptr(&(atm->obj), obj); // Needed?? ck_pr_store_ptr(&(atm->obj), obj); // Needed??
return_closcall1(data, k, atm); ") return_closcall1(data, k, atm); ")
(define (make-atom obj)
(%make-atom (make-shared obj)))
(define (atom . obj) (define (atom . obj)
(if (pair? obj) (if (pair? obj)
(make-atom (car obj)) (%make-atom (make-shared (car obj)))
(make-atom #f))) (%make-atom #f)))
;; - ref atomic ;; - ref atomic
(define-c ref (define-c ref
@ -68,9 +74,7 @@
;; ;;
(define (swap! atom f . args) (define (swap! atom f . args)
(let* ((oldval (ref atom)) (let* ((oldval (ref atom))
(newval (apply f oldval args))) (newval (make-shared (apply f oldval args))))
;; TODO: newval could be on the stack, need to ensure it is moved...
;; maybe call (make-shared newval)
(if (compare-and-set! atom oldval newval) (if (compare-and-set! atom oldval newval)
newval ;; value did not change, return new one newval ;; value did not change, return new one
(apply swap! atom f args) ;; Value changed, try again (apply swap! atom f args) ;; Value changed, try again
@ -106,6 +110,9 @@
" atomic a; " atomic a;
Cyc_check_atomic(data, obj); Cyc_check_atomic(data, obj);
Cyc_verify_immutable(data, newval); Cyc_verify_immutable(data, newval);
if (gc_is_stack_obj(data, obj)){
Cyc_rt_raise2(data, \"Atom cannot be a thread-local object\", obj);
}
a = (atomic) obj; a = (atomic) obj;
bool result = ck_pr_cas_ptr(&(a->obj), oldval, newval); bool result = ck_pr_cas_ptr(&(a->obj), oldval, newval);
object rv = result ? boolean_t : boolean_f; object rv = result ? boolean_t : boolean_f;