Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-12 23:37:38 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Relocated mutex primitives to srfi 18 lib

Browse source
This commit is contained in:
Justin Ethier 2016-02-16 23:51:28 -05:00
parent 214f8de4c0
commit c98e186172
6 changed files with 54 additions and 101 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
include/cyclone/runtime.h
View file

@ -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;

63
runtime.c
View file

@ -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;

16
scheme/cyclone/cgen.sld
View file

@ -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)

8
scheme/cyclone/transforms.sld
View file

@ -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

4
scheme/eval.sld
View file

@ -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?)

57
srfi/18.sld
View file

@ -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);