This commit is contained in:
Justin Ethier 2019-05-30 13:18:50 -04:00
parent d3e679fd03
commit ddd057f97b
3 changed files with 40 additions and 1 deletions

View file

@ -453,6 +453,7 @@ object Cyc_is_integer(object o);
#define Cyc_is_bytevector(o) (make_boolean(is_object_type(o) && ((list) o)->tag == bytevector_tag))
#define Cyc_is_port(o) (make_boolean(is_object_type(o) && ((list) o)->tag == port_tag))
#define Cyc_is_mutex(o) (make_boolean(is_object_type(o) && ((list) o)->tag == mutex_tag))
#define Cyc_is_atomic(o) (make_boolean(is_object_type(o) && ((list) o)->tag == atomic_tag))
#define Cyc_is_cond_var(o) (make_boolean(is_object_type(o) && ((list) o)->tag == cond_var_tag))
#define Cyc_is_symbol(o) (make_boolean(is_object_type(o) && ((list) o)->tag == symbol_tag))
#define Cyc_is_string(o) (make_boolean(is_object_type(o) && ((list) o)->tag == string_tag))

View file

@ -12,4 +12,39 @@
;; probably want a (make-shared)
;; may also way a way to allocate multiple shared objects at once (since a minor GC will likely be req'd)
;; (atomic? obj)
;; (atom? obj)
;; (atom obj)
(define-c atom?
"(void *data, int argc, closure _, object k, object obj)"
" object result = Cyc_is_atomic(obj);
return_closcall1(data, k, result); ")
;;
;; Alloc on the heap since by definition atoms are used by multiple threads
;;
(define-c make-atom
"(void *data, int argc, closure _, object k, object obj)"
" int heap_grown;
atomic atm;
atomic_type tmp;
tmp.hdr.mark = gc_color_red;
tmp.hdr.grayed = 0;
tmp.tag = atomic_tag;
tmp.obj = obj;
atm = gc_alloc(((gc_thread_data *)data)->heap, sizeof(atomic_type), (char *)(&tmp), (gc_thread_data *)data, &heap_grown);
return_closcall1(data, k, atm); ")
(define (atom . obj)
(if (pair? obj)
(make-atom (car obj))
(make-atom #f)))
;; TODO:
;; - ref atomic
;; TODO:
;; - swap, see https://clojure.github.io/clojure/clojure.core-api.html#clojure.core/swap!
;; (swap! atom f)(swap! atom f x)(swap! atom f x y)(swap! atom f x y & args)
;; TODO:
;; - compare and swap?

View file

@ -919,6 +919,9 @@ object Cyc_display(void *data, object x, FILE * port)
case cond_var_tag:
fprintf(port, "<condition variable %p>", x);
break;
case atomic_tag:
fprintf(port, "<atom %p>", x);
break;
case boolean_tag:
fprintf(port, "#%s", ((boolean_type *) x)->desc);
break;