Permalink
Browse files

Stuff

  • Loading branch information...
1 parent 2836bc2 commit e9dcb680052222a9cee8b1b0ea4138e03d0be7ae @lucasaiu committed May 17, 2013
View
@@ -132,7 +132,7 @@ void caml_register_dyn_global_r(CAML_R, void *v) {
heap. */
void caml_oldify_local_roots_r (CAML_R)
{
-caml_acquire_global_lock();
+//caml_acquire_global_lock();
char * sp;
uintnat retaddr;
value * regs;
@@ -174,8 +174,8 @@ caml_acquire_global_lock();
sp = caml_bottom_of_stack;
retaddr = caml_last_return_address;
regs = caml_gc_regs;
- assert(caml_gc_regs != (typeof(caml_gc_regs))0xaaaaaaaaaaaaaaaa); // FIXME: remove!!!!!!!!!!!!!!! Luca Saiu REENTRANTRUNTIME !!!!!!!!!!!!!!
- assert(caml_gc_regs != (typeof(caml_gc_regs))0xbbbbbbbbbbbbbbbb); // FIXME: remove!!!!!!!!!!!!!!! Luca Saiu REENTRANTRUNTIME !!!!!!!!!!!!!!
+ //Assert(caml_gc_regs != (typeof(caml_gc_regs))0xaaaaaaaaaaaaaaaa); // FIXME: remove!!!!!!!!!!!!!!! Luca Saiu REENTRANTRUNTIME !!!!!!!!!!!!!!
+ //Assert(caml_gc_regs != (typeof(caml_gc_regs))0xbbbbbbbbbbbbbbbb); // FIXME: remove!!!!!!!!!!!!!!! Luca Saiu REENTRANTRUNTIME !!!!!!!!!!!!!!
if (sp != NULL) {
while (1) {
/* Find the descriptor corresponding to the return address */
@@ -236,7 +236,7 @@ caml_acquire_global_lock();
caml_final_do_young_roots_r (ctx, &caml_oldify_one_r);
/* Hook */
if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(&caml_oldify_one_r);
-caml_release_global_lock();
+//caml_release_global_lock();
}
/* Call [darken] on all roots */
@@ -248,7 +248,7 @@ void caml_darken_all_roots_r (CAML_R)
void caml_do_roots_r (CAML_R, scanning_action f)
{
-caml_acquire_global_lock(); // FIXME: is this really needed? I strongly suspect not !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+//caml_acquire_global_lock(); // FIXME: is this really needed? I strongly suspect not !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
int /*i,*/ j;
value glob;
caml_link *lnk;
@@ -270,8 +270,8 @@ caml_acquire_global_lock(); // FIXME: is this really needed? I strongly suspect
/* The stack and local roots */
if (caml_frame_descriptors == NULL) caml_init_frame_descriptors_r(ctx);
- assert(caml_gc_regs != (typeof(caml_gc_regs))0xaaaaaaaaaaaaaaaa); // FIXME: remove!!!!!!!!!!!!!!! Luca Saiu REENTRANTRUNTIME !!!!!!!!!!!!!!
- assert(caml_gc_regs != (typeof(caml_gc_regs))0xbbbbbbbbbbbbbbbb); // FIXME: remove!!!!!!!!!!!!!!! Luca Saiu REENTRANTRUNTIME !!!!!!!!!!!!!!
+ //Assert(caml_gc_regs != (typeof(caml_gc_regs))0xaaaaaaaaaaaaaaaa); // FIXME: remove!!!!!!!!!!!!!!! Luca Saiu REENTRANTRUNTIME !!!!!!!!!!!!!!
+ //Assert(caml_gc_regs != (typeof(caml_gc_regs))0xbbbbbbbbbbbbbbbb); // FIXME: remove!!!!!!!!!!!!!!! Luca Saiu REENTRANTRUNTIME !!!!!!!!!!!!!!
caml_do_local_roots_r(ctx, f, caml_bottom_of_stack, caml_last_return_address,
caml_gc_regs, caml_local_roots);
/* Global C roots */
@@ -280,14 +280,14 @@ caml_acquire_global_lock(); // FIXME: is this really needed? I strongly suspect
caml_final_do_strong_roots_r (ctx, f);
/* Hook */
if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f);
-caml_release_global_lock();
+//caml_release_global_lock();
}
void caml_do_local_roots_r(CAML_R, scanning_action f, char * bottom_of_stack,
uintnat last_retaddr, value * gc_regs,
struct caml__roots_block * local_roots)
{
-caml_acquire_global_lock();
+//caml_acquire_global_lock();
char * sp;
uintnat retaddr;
value * regs;
@@ -356,17 +356,17 @@ caml_acquire_global_lock();
}
}
}
-caml_release_global_lock();
+//caml_release_global_lock();
}
uintnat caml_stack_usage_r (CAML_R)
{
uintnat sz;
-caml_acquire_global_lock();
+//caml_acquire_global_lock();
sz = (value *) caml_top_of_stack - (value *) caml_bottom_of_stack;
if (caml_stack_usage_hook != NULL)
sz += (*caml_stack_usage_hook)();
-caml_release_global_lock();
+//caml_release_global_lock();
return sz;
}
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.
@@ -391,7 +391,7 @@ 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);
- DUMP("-- tick --");
+ //DUMP("-- tick --");
/* DUMP("before caml_record_signal_r"); */
caml_record_signal_r(ctx, SIGPREEMPTION);
/* DUMP("after caml_record_signal_r"); */
@@ -136,7 +136,7 @@ static void caml_thread_scan_roots(scanning_action action)
caml_thread_t th;
int how_many = 0; // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
th = curr_thread;
- DUMP("curr_thread is %p", curr_thread); // !!!!!!!!!!!!!!!!!
+ //DUMP("curr_thread is %p", curr_thread); // !!!!!!!!!!!!!!!!!
do {
(*action)(ctx, th->descr, &th->descr);
(*action)(ctx, th->backtrace_last_exn, &th->backtrace_last_exn);
@@ -147,16 +147,16 @@ static void caml_thread_scan_roots(scanning_action action)
if (th->bottom_of_stack != NULL)
caml_do_local_roots_r(ctx, action, th->bottom_of_stack, th->last_retaddr,
th->gc_regs, th->local_roots);
- DUMP("%p->gc_regs is %p", th, th->gc_regs); // !!!!!!!!!!!!!!!!
+ //DUMP("%p->gc_regs is %p", th, th->gc_regs); // !!!!!!!!!!!!!!!!
#else
caml_do_local_roots_r(ctx, action, th->sp, th->stack_high, th->local_roots);
#endif
how_many ++; // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
}
th = th->next;
} while (th != curr_thread);
- DUMP("scanned local roots for %i threads (of %i)", how_many, caml_systhreads_get_thread_no_r(ctx)); // !!!!!!!!!!!!
- DUMP("Is there a prev_scan_roots_hook? %s", prev_scan_roots_hook ? "yes": "no"); // !!!!!!!!!!!!
+ //DUMP("scanned local roots for %i threads (of %i)", how_many, caml_systhreads_get_thread_no_r(ctx)); // !!!!!!!!!!!!
+ //DUMP("Is there a prev_scan_roots_hook? %s", prev_scan_roots_hook ? "yes": "no"); // !!!!!!!!!!!!
/* Hook */
if (prev_scan_roots_hook != NULL) (*prev_scan_roots_hook)(action);
QR();
@@ -177,7 +177,7 @@ static void caml_thread_enter_blocking_section_hook(void)
//fprintf(stderr, "caml_thread_enter_blocking_section_hook: ctx %p, thread %p: curr_thread->gc_regs, about to be overwritten, was %p\n", ctx, (void*)pthread_self(), curr_thread->gc_regs); fflush(stderr);
//fprintf(stderr, "caml_thread_enter_blocking_section_hook: ctx %p, thread %p: caml_gc_regs is %p\n", ctx, (void*)pthread_self(), caml_gc_regs); fflush(stderr);
-DUMP("changing curr_thread->gc_regs from %p to %p", curr_thread->gc_regs, caml_gc_regs);
+ //DUMP("changing curr_thread->gc_regs from %p to %p", curr_thread->gc_regs, caml_gc_regs);
curr_thread->gc_regs = caml_gc_regs;
curr_thread->exception_pointer = caml_exception_pointer;
curr_thread->local_roots = caml_local_roots;
@@ -215,7 +215,7 @@ static void caml_thread_leave_blocking_section_hook_default(void)
//fprintf(stderr, "caml_thread_leave_blocking_section_hook_default: ctx %p, thread %p: caml_gc_regs, about to be overwritten, was %p\n", ctx, (void*)pthread_self(), caml_gc_regs); fflush(stderr);
//fprintf(stderr, "caml_thread_leave_blocking_section_hook_default: ctx %p, thread %p: curr_thread->gc_regs is %p\n", ctx, (void*)pthread_self(), curr_thread->gc_regs); fflush(stderr);
-DUMP("changing ctx->caml_gc_regs from %p to %p", caml_gc_regs, curr_thread->gc_regs);
+ //DUMP("changing ctx->caml_gc_regs from %p to %p", caml_gc_regs, curr_thread->gc_regs);
caml_gc_regs = curr_thread->gc_regs;
caml_exception_pointer = curr_thread->exception_pointer;
caml_local_roots = curr_thread->local_roots;
View
@@ -33,20 +33,21 @@ external self : unit -> t = "caml_context_self_r" "reentrant"
external is_main : t -> bool = "caml_context_is_main_r" "reentrant"
(* external is_alive : t -> bool = "caml_context_is_alive_r" "reentrant" *)
-external actually_split_into_array : int -> (int -> unit) -> (t array) = "caml_context_split_r" "reentrant"
+external actually_split_into_context_array : int -> (int -> unit) -> (t array) = "caml_context_split_r" "reentrant"
-let split_into_array =
+let split_into_context_array =
if implemented_bool then
- actually_split_into_array
+ actually_split_into_context_array
else
raise Unimplemented
-let split_into_contexts how_many f =
- Array.to_list (split_into_array how_many f)
+let split_into_context_list how_many f =
+ Array.to_list (split_into_context_array how_many f)
let split_into_context thunk =
- List.hd (split_into_contexts 1 (fun i -> thunk ()))
+ List.hd (split_into_context_list 1 (fun _ -> thunk ()))
+(* Debugging stuff *)
let to_string context =
string_of_int ((Obj.magic context) :> int)
@@ -126,7 +127,7 @@ let split context_no f =
let split_mailbox_receiving_mailbox =
make_mailbox () in
let _ =
- split_into_contexts
+ split_into_context_list
context_no
(fun index ->
let mailbox = make_mailbox () in
@@ -141,6 +142,9 @@ let split context_no f =
(fun _ -> receive split_mailbox_receiving_mailbox)
(iota context_no)))
+let split_into_array context_no f =
+ Array.of_list (split context_no f)
+
let split1 f =
List.hd (split 1 (fun _ mailbox -> f mailbox))
View
@@ -29,12 +29,13 @@ val is_mailbox_local : mailbox -> bool
(* These may raise CannotSplit *)
val split1 : (mailbox -> unit) -> (*new context mailbox*)mailbox
val split : int -> (int -> mailbox -> unit) -> (*mailboxes to new contexts*)(mailbox list)
+val split_into_array : int -> (int -> mailbox -> unit) -> (*mailboxes to new contexts*)(mailbox array)
val send : mailbox -> 'a -> unit
val receive : mailbox -> 'a (* raises ForeignMailbox if the mailbox is foreign *)
(* Wait until the context local to the given mailbox or mailboxes terminates: *)
-(* FIXME: fix the multi-thread case *)
+(* FIXME: fix the multi-thread case [FIXME: is it already fixed?]*)
val join_context : t -> unit
val join_contexts : t list -> unit
val join1 : mailbox -> unit

0 comments on commit e9dcb68

Please sign in to comment.