Permalink
Browse files

Now the multiruntime system can be disabled at configuration time

  • Loading branch information...
1 parent 486b53b commit 355cf08b791a1b0dcb110f2c517aef9b46694c10 @lucasaiu committed Sep 3, 2013
View
20 asmrun/startup.c
@@ -148,33 +148,35 @@ static void parse_camlrunparam_r(CAML_R)
//extern __thread caml_global_context *caml_context; // in context.c // FIXME: remove this: it's now a thread-local static variable
+#ifdef HAS_MULTICONTEXT
/* FIXME: refactor: call this from caml_main_rr --Luca Saiu REENTRANTRUNTIME */
caml_global_context* caml_make_empty_context(void)
{
// FIXME: lock
/* Make a new context in which to unmarshal back the byte array back
into a big data structure, copying whatever's needed: */
//caml_global_context *old_thread_local_context = caml_get_thread_local_context();
- caml_global_context *ctx = caml_initialize_first_global_context();
- ctx->descriptor->kind = caml_global_context_nonmain_local;
- //caml_set_thread_local_context(old_thread_local_context); // undo caml_initialize_first_global_context's trashing of the __thread variable
+ caml_global_context *this_ctx = caml_make_first_global_context();
+ this_ctx->descriptor->kind = caml_global_context_nonmain_local;
+ //caml_set_thread_local_context(old_thread_local_context); // undo caml_make_first_global_context's trashing of the __thread variable
// FIXME: unlock
/* Initialize the abstract machine */
- caml_init_gc_r (ctx, minor_heap_init, heap_size_init, heap_chunk_init,
+ caml_init_gc_r (this_ctx, minor_heap_init, heap_size_init, heap_chunk_init,
percent_free_init, max_percent_free_init);
//caml_init_stack_r (ctx, max_stack_init); // Not for native code
- init_atoms_r(ctx);
+ init_atoms_r(this_ctx);
/* No need to call caml_init_signals for each context: its
initialization only needs to be performed once */
- caml_debugger_init_r (ctx); /* force debugger.o stub to be linked */
+ caml_debugger_init_r (this_ctx); /* force debugger.o stub to be linked */
/* Make the new context be the thread-local context for this thread: */
- caml_set_thread_local_context(ctx);
+ caml_set_thread_local_context(this_ctx);
- return ctx;
+ return this_ctx;
}
+#endif // #ifdef HAS_MULTICONTEXT
extern value caml_start_program_r (CAML_R);
extern void caml_init_ieee_floats (void);
@@ -190,7 +192,7 @@ caml_global_context* caml_main_rr(char **argv)
value res;
char tos;
caml_context_initialize_global_stuff();
- CAML_R = caml_initialize_first_global_context();
+ CAML_R = caml_make_first_global_context();
the_main_context = ctx;
caml_init_ieee_floats();
View
BIN boot/myocamlbuild
Binary file not shown.
View
BIN boot/ocamlc
Binary file not shown.
View
BIN boot/ocamldep
Binary file not shown.
View
BIN boot/ocamllex
Binary file not shown.
View
BIN boot/ocamlrun
Binary file not shown.
View
BIN boot/stdlib.cma
Binary file not shown.
View
1 byterun/callback.c
@@ -310,5 +310,6 @@ CAMLexport void caml_destroy_named_value_table_r(CAML_R){
for(i = 0; i < Named_value_size; i ++){
//DUMP("Destroying the %i-th bucket", i);
caml_destroy_named_value_table_bucket_r(ctx, named_value_table[i]);
+ named_value_table[i] = NULL; // just to catch bugs
}
}
View
588 byterun/context.c
@@ -39,6 +39,11 @@
#include <pthread.h>
#include <errno.h> // for EBUSY. FIXME: ensure this is still needed at the end --Luca Saiu REENTRANTRUNTIME
+#ifndef HAS_MULTICONTEXT
+caml_global_context the_one_and_only_context_struct;
+//caml_global_context * const ctx = the_one_and_only_context_struct;
+#endif // #ifndef HAS_MULTICONTEXT
+
static __thread caml_global_context *the_thread_local_caml_context = NULL;
/* The one and only main context: */
@@ -71,6 +76,7 @@ static pthread_mutex_t caml_channel_mutex /* __attribute__((unused)) */;
//static int caml_are_global_mutexes_initialized = 0; // FIXME: will this be needed in the end?
void caml_initialize_mutex(pthread_mutex_t *mutex){
+#ifdef HAS_PTHREAD
pthread_mutexattr_t attributes;
pthread_mutexattr_init(&attributes);
//int result = pthread_mutexattr_settype(&attributes, PTHREAD_MUTEX_RECURSIVE_NP);
@@ -82,39 +88,52 @@ void caml_initialize_mutex(pthread_mutex_t *mutex){
pthread_mutex_init(mutex, &attributes);
//fprintf(stderr, "= {%u %p | %p}\n", mutex->__data.__count, (void*)(long)mutex->__data.__count, (void*)(pthread_self())); fflush(stderr);
pthread_mutexattr_destroy(&attributes);
+#endif // #ifdef HAS_PTHREAD
}
void caml_finalize_mutex(pthread_mutex_t *mutex){
+#ifdef HAS_PTHREAD
pthread_mutex_destroy(mutex);
+#endif // #ifdef HAS_PTHREAD
}
void caml_initialize_semaphore(sem_t *semaphore, int initial_value){
+#ifdef HAS_PTHREAD
int init_result = sem_init(semaphore, /*not process-shared*/0, initial_value);
if(init_result != 0){
fprintf(stderr, "++++++++ [thread %p] sem_init failed\n", (void*)(pthread_self())); fflush(stderr);
exit(EXIT_FAILURE);
}
+#endif // #ifdef HAS_PTHREAD
}
void caml_finalize_semaphore(sem_t *semaphore){
+#ifdef HAS_PTHREAD
sem_destroy(semaphore);
+#endif // #ifdef HAS_PTHREAD
}
void caml_p_semaphore(sem_t* semaphore){
+#ifdef HAS_PTHREAD
int sem_wait_result;
while((sem_wait_result = sem_wait(semaphore)) != 0){
assert(errno == EINTR);
INIT_CAML_R; DUMP("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! sem_wait was interrupted by a signal");
errno = 0;
}
assert(sem_wait_result == 0);
+#endif // #ifdef HAS_PTHREAD
}
void caml_v_semaphore(sem_t* semaphore){
+#ifdef HAS_PTHREAD
int sem_post_result = sem_post(semaphore);
assert(sem_post_result == 0);
+#endif // #ifdef HAS_PTHREAD
}
+#ifdef HAS_MULTICONTEXT
void* caml_destructor_thread_function(void *ctx_as_void_star){
CAML_R = ctx_as_void_star;
+ DUMP("Hello from the destructor thread for context %p (ctx is %p)", ctx_as_void_star, ctx);
/* Block until notified by a V: */
DUMP("waiting to be notified before destroying the context");
@@ -127,15 +146,22 @@ void* caml_destructor_thread_function(void *ctx_as_void_star){
fprintf(stderr, "Destroyed the context %p: exiting the destructor thread %p as well.\n", ctx, (void*)pthread_self()); fflush(stderr);
return NULL; // unused
}
+#endif // #ifdef HAS_MULTICONTEXT
-caml_global_context *caml_initialize_first_global_context(void)
+/* Initialize the given context structure, which has already been allocated elsewhere: */
+void caml_initialize_first_global_context(/* CAML_R */caml_global_context *this_ctx)
{
+#ifndef HAS_MULTICONTEXT
+ /* If we're working with some context different from the one and
+ only, we're doing something wrong: */
+ assert(this_ctx == &the_one_and_only_context_struct);
+#endif // #ifndef HAS_MULTICONTEXT
+
/* Maybe we should use partial contexts for specific tasks, that
will probably not be used by all threads. We should check the size of
each part of the context, to allocate only what is probably required
by all threads, and then allocate other sub-contexts on demand. */
- caml_global_context* ctx = (caml_global_context*)caml_stat_alloc(sizeof(caml_global_context));
/*
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT --Luca Saiu REENTRANTRUNTIME: BEGIN
FIXME: This is a pretty bad symptom. If I replace the 0 with a 1, the
@@ -145,385 +171,407 @@ since the original version by Fabrice]... There is some struct field
which is never correctly initialized.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT --Luca Saiu REENTRANTRUNTIME: END
*/
- //memset(ctx, 1, sizeof(caml_global_context));
- //memset(ctx, -1, sizeof(caml_global_context));
- memset(ctx, 0, sizeof(caml_global_context));
+ //memset(this_ctx, 1, sizeof(caml_global_context));
+ //memset(this_ctx, -1, sizeof(caml_global_context));
+ memset(this_ctx, 0, sizeof(caml_global_context));
#ifdef NATIVE_CODE
/* TODO : only for first context ! We should implement a way, so
that calling several times caml_main will actually start several
runtimes, with different contexts. A thread would then be able to
schedule several ocaml runtimes ! Protect this with a protected
section. */
- ctx->caml_globals_map = caml_globals_map; // FIXME: this is Fabrice's version; I really have no reason to change it, except to see the effect --Luca Saiu REENTRANTRUNTIME
- //ctx->caml_globals_map = NULL; // FIXME: horrible, horrible test. I'm intentionally breaking Fabrice's code to see what breaks [nothing, apparently]. --Luca Saiu REENTRANTRUNTIME
+ this_ctx->caml_globals_map = caml_globals_map; // FIXME: this is Fabrice's version; I really have no reason to change it, except to see the effect --Luca Saiu REENTRANTRUNTIME
+ //this_ctx->caml_globals_map = NULL; // FIXME: horrible, horrible test. I'm intentionally breaking Fabrice's code to see what breaks [nothing, apparently]. --Luca Saiu REENTRANTRUNTIME
#endif/* #ifdef NATIVE_CODE */
/* from stacks.c */
/* value caml_global_data; */
- ctx->caml_stack_usage_hook = NULL;
- /* ctx->caml_stack_low;
- ctx->caml_stack_high;
- ctx->caml_stack_threshold;
- ctx->caml_extern_sp;
- ctx->caml_trapsp;
- ctx->caml_trap_barrier;
- ctx->caml_max_stack_size;
+ this_ctx->caml_stack_usage_hook = NULL;
+ /* this_ctx->caml_stack_low;
+ this_ctx->caml_stack_high;
+ this_ctx->caml_stack_threshold;
+ this_ctx->caml_extern_sp;
+ this_ctx->caml_trapsp;
+ this_ctx->caml_trap_barrier;
+ this_ctx->caml_max_stack_size;
*/
/* from major_gc.c */
- /* ctx->caml_percent_free;
- ctx->caml_major_heap_increment;
- ctx->caml_heap_start;
- ctx->caml_gc_sweep_hp;
- ctx->caml_gc_phase;
- ctx->gray_vals;
- ctx->gray_vals_cur;
- ctx->gray_vals_end;
- ctx->gray_vals_size;
- ctx->heap_is_pure;
- ctx->caml_allocated_words;
- ctx->caml_dependent_size;
- ctx->caml_dependent_allocated;
- ctx->caml_extra_heap_resources;
+ /* this_ctx->caml_percent_free;
+ this_ctx->caml_major_heap_increment;
+ this_ctx->caml_heap_start;
+ this_ctx->caml_gc_sweep_hp;
+ this_ctx->caml_gc_phase;
+ this_ctx->gray_vals;
+ this_ctx->gray_vals_cur;
+ this_ctx->gray_vals_end;
+ this_ctx->gray_vals_size;
+ this_ctx->heap_is_pure;
+ this_ctx->caml_allocated_words;
+ this_ctx->caml_dependent_size;
+ this_ctx->caml_dependent_allocated;
+ this_ctx->caml_extra_heap_resources;
*/
- ctx->caml_fl_size_at_phase_change = 0;
+ this_ctx->caml_fl_size_at_phase_change = 0;
/*
- ctx->markhp;
- ctx->mark_chunk;
- ctx->mark_limit;
- ctx->caml_gc_subphase;
- ctx->weak_prev;
+ this_ctx->markhp;
+ this_ctx->mark_chunk;
+ this_ctx->mark_limit;
+ this_ctx->caml_gc_subphase;
+ this_ctx->weak_prev;
*/
#ifdef DEBUG
- ctx->major_gc_counter = 0;
+ this_ctx->major_gc_counter = 0;
#endif
/* from freelist.c */
- ctx->sentinel.filler1 = 0;
- ctx->sentinel.h = Make_header (0, 0, Caml_blue);
- ctx->sentinel.first_bp = 0;
- ctx->sentinel.filler2 = 0;
-#define Fl_head ((char *) (&(ctx->sentinel.first_bp)))
- ctx->fl_prev = Fl_head;
- ctx->fl_last = NULL;
- ctx->caml_fl_merge = Fl_head;
- ctx->caml_fl_cur_size = 0;
- /* ctx->last_fragment; */
- /* ctx->flp [FLP_MAX]; */
- ctx->flp_size = 0;
- ctx->beyond = NULL;
- ctx->caml_allocation_policy = Policy_next_fit;
+ this_ctx->sentinel.filler1 = 0;
+ this_ctx->sentinel.h = Make_header (0, 0, Caml_blue);
+ this_ctx->sentinel.first_bp = 0;
+ this_ctx->sentinel.filler2 = 0;
+#define Fl_head ((char *) (&(this_ctx->sentinel.first_bp)))
+ this_ctx->fl_prev = Fl_head;
+ this_ctx->fl_last = NULL;
+ this_ctx->caml_fl_merge = Fl_head;
+ this_ctx->caml_fl_cur_size = 0;
+ /* this_ctx->last_fragment; */
+ /* this_ctx->flp [FLP_MAX]; */
+ this_ctx->flp_size = 0;
+ this_ctx->beyond = NULL;
+ this_ctx->caml_allocation_policy = Policy_next_fit;
/* from minor_gc.c */
- /* ctx->caml_minor_heap_size; */
- ctx->caml_young_base = NULL;
- ctx->caml_young_start = NULL;
- ctx->caml_young_end = NULL;
- ctx->caml_young_ptr = NULL;
- ctx->caml_young_limit = NULL;
-
- ctx->caml_ref_table.base = NULL;
- ctx->caml_ref_table.end = NULL;
- ctx->caml_ref_table.threshold = NULL;
- ctx->caml_ref_table.ptr = NULL;
- ctx->caml_ref_table.limit = NULL;
- ctx->caml_ref_table.size = 0;
- ctx->caml_ref_table.reserve = 0;
-
- ctx->caml_weak_ref_table.base = NULL;
- ctx->caml_weak_ref_table.end = NULL;
- ctx->caml_weak_ref_table.threshold = NULL;
- ctx->caml_weak_ref_table.ptr = NULL;
- ctx->caml_weak_ref_table.limit = NULL;
- ctx->caml_weak_ref_table.size = 0;
- ctx->caml_weak_ref_table.reserve = 0;
- ctx->caml_in_minor_collection = 0;
- ctx->oldify_todo_list = 0;
+ /* this_ctx->caml_minor_heap_size; */
+ this_ctx->caml_young_base = NULL;
+ this_ctx->caml_young_start = NULL;
+ this_ctx->caml_young_end = NULL;
+ this_ctx->caml_young_ptr = NULL;
+ this_ctx->caml_young_limit = NULL;
+
+ this_ctx->caml_ref_table.base = NULL;
+ this_ctx->caml_ref_table.end = NULL;
+ this_ctx->caml_ref_table.threshold = NULL;
+ this_ctx->caml_ref_table.ptr = NULL;
+ this_ctx->caml_ref_table.limit = NULL;
+ this_ctx->caml_ref_table.size = 0;
+ this_ctx->caml_ref_table.reserve = 0;
+
+ this_ctx->caml_weak_ref_table.base = NULL;
+ this_ctx->caml_weak_ref_table.end = NULL;
+ this_ctx->caml_weak_ref_table.threshold = NULL;
+ this_ctx->caml_weak_ref_table.ptr = NULL;
+ this_ctx->caml_weak_ref_table.limit = NULL;
+ this_ctx->caml_weak_ref_table.size = 0;
+ this_ctx->caml_weak_ref_table.reserve = 0;
+ this_ctx->caml_in_minor_collection = 0;
+ this_ctx->oldify_todo_list = 0;
#ifdef DEBUG
- ctx->minor_gc_counter = 0;
+ this_ctx->minor_gc_counter = 0;
#endif
#if 0
/* from memory.h */
#ifdef ARCH_SIXTYFOUR
- /* ctx->caml_page_table */
+ /* this_ctx->caml_page_table */
#else
- /* ctx->caml_page_table[Pagetable1_size]; */
- ctx->caml_page_table_empty[0] = 0;
+ /* this_ctx->caml_page_table[Pagetable1_size]; */
+ this_ctx->caml_page_table_empty[0] = 0;
#endif/* #else (#ifdef ARCH_SIXTYFOUR) */
#endif/* #if 0 */
/* from roots.c */
#ifdef NATIVE_CODE
- ctx->caml_local_roots = NULL;
- //ctx->caml_scan_roots_hook = NULL;
+ this_ctx->caml_local_roots = NULL;
+ //this_ctx->caml_scan_roots_hook = NULL;
/* Fabrice's original version; see my comment in context.h --Luca Saiu REENTRANTRUNTIME */
- /* ctx->caml_top_of_stack; */
- /* ctx->caml_bottom_of_stack = NULL; */
- /* ctx->caml_last_return_address = 1; */
- /* /\* ctx->caml_gc_regs; */
- /* ctx->caml_globals_inited; *\/ */
- /* ctx->caml_globals_scanned = 0; */
- /* ctx->caml_dyn_globals = NULL; */
- /* ctx->caml_top_of_stack; */
- ctx->caml_bottom_of_stack = NULL; /* no stack initially */
- ctx->caml_last_return_address = 1; /* not in OCaml code initially */
- /* ctx->caml_gc_regs; */
- ctx->caml_globals_inited = 0;
- ctx->caml_globals_scanned = 0;
- ctx->caml_dyn_globals = NULL;
- ctx->caml_stack_usage_hook = NULL;
+ /* this_ctx->caml_top_of_stack; */
+ /* this_ctx->caml_bottom_of_stack = NULL; */
+ /* this_ctx->caml_last_return_address = 1; */
+ /* /\* this_ctx->caml_gc_regs; */
+ /* this_ctx->caml_globals_inited; *\/ */
+ /* this_ctx->caml_globals_scanned = 0; */
+ /* this_ctx->caml_dyn_globals = NULL; */
+ /* this_ctx->caml_top_of_stack; */
+ this_ctx->caml_bottom_of_stack = NULL; /* no stack initially */
+ this_ctx->caml_last_return_address = 1; /* not in OCaml code initially */
+ /* this_ctx->caml_gc_regs; */
+ this_ctx->caml_globals_inited = 0;
+ this_ctx->caml_globals_scanned = 0;
+ this_ctx->caml_dyn_globals = NULL;
+ this_ctx->caml_stack_usage_hook = NULL;
#else
- ctx->caml_local_roots = NULL;
- //ctx->caml_scan_roots_hook = NULL;
+ this_ctx->caml_local_roots = NULL;
+ //this_ctx->caml_scan_roots_hook = NULL;
#endif/* #else (#ifdef NATIVE_CODE) */
#ifdef CAML_CONTEXT_STARTUP
/* from startup.c */
#ifdef NATIVE_CODE
- /* ctx->caml_atom_table
- ctx->caml_code_area_start
- ctx->caml_code_area_end */
- /* ctx->caml_termination_jmpbuf */
- ctx->caml_termination_hook = NULL;
+ /* this_ctx->caml_atom_table
+ this_ctx->caml_code_area_start
+ this_ctx->caml_code_area_end */
+ /* this_ctx->caml_termination_jmpbuf */
+ this_ctx->caml_termination_hook = NULL;
#endif/* #ifdef NATIVE_CODE */
#endif/* #ifdef CAML_CONTEXT_STARTUP */
/* from globroots.c */
- ctx->random_seed = 0;
+ this_ctx->random_seed = 0;
- ctx->caml_global_roots.root = NULL;
- ctx->caml_global_roots.forward[0] = NULL;
- ctx->caml_global_roots.level = 0;
+ this_ctx->caml_global_roots.root = NULL;
+ this_ctx->caml_global_roots.forward[0] = NULL;
+ this_ctx->caml_global_roots.level = 0;
- ctx->caml_global_roots_young.root = NULL;
- ctx->caml_global_roots_young.forward[0] = NULL;
- ctx->caml_global_roots_young.level = 0;
+ this_ctx->caml_global_roots_young.root = NULL;
+ this_ctx->caml_global_roots_young.forward[0] = NULL;
+ this_ctx->caml_global_roots_young.level = 0;
- ctx->caml_global_roots_old.root = NULL;
- ctx->caml_global_roots_old.forward[0] = NULL;
- ctx->caml_global_roots_old.level = 0;
+ this_ctx->caml_global_roots_old.root = NULL;
+ this_ctx->caml_global_roots_old.forward[0] = NULL;
+ this_ctx->caml_global_roots_old.level = 0;
/* from fail.c */
#ifdef NATIVE_CODE
- ctx->caml_exception_pointer= NULL;
- ctx->array_bound_error_bucket_inited = 0;
+ this_ctx->caml_exception_pointer= NULL;
+ this_ctx->array_bound_error_bucket_inited = 0;
#else
- ctx->caml_external_raise = NULL;
- /* ctx->caml_exn_bucket */
- ctx->out_of_memory_bucket.hdr = 0; ctx->out_of_memory_bucket.exn = 0;
+ this_ctx->caml_external_raise = NULL;
+ /* this_ctx->caml_exn_bucket */
+ this_ctx->out_of_memory_bucket.hdr = 0; this_ctx->out_of_memory_bucket.exn = 0;
#endif /* #else (#ifdef NATIVE_CODE) */
/* from signals_byt.c */
- ctx->caml_something_to_do = 0;
- ctx->caml_async_action_hook = NULL;
+ this_ctx->caml_something_to_do = 0;
+ this_ctx->caml_async_action_hook = NULL;
/* from signals.c */
- ctx->caml_signals_are_pending = 0;
- /* ctx->caml_pending_signals */
- ctx->caml_async_signal_mode = 0;
+ this_ctx->caml_signals_are_pending = 0;
+ /* this_ctx->caml_pending_signals */
+ this_ctx->caml_async_signal_mode = 0;
- /* ctx->caml_enter_blocking_section_hook = &caml_enter_blocking_section_default; */
- /* ctx->caml_leave_blocking_section_hook = &caml_leave_blocking_section_default; */
- /* ctx->caml_try_leave_blocking_section_hook = &caml_try_leave_blocking_section_default; */
+ /* this_ctx->caml_enter_blocking_section_hook = &caml_enter_blocking_section_default; */
+ /* this_ctx->caml_leave_blocking_section_hook = &caml_leave_blocking_section_default; */
+ /* this_ctx->caml_try_leave_blocking_section_hook = &caml_try_leave_blocking_section_default; */
- ctx->caml_force_major_slice = 0;
- ctx->caml_signal_handlers = Val_int(0);
- caml_register_global_root_r(ctx, &ctx->caml_signal_handlers);
+ this_ctx->caml_force_major_slice = 0;
+ this_ctx->caml_signal_handlers = Val_int(0);
+ caml_register_global_root_r(this_ctx, &this_ctx->caml_signal_handlers);
/* from backtrace.c */
#ifdef NATIVE_CODE
- ctx->caml_backtrace_active = 0;
- ctx->caml_backtrace_pos = 0;
- ctx->caml_backtrace_buffer = NULL;
- ctx->caml_backtrace_last_exn = Val_unit;
+ this_ctx->caml_backtrace_active = 0;
+ this_ctx->caml_backtrace_pos = 0;
+ this_ctx->caml_backtrace_buffer = NULL;
+ this_ctx->caml_backtrace_last_exn = Val_unit;
#else
- ctx->caml_backtrace_active = 0;
- ctx->caml_backtrace_pos = 0;
- ctx->caml_backtrace_buffer = NULL;
- ctx->caml_backtrace_last_exn = Val_unit;
- ctx->caml_cds_file = NULL;
+ this_ctx->caml_backtrace_active = 0;
+ this_ctx->caml_backtrace_pos = 0;
+ this_ctx->caml_backtrace_buffer = NULL;
+ this_ctx->caml_backtrace_last_exn = Val_unit;
+ this_ctx->caml_cds_file = NULL;
#endif /* #else (#ifdef NATIVE_CODE) */
/* from compare.c */
- /* ctx->compare_stack_init */
- ctx->compare_stack = ctx->compare_stack_init;
- ctx->compare_stack_limit = ctx->compare_stack_init + COMPARE_STACK_INIT_SIZE;
- /* ctx->caml_compare_unordered; */
+ /* this_ctx->compare_stack_init */
+ this_ctx->compare_stack = this_ctx->compare_stack_init;
+ this_ctx->compare_stack_limit = this_ctx->compare_stack_init + COMPARE_STACK_INIT_SIZE;
+ /* this_ctx->caml_compare_unordered; */
/* from sys.c */
- /* ctx->caml_exe_name */
- /* ctx->caml_main_argv */
+ /* this_ctx->caml_exe_name */
+ /* this_ctx->caml_main_argv */
/* from extern.c */
/*
- ctx->obj_counter;
- ctx->size_32;
- ctx->size_64;
- ctx->extern_ignore_sharing;
- ctx->extern_closures;
- ctx->extern_cross_context;
- ctx->extern_trail_first;
- ctx->extern_trail_block;
- ctx->extern_trail_cur;
- ctx->extern_trail_limit;
- ctx->extern_userprovided_output;
- ctx->extern_ptr;
- ctx->extern_limit;
- ctx->extern_output_first;
- ctx->extern_output_block;
- ctx->extern_stack_init;
+ this_ctx->obj_counter;
+ this_ctx->size_32;
+ this_ctx->size_64;
+ this_ctx->extern_ignore_sharing;
+ this_ctx->extern_closures;
+ this_ctx->extern_cross_context;
+ this_ctx->extern_trail_first;
+ this_ctx->extern_trail_block;
+ this_ctx->extern_trail_cur;
+ this_ctx->extern_trail_limit;
+ this_ctx->extern_userprovided_output;
+ this_ctx->extern_ptr;
+ this_ctx->extern_limit;
+ this_ctx->extern_output_first;
+ this_ctx->extern_output_block;
+ this_ctx->extern_stack_init;
*/
- ctx->extern_stack = ctx->extern_stack_init;
- ctx->extern_stack_limit = ctx->extern_stack_init + EXTERN_STACK_INIT_SIZE;
- ctx->extern_flags[0] = NO_SHARING; ctx->extern_flags[1] = CLOSURES; ctx->extern_flags[2] = CROSS_CONTEXT;
+ this_ctx->extern_stack = this_ctx->extern_stack_init;
+ this_ctx->extern_stack_limit = this_ctx->extern_stack_init + EXTERN_STACK_INIT_SIZE;
+ this_ctx->extern_flags[0] = NO_SHARING; this_ctx->extern_flags[1] = CLOSURES; this_ctx->extern_flags[2] = CROSS_CONTEXT;
/* From intext.h */
- /*ctx->caml_code_fragments_table;*/
+ /*this_ctx->caml_code_fragments_table;*/
/* from intern.c */
/*
- ctx->intern_src;
- ctx->intern_input;
- ctx->intern_input_malloced;
- ctx->intern_dest;
- ctx->intern_extra_block;
- ctx->intern_obj_table;
- ctx->intern_color;
- ctx->intern_header;
- ctx->intern_block;
+ this_ctx->intern_src;
+ this_ctx->intern_input;
+ this_ctx->intern_input_malloced;
+ this_ctx->intern_dest;
+ this_ctx->intern_extra_block;
+ this_ctx->intern_obj_table;
+ this_ctx->intern_color;
+ this_ctx->intern_header;
+ this_ctx->intern_block;
*/
- ctx->camlinternaloo_last_id = NULL;
+ this_ctx->camlinternaloo_last_id = NULL;
/* intern_stack_init[INTERN_STACK_INIT_SIZE]; */
- ctx->intern_stack = ctx->intern_stack_init;
- ctx->intern_stack_limit = ctx->intern_stack_init + INTERN_STACK_INIT_SIZE;
+ this_ctx->intern_stack = this_ctx->intern_stack_init;
+ this_ctx->intern_stack_limit = this_ctx->intern_stack_init + INTERN_STACK_INIT_SIZE;
/* from gc_ctrl.c */
- ctx->caml_stat_minor_words = 0.0;
- ctx->caml_stat_promoted_words = 0.0;
- ctx->caml_stat_major_words = 0.0;
-
- ctx->caml_stat_minor_collections = 0;
- ctx->caml_stat_major_collections = 0;
- ctx->caml_stat_heap_size = 0;
- ctx->caml_stat_top_heap_size = 0;
- ctx->caml_stat_compactions = 0;
- ctx->caml_stat_heap_chunks = 0;
- /* ctx->caml_percent_max */
+ this_ctx->caml_stat_minor_words = 0.0;
+ this_ctx->caml_stat_promoted_words = 0.0;
+ this_ctx->caml_stat_major_words = 0.0;
+
+ this_ctx->caml_stat_minor_collections = 0;
+ this_ctx->caml_stat_major_collections = 0;
+ this_ctx->caml_stat_heap_size = 0;
+ this_ctx->caml_stat_top_heap_size = 0;
+ this_ctx->caml_stat_compactions = 0;
+ this_ctx->caml_stat_heap_chunks = 0;
+ /* this_ctx->caml_percent_max */
/* from compact.c */
- /* ctx->compact_fl */
+ /* this_ctx->compact_fl */
/* from callback.c */
- ctx->caml_callback_depth = 0;
- ctx->callback_code_threaded = 0;
+ this_ctx->caml_callback_depth = 0;
+ this_ctx->callback_code_threaded = 0;
int i;
for(i = 0; i < Named_value_size; i ++)
- ctx->named_value_table[i] = NULL;
+ this_ctx->named_value_table[i] = NULL;
/* from debugger.c */
- ctx->caml_debugger_in_use = 0;
- /* ctx->caml_event_count; */
- ctx->caml_debugger_fork_mode = 1;
- ctx->marshal_flags = Val_emptylist;
+ this_ctx->caml_debugger_in_use = 0;
+ /* this_ctx->caml_event_count; */
+ this_ctx->caml_debugger_fork_mode = 1;
+ this_ctx->marshal_flags = Val_emptylist;
/* from weak.c */
- ctx->caml_weak_list_head = 0;
+ this_ctx->caml_weak_list_head = 0;
/* from finalise.c */
- ctx->final_table = NULL;
- ctx->final_old = 0;
- ctx->final_young = 0;
- ctx->final_size = 0;
- ctx->to_do_hd = NULL;
- ctx->to_do_tl = NULL;
- ctx->running_finalisation_function = 0;
+ this_ctx->final_table = NULL;
+ this_ctx->final_old = 0;
+ this_ctx->final_young = 0;
+ this_ctx->final_size = 0;
+ this_ctx->to_do_hd = NULL;
+ this_ctx->to_do_tl = NULL;
+ this_ctx->running_finalisation_function = 0;
/* from dynlink.c */
/*
- ctx->caml_prim_table
- ctx->caml_prim_name_table
- ctx->shared_libs;
- ctx->caml_shared_libs_path;
+ this_ctx->caml_prim_table
+ this_ctx->caml_prim_name_table
+ this_ctx->shared_libs;
+ this_ctx->caml_shared_libs_path;
*/
/* from parsing.c */
- ctx->caml_parser_trace = 0;
+ this_ctx->caml_parser_trace = 0;
- //caml_context = ctx;
+ //caml_context = this_ctx;
/*
- fprintf(stderr, "set caml_context %x\n", ctx);
+ fprintf(stderr, "set caml_context %x\n", this_ctx);
fprintf(stderr, "enter_blocking_section_hook = %lx (%lx)\n",
- & ctx->enter_blocking_section_hook,
- ctx->enter_blocking_section_hook);
+ & this_ctx->enter_blocking_section_hook,
+ this_ctx->enter_blocking_section_hook);
fprintf(stderr, "leave_blocking_section_hook = %lx (%lx)\n",
- & ctx->leave_blocking_section_hook,
- ctx->leave_blocking_section_hook);
+ & this_ctx->leave_blocking_section_hook,
+ this_ctx->leave_blocking_section_hook);
fprintf(stderr, "caml_enter_blocking_section_default = %lx\n",
caml_enter_blocking_section_default);
fprintf(stderr, "caml_leave_blocking_section_default = %lx\n",
caml_leave_blocking_section_default);
*/
/* From st_stubs.c */
- ctx->all_threads = NULL;
- ctx->curr_thread = NULL;
- /* ctx->caml_master_lock; */
- ctx->caml_tick_thread_running = 0;
- /* ctx->caml_tick_thread_id; */
- ctx->caml_thread_next_ident = 0;
+ this_ctx->all_threads = NULL;
+ this_ctx->curr_thread = NULL;
+ /* this_ctx->caml_master_lock; */
+ this_ctx->caml_tick_thread_running = 0;
+ /* this_ctx->caml_tick_thread_id; */
+ this_ctx->caml_thread_next_ident = 0;
/* From scheduler.c: */
- ctx->curr_vmthread = NULL;
- ctx->next_ident = Val_int(0);
- ctx->last_locked_channel = NULL;
+ this_ctx->curr_vmthread = NULL;
+ this_ctx->next_ident = Val_int(0);
+ this_ctx->last_locked_channel = NULL;
/* Global context-local OCaml variables */
#ifdef NATIVE_CODE
- ctx->caml_globals.allocated_size = INITIAL_CAML_GLOBALS_ALLOCATED_SIZE;
- ctx->caml_globals.used_size = 0;
- ctx->caml_globals.array = caml_stat_alloc(ctx->caml_globals.allocated_size);
+ this_ctx->caml_globals.allocated_size = INITIAL_CAML_GLOBALS_ALLOCATED_SIZE;
+ this_ctx->caml_globals.used_size = 0;
+ this_ctx->caml_globals.array = caml_stat_alloc(this_ctx->caml_globals.allocated_size);
#endif /* #ifdef NATIVE_CODE */
/* Global context-local C variables */
- ctx->c_globals.allocated_size = INITIAL_C_GLOBALS_ALLOCATED_SIZE;
- ctx->c_globals.used_size = 0;
- ctx->c_globals.array = caml_stat_alloc(ctx->c_globals.allocated_size);
+ this_ctx->c_globals.allocated_size = INITIAL_C_GLOBALS_ALLOCATED_SIZE;
+ this_ctx->c_globals.used_size = 0;
+ this_ctx->c_globals.array = caml_stat_alloc(this_ctx->c_globals.allocated_size);
/* By default, a context is associated with its creating thread: */
- ctx->thread = pthread_self();
- caml_set_thread_local_context(ctx);
+ this_ctx->thread = pthread_self();
+ caml_set_thread_local_context(this_ctx);
/* Make a local descriptor for this context: */
//fprintf(stderr, "Initializing the context descriptor...\n"); fflush(stderr);
- ctx->descriptor = caml_stat_alloc(sizeof(struct caml_global_context_descriptor));
- ctx->descriptor->kind = caml_global_context_main;
- ctx->descriptor->content.local_context.context = ctx;
- //fprintf(stderr, "Initialized the context [%p] descriptor [%p]\n", ctx, ctx->descriptor); fflush(stderr);
+ this_ctx->descriptor = caml_stat_alloc(sizeof(struct caml_global_context_descriptor));
+ this_ctx->descriptor->kind = caml_global_context_main;
+ this_ctx->descriptor->content.local_context.context = this_ctx;
+ //fprintf(stderr, "Initialized the context [%p] descriptor [%p]\n", this_ctx, this_ctx->descriptor); fflush(stderr);
- caml_initialize_mutex(&ctx->mutex);
+ caml_initialize_mutex(&this_ctx->mutex);
/* We can split in the present state: */
- ctx->can_split = 1;
+ this_ctx->can_split = 1;
+
+ ///* The main thread is already a user for this context. This pinning
+ // has to be performed *before* creating the destructor thread, to
+ // ensure the counter is greater than zero when the destructor thread
+ // starts: */
+ //caml_pin_context_r(this_ctx);
+ //DUMP("added the initial pin");
/* Context-destructor structures: */
- ctx->reference_count = 0;
- caml_initialize_semaphore(&ctx->destruction_semaphore, 0);
- int pthread_create_result = pthread_create(&ctx->destructor_thread, NULL, caml_destructor_thread_function, ctx);
+ this_ctx->reference_count = 1; // there is one user thread: the main one
+ {CAML_R = this_ctx; DUMP("added the initial pin to the context %p", this_ctx);}
+#ifdef HAS_MULTICONTEXT
+ caml_initialize_semaphore(&this_ctx->destruction_semaphore, 0);
+ int pthread_create_result =
+ pthread_create(&this_ctx->destructor_thread, NULL, caml_destructor_thread_function, this_ctx);
assert(pthread_create_result == 0);
- //caml_initialize_mutex(&ctx->reference_count_mutex);
+ //caml_initialize_mutex(&this_ctx->reference_count_mutex);
+#endif // #ifdef HAS_MULTICONTEXT
/* The kludgish self-pointer: */
- ctx->ctx = ctx;
-
- /* The main thread is already a user for this context: */
- caml_pin_context_r(ctx);
+#ifdef HAS_MULTICONTEXT
+ this_ctx->ctx = this_ctx;
+#endif // #ifdef HAS_MULTICONTEXT
+}
- return ctx;
+caml_global_context *caml_make_first_global_context(void){
+#ifdef HAS_MULTICONTEXT
+ caml_global_context* the_initial_context_pointer = (caml_global_context*)caml_stat_alloc(sizeof(caml_global_context));
+ caml_initialize_first_global_context(the_initial_context_pointer);
+ return the_initial_context_pointer;
+#else
+ static int already_initialized = 0;
+ assert(already_initialized == 0);
+ caml_initialize_first_global_context(&the_one_and_only_context_struct);
+ already_initialized = 1;
+ return &the_one_and_only_context_struct;
+#endif // #ifdef HAS_MULTICONTEXT
}
#ifdef NATIVE_CODE
@@ -685,8 +733,8 @@ library_context *caml_get_library_context_r(CAML_R,
return uctx;
}
-extern void caml_destroy_context_r(CAML_R){
- //fprintf(stderr, "caml_destroy_context_r [context %p] [thread %p]: OK-1\n", ctx, (void*)(pthread_self())); fflush(stderr);
+void caml_finalize_context_r(CAML_R){
+ //fprintf(stderr, "caml_finalize_context_r [context %p] [thread %p]: OK-1\n", ctx, (void*)(pthread_self())); fflush(stderr);
caml_destroy_named_value_table_r(ctx);
caml_remove_global_root_r(ctx, &ctx->caml_signal_handlers);
@@ -701,7 +749,7 @@ extern void caml_destroy_context_r(CAML_R){
/* No global variables are live any more; destroy everything in the Caml heap: */
#ifdef NATIVE_CODE
caml_shrink_extensible_buffer(&ctx->caml_globals, ctx->caml_globals.used_size);
- //fprintf(stderr, "caml_destroy_context_r [context %p] [thread %p]: OK-2\n", ctx, (void*)(pthread_self())); fflush(stderr);
+ //fprintf(stderr, "caml_finalize_context_r [context %p] [thread %p]: OK-2\n", ctx, (void*)(pthread_self())); fflush(stderr);
caml_stat_free(ctx->caml_globals.array);
#endif /* #ifdef NATIVE_CODE */
@@ -710,16 +758,23 @@ extern void caml_destroy_context_r(CAML_R){
ctx->descriptor->kind = caml_global_context_dead;
ctx->descriptor->content.local_context.context = NULL;
- //fprintf(stderr, "caml_destroy_context_r [context %p] [thread %p]: OK-3\n", ctx, (void*)(pthread_self())); fflush(stderr);
+ //fprintf(stderr, "caml_finalize_context_r [context %p] [thread %p]: OK-3\n", ctx, (void*)(pthread_self())); fflush(stderr);
// Free every dynamically-allocated object which is pointed by the context data structure [FIXME: really do it]:
- //fprintf(stderr, "caml_destroy_context_r [context %p] [thread %p]: FIXME: actually free everything\n", ctx, (void*)(pthread_self())); fflush(stderr);
+ //fprintf(stderr, "caml_finalize_context_r [context %p] [thread %p]: FIXME: actually free everything\n", ctx, (void*)(pthread_self())); fflush(stderr);
+
+ //fprintf(stderr, "caml_finalize_context_r [context %p] [thread %p]: OK-4\n", ctx, (void*)(pthread_self())); fflush(stderr);
+ fprintf(stderr, "caml_finalize_context_r [context %p] [thread %p]: OK-5: finalized %p\n", ctx, (void*)(pthread_self()), ctx); fflush(stderr);
+ // FIXME: really destroy stuff
+}
+
+#ifdef HAS_MULTICONTEXT
+void caml_destroy_context_r(CAML_R){
+ caml_finalize_context_r(ctx);
- //fprintf(stderr, "caml_destroy_context_r [context %p] [thread %p]: OK-4\n", ctx, (void*)(pthread_self())); fflush(stderr);
/* Free the context data structure ifself: */
caml_stat_free(ctx);
- fprintf(stderr, "caml_destroy_context_r [context %p] [thread %p]: OK-5: destroyed %p\n", ctx, (void*)(pthread_self()), ctx); fflush(stderr);
- // FIXME: really destroy stuff
}
+#endif // #ifdef HAS_MULTICONTEXT
#ifdef NATIVE_CODE
/* The index of the first word in caml_globals which is not used yet.
@@ -841,9 +896,10 @@ CAMLprim value caml_set_debugging(value bool){
}
void caml_context_initialize_global_stuff(void){
- /* Attempt to prevent multiple initialization. This will not always
- work, because of missing synchronization: we can't use the global
- mutex, since we're gonna initialize it here. */
+ /* Attempt to prevent multiple initialization. This will not be
+ 100% reliable in particularly perverse cases which would require
+ synchronization: we can't use the global mutex, since we're gonna
+ initialize it here. */
if(caml_are_mutexes_already_initialized){
fprintf(stderr, "caml_initialize_global_stuff: called more than once\n");
fflush(stderr);
@@ -975,9 +1031,9 @@ void caml_release_contextual_lock(CAML_R){
}
-void caml_dump_global_mutex(void){
- fprintf(stderr, "{%u %p | %p}\n", caml_global_mutex.__data.__count, (void*)(long)caml_global_mutex.__data.__owner, (void*)(pthread_self())); fflush(stderr);
-}
+/* void caml_dump_global_mutex(void){ */
+/* fprintf(stderr, "{%u %p | %p}\n", caml_global_mutex.__data.__count, (void*)(long)caml_global_mutex.__data.__owner, (void*)(pthread_self())); fflush(stderr); */
+/* } */
//#ifndef NATIVE_CODE //FIXME: remove later. This is for debugging only
//#endif // #ifndef NATIVE_CODE
@@ -1022,11 +1078,21 @@ void caml_unpin_context_r(CAML_R){
DUMP("UNpin %i -> %i", ctx->reference_count + 1, ctx->reference_count);
if(ctx->reference_count == 0){
DUMP("removed the last pin");
+#ifdef HAS_MULTICONTEXT
caml_v_semaphore(&ctx->destruction_semaphore);
+#else
+ caml_run_at_context_exit_functions_r(&the_one_and_only_context_struct);
+ caml_finalize_context_r(&the_one_and_only_context_struct);
+#endif // #ifdef HAS_MULTICONTEXT
/* if(caml_remove_last_pin_from_context_hook != NULL) */
/* caml_remove_last_pin_from_context_hook(ctx); */
}
}
+CAMLprim value caml_unpin_context_primitive_r(CAML_R, value unit){
+ DUMP("explicitly unpinning");
+ caml_unpin_context_r(ctx);
+ return Val_unit;
+}
/* static void caml_default_remove_last_pin_from_context_hook_r(CAML_R){ */
/* caml_destroy_context_r(ctx); */
@@ -1036,11 +1102,11 @@ void caml_unpin_context_r(CAML_R){
/* CAMLprim int caml_multi_context_implemented(value unit){ */
-/* #if HAS_MULTI_CONTEXT */
+/* #if HAS_MULTICONTEXT */
/* return Bool_val(1); */
/* #else */
/* return Bool_val(0); */
-/* #endif /\* #if HAS_MULTI_CONTEXT *\/ */
+/* #endif /\* #if HAS_MULTICONTEXT *\/ */
/* } */
__thread int caml_indentation_level = 0; // FIXME: remove this crap after debugging !!!!!!!!!!!!!!!!
View
55 byterun/context.h
@@ -638,11 +638,13 @@ struct caml_global_context {
struct caml_global_context *after_longjmp_context;
char *after_longjmp_serialized_blob;
+#ifdef HAS_PTHREAD
/* The (POSIX) thread associated to this context: */
pthread_t thread;
/* Protect context fields from concurrent accesses: */
pthread_mutex_t mutex;
+#endif // #ifdef HAS_PTHREAD
/* Can we still split? If threads have already been created, it's too late. */
int can_split;
@@ -651,14 +653,18 @@ struct caml_global_context {
int reference_count;
//pthread_mutex_t reference_count_mutex; // NO: I'll just use the contextual mutex // Actually I don't need *any* mutex: caml threads on the same context are not parallel!!!!
//pthread_cond_t reference_count_condition;
+#ifdef HAS_MULTICONTEXT
sem_t destruction_semaphore;
pthread_t destructor_thread;
+#endif // #ifdef HAS_MULTICONTEXT
+#ifdef HAS_MULTICONTEXT
/* The "kludigsh self-pointer"; this is handy for compatibility
macros translating X to ctx->X. This field points to the
structure itself, so that the expressions ctx->X and
ctx->ctx->X refer the same value -- also as l-values. */
struct caml_global_context *ctx;
+#endif // #ifdef HAS_MULTICONTEXT
}; /* struct caml_global_context */
/* Context descriptors may be either local or remote: */
@@ -699,10 +705,49 @@ struct caml_global_context_descriptor* caml_global_context_descriptor_of_value(v
value caml_value_of_mailbox(struct caml_mailbox *m);
struct caml_mailbox* caml_mailbox_of_value(value v);
-#define CAML_R caml_global_context * /* volatile */ ctx // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-#define INIT_CAML_R CAML_R __attribute__((unused)) = caml_get_thread_local_context() // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-extern caml_global_context *caml_initialize_first_global_context(void);
+/* Preprocessor magic for multi-context support */
+#ifdef HAS_MULTICONTEXT
+
+ #define CAML_CURRENT_CONTEXT \
+ ctx
+
+ #define CAML_R \
+ caml_global_context *CAML_CURRENT_CONTEXT
+ #define INIT_CAML_R \
+ CAML_R /* __attribute__((unused)) */ = caml_get_thread_local_context()
+
+#else // no mulitcontext
+
+ /* The one and only context */
+ extern caml_global_context the_one_and_only_context_struct;
+ //extern caml_global_context * const ctx;
+ #define ctx (&the_one_and_only_context_struct)
+
+ //#define CAML_CURRENT_CONTEXT ctx//(&the_one_and_only_context_struct)
+
+ #define CAML_R \
+ caml_global_context *usElESs__ __attribute__((unused))
+ #define INIT_CAML_R \
+ /* nothing */
+
+ /* Some useless constant easy to load into a register, to be passed
+ around and then NOT used: */
+// #define ctx 0
+#endif // #ifdef HAS_MULTICONTEXT
+
+/* FIXME: use this everywhere instead of ctx->NAME. This lets us keep
+ ctx distinct from the_one_and_only_ctx; ctx is just a useless
+ parameter, and it must be easy to generate as a constant. 0 is a
+ good value. */
+/* #define CAML_CONTEXTUAL(name) \ */
+/* CAML_CURRENT_CONTEXT->name */
+
+
+/* Initialize the given context structure, which has already been allocated elsewhere: */
+extern void caml_initialize_first_global_context(caml_global_context *);
+
+extern caml_global_context *caml_make_first_global_context(void);
extern caml_global_context *caml_make_empty_context(void); /* defined in startup.c */
extern void caml_destroy_context_r(caml_global_context *c);
@@ -1125,6 +1170,10 @@ void caml_v_semaphore(sem_t* semaphore); // signal-safe, differently from POSIX
do{}while(0)
#endif // #ifdef NATIVE_CODE
+#ifndef HAS_PTHREAD
+#define pthread_self() 0 // DUMP and friends use this
+#endif // #ifndef HAS_PTHREAD
+
#define DUMPROOTS(FORMAT, ...) \
do{ \
flockfile(stderr); \
View
49 byterun/context_split.c
@@ -278,6 +278,8 @@ value caml_deserialize_blob_r(CAML_R, char *blob){
CAMLreturn(result);
}
+#ifdef HAS_MULTICONTEXT
+
/* Of course the result is malloc'ed. */
static char* caml_globals_and_data_as_c_byte_array_r(CAML_R, value function){
/* Make a big structure holding all globals and user-specified data, and marshal it into a blob: */
@@ -403,6 +405,7 @@ static int caml_run_function_this_thread_r(CAML_R, value function, int index)
/* Return 0 on success and non-zero on failure. */
static int caml_deserialize_and_run_in_this_thread(caml_global_context *parent_context, char *blob, int index, sem_t *semaphore, /*out*/caml_global_context **to_context)
{
+#ifdef HAS_MULTICONTEXT
/* Make a new empty context, and use it to deserialize the blob into. */
CAML_R = caml_make_empty_context(); // ctx also becomes the thread-local context
//DUMPROOTS("splitting: from new thread");
@@ -463,8 +466,10 @@ static int caml_deserialize_and_run_in_this_thread(caml_global_context *parent_c
did_we_fail = caml_run_function_this_thread_r(ctx, function, index);
DUMP("$$$$$$$$$$$$$$$ ran the Caml code in a child context");
if(did_we_fail){
- DUMP("the Caml code failed"); // !!!!!!!!!!!!!!!!!!!!!!!!!!! What shall we do in this case?
- volatile int a = 1; a /= 0; /*die horribly*/
+ //DUMP("the Caml code failed"); // !!!!!!!!!!!!!!!!!!!!!!!!!!! What shall we do in this case?
+ //volatile int a = 1; a /= 0; /*die horribly*/
+ DUMP("the Caml code failed");
+ assert(0); // What shall we do in this case?
}
/* One less user for this context; the main thread is done: */
@@ -475,6 +480,8 @@ static int caml_deserialize_and_run_in_this_thread(caml_global_context *parent_c
/* joined: the object must remain visibile to the OCaml code, and */
/* for accessing the pthread_t objecet from the C join code. *\/ */
/* CAMLreturnT(int, did_we_fail); */
+#endif // #ifdef HAS_MULTICONTEXT
+ assert(0); // this must be unreachable if multi-context is disabled
}
struct caml_thread_arguments{
@@ -606,19 +613,34 @@ caml_leave_blocking_section_r(ctx);
/* result = caml_alloc_r(ctx, thread_no, 0); */
/* CAMLreturn(result); */
/* } */
+#endif // #ifdef HAS_MULTICONTEXT
+
+static void caml_raise_registered_r(CAML_R, char *registered_name){
+ caml_raise_constant_r(ctx, *caml_named_value_r(ctx, registered_name));
+}
+
+static void caml_raise_cannot_split_r(CAML_R) __attribute__((unused));
+static void caml_raise_cannot_split_r(CAML_R){
+ caml_raise_registered_r(ctx, "Context.CannotSplit");
+}
+
+static void caml_raise_unimplemented_r(CAML_R){
+ caml_raise_registered_r(ctx, "Context.Unimplemented");
+}
CAMLprim value caml_context_split_r(CAML_R, value thread_no_as_value, value function)
{
+#if defined(HAS_MULTICONTEXT) && defined(NATIVE_CODE)
+
//DUMPROOTS("splitting: before GC-protecting locals");
CAMLparam1(function);
//CAMLlocal2(result, open_channels);
CAMLlocal5(result, open_channels, res, tail, chan);
//DUMPROOTS("splitting: after GC-protecting locals");
- value *exception_closure = caml_named_value_r(ctx, "CannotSplit");
int can_split = caml_can_split_r(ctx);
if (! can_split)
- caml_raise_constant_r(ctx, *exception_closure);
+ caml_raise_cannot_split_r(ctx);
int thread_no = Int_val(thread_no_as_value);
caml_global_context **new_contexts = caml_stat_alloc(sizeof(caml_global_context*) * thread_no);
@@ -722,6 +744,10 @@ CAMLprim value caml_context_split_r(CAML_R, value thread_no_as_value, value func
CAMLreturn(result);
//CAMLreturn(Val_unit);
+#else
+ caml_raise_unimplemented_r(ctx);
+ return Val_unit; // unreachable
+#endif // #if defined(HAS_MULTICONTEXT) && defined(NATIVE_CODE)
}
// FIXME: is this useful? I'd like to kill it
@@ -767,6 +793,7 @@ CAMLprim value caml_context_join_r(CAML_R, value context_as_value){
CAMLprim value caml_context_send_r(CAML_R, value receiver_mailbox_as_value, value message){
//fprintf(stderr, "SEND: OK-1\n"); fflush(stderr);
CAMLparam2(receiver_mailbox_as_value, message);
+#ifdef HAS_MULTICONTEXT
struct caml_mailbox *receiver_mailbox;
char *message_blob;
receiver_mailbox = caml_mailbox_of_value(receiver_mailbox_as_value);
@@ -809,13 +836,16 @@ CAMLprim value caml_context_send_r(CAML_R, value receiver_mailbox_as_value, valu
//fprintf(stderr, "caml_context_send_r [%p, m %p]: OK-100\n", ctx, receiver_mailbox); fflush(stderr);
//fprintf(stderr, "caml_context_send_r [%p, m %p]: OK-100 END, message_no is %i\n", ctx, receiver_mailbox, (int)receiver_mailbox->message_no); fflush(stderr);
//fprintf(stderr, "SEND: OK-4\n"); fflush(stderr);
-
+#else
+ caml_raise_unimplemented_r(ctx);
+#endif // #ifdef HAS_MULTICONTEXT
CAMLreturn(Val_unit);
}
CAMLprim value caml_context_receive_r(CAML_R, value receiver_mailbox_as_value){
- //fprintf(stderr, "RECEIVE: OK-1\n"); fflush(stderr);
CAMLparam1(receiver_mailbox_as_value);
+#ifdef HAS_MULTICONTEXT
+ //fprintf(stderr, "RECEIVE: OK-1\n"); fflush(stderr);
CAMLlocal1(message);
struct caml_mailbox *receiver_mailbox = caml_mailbox_of_value(receiver_mailbox_as_value);
char *message_blob;
@@ -860,11 +890,14 @@ CAMLprim value caml_context_receive_r(CAML_R, value receiver_mailbox_as_value){
message = caml_deserialize_blob_r(ctx, message_blob);
free(message_blob);
+ CAMLreturn(message);
//fprintf(stderr, "caml_context_receive_r [%p, m %p]: OK-100 END, message_no is %i\n", ctx, receiver_mailbox, (int)receiver_mailbox->message_no); fflush(stderr);
//fprintf(stderr, "RECEIVE: OK-4\n"); fflush(stderr);
-
- CAMLreturn(message);
+#else
+ caml_raise_unimplemented_r(ctx);
+ CAMLreturn(Val_unit); // unreachable
+#endif // #ifdef HAS_MULTICONTEXT
}
CAMLprim value caml_dump_r(CAML_R, value string){
View
2 byterun/md5.h
@@ -36,7 +36,7 @@ struct MD5Context {
/* These don't need to be reentrant: REENTRANTRUNTIME */
CAMLextern void caml_MD5Init (struct MD5Context *context);
CAMLextern void caml_MD5Update (struct MD5Context *context, unsigned char *buf, uintnat len);
-CAMLextern void caml_MD5Final (unsigned char *digest, struct MD5Context *ctx);
+CAMLextern void caml_MD5Final (unsigned char *digest, struct MD5Context *ctx_);
CAMLextern void caml_MD5Transform (uint32 *buf, uint32 *in);
View
10 byterun/startup.c
@@ -344,6 +344,7 @@ extern void caml_signal_thread(void * lpParam);
//extern __thread caml_global_context *caml_context; // in context.c // FIXME: remove: it's now a thread-local static
+#ifdef HAS_MULTICONTEXT
/* FIXME: refactor: call this from caml_main_rr --Luca Saiu REENTRANTRUNTIME */
caml_global_context* caml_make_empty_context(void)
{
@@ -352,9 +353,9 @@ caml_global_context* caml_make_empty_context(void)
into a big data structure, copying whatever's needed: */
caml_acquire_global_lock(); // FIXME: is this critical section needed?
//caml_global_context *old_thread_local_context = caml_get_thread_local_context();
- caml_global_context *ctx = caml_initialize_first_global_context();
+ caml_global_context *ctx = caml_make_first_global_context();
ctx->descriptor->kind = caml_global_context_nonmain_local;
- //caml_set_thread_local_context(old_thread_local_context); // undo caml_initialize_first_global_context's trashing of the __thread variable
+ //caml_set_thread_local_context(old_thread_local_context); // undo caml_make_first_global_context's trashing of the __thread variable
caml_release_global_lock();
// FIXME: unlock
@@ -373,6 +374,7 @@ caml_global_context* caml_make_empty_context(void)
return ctx;
}
+#endif // #ifdef HAS_MULTICONTEXT
/* Main entry point when loading code from a file */
@@ -389,7 +391,7 @@ CAMLexport caml_global_context* caml_main_rr(char **argv)
#endif
caml_context_initialize_global_stuff();
- CAML_R = caml_initialize_first_global_context();
+ CAML_R = caml_make_first_global_context();
the_main_context = ctx;
/* Machine-dependent initialization of the floating-point hardware
@@ -505,7 +507,7 @@ CAMLexport void caml_startup_code(
#endif
caml_context_initialize_global_stuff();
- CAML_R = caml_initialize_first_global_context();
+ CAML_R = caml_make_first_global_context();
the_main_context = ctx;
caml_init_ieee_floats();
View
3 byterun/sys.c
@@ -99,9 +99,12 @@ CAMLexport void caml_sys_io_error_r(CAML_R, value arg)
CAMLprim value caml_sys_exit_r(CAML_R, value retcode)
{
+ DUMP();
#ifndef NATIVE_CODE
caml_debugger_r(ctx, PROGRAM_EXIT);
#endif
+ caml_unpin_context_r(ctx); // FIXME: is this appropriate here?
+
exit(Int_val(retcode));
return Val_unit;
}
View
3 config/s.h
@@ -47,8 +47,7 @@
#define HAS_GETHOSTBYNAME_R 6
#define HAS_GETHOSTBYADDR_R 8
#define HAS_STACK_OVERFLOW_DETECTION
-#define HAS_MULTI_CONTEXT
-#define HAS_PTHREAD
#define HAS_PTHREAD
#define HAS_SIGWAIT
+#define HAS_MULTICONTEXT
#define HAS_LIBBFD
View
59 configure
@@ -34,6 +34,7 @@ x11_lib_dir=''
graph_wanted=yes
tk_wanted=yes
pthread_wanted=yes
+multicontext_wanted=yes
tk_defs=''
tk_libs=''
tk_x11=yes
@@ -97,6 +98,8 @@ while : ; do
;; # Ignored for backward compatibility
-no-pthread*|--no-pthread*)
pthread_wanted=no;;
+ -no-multicontext*|--no-multicontext*|-no-multi-context*|--no-multi-context*)
+ multicontext_wanted=no;;
-no-tk|--no-tk)
tk_wanted=no;;
-partialld|--partialld)
@@ -1179,25 +1182,6 @@ esac
echo "BNG_ARCH=$bng_arch" >> Makefile
echo "BNG_ASM_LEVEL=$bng_asm_level" >> Makefile
-# Determine if multi-context is supported
-
-multicontext_support=false
-case "$arch,$system" in
- amd64,linux)
- echo "Multi-context is supported."
- multicontext_support=true
- echo "#define HAS_MULTI_CONTEXT" >> s.h
- # FIXME: all of this should probably be printed only once
- pthread_link="-lpthread"
- pthread_caml_link="-cclib -lpthread"
- bytecccompopts="$bytecccompopts -D_REENTRANT"
- nativecccompopts="$nativecccompopts -D_REENTRANT"
- echo "#define HAS_PTHREAD" >> s.h
- ;;
- *)
- echo "Multi-context is not supported";;
-esac
-
# Determine if the POSIX threads library is supported
systhread_support=false
@@ -1217,10 +1201,8 @@ if test "$pthread_wanted" = "yes"; then
echo "POSIX threads library supported."
systhread_support=true
otherlibraries="$otherlibraries systhreads"
-# if test "$multicontext_support" != "1"; then
- bytecccompopts="$bytecccompopts -D_REENTRANT"
- nativecccompopts="$nativecccompopts -D_REENTRANT"
-# fi
+ bytecccompopts="$bytecccompopts -D_REENTRANT"
+ nativecccompopts="$nativecccompopts -D_REENTRANT"
echo "#define HAS_PTHREAD" >> s.h
case "$host" in
*-*-freebsd*)
@@ -1257,6 +1239,31 @@ else
echo "Bytecode threads library not supported (missing system calls)"
fi
+# Determine if multi-context is supported
+
+multicontext_support=false
+if test "$multicontext_wanted" = "yes"; then
+ case "$arch,$system" in
+ amd64,linux)
+ if test "$systhread_support" != "true"; then
+ echo "No pthreads on GNU/Linux amd64. This should not happen" 1>&2
+ exit 2 # Why 2? Just a local convention? --L.S. !!!!!!!!!!!!!!!!!!!
+ fi
+ echo "Multi-context is supported."
+ multicontext_support=true
+ echo "#define HAS_MULTICONTEXT" >> s.h
+ ;;
+ *)
+ echo "Multi-context is not supported"
+ echo '// #define HAS_MULTICONTEXT /* not supported */' >> s.h
+ ;;
+ esac
+## FIXME: disable the next else branch, for uniformity !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+else
+ echo "You disabled multi-context"
+ echo '// #define HAS_MULTICONTEXT /* disabled at configuration time */' >> s.h
+fi
+
# Determine the location of X include files and libraries
# If the user specified -x11include and/or -x11lib, these settings
@@ -1720,6 +1727,12 @@ else
fi
fi
+if test "$multicontext_support" = "true"; then
+ echo "Multi-context: enabled"
+else
+ echo "Multi-context: disabled or not supported"
+fi
+
if test "$debugger" = "ocamldebugger"; then
echo "Source-level replay debugger: supported"
else
View
6 myocamlbuild_config.ml
@@ -18,7 +18,7 @@ let tk_defs = "";;
let tk_link = "";;
let libbfd_link = "-lbfd -ldl -liberty -lz";;
let bytecc = "gcc";;
-let bytecccompopts = "-fno-defer-pop -Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT -D_REENTRANT";;
+let bytecccompopts = "-fno-defer-pop -Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT";;
let bytecclinkopts = " -Wl,-E";;
let bytecclibs = " -lm -ldl -lcurses -lpthread";;
let byteccrpath = "-Wl,-rpath,";;
@@ -37,8 +37,8 @@ let arch = "amd64";;
let model = "default";;
let system = "linux";;
let nativecc = "gcc";;
-let nativecccompopts = "-Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT -D_REENTRANT";;
-let nativeccprofopts = "-Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT -D_REENTRANT";;
+let nativecccompopts = "-Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT";;
+let nativeccprofopts = "-Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT";;
let nativecclinkopts = "";;
let nativeccrpath = "-Wl,-rpath,";;
let nativecclibs = " -lm -ldl -lpthread";;
View
20 otherlibs/systhreads/st_stubs.c
@@ -97,7 +97,7 @@ struct caml_thread_struct {
int backtrace_pos; /* Saved backtrace_pos */
code_t * backtrace_buffer; /* Saved backtrace_buffer */
value backtrace_last_exn; /* Saved backtrace_last_exn (root) */
- CAML_R; /* the context to which this thread belongs */
+ caml_global_context *this_ctx;//CAML_R; /* the context to which this thread belongs */
};
/* The key used for storing the thread descriptor in the specific data
@@ -439,7 +439,7 @@ static caml_thread_t caml_thread_new_info_r(CAML_R)
th->backtrace_pos = 0;
th->backtrace_buffer = NULL;
th->backtrace_last_exn = Val_unit;
- th->ctx = ctx;
+ th->this_ctx = ctx;
//th->posix_thread = (pthread_t)(void*)0xbadbadbad; /* an intentionally invalid value, to aid debugging */
//th->id = (int)-2;
QR();
@@ -477,7 +477,7 @@ static void caml_thread_remove_info(caml_thread_t th)
//QBR("############################################################# \"virtually\" removing %p from the thread list", th); return; // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
QB();
- CAML_R = th->ctx;
+ CAML_R = th->this_ctx;
caml_acquire_contextual_lock(ctx);
if(0){ // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -581,7 +581,7 @@ caml_acquire_contextual_lock(ctx);
#ifdef NATIVE_CODE
curr_thread->exit_buf = &caml_termination_jmpbuf;
#endif
- curr_thread->ctx = ctx;
+ curr_thread->this_ctx = ctx;
/* The stack-related fields will be filled in at the next
enter_blocking_section */
@@ -670,7 +670,7 @@ CAMLprim value caml_thread_cleanup_r(CAML_R, value unit) /* ML */
DUMP("????????????????? waiting for the tick thread to exit");
select(0, NULL, NULL, NULL, &timeout);
} while(caml_tick_thread_running == -1);
- DUMP("!!!!!!!!!!!!!!!!! the tick thread has sais it's exiting");
+ DUMP("!!!!!!!!!!!!!!!!! the tick thread has said it's about to exit");
}
} // switch
QR();
@@ -740,7 +740,7 @@ static ST_THREAD_FUNCTION caml_thread_start(void * arg)
{
QB();
caml_thread_t th = (caml_thread_t) arg;
- CAML_R = th->ctx;
+ CAML_R = th->this_ctx;
value clos;
#ifdef NATIVE_CODE
struct longjmp_buffer termination_buf;
@@ -800,7 +800,7 @@ static ST_THREAD_FUNCTION caml_thread_start(void * arg)
/* { */
/* QB(); */
/* caml_thread_t th = (caml_thread_t) arg; */
-/* CAML_R = th->ctx; */
+/* CAML_R = th->this_ctx; */
/* value clos; */
/* #ifdef NATIVE_CODE */
/* struct longjmp_buffer termination_buf; */
@@ -919,8 +919,8 @@ caml_release_contextual_lock(ctx);
#ifdef NATIVE_CODE
th->top_of_stack = (char *) &err;
#endif
- assert(th->ctx == (void*)0xdead);
- th->ctx = ctx;
+ assert(th->this_ctx == (void*)0xdead);
+ th->this_ctx = ctx;
/* Take master lock to protect access to the chaining of threads */
caml_acquire_contextual_lock(ctx);
st_masterlock_acquire(&caml_master_lock);
@@ -962,7 +962,7 @@ CAMLexport int caml_c_thread_unregister_r(CAML_R)
{
//QBR("############################################################# \"virtually\" calling caml_c_thread_unregister_r"); return; // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
caml_thread_t th = st_tls_get(thread_descriptor_key);
- assert(ctx == th->ctx);// FIXME: remove
+ assert(ctx == th->this_ctx);// FIXME: remove
/* Not registered? */
if (th == NULL) {QR(); return 0;}
View
2 otherlibs/threads/scheduler.c
@@ -765,7 +765,7 @@ value thread_outchan_ready(value vchan, value vsize) /* ML */
/* Suspend the current thread for some time */
-value thread_delay_r(CAML_R, value time) /* ML */
+CAMLprim value thread_delay_r(CAML_R, value time) /* ML */ // FIXME: remove CAMLprim after testing
{
double date = timeofday() + Double_val(time);
Assert(curr_thread != NULL);
View
6 stdlib/context.ml
@@ -21,7 +21,8 @@ let iota n =
range 0 (n - 1);;
exception CannotSplit
-let _ = Callback.register_exception "CannotSplit" CannotSplit
+let _ = Callback.register_exception "Context.CannotSplit" CannotSplit
+let _ = Callback.register_exception "Context.Unimplemented" Unimplemented
(* FIXME: use a custom type instead *)
type t =
@@ -152,6 +153,9 @@ let split1 f =
let at_context_exit_functions : (unit -> unit) list ref =
ref []
+(* This is UNSAFE and shouldn't be exposed to the user. FIXME: is it really needed? *)
+external unpin_this_context : unit -> unit = "caml_unpin_context_primitive_r" "reentrant"
+
(* FIXME: remove after debugging *)
external dump : string -> unit = "caml_dump_r" "reentrant"
(* FIXME: remove after debugging *)
View
5 stdlib/context.mli
@@ -1,6 +1,7 @@
(* Luca Saiu, REENTRANTRUNTIME *)
-(* The context support unimplemented on this architecture: *)
+(* The context support is unimplemented on this architecture, or
+ disabled at configuration time: *)
exception Unimplemented
(* Return true iff multi-context support is implemented: *)
@@ -26,7 +27,7 @@ val make_mailbox : unit -> mailbox
val context_of_mailbox : mailbox -> t
val is_mailbox_local : mailbox -> bool
-(* These may raise CannotSplit *)
+(* These may raise CannotSplit and Unimplemented *)
val split1 : (mailbox -> unit) -> (*new context mailbox*)mailbox
val split : int -> (int -> mailbox -> unit) -> (*mailboxes to new contexts*)(mailbox list)
val split_into_array : int -> (int -> mailbox -> unit) -> (*mailboxes to new contexts*)(mailbox array)
View
6 tools/myocamlbuild_config.ml
@@ -18,7 +18,7 @@ let tk_defs = "";;
let tk_link = "";;
let libbfd_link = "-lbfd -ldl -liberty -lz";;
let bytecc = "gcc";;
-let bytecccompopts = "-fno-defer-pop -Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT -D_REENTRANT";;
+let bytecccompopts = "-fno-defer-pop -Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT";;
let bytecclinkopts = " -Wl,-E";;
let bytecclibs = " -lm -ldl -lcurses -lpthread";;
let byteccrpath = "-Wl,-rpath,";;
@@ -37,8 +37,8 @@ let arch = "amd64";;
let model = "default";;
let system = "linux";;
let nativecc = "gcc";;
-let nativecccompopts = "-Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT -D_REENTRANT";;
-let nativeccprofopts = "-Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT -D_REENTRANT";;
+let nativecccompopts = "-Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT";;
+let nativeccprofopts = "-Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT";;
let nativecclinkopts = "";;
let nativeccrpath = "-Wl,-rpath,";;
let nativecclibs = " -lm -ldl -lpthread";;

0 comments on commit 355cf08

Please sign in to comment.