Permalink
Browse files

Merge pull request #1 from lucasaiu/master

Merged from my master branch,  Whatever.
  • Loading branch information...
2 parents 927013f + 716c206 commit 20d9759ba6b6659197d49694de6ae26b9210e191 @lucasaiu committed Dec 12, 2012
View
@@ -24,6 +24,7 @@
#include <stdio.h>
#include <stdlib.h>
+#include <setjmp.h> // FIXME: remove if not needed in the end --Luca Saiu REENTRANTRUNTIME
#include "callback.h"
#include "backtrace.h"
#include "custom.h"
@@ -201,35 +202,6 @@ caml_global_context* caml_main_rr(char **argv)
and I will know. --Luca Saiu REENTRANTRUNTIME */
ctx->caml_global_data = Val_long(42);
-/* /\* Make the global variable array, and make it go to the old */
-/* generation: --Luca Saiu REENTRANTRUNTIME *\/ */
-/* //printf("The tagged size is %li\n", (long)Val_long(CAML_INITIAL_GLOBAL_NO)); */
-/* /\* printf("Initializing ctx->caml_global_data: it will have %i elements\n", CAML_INITIAL_GLOBAL_NO); *\/ */
-/* ctx->caml_global_data = caml_alloc_shr_r(ctx, */
-/* CAML_INITIAL_GLOBAL_NO, */
-/* 0); // just like in meta.c */
-/* int i; */
-/* for (i = 0; i < CAML_INITIAL_GLOBAL_NO; i ++) */
-/* caml_initialize_r(ctx, &Field(ctx->caml_global_data, i), Val_long(i)); */
-
-/* /\* // FIXME: remove this ugly kludge: begin --Luca Saiu REENTRANTRUNTIME *\/ */
-/* /\* // Just in order to test from the assembly side with known global variables *\/ */
-/* /\* // (not yet generated by the compiler), let's hardwire some values: *\/ */
-/* /\* //#define GLOBAL(INDEX, X) caml_array_set_r(ctx, ctx->caml_global_data, Val_long(INDEX), X); *\/ */
-/* /\* #define GLOBAL(INDEX, X) caml_initialize_r(ctx, &Field(ctx->caml_global_data, INDEX), X); *\/ */
-/* /\* //caml_initialize_r(ctx, &Field(new_global_data, i), Field(caml_global_data, i)); *\/ */
-
-/* /\* GLOBAL(0, Val_long(10)) *\/ */
-/* /\* GLOBAL(1, caml_make_vect_r(ctx, Val_long(3), Val_long(10000))) *\/ */
-/* /\* GLOBAL(2, Val_long(20)) *\/ */
-/* /\* GLOBAL(3, Val_long(0)) *\/ */
-/* /\* GLOBAL(4, Val_long(1)) *\/ */
-/* /\* GLOBAL(5, Val_long(0)) *\/ */
-/* /\* GLOBAL(6, caml_copy_double_r(ctx, 3.14)) *\/ */
-/* /\* GLOBAL(7, Val_long('a')) *\/ */
-/* /\* GLOBAL(8, Val_long(30)) *\/ */
-
-/* // FIXME: remove this ugly kludge: end --Luca Saiu REENTRANTRUNTIME */
/* caml_oldify_one_r (ctx, ctx->caml_global_data, &ctx->caml_global_data); */
/* caml_oldify_mopup_r (ctx); // FIXME: what's this for, exactly? --Luca Saiu REENTRANTRUNTIME */
@@ -251,11 +223,41 @@ caml_global_context* caml_main_rr(char **argv)
if (caml_termination_hook != NULL) caml_termination_hook(NULL);
return ctx;
}
- res = caml_start_program_r(ctx);
- if (Is_exception_result(res))
- caml_fatal_uncaught_exception_r(ctx, Extract_exception(res));
- return ctx;
+ // Before my experimental changes: begin --Luca Saiu REENTRANTRUNTIME
+ /* res = caml_start_program_r(ctx); */
+ /* if (Is_exception_result(res)) */
+ /* caml_fatal_uncaught_exception_r(ctx, Extract_exception(res)); */
+
+ /* printf("HHH OK2\n"); */
+
+ /* return ctx; */
+ // Before my experimental changes: end --Luca Saiu REENTRANTRUNTIME
+
+ //// Very experimental: begin --Luca Saiu REENTRANTRUNTIME
+
+ printf("caml_main_rr: setjmp'ing [%p]\n", *((void**)(ctx->where_to_longjmp)));
+ if(setjmp(ctx->where_to_longjmp)){
+ printf("caml_main_rr: back from a longjmp [%p]\n", *((void**)(ctx->where_to_longjmp)));
+ printf("In the parent context caml_bottom_of_stack is %p\n", caml_bottom_of_stack); ////
+ //caml_init_gc_r (ctx->after_longjmp_context, minor_heap_init, heap_size_init, heap_chunk_init, percent_free_init, max_percent_free_init);
+ // Very experimental. Begin. What the fuck happens here?
+ // caml_top_of_stack = &tos;
+ //caml_init_gc_r (ctx, minor_heap_init, heap_size_init, heap_chunk_init, percent_free_init, max_percent_free_init);
+ // Very experimental. End. What the fuck happens here?
+ ctx->after_longjmp_function(ctx->after_longjmp_context,
+ ctx->after_longjmp_serialized_blob);
+ return NULL; /* this should be unreachable */
+ }
+ else{
+ printf("caml_main_rr: right after the setjmp call [%p]\n", *((void**)(ctx->where_to_longjmp)));
+ res = caml_start_program_r(ctx);
+ if (Is_exception_result(res))
+ caml_fatal_uncaught_exception_r(ctx, Extract_exception(res));
+ printf("caml_main_rr: exiting normally\n");
+ return ctx;
+ }
+ //// Very experimental: end --Luca Saiu REENTRANTRUNTIME
}
void caml_startup(char **argv)
View
Binary file not shown.
View
@@ -41,13 +41,13 @@
__thread caml_global_context *caml_context;
-caml_global_context *caml_get_global_context(void)
+caml_global_context *caml_get_thread_local_context(void)
{
/* fprintf(stderr, "get caml_context %x\n", caml_context); */
return caml_context;
}
-void caml_set_global_context(caml_global_context *new_caml_context)
+void caml_set_thread_local_context(caml_global_context *new_caml_context)
{
caml_context = new_caml_context;
}
@@ -432,7 +432,10 @@ void* caml_context_local_c_variable_r(CAML_R, caml_c_global_id id){
void caml_scan_caml_globals_r(CAML_R, scanning_action f){
int i, caml_global_no = ctx->caml_globals.used_size / sizeof(value);
- //if(caml_global_no != 0) printf("Context %p: scanning the %i Caml globals\n", ctx, caml_global_no);
+ /* if(caml_global_no != 0) */
+ /* printf("Context %p: scanning the %i Caml globals\n", ctx, caml_global_no); */
+ /* else */
+ /* printf("Context %p: there are no Caml globals to scan\n", ctx); */
value *caml_globals = (value*)(ctx->caml_globals.array);
for(i = 0; i < caml_global_no; i ++){
value *root_pointer = caml_globals + i;
@@ -573,7 +576,7 @@ void caml_register_module_r(CAML_R, size_t size_in_bytes, long *offset_pointer){
/* If this is the first time we register this module, make space for its globals in
ctx->caml_globals. If the module was already registered, do nothing. */
- caml_enter_lock_section_r(ctx);
+ caml_acquire_global_lock_r(ctx);
if(*offset_pointer == -1){
/* fprintf(stderr, "Registering the module %p for the first time: making place for %i globals\n", offset_pointer, (int)size_in_words); */
/* fprintf(stderr, "first_unused_word_offset is %i\n", (int)first_unused_word_offset); */
@@ -587,7 +590,7 @@ void caml_register_module_r(CAML_R, size_t size_in_bytes, long *offset_pointer){
}
/* else */
/* fprintf(stderr, "The module %p has already been registered: its offset is %i\n", offset_pointer, (int)*offset_pointer); */
- caml_leave_lock_section_r(ctx);
+ caml_release_global_lock_r(ctx);
/* fprintf(stderr, "The offset (in bytes) we just wrote at %p is %li\n", offset_pointer, *offset_pointer); */
/* fprintf(stderr, "The context is at %p\n", (void*)ctx); */
/* fprintf(stderr, "Globals are at %p\n", (void*)ctx->caml_globals.array); */
@@ -652,13 +655,22 @@ CAMLprim value caml_context_is_remote_r(CAML_R, value descriptor)
void caml_acquire_global_lock_r(CAML_R){
/* FIXME: is this needed? I wanna play it safe --Luca Saiu REENTRANTRUNTIME */
int result __attribute__((unused));
- caml_enter_lock_section_r(ctx);
+ //caml_enter_lock_section_r(ctx);
result = pthread_mutex_lock(&caml_global_mutex);
Assert(result == 0);
}
void caml_release_global_lock_r(CAML_R){
int result __attribute__((unused)) = pthread_mutex_unlock(&caml_global_mutex);
Assert(result == 0);
/* FIXME: is this needed? I wanna play it safe --Luca Saiu REENTRANTRUNTIME */
- caml_leave_lock_section_r(ctx);
+ //caml_leave_lock_section_r(ctx);
}
+
+/* CA__MLprim value caml_context_dump_r(CAML_R, value unit){ */
+/* #ifdef NATIVE_CODE */
+/* //printf("%p->caml_bottom_of_stack is %p\n", ctx, ctx->caml_bottom_of_stack); */
+/* return Val_long((long)(ctx->caml_bottom_of_stack)); */
+/* #else */
+/* return Val_long(0); */
+/* #endif /\* else (#ifdef NATIVE_CODE) *\/ */
+/* } */
View
@@ -26,6 +26,7 @@
/* If these includes are missing, the offsets of fields might differ ! */
#include <signal.h>
+#include <setjmp.h> // FIXME: remove if not needed in the end --Luca Saiu REENTRANTRUNTIME
#include "config.h"
#include "misc.h"
@@ -516,13 +517,21 @@ struct caml_global_context {
char ** caml_instr_table;
char * caml_instr_base;
#endif
-
+
/* Context-local "global" C variables: */
#define INITIAL_C_GLOBALS_ALLOCATED_SIZE 16
struct caml_extensible_buffer c_globals; /* = {INITIAL_C_GLOBALS_ALLOCATED_SIZE, 0, dynamic} */
/* Our (local) descriptor: */
struct caml_global_context_descriptor *descriptor;
+
+ /* Where to longjmp when executing a split context thunk: */
+ jmp_buf where_to_longjmp;
+ /* Procedure to execute after longjmp: */
+ void (*after_longjmp_function)(struct caml_global_context*, char*);
+ /* Procedure parameters: */
+ struct caml_global_context *after_longjmp_context;
+ char *after_longjmp_serialized_blob;
}; /* struct caml_global_context */
/* Context descriptors may be either local or remote: */
@@ -560,13 +569,13 @@ value caml_value_of_context_descriptor(struct caml_global_context_descriptor *c)
struct caml_global_context_descriptor* caml_global_context_descriptor_of_value(value v);
#define CAML_R caml_global_context *ctx
-#define INIT_CAML_R CAML_R = caml_get_global_context()
+#define INIT_CAML_R CAML_R = caml_get_thread_local_context()
extern caml_global_context *caml_initialize_first_global_context(void);
/* Access a thread-local context pointer */
-extern caml_global_context *caml_get_global_context(void);
-extern void caml_set_global_context(caml_global_context *new_global_context);
+extern caml_global_context *caml_get_thread_local_context(void);
+extern void caml_set_thread_local_context(caml_global_context *new_global_context);
extern void (*caml_enter_lock_section_hook)(void);
extern void (*caml_leave_lock_section_hook)(void);
@@ -874,8 +883,8 @@ extern library_context *caml_get_library_context_r(
/* new block. *\/ */
/* int caml_allocate_caml_globals_r(CAML_R, size_t added_caml_global_no); */
-/* /\* Scan all OCaml globals as roots: *\/ */
-/* void caml_scan_caml_globals_r(CAML_R, scanning_action f); */
+/* Scan all OCaml globals as roots: */
+void caml_scan_caml_globals_r(CAML_R, scanning_action f);
/* C context-local "globals" */
Oops, something went wrong.

0 comments on commit 20d9759

Please sign in to comment.