Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Temporary fix for a just-noticed crash: we have to clone (via a blob)…

… caml_signal_handlers into each context at split time
  • Loading branch information...
commit db5549cdbdb27a70018392484bd7ff55ed202650 1 parent f22b4f9
@lucasaiu authored
View
BIN  boot/ocamlrun
Binary file not shown
View
14 byterun/context.h
@@ -1036,7 +1036,7 @@ void caml_finalize_semaphore(sem_t *semaphore);
#define DUMP(FORMAT, ...) \
do{ \
fprintf(stderr, \
- "%s:%i(" RED "%s" NOATTR ") C%p T%p "/* "AP" PURPLE"%p"NOATTR"/"PURPLE"%p" */NOATTR" ", \
+ "%s:%i(" RED "%s" NOATTR ") C%p T" CYAN "%p "/* "AP" PURPLE"%p"NOATTR"/"PURPLE"%p" */NOATTR" ", \
__FILE__, __LINE__, __FUNCTION__, ctx, \
(void*)pthread_self()); \
fflush(stderr); \
@@ -1095,14 +1095,14 @@ extern __thread int caml_indentation_level;
/* #undef DUMP */
/* #undef QDUMP */
-/* #undef QB */
-/* #undef QR */
-/* #undef QBR */
+#undef QB
+#undef QR
+#undef QBR
/* #define DUMP(FORMAT, ...) /\* nothing *\/ */
/* #define QDUMP(FORMAT, ...) /\* nothing *\/ */
-/* #define QB(FORMAT, ...) /\* nothing *\/ */
-/* #define QR(FORMAT, ...) /\* nothing *\/ */
-/* #define QBR(FORMAT, ...) /\* nothing *\/ */
+#define QB(FORMAT, ...) /* nothing */
+#define QR(FORMAT, ...) /* nothing */
+#define QBR(FORMAT, ...) /* nothing */
/* int caml_get_thread_no_r(CAML_R); */
/* void caml_set_caml_get_thread_no_r(CAML_R, int (*f)(CAML_R)); */
View
60 byterun/context_split.c
@@ -179,7 +179,7 @@ static value caml_globals_and_data_r(CAML_R, value *data, size_t element_no)
}
/* Return a pointer to a malloc'ed buffer: */
-static char* caml_serialize_into_blob_r(CAML_R, value caml_value){
+char* caml_serialize_into_blob_r(CAML_R, value caml_value){
CAMLparam1(caml_value);
CAMLlocal1(flags);
char *blob;
@@ -204,7 +204,7 @@ static char* caml_serialize_into_blob_r(CAML_R, value caml_value){
CAMLreturnT(char*, blob);
}
-static value caml_deserialize_blob_r(CAML_R, char *blob){
+value caml_deserialize_blob_r(CAML_R, char *blob){
CAMLparam0();
CAMLlocal1(result);
caml_acquire_global_lock(); // FIXME: remove after de-staticizing deserialization
@@ -280,12 +280,12 @@ static int caml_run_function_this_thread_r(CAML_R, value function, int index)
int did_we_fail;
/* fprintf(stderr, "======Forcing a GC\n"); fflush(stderr); */
-caml_gc_compaction_r(ctx, Val_unit); //!!!!!
+//caml_gc_compaction_r(ctx, Val_unit); //!!!!!
/* fprintf(stderr, "======It's ok to have warnings about the lack of globals up to this point\n"); fflush(stderr); */
//fprintf(stderr, "W0[context %p] [thread %p] (index %i) BBBBBBBBBBBBBBBBBBBBBBBBBB\n", ctx, (void*)(pthread_self()), index); fflush(stderr); caml_acquire_global_lock(); // FIXME: a test. this is obviously unusable in production
//fprintf(stderr, "W1 [context %p] ctx->caml_local_roots is %p\n", ctx, caml_local_roots); fflush(stderr);
- DUMP();
+//DUMP();
/* Make a new context, and deserialize the blob into it: */
/* fprintf(stderr, "W3 [context %p] [thread %p] (index %i) (function %p)\n", ctx, (void*)(pthread_self()), index, (void*)function); fflush(stderr); */
@@ -295,8 +295,8 @@ caml_gc_compaction_r(ctx, Val_unit); //!!!!!
/* caml_pair_r(ctx, Val_int(3), Val_int(4))); */
//fprintf(stderr, "W4 [context %p] [thread %p] (index %i) (function %p)\n", ctx, (void*)(pthread_self()), index, (void*)function); fflush(stderr);
- caml_gc_compaction_r(ctx, Val_unit); //!!!!!
- DUMP();
+//caml_gc_compaction_r(ctx, Val_unit); //!!!!!
+ //DUMP();
/* caml_empty_minor_heap_r(ctx); */
/* caml_finish_major_cycle_r (ctx); */
@@ -305,8 +305,8 @@ caml_gc_compaction_r(ctx, Val_unit); //!!!!!
/* Run the Caml function: */
//fprintf(stderr, "W5 [context %p] [thread %p] (index %i) (function %p)\n", ctx, (void*)(pthread_self()), index, (void*)function); fflush(stderr);
- caml_gc_compaction_r(ctx, Val_unit); //!!!!!
- DUMP();
+ //caml_gc_compaction_r(ctx, Val_unit); //!!!!!
+ //DUMP();
//fprintf(stderr, "W7 [context %p] [thread %p] (index %i) (%i globals) ctx->caml_local_roots is %p\n", ctx, (void*)(pthread_self()), index, (int)(ctx->caml_globals.used_size / sizeof(value)), caml_local_roots); fflush(stderr);
//caml_dump_global_mutex();
@@ -383,13 +383,13 @@ static void* caml_deserialize_and_run_in_this_thread_as_thread_function(void *ar
/* Create threads, and wait until all of them have signaled that they're done with the blob: */
static void caml_split_and_wait_r(CAML_R, char *blob, caml_global_context **split_contexts, size_t how_many, sem_t *semaphore)
{
- DUMP();
+ //DUMP();
//#ifdef NATIVE_CODE
// fprintf(stderr, "@@@@@ In the parent context caml_bottom_of_stack is %p\n", caml_bottom_of_stack);
//#endif // #ifdef NATIVE_CODE
- DUMP();
+ //DUMP();
caml_gc_compaction_r(ctx, Val_unit); //!!!!!
- DUMP();
+ //DUMP();
int i;
for(i = 0; i < how_many; i ++){
//sleep(10); // FIXME: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -406,13 +406,13 @@ static void caml_split_and_wait_r(CAML_R, char *blob, caml_global_context **spli
caml_failwith_r(ctx, "pthread_create failed"); // FIXME: blob is leaked is this case
} /* for */
/* Wait for the last thread to use the blob, then destroy it: */
- DUMP("waiting for every thread to deserialize");
+ //DUMP("waiting for every thread to deserialize");
for(i = 0; i < how_many; i ++){
- DUMP("about to P");
+ //DUMP("about to P");
sem_wait(semaphore);
- DUMP("one child finished; waiting for %i more", (int)(how_many - i - 1));
+ //DUMP("one child finished; waiting for %i more", (int)(how_many - i - 1));
}
- DUMP("every thread has deserialized");
+ //DUMP("every thread has deserialized");
}
CAMLprim value caml_context_split_r(CAML_R, value thread_no_as_value, value function)
@@ -421,7 +421,7 @@ CAMLprim value caml_context_split_r(CAML_R, value thread_no_as_value, value func
CAMLlocal2(result, open_channels);
value *exception_closure = caml_named_value_r(ctx, "CannotSplit");
int can_split = caml_can_split_r(ctx);
- DUMP("************************** can_split is %i", can_split);
+ //DUMP("************************** can_split is %i", can_split);
if (! can_split)
caml_raise_constant_r(ctx, *exception_closure);
@@ -443,24 +443,24 @@ CAMLprim value caml_context_split_r(CAML_R, value thread_no_as_value, value func
caml_split_and_wait_r(ctx, blob, new_contexts, thread_no, &semaphore);
/* Now we're done with the blob: */
- DUMP("child threads have finished with the blob: destroying it");
+// DUMP("child threads have finished with the blob: destroying it");
caml_stat_free(blob);
- DUMP();
+// DUMP();
caml_gc_compaction_r(ctx, Val_unit); //!!!!!
- DUMP();
+// DUMP();
caml_finalize_semaphore(&semaphore);
- DUMP();
+// DUMP();
/////
/* Copy the contexts we got, and we're done with new_contexts as well: */
- DUMP("copying the new context (descriptors) into the Caml data structure result");
+// DUMP("copying the new context (descriptors) into the Caml data structure result");
result = caml_alloc_r(ctx, thread_no, 0);
caml_gc_compaction_r(ctx, Val_unit); //!!!!!
for(i = 0; i < thread_no; i ++)
caml_initialize_r(ctx, &Field(result, i), caml_value_of_context_descriptor(new_contexts[i]->descriptor));
caml_stat_free(new_contexts);
- DUMP("destroyed the malloced buffer of pointers new_contexts");
+// DUMP("destroyed the malloced buffer of pointers new_contexts");
CAMLreturn(result);
}
@@ -502,7 +502,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);
+ //fprintf(stderr, "SEND: OK-1\n"); fflush(stderr);
CAMLparam2(receiver_mailbox_as_value, message);
struct caml_mailbox *receiver_mailbox;
char *message_blob;
@@ -514,7 +514,7 @@ CAMLprim value caml_context_send_r(CAML_R, value receiver_mailbox_as_value, valu
it out of the critical section: */
message_blob = caml_serialize_into_blob_r(ctx, message);
- fprintf(stderr, "SEND: OK-2\n"); fflush(stderr);
+ //fprintf(stderr, "SEND: OK-2\n"); fflush(stderr);
/* /\* Wait until there is a free slot: *\/ */
/* caml_enter_blocking_section_r(ctx); */
/* sem_wait(&receiver_mailbox->free_slot_no_semaphore); */
@@ -526,7 +526,7 @@ CAMLprim value caml_context_send_r(CAML_R, value receiver_mailbox_as_value, valu
//fprintf(stderr, "caml_context_send_r [%p, m %p]: OK-30 AFTER LOCK\n", ctx, receiver_mailbox); fflush(stderr);
int message_no = receiver_mailbox->message_no;
- fprintf(stderr, "SEND: OK-3\n"); fflush(stderr);
+ //fprintf(stderr, "SEND: OK-3\n"); fflush(stderr);
/* Make sure there is enough space, enlarging the queue if needed: */
if(message_no == receiver_mailbox->allocated_message_no){
receiver_mailbox->allocated_message_no *= 2;
@@ -543,13 +543,13 @@ CAMLprim value caml_context_send_r(CAML_R, value receiver_mailbox_as_value, valu
//fprintf(stderr, "caml_context_send_r [%p, m %p]: OK-60 AFTER V\n", ctx, receiver_mailbox); fflush(stderr);
//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);
+ //fprintf(stderr, "SEND: OK-4\n"); fflush(stderr);
CAMLreturn(Val_unit);
}
CAMLprim value caml_context_receive_r(CAML_R, value receiver_mailbox_as_value){
- fprintf(stderr, "RECEIVE: OK-1\n"); fflush(stderr);
+ //fprintf(stderr, "RECEIVE: OK-1\n"); fflush(stderr);
CAMLparam1(receiver_mailbox_as_value);
CAMLlocal1(message);
struct caml_mailbox *receiver_mailbox = caml_mailbox_of_value(receiver_mailbox_as_value);
@@ -567,7 +567,7 @@ CAMLprim value caml_context_receive_r(CAML_R, value receiver_mailbox_as_value){
sem_wait(&receiver_mailbox->message_no_semaphore);
caml_leave_blocking_section_r(ctx);
- fprintf(stderr, "RECEIVE: OK-2\n"); fflush(stderr);
+ //fprintf(stderr, "RECEIVE: OK-2\n"); fflush(stderr);
//fprintf(stderr, "caml_context_receive_r [%p, m %p]: OK-20 AFTER P, BEFORE LOCK\n", ctx, receiver_mailbox); fflush(stderr);
/* Get what we need, and immediately unblock the next sender; we can
process our message after V'ing. */
@@ -586,7 +586,7 @@ CAMLprim value caml_context_receive_r(CAML_R, value receiver_mailbox_as_value){
//fprintf(stderr, "caml_context_receive_r [%p, m %p]: OK-40 BEFORE UNLOCK; message_no is now %i\n", ctx, receiver_mailbox, (int)receiver_mailbox->message_no); fflush(stderr);
pthread_mutex_unlock(&receiver_mailbox->mutex);
//fprintf(stderr, "caml_context_receive_r [%p, m %p]: OK-50 AFTER UNLOCK\n", ctx, receiver_mailbox); fflush(stderr);
- fprintf(stderr, "RECEIVE: OK-3\n"); fflush(stderr);
+ //fprintf(stderr, "RECEIVE: OK-3\n"); fflush(stderr);
/* /\* Signal the fact that there one slot has been freed: *\/ */
/* sem_post(&receiver_mailbox->free_slot_no_semaphore); */
@@ -595,7 +595,7 @@ CAMLprim value caml_context_receive_r(CAML_R, value receiver_mailbox_as_value){
free(message_blob);
//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);
+ //fprintf(stderr, "RECEIVE: OK-4\n"); fflush(stderr);
CAMLreturn(message);
}
View
9 byterun/context_split.h
@@ -7,6 +7,15 @@
// // FIXME: remove from the header. This should not be public
// typedef struct caml_context_blob* caml_context_blob_t;
+/* Serialize the given Caml object, which must belong to the given
+ context, into a malloc'ed buffer. */
+char* caml_serialize_into_blob_r(CAML_R, value object);
+
+/* Deserialize a buffer as returned by caml_serialize_r into a Caml
+ object for the given context (usually different from the
+ serialization context). This does *not* free the buffer. */
+value caml_deserialize_blob_r(CAML_R, char *blob);
+
/* Split the given context into how_many copies. Each one is
associated to a different new thread. For each thread the given
int -> unit function with an index from 0 to how_many - 1. Store
View
7 byterun/signals.c
@@ -148,7 +148,8 @@ CAMLexport void caml_leave_blocking_section_r(CAML_R)
void caml_execute_signal_r(CAML_R, int signal_number, int in_signal_handler)
{
- //DUMP("signal_number %i (converted into %i), in_signal_handler=%i", signal_number, (int)caml_rev_convert_signal_number(signal_number), in_signal_handler);
+ DUMP("SIGPREEMPTION is %i", SIGVTALRM);
+ DUMP("signal_number %i (converted into %i), in_signal_handler=%i", signal_number, (int)caml_rev_convert_signal_number(signal_number), in_signal_handler);
value res;
#ifdef POSIX_SIGNALS
sigset_t sigs;
@@ -160,7 +161,7 @@ void caml_execute_signal_r(CAML_R, int signal_number, int in_signal_handler)
#endif
//DUMP();
//caml_gc_compaction_r(ctx, Val_unit); //!!!!
- //DUMP("right before calling caml_callback_exn_r; caml_signal_handlers is %p", caml_signal_handlers);
+ DUMP("right before calling caml_callback_exn_r; caml_signal_handlers is %p", caml_signal_handlers);
res = caml_callback_exn_r(ctx,
Field(caml_signal_handlers, signal_number),
Val_int(caml_rev_convert_signal_number(signal_number)));
@@ -287,7 +288,7 @@ CAMLexport int caml_rev_convert_signal_number(int signo)
CAMLprim value caml_install_signal_handler_r(CAML_R, value signal_number, value action)
{
- //DUMP("signal_number %i", (int)Int_val(signal_number));
+ DUMP("signal_number %i", (int)Int_val(signal_number));
CAMLparam2 (signal_number, action);
CAMLlocal1 (res);
int sig, act, oldact;
View
2  configure
@@ -1179,7 +1179,7 @@ esac
echo "BNG_ARCH=$bng_arch" >> Makefile
echo "BNG_ASM_LEVEL=$bng_asm_level" >> Makefile
-# Determine if multi-context is support
+# Determine if multi-context is supported
case "$arch,$system" in
amd64,linux)
View
1  otherlibs/systhreads/st_posix.h
@@ -1,4 +1,3 @@
-//#warning Do "git diff 7d4891a0395abdac8e60f3cc788b71908c73a88d" on this file, and read it top-to-bottom
/***********************************************************************/
/* */
/* OCaml */
View
343 otherlibs/systhreads/st_stubs.c
@@ -132,17 +132,10 @@ static void caml_thread_scan_roots(scanning_action action)
{
QB();
INIT_CAML_R;
- DUMP("beginning");
caml_thread_t th;
th = curr_thread;
- //DUMP("FIXME: ENSURE THAT ALL THREADS ARE REACHABLE FROM %p", th);
do {
- //DUMP("caml_thread_t descriptor %p (pthread %p): begin", th, th->posix_thread);
- //if(th->posix_thread == (void*)(pthread_t)(void*)(long)0){DUMP("@@@@@@@@@@@@@@@@@@@@@@@@@ SKIPPING");th = th->next; break;}; // !!!!!!!!!!!!!!!!!!
-#ifdef NATIVE_CODE
- //DUMP("th->bottom_of_stack=%p, th->last_retaddr=%lx, th->gc_regs=%p, th->local_roots=%p", th->bottom_of_stack, th->last_retaddr, th->gc_regs, th->local_roots);
-#endif // #ifdef NATIVE_CODE
(*action)(ctx, th->descr, &th->descr);
(*action)(ctx, th->backtrace_last_exn, &th->backtrace_last_exn);
/* Don't rescan the stack of the current thread, it was done already */
@@ -155,14 +148,10 @@ static void caml_thread_scan_roots(scanning_action action)
caml_do_local_roots_r(ctx, action, th->sp, th->stack_high, th->local_roots);
#endif
}
- DUMP("caml_thread_t descriptor %p: end", th);
th = th->next;
} while (th != curr_thread);
- //DUMP("");
/* Hook */
- //DUMP("calling the previous hook (%p) if any", prev_scan_roots_hook);
if (prev_scan_roots_hook != NULL) (*prev_scan_roots_hook)(action);
- DUMP("end");
QR();
}
@@ -405,7 +394,6 @@ static caml_thread_t caml_thread_new_info(void)
static value caml_thread_new_descriptor_r(CAML_R, value clos)
{
QB();
- DUMP();
value mu = Val_unit;
value descr;
Begin_roots2 (clos, mu)
@@ -420,7 +408,6 @@ static value caml_thread_new_descriptor_r(CAML_R, value clos)
Start_closure(descr) = clos;
Terminated(descr) = mu;
End_roots();
- DUMP();
QR();
return descr;
}
@@ -434,9 +421,6 @@ static void caml_thread_remove_info(caml_thread_t th)
QR();
CAML_R = th->ctx;
- /* DUMP("================= I should destroy thread structures, but I won't"); */
- /* return; // FIXME: remove !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */
- DUMP("begin ---------------------");
/* If we're destroying the current thread, invalidate ctx->curr_thread: */
if(curr_thread == th) curr_thread = NULL; // Luca Saiu REENTRANTRUNTIME (after a similar change by Fabrice)
@@ -447,18 +431,12 @@ static void caml_thread_remove_info(caml_thread_t th)
all_threads = th->next; /* PR#5295 */
th->next->prev = th->prev;
th->prev->next = th->next;
- DUMP();
#ifndef NATIVE_CODE
stat_free(th->stack_low);
#endif
- DUMP();
if (th->backtrace_buffer != NULL) free(th->backtrace_buffer);
- DUMP();
- memset(th, 0xdd, sizeof(struct caml_thread_struct)); // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- DUMP();
- stat_free(th); // FIXME: this is needed!!! uncomment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- volatile int local; DUMP("end ----------------------- [and from now on the thing might crash] Local variable address: %p", &local);
+ memset(th, 0xdd, sizeof(struct caml_thread_struct)); // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! To ease debugging !!!!!!!!!!!!!!!
+ stat_free(th);
QR();
}
@@ -509,14 +487,11 @@ static void caml_thread_initialize_for_current_context_r(CAML_R){
QB();
/* The thing is already initialized if ctx->curr_thread is NULL: */
if(curr_thread != NULL){
- DUMP("already initialized");
QR();
return;
}
/* Set up a thread info block for the current thread */
- DUMP("curr_thread is %p before being initialized", curr_thread);
- DUMP("thread_next_ident is %i: check that it's changed at next thread creation", (int)thread_next_ident);
curr_thread =
(caml_thread_t) stat_alloc(sizeof(struct caml_thread_struct));
memset(curr_thread, 0xaa, sizeof(struct caml_thread_struct)); // !!!!!!!!! FIXME: remove. This is for debugging only
@@ -529,18 +504,19 @@ static void caml_thread_initialize_for_current_context_r(CAML_R){
#ifdef NATIVE_CODE
curr_thread->exit_buf = &caml_termination_jmpbuf;
#endif
- //// @@@@@@@@@
curr_thread->ctx = ctx;
- //curr_thread->posix_thread = 0;
- //curr_thread->id = (int)thread_next_ident;
- //// @@@@@@@@@
+
+ /* If this is not the main context, then we have to copy its signal
+ handlers (a Caml array, which can be cloned via a blob): */
+ if(ctx->descriptor->kind != caml_global_context_main){
+ fprintf(stderr, "UNIMPLEMENTED -- I'm fixing this on Monday :-) --Luca Saiu\n"); fflush(stderr);
+ exit(EXIT_FAILURE);
+ }
+
/* The stack-related fields will be filled in at the next
enter_blocking_section */
/* Associate the thread descriptor with the thread */
st_tls_set(thread_descriptor_key, (void *) curr_thread);
- //DUMP("curr_thread->ctx is %p", curr_thread->ctx);
- //DUMP("curr_thread->posix_thread is %p", curr_thread->posix_thread);
- //already_fully_initialized = 1;
QR();
}
@@ -551,17 +527,12 @@ static void caml_thread_initialize_for_current_context_r(CAML_R){
CAMLprim value caml_thread_initialize_r(CAML_R, value unit) /* ML */
{
QB();
- DUMP("before the repeated-initialization check");
- // /* Protect against repeated initialization (PR#1325) */
- // if (curr_thread != NULL) return Val_unit;
+ /* Protect against repeated initialization (PR#1325) */
static int already_initialized = 0;
if(already_initialized) {QR(); return Val_unit;} else already_initialized = 1;
- // DUMP("");
/* caml_set_caml_get_thread_no_r(ctx, caml_systhreads_get_thread_no_r); */
- DUMP("");
caml_set_caml_initialize_context_thread_support(ctx, caml_thread_initialize_for_current_context_r);
- DUMP("");
/* OS-specific initialization */
st_initialize();
@@ -571,11 +542,8 @@ CAMLprim value caml_thread_initialize_r(CAML_R, value unit) /* ML */
st_tls_newkey(&thread_descriptor_key);
st_tls_newkey(&last_channel_locked_key);
- caml_thread_initialize_for_current_context_r(ctx);
-
/* Set up the hooks */
prev_scan_roots_hook = caml_scan_roots_hook;
-//DUMP("about to set caml_scan_roots_hook");
caml_scan_roots_hook = caml_thread_scan_roots;
caml_enter_blocking_section_hook = caml_thread_enter_blocking_section_hook_default;
caml_leave_blocking_section_hook = caml_thread_leave_blocking_section_hook_default;
@@ -592,65 +560,17 @@ CAMLprim value caml_thread_initialize_r(CAML_R, value unit) /* ML */
/* Set up fork() to reinitialize the thread machinery in the child
(PR#4577) */
st_atfork(caml_thread_reinitialize);
-//DUMP("end");
+
+ /* We've set up the whole machinery which will be used from now on
+ at context split; good, but we also have to initialize the
+ *current* context: */
+ //caml_thread_initialize_for_current_context_r(ctx);???
+ caml_initialize_context_thread_support(ctx);
+
QR();
return Val_unit;
}
-/* CAMLprim value caml_thread_initialize_r(CAML_R, value unit) /\* ML *\/ */
-/* { */
-/* DUMP("before the repeated-initialization check"); */
-/* // /\* Protect against repeated initialization (PR#1325) *\/ */
-/* // if (curr_thread != NULL) return Val_unit; */
-/* static int already_initialized = 0; */
-/* if(already_initialized) return Val_unit; else already_initialized = 1; */
-
-/* DUMP(""); */
-/* /\* OS-specific initialization *\/ */
-/* st_initialize(); */
-/* /\* Initialize and acquire the master lock *\/ */
-/* st_masterlock_init(&caml_master_lock); */
-/* /\* Initialize the keys *\/ */
-/* st_tls_newkey(&thread_descriptor_key); */
-/* st_tls_newkey(&last_channel_locked_key); */
-/* /\* Set up a thread info block for the current thread *\/ */
-/* curr_thread = */
-/* (caml_thread_t) stat_alloc(sizeof(struct caml_thread_struct)); */
-/* curr_thread->descr = caml_thread_new_descriptor_r(ctx, Val_unit); */
-/* curr_thread->next = curr_thread; */
-/* curr_thread->prev = curr_thread; */
-/* all_threads = curr_thread; */
-/* curr_thread->backtrace_last_exn = Val_unit; */
-/* #ifdef NATIVE_CODE */
-/* curr_thread->exit_buf = &caml_termination_jmpbuf; */
-/* #endif */
-/* /\* The stack-related fields will be filled in at the next */
-/* enter_blocking_section *\/ */
-/* /\* Associate the thread descriptor with the thread *\/ */
-/* st_tls_set(thread_descriptor_key, (void *) curr_thread); */
-/* /\* Set up the hooks *\/ */
-/* prev_scan_roots_hook = caml_scan_roots_hook; */
-/* DUMP("about to set caml_scan_roots_hook"); */
-/* caml_scan_roots_hook = caml_thread_scan_roots; */
-/* caml_enter_blocking_section_hook = caml_thread_enter_blocking_section_hook_default; */
-/* caml_leave_blocking_section_hook = caml_thread_leave_blocking_section_hook_default; */
-/* caml_try_leave_blocking_section_hook = caml_thread_try_leave_blocking_section; */
-/* #ifdef NATIVE_CODE */
-/* caml_termination_hook = st_thread_exit; */
-/* #endif */
-/* caml_channel_mutex_free = caml_io_mutex_free; */
-/* caml_channel_mutex_lock = caml_io_mutex_lock; */
-/* caml_channel_mutex_unlock = caml_io_mutex_unlock; */
-/* caml_channel_mutex_unlock_exn = caml_io_mutex_unlock_exn; */
-/* prev_stack_usage_hook = caml_stack_usage_hook; */
-/* caml_stack_usage_hook = caml_thread_stack_usage; */
-/* /\* Set up fork() to reinitialize the thread machinery in the child */
-/* (PR#4577) *\/ */
-/* st_atfork(caml_thread_reinitialize); */
-/* DUMP("end"); */
-/* return Val_unit; */
-/* } */
-
/* Cleanup the thread machinery on program exit or DLL unload. */
CAMLprim value caml_thread_cleanup_r(CAML_R, value unit) /* ML */
@@ -683,49 +603,24 @@ static void caml_thread_stop_r(CAML_R)
QR();
}
-/* Return the number of threads associated to the given context: */
-static int caml_systhreads_get_thread_no_r(CAML_R){
- QB();
- //QDUMP("!!!!!!!!!!![%p %p]", curr_thread, all_threads);
- int result = 0;
- caml_thread_t t = all_threads;
- //QDUMP("!!!!!!!!!!!!!!!!! t is %p\n", t);
- caml_thread_t first_thread = t;
- if(t == NULL)
- result = 0;//return 0;
- else do{
- //QDUMP("!!!!!!!!!!!!!!!!! t is %p, result is %i\n", t, result);
- result ++;
- t = t->next;
- if(result > 1000)
- QDUMP("EEEEEEEEEEEEEEEEEEEEEE probably looping (1) looking for %p", first_thread);
- } while(t != first_thread);
- //QDUMP("!!!!!!!!!!!!!!!!! [1: %i]\n", result);
-
- /* if(already_fully_initialized){ */
- /* //// */
- /* int result2 = 0; */
- /* caml_thread_t t2 = curr_thread;//all_threads; */
- /* //QDUMP("!!!!!!!!!!!!!!!!! t2 is %p\n", t2); */
- /* caml_thread_t first_thread2 = t2; */
- /* if(t2 == NULL) */
- /* result2 = 0;//return 0; */
- /* else do{ */
- /* //QDUMP("!!!!!!!!!!!!!!!!! t2 is %p, first_thread2 is %p, result2 is %i\n", t2, first_thread2, result2); */
- /* result2 ++; */
- /* t2 = t2->next; */
- /* if(result2 > 1000) */
- /* QDUMP("EEEEEEEEEEEEEEEEEEEEEE probably looping (2) looking for %p", first_thread2); */
- /* } while(t2 != first_thread2); */
- /* //QDUMP("!!!!!!!!!!!!!!!!! [2: %i]\n", result2); */
- /* if(result != result2) */
- /* QDUMP("EEEEEEEEEEEEEEEEEEEEEE result is %i, result2 is %i [only ok if we're destroying the current thread]\n", result, result2); */
- /* //// */
- /* } */
-
- QR();
- return result;
-}
+/* /\* Return the number of threads associated to the given context: *\/ */
+/* static int caml_systhreads_get_thread_no_r(CAML_R){ */
+/* QB(); */
+/* int result = 0; */
+/* caml_thread_t t = all_threads; */
+/* caml_thread_t first_thread = t; */
+/* if(t == NULL) */
+/* result = 0;//return 0; */
+/* else do{ */
+/* result ++; */
+/* t = t->next; */
+/* if(result > 1000) */
+/* QDUMP("EEEEEEEEEEEEEEEEEEEEEE probably looping (1) looking for %p", first_thread); */
+/* } while(t != first_thread); */
+
+/* QR(); */
+/* return result; */
+/* } */
/* Create a thread */
@@ -733,10 +628,7 @@ static ST_THREAD_FUNCTION caml_thread_start(void * arg)
{
QB();
caml_thread_t th = (caml_thread_t) arg;
-//??? does th point to something which is destroyed by the GC ??? !!!!!!!!!!!!!!!!!!!!
CAML_R = th->ctx;
- //th->posix_thread = (void*)pthread_self();
-//DUMP("Now threads are %i, including this one", caml_get_thread_no_r(ctx));
value clos;
#ifdef NATIVE_CODE
struct longjmp_buffer termination_buf;
@@ -759,13 +651,7 @@ static ST_THREAD_FUNCTION caml_thread_start(void * arg)
/* Callback the closure */
clos = Start_closure(th->descr);
caml_modify_r(ctx, &(Start_closure(th->descr)), Val_unit);
- caml_callback_exn_r(ctx, clos, Val_unit); // !!!!!!!!!!!! FIXME: re-enable ?????????????
- //DUMP("before allocating");
- //int j; for(j = 0; j < 10000000; j ++) caml_alloc_tuple_r(ctx, 2); // ????????????????
- //DUMP("after allocating");
- DUMP("before gc");
- caml_gc_compaction_r(ctx, Val_unit); //!!!!!
- DUMP("still alive after gc");
+ caml_callback_exn_r(ctx, clos, Val_unit);
QR("exiting the native-code thread");
caml_thread_stop_r(ctx);
#ifdef NATIVE_CODE
@@ -777,93 +663,6 @@ static ST_THREAD_FUNCTION caml_thread_start(void * arg)
//CAMLreturnT(void*, 0);
}
-/* /\* I'm now 90% sure that adding local variable GC-protectiion here was */
-/* a mistake on my part: pthread_exit is called (indirectly...) before */
-/* CAMLreturnT. Fuckfuckfuck. Fabrice had the right intuition, but I */
-/* didn't remember this function immediately. *\/ */
-/* static ST_THREAD_FUNCTION caml_thread_start(void * arg) */
-/* { */
-/* QB(); */
-/* caml_thread_t th = (caml_thread_t) arg; */
-/* //??? does th point to something which is destroyed by the GC ??? !!!!!!!!!!!!!!!!!!!! */
-/* CAML_R = th->ctx; */
-/* th->posix_thread = (void*)pthread_self(); */
-/* DUMP("Now threads are %i, including this one", caml_get_thread_no_r(ctx)); */
-/* CAMLparam0(); */
-/* CAMLlocal1(clos); */
-/* #ifdef NATIVE_CODE */
-/* struct longjmp_buffer termination_buf; */
-/* char tos; */
-/* #endif */
-/* /\* associate the context to this thread *\/ */
-/* caml_set_thread_local_context(ctx); */
-
-/* /\* Associate the thread descriptor with the thread *\/ */
-/* st_tls_set(thread_descriptor_key, (void *) th); */
-/* /\* Acquire the global mutex *\/ */
-/* caml_leave_blocking_section_r(ctx); */
-/* #ifdef NATIVE_CODE */
-/* /\* Record top of stack (approximative) *\/ */
-/* th->top_of_stack = &tos; */
-/* /\* Setup termination handler (for caml_thread_exit) *\/ */
-/* if (sigsetjmp(termination_buf.buf, 0) == 0) { */
-/* th->exit_buf = &termination_buf; */
-/* #endif */
-/* /\* Callback the closure *\/ */
-/* clos = Start_closure(th->descr); */
-/* caml_modify_r(ctx, &(Start_closure(th->descr)), Val_unit); */
-/* caml_callback_exn_r(ctx, clos, Val_unit); // !!!!!!!!!!!! FIXME: re-enable ????????????? */
-/* //DUMP("before allocating"); */
-/* //int j; for(j = 0; j < 10000000; j ++) caml_alloc_tuple_r(ctx, 2); // ???????????????? */
-/* //DUMP("after allocating"); */
-/* DUMP("before gc"); */
-/* caml_gc_compaction_r(ctx, Val_unit); //!!!!! */
-/* DUMP("still alive after gc"); */
-/* caml_thread_stop_r(ctx); */
-/* #ifdef NATIVE_CODE */
-/* } */
-/* #endif */
-/* /\* The thread now stops running *\/ */
-/* QR(); */
-/* CAMLreturnT(void*, 0); */
-/* } */
-
-/* static ST_THREAD_FUNCTION caml_thread_start(void * arg) */
-/* { */
-/* caml_thread_t th = (caml_thread_t) arg; */
-/* CAML_R = th->ctx; */
-/* fprintf(stderr, "caml_c_thread_start: context %p, thread %p. Now threads are %i, including this one\n", ctx, (void*)pthread_self(), caml_thread_no_r(ctx)); fflush(stderr); */
-/* value clos; */
-/* #ifdef NATIVE_CODE */
-/* struct longjmp_buffer termination_buf; */
-/* char tos; */
-/* #endif */
-/* /\* associate the context to this thread *\/ */
-/* caml_set_thread_local_context(ctx); */
-
-/* /\* Associate the thread descriptor with the thread *\/ */
-/* st_tls_set(thread_descriptor_key, (void *) th); */
-/* /\* Acquire the global mutex *\/ */
-/* caml_leave_blocking_section_r(ctx); */
-/* #ifdef NATIVE_CODE */
-/* /\* Record top of stack (approximative) *\/ */
-/* th->top_of_stack = &tos; */
-/* /\* Setup termination handler (for caml_thread_exit) *\/ */
-/* if (sigsetjmp(termination_buf.buf, 0) == 0) { */
-/* th->exit_buf = &termination_buf; */
-/* #endif */
-/* /\* Callback the closure *\/ */
-/* clos = Start_closure(th->descr); */
-/* caml_modify_r(ctx, &(Start_closure(th->descr)), Val_unit); */
-/* caml_callback_exn_r(ctx, clos, Val_unit); */
-/* caml_thread_stop_r(ctx); */
-/* #ifdef NATIVE_CODE */
-/* } */
-/* #endif */
-/* /\* The thread now stops running *\/ */
-/* return 0; */
-/* } */
-
CAMLprim value caml_thread_new_r(CAML_R, value clos) /* ML */
{
QB();
@@ -871,11 +670,8 @@ CAMLprim value caml_thread_new_r(CAML_R, value clos) /* ML */
caml_thread_t th;
st_retcode err;
- DUMP("");
ctx->can_split = 0;
- DUMP("");
-//DUMP("Before the creation threads are %i, including this one", caml_get_thread_no_r(ctx));
/* Create a thread info block */
th = caml_thread_new_info();
if (th == NULL) caml_raise_out_of_memory_r(ctx);
@@ -906,44 +702,6 @@ CAMLprim value caml_thread_new_r(CAML_R, value clos) /* ML */
CAMLreturn(th->descr);
}
-/* CAMLprim value caml_thread_new_r(CAML_R, value clos) /\* ML *\/ */
-/* { */
-/* caml_thread_t th; */
-/* st_retcode err; */
-
-/* DUMP(""); */
-/* ctx->can_split = 0; */
-/* DUMP(""); */
-
-/* DUMP("Before the creation threads are %i, including this one", caml_get_thread_no_r(ctx)); */
-/* /\* Create a thread info block *\/ */
-/* th = caml_thread_new_info(); */
-/* if (th == NULL) caml_raise_out_of_memory_r(ctx); */
-/* /\* Equip it with a thread descriptor *\/ */
-/* th->descr = caml_thread_new_descriptor_r(ctx, clos); */
-/* /\* Add thread info block to the list of threads *\/ */
-/* th->next = curr_thread->next; */
-/* th->prev = curr_thread; */
-/* th->ctx = ctx; */
-/* curr_thread->next->prev = th; */
-/* curr_thread->next = th; */
-/* /\* Create the new thread *\/ */
-/* err = st_thread_create_r(ctx, NULL, caml_thread_start, (void *) th); */
-/* if (err != 0) { */
-/* /\* Creation failed, remove thread info block from list of threads *\/ */
-/* caml_thread_remove_info(th); */
-/* st_check_error_r(ctx, err, "Thread.create"); */
-/* } */
-/* /\* Create the tick thread if not already done. */
-/* Because of PR#4666, we start the tick thread late, only when we create */
-/* the first additional thread in the current process*\/ */
-/* if (! caml_tick_thread_running) { */
-/* err = st_thread_create_r(ctx, &caml_tick_thread_id, caml_thread_tick, ctx); */
-/* st_check_error_r(ctx, err, "Thread.create"); */
-/* caml_tick_thread_running = 1; */
-/* } */
-/* return th->descr; */
-/* } */
/* Register a thread already created from C */
@@ -955,7 +713,7 @@ CAMLexport int caml_c_thread_register_r(CAML_R)
/* Already registered? */
if (st_tls_get(thread_descriptor_key) != NULL) {QR(); return 0;}
-//DUMP("Now threads are %i, including this one", caml_get_thread_no_r(ctx));
+
/* Create a thread info block */
th = caml_thread_new_info();
if (th == NULL) {QR(); return 0;}
@@ -1042,7 +800,7 @@ CAMLprim value caml_thread_uncaught_exception_r(CAML_R, value exn) /* ML */
{
QB();
char * msg = caml_format_exception_r(ctx, exn);
-DUMP("Thread %d killed on uncaught exception %s", Int_val(Ident(curr_thread->descr)), msg);
+DUMP("Thread %d killed on uncaught exception %s", Int_val(Ident(curr_thread->descr)), msg); // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
free(msg);
if (caml_backtrace_active) caml_print_exception_backtrace_r(ctx);
fflush(stderr);
@@ -1087,39 +845,16 @@ CAMLprim value caml_thread_exit_r(CAML_R, value unit) /* ML */
CAMLprim value caml_thread_yield_r(CAML_R, value unit) /* ML */
{
QB();
- //DUMP("");
int st_masterlock_waiters_result = st_masterlock_waiters(&caml_master_lock);
if (st_masterlock_waiters_result == 0){
- //DUMP("st_masterlock_waiters_result is %i", st_masterlock_waiters_result);
QR();
return Val_unit;
}
- //DUMP("");
caml_enter_blocking_section_r(ctx);
- //DUMP("");
st_thread_yield();
- //DUMP("");
caml_leave_blocking_section_r(ctx);
- //DUMP("");
QR();
return Val_unit;
- /*
- fprintf(stderr, "caml_thread_yield_r: context %p, thread %p: BEGIN\n", ctx, (void*)pthread_self(), caml_thread_no_r(ctx)); fflush(stderr);
-
- int waiter_no = st_masterlock_waiters(&caml_master_lock);
- fprintf(stderr, "caml_thread_yield_r: context %p, thread %p: waiter_no is %i\n", ctx, (void*)pthread_self(), waiter_no); fflush(stderr);
- if (waiter_no == 0){
- fprintf(stderr, "caml_thread_yield_r: context %p, thread %p: returning because waiter_no is zero\n", ctx, (void*)pthread_self()); fflush(stderr);
- return Val_unit;
- }
- fprintf(stderr, "caml_thread_yield_r: context %p, thread %p: BEFORE CALLING caml_enter_blocking_section_r\n", ctx, (void*)pthread_self()); fflush(stderr);
- caml_enter_blocking_section_r(ctx);
- fprintf(stderr, "caml_thread_yield_r: context %p, thread %p: BEFORE CALLING st_thread_yield\n", ctx, (void*)pthread_self(), caml_thread_no_r(ctx)); fflush(stderr);
- st_thread_yield();
- fprintf(stderr, "caml_thread_yield_r: context %p, thread %p: AFTER RETURNING FROM st_thread_yield\n", ctx, (void*)pthread_self(), caml_thread_no_r(ctx)); fflush(stderr); caml_leave_blocking_section_r(ctx);
- fprintf(stderr, "caml_thread_yield_r: context %p, thread %p: END\n", ctx, (void*)pthread_self(), caml_thread_no_r(ctx)); fflush(stderr);
- return Val_unit;
- */
}
/* Suspend the current thread until another thread terminates */
Please sign in to comment.
Something went wrong with that request. Please try again.