Permalink
Browse files

Fixed the crazy bug only showing up without address randomization (th…

…anks to Fabrice). Other changes, comparatively minor
  • Loading branch information...
lucasaiu committed May 7, 2013
1 parent 4c6d7e8 commit 2836bc2e3660b244062e4cc9caa49feccbe2f3f8
View
@@ -149,16 +149,17 @@ caml_acquire_global_lock();
struct caml__roots_block *lr;
caml_link *lnk;
+ // Disabled: roots are now in a contextual extensible buffer
/* The global roots */
- for (i = caml_globals_scanned;
- i <= caml_globals_inited && caml_globals[i] != 0;
- i++) {
- glob = caml_globals[i];
- for (j = 0; j < Wosize_val(glob); j++){
- Oldify (&Field (glob, j));
- }
- }
- caml_globals_scanned = caml_globals_inited;
+ /* for (i = caml_globals_scanned; */
+ /* i <= caml_globals_inited && caml_globals[i] != 0; */
+ /* i++) { */
+ /* glob = caml_globals[i]; */
+ /* for (j = 0; j < Wosize_val(glob); j++){ */
+ /* Oldify (&Field (glob, j)); */
+ /* } */
+ /* } */
+ /* caml_globals_scanned = caml_globals_inited; */
/* Dynamic global roots */
iter_list(caml_dyn_globals, lnk) {
@@ -247,17 +248,17 @@ void caml_darken_all_roots_r (CAML_R)
void caml_do_roots_r (CAML_R, scanning_action f)
{
-caml_acquire_global_lock();
- int i, j;
+caml_acquire_global_lock(); // FIXME: is this really needed? I strongly suspect not !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ int /*i,*/ j;
value glob;
caml_link *lnk;
- /* The global roots */
- for (i = 0; caml_globals[i] != 0; i++) {
- glob = caml_globals[i];
- for (j = 0; j < Wosize_val(glob); j++)
- f (ctx, Field (glob, j), &Field (glob, j));
- }
+ /* /\* The global roots *\/ */
+ /* for (i = 0; caml_globals[i] != 0; i++) { */
+ /* glob = caml_globals[i]; */
+ /* for (j = 0; j < Wosize_val(glob); j++) */
+ /* f (ctx, Field (glob, j), &Field (glob, j)); */
+ /* } */
/* Dynamic global roots */
iter_list(caml_dyn_globals, lnk) {
View
@@ -86,6 +86,7 @@ extern void caml_init_frame_descriptors(dont_use);
extern void caml_init_frame_descriptors_r(CAML_R);
//extern void caml_register_frametable(dont_use, intnat *); // Not used from the outside
//extern void caml_register_frametable_r(CAML_R, intnat *); // Not used from the outside
+extern void caml_register_frametable_r(CAML_R, intnat *); // I think Fabrice commented out the prototype. I might be missing something here. FIXME: ask Fabrice --Luca Saiu REENTRANTRUNTIME !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
extern void caml_register_dyn_global(dont_use, void *);
extern void caml_register_dyn_global_r(CAML_R, void *);
@@ -98,7 +99,7 @@ extern uintnat caml_stack_usage_r (CAML_R);
/* extern uintnat caml_last_return_address; */
/* extern value * caml_gc_regs; */
/* extern char * caml_exception_pointer; */
-extern value caml_globals[];
+/* extern value caml_globals[]; */ // This is now a resizable_buffer, in the context
/* extern intnat caml_globals_inited; */
extern intnat * caml_frametable[];
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
@@ -19,7 +19,7 @@
#include "config.h"
#include "misc.h"
-#include "mlvalues.h" /* for CAML_R */
+#include "context.h" /* for CAML_R */
extern void caml_compact_heap_r (CAML_R);
extern void caml_compact_heap_maybe_r (CAML_R);
View
@@ -370,8 +370,12 @@
#endif /* CAML_NAME_SPACE */
-/// FIXME: horrible compatibility macros (to compile coq). This has to be generalized
-//#define raise_out_of_memory() AAAAcaml_raise_out_of_memory()
-#define caml_raise_out_of_memory() caml_raise_out_of_memory_r(caml_get_thread_local_context())
-
+/// FIXME: horrible compatibility macros. This has to be generalized
+#define CTX caml_get_thread_local_context()
+#define caml_raise_out_of_memory() caml_raise_out_of_memory_r(CTX)
+#define caml_failwith(S) caml_failwith_r(CTX, S)
+#define caml_serialize_int_4(Q) caml_serialize_int_4_r(CTX, Q)
+#define caml_serialize_block_4(B, L) caml_serialize_block_4_r(CTX, B, L)
+#define caml_deserialize_uint_4() caml_deserialize_uint_4_r(CTX)
+#define caml_deserialize_block_4(B, L) caml_deserialize_block_4_r(CTX, B, L)
#endif /* CAML_COMPATIBILITY_H */
View
@@ -35,6 +35,7 @@
#include "callback.h" // for caml_callback_r
#include "alloc.h"
#include "intext.h"
+#include <pthread.h>
static __thread caml_global_context *the_thread_local_caml_context = NULL;
@@ -66,6 +67,7 @@ static pthread_mutex_t caml_global_mutex = (pthread_mutex_t)(long)0xdeaddeaddead
void caml_initialize_mutex(pthread_mutex_t *mutex){
pthread_mutexattr_t attributes;
pthread_mutexattr_init(&attributes);
+ //int result = pthread_mutexattr_settype(&attributes, PTHREAD_MUTEX_RECURSIVE_NP);
int result = pthread_mutexattr_settype(&attributes, PTHREAD_MUTEX_RECURSIVE_NP);
if(result){
fprintf(stderr, "++++++++ [thread %p] pthread_mutexattr_settype failed\n", (void*)(pthread_self())); fflush(stderr);
@@ -626,7 +628,7 @@ library_context *caml_get_library_context_r(CAML_R,
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);
- caml_remove_global_root_r(ctx, ctx->caml_signal_handlers);
+ caml_remove_global_root_r(ctx, &ctx->caml_signal_handlers);
//caml_gc_compaction_r(ctx, Val_unit); //!!!!!@@@@@@@@@@@@@@??????????????????
///
@@ -658,18 +660,18 @@ extern void caml_destroy_context(CAML_R){
// FIXME: really destroy stuff
}
+#ifdef NATIVE_CODE
/* The index of the first word in caml_globals which is not used yet.
This variable is shared by all contexts, and accessed in mutual
exclusion. */
-static long first_unused_word_offset = 0; // the first word is unused
+static long first_unused_word_offset = 0;
-#ifdef NATIVE_CODE
void caml_register_module_r(CAML_R, size_t size_in_bytes, long *offset_pointer){
/* Compute the size in words, which is to say how many globals are there: */
int size_in_words = size_in_bytes / sizeof(void*);
/* We keep the module name right after the offset pointer, as a read-only string: */
char *module_name = (char*)offset_pointer + sizeof(long);
- DUMP("module_name is %s", module_name);
+ DUMP("module_name is %s (%li bytes); offset_pointer is at %p", module_name, (long)size_in_bytes, offset_pointer);
Assert(size_in_words * sizeof(void*) == size_in_bytes); /* there's a whole number of globals */
//fprintf(stderr, "caml_register_module_r [context %p]: registering %s%p [%lu bytes at %p]: BEGIN\n", ctx, module_name, offset_pointer, (unsigned long)size_in_bytes, offset_pointer); fflush(stderr);
View
@@ -28,7 +28,9 @@
#include <signal.h>
#include <setjmp.h> // FIXME: remove if not needed in the end --Luca Saiu REENTRANTRUNTIME
+#ifndef __USE_UNIX98
#define __USE_UNIX98
+#endif
#include <pthread.h>
#include <semaphore.h>
View
@@ -16,6 +16,7 @@
#include "callback.h" // for caml_callback_r and friends
#include "alloc.h"
#include "intext.h"
+#include "printexc.h" // FIXME: remove after debugging, if possible
#include "gc_ctrl.h" // FIXME: remove after debugging, if possible
#include "compact.h" // FIXME: remove after debugging, if possible
@@ -129,7 +130,7 @@ value caml_global_tuple_r(CAML_R)
/* No need for GC-protection: there is no allocation here. */
// FIXME: for debugging only. Remove: BEGIN
globals = ctx->caml_global_data;
- int element_no = Wosize_val(globals);
+ //int element_no = Wosize_val(globals);
//fprintf(stderr, "[bytecode] The tuple has %i elements\n", (int)element_no);
// FIXME: for debugging only. Remove: END
View
@@ -41,4 +41,6 @@ void caml_init_gc_r (CAML_R, uintnat, uintnat, uintnat,
void caml_heap_check_r (CAML_R);
#endif
+value caml_gc_compaction_r(CAML_R, value v); // FIXME: Remove after debugging, if possible !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
#endif /* CAML_GC_CTRL_H */
View
@@ -186,19 +186,19 @@ caml_trace_value_file_r (CAML_R, value v, code_t prog, int proglen, FILE * f)
if (prog && v % sizeof (int) == 0
&& (code_t) v >= prog
&& (code_t) v < (code_t) ((char *) prog + proglen))
- fprintf (f, "=code@%d", (code_t) v - prog);
+ fprintf (f, "=code@%d", (int)((code_t) v - prog));
else if (Is_long (v))
fprintf (f, "=long%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val (v));
else if ((void*)v >= (void*)caml_stack_low
&& (void*)v < (void*)caml_stack_high)
- fprintf (f, "=stack_%d", (intnat*)caml_stack_high - (intnat*)v);
+ fprintf (f, "=stack_%d", (int)((intnat*)caml_stack_high - (intnat*)v));
else if (Is_block (v)) {
int s = Wosize_val (v);
int tg = Tag_val (v);
int l = 0;
switch (tg) {
case Closure_tag:
- fprintf (f, "=closure[s%d,cod%d]", s, (code_t) (Code_val (v)) - prog);
+ fprintf (f, "=closure[s%d,cod%d]", s, (int)((code_t) (Code_val (v)) - prog));
goto displayfields;
case String_tag:
l = caml_string_length (v);
@@ -254,10 +254,10 @@ caml_trace_accu_sp_file_r (CAML_R, value accu, value * sp, code_t prog, int prog
fprintf (f, "accu=");
caml_trace_value_file_r (ctx, accu, prog, proglen, f);
fprintf (f, "\n sp=%#" ARCH_INTNAT_PRINTF_FORMAT "x @%d:",
- (intnat) sp, caml_stack_high - sp);
+ (intnat) sp, (int)(caml_stack_high - sp));
for (p = sp, i = 0; i < 12 + (1 << caml_trace_flag) && p < caml_stack_high;
p++, i++) {
- fprintf (f, "\n[%d] ", caml_stack_high - p);
+ fprintf (f, "\n[%d] ", (int)(caml_stack_high - p));
caml_trace_value_file_r (ctx, *p, prog, proglen, f);
};
putc ('\n', f);
View
@@ -1142,7 +1142,7 @@ value caml_interprete_r(CAML_R, code_t prog, asize_t prog_size)
#else
caml_fatal_error_arg("Fatal error: bad opcode (%"
ARCH_INTNAT_PRINTF_FORMAT "x)\n",
- (char *)(*(pc-1)));
+ (char *)(long)(*(pc-1)));
#endif
}
}
View
@@ -130,7 +130,7 @@ caml_release_global_lock();
CAMLexport void caml_close_channel(struct channel *channel)
{
- INIT_CAML_R;
+ //INIT_CAML_R;
int greater_than_zero;
close(channel->fd);
Lock(channel);
@@ -472,7 +472,7 @@ CAMLexport void caml_finalize_channel(value vchan)
{
struct channel * chan = Channel(vchan);
int greater_than_zero;
- INIT_CAML_R;
+ //INIT_CAML_R;
Lock(chan);
greater_than_zero = --chan->refcount > 0;
fprintf(stderr, "Context %p: finalizing the channel with struct channel* %p, fd %i: its refcount is now %i\n", ctx, chan, chan->fd, chan->refcount); fflush(stderr);
View
@@ -78,7 +78,14 @@ void caml_darken_r (CAML_R, value v, value *p /* not used */)
h = Hd_val (v);
t = Tag_hd (h);
}
- CAMLassert (!Is_blue_hd (h));
+ // CAMLassert (!Is_blue_hd (h));
+ if(Is_blue_hd (h)) // !!!!!!!!!!!!!!
+ { volatile int n = 1000;
+ n /= 2;
+ /* n /= 4; */
+ /* n /= 4; */
+ /* n /= 4; */
+ } // !!!!!
if (Is_white_hd (h)){
if (t < No_scan_tag){
Hd_val (v) = Grayhd_hd (h);
@@ -109,7 +116,9 @@ static void start_cycle_r (CAML_R)
static void mark_slice_r (CAML_R, intnat work)
{
value *gray_vals_ptr; /* Local copy of gray_vals_cur */
- value v, child;
+ // ORIGINAL VERSION: there was no volatile qualifier !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1
+ /* value v, child; */
+ volatile value v, child;
header_t hd;
mlsize_t size, i;
View
@@ -312,8 +312,8 @@ CAMLprim value caml_install_signal_handler_r(CAML_R, value signal_number, value
if (Is_block(action)) {
if (caml_signal_handlers == 0) {
caml_signal_handlers = caml_alloc_r(ctx, NSIG, 0);
- ////
- int i, length = NSIG;
+ //// !!!!!!!!!!!!!!!!!!!!!!!!!!! This is probably ok. Just remove my comment markers. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ int i;
for(i = 0; i < NSIG; i ++)
caml_initialize_r(ctx, &Field(caml_signal_handlers, i), Val_int(0));
////
View
@@ -17,8 +17,8 @@ let x11_link = "not found";;
let tk_defs = "";;
let tk_link = "";;
let libbfd_link = "-lbfd -ldl -liberty -lz";;
-let bytecc = "gcc -g";;
-let bytecccompopts = "-fno-defer-pop -Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT";;
+let bytecc = "gcc -Wall -Wno-unused-value -Wno-div-by-zero -Werror -g";;
+let bytecccompopts = "-fno-defer-pop -Wall -Wno-unused-value -Wno-div-by-zero -Werror -D_FILE_OFFSET_BITS=64 -D_REENTRANT";;
let bytecclinkopts = " -Wl,-E";;
let bytecclibs = " -lm -ldl -lcurses -lpthread";;
let byteccrpath = "-Wl,-rpath,";;
@@ -36,14 +36,14 @@ let mklib out files opts = Printf.sprintf "ar rc %s %s %s; ranlib %s" out opts f
let arch = "amd64";;
let model = "default";;
let system = "linux";;
-let nativecc = "gcc -g";;
-let nativecccompopts = "-Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT";;
-let nativeccprofopts = "-Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT";;
+let nativecc = "gcc -Wall -Wno-unused-value -Wno-div-by-zero -Werror -g";;
+let nativecccompopts = "-Wall -Wno-unused-value -Wno-div-by-zero -Werror -D_FILE_OFFSET_BITS=64 -D_REENTRANT";;
+let nativeccprofopts = "-Wall -Wno-unused-value -Wno-div-by-zero -Werror -D_FILE_OFFSET_BITS=64 -D_REENTRANT";;
let nativecclinkopts = "";;
let nativeccrpath = "-Wl,-rpath,";;
let nativecclibs = " -lm -ldl -lpthread";;
let asm = "as";;
-let aspp = "gcc -c -g";;
+let aspp = "gcc -Wall -Wno-unused-value -Wno-div-by-zero -Werror -c -g";;
let asppprofflags = "-DPROFILING";;
let profiling = "prof";;
let dynlinkopts = " -ldl";;
@@ -63,14 +63,14 @@ let ext_asm = ".s";;
let ext_lib = ".a";;
let ext_dll = ".so";;
let extralibs = "";;
-let ccomptype = "cc";;
-let toolchain = "cc";;
+let ccomptype = "gcc -Wall -Wno-unused-value -Wno-div-by-zero -Werror -g";;
+let toolchain = "gcc -Wall -Wno-unused-value -Wno-div-by-zero -Werror -g";;
let natdynlink = true;;
let cmxs = "cmxs";;
let mkexe = bytecc;;
let mkexedebugflag = "-g";;
-let mkdll = "gcc -shared -g";;
-let mkmaindll = "gcc -shared -g";;
+let mkdll = "gcc -Wall -Wno-unused-value -Wno-div-by-zero -Werror -shared -g";;
+let mkmaindll = "gcc -Wall -Wno-unused-value -Wno-div-by-zero -Werror -shared -g";;
let runtimed = "runtimed";;
let camlp4 = "camlp4";;
let asm_cfi_supported = true;;
@@ -25,6 +25,8 @@
#include "bng.h"
#include "nat.h"
+#include <context.h>
+
/* Stub code for the Nat module. */
static intnat hash_nat(value);
@@ -97,7 +99,8 @@ CAMLprim value set_digit_nat_native(value nat, value ofs, value digit)
CAMLprim value nth_digit_nat_native(value nat, value ofs)
{
- return caml_copy_nativeint(Digit_val(nat, Long_val(ofs)));
+ INIT_CAML_R;
+ return caml_copy_nativeint_r(ctx, Digit_val(nat, Long_val(ofs)));
}
CAMLprim value num_digits_nat(value nat, value ofs, value len)
@@ -52,7 +52,7 @@ CAMLprim value unix_inet_addr_of_string_r(CAML_R, value s)
default:
{
freeaddrinfo(res);
- caml_failwith(ctx, "inet_addr_of_string");
+ caml_failwith_r(ctx, "inet_addr_of_string");
}
}
freeaddrinfo(res);
Oops, something went wrong.

0 comments on commit 2836bc2

Please sign in to comment.