diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index 446f21ef..255604db 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -149,9 +149,6 @@ object Cyc_vector_ref(void *d, object v, object k); object Cyc_vector_set(void *d, object v, object k, object obj); object Cyc_make_vector(void *data, object cont, object len, object fill); object Cyc_list2vector(void *data, object cont, object l); -object Cyc_make_mutex(void *data); -object Cyc_mutex_lock(void *data, object cont, object obj); -object Cyc_mutex_unlock(void *data, object obj); object Cyc_number2string(void *d, object cont, object n); object Cyc_symbol2string(void *d, object cont, object sym) ; object Cyc_string2symbol(void *d, object str); @@ -339,10 +336,6 @@ extern const object primitive_vector_91ref; extern const object primitive_vector_91set_67; extern const object primitive_string_91ref; extern const object primitive_string_91set_67; -extern const object primitive_make_91mutex; -extern const object primitive_mutex_91lock_67; -extern const object primitive_mutex_91unlock_67; -extern const object primitive_mutex_127; extern const object primitive_Cyc_91installation_91dir; extern const object primitive_command_91line_91arguments; extern const object primitive_system; diff --git a/runtime.c b/runtime.c index 4e61a019..94268428 100644 --- a/runtime.c +++ b/runtime.c @@ -1237,47 +1237,6 @@ object Cyc_command_line_arguments(void *data, object cont) { return_closcall1(data, cont, lis); } -/** - * Create a new mutex by allocating it on the heap. This is different than - * other types of objects because by definition a mutex will be used by - * multiple threads, so no need to risk having the non-creating thread pick - * up a stack object ref by mistake. - */ -object Cyc_make_mutex(void *data) { - int heap_grown; - mutex lock; - mutex_type tmp; - tmp.hdr.mark = gc_color_red; - tmp.hdr.grayed = 0; - tmp.tag = mutex_tag; - lock = gc_alloc(Cyc_heap, sizeof(mutex_type), (char *)(&tmp), (gc_thread_data *)data, &heap_grown); - if (pthread_mutex_init(&(lock->lock), NULL) != 0) { - fprintf(stderr, "Unable to make mutex\n"); - exit(1); - } - return lock; -} - -object Cyc_mutex_lock(void *data, object cont, object obj) { - mutex m = (mutex) obj; - Cyc_check_mutex(data, obj); - set_thread_blocked(data, cont); - if (pthread_mutex_lock(&(m->lock)) != 0) { - fprintf(stderr, "Error locking mutex\n"); - exit(1); - } - return_thread_runnable(data, boolean_t); -} - -object Cyc_mutex_unlock(void *data, object obj) { - mutex m = (mutex) obj; - Cyc_check_mutex(data, obj); - if (pthread_mutex_unlock(&(m->lock)) != 0) { - fprintf(stderr, "Error unlocking mutex\n"); - exit(1); - } - return boolean_t; -} object Cyc_make_vector(void *data, object cont, object len, object fill) { object v = nil; @@ -1921,20 +1880,6 @@ void _cyc_string_91ref(void *data, object cont, object args) { Cyc_check_num_args(data, "string-ref", 2, args); { object c = Cyc_string_ref(data, car(args), cadr(args)); return_closcall1(data, cont, c); }} -void _Cyc_make_mutex(void *data, object cont, object args) { - { object c = Cyc_make_mutex(data); - return_closcall1(data, cont, c); }} -void _Cyc_mutex_lock(void *data, object cont, object args) { - Cyc_check_num_args(data, "mutex-lock!", 1, args); - { object c = Cyc_mutex_lock(data, cont, car(args)); - return_closcall1(data, cont, c); }} -void _Cyc_mutex_unlock(void *data, object cont, object args) { - Cyc_check_num_args(data, "mutex-unlock!", 1, args); - { object c = Cyc_mutex_unlock(data, car(args)); - return_closcall1(data, cont, c); }} -void _mutex_127(void *data, object cont, object args) { - Cyc_check_num_args(data, "mutex?", 1, args); - return_closcall1(data, cont, Cyc_is_mutex(car(args))); } void _Cyc_91installation_91dir(void *data, object cont, object args) { Cyc_check_num_args(data, "Cyc-installation-dir", 1, args); Cyc_installation_dir(data, cont, car(args));} @@ -2590,10 +2535,6 @@ static primitive_type string_91length_primitive = {{0}, primitive_tag, "string-l static primitive_type substring_primitive = {{0}, primitive_tag, "substring", &_cyc_substring}; static primitive_type string_91ref_primitive = {{0}, primitive_tag, "string-ref", &_cyc_string_91ref}; static primitive_type string_91set_67_primitive = {{0}, primitive_tag, "string-set!", &_cyc_string_91set_67}; -static primitive_type make_91mutex_primitive = {{0}, primitive_tag, "make-mutex", &_Cyc_make_mutex}; -static primitive_type mutex_91lock_67_primitive = {{0}, primitive_tag, "mutex-lock!", &_Cyc_mutex_lock}; -static primitive_type mutex_91unlock_67_primitive = {{0}, primitive_tag, "mutex-unlock!", &_Cyc_mutex_unlock}; -static primitive_type mutex_127_primitive = {{0}, primitive_tag, "mutex?", &_mutex_127}; static primitive_type Cyc_91installation_91dir_primitive = {{0}, primitive_tag, "Cyc-installation-dir", &_Cyc_91installation_91dir}; static primitive_type command_91line_91arguments_primitive = {{0}, primitive_tag, "command-line-arguments", &_command_91line_91arguments}; static primitive_type system_primitive = {{0}, primitive_tag, "system", &_cyc_system}; @@ -2715,10 +2656,6 @@ const object primitive_string_91length = &string_91length_primitive; const object primitive_substring = &substring_primitive; const object primitive_string_91ref = &string_91ref_primitive; const object primitive_string_91set_67 = &string_91set_67_primitive; -const object primitive_make_91mutex = &make_91mutex_primitive; -const object primitive_mutex_91lock_67 = &mutex_91lock_67_primitive; -const object primitive_mutex_91unlock_67 = &mutex_91unlock_67_primitive; -const object primitive_mutex_127 = &mutex_127_primitive; const object primitive_Cyc_91installation_91dir = &Cyc_91installation_91dir_primitive; const object primitive_command_91line_91arguments = &command_91line_91arguments_primitive; const object primitive_system = &system_primitive; diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index efc02048..3c8040cd 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -535,10 +535,6 @@ ((eq? p 'string-ref) "Cyc_string_ref") ((eq? p 'string-set!) "Cyc_string_set") ((eq? p 'substring) "Cyc_substring") - ((eq? p 'make-mutex) "Cyc_make_mutex") - ((eq? p 'mutex-lock!) "Cyc_mutex_lock") - ((eq? p 'mutex-unlock!) "Cyc_mutex_unlock") - ((eq? p 'mutex?) "Cyc_is_mutex") ((eq? p 'Cyc-installation-dir) "Cyc_installation_dir") ((eq? p 'command-line-arguments) "Cyc_command_line_arguments") ((eq? p 'system) "Cyc_system") @@ -621,9 +617,6 @@ string-ref string-set! substring - make-mutex - mutex-lock! - mutex-unlock! Cyc-installation-dir command-line-arguments assq @@ -670,9 +663,6 @@ ((eq? p 'make-vector) "object") ((eq? p 'list->string) "object") ((eq? p 'list->vector) "object") - ;((eq? p 'make-mutex) "object") - ((eq? p 'mutex-lock!) "object") - ((eq? p 'mutex-unlock!) "object") ((eq? p 'Cyc-installation-dir) "object") (else #f))) @@ -695,8 +685,6 @@ string-length substring + - * / apply command-line-arguments - ;make-mutex - mutex-lock! mutex-unlock! Cyc-read-line read-char peek-char cons length vector-length cell)))) @@ -705,14 +693,14 @@ (define (prim:cont? exp) (and (prim? exp) (member exp '(Cyc-read-line apply command-line-arguments number->string - read-char peek-char mutex-lock! + read-char peek-char symbol->string list->string substring string-append make-vector list->vector Cyc-installation-dir)))) ;; Primitive functions that pass a continuation or thread data but have no other arguments (define (prim:cont/no-args? exp) (and (prim? exp) - (member exp '(command-line-arguments make-mutex Cyc-current-exception-handler)))) + (member exp '(command-line-arguments Cyc-current-exception-handler)))) ;; Pass an integer arg count as the function's first parameter? (define (prim:arg-count? exp) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 9eb37c11..36cfe385 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -516,10 +516,6 @@ vector-length vector-ref vector-set! - make-mutex - mutex-lock! - mutex-unlock! - mutex? boolean? char? eof-object? @@ -582,10 +578,6 @@ string-set! string->symbol ;; Could be mistaken for an identifier make-vector - make-mutex - mutex-lock! - mutex-unlock! - mutex? ;; I/O must be done at runtime for side effects: Cyc-stdout Cyc-stdin diff --git a/scheme/eval.sld b/scheme/eval.sld index 2c48cf29..e91d6e55 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -248,10 +248,6 @@ (list 'vector-length vector-length) (list 'vector-ref vector-ref) (list 'vector-set! vector-set!) - (list 'make-mutex make-mutex) - (list 'mutex-lock! mutex-lock!) - (list 'mutex-unlock! mutex-unlock!) - (list 'mutex? mutex?) (list 'boolean? boolean?) (list 'char? char?) (list 'eof-object? eof-object?) diff --git a/srfi/18.sld b/srfi/18.sld index 3b0e8c56..bf68ba2a 100644 --- a/srfi/18.sld +++ b/srfi/18.sld @@ -21,11 +21,10 @@ ;; TODO: thread-terminate! ;; TODO: thread-join! - ;; For now, these are built-ins. No need to export them here: - ;; mutex? - ;; make-mutex - ;; mutex-lock! - ;; mutex-unlock! + mutex? + make-mutex + mutex-lock! + mutex-unlock! ;; For now, these are not implemented: ;; mutex-name @@ -106,6 +105,54 @@ "(void *data, int argc, closure _, object k)" " Cyc_trigger_minor_gc(data, k); ") + ;; Mutexes + (define-c mutex? + "(void *data, int argc, closure _, object k, object obj)" + " object result = Cyc_is_mutex(obj); + return_closcall1(data, k, result); ") + ;; + ;; Create a new mutex by allocating it on the heap. This is different than + ;; other types of objects because by definition a mutex will be used by + ;; multiple threads, so no need to risk having the non-creating thread pick + ;; up a stack object ref by mistake. + ;; + (define-c make-mutex + "(void *data, int argc, closure _, object k)" + " int heap_grown; + mutex lock; + mutex_type tmp; + tmp.hdr.mark = gc_color_red; + tmp.hdr.grayed = 0; + tmp.tag = mutex_tag; + lock = gc_alloc(gc_get_heap(), sizeof(mutex_type), (char *)(&tmp), (gc_thread_data *)data, &heap_grown); + if (pthread_mutex_init(&(lock->lock), NULL) != 0) { + fprintf(stderr, \"Unable to make mutex\\n\"); + exit(1); + } + return_closcall1(data, k, lock); ") + + (define-c mutex-lock! + "(void *data, int argc, closure _, object k, object obj)" + " mutex m = (mutex) obj; + Cyc_check_mutex(data, obj); + set_thread_blocked(data, k); + if (pthread_mutex_lock(&(m->lock)) != 0) { + fprintf(stderr, \"Error locking mutex\\n\"); + exit(1); + } + return_thread_runnable(data, boolean_t); ") + + (define-c mutex-unlock! + "(void *data, int argc, closure _, object k, object obj)" + " mutex m = (mutex) obj; + Cyc_check_mutex(data, obj); + if (pthread_mutex_unlock(&(m->lock)) != 0) { + fprintf(stderr, \"Error unlocking mutex\\n\"); + exit(1); + } + return_closcall1(data, k, boolean_t); ") + + ;;;; Condition Variables (define-c condition-variable? "(void *data, int argc, closure _, object k, object obj)" " object result = Cyc_is_cond_var(obj);