Permalink
Browse files

Two important changes: 1) changed the destruction of the ticker threa…

…ds at systhread context finalization to be synchronous: this is important for ensuring that the masterlock is not used after context destruction; 2) correctly destroyed the dynamically-allocated part of named_value_table, for each context.
  • Loading branch information...
1 parent 24ef428 commit 486b53b2417bdcb199d6714dd6b4a59faaeca937 @lucasaiu committed Aug 6, 2013
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
@@ -21,6 +21,7 @@
#define CAML_CONTEXT_FIX_CODE
#include <stdio.h> // !!!!!!!!!!!!!!!!!!!!!!!!!
+#include <assert.h> // !!!!!!!!!!!!!!!!!!!!!!!!!
#include <string.h>
#include "callback.h"
#include "fail.h"
@@ -292,3 +293,22 @@ CAMLexport void caml_install_named_value_table_as_caml_value_r(CAML_R, value enc
caml_named_value_table_bucket_from_caml_value_r(ctx, Field(encoded_named_value_table, i));
CAMLreturn0;
}
+
+/* Helper for caml_destroy_named_value_table_r */
+static void caml_destroy_named_value_table_bucket_r(CAML_R, struct named_value *bucket){
+ //DUMP("Destroying the bucket at %p", bucket);
+ while(bucket != NULL){
+ void *next = bucket->next;
+ //DUMP("Destroying the bbucket at %p", bucket);
+ free(bucket);
+ bucket = next;
+ //DUMP("The bucket rest is now %p", bucket);
+ }
+}
+CAMLexport void caml_destroy_named_value_table_r(CAML_R){
+ int i;
+ 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]);
+ }
+}
View
@@ -71,6 +71,9 @@ CAMLextern value caml_named_value_table_as_caml_value_r(CAML_R);
used on an encoding obtained from deserializing a blob. */
CAMLextern void caml_install_named_value_table_as_caml_value_r(CAML_R, value encoded_named_value_table);
+/* Destroy dynamically-allocated structures */
+CAMLextern void caml_destroy_named_value_table_r(CAML_R);
+
/* CAMLextern int caml_callback_depth; */
#ifdef __cplusplus
View
@@ -688,6 +688,7 @@ library_context *caml_get_library_context_r(CAML_R,
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);
+ caml_destroy_named_value_table_r(ctx);
caml_remove_global_root_r(ctx, &ctx->caml_signal_handlers);
//caml_gc_compaction_r(ctx, Val_unit); //!!!!!@@@@@@@@@@@@@@??????????????????
View
@@ -603,8 +603,12 @@ struct caml_global_context {
/* The master lock protecting the OCaml runtime system */
st_masterlock caml_master_lock;
- /* Whether the ``tick'' thread is already running */
- int caml_tick_thread_running /* = 0 */;
+ /* /\* Whether the ``tick'' thread is already running *\/ */
+ /* int caml_tick_thread_running /\* = 0 *\/; */
+ /* Whether the ``tick'' thread is already running. "-1" means that
+ the tick thread is being requested to exit, after resetting the
+ field to 0 */
+ volatile int caml_tick_thread_running /* = 0 */;
/* The thread identifier of the ``tick'' thread */
st_thread_id caml_tick_thread_id;
@@ -1107,7 +1111,7 @@ void caml_v_semaphore(sem_t* semaphore); // signal-safe, differently from POSIX
//#define flockfile(Q) /* nothing */
//#define funlockfile(Q) /* nothing */
-int caml_systhreads_get_thread_no_r(CAML_R); // FIXME: remove this declaration
+//int caml_systhreads_get_thread_no_r(CAML_R); // FIXME: remove this declaration
#ifdef NATIVE_CODE
@@ -1154,10 +1158,9 @@ int caml_systhreads_get_thread_no_r(CAML_R); // FIXME: remove this declaration
do{ \
flockfile(stderr); \
fprintf(stderr, \
- "%s:%i(" RED "%s" NOATTR ") C%p T" CYAN "%p" PURPLE" %2i"/* " 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(), \
- (int)caml_systhreads_get_thread_no_r(ctx)); \
+ (void*)pthread_self()); \
/* fflush(stderr); */ \
fprintf(stderr, " " GREEN FORMAT, ##__VA_ARGS__); \
fprintf(stderr, NOATTR "\n"); \
@@ -378,7 +378,8 @@ DUMP("this is the tick thread");
pthread_sigmask(SIG_BLOCK, &mask, NULL);
/* Allow async cancellation */
pthread_setcanceltype(PTHREAD_CANCEL_ASYNCHRONOUS, NULL);
- while(1) {
+ while(caml_tick_thread_running != -1) {
+ //while(1) {
/* select() seems to be the most efficient way to suspend the
thread for sub-second intervals */
timeout.tv_sec = /*1*/0;//timeout.tv_sec = 0; // FIXME: this of course should be reset to 0 after debugging
@@ -392,14 +393,19 @@ DUMP("this is the tick thread");
go through caml_handle_signal(), just record signal delivery via
caml_record_signal(). */
//fprintf(stderr, "Context %p: st_thread_tick: thread %p ticking.\n", ctx, (void*)pthread_self()); fflush(stderr);
- DDUMP("-- tick -- Busy:%s, waiters: %i", (ctx->caml_master_lock.busy?"YES":" no"), ctx->caml_master_lock.waiters);
+ //DDUMP("-- tick -- Busy:%s, waiters: %i", (ctx->caml_master_lock.busy?"YES":" no"), ctx->caml_master_lock.waiters);
/* DUMP("before caml_record_signal_r"); */
caml_record_signal_r(ctx, SIGPREEMPTION);
/* DUMP("after caml_record_signal_r"); */
//fprintf(stderr, "Context %p: st_thread_tick: thread %p ticked.\n", ctx, (void*)pthread_self()); fflush(stderr);
}
+ DUMP("~~~~~~~~~~~~~~~~~~~~~~~~~~~~ the tick thread is exiting");
+ /* This authorizes the destructor thread to destroy the context;
+ from now on we can't use any longer: */
+ caml_tick_thread_running = 0;
QR();
- return NULL; /* prevents compiler warning */
+ //return NULL; /* prevents compiler warning */
+ return NULL;
}
/* "At fork" processing */
@@ -646,10 +646,35 @@ CAMLprim value caml_thread_initialize_r(CAML_R, value unit) /* ML */
CAMLprim value caml_thread_cleanup_r(CAML_R, value unit) /* ML */
{
+ //if (caml_tick_thread_running) st_thread_kill(caml_tick_thread_id); // ORIGINAL VERSION --L.S
+ //return Val_unit; // ORIGINAL VERSION --L.S
QB();
- if (caml_tick_thread_running) st_thread_kill(caml_tick_thread_id);
+
+ /* Ask the tick thread to exit, and wait until we're sure it stopped
+ using the context: */
+ switch (caml_tick_thread_running){
+ case 0:
+ /* Do nothing: the tick thread was never started. */
+ break;
+ case -1:
+ /* This shouldn't happen: the tick thread has been killed more than once */
+ assert(0);
+ default:{
+ /* Ask the tick thread to exit... */
+ struct timeval timeout;
+ timeout.tv_sec = 0;
+ timeout.tv_usec = Thread_timeout * 1000;
+ caml_tick_thread_running = -1;
+ /* ...and wait until it does: */
+ do {
+ 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");
+ }
+ } // switch
QR();
- return Val_unit;
+ return Val_unit; // FROM THE ORIGINAL VERSION --L.S
}
/* Thread cleanup at termination */
View
@@ -162,7 +162,7 @@ let run_at_context_exit_functions () =
dump "Executing \"contextual\" at_exit functions";
List.iter
(fun f -> f ())
- (List.rev !at_context_exit_functions);
+ ((* List.rev *) !at_context_exit_functions);
dump "Executed \"contextual\" at_exit functions"
let () =
Callback.register "Context.run_at_context_exit_functions" run_at_context_exit_functions

0 comments on commit 486b53b

Please sign in to comment.