Permalink
Browse files

Implemented context finalization with reference counting. It works wi…

…th no threads and with systhread, but not yet (if ever) with vmthreads
  • Loading branch information...
1 parent 11901cb commit 3aeef9703c8243798c7a44f1d202325447fa467f @lucasaiu committed Aug 6, 2013
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
@@ -20,10 +20,12 @@
#define CAML_CONTEXT_ROOTS
#define CAML_CONTEXT_FIX_CODE
+#include <stdio.h> // !!!!!!!!!!!!!!!!!!!!!!!!!
#include <string.h>
#include "callback.h"
#include "fail.h"
#include "memory.h"
+#include "alloc.h"
#include "mlvalues.h"
#ifndef NATIVE_CODE
@@ -236,3 +238,57 @@ CAMLexport value * caml_named_value_r(CAML_R, char const *name)
}
return NULL;
}
+
+/* Helper function for caml_named_value_table_as_caml_value_r */
+static value caml_named_value_table_bucket_as_caml_value_r(CAML_R, struct named_value *bucket){
+ CAMLparam0();
+ CAMLlocal1(result);
+ result = Val_emptylist;
+
+ if(bucket != NULL){
+ result = caml_alloc_r(ctx, 3, 0);
+ caml_modify_r(ctx, &Field(result, 0), caml_copy_string_r(ctx, bucket->name));
+ caml_modify_r(ctx, &Field(result, 1), bucket->val);
+ caml_modify_r(ctx, &Field(result, 2), caml_named_value_table_bucket_as_caml_value_r(ctx, bucket->next));
+ }
+ CAMLreturn(result);
+}
+
+CAMLexport value caml_named_value_table_as_caml_value_r(CAML_R){
+ CAMLparam0();
+ CAMLlocal3(result, bucket, bucket_item);
+ int i;
+ result = caml_alloc_r(ctx, Named_value_size, 0);
+ for(i = 0; i < Named_value_size; i ++){
+ bucket = caml_named_value_table_bucket_as_caml_value_r(ctx, named_value_table[i]);
+ caml_modify_r(ctx, &Field(result, i), bucket);
+ }
+ DUMP("result is %p", (void*)(long)result);
+ CAMLreturn(result);
+}
+
+/* Helper function for caml_install_named_value_table_as_caml_value_r */
+static struct named_value* caml_named_value_table_bucket_from_caml_value_r(CAML_R, value caml_bucket){
+ struct named_value *result = NULL;
+ CAMLparam0();
+ CAMLlocal1(caml_name);
+ result = NULL;
+ if(caml_bucket != Val_emptylist){
+ caml_name = Field(caml_bucket, 0);
+ result = caml_stat_alloc(sizeof(struct named_value) + caml_string_length(caml_name));
+ result->val = Field(caml_bucket, 1);
+ caml_register_global_root_r(ctx, &result->val);
+ strcpy(result->name, String_val(caml_name));
+ result->next = caml_named_value_table_bucket_from_caml_value_r(ctx, Field(caml_bucket, 2));
+ }
+ CAMLreturnT(struct named_value*, result);
+}
+
+CAMLexport void caml_install_named_value_table_as_caml_value_r(CAML_R, value encoded_named_value_table){
+ CAMLparam1(encoded_named_value_table);
+ int i;
+ for(i = 0; i < Named_value_size; i ++)
+ named_value_table[i] =
+ caml_named_value_table_bucket_from_caml_value_r(ctx, Field(encoded_named_value_table, i));
+ CAMLreturn0;
+}
View
@@ -61,6 +61,16 @@ CAMLextern value * caml_named_value_r (CAML_R, char const * name);
CAMLextern caml_global_context * caml_main_rr (char ** argv);
CAMLextern void caml_startup (char ** argv);
+/* Return a Caml encoding of the current named_value_table. This is
+ needed to copy the table at split time, sharing correctly. */
+CAMLextern value caml_named_value_table_as_caml_value_r(CAML_R);
+
+/* Given a Caml encoding of named_value_table, install it in the given
+ context, setting up roots as needed. The contained Caml values
+ have to refer the given context heap, so this is intended to be
+ 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);
+
/* CAMLextern int caml_callback_depth; */
#ifdef __cplusplus
View
@@ -103,7 +103,7 @@ void caml_p_semaphore(sem_t* semaphore){
int sem_wait_result;
while((sem_wait_result = sem_wait(semaphore)) != 0){
assert(errno == EINTR);
- INIT_CAML_R; DUMP("\a!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! sem_wait was interrupted by a signal");
+ INIT_CAML_R; DUMP("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! sem_wait was interrupted by a signal");
errno = 0;
}
assert(sem_wait_result == 0);
@@ -113,14 +113,29 @@ void caml_v_semaphore(sem_t* semaphore){
assert(sem_post_result == 0);
}
+void* caml_destructor_thread_function(void *ctx_as_void_star){
+ CAML_R = ctx_as_void_star;
+
+ /* Block until notified by a V: */
+ DUMP("waiting to be notified before destroying the context");
+ caml_p_semaphore(&ctx->destruction_semaphore);
+
+ /* We were notified; run at_exit callbacks and destroy the context: */
+ caml_run_at_context_exit_functions_r(ctx);
+ DUMP("about to destroy the context");
+ caml_destroy_context_r(ctx);
+ fprintf(stderr, "Destroyed the context %p: exiting the destructor thread %p as well.\n", ctx, (void*)pthread_self()); fflush(stderr);
+ return NULL; // unused
+}
+
caml_global_context *caml_initialize_first_global_context(void)
{
/* 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) );
+ 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
@@ -405,7 +420,9 @@ section. */
/* from callback.c */
ctx->caml_callback_depth = 0;
ctx->callback_code_threaded = 0;
- ctx->named_value_table[0] = NULL;
+ int i;
+ for(i = 0; i < Named_value_size; i ++)
+ ctx->named_value_table[i] = NULL;
/* from debugger.c */
ctx->caml_debugger_in_use = 0;
@@ -493,9 +510,19 @@ section. */
/* We can split in the present state: */
ctx->can_split = 1;
+ /* 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);
+ assert(pthread_create_result == 0);
+ //caml_initialize_mutex(&ctx->reference_count_mutex);
+
/* The kludgish self-pointer: */
ctx->ctx = ctx;
+ /* The main thread is already a user for this context: */
+ caml_pin_context_r(ctx);
+
return ctx;
}
@@ -658,8 +685,8 @@ library_context *caml_get_library_context_r(CAML_R,
return uctx;
}
-extern void caml_destroy_context(CAML_R){
- //fprintf(stderr, "caml_destroy_context [context %p] [thread %p]: OK-1\n", ctx, (void*)(pthread_self())); fflush(stderr);
+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_remove_global_root_r(ctx, &ctx->caml_signal_handlers);
@@ -673,7 +700,7 @@ extern void caml_destroy_context(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 [context %p] [thread %p]: OK-2\n", ctx, (void*)(pthread_self())); fflush(stderr);
+ //fprintf(stderr, "caml_destroy_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 */
@@ -682,14 +709,14 @@ extern void caml_destroy_context(CAML_R){
ctx->descriptor->kind = caml_global_context_dead;
ctx->descriptor->content.local_context.context = NULL;
- //fprintf(stderr, "caml_destroy_context [context %p] [thread %p]: OK-3\n", ctx, (void*)(pthread_self())); fflush(stderr);
+ //fprintf(stderr, "caml_destroy_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 [context %p] [thread %p]: FIXME: actually free everything\n", ctx, (void*)(pthread_self())); fflush(stderr);
+ //fprintf(stderr, "caml_destroy_context_r [context %p] [thread %p]: FIXME: actually free everything\n", ctx, (void*)(pthread_self())); fflush(stderr);
- //fprintf(stderr, "caml_destroy_context [context %p] [thread %p]: OK-4\n", ctx, (void*)(pthread_self())); fflush(stderr);
+ //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 [context %p] [thread %p]: OK-5: destroyed %p\n", ctx, (void*)(pthread_self()), ctx); fflush(stderr);
+ 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
}
@@ -982,6 +1009,31 @@ int caml_can_split_r(CAML_R){
return ctx->can_split;
}
+void caml_pin_context_r(CAML_R){
+ Assert(ctx->reference_count > 0);
+ ctx->reference_count ++;
+ DUMP(" PIN %i -> %i", ctx->reference_count - 1, ctx->reference_count);
+}
+
+void caml_unpin_context_r(CAML_R){
+ Assert(ctx->reference_count > 0);
+ ctx->reference_count --;
+ DUMP("UNpin %i -> %i", ctx->reference_count + 1, ctx->reference_count);
+ if(ctx->reference_count == 0){
+ DUMP("removed the last pin");
+ caml_v_semaphore(&ctx->destruction_semaphore);
+ /* if(caml_remove_last_pin_from_context_hook != NULL) */
+ /* caml_remove_last_pin_from_context_hook(ctx); */
+ }
+}
+
+/* static void caml_default_remove_last_pin_from_context_hook_r(CAML_R){ */
+/* caml_destroy_context_r(ctx); */
+/* } */
+/* void (*caml_remove_last_pin_from_context_hook)(CAML_R) = caml_default_remove_last_pin_from_context_hook_r; */
+
+
+
/* CAMLprim int caml_multi_context_implemented(value unit){ */
/* #if HAS_MULTI_CONTEXT */
/* return Bool_val(1); */
View
@@ -643,6 +643,13 @@ struct caml_global_context {
/* Can we still split? If threads have already been created, it's too late. */
int can_split;
+ /* Context-destructor structures: */
+ 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;
+ sem_t destruction_semaphore;
+ pthread_t destructor_thread;
+
/* 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
@@ -693,7 +700,12 @@ struct caml_mailbox* caml_mailbox_of_value(value v);
extern caml_global_context *caml_initialize_first_global_context(void);
extern caml_global_context *caml_make_empty_context(void); /* defined in startup.c */
-extern void caml_destroy_context(caml_global_context *c);
+extern void caml_destroy_context_r(caml_global_context *c);
+
+/* FIXME: document */
+extern void caml_pin_context_r(CAML_R);
+extern void caml_unpin_context_r(CAML_R);
+/* extern void (*caml_remove_last_pin_from_context_hook)(CAML_R); */
/* Access a thread-local context pointer */
extern caml_global_context *caml_get_thread_local_context(void);
@@ -1092,8 +1104,8 @@ void caml_v_semaphore(sem_t* semaphore); // signal-safe, differently from POSIX
#define LIGHTPURPLE NOATTR "\033[1m\033[35m"
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-#define flockfile(Q) /* nothing */
-#define funlockfile(Q) /* nothing */
+//#define flockfile(Q) /* nothing */
+//#define funlockfile(Q) /* nothing */
int caml_systhreads_get_thread_no_r(CAML_R); // FIXME: remove this declaration
@@ -1232,7 +1244,7 @@ extern __thread int caml_indentation_level;
DUMP(FORMAT, ##__VA_ARGS__); \
} while(0)
-#define USLEEP(LABEL, FLOAT_SECONDS) \
+#define SLEEP(LABEL, FLOAT_SECONDS) \
do { \
double __float_seconds = FLOAT_SECONDS; \
long __float_seconds_integer_part = (long)__float_seconds ; \
Oops, something went wrong.

0 comments on commit 3aeef97

Please sign in to comment.