Skip to content

Commit

Permalink
Merge pull request #1 from lucasaiu/master
Browse files Browse the repository at this point in the history 
Merged from my master branch,  Whatever.
  • Loading branch information
@lucasaiu
lucasaiu committed Dec 12, 2012
2 parents 927013f + 716c206 commit 20d9759
Show file tree
Hide file tree
Showing 10 changed files with 182 additions and 103 deletions.
68 changes: 35 additions & 33 deletions asmrun/startup.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down Expand Up @@ -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 */

Expand All @@ -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)
Expand Down
Binary file modified boot/ocamlrun
View file
Binary file not shown.
26 changes: 19 additions & 7 deletions byterun/context.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;
}
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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); */
Expand All @@ -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); */
Expand Down Expand Up @@ -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) *\/ */
/* } */
21 changes: 15 additions & 6 deletions byterun/context.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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"

Expand Down Expand Up @@ -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: */
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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" */
Expand Down
Loading

0 comments on commit 20d9759

Please sign in to comment.