309

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/jocamltrunk@7192 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

82 files changed, 1534 insertions, 1525 deletions

diff --git a/asmrun/i386.S b/asmrun/i386.S
index 52b0d9f55c..5bac7304a8 100644
--- a/asmrun/i386.S
+++ b/asmrun/i386.S
@@ -324,3 +324,11 @@ G(caml_system__frametable):
         .value  -1              /* negative frame size => use callback link */
         .value  0               /* no roots here */
 #endif
+
+        .globl  G(caml_extra_params)
+G(caml_extra_params):
+#ifndef SYS_solaris
+        .space  64
+#else
+        .zero   64
+#endif
diff --git a/asmrun/i386nt.asm b/asmrun/i386nt.asm
index 583feb7414..b2a2614c31 100644
--- a/asmrun/i386nt.asm
+++ b/asmrun/i386nt.asm
@@ -274,4 +274,9 @@ _caml_system__frametable LABEL DWORD
         WORD    -1              ; negative frame size => use callback link 
         WORD    0               ; no roots here 
 
+        PUBLIC  _caml_extra_params
+_caml_extra_params LABEL DWORD
+        BYTE    64 DUP (?)
+
         END
+
diff --git a/asmrun/roots.c b/asmrun/roots.c
index 76d85a0ad4..5a143d2dd7 100644
--- a/asmrun/roots.c
+++ b/asmrun/roots.c
@@ -34,7 +34,7 @@ void (*caml_scan_roots_hook) (scanning_action) = NULL;
 /* The hashtable of frame descriptors */
 
 typedef struct {
-  unsigned long retaddr;
+  uintnat retaddr;
   short frame_size;
   short num_live;
   short live_ofs[1];
@@ -44,14 +44,14 @@ static frame_descr ** frame_descriptors = NULL;
 static int frame_descriptors_mask;
 
 #define Hash_retaddr(addr) \
-  (((unsigned long)(addr) >> 3) & frame_descriptors_mask)
+  (((uintnat)(addr) >> 3) & frame_descriptors_mask)
 
 static void init_frame_descriptors(void)
 {
-  long num_descr, tblsize, i, j, len;
-  long * tbl;
+  intnat num_descr, tblsize, i, j, len;
+  intnat * tbl;
   frame_descr * d;
-  unsigned long h;
+  uintnat h;
 
   /* Count the frame descriptors */
   num_descr = 0;
@@ -81,7 +81,7 @@ static void init_frame_descriptors(void)
       }
       frame_descriptors[h] = d;
       d = (frame_descr *)
-        (((unsigned long)d +
+        (((uintnat)d +
           sizeof(char *) + sizeof(short) + sizeof(short) +
           sizeof(short) * d->num_live + sizeof(frame_descr *) - 1)
          & -sizeof(frame_descr *));
@@ -92,20 +92,20 @@ static void init_frame_descriptors(void)
 /* Communication with [caml_start_program] and [caml_call_gc]. */
 
 char * caml_bottom_of_stack = NULL; /* no stack initially */
-unsigned long caml_last_return_address = 1; /* not in Caml code initially */
+uintnat caml_last_return_address = 1; /* not in Caml code initially */
 value * caml_gc_regs;
-long caml_globals_inited = 0;
-static long caml_globals_scanned = 0;
+intnat caml_globals_inited = 0;
+static intnat caml_globals_scanned = 0;
 
 /* Call [caml_oldify_one] on (at least) all the roots that point to the minor
    heap. */
 void caml_oldify_local_roots (void)
 {
   char * sp;
-  unsigned long retaddr;
+  uintnat retaddr;
   value * regs;
   frame_descr * d;
-  unsigned long h;
+  uintnat h;
   int i, j, n, ofs;
   short * p;
   value glob;
@@ -227,14 +227,14 @@ void caml_do_roots (scanning_action f)
 }
 
 void caml_do_local_roots(scanning_action f, char * bottom_of_stack,
-                         unsigned long last_retaddr, value * gc_regs,
+                         uintnat last_retaddr, value * gc_regs,
                          struct caml__roots_block * local_roots)
 {
   char * sp;
-  unsigned long retaddr;
+  uintnat retaddr;
   value * regs;
   frame_descr * d;
-  unsigned long h;
+  uintnat h;
   int i, j, n, ofs;
   short * p;
   value * root;
diff --git a/asmrun/signals.c b/asmrun/signals.c
index a6ce72ef7c..0262f237ac 100644
--- a/asmrun/signals.c
+++ b/asmrun/signals.c
@@ -13,11 +13,11 @@
 
 /* $Id$ */
 
+#if defined(TARGET_amd64) && defined (SYS_linux)
+#define _GNU_SOURCE
+#endif
 #include <signal.h>
 #include <stdio.h>
-#if defined(TARGET_sparc) && defined(SYS_solaris)
-#include <ucontext.h>
-#endif
 #include "alloc.h"
 #include "callback.h"
 #include "memory.h"
@@ -25,7 +25,10 @@
 #include "misc.h"
 #include "mlvalues.h"
 #include "fail.h"
+#include "osdeps.h"
 #include "signals.h"
+#include "signals_machdep.h"
+#include "signals_osdep.h"
 #include "stack.h"
 #include "sys.h"
 #ifdef HAS_STACK_OVERFLOW_DETECTION
@@ -33,10 +36,9 @@
 #include <sys/resource.h>
 #endif
 
-extern char * caml_code_area_start, * caml_code_area_end;
-
-#define In_code_area(pc) \
-  ((char *)(pc) >= caml_code_area_start && (char *)(pc) <= caml_code_area_end)
+#ifndef NSIG
+#define NSIG 64
+#endif
 
 #ifdef _WIN32
 typedef void (*sighandler)(int sig);
@@ -44,79 +46,56 @@ extern sighandler caml_win32_signal(int sig, sighandler action);
 #define signal(sig,act) caml_win32_signal(sig,act)
 #endif
 
-#if defined(TARGET_power) && defined(SYS_rhapsody)
+extern char * caml_code_area_start, * caml_code_area_end;
 
-  #include <sys/utsname.h>
+#define In_code_area(pc) \
+  ((char *)(pc) >= caml_code_area_start && \
+   (char *)(pc) <= caml_code_area_end)
 
-  #define STRUCT_SIGCONTEXT void
-  #define CONTEXT_GPR(ctx, regno) (*context_gpr_p ((ctx), (regno)))
-  #define CONTEXT_PC(ctx) CONTEXT_GPR ((ctx), -2)
-  static int ctx_version = 0;
-  static void init_ctx (void)
-  {
-    struct utsname name;
-    if (uname (&name) == 0){
-      if (name.release[1] == '.' && name.release[0] <= '5'){
-        ctx_version = 1;
-      }else{
-        ctx_version = 2;
-      }
-    }else{
-      caml_fatal_error ("cannot determine SIGCONTEXT format");
-    }
+volatile intnat caml_pending_signals[NSIG];
+volatile int caml_force_major_slice = 0;
+value caml_signal_handlers = 0;
+
+static void caml_process_pending_signals(void)
+{
+  int signal_num;
+  intnat signal_state;
+
+  for (signal_num = 0; signal_num < NSIG; signal_num++) {
+    Read_and_clear(signal_state, caml_pending_signals[signal_num]);
+    if (signal_state) caml_execute_signal(signal_num, 0);
   }
+}
 
-  #ifdef DARWIN_VERSION_6
-    #include <sys/ucontext.h>
-    static unsigned long *context_gpr_p (void *ctx, int regno)
-    {
-      unsigned long *regs;
-      if (ctx_version == 0) init_ctx ();
-      if (ctx_version == 1){
-        /* old-style context (10.0 and 10.1) */
-        regs = (unsigned long *)(((struct sigcontext *)ctx)->sc_regs);
-      }else{
-        Assert (ctx_version == 2);
-        /* new-style context (10.2) */
-        regs = (unsigned long *)&(((struct ucontext *)ctx)->uc_mcontext->ss);
-      }
-      return &(regs[2 + regno]);
-    }
-  #else
-    #define SA_SIGINFO 0x0040
-    struct ucontext {
-      int       uc_onstack;
-      sigset_t  uc_sigmask;
-      struct sigaltstack uc_stack;
-      struct ucontext   *uc_link;
-      size_t    uc_mcsize;
-      unsigned long     *uc_mcontext;
-    };
-    static unsigned long *context_gpr_p (void *ctx, int regno)
-    {
-      unsigned long *regs;
-      if (ctx_version == 0) init_ctx ();
-      if (ctx_version == 1){
-        /* old-style context (10.0 and 10.1) */
-        regs = (unsigned long *)(((struct sigcontext *)ctx)->sc_regs);
-      }else{
-        Assert (ctx_version == 2);
-        /* new-style context (10.2) */
-        regs = (unsigned long *)((struct ucontext *)ctx)->uc_mcontext + 8;
-      }
-      return &(regs[2 + regno]);
-    }
-  #endif
-#endif
+static intnat volatile caml_async_signal_mode = 0;
 
-volatile int caml_async_signal_mode = 0;
-volatile int caml_pending_signal = 0;
-volatile int caml_force_major_slice = 0;
-value caml_signal_handlers = 0;
-void (*caml_enter_blocking_section_hook)() = NULL;
-void (*caml_leave_blocking_section_hook)() = NULL;
+static void caml_enter_blocking_section_default(void)
+{
+  Assert (caml_async_signal_mode == 0);
+  caml_async_signal_mode = 1;
+}
+
+static void caml_leave_blocking_section_default(void)
+{
+  Assert (caml_async_signal_mode == 1);
+  caml_async_signal_mode = 0;
+}
+
+static int caml_try_leave_blocking_section_default(void)
+{
+  intnat res;
+  Read_and_clear(res, caml_async_signal_mode);
+  return res;
+}
 
-static int rev_convert_signal_number(int signo);
+CAMLexport void (*caml_enter_blocking_section_hook)(void) =
+   caml_enter_blocking_section_default;
+CAMLexport void (*caml_leave_blocking_section_hook)(void) =
+   caml_leave_blocking_section_default;
+CAMLexport int (*caml_try_leave_blocking_section_hook)(void) =
+   caml_try_leave_blocking_section_default;
+
+int caml_rev_convert_signal_number(int signo);
 
 /* Execute a signal handler immediately. */
 
@@ -131,8 +110,9 @@ void caml_execute_signal(int signal_number, int in_signal_handler)
   sigaddset(&sigs, signal_number);
   sigprocmask(SIG_BLOCK, &sigs, &sigs);
 #endif
-  res = caml_callback_exn(Field(caml_signal_handlers, signal_number),
-                          Val_int(rev_convert_signal_number(signal_number)));
+  res = caml_callback_exn(
+           Field(caml_signal_handlers, signal_number),
+           Val_int(caml_rev_convert_signal_number(signal_number)));
 #ifdef POSIX_SIGNALS
   if (! in_signal_handler) {
     /* Restore the original signal mask */
@@ -146,6 +126,15 @@ void caml_execute_signal(int signal_number, int in_signal_handler)
   if (Is_exception_result(res)) caml_raise(Extract_exception(res));
 }
 
+/* Record the delivery of a signal and play with the allocation limit
+   so that the next allocation will trigger a garbage collection. */
+
+void caml_record_signal(int signal_number)
+{
+  caml_pending_signals[signal_number] = 1;
+  caml_young_limit = caml_young_end;
+}
+
 /* This routine is the common entry point for garbage collection
    and signal handling.  It can trigger a callback to Caml code.
    With system threads, this callback can cause a context switch.
@@ -157,17 +146,17 @@ void caml_execute_signal(int signal_number, int in_signal_handler)
 
 void caml_garbage_collection(void)
 {
-  int sig;
+  int signal_number;
+  intnat signal_state;
 
-  if (caml_young_ptr < caml_young_start || caml_force_major_slice){
+  caml_young_limit = caml_young_start;
+  if (caml_young_ptr < caml_young_start || caml_force_major_slice) {
     caml_minor_collection();
   }
-  /* If a signal arrives between the following two instructions,
-     it will be lost. */
-  sig = caml_pending_signal;
-  caml_pending_signal = 0;
-  caml_young_limit = caml_young_start;
-  if (sig) caml_execute_signal(sig, 0);
+  for (signal_number = 0; signal_number < NSIG; signal_number++) {
+    Read_and_clear(signal_state, caml_pending_signals[signal_number]);
+    if (signal_state) caml_execute_signal(signal_number, 0);
+  }
 }
 
 /* Trigger a garbage collection as soon as possible */
@@ -184,104 +173,45 @@ void caml_urge_major_slice (void)
 
 void caml_enter_blocking_section(void)
 {
-  int sig;
+  int i;
+  intnat pending;
 
   while (1){
-    Assert (!caml_async_signal_mode);
-    /* If a signal arrives between the next two instructions,
-       it will be lost. */
-    sig = caml_pending_signal;
-    caml_pending_signal = 0;
-    caml_young_limit = caml_young_start;
-    if (sig) caml_execute_signal(sig, 0);
-    caml_async_signal_mode = 1;
-    if (!caml_pending_signal) break;
-    caml_async_signal_mode = 0;
-  }
-  if (caml_enter_blocking_section_hook != NULL){
-    caml_enter_blocking_section_hook();
+    /* Process all pending signals now */
+    caml_process_pending_signals();
+    caml_enter_blocking_section_hook ();
+    /* Check again for pending signals. */
+    pending = 0;
+    for (i = 0; i < NSIG; i++) pending |= caml_pending_signals[i];
+    /* If none, done; otherwise, try again */
+    if (!pending) break;
+    caml_leave_blocking_section_hook ();
   }
 }
 
-void caml_leave_blocking_section(void)
+CAMLexport void caml_leave_blocking_section(void)
 {
-  if (caml_leave_blocking_section_hook != NULL){
-    caml_leave_blocking_section_hook();
-  }
-  Assert(caml_async_signal_mode);
-  caml_async_signal_mode = 0;
+  caml_leave_blocking_section_hook ();
+  caml_process_pending_signals();
 }
 
-#if defined(TARGET_alpha) || defined(TARGET_mips)
-static void handle_signal(int sig, int code, struct sigcontext * context)
-#elif defined(TARGET_power) && defined(SYS_elf)
-static void handle_signal(int sig, struct sigcontext * context)
-#elif defined(TARGET_power) && defined(SYS_rhapsody)
-static void handle_signal(int sig, int code, STRUCT_SIGCONTEXT * context)
-#elif defined(TARGET_power) && defined(SYS_bsd)
-static void handle_signal(int sig, int code, struct sigcontext * context)
-#elif defined(TARGET_sparc) && defined(SYS_solaris)
-static void handle_signal(int sig, int code, void * context)
-#else
-static void handle_signal(int sig)
-#endif
+DECLARE_SIGNAL_HANDLER(handle_signal)
 {
 #if !defined(POSIX_SIGNALS) && !defined(BSD_SIGNALS)
   signal(sig, handle_signal);
 #endif
-  if (caml_async_signal_mode) {
-    /* We are interrupting a C function blocked on I/O.
-       Callback the Caml code immediately. */
-    caml_leave_blocking_section();
+  if (sig < 0 || sig >= NSIG) return;
+  if (caml_try_leave_blocking_section_hook ()) {
     caml_execute_signal(sig, 1);
-    caml_enter_blocking_section();
+    caml_enter_blocking_section_hook();
   } else {
-    /* We can't execute the signal code immediately.
-       Instead, we remember the signal and play with the allocation limit
-       so that the next allocation will trigger a garbage collection. */
-    caml_pending_signal = sig;
-    caml_young_limit = caml_young_end;
-    /* Some ports cache [caml_young_limit] in a register.
-       Use the signal context to modify that register too, but only if
-       we are inside Caml code (not inside C code). */
-#if defined(TARGET_alpha)
-    if (In_code_area(context->sc_pc)) {
-      /* Cached in register $14 */
-      context->sc_regs[14] = (long) caml_young_limit;
-    }
-#endif
-#if defined(TARGET_mips)
-    if (In_code_area(context->sc_pc)) {
-      /* Cached in register $23 */
-      context->sc_regs[23] = (int) caml_young_limit;
-    }
-#endif
-#if defined(TARGET_power) && defined(SYS_elf)
-    if (caml_last_return_address == 0) {
-      /* Cached in register 30 */
-      context->regs->gpr[30] = (unsigned long) caml_young_limit;
-    }
-#endif
-#if defined(TARGET_power) && defined(SYS_rhapsody)
-    if (In_code_area(CONTEXT_PC(context))) {
-      /* Cached in register 30 */
-      CONTEXT_GPR(context, 30) = (unsigned long) caml_young_limit;
-    }
-#endif
-#if defined(TARGET_power) && defined(SYS_bsd)
-    if (caml_last_return_address == 0) {
-      /* Cached in register 30 */
-      context->sc_frame.fixreg[30] = (unsigned long) caml_young_limit;
-    }
-#endif
-#if defined(TARGET_sparc) && defined(SYS_solaris)
-    { greg_t * gregs = ((ucontext_t *)context)->uc_mcontext.gregs;
-      if (In_code_area(gregs[REG_PC])) {
-      /* Cached in register l7, which is saved on the stack 7 words
-	 after the stack pointer.  */
-        ((long *)(gregs[REG_SP]))[7] = (long) caml_young_limit;
-      }
-    }
+    caml_record_signal(sig);
+  /* Some ports cache [caml_young_limit] in a register.
+     Use the signal context to modify that register too, but only if
+     we are inside Caml code (not inside C code). */
+#if defined(CONTEXT_PC) && defined(CONTEXT_YOUNG_LIMIT)
+    if (In_code_area(CONTEXT_PC))
+      CONTEXT_YOUNG_LIMIT = (context_reg) caml_young_limit;
 #endif
   }
 }
@@ -364,7 +294,7 @@ int caml_convert_signal_number(int signo)
     return signo;
 }
 
-static int rev_convert_signal_number(int signo)
+int caml_rev_convert_signal_number(int signo)
 {
   int i;
   for (i = 0; i < sizeof(posix_signals) / sizeof(int); i++)
@@ -372,49 +302,56 @@ static int rev_convert_signal_number(int signo)
   return signo;
 }
 
-#ifndef NSIG
-#define NSIG 64
-#endif
+typedef void (*signal_handler)(int signo);
 
 value caml_install_signal_handler(value signal_number, value action) /* ML */
 {
   CAMLparam2 (signal_number, action);
   int sig;
-  void (*act)(int signo), (*oldact)(int signo);
+  signal_handler oldact;
 #ifdef POSIX_SIGNALS
   struct sigaction sigact, oldsigact;
+#else
+  signal_handler act;
 #endif
   CAMLlocal1 (res);
 
   sig = caml_convert_signal_number(Int_val(signal_number));
   if (sig < 0 || sig >= NSIG) 
     caml_invalid_argument("Sys.signal: unavailable signal");
+#ifdef POSIX_SIGNALS
   switch(action) {
   case Val_int(0):              /* Signal_default */
-    act = SIG_DFL;
+    sigact.sa_handler = SIG_DFL;
+    sigact.sa_flags = 0;
     break;
   case Val_int(1):              /* Signal_ignore */
-    act = SIG_IGN;
+    sigact.sa_handler = SIG_IGN;
+    sigact.sa_flags = 0;
     break;
   default:                      /* Signal_handle */
-    act = (void (*)(int)) handle_signal;
+    SET_SIGACT(sigact, handle_signal);
     break;
   }
-#ifdef POSIX_SIGNALS
-  sigact.sa_handler = act;
   sigemptyset(&sigact.sa_mask);
-#if defined(SYS_solaris) || defined(SYS_rhapsody)
-  sigact.sa_flags = SA_SIGINFO;
-#else
-  sigact.sa_flags = 0;
-#endif
   if (sigaction(sig, &sigact, &oldsigact) == -1) caml_sys_error(NO_ARG);
   oldact = oldsigact.sa_handler;
 #else
+  switch(action) {
+  case Val_int(0):              /* Signal_default */
+    act = SIG_DFL;
+    break;
+  case Val_int(1):              /* Signal_ignore */
+    act = SIG_IGN;
+    break;
+  default:                      /* Signal_handle */
+    act = handle_signal;
+    break;
+  }
   oldact = signal(sig, act);
   if (oldact == SIG_ERR) caml_sys_error(NO_ARG);
 #endif
-  if (oldact == (void (*)(int)) handle_signal) {
+  if (oldact == (signal_handler) handle_signal) {
     res = caml_alloc_small(1, 0);          /* Signal_handle */
     Field(res, 0) = Field(caml_signal_handlers, sig);
   }
@@ -429,100 +366,40 @@ value caml_install_signal_handler(value signal_number, value action) /* ML */
     }
     caml_modify(&Field(caml_signal_handlers, sig), Field(action, 0));
   }
+  caml_process_pending_signals();
   CAMLreturn (res);
 }
 
 /* Machine- and OS-dependent handling of bound check trap */
 
-#if defined(TARGET_sparc) && defined(SYS_sunos)
-static void trap_handler(int sig, int code, 
-                         struct sigcontext * context, char * address)
-{
-  int * sp;
-  /* Unblock SIGILL */
-  sigset_t mask;
-  sigemptyset(&mask);
-  sigaddset(&mask, SIGILL);
-  sigprocmask(SIG_UNBLOCK, &mask, NULL);
-  if (code != ILL_TRAP_FAULT(5)) {
-    fprintf(stderr, "Fatal error: illegal instruction, code 0x%x\n", code);
-    exit(100);
-  }
-  /* Recover [caml_young_ptr] and [caml_exception_pointer]
-     from the %l5 and %l6 regs */
-  sp = (int *) context->sc_sp;
-  caml_exception_pointer = (char *) sp[5];
-  caml_young_ptr = (char *) sp[6];
-  caml_array_bound_error();
-}
-#endif
-
-#if defined(TARGET_sparc) && defined(SYS_solaris)
-static void trap_handler(int sig, siginfo_t * info, void * context)
+#if defined(TARGET_power) || (defined(TARGET_sparc) && defined(SYS_solaris))
+DECLARE_SIGNAL_HANDLER(trap_handler)
 {
-  long * sp;
-
+#if defined(SYS_solaris)
   if (info->si_code != ILL_ILLTRP) {
-    fprintf(stderr, "Fatal error: illegal instruction, code 0x%x\n",
-            info->si_code);
-    exit(100);
+    /* Deactivate our exception handler and return. */
+    struct sigaction act;
+    act.sa_handler = SIG_DFL;
+    act.sa_flags = 0;
+    sigemptyset(&act.sa_mask);
+    sigaction(sig, &act, NULL);
+    return;
   }
-  /* Recover [caml_young_ptr] and [caml_exception_pointer]
-     from the %l5 and %l6 regs */
-  sp = (long *) (((ucontext_t *)context)->uc_mcontext.gregs[REG_SP]);
-  caml_exception_pointer = (char *) sp[5];
-  caml_young_ptr = (char *) sp[6];
-  caml_array_bound_error();
-}
-#endif
-
-#if defined(TARGET_sparc) && (defined(SYS_bsd) || defined(SYS_linux))
-static void trap_handler(int sig)
-{
-  /* TODO: recover registers from context and call [caml_array_bound_error] */
-  caml_fatal_error("Fatal error: out-of-bound access in array or string\n");
-}
 #endif
-
-#if defined(TARGET_power) && defined(SYS_elf)
-static void trap_handler(int sig, struct sigcontext * context)
-{
-  /* Recover [caml_young_ptr] and [caml_exception_pointer]
-     from registers 31 and 29 */
-  caml_exception_pointer = (char *) context->regs->gpr[29];
-  caml_young_ptr = (char *) context->regs->gpr[31];
-  caml_array_bound_error();
-}
-#endif
-
-#if defined(TARGET_power) && defined(SYS_rhapsody)
-static void trap_handler(int sig, int code, STRUCT_SIGCONTEXT * context)
-{
+#if defined(SYS_rhapsody)
   /* Unblock SIGTRAP */
-  sigset_t mask;
-  sigemptyset(&mask);
-  sigaddset(&mask, SIGTRAP);
-  sigprocmask(SIG_UNBLOCK, &mask, NULL);
-  /* Recover [caml_young_ptr] and [caml_exception_pointer]
-     from registers 31 and 29 */
-  caml_exception_pointer = (char *) CONTEXT_GPR(context, 29);
-  caml_young_ptr = (char *) CONTEXT_GPR(context, 31);
-  caml_array_bound_error();
-}
+  { sigset_t mask;
+    sigemptyset(&mask);
+    sigaddset(&mask, SIGTRAP);
+    sigprocmask(SIG_UNBLOCK, &mask, NULL);
+  }
 #endif
-
-#if defined(TARGET_power) && defined(SYS_bsd)
-static void trap_handler(int sig, int code, struct sigcontext * context)
-{
-  /* Recover [caml_young_ptr] and [caml_exception_pointer]
-     from registers 31 and 29 */
-  caml_exception_pointer = (char *) context->sc_frame.fixreg[29];
-  caml_young_ptr = (char *) context->sc_frame.fixreg[31];
+  caml_exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER;
+  caml_young_ptr = (char *) CONTEXT_YOUNG_PTR;
   caml_array_bound_error();
 }
 #endif
 
-
 /* Machine- and OS-dependent handling of stack overflow */
 
 #ifdef HAS_STACK_OVERFLOW_DETECTION
@@ -530,46 +407,39 @@ static void trap_handler(int sig, int code, struct sigcontext * context)
 static char * system_stack_top;
 static char sig_alt_stack[SIGSTKSZ];
 
-static int is_stack_overflow(char * fault_addr)
+DECLARE_SIGNAL_HANDLER(segv_handler)
 {
   struct rlimit limit;
   struct sigaction act;
+  char * fault_addr;
 
   /* Sanity checks:
      - faulting address is word-aligned
-     - faulting address is within the stack */
-  if (((long) fault_addr & (sizeof(long) - 1)) == 0 &&
-      getrlimit(RLIMIT_STACK, &limit) == 0 &&
-      fault_addr < system_stack_top &&
-      fault_addr >= system_stack_top - limit.rlim_cur - 0x2000) {
-    /* OK, caller can turn this into a Stack_overflow exception */
-    return 1;
-  } else {
-    /* Otherwise, deactivate our exception handler.  Caller will
-       return, causing fatal signal to be generated at point of error. */
-    act.sa_handler = SIG_DFL;
-    act.sa_flags = 0;
-    sigemptyset(&act.sa_mask);
-    sigaction(SIGSEGV, &act, NULL);
-    return 0;
-  }
-}
-
-#if defined(TARGET_i386) && defined(SYS_linux_elf)
-static void segv_handler(int signo, struct sigcontext sc)
-{
-  if (is_stack_overflow((char *) sc.cr2))
-    caml_raise_stack_overflow();
-}
+     - faulting address is within the stack
+     - we are in Caml code */
+  fault_addr = CONTEXT_FAULTING_ADDRESS;
+  if (((uintnat) fault_addr & (sizeof(intnat) - 1)) == 0
+      && getrlimit(RLIMIT_STACK, &limit) == 0
+      && fault_addr < system_stack_top
+      && fault_addr >= system_stack_top - limit.rlim_cur - 0x2000
+#ifdef CONTEXT_PC
+      && In_code_area(CONTEXT_PC)
+#endif
+      ) {
+    /* Turn this into a Stack_overflow exception */
+#if defined(CONTEXT_YOUNG_PTR) && defined(CONTEXT_EXCEPTION_POINTER)
+    caml_exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER;
+    caml_young_ptr = (char *) CONTEXT_YOUNG_PTR;
 #endif
-
-#if defined(TARGET_i386) && !defined(SYS_linux_elf)
-static void segv_handler(int signo, siginfo_t * info, void * arg)
-{
-  if (is_stack_overflow((char *) info->si_addr))
     caml_raise_stack_overflow();
+  }
+  /* Otherwise, deactivate our exception handler and return,
+     causing fatal signal to be generated at point of error. */
+  act.sa_handler = SIG_DFL;
+  act.sa_flags = 0;
+  sigemptyset(&act.sa_mask);
+  sigaction(SIGSEGV, &act, NULL);
 }
-#endif
 
 #endif
 
@@ -578,38 +448,26 @@ static void segv_handler(int signo, siginfo_t * info, void * arg)
 void caml_init_signals(void)
 {
   /* Bound-check trap handling */
-#if defined(TARGET_sparc) && \
-      (defined(SYS_sunos) || defined(SYS_bsd) || defined(SYS_linux))
-  {
-    struct sigaction act;
-    act.sa_handler = (void (*)(int)) trap_handler;
-    sigemptyset(&act.sa_mask);
-    act.sa_flags = 0;
-    sigaction(SIGILL, &act, NULL);
-  }
-#endif
 #if defined(TARGET_sparc) && defined(SYS_solaris)
-  {
-    struct sigaction act;
-    act.sa_sigaction = trap_handler;
+  { struct sigaction act;
     sigemptyset(&act.sa_mask);
-    act.sa_flags = SA_SIGINFO | SA_NODEFER;
+    SET_SIGACT(act, trap_handler);
+    act.sa_flags |= SA_NODEFER;
     sigaction(SIGILL, &act, NULL);
   }
 #endif
+
 #if defined(TARGET_power)
-  {
-    struct sigaction act;
-    act.sa_handler = (void (*)(int)) trap_handler;
+  { struct sigaction act;
     sigemptyset(&act.sa_mask);
-#if defined (SYS_rhapsody)
-    act.sa_flags = SA_SIGINFO;
-#else
-    act.sa_flags = SA_NODEFER;
+    SET_SIGACT(act, trap_handler);
+#if !defined(SYS_rhapsody)
+    act.sa_flags |= SA_NODEFER;
 #endif
     sigaction(SIGTRAP, &act, NULL);
   }
 #endif
+
   /* Stack overflow handling */
 #ifdef HAS_STACK_OVERFLOW_DETECTION
   {
@@ -618,13 +476,8 @@ void caml_init_signals(void)
     stk.ss_sp = sig_alt_stack;
     stk.ss_size = SIGSTKSZ;
     stk.ss_flags = 0;
-#if defined(TARGET_i386) && defined(SYS_linux_elf)
-    act.sa_handler = (void (*)(int)) segv_handler;
-    act.sa_flags = SA_ONSTACK | SA_NODEFER;
-#else
-    act.sa_sigaction = segv_handler;
-    act.sa_flags = SA_SIGINFO | SA_ONSTACK | SA_NODEFER;
-#endif
+    SET_SIGACT(act, segv_handler);
+    act.sa_flags |= SA_ONSTACK | SA_NODEFER;
     sigemptyset(&act.sa_mask);
     system_stack_top = (char *) &act;
     if (sigaltstack(&stk, NULL) == 0) { sigaction(SIGSEGV, &act, NULL); }
diff --git a/asmrun/sparc.S b/asmrun/sparc.S
index 36b7d93f69..38d0be0c16 100644
--- a/asmrun/sparc.S
+++ b/asmrun/sparc.S
@@ -20,15 +20,12 @@
 
 #if defined(SYS_sunos)
 
-        .common _caml_required_size, 4, "bss"
-
 #define Caml_young_limit _caml_young_limit
 #define Caml_young_ptr _caml_young_ptr
 #define Caml_bottom_of_stack _caml_bottom_of_stack
 #define Caml_last_return_address _caml_last_return_address
 #define Caml_gc_regs _caml_gc_regs
 #define Caml_exception_pointer _caml_exception_pointer
-#define Caml_required_size _caml_required_size
 #define Caml_allocN _caml_allocN
 #define Caml_call_gc _caml_call_gc
 #define Caml_garbage_collection _caml_garbage_collection
@@ -43,18 +40,17 @@
 #define Caml_apply3 _caml_apply3
 #define Caml_raise _caml_raise
 #define Caml_system__frametable _caml_system__frametable
+#define Caml_ml_array_bound_error _caml_ml_array_bound_error
+#define Caml_array_bound_error _caml_array_bound_error
 
 #else
 
-        .common caml_required_size, 4, 4
-
 #define Caml_young_limit caml_young_limit
 #define Caml_young_ptr caml_young_ptr
 #define Caml_bottom_of_stack caml_bottom_of_stack
 #define Caml_last_return_address caml_last_return_address
 #define Caml_gc_regs caml_gc_regs
 #define Caml_exception_pointer caml_exception_pointer
-#define Caml_required_size caml_required_size
 #define Caml_allocN caml_allocN
 #define Caml_call_gc caml_call_gc
 #define Caml_garbage_collection caml_garbage_collection
@@ -69,6 +65,8 @@
 #define Caml_apply3 caml_apply3
 #define Caml_raise caml_raise
 #define Caml_system__frametable caml_system__frametable
+#define Caml_ml_array_bound_error caml_ml_array_bound_error
+#define Caml_array_bound_error caml_array_bound_error
 
 #endif
 
@@ -108,8 +106,6 @@ Caml_allocN:
 
 /* Required size in %g2 */
 Caml_call_gc:
-    /* Save %g2 (required size) */
-        Store(%g2, Caml_required_size)
     /* Save exception pointer if GC raises */
         Store(Exn_ptr, Caml_exception_pointer)
     /* Save current allocation pointer for debugging purposes */
@@ -121,26 +117,28 @@ Caml_call_gc:
     /* Allocate space on stack for caml_context structure and float regs */
         sub     %sp, 20*4 + 15*8, %sp
     /* Save int regs on stack and save it into caml_gc_regs */
-L100:   add     %sp, 96 + 15*8, %g2
-        st      %o0, [%g2]
-        st      %o1, [%g2 + 0x4]
-        st      %o2, [%g2 + 0x8]
-        st      %o3, [%g2 + 0xc]
-        st      %o4, [%g2 + 0x10]
-        st      %o5, [%g2 + 0x14]
-        st      %i0, [%g2 + 0x18]
-        st      %i1, [%g2 + 0x1c]
-        st      %i2, [%g2 + 0x20]
-        st      %i3, [%g2 + 0x24]
-        st      %i4, [%g2 + 0x28]
-        st      %i5, [%g2 + 0x2c]
-        st      %l0, [%g2 + 0x30]
-        st      %l1, [%g2 + 0x34]
-        st      %l2, [%g2 + 0x38]
-        st      %l3, [%g2 + 0x3c]
-        st      %l4, [%g2 + 0x40]
-        st      %g3, [%g2 + 0x44]
-        st      %g4, [%g2 + 0x48]
+L100:   add     %sp, 96 + 15*8, %g1
+        st      %o0, [%g1]
+        st      %o1, [%g1 + 0x4]
+        st      %o2, [%g1 + 0x8]
+        st      %o3, [%g1 + 0xc]
+        st      %o4, [%g1 + 0x10]
+        st      %o5, [%g1 + 0x14]
+        st      %i0, [%g1 + 0x18]
+        st      %i1, [%g1 + 0x1c]
+        st      %i2, [%g1 + 0x20]
+        st      %i3, [%g1 + 0x24]
+        st      %i4, [%g1 + 0x28]
+        st      %i5, [%g1 + 0x2c]
+        st      %l0, [%g1 + 0x30]
+        st      %l1, [%g1 + 0x34]
+        st      %l2, [%g1 + 0x38]
+        st      %l3, [%g1 + 0x3c]
+        st      %l4, [%g1 + 0x40]
+        st      %g3, [%g1 + 0x44]
+        st      %g4, [%g1 + 0x48]
+        st      %g2, [%g1 + 0x4C]       /* Save required size */
+        mov     %g1, %g2
         Store(%g2, Caml_gc_regs)
     /* Save the floating-point registers */
         add     %sp, 96, %g1
@@ -163,26 +161,27 @@ L100:   add     %sp, 96 + 15*8, %g2
         call    Caml_garbage_collection
         nop
     /* Restore all regs used by the code generator */
-        add     %sp, 96 + 15*8, %g2
-        ld      [%g2], %o0
-        ld      [%g2 + 0x4], %o1
-        ld      [%g2 + 0x8], %o2
-        ld      [%g2 + 0xc], %o3
-        ld      [%g2 + 0x10], %o4
-        ld      [%g2 + 0x14], %o5
-        ld      [%g2 + 0x18], %i0
-        ld      [%g2 + 0x1c], %i1
-        ld      [%g2 + 0x20], %i2
-        ld      [%g2 + 0x24], %i3
-        ld      [%g2 + 0x28], %i4
-        ld      [%g2 + 0x2c], %i5
-        ld      [%g2 + 0x30], %l0
-        ld      [%g2 + 0x34], %l1
-        ld      [%g2 + 0x38], %l2
-        ld      [%g2 + 0x3c], %l3
-        ld      [%g2 + 0x40], %l4
-        ld      [%g2 + 0x44], %g3
-        ld      [%g2 + 0x48], %g4
+        add     %sp, 96 + 15*8, %g1
+        ld      [%g1], %o0
+        ld      [%g1 + 0x4], %o1
+        ld      [%g1 + 0x8], %o2
+        ld      [%g1 + 0xc], %o3
+        ld      [%g1 + 0x10], %o4
+        ld      [%g1 + 0x14], %o5
+        ld      [%g1 + 0x18], %i0
+        ld      [%g1 + 0x1c], %i1
+        ld      [%g1 + 0x20], %i2
+        ld      [%g1 + 0x24], %i3
+        ld      [%g1 + 0x28], %i4
+        ld      [%g1 + 0x2c], %i5
+        ld      [%g1 + 0x30], %l0
+        ld      [%g1 + 0x34], %l1
+        ld      [%g1 + 0x38], %l2
+        ld      [%g1 + 0x3c], %l3
+        ld      [%g1 + 0x40], %l4
+        ld      [%g1 + 0x44], %g3
+        ld      [%g1 + 0x48], %g4
+        ld      [%g1 + 0x4C], %g2     /* Recover desired size */
         add     %sp, 96, %g1
         ldd     [%g1], %f0
         ldd     [%g1 + 0x8], %f2
@@ -202,7 +201,6 @@ L100:   add     %sp, 96 + 15*8, %g2
     /* Reload alloc ptr */
         Load(Caml_young_ptr, Alloc_ptr)
     /* Allocate space for block */
-        Load(Caml_required_size, %g2)
 #ifdef INDIRECT_LIMIT
         ld      [Alloc_limit], %g1
         sub     Alloc_ptr, %g2, Alloc_ptr
@@ -376,6 +374,16 @@ Caml_callback3_exn:
         b       L108
         or      %l2, %lo(Caml_apply3), %l2
 
+#ifndef SYS_solaris
+/* Glue code to call [caml_array_bound_error] */
+
+        .global Caml_ml_array_bound_error
+Caml_ml_array_bound_error:
+        Address(Caml_array_bound_error, %g2)
+        b       Caml_c_call
+        nop
+#endif
+
 #ifdef SYS_solaris
         .section ".rodata"
 #else
diff --git a/asmrun/stack.h b/asmrun/stack.h
index dd70690994..a287119834 100644
--- a/asmrun/stack.h
+++ b/asmrun/stack.h
@@ -20,38 +20,38 @@
 
 /* Macros to access the stack frame */
 #ifdef TARGET_alpha
-#define Saved_return_address(sp) *((long *)((sp) - 8))
+#define Saved_return_address(sp) *((intnat *)((sp) - 8))
 #define Already_scanned(sp, retaddr) ((retaddr) & 1L)
-#define Mark_scanned(sp, retaddr) (*((long *)((sp) - 8)) = (retaddr) | 1L)
+#define Mark_scanned(sp, retaddr) (*((intnat *)((sp) - 8)) = (retaddr) | 1L)
 #define Mask_already_scanned(retaddr) ((retaddr) & ~1L)
 #define Callback_link(sp) ((struct caml_context *)((sp) + 16))
 #endif
 
 #ifdef TARGET_sparc
-#define Saved_return_address(sp) *((long *)((sp) + 92))
+#define Saved_return_address(sp) *((intnat *)((sp) + 92))
 #define Callback_link(sp) ((struct caml_context *)((sp) + 104))
 #endif
 
 #ifdef TARGET_i386
-#define Saved_return_address(sp) *((long *)((sp) - 4))
+#define Saved_return_address(sp) *((intnat *)((sp) - 4))
 #define Callback_link(sp) ((struct caml_context *)((sp) + 8))
 #endif
 
 #ifdef TARGET_mips
-#define Saved_return_address(sp) *((long *)((sp) - 4))
+#define Saved_return_address(sp) *((intnat *)((sp) - 4))
 #define Callback_link(sp) ((struct caml_context *)((sp) + 16))
 #endif
 
 #ifdef TARGET_hppa
 #define Stack_grows_upwards
-#define Saved_return_address(sp) *((long *)(sp))
+#define Saved_return_address(sp) *((intnat *)(sp))
 #define Callback_link(sp) ((struct caml_context *)((sp) - 24))
 #endif
 
 #ifdef TARGET_power
-#define Saved_return_address(sp) *((long *)((sp) - 4))
+#define Saved_return_address(sp) *((intnat *)((sp) - 4))
 #define Already_scanned(sp, retaddr) ((retaddr) & 1)
-#define Mark_scanned(sp, retaddr) (*((long *)((sp) - 4)) = (retaddr) | 1)
+#define Mark_scanned(sp, retaddr) (*((intnat *)((sp) - 4)) = (retaddr) | 1)
 #define Mask_already_scanned(retaddr) ((retaddr) & ~1)
 #ifdef SYS_aix
 #define Trap_frame_size 32
@@ -62,25 +62,25 @@
 #endif
 
 #ifdef TARGET_m68k
-#define Saved_return_address(sp) *((long *)((sp) - 4))
+#define Saved_return_address(sp) *((intnat *)((sp) - 4))
 #define Callback_link(sp) ((struct caml_context *)((sp) + 8))
 #endif
 
 #ifdef TARGET_arm
-#define Saved_return_address(sp) *((long *)((sp) - 4))
+#define Saved_return_address(sp) *((intnat *)((sp) - 4))
 #define Callback_link(sp) ((struct caml_context *)((sp) + 8))
 #endif
 
 #ifdef TARGET_ia64
-#define Saved_return_address(sp) *((long *)((sp) + 8))
+#define Saved_return_address(sp) *((intnat *)((sp) + 8))
 #define Already_scanned(sp, retaddr) ((retaddr) & 1L)
-#define Mark_scanned(sp, retaddr) (*((long *)((sp) + 8)) = (retaddr) | 1L)
+#define Mark_scanned(sp, retaddr) (*((intnat *)((sp) + 8)) = (retaddr) | 1L)
 #define Mask_already_scanned(retaddr) ((retaddr) & ~1L)
 #define Callback_link(sp) ((struct caml_context *)((sp) + 32))
 #endif
 
 #ifdef TARGET_amd64
-#define Saved_return_address(sp) *((long *)((sp) - 8))
+#define Saved_return_address(sp) *((intnat *)((sp) - 8))
 #define Callback_link(sp) ((struct caml_context *)((sp) + 16))
 #endif
 
@@ -88,18 +88,18 @@
 
 struct caml_context {
   char * bottom_of_stack;       /* beginning of Caml stack chunk */
-  unsigned long last_retaddr;   /* last return address in Caml code */
+  uintnat last_retaddr;         /* last return address in Caml code */
   value * gc_regs;              /* pointer to register block */
 };
 
 /* Declaration of variables used in the asm code */
 extern char * caml_bottom_of_stack;
-extern unsigned long caml_last_return_address;
+extern uintnat caml_last_return_address;
 extern value * caml_gc_regs;
 extern char * caml_exception_pointer;
 extern value caml_globals[];
-extern long caml_globals_inited;
-extern long * caml_frametable[];
+extern intnat caml_globals_inited;
+extern intnat * caml_frametable[];
 
 
 #endif /* CAML_STACK_H */
diff --git a/asmrun/startup.c b/asmrun/startup.c
index 576c2c56c8..44aab0ccf5 100644
--- a/asmrun/startup.c
+++ b/asmrun/startup.c
@@ -64,12 +64,12 @@ static void init_atoms(void)
 
 /* Configuration parameters and flags */
 
-static unsigned long percent_free_init = Percent_free_def;
-static unsigned long max_percent_free_init = Max_percent_free_def;
-static unsigned long minor_heap_init = Minor_heap_def;
-static unsigned long heap_chunk_init = Heap_chunk_def;
-static unsigned long heap_size_init = Init_heap_def;
-static unsigned long max_stack_init = Max_stack_def;
+static uintnat percent_free_init = Percent_free_def;
+static uintnat max_percent_free_init = Max_percent_free_def;
+static uintnat minor_heap_init = Minor_heap_def;
+static uintnat heap_chunk_init = Heap_chunk_def;
+static uintnat heap_size_init = Init_heap_def;
+static uintnat max_stack_init = Max_stack_def;
 
 /* Parse the CAMLRUNPARAM variable */
 /* The option letter for each runtime option is the first letter of the
@@ -80,14 +80,18 @@ static unsigned long max_stack_init = Max_stack_def;
 
 /* If you change these functions, see also their copy in byterun/startup.c */
 
-static void scanmult (char *opt, long unsigned int *var)
+static void scanmult (char *opt, uintnat *var)
 {
   char mult = ' ';
-  sscanf (opt, "=%lu%c", var, &mult);
-  sscanf (opt, "=0x%lx%c", var, &mult);
-  if (mult == 'k') *var = *var * 1024;
-  if (mult == 'M') *var = *var * (1024 * 1024);
-  if (mult == 'G') *var = *var * (1024 * 1024 * 1024);
+  int val;
+  sscanf (opt, "=%u%c", &val, &mult);
+  sscanf (opt, "=0x%x%c", &val, &mult);
+  switch (mult) {
+  case 'k':   *var = (uintnat) val * 1024; break;
+  case 'M':   *var = (uintnat) val * 1024 * 1024; break;
+  case 'G':   *var = (uintnat) val * 1024 * 1024 * 1024; break;
+  default:    *var = (uintnat) val; break;
+  }
 }
 
 static void parse_camlrunparam(void)
diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml
index 01156f4384..65e51dcbcf 100644
--- a/bytecomp/bytegen.ml
+++ b/bytecomp/bytegen.ml
@@ -146,7 +146,7 @@ let rec size_of_lambda = function
 let copy_event ev kind info repr =
   { ev_pos = 0;                   (* patched in emitcode *)
     ev_module = ev.ev_module;
-    ev_char = ev.ev_char;
+    ev_loc = ev.ev_loc;
     ev_kind = kind;
     ev_info = info;
     ev_typenv = ev.ev_typenv;
@@ -686,7 +686,7 @@ let rec comp_expr env exp sz cont =
       let event kind info =
         { ev_pos = 0;                   (* patched in emitcode *)
           ev_module = !compunit_name;
-          ev_char = lev.lev_pos;
+          ev_loc = lev.lev_loc;
           ev_kind = kind;
           ev_info = info;
           ev_typenv = lev.lev_env;
diff --git a/bytecomp/dllpath.ml b/bytecomp/dllpath.ml
deleted file mode 100644
index f0626a871b..0000000000
--- a/bytecomp/dllpath.ml
+++ /dev/null
@@ -1,59 +0,0 @@
-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 2001 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id$ *)
-
-(* Handling of load path for dynamically-linked libraries *)
-
-(* Read the [ld.conf] file and return the corresponding list of directories *)
-
-let ld_conf_contents () =
-  let path = ref [] in
-  begin try
-    let ic = open_in (Filename.concat Config.standard_library "ld.conf") in
-    begin try
-      while true do
-        path := input_line ic :: !path
-      done
-    with End_of_file -> ()
-    end;
-    close_in ic
-  with Sys_error _ -> ()
-  end;
-  List.rev !path
-
-(* Split the CAML_LD_LIBRARY_PATH environment variable and return
-   the corresponding list of directories.  *)
-
-let split str sep =
-  let rec split_rec pos =
-    if pos >= String.length str then [] else begin
-      try
-        let newpos = String.index_from str pos sep in
-        String.sub str pos (newpos - pos) ::
-        split_rec (newpos + 1)
-      with Not_found ->
-        [String.sub str pos (String.length str - pos)]
-    end in
-  split_rec 0
-
-let ld_library_path_contents () =
-  let path_separator =
-    match Sys.os_type with
-      "Unix" | "Cygwin" -> ':' | "Win32" -> ';' | _ -> assert false in
-  try
-    split (Sys.getenv "CAML_LD_LIBRARY_PATH") path_separator
-  with Not_found ->
-    []
-
-let split_dll_path path =
-  split path '\000'
diff --git a/bytecomp/dllpath.mli b/bytecomp/dllpath.mli
deleted file mode 100644
index 496fbf4974..0000000000
--- a/bytecomp/dllpath.mli
+++ /dev/null
@@ -1,25 +0,0 @@
-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 2001 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id$ *)
-
-(* Handling of load path for dynamically-linked libraries *)
-
-(* Read the [ld.conf] file and return the corresponding list of directories *)
-val ld_conf_contents: unit -> string list
-
-(* Split the CAML_LD_LIBRARY_PATH environment variable and return
-   the corresponding list of directories *)
-val ld_library_path_contents: unit -> string list
-
-(* Split the given 0-separated path *)
-val split_dll_path: string -> string list
diff --git a/bytecomp/instruct.ml b/bytecomp/instruct.ml
index fd13db5d7a..9fd2cb9409 100644
--- a/bytecomp/instruct.ml
+++ b/bytecomp/instruct.ml
@@ -22,7 +22,7 @@ type compilation_env =
 type debug_event =
   { mutable ev_pos: int;                (* Position in bytecode *)
     ev_module: string;                  (* Name of defining module *)
-    ev_char: Lexing.position;           (* Position in source file *)
+    ev_loc: Location.t;                 (* Location in source file *)
     ev_kind: debug_event_kind;          (* Before/after event *)
     ev_info: debug_event_info;          (* Extra information *)
     ev_typenv: Env.summary;             (* Typing environment *)
diff --git a/bytecomp/instruct.mli b/bytecomp/instruct.mli
index fdedd8fd47..b7dbd7e3ba 100644
--- a/bytecomp/instruct.mli
+++ b/bytecomp/instruct.mli
@@ -23,7 +23,7 @@ type compilation_env =
     ce_heap: int Ident.tbl;  (* Structure of the heap-allocated env *)
     ce_rec: int Ident.tbl }  (* Functions bound by the same let rec *)
 
-(* The ce_stack component gives locations of variables residing 
+(* The ce_stack component gives locations of variables residing
    in the stack. The locations are offsets w.r.t. the origin of the
    stack frame.
    The ce_heap component gives the positions of variables residing in the
@@ -39,7 +39,7 @@ type compilation_env =
 type debug_event =
   { mutable ev_pos: int;                (* Position in bytecode *)
     ev_module: string;                  (* Name of defining module *)
-    ev_char: Lexing.position;           (* Position in source file *)
+    ev_loc: Location.t;                 (* Location in source file *)
     ev_kind: debug_event_kind;          (* Before/after event *)
     ev_info: debug_event_info;          (* Extra information *)
     ev_typenv: Env.summary;             (* Typing environment *)
diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml
index dfc26721e0..3a2fe60c18 100644
--- a/bytecomp/lambda.ml
+++ b/bytecomp/lambda.ml
@@ -96,7 +96,7 @@ and bigarray_kind =
   | Pbigarray_float32 | Pbigarray_float64
   | Pbigarray_sint8 | Pbigarray_uint8
   | Pbigarray_sint16 | Pbigarray_uint16
-  | Pbigarray_int32 | Pbigarray_int64 
+  | Pbigarray_int32 | Pbigarray_int64
   | Pbigarray_caml_int | Pbigarray_native_int
   | Pbigarray_complex32 | Pbigarray_complex64
 
@@ -110,6 +110,7 @@ type structured_constant =
   | Const_pointer of int
   | Const_block of int * structured_constant list
   | Const_float_array of string list
+  | Const_immstring of string
 
 type function_kind = Curried | Tupled
 
@@ -148,7 +149,7 @@ and lambda_switch =
     sw_failaction : lambda option}
 
 and lambda_event =
-  { lev_pos: Lexing.position;
+  { lev_loc: Location.t;
     lev_kind: lambda_event_kind;
     lev_repr: int ref option;
     lev_env: Env.summary }
@@ -163,10 +164,6 @@ let const_unit = Const_pointer 0
 
 let lambda_unit = Lconst const_unit
 
-let lambda_int i = Lconst (Const_base (Const_int i))
-
-let lambda_string s = Lconst (Const_base (Const_string s))
-
 let rec same l1 l2 =
   match (l1, l2) with
   | Lvar v1, Lvar v2 ->
@@ -205,7 +202,7 @@ let rec same l1 l2 =
   | Lsend(k1, a1, b1, cl1), Lsend(k2, a2, b2, cl2) ->
       k1 = k2 && same a1 a2 && same b1 b2 && samelist same cl1 cl2
   | Levent(a1, ev1), Levent(a2, ev2) ->
-      same a1 a2 && ev1.lev_pos = ev2.lev_pos
+      same a1 a2 && ev1.lev_loc = ev2.lev_loc
   | Lifused(id1, a1), Lifused(id2, a2) ->
       Ident.same id1 id2 && same a1 a2
   | _, _ ->
@@ -240,63 +237,88 @@ let name_lambda_list args fn =
       Llet(Strict, id, arg, name_list (Lvar id :: names) rem) in
   name_list [] args
 
-module IdentSet =
-  Set.Make(struct
-    type t = Ident.t
-    let compare = compare
-  end)
-
-let free_variables l =
-  let fv = ref IdentSet.empty in
-  let rec freevars = function
-    Lvar id ->
-      fv := IdentSet.add id !fv
-  | Lconst sc -> ()
+let rec iter f = function
+    Lvar _
+  | Lconst _ -> ()
   | Lapply(fn, args) ->
-      freevars fn; List.iter freevars args
+      f fn; List.iter f args
   | Lfunction(kind, params, body) ->
-      freevars body;
-      List.iter (fun param -> fv := IdentSet.remove param !fv) params
+      f body
   | Llet(str, id, arg, body) ->
-      freevars arg; freevars body; fv := IdentSet.remove id !fv
+      f arg; f body
   | Lletrec(decl, body) ->
-      freevars body;
-      List.iter (fun (id, exp) -> freevars exp) decl;
-      List.iter (fun (id, exp) -> fv := IdentSet.remove id !fv) decl
+      f body;
+      List.iter (fun (id, exp) -> f exp) decl
   | Lprim(p, args) ->
-      List.iter freevars args
+      List.iter f args
   | Lswitch(arg, sw) ->
-      freevars arg; 
-      List.iter (fun (key, case) -> freevars case) sw.sw_consts;
-      List.iter (fun (key, case) -> freevars case) sw.sw_blocks;
+      f arg; 
+      List.iter (fun (key, case) -> f case) sw.sw_consts;
+      List.iter (fun (key, case) -> f case) sw.sw_blocks;
       begin match sw.sw_failaction with
       | None -> ()
-      | Some l -> freevars l
+      | Some l -> f l
       end
   | Lstaticraise (_,args) ->
-      List.iter freevars args
+      List.iter f args
   | Lstaticcatch(e1, (_,vars), e2) ->
-      freevars e1; freevars e2 ;
-      List.iter (fun id -> fv := IdentSet.remove id !fv) vars        
+      f e1; f e2
   | Ltrywith(e1, exn, e2) ->
-      freevars e1; freevars e2; fv := IdentSet.remove exn !fv
+      f e1; f e2
   | Lifthenelse(e1, e2, e3) ->
-      freevars e1; freevars e2; freevars e3
+      f e1; f e2; f e3
   | Lsequence(e1, e2) ->
-      freevars e1; freevars e2
+      f e1; f e2
   | Lwhile(e1, e2) ->
-      freevars e1; freevars e2
-  | Lfor(v, e1, e2, dir, e3) -> 
-      freevars e1; freevars e2; freevars e3; fv := IdentSet.remove v !fv
+      f e1; f e2
+  | Lfor(v, e1, e2, dir, e3) ->
+      f e1; f e2; f e3
   | Lassign(id, e) ->
-      fv := IdentSet.add id !fv; freevars e
+      f e
   | Lsend (k, met, obj, args) ->
-      List.iter freevars (met::obj::args)
+      List.iter f (met::obj::args)
   | Levent (lam, evt) ->
-      freevars lam
+      f lam
   | Lifused (v, e) ->
-      freevars e
-  in freevars l; !fv
+      f e
+
+module IdentSet =
+  Set.Make(struct
+    type t = Ident.t
+    let compare = compare
+  end)
+
+let free_ids get l =
+  let fv = ref IdentSet.empty in
+  let rec free l =
+    iter free l;
+    fv := List.fold_right IdentSet.add (get l) !fv;
+    match l with
+      Lfunction(kind, params, body) ->
+        List.iter (fun param -> fv := IdentSet.remove param !fv) params
+    | Llet(str, id, arg, body) ->
+        fv := IdentSet.remove id !fv
+    | Lletrec(decl, body) ->
+        List.iter (fun (id, exp) -> fv := IdentSet.remove id !fv) decl
+    | Lstaticcatch(e1, (_,vars), e2) ->
+        List.iter (fun id -> fv := IdentSet.remove id !fv) vars
+    | Ltrywith(e1, exn, e2) ->
+        fv := IdentSet.remove exn !fv
+    | Lfor(v, e1, e2, dir, e3) ->
+        fv := IdentSet.remove v !fv
+    | Lassign(id, e) ->
+        fv := IdentSet.add id !fv
+    | Lvar _ | Lconst _ | Lapply _
+    | Lprim _ | Lswitch _ | Lstaticraise _
+    | Lifthenelse _ | Lsequence _ | Lwhile _
+    | Lsend _ | Levent _ | Lifused _ -> ()
+  in free l; !fv
+
+let free_variables l =
+  free_ids (function Lvar id -> [id] | _ -> []) l
+
+let free_methods l =
+  free_ids (function Lsend(Self, Lvar meth, obj, _) -> [meth] | _ -> []) l
 
 (* Check if an action has a "when" guard *)
 let raise_count = ref 0
@@ -365,14 +387,14 @@ let subst_lambda s lam =
                          match sw.sw_failaction with
                          | None -> None
                          | Some l -> Some (subst l)})
-                   
+
   | Lstaticraise (i,args) ->  Lstaticraise (i, List.map subst args)
   | Lstaticcatch(e1, io, e2) -> Lstaticcatch(subst e1, io, subst e2)
   | Ltrywith(e1, exn, e2) -> Ltrywith(subst e1, exn, subst e2)
   | Lifthenelse(e1, e2, e3) -> Lifthenelse(subst e1, subst e2, subst e3)
   | Lsequence(e1, e2) -> Lsequence(subst e1, subst e2)
   | Lwhile(e1, e2) -> Lwhile(subst e1, subst e2)
-  | Lfor(v, e1, e2, dir, e3) -> Lfor(v, subst e1, subst e2, dir, subst e3) 
+  | Lfor(v, e1, e2, dir, e3) -> Lfor(v, subst e1, subst e2, dir, subst e3)
   | Lassign(id, e) -> Lassign(id, subst e)
   | Lsend (k, met, obj, args) ->
       Lsend (k, subst met, subst obj, List.map subst args)
diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli
index 6709c87d9f..0aa6412fb0 100644
--- a/bytecomp/lambda.mli
+++ b/bytecomp/lambda.mli
@@ -110,6 +110,7 @@ type structured_constant =
   | Const_pointer of int
   | Const_block of int * structured_constant list
   | Const_float_array of string list
+  | Const_immstring of string
 
 type function_kind = Curried | Tupled
 
@@ -156,7 +157,7 @@ and lambda_switch =
     sw_blocks: (int * lambda) list;     (* Tag block cases *)
     sw_failaction : lambda option}      (* Action to take if failure *)
 and lambda_event =
-  { lev_pos: Lexing.position;
+  { lev_loc: Location.t;
     lev_kind: lambda_event_kind;
     lev_repr: int ref option;
     lev_env: Env.summary }
@@ -169,16 +170,15 @@ and lambda_event_kind =
 val same: lambda -> lambda -> bool
 val const_unit: structured_constant
 val lambda_unit: lambda
-val lambda_int : int -> lambda
-val lambda_string : string -> lambda
-
 val name_lambda: lambda -> (Ident.t -> lambda) -> lambda
 val name_lambda_list: lambda list -> (lambda list -> lambda) -> lambda
 val is_guarded: lambda -> bool
 val patch_guarded : lambda -> lambda -> lambda
 
+val iter: (lambda -> unit) -> lambda -> unit
 module IdentSet: Set.S with type elt = Ident.t
 val free_variables: lambda -> IdentSet.t
+val free_methods: lambda -> IdentSet.t
 
 val transl_path: Path.t -> lambda
 val make_sequence: ('a -> lambda) -> 'a list -> lambda
@@ -200,8 +200,8 @@ val next_raise_count : unit -> int
 val staticfail : lambda (* Anticipated static failure *)
 
 (* Check anticipated failure, substitute its final value *)
-val is_guarded: lambda -> bool 
-val patch_guarded : lambda -> lambda -> lambda 
+val is_guarded: lambda -> bool
+val patch_guarded : lambda -> lambda -> lambda
 
 (*>JOCAML*)
 (* Get a runtime location, ie a tuple (filename, line, pos) *)
diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml
index 64d0b9e75f..330e91f867 100644
--- a/bytecomp/matching.ml
+++ b/bytecomp/matching.ml
@@ -101,8 +101,12 @@ let  rshift_num n {left=left ; right=right} =
 
 let ctx_rshift_num n ctx = List.map (rshift_num n) ctx
 
+(* Recombination of contexts (eg: (_,_)::p1::p2::rem ->  (p1,p2)::rem)
+  All mutable fields are replaced by '_', since side-effects in
+  guards can alter these fields *)
+
 let combine {left=left ; right=right} = match left with
-| p::ps -> {left=ps ; right=set_args p right}
+| p::ps -> {left=ps ; right=set_args_erase_mutable p right}
 | _ -> assert false
 
 let ctx_combine ctx = List.map combine ctx
@@ -376,11 +380,11 @@ let pretty_cases cases =
           prerr_string " " ;
           prerr_string (Format.flush_str_formatter ()))
         ps ;
-
+(*
       prerr_string " -> " ;
       Printlambda.lambda Format.str_formatter l ;
       prerr_string (Format.flush_str_formatter ()) ;
-
+*)
       prerr_endline "")
     cases
 
@@ -1075,7 +1079,7 @@ let rec matcher_const cst p rem = match p.pat_desc with
 | _ -> raise NoMatch
 
 let get_key_constant caller = function
-  | {pat_desc= Tpat_constant cst} as p -> cst
+  | {pat_desc= Tpat_constant cst} -> cst
   | p ->
       prerr_endline ("BAD: "^caller) ;
       pretty_pat p ;
@@ -1241,7 +1245,7 @@ let get_key_variant p = match p.pat_desc with
 | Tpat_variant(lab, None , _) -> Cstr_constant (Btype.hash_variant lab)
 |  _ -> assert false
 
-let divide_variant row ctx ({cases = cl; args = al; default=def} as pm) =
+let divide_variant row ctx {cases = cl; args = al; default=def} =
   let row = Btype.row_repr row in
   let rec divide = function
       ({pat_desc = Tpat_variant(lab, pato, _)} as p:: patl, action) :: rem ->
@@ -1486,7 +1490,7 @@ let as_int_list cases acts =
   let default = max_vals cases acts in
   let min_key,_,_ = cases.(0)
   and _,max_key,_ = cases.(Array.length cases-1) in
-  let offset = max_key-min_key in
+
   let rec do_rec i k =
     if i >= 0 then
       let low, high, act =  cases.(i) in
@@ -1636,7 +1640,7 @@ let as_interval_canfail fail low high l =
 
   let rec init_rec = function
     | [] -> []
-    | (i,act_i)::rem as all ->
+    | (i,act_i)::rem ->
         let index = store.act_store act_i in
         if index=0 then
           fail_rec low i rem
@@ -1795,6 +1799,7 @@ let mk_failaction_neg partial ctx def = match partial with
     end
 | Total ->
     None, [], jumps_empty
+
       
       
 (* Conforme a l'article et plus simple qu'avant *)
@@ -1894,7 +1899,6 @@ let combine_constructor arg ex_pat cstr partial ctx def
     (tag_lambda_list, total1, pats) =
   if cstr.cstr_consts < 0 then begin
     (* Special cases for exceptions *)    
-    let cstrs = List.map fst tag_lambda_list in
     let fail, to_add, local_jumps =
       mk_failaction_neg partial ctx def in
     let tag_lambda_list = to_add@tag_lambda_list in
@@ -1921,8 +1925,7 @@ let combine_constructor arg ex_pat cstr partial ctx def
     (* Regular concrete type *)
     let ncases = List.length tag_lambda_list
     and nconstrs =  cstr.cstr_consts + cstr.cstr_nonconsts in
-    let sig_complete = ncases = nconstrs
-    and cstrs = List.map fst tag_lambda_list in
+    let sig_complete = ncases = nconstrs in
     let fails,local_jumps =
       if sig_complete then [],jumps_empty
       else
@@ -1998,7 +2001,9 @@ let combine_variant row arg partial ctx def (tag_lambda_list, total1, pats) =
   let sig_complete =  List.length tag_lambda_list = !num_constr
   and one_action = same_actions tag_lambda_list in
   let fail, to_add, local_jumps =
-    if sig_complete || (match partial with Total -> true | _ -> false) then
+    if
+      sig_complete  || (match partial with Total -> true | _ -> false)
+    then
       None, [], jumps_empty
     else
       mk_failaction_neg partial ctx def in
@@ -2055,7 +2060,7 @@ let rec event_branch repr lam =
       lam
   | (Levent(lam', ev), Some r) ->
       incr r;
-      Levent(lam', {lev_pos = ev.lev_pos;
+      Levent(lam', {lev_loc = ev.lev_loc;
                     lev_kind = ev.lev_kind;
                     lev_repr = repr;
                     lev_env = ev.lev_env})
@@ -2299,7 +2304,6 @@ and do_compile_matching_pr repr partial ctx arg x =
   pretty_jumps jumps ;    
   r
 *)
-
 and do_compile_matching repr partial ctx arg pmh = match pmh with
 | Pm pm ->
   let pat = what_is_cases pm.cases in
@@ -2356,8 +2360,23 @@ and compile_no_test divide up_ctx repr partial ctx to_match =
 
 (* The entry points *)
 
+(*
+   If there is a guard in a matching, then
+   set exhaustiveness info to Partial.
+   (because of side effects in guards, assume the worst)
+*)
+
+let check_partial pat_act_list partial =
+  if
+    List.exists
+      (fun (_,lam) -> is_guarded lam)
+       pat_act_list
+  then begin
+    Partial 
+  end else
+    partial
 
-(* had toplevel handler when appropriate *)
+(* have toplevel handler when appropriate *)
 
 let start_ctx n = [{left=[] ; right = omegas n}]
 
@@ -2369,6 +2388,7 @@ let check_total total lambda i handler_fun =
   end
 
 let compile_matching loc repr handler_fun arg pat_act_list partial =
+  let partial = check_partial pat_act_list partial in
   match partial with
   | Partial ->
       let raise_num = next_raise_count () in
@@ -2380,7 +2400,7 @@ let compile_matching loc repr handler_fun arg pat_act_list partial =
         let (lambda, total) = compile_match repr partial (start_ctx 1) pm in
         check_total total lambda raise_num handler_fun
       with
-      | Unused -> assert false ; handler_fun()
+      | Unused -> assert false (* ; handler_fun() *)
       end
   | Total ->
       let pm =
@@ -2391,6 +2411,7 @@ let compile_matching loc repr handler_fun arg pat_act_list partial =
       assert (jumps_is_empty total) ;
       lambda
 
+
 let partial_function loc () =
   (* [Location.get_pos_info] is too expensive *)
   let fname = match loc.Location.loc_start.Lexing.pos_fname with
@@ -2426,6 +2447,7 @@ let for_let (handler,loc) param pat body =
 
 (* Easy case since variables are available *)
 let for_tupled_function loc paraml pats_act_list partial =
+  let partial = check_partial pats_act_list partial in
   let raise_num = next_raise_count () in
   let omegas = [List.map (fun _ -> omega) paraml] in
   let pm =
@@ -2443,7 +2465,7 @@ let for_tupled_function loc paraml pats_act_list partial =
 
 
 let flatten_pattern size p = match p.pat_desc with
-|  Tpat_tuple args -> args
+| Tpat_tuple args -> args
 | Tpat_any -> omegas size  
 | _ -> raise Cannot_flatten
 
@@ -2451,6 +2473,9 @@ let rec flatten_pat_line size p k = match p.pat_desc with
 | Tpat_any ->  omegas size::k
 | Tpat_tuple args -> args::k
 | Tpat_or (p1,p2,_) ->  flatten_pat_line size p1 (flatten_pat_line size p2 k)
+| Tpat_alias (p,_) -> (* Note: if this 'as' pat is here, then this is a useless
+                         binding, solves PR #3780 *)
+    flatten_pat_line size p k
 | _ -> fatal_error "Matching.flatten_pat_line"
 
 let flatten_cases size cases =
@@ -2461,7 +2486,7 @@ let flatten_cases size cases =
     cases
 
 let flatten_matrix size pss =
- List.fold_right
+  List.fold_right
     (fun ps r -> match ps with
     | [p] -> flatten_pat_line size p r
     | _   -> fatal_error "Matching.flatten_matrix")
@@ -2503,6 +2528,7 @@ let compile_flattened repr partial ctx _ pmh = match pmh with
 
 let for_multiple_match (handler, loc) paraml pat_act_list partial =
   let repr = None in
+  let partial = check_partial pat_act_list partial in
   let raise_num,pm1 =
     match partial with
     | Partial ->
@@ -2544,8 +2570,6 @@ let for_multiple_match (handler, loc) paraml pat_act_list partial =
         | Total ->
             assert (jumps_is_empty total) ;
             lam)
-        
-
     with Cannot_flatten ->
       let (lambda, total) = compile_match None partial (start_ctx 1) pm1 in
       begin match partial with
@@ -2557,5 +2581,5 @@ let for_multiple_match (handler, loc) paraml pat_act_list partial =
           lambda
       end
   with Unused ->
-    assert false ; partial_function loc ()
+    assert false (* ; partial_function loc () *)
 
diff --git a/bytecomp/printinstr.ml b/bytecomp/printinstr.ml
index a7c859d847..2f0508b299 100644
--- a/bytecomp/printinstr.ml
+++ b/bytecomp/printinstr.ml
@@ -99,8 +99,10 @@ let instruction ppf = function
   | Kgetpubmet n -> fprintf ppf "\tgetpubmet %i" n
   | Kgetdynmet -> fprintf ppf "\tgetdynmet"
   | Kstop -> fprintf ppf "\tstop"
-  | Kevent ev -> fprintf ppf "\tevent \"%s\" %i" ev.ev_char.Lexing.pos_fname
-                                                 ev.ev_char.Lexing.pos_cnum
+  | Kevent ev -> fprintf ppf "\tevent \"%s\" %i-%i"
+                         ev.ev_loc.Location.loc_start.Lexing.pos_fname
+                         ev.ev_loc.Location.loc_start.Lexing.pos_cnum
+                         ev.ev_loc.Location.loc_end.Lexing.pos_cnum
 
 let rec instruction_list ppf = function
     [] -> ()
@@ -108,6 +110,6 @@ let rec instruction_list ppf = function
       fprintf ppf "L%i:%a" lbl instruction_list il
   | instr :: il ->
       fprintf ppf "%a@ %a" instruction instr instruction_list il
- 
+
 let instrlist ppf il =
   fprintf ppf "@[<v 0>%a@]" instruction_list il
diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml
index fb129ffb75..27c0ff3d55 100644
--- a/bytecomp/printlambda.ml
+++ b/bytecomp/printlambda.ml
@@ -23,6 +23,7 @@ let rec struct_const ppf = function
   | Const_base(Const_int n) -> fprintf ppf "%i" n
   | Const_base(Const_char c) -> fprintf ppf "%C" c
   | Const_base(Const_string s) -> fprintf ppf "%S" s
+  | Const_immstring s -> fprintf ppf "#%S" s
   | Const_base(Const_float f) -> fprintf ppf "%s" f
   | Const_base(Const_int32 n) -> fprintf ppf "%lil" n
   | Const_base(Const_int64 n) -> fprintf ppf "%LiL" n
@@ -172,12 +173,6 @@ let primitive ppf = function
   | Pbigarrayref(n, kind, layout) -> print_bigarray "get" kind ppf layout
   | Pbigarrayset(n, kind, layout) -> print_bigarray "set" kind ppf layout
 
-let pstr = function
-  | Strict -> "S"
-  | StrictOpt -> "SO"
-  | Alias -> "A"
-  | Variable -> "V"
-
 let rec lam ppf = function
   | Lvar id ->
       Ident.print ppf id
@@ -205,12 +200,10 @@ let rec lam ppf = function
   | Llet(str, id, arg, body) ->
       let rec letbody = function
         | Llet(str, id, arg, body) ->
-            fprintf ppf "@ @[<2>%a(%s)@ %a@]"
-              Ident.print id (pstr str) lam arg;
+            fprintf ppf "@ @[<2>%a@ %a@]" Ident.print id lam arg;
             letbody body
         | expr -> expr in
-      fprintf ppf "@[<2>(let@ @[<hv 1>(@[<2>%a(%s)@ %a@]"
-        Ident.print id (pstr str) lam arg;
+      fprintf ppf "@[<2>(let@ @[<hv 1>(@[<2>%a@ %a@]" Ident.print id lam arg;
       let expr = letbody body in
       fprintf ppf ")@]@ %a)@]" lam expr
   | Lletrec(id_arg_list, body) ->
@@ -289,12 +282,15 @@ let rec lam ppf = function
         if k = Self then "self" else if k = Cached then "cache" else "" in
       fprintf ppf "@[<2>(send%s@ %a@ %a%a)@]" kind lam obj lam met args largs
   | Levent(expr, ev) ->
-      let kind = 
+      let kind =
        match ev.lev_kind with
        | Lev_before -> "before"
        | Lev_after _  -> "after"
        | Lev_function -> "funct-body" in
-      fprintf ppf "@[<2>(%s %i@ %a)@]" kind ev.lev_pos.Lexing.pos_cnum lam expr
+      fprintf ppf "@[<2>(%s %i-%i@ %a)@]" kind
+              ev.lev_loc.Location.loc_start.Lexing.pos_cnum
+              ev.lev_loc.Location.loc_end.Lexing.pos_cnum
+              lam expr
   | Lifused(id, expr) ->
       fprintf ppf "@[<2>(ifused@ %a@ %a)@]" Ident.print id lam expr
 
diff --git a/bytecomp/simplif.ml b/bytecomp/simplif.ml
index 126aa7772a..ee59cab742 100644
--- a/bytecomp/simplif.ml
+++ b/bytecomp/simplif.ml
@@ -370,7 +370,7 @@ let simplify_lets lam =
   | Llet(StrictOpt, v, l1, l2) ->
       begin match count_var v with
         0 -> simplif l2
-      | n -> Llet(StrictOpt, v, simplif l1, simplif l2)
+      | n -> Llet(Alias, v, simplif l1, simplif l2)
       end
   | Llet(kind, v, l1, l2) -> Llet(kind, v, simplif l1, simplif l2)
   | Lletrec(bindings, body) ->
diff --git a/bytecomp/switch.ml b/bytecomp/switch.ml
index 38db1d5502..ff58af72e6 100644
--- a/bytecomp/switch.ml
+++ b/bytecomp/switch.ml
@@ -653,7 +653,7 @@ let approx_count cases i j n_actions =
 
 (* Sends back a boolean that says whether is switch is worth or not *)
 
-let dense ({cases=cases ; actions=actions} as s) i j =
+let dense {cases=cases ; actions=actions} i j =
   if i=j then true
   else
     let l,_,_ = cases.(i)
@@ -775,7 +775,6 @@ let make_clusters ({cases=cases ; actions=actions} as s) n_clusters k =
 
   
 let zyva (low,high) konst arg cases actions = 
-  let lcases = Array.length cases in
   let old_ok = !ok_inter in
   ok_inter := (abs low <= inter_limit && abs high <= inter_limit) ;
   if !ok_inter <> old_ok then Hashtbl.clear t ;
diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml
index 4d22e092ab..6a55cabf28 100644
--- a/bytecomp/symtable.ml
+++ b/bytecomp/symtable.ml
@@ -212,6 +212,7 @@ let rec transl_const = function
   | Const_base(Const_int64 i) -> Obj.repr i
   | Const_base(Const_nativeint i) -> Obj.repr i
   | Const_pointer i -> Obj.repr i
+  | Const_immstring s -> Obj.repr s
   | Const_block(tag, fields) ->
       let block = Obj.new_block tag (List.length fields) in
       let pos = ref 0 in
diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml
index e635134cfd..b0eeeacfc2 100644
--- a/bytecomp/translclass.ml
+++ b/bytecomp/translclass.ml
@@ -46,12 +46,12 @@ let lsequence l1 l2 =
 
 let lfield v i = Lprim(Pfield i, [Lvar v])
 
-let transl_label l = share (Const_base (Const_string l))
+let transl_label l = share (Const_immstring l)
 
 let rec transl_meth_list lst =
   if lst = [] then Lconst (Const_pointer 0) else
   share (Const_block
-            (0, List.map (fun lab -> Const_base (Const_string lab)) lst))
+            (0, List.map (fun lab -> Const_immstring lab) lst))
 
 let set_inst_var obj id expr =
   let kind = if Typeopt.maybe_pointer expr then Paddrarray else Pintarray in
@@ -71,35 +71,26 @@ let transl_val tbl create name =
   Lapply (oo_prim (if create then "new_variable" else "get_variable"),
           [Lvar tbl; transl_label name])
 
-let transl_vals tbl create sure vals rem =
-  if create && sure && List.length vals > 1 then
-    let (_,id0) = List.hd vals in
-    let call =
-      Lapply(oo_prim "new_variables",
-	     [Lvar tbl; transl_meth_list (List.map fst vals)]) in
-    let i = ref (List.length vals) in
-    Llet(Strict, id0, call,
-	 List.fold_right
-	   (fun (name,id) rem ->
-	     decr i; Llet(Alias, id, Lprim(Poffsetint !i, [Lvar id0]), rem))
-	   (List.tl vals) rem)
-  else
+let transl_vals tbl create vals rem =
   List.fold_right
     (fun (name, id) rem ->
       Llet(StrictOpt, id, transl_val tbl create name, rem))
     vals rem
 
-let transl_super tbl meths inh_methods rem =
+let meths_super tbl meths inh_meths =
   List.fold_right
     (fun (nm, id) rem ->
-       begin try
-         Llet(StrictOpt, id, Lapply (oo_prim "get_method",
-                                     [Lvar tbl; Lvar (Meths.find nm meths)]),
-              rem)
-       with Not_found ->
-         rem
-       end)
-    inh_methods rem
+       try
+         (nm, id,
+          Lapply(oo_prim "get_method", [Lvar tbl; Lvar (Meths.find nm meths)]))
+         :: rem
+       with Not_found -> rem)
+    inh_meths []
+
+let bind_super tbl (vals, meths) cl_init =
+  transl_vals tbl false vals
+    (List.fold_right (fun (nm, id, def) rem -> Llet(StrictOpt, id, def, rem))
+       meths cl_init)
 
 let create_object cl obj init =
   let obj' = Ident.create "self" in
@@ -217,32 +208,43 @@ let bind_method tbl lab id cl_init =
                               [Lvar tbl; transl_label lab]),
        cl_init)
 
-let bind_methods tbl meths cl_init =
+let bind_methods tbl meths vals cl_init =
   let methl = Meths.fold (fun lab id tl -> (lab,id) :: tl) meths [] in
-  let len = List.length methl in
-  if len < 2 then Meths.fold (bind_method tbl) meths cl_init else
+  let len = List.length methl and nvals = List.length vals in
+  if len < 2 && nvals = 0 then Meths.fold (bind_method tbl) meths cl_init else
+  if len = 0 && nvals < 2 then transl_vals tbl true vals cl_init else
   let ids = Ident.create "ids" in
   let i = ref len in
+  let getter, names, cl_init =
+    match vals with [] -> "get_method_labels", [], cl_init
+    | (_,id0)::vals' ->
+        incr i;
+        let i = ref (List.length vals) in
+        "new_methods_variables",
+        [transl_meth_list (List.map fst vals)],
+        Llet(Strict, id0, lfield ids 0,
+	     List.fold_right
+	       (fun (name,id) rem ->
+	         decr i;
+                 Llet(Alias, id, Lprim(Poffsetint !i, [Lvar id0]), rem))
+	       vals' cl_init)
+  in
   Llet(StrictOpt, ids,
-       Lapply (oo_prim "get_method_labels",
-               [Lvar tbl; transl_meth_list (List.map fst methl)]),
+       Lapply (oo_prim getter,
+               [Lvar tbl; transl_meth_list (List.map fst methl)] @ names),
        List.fold_right
-         (fun (lab,id) lam ->
-           decr i; Llet(StrictOpt, id, Lprim(Pfield !i, [Lvar ids]), lam))
+         (fun (lab,id) lam -> decr i; Llet(StrictOpt, id, lfield ids !i, lam))
          methl cl_init)
 
-let output_methods tbl vals methods lam =
-  let lam =
-    match methods with
-      [] -> lam
-    | [lab; code] ->
-        lsequence (Lapply(oo_prim "set_method", [Lvar tbl; lab; code])) lam
-    | _ ->
-        lsequence (Lapply(oo_prim "set_methods",
-                         [Lvar tbl; Lprim(Pmakeblock(0,Immutable), methods)]))
-          lam
-  in
-  transl_vals tbl true true vals lam
+let output_methods tbl methods lam =
+  match methods with
+    [] -> lam
+  | [lab; code] ->
+      lsequence (Lapply(oo_prim "set_method", [Lvar tbl; lab; code])) lam
+  | _ ->
+      lsequence (Lapply(oo_prim "set_methods",
+                        [Lvar tbl; Lprim(Pmakeblock(0,Immutable), methods)]))
+        lam
 
 let rec ignore_cstrs cl =
   match cl.cl_desc with
@@ -250,7 +252,12 @@ let rec ignore_cstrs cl =
   | Tclass_apply (cl, _) -> ignore_cstrs cl
   | _ -> cl
 
-let rec build_class_init cla cstr inh_init cl_init msubst top cl =
+let rec index a = function
+    [] -> raise Not_found
+  | b :: l ->
+      if b = a then 0 else 1 + index a l
+
+let rec build_class_init cla cstr super inh_init cl_init msubst top cl =
   match cl.cl_desc with
     Tclass_ident path ->
       begin match inh_init with
@@ -260,23 +267,23 @@ let rec build_class_init cla cstr inh_init cl_init msubst top cl =
            Llet (Strict, obj_init, 
                  Lapply(Lprim(Pfield 1, [lpath]), Lvar cla ::
 			if top then [Lprim(Pfield 3, [lpath])] else []),
-                 cl_init))
+                 bind_super cla super cl_init))
       | _ ->
           assert false
       end
   | Tclass_structure str ->
+      let cl_init = bind_super cla super cl_init in
       let (inh_init, cl_init, methods, values) =
         List.fold_right
           (fun field (inh_init, cl_init, methods, values) ->
             match field with
               Cf_inher (cl, vals, meths) ->
-                let cl_init = output_methods cla values methods cl_init in
+                let cl_init = output_methods cla methods cl_init in
                 let inh_init, cl_init =
-                  build_class_init cla false inh_init
-                    (transl_vals cla false false vals
-                       (transl_super cla str.cl_meths meths cl_init))
-                    msubst top cl in
-                (inh_init, cl_init, [], [])
+                  build_class_init cla false
+                    (vals, meths_super cla str.cl_meths meths)
+                    inh_init cl_init msubst top cl in
+                (inh_init, cl_init, [], values)
             | Cf_val (name, id, exp) ->
                 (inh_init, cl_init, methods, (name, id)::values)
             | Cf_meth (name, exp) ->
@@ -291,13 +298,6 @@ let rec build_class_init cla cstr inh_init cl_init msubst top cl =
                 (inh_init, cl_init,
                  Lvar (Meths.find name str.cl_meths) :: met_code @ methods,
                  values)
-                 (*
-                 Lsequence(Lapply (oo_prim ("set_method" ^ builtin),
-                                   Lvar cla ::
-                                   Lvar (Meths.find name str.cl_meths) ::
-                                   met_code),
-                           cl_init))
-                  *)
             | Cf_let (rec_flag, defs, vals) ->
                 let vals =
                   List.map (function (id, _) -> (Ident.name id, id)) vals
@@ -312,43 +312,61 @@ let rec build_class_init cla cstr inh_init cl_init msubst top cl =
           str.cl_field
           (inh_init, cl_init, [], [])
       in
-      let cl_init = output_methods cla values methods cl_init in
-      (inh_init, bind_methods cla str.cl_meths cl_init)
+      let cl_init = output_methods cla methods cl_init in
+      (inh_init, bind_methods cla str.cl_meths values cl_init)
   | Tclass_fun (pat, vals, cl, _) ->
       let (inh_init, cl_init) =
-        build_class_init cla cstr inh_init cl_init msubst top cl
+        build_class_init cla cstr super inh_init cl_init msubst top cl
       in
       let vals = List.map (function (id, _) -> (Ident.name id, id)) vals in
-      (inh_init, transl_vals cla true false vals cl_init)
+      (inh_init, transl_vals cla true vals cl_init)
   | Tclass_apply (cl, exprs) ->
-      build_class_init cla cstr inh_init cl_init msubst top cl
+      build_class_init cla cstr super inh_init cl_init msubst top cl
   | Tclass_let (rec_flag, defs, vals, cl) ->
       let (inh_init, cl_init) =
-        build_class_init cla cstr inh_init cl_init msubst top cl
+        build_class_init cla cstr super inh_init cl_init msubst top cl
       in
       let vals = List.map (function (id, _) -> (Ident.name id, id)) vals in
-      (inh_init, transl_vals cla true false vals cl_init)
+      (inh_init, transl_vals cla true vals cl_init)
   | Tclass_constraint (cl, vals, meths, concr_meths) ->
       let virt_meths =
         List.filter (fun lab -> not (Concr.mem lab concr_meths)) meths in
+      let concr_meths = Concr.elements concr_meths in
       let narrow_args =
 	[Lvar cla;
          transl_meth_list vals;
          transl_meth_list virt_meths;
-         transl_meth_list (Concr.elements concr_meths)] in
+         transl_meth_list concr_meths] in
       let cl = ignore_cstrs cl in
       begin match cl.cl_desc, inh_init with
 	Tclass_ident path, (obj_init, path')::inh_init ->
 	  assert (Path.same path path');
 	  let lpath = transl_path path in
+          let inh = Ident.create "inh"
+          and inh_vals = Ident.create "vals"
+          and inh_meths = Ident.create "meths"
+          and valids, methids = super in
+          let cl_init =
+            List.fold_left
+              (fun init (nm, id, _) ->
+                Llet(StrictOpt, id, lfield inh_meths (index nm concr_meths),
+                     init))
+              cl_init methids in
+          let cl_init =
+            List.fold_left
+              (fun init (nm, id) ->
+                Llet(StrictOpt, id, lfield inh_vals (index nm vals), init))
+              cl_init valids in
           (inh_init,
-           Llet (Strict, obj_init, 
+           Llet (Strict, inh, 
 		 Lapply(oo_prim "inherits", narrow_args @
 			[lpath; Lconst(Const_pointer(if top then 1 else 0))]),
-                 cl_init))
+                 Llet(StrictOpt, obj_init, lfield inh 0,
+                 Llet(Alias, inh_vals, lfield inh 1,
+                 Llet(Alias, inh_meths, lfield inh 2, cl_init)))))
       | _ ->
 	  let core cl_init =
-            build_class_init cla true inh_init cl_init msubst top cl
+            build_class_init cla true super inh_init cl_init msubst top cl
 	  in
 	  if cstr then core cl_init else
           let (inh_init, cl_init) =
@@ -366,6 +384,16 @@ let rec build_class_lets cl =
   | _ ->
       (cl.cl_env, fun x -> x)
 
+let rec get_class_meths cl =
+  match cl.cl_desc with
+    Tclass_structure cl ->
+      Meths.fold (fun _ -> IdentSet.add) cl.cl_meths IdentSet.empty
+  | Tclass_ident _ -> IdentSet.empty
+  | Tclass_fun (_, _, cl, _)
+  | Tclass_let (_, _, _, cl)
+  | Tclass_apply (cl, _)
+  | Tclass_constraint (cl, _, _, _) -> get_class_meths cl
+
 (*
    XXX Il devrait etre peu couteux d'ecrire des classes :
      class c x y = d e f
@@ -426,7 +454,6 @@ let transl_class_rebind ids cl =
 
     let cla = Ident.create "class"
     and new_init = Ident.create "new_init"
-    and arg = Ident.create "arg"
     and env_init = Ident.create "env_init"
     and table = Ident.create "table"
     and envs = Ident.create "envs" in
@@ -478,8 +505,8 @@ let rec builtin_meths self env env2 body =
     | _ -> raise Not_found
   in
   match body with
-  | Llet(Alias, s', Lvar s, body) when List.mem s self ->
-      builtin_meths self env env2 body
+  | Llet(_, s', Lvar s, body) when List.mem s self ->
+      builtin_meths (s'::self) env env2 body
   | Lapply(f, [arg]) when const_path f ->
       let s, args = conv arg in ("app_"^s, f :: args)
   | Lapply(f, [arg; p]) when const_path f && const_path p ->
@@ -504,7 +531,7 @@ let rec builtin_meths self env env2 body =
         | Lprim(Parraysetu _, [Lvar s; Lvar n; Lvar x'])
           when Ident.same x x' && List.mem s self ->
             ("set_var", [Lvar n])
-        | Llet(Alias, s', Lvar s, body) when List.mem s self ->
+        | Llet(_, s', Lvar s, body) when List.mem s self ->
             enter (s'::self) body
         | _ -> raise Not_found
       in enter self body
@@ -579,11 +606,18 @@ let transl_class ids cl_id arity pub_meths cl =
   let cl_env, llets = build_class_lets cl in
   let new_ids = if top then [] else Env.diff top_env cl_env in
   let env2 = Ident.create "env" in
+  let meth_ids = get_class_meths cl in
   let subst env lam i0 new_ids' =
     let fv = free_variables lam in
     let fv = List.fold_right IdentSet.remove !new_ids' fv in
-    let fv =
-      IdentSet.filter (fun id -> List.mem id new_ids) fv in
+    (* IdentSet.iter
+      (fun id ->
+        if not (List.mem id new_ids) then prerr_endline (Ident.name id))
+      fv; *)
+    let fv = IdentSet.filter (fun id -> List.mem id new_ids) fv in
+    (* need to handle methods specially (PR#3576) *)
+    let fm = IdentSet.diff (free_methods lam) meth_ids in
+    let fv = IdentSet.union fv fm in
     new_ids' := !new_ids' @ IdentSet.elements fv;
     let i = ref (i0-1) in
     List.fold_left
@@ -633,8 +667,9 @@ let transl_class ids cl_id arity pub_meths cl =
     build_object_init_0 cla [] cl copy_env subst_env top ids in
   if not (Translcore.check_recursive_lambda ids obj_init) then
     raise(Error(cl.cl_loc, Illegal_class_expr));
+  let inh_init' = List.rev inh_init in
   let (inh_init', cl_init) =
-    build_class_init cla true (List.rev inh_init) obj_init msubst top cl
+    build_class_init cla true ([],[]) inh_init' obj_init msubst top cl
   in
   assert (inh_init' = []);
   let table = Ident.create "table"
@@ -691,8 +726,8 @@ let transl_class ids cl_id arity pub_meths cl =
   if top then llets (lbody_virt lambda_unit) else
 
   (* Now for the hard stuff: prepare for table cacheing *)
-  let env_index = Ident.create "env_index"
-  and envs = Ident.create "envs" in
+  let envs = Ident.create "envs"
+  and cached = Ident.create "cached" in
   let lenvs =
     if !new_ids_meths = [] && !new_ids_init = [] && inh_init = []
     then lambda_unit
@@ -719,8 +754,6 @@ let transl_class ids cl_id arity pub_meths cl =
          Lapply (oo_prim "new_variable", [Lvar cla; transl_label ""]),
          lam)
   in
-  let obj_init2 = Ident.create "obj_init"
-  and cached = Ident.create "cached" in
   let inh_paths =
     List.filter
       (fun (_,path) -> List.mem (Path.head path) new_ids) inh_init in
@@ -767,11 +800,6 @@ let transl_class ids cl_id arity pub_meths cl =
         else [lambda_unit; lfield cached 0; lambda_unit; lenvs]
        )))))
 
-(* Dummy for recursive modules *)
-
-let dummy_class undef_fn =
-  Lprim(Pmakeblock(0, Mutable), [undef_fn; undef_fn; undef_fn; lambda_unit])
-
 (* Wrapper for class compilation *)
 
 let transl_class ids cl_id arity pub_meths cl =
diff --git a/bytecomp/translclass.mli b/bytecomp/translclass.mli
index 85d5f74bcd..8b74d29811 100644
--- a/bytecomp/translclass.mli
+++ b/bytecomp/translclass.mli
@@ -15,7 +15,6 @@
 open Typedtree
 open Lambda
 
-val dummy_class : lambda -> lambda
 val transl_class :
   Ident.t list -> Ident.t -> int -> string list -> class_expr -> lambda;;
 
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index ccd5d202e4..21e4f887ea 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -53,7 +53,8 @@ let comparisons_table = create_hashtable 11 [
               prim_native_name = ""; prim_native_float = false},
        Pbintcomp(Pnativeint, Ceq),
        Pbintcomp(Pint32, Ceq),
-       Pbintcomp(Pint64, Ceq));
+       Pbintcomp(Pint64, Ceq),
+       true);
   "%notequal",
       (Pccall{prim_name = "caml_notequal"; prim_arity = 2; prim_alloc = true;
               prim_native_name = ""; prim_native_float = false},
@@ -64,7 +65,8 @@ let comparisons_table = create_hashtable 11 [
               prim_native_float = false},
        Pbintcomp(Pnativeint, Cneq),
        Pbintcomp(Pint32, Cneq),
-       Pbintcomp(Pint64, Cneq));
+       Pbintcomp(Pint64, Cneq),
+       true);
   "%lessthan",
       (Pccall{prim_name = "caml_lessthan"; prim_arity = 2; prim_alloc = true;
               prim_native_name = ""; prim_native_float = false},
@@ -75,7 +77,8 @@ let comparisons_table = create_hashtable 11 [
               prim_native_float = false},
        Pbintcomp(Pnativeint, Clt),
        Pbintcomp(Pint32, Clt),
-       Pbintcomp(Pint64, Clt));
+       Pbintcomp(Pint64, Clt),
+       false);
   "%greaterthan",
       (Pccall{prim_name = "caml_greaterthan"; prim_arity = 2; prim_alloc = true;
               prim_native_name = ""; prim_native_float = false},
@@ -86,7 +89,8 @@ let comparisons_table = create_hashtable 11 [
               prim_native_float = false},
        Pbintcomp(Pnativeint, Cgt),
        Pbintcomp(Pint32, Cgt),
-       Pbintcomp(Pint64, Cgt));
+       Pbintcomp(Pint64, Cgt),
+       false);
   "%lessequal",
       (Pccall{prim_name = "caml_lessequal"; prim_arity = 2; prim_alloc = true;
               prim_native_name = ""; prim_native_float = false},
@@ -97,7 +101,8 @@ let comparisons_table = create_hashtable 11 [
               prim_native_float = false},
        Pbintcomp(Pnativeint, Cle),
        Pbintcomp(Pint32, Cle),
-       Pbintcomp(Pint64, Cle));
+       Pbintcomp(Pint64, Cle),
+       false);
   "%greaterequal",
       (Pccall{prim_name = "caml_greaterequal"; prim_arity = 2;
               prim_alloc = true;
@@ -109,7 +114,8 @@ let comparisons_table = create_hashtable 11 [
               prim_native_float = false},
        Pbintcomp(Pnativeint, Cge),
        Pbintcomp(Pint32, Cge),
-       Pbintcomp(Pint64, Cge));
+       Pbintcomp(Pint64, Cge),
+       false);
   "%compare",
       (Pccall{prim_name = "caml_compare"; prim_arity = 2; prim_alloc = true;
               prim_native_name = ""; prim_native_float = false},
@@ -130,7 +136,8 @@ let comparisons_table = create_hashtable 11 [
               prim_native_float = false},
        Pccall{prim_name = "caml_int64_compare"; prim_arity = 2;
               prim_alloc = false; prim_native_name = "";
-              prim_native_float = false})
+              prim_native_float = false},
+       false)
 ]
 
 let primitives_table = create_hashtable 57 [
@@ -262,12 +269,15 @@ let prim_obj_dup =
 let transl_prim prim args =
   try
     let (gencomp, intcomp, floatcomp, stringcomp,
-         nativeintcomp, int32comp, int64comp) =
+         nativeintcomp, int32comp, int64comp,
+         simplify_constant_constructor) =
       Hashtbl.find comparisons_table prim.prim_name in
     begin match args with
-      [arg1; {exp_desc = Texp_construct({cstr_tag = Cstr_constant _}, _)}] ->
+      [arg1; {exp_desc = Texp_construct({cstr_tag = Cstr_constant _}, _)}]
+      when simplify_constant_constructor ->
         intcomp
-    | [{exp_desc = Texp_construct({cstr_tag = Cstr_constant _}, _)}; arg2] ->
+    | [{exp_desc = Texp_construct({cstr_tag = Cstr_constant _}, _)}; arg2]
+      when simplify_constant_constructor ->
         intcomp
     | [arg1; arg2] when has_base_type arg1 Predef.path_int
                      || has_base_type arg1 Predef.path_char ->
@@ -325,7 +335,7 @@ let make_sequence lam1 lam2 =
 let simple_prim p =
   let prim =
     try
-      let (gencomp, _, _, _, _, _, _) =
+      let (gencomp, _, _, _, _, _, _, _) =
         Hashtbl.find comparisons_table p.prim_name in
       gencomp
     with Not_found ->
@@ -344,7 +354,7 @@ let () = Transljoin.simple_prim := simple_prim
 let transl_primitive p =
   let prim =
     try
-      let (gencomp, _, _, _, _, _, _) =
+      let (gencomp, _, _, _, _, _, _, _) =
         Hashtbl.find comparisons_table p.prim_name in
       gencomp
     with Not_found ->
@@ -456,8 +466,8 @@ let rec push_defaults loc bindings pat_expr_list partial =
     [pat, ({exp_desc = Texp_function(pl,partial)} as exp)] ->
       let pl = push_defaults exp.exp_loc bindings pl partial in
       [pat, {exp with exp_desc = Texp_function(pl, partial)}]
-  | [pat, ({exp_desc = Texp_let
-             (Default, cases, ({exp_desc = Texp_function _} as e2))} as e1)] ->
+  | [pat, {exp_desc = Texp_let
+             (Default, cases, ({exp_desc = Texp_function _} as e2))}] ->
       push_defaults loc (cases :: bindings) [pat, e2] partial
   | [pat, exp] ->
       let exp =
@@ -488,7 +498,7 @@ let event_before exp lam = match lam with
 | Lstaticraise (_,_) -> lam
 | _ ->
   if !Clflags.debug
-  then Levent(lam, {lev_pos = exp.exp_loc.Location.loc_start;
+  then Levent(lam, {lev_loc = exp.exp_loc;
                     lev_kind = Lev_before;
                     lev_repr = None;
                     lev_env = Env.summary exp.exp_env})
@@ -496,20 +506,18 @@ let event_before exp lam = match lam with
 
 let event_after exp lam =
   if !Clflags.debug
-  then Levent(lam, {lev_pos = exp.exp_loc.Location.loc_end;
+  then Levent(lam, {lev_loc = exp.exp_loc;
                     lev_kind = Lev_after exp.exp_type;
                     lev_repr = None;
                     lev_env = Env.summary exp.exp_env})
   else lam
 
-let no_event exp lam = lam
-
 let event_function exp lam =
   if !Clflags.debug then
     let repr = Some (ref 0) in
     let (info, body) = lam repr in
     (info,
-     Levent(body, {lev_pos = exp.exp_loc.Location.loc_start;
+     Levent(body, {lev_loc = exp.exp_loc;
                    lev_kind = Lev_function;
                    lev_repr = repr;
                    lev_env = Env.summary exp.exp_env}))
@@ -528,13 +536,6 @@ let primitive_is_ccall = function
 
 let assert_failed loc =
   (* [Location.get_pos_info] is too expensive *)
-  let fname = match loc.Location.loc_start.Lexing.pos_fname with
-              | "" -> !Location.input_name
-              | x -> x
-  in
-  let pos = loc.Location.loc_start in
-  let line = pos.Lexing.pos_lnum in
-  let char = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in
   Lprim(Praise, [Lprim(Pmakeblock(0, Immutable),
           [transl_path Predef.path_assert_failure;
            transl_location loc])])
@@ -545,6 +546,11 @@ let assert_failed loc =
 let id_lam lam = lam
 ;;
 
+let rec cut n l =
+  if n = 0 then ([],l) else
+  match l with [] -> failwith "Translcore.cut"
+  | a::l -> let (l1,l2) = cut (n-1) l in (a::l1,l2)
+
 (* Translation of expressions *)
 
 let rec transl_exp e =
@@ -588,7 +594,6 @@ and transl_exp0 e =
   | Texp_def (d,body) ->
       do_transl_def d (transl_exp body)
   | Texp_loc (d,body) -> assert false
-(*< JOCAML *)
   | Texp_function (pat_expr_list, partial) ->
       let ((kind, params), body) =
         event_function e
@@ -611,8 +616,13 @@ and transl_exp0 e =
         Transljoin.local_send_sync auto idx (transl_exp arg)
 (*<JOCAML*)
   | Texp_apply({exp_desc = Texp_ident(path, {val_kind = Val_prim p})}, args)
-    when List.length args = p.prim_arity
+    when List.length args >= p.prim_arity
     && List.for_all (fun (arg,_) -> arg <> None) args ->
+      let args, args' = cut p.prim_arity args in
+      let wrap f =
+        event_after e (if args' = [] then f else transl_apply f args') in
+      let wrap0 f =
+        if args' = [] then f else wrap f in
       let args = List.map (function Some x, _ -> x | _ -> assert false) args in
       let argl = transl_list transl_exp args in
       let public_send = p.prim_name = "%send"
@@ -620,39 +630,38 @@ and transl_exp0 e =
       if public_send || p.prim_name = "%sendself" then
         let kind = if public_send then Public else Self in
 	let obj = List.hd argl in
-	event_after e (Lsend (kind, List.nth argl 1, obj, []))
+	wrap (Lsend (kind, List.nth argl 1, obj, []))
       else if p.prim_name = "%sendcache" then
         match argl with [obj; meth; cache; pos] ->
-          event_after e (Lsend(Cached, meth, obj, [cache; pos]))
+          wrap (Lsend(Cached, meth, obj, [cache; pos]))
         | _ -> assert false
       else begin
         let prim = transl_prim p args in
         match (prim, args) with
           (Praise, [arg1]) ->
-            Lprim(Praise, [event_after arg1 (List.hd argl)])
+            wrap0 (Lprim(Praise, [event_after arg1 (List.hd argl)]))
         | (_, _) ->
-            if primitive_is_ccall prim
-            then event_after e (Lprim(prim, argl))
-            else Lprim(prim, argl)
+            let p = Lprim(prim, argl) in
+            if primitive_is_ccall prim then wrap p else wrap0 p
       end
   | Texp_apply(funct, oargs) ->
       event_after e (transl_apply (transl_exp funct) oargs)
-  | Texp_match({exp_desc = Texp_tuple argl} as arg, pat_expr_list, partial) ->
+  | Texp_match({exp_desc = Texp_tuple argl}, pat_expr_list, partial) ->
       Matching.for_multiple_match (id_lam,e.exp_loc)
         (transl_list transl_exp argl)
-        (transl_cases event_before transl_exp pat_expr_list) partial
+        (transl_cases transl_exp pat_expr_list) partial
   | Texp_match(arg, pat_expr_list, partial) ->
       Matching.for_function
         (id_lam,e.exp_loc) None
         (transl_exp arg)
-        (transl_cases event_before transl_exp pat_expr_list) partial
+        (transl_cases transl_exp pat_expr_list) partial
   | Texp_try(body, pat_expr_list) ->
       let id = name_pattern "exn" pat_expr_list in
       Ltrywith
         (transl_exp body, id,
          Matching.for_trywith
            (Lvar id)
-           (transl_cases event_before transl_exp pat_expr_list))
+           (transl_cases transl_exp pat_expr_list))
   | Texp_tuple el ->
       let ll = transl_list transl_exp el in
       begin try
@@ -731,11 +740,7 @@ and transl_exp0 e =
                   event_before ifso (transl_exp ifso),
                   lambda_unit)
   | Texp_sequence(expr1, expr2) ->
-      let lam1 = transl_exp expr1 in
-      if lam1 = lambda_unit then
-        transl_exp expr2
-      else
-        Lsequence(lam1, event_before expr2 (transl_exp expr2))
+      Lsequence(transl_exp expr1, event_before expr2 (transl_exp expr2))
   | Texp_while(cond, body) ->
       Lwhile(transl_exp cond, event_before body (transl_exp body))
   | Texp_for(param, low, high, dir, body) ->
@@ -779,15 +784,15 @@ and transl_exp0 e =
       else Lifthenelse (transl_exp cond, lambda_unit, assert_failed e.exp_loc)
   | Texp_assertfalse -> assert_failed e.exp_loc
   | Texp_lazy e ->
-    let fn = Lfunction (Curried, [Ident.create "param"], transl_exp e) in
-    Lprim(Pmakeblock(Config.lazy_tag, Immutable), [fn])
+      let fn = Lfunction (Curried, [Ident.create "param"], transl_exp e) in
+      Lprim(Pmakeblock(Config.lazy_tag, Immutable), [fn])
   | Texp_object (cs, cty, meths) ->
       let cl = Ident.create "class" in
       !transl_object cl meths
-      { cl_desc = Tclass_structure cs;
-        cl_loc = e.exp_loc;
-        cl_type = Tcty_signature cty;
-        cl_env = e.exp_env }
+        { cl_desc = Tclass_structure cs;
+          cl_loc = e.exp_loc;
+          cl_type = Tcty_signature cty;
+          cl_env = e.exp_env }
 (*> JOCAML *)
   | Texp_spawn (e) -> transl_spawn e
 (*< JOCAML *)
@@ -832,17 +837,17 @@ and transl_proc die sync p = match p.exp_desc with
     Lifthenelse
       (Transljoin.reply_handler sync p transl_exp cond,
        transl_proc die sync body, staticfail)
-| Texp_match({exp_desc = Texp_tuple argl} as arg, pat_expr_list, partial) ->
+| Texp_match({exp_desc = Texp_tuple argl}, pat_expr_list, partial) ->
     Matching.for_multiple_match
       (Transljoin.lambda_reply_handler sync p, p.exp_loc)
       (transl_list (Transljoin.reply_handler sync p transl_exp) argl)
-      (transl_cases no_event (transl_proc die sync) pat_expr_list) partial
+      (transl_cases (transl_proc die sync) pat_expr_list) partial
 | Texp_match(arg, pat_expr_list, partial) ->
     Matching.for_function
        (Transljoin.lambda_reply_handler sync p, p.exp_loc)
       None
       (Transljoin.reply_handler sync p transl_exp arg)
-      (transl_cases no_event (transl_proc die sync) pat_expr_list) partial
+      (transl_cases (transl_proc die sync) pat_expr_list) partial
 | Texp_for(param, low, high, dir, body) ->
     assert (sync = None) ;
     let lam_low = transl_exp low
@@ -913,15 +918,14 @@ and transl_simple_proc die sync p = match p.exp_desc with
 | Texp_when(cond, body) ->
       (Lifthenelse
          (transl_exp cond, transl_simple_proc die sync body, staticfail))
-| Texp_match({exp_desc = Texp_tuple argl} as arg, pat_expr_list, partial) ->
+| Texp_match({exp_desc = Texp_tuple argl}, pat_expr_list, partial) ->
     Matching.for_multiple_match (id_lam, p.exp_loc)
       (transl_list transl_exp argl)
-      (transl_cases no_event
-         (transl_simple_proc die sync) pat_expr_list) partial
+      (transl_cases (transl_simple_proc die sync) pat_expr_list) partial
 | Texp_match(arg, pat_expr_list, partial) ->
     Matching.for_function (id_lam, p.exp_loc) None
       (transl_exp arg)
-      (transl_cases no_event
+      (transl_cases
          (transl_simple_proc die sync) pat_expr_list) partial
 | Texp_for(param, low, high, dir, body) ->
     assert (sync=None) ;
@@ -969,11 +973,6 @@ and transl_simple_proc die sync p = match p.exp_desc with
 
 and transl_reaction (name,_) (Reac reac) =
   let (x, _ , actuals, idpats, p) = reac in
-(*
-      let dump_oid fp = function
-      | Some id -> Printf.fprintf fp "+%s" (Ident.unique_name id)
-      | None -> Printf.fprintf fp "-"  in
-*)
 (* Principal continuation, as computed by typing *)
   let sync = Transljoin.principal p in
 (* Important: argument order comes from actual pattern order,
@@ -984,12 +983,6 @@ and transl_reaction (name,_) (Reac reac) =
       | p::_ -> p | [] -> assert false)
       actuals in
   let konts = List.map (fun jp -> !(jp.jpat_kont)) jpats in
-(*
-
-      Printf.eprintf "Principal: %a\n" dump_oid sync ;
-      List.iter (fun k -> dump_oid stderr k) konts ;
-      prerr_endline "" ;
-*)
   let body =
     List.fold_right
       (fun (param, pat) lam ->
@@ -1043,7 +1036,10 @@ and transl_dispatcher disp =
         | [] -> assert false
         | (auto,_)::_ ->
             let cls =
-              List.map (fun (_,(p,i)) -> p,lambda_int i) allchans in
+              List.map
+                (fun (_,(p,i)) ->
+                  p,Lconst (Const_base (Const_int i)))
+                allchans in
             (if chan.jchannel_sync then
               Transljoin.local_send_sync2
             else
@@ -1100,13 +1096,15 @@ and transl_as_seq die es k = match es with
     make_sequence
       (transl_simple_proc false None e)
       (transl_as_seq die rem k)
-(*< JOCAML *)
-and transl_list comp_fun expr_list =  List.map comp_fun expr_list
 
-and transl_cases event_before transl_exp pat_expr_list =
+and transl_list transl_exp expr_list =
+  List.map transl_exp expr_list
+
+and transl_cases transl_exp pat_expr_list =
   List.map
     (fun (pat, expr) -> (pat, event_before expr (transl_exp expr)))
     pat_expr_list
+(*< JOCAML *)
 
 and transl_tupled_cases patl_expr_list =
   List.map (fun (patl, expr) -> (patl, transl_exp expr)) patl_expr_list
@@ -1185,13 +1183,13 @@ and transl_function loc untuplify_fn repr partial pat_expr_list =
         let param = name_pattern "param" pat_expr_list in
         ((Curried, [param]),
          Matching.for_function (id_lam,loc) repr (Lvar param)
-           (transl_cases event_before transl_exp pat_expr_list) partial)
+           (transl_cases transl_exp pat_expr_list) partial)
       end
   | _ ->
       let param = name_pattern "param" pat_expr_list in
       ((Curried, [param]),
        Matching.for_function (id_lam,loc) repr (Lvar param)
-         (transl_cases event_before transl_exp pat_expr_list) partial)
+         (transl_cases transl_exp pat_expr_list) partial)
 
 and transl_let reply_handler transl_exp rec_flag pat_expr_list body =
   match rec_flag with
@@ -1275,7 +1273,6 @@ and do_transl_def autos body =
     List.fold_right Transljoin.create_auto autos r in
   r
 
-(*< JOCAML *)
 
 and transl_setinstvar self var expr =
   Lprim(Parraysetu (if maybe_pointer expr then Paddrarray else Pintarray),
diff --git a/bytecomp/transljoin.ml b/bytecomp/transljoin.ml
index 23ca1ae455..806db53c43 100644
--- a/bytecomp/transljoin.ml
+++ b/bytecomp/transljoin.ml
@@ -99,6 +99,9 @@ let mk_apply f args = match Lazy.force f with
 | path,_                   -> Lapply (transl_path path, args)
   
 
+let lambda_int i = Lconst (Const_base (Const_int i))
+and lambda_string s = Lconst (Const_immstring s)
+
 let init_unit_queue auto idx =
   mk_apply lambda_init_unit_queue [Lvar auto ; lambda_int idx]
 
@@ -717,7 +720,6 @@ let create_table auto gs r =
             (fun bd jpat r -> match bd with
             | None,lam -> lam::r
             | Some y,_ ->
-                let k = jpat.jpat_kont in
                 if !(jpat.jpat_kont) = sync then
                   Lprim (Pfield 1, [Lvar y])::r
                 else
diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml
index 1a3113d39c..bc74712f8c 100644
--- a/bytecomp/translmod.ml
+++ b/bytecomp/translmod.ml
@@ -17,6 +17,7 @@
 
 open Misc
 open Asttypes
+open Longident
 open Path
 open Types
 open Typedtree
@@ -95,7 +96,15 @@ let field_path path field =
 
 (* Utilities for compiling "module rec" definitions *)
 
-let undefined_exception loc =
+let mod_prim name =
+  try
+    transl_path
+      (fst (Env.lookup_value (Ldot (Lident "CamlinternalMod", name))
+                             Env.empty))
+  with Not_found ->
+    fatal_error ("Primitive " ^ name ^ " not found.")
+
+let undefined_location loc =
   (* Confer Translcore.assert_failed *)
   let fname = match loc.Location.loc_start.Lexing.pos_fname with
               | "" -> !Location.input_name
@@ -103,61 +112,50 @@ let undefined_exception loc =
   let pos = loc.Location.loc_start in
   let line = pos.Lexing.pos_lnum in
   let char = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in
-  Lprim(Pmakeblock(0, Immutable),
-        [transl_path Predef.path_undefined_recursive_module;
-         Lconst(Const_block(0,
-                   [Const_base(Const_string fname);
-                    Const_base(Const_int line);
-                    Const_base(Const_int char)]))])
-
-let undefined_function loc =
-  Lfunction(Curried, [Ident.create "undef"],
-            Lprim(Praise, [undefined_exception loc]))
-
-let init_value modl =
-  let undef_exn_id = Ident.create "undef_exception" in
-  let undef_function_id = Ident.create "undef_function" in
-  let rec init_value_mod env mty =
+  Lconst(Const_block(0,
+                     [Const_base(Const_string fname);
+                      Const_base(Const_int line);
+                      Const_base(Const_int char)]))
+
+let init_shape modl =
+  let rec init_shape_mod env mty =
     match Mtype.scrape env mty with
       Tmty_ident _ ->
         raise Not_found
     | Tmty_signature sg ->
-        Lprim(Pmakeblock(0, Mutable), init_value_struct env sg)
+        Const_block(0, [Const_block(0, init_shape_struct env sg)])
     | Tmty_functor(id, arg, res) ->
-        raise Not_found (* to be fixed? *)
-  and init_value_struct env sg =
+        raise Not_found (* can we do better? *)
+  and init_shape_struct env sg =
     match sg with
       [] -> []
     | Tsig_value(id, vdesc) :: rem ->
         let init_v =
           match Ctype.expand_head env vdesc.val_type with
             {desc = Tarrow(_,_,_,_)} ->
-              Lvar undef_function_id
+              Const_pointer 0 (* camlinternalMod.Function *)
           | {desc = Tconstr(p, _, _)} when Path.same p Predef.path_lazy_t ->
-              Lprim(Pmakeblock(Config.lazy_tag, Immutable),
-                    [Lvar undef_function_id])
+              Const_pointer 1 (* camlinternalMod.Lazy *)
           | _ -> raise Not_found in
-        init_v :: init_value_struct env rem
+        init_v :: init_shape_struct env rem
     | Tsig_type(id, tdecl, _) :: rem ->
-        init_value_struct (Env.add_type id tdecl env) rem
+        init_shape_struct (Env.add_type id tdecl env) rem
     | Tsig_exception(id, edecl) :: rem ->
-        transl_exception
-          id (Some Predef.path_undefined_recursive_module) edecl ::
-        init_value_struct env rem
+        raise Not_found
     | Tsig_module(id, mty, _) :: rem ->
-        init_value_mod env mty ::
-        init_value_struct (Env.add_module id mty env) rem
+        init_shape_mod env mty ::
+        init_shape_struct (Env.add_module id mty env) rem
     | Tsig_modtype(id, minfo) :: rem ->
-        init_value_struct (Env.add_modtype id minfo env) rem
+        init_shape_struct (Env.add_modtype id minfo env) rem
     | Tsig_class(id, cdecl, _) :: rem ->
-        Translclass.dummy_class (Lvar undef_function_id) ::
-        init_value_struct env rem
+        Const_pointer 2 (* camlinternalMod.Class *)
+        :: init_shape_struct env rem
     | Tsig_cltype(id, ctyp, _) :: rem ->
-        init_value_struct env rem
+        init_shape_struct env rem
   in
   try
-    Some(Llet(Alias, undef_function_id, undefined_function modl.mod_loc,
-              init_value_mod modl.mod_env modl.mod_type))
+    Some(undefined_location modl.mod_loc,
+         Lconst(init_shape_mod modl.mod_env modl.mod_type))
   with Not_found ->
     None
 
@@ -197,35 +195,30 @@ let reorder_rec_bindings bindings =
 
 (* Generate lambda-code for a reordered list of bindings *)
 
-let prim_update =
-  { prim_name = "caml_update_dummy";
-    prim_arity = 2;
-    prim_alloc = true;
-    prim_native_name = "";
-    prim_native_float = false }
-
 let eval_rec_bindings bindings cont =
   let rec bind_inits = function
     [] ->
       bind_strict bindings
   | (id, None, rhs) :: rem ->
       bind_inits rem
-  | (id, Some init, rhs) :: rem ->
-      Llet(Strict, id, init, bind_inits rem)
+  | (id, Some(loc, shape), rhs) :: rem ->
+      Llet(Strict, id, Lapply(mod_prim "init_mod", [loc; shape]),
+           bind_inits rem)
   and bind_strict = function
     [] ->
       patch_forwards bindings
   | (id, None, rhs) :: rem ->
       Llet(Strict, id, rhs, bind_strict rem)
-  | (id, Some init, rhs) :: rem ->
+  | (id, Some(loc, shape), rhs) :: rem ->
       bind_strict rem
   and patch_forwards = function
     [] ->
       cont
   | (id, None, rhs) :: rem ->
       patch_forwards rem
-  | (id, Some init, rhs) :: rem ->
-      Lsequence(Lprim(Pccall prim_update, [Lvar id; rhs]), patch_forwards rem)
+  | (id, Some(loc, shape), rhs) :: rem ->
+      Lsequence(Lapply(mod_prim "update_mod", [shape; Lvar id; rhs]),
+                patch_forwards rem)
   in
     bind_inits bindings
 
@@ -234,7 +227,7 @@ let compile_recmodule compile_rhs bindings cont =
     (reorder_rec_bindings
       (List.map
         (fun (id, modl) ->
-                  (id, modl.mod_loc, init_value modl, compile_rhs id modl))
+                  (id, modl.mod_loc, init_shape modl, compile_rhs id modl))
         bindings))
     cont
 
diff --git a/byterun/.cvsignore b/byterun/.cvsignore
index 895cec3f58..90636dc158 100644
--- a/byterun/.cvsignore
+++ b/byterun/.cvsignore
@@ -2,6 +2,7 @@ jumptbl.h
 primitives
 prims.c
 opnames.h
+version.h
 ocamlrun
 ocamlrund
 ld.conf
diff --git a/byterun/.depend b/byterun/.depend
index c9b0e0990e..441b7e7920 100644
--- a/byterun/.depend
+++ b/byterun/.depend
@@ -105,7 +105,8 @@ roots.o: roots.c finalise.h roots.h misc.h compatibility.h config.h \
   freelist.h minor_gc.h globroots.h stacks.h
 signals.o: signals.c alloc.h compatibility.h misc.h config.h \
   ../config/m.h ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h \
-  major_gc.h freelist.h minor_gc.h roots.h signals.h sys.h
+  major_gc.h freelist.h minor_gc.h roots.h signals.h signals_machdep.h \
+  sys.h
 stacks.o: stacks.c config.h ../config/m.h ../config/s.h compatibility.h \
   fail.h misc.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
   minor_gc.h
@@ -113,7 +114,8 @@ startup.o: startup.c config.h ../config/m.h ../config/s.h compatibility.h \
   alloc.h misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \
   dynlink.h exec.h fail.h fix_code.h gc_ctrl.h instrtrace.h interp.h \
   intext.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h osdeps.h \
-  prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h
+  prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \
+  version.h
 str.o: str.c alloc.h compatibility.h misc.h config.h ../config/m.h \
   ../config/s.h mlvalues.h fail.h
 sys.o: sys.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \
@@ -239,7 +241,8 @@ roots.d.o: roots.c finalise.h roots.h misc.h compatibility.h config.h \
   freelist.h minor_gc.h globroots.h stacks.h
 signals.d.o: signals.c alloc.h compatibility.h misc.h config.h \
   ../config/m.h ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h \
-  major_gc.h freelist.h minor_gc.h roots.h signals.h sys.h
+  major_gc.h freelist.h minor_gc.h roots.h signals.h signals_machdep.h \
+  sys.h
 stacks.d.o: stacks.c config.h ../config/m.h ../config/s.h compatibility.h \
   fail.h misc.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \
   minor_gc.h
@@ -247,7 +250,8 @@ startup.d.o: startup.c config.h ../config/m.h ../config/s.h compatibility.h \
   alloc.h misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \
   dynlink.h exec.h fail.h fix_code.h gc_ctrl.h instrtrace.h interp.h \
   intext.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h osdeps.h \
-  prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h
+  prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \
+  version.h
 str.d.o: str.c alloc.h compatibility.h misc.h config.h ../config/m.h \
   ../config/s.h mlvalues.h fail.h
 sys.d.o: sys.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \
diff --git a/byterun/Makefile b/byterun/Makefile
index f79365cad9..6165e725d9 100644
--- a/byterun/Makefile
+++ b/byterun/Makefile
@@ -89,18 +89,22 @@ prims.c : primitives
 	 echo '	 0 };') > prims.c
 
 opnames.h : instruct.h
-	LANG=C; \
 	sed -e '/\/\*/d' \
 	    -e '/^#/d' \
 	    -e 's/enum /char * names_of_/' \
 	    -e 's/{$$/[] = {/' \
-	    -e 's/\([A-Z][A-Z_0-9]*\)/"\1"/g' instruct.h > opnames.h
+	    -e 's/\([[:upper:]][[:upper:]_0-9]*\)/"\1"/g' instruct.h > opnames.h
 
 # jumptbl.h is required only if you have GCC 2.0 or later
 jumptbl.h : instruct.h
 	sed -n -e '/^  /s/ \([A-Z]\)/ \&\&lbl_\1/gp' \
 	       -e '/^}/q' instruct.h > jumptbl.h
 
+version.h : ../stdlib/sys.ml
+	sed -n -e 's/;;//' \
+            -e '/let *ocaml_version *= */s//#define OCAML_VERSION /p' \
+            <../stdlib/sys.ml >version.h
+
 .SUFFIXES: .d.o
 
 .c.d.o:
@@ -109,7 +113,7 @@ jumptbl.h : instruct.h
 	mv $*.o $*.d.o
 	@ if test -f $*.f.o; then mv $*.f.o $*.o; else :; fi
 
-depend : prims.c opnames.h jumptbl.h
+depend : prims.c opnames.h jumptbl.h version.h
 	gcc -MM $(BYTECCCOMPOPTS) *.c > .depend
 	gcc -MM $(BYTECCCOMPOPTS) -DDEBUG *.c | sed -e 's/\.o/.d.o/' >> .depend
 
diff --git a/byterun/Makefile.nt b/byterun/Makefile.nt
index aa9499df16..93fe717fcd 100644
--- a/byterun/Makefile.nt
+++ b/byterun/Makefile.nt
@@ -86,6 +86,11 @@ jumptbl.h : instruct.h
 	sed -n -e "/^  /s/ \([A-Z]\)/ \&\&lbl_\1/gp" \
 	       -e "/^}/q" instruct.h > jumptbl.h
 
+version.h : ../stdlib/sys.ml
+	sed -n -e 's/;;//' \
+            -e '/let *ocaml_version *= */s//#define OCAML_VERSION /p' \
+            <../stdlib/sys.ml >version.h
+
 main.$(DO): main.c
 	$(CC) $(DLLCCCOMPOPTS) -c main.c
 	mv main.$(O) main.$(DO)
diff --git a/byterun/alloc.h b/byterun/alloc.h
index 1cf70c2247..66cab70244 100644
--- a/byterun/alloc.h
+++ b/byterun/alloc.h
@@ -32,7 +32,7 @@ CAMLextern value caml_copy_string_array (char const **);
 CAMLextern value caml_copy_double (double);
 CAMLextern value caml_copy_int32 (int32);       /* defined in [ints.c] */
 CAMLextern value caml_copy_int64 (int64);       /* defined in [ints.c] */
-CAMLextern value caml_copy_nativeint (long);    /* defined in [ints.c] */
+CAMLextern value caml_copy_nativeint (intnat);  /* defined in [ints.c] */
 CAMLextern value caml_alloc_array (value (*funct) (char const *),
                                    char const ** array);
 
diff --git a/byterun/array.c b/byterun/array.c
index c13c0fed72..468fe444a4 100644
--- a/byterun/array.c
+++ b/byterun/array.c
@@ -25,14 +25,14 @@
 
 CAMLprim value caml_array_get_addr(value array, value index)
 {
-  long idx = Long_val(index);
+  intnat idx = Long_val(index);
   if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error();
   return Field(array, idx);
 }
 
 CAMLprim value caml_array_get_float(value array, value index)
 {
-  long idx = Long_val(index);
+  intnat idx = Long_val(index);
   double d;
   value res;
 
@@ -58,7 +58,7 @@ CAMLprim value caml_array_get(value array, value index)
 
 CAMLprim value caml_array_set_addr(value array, value index, value newval)
 {
-  long idx = Long_val(index);
+  intnat idx = Long_val(index);
   if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error();
   Modify(&Field(array, idx), newval);
   return Val_unit;
@@ -66,7 +66,7 @@ CAMLprim value caml_array_set_addr(value array, value index, value newval)
 
 CAMLprim value caml_array_set_float(value array, value index, value newval)
 {
-  long idx = Long_val(index);
+  intnat idx = Long_val(index);
   if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
     caml_array_bound_error();
   Store_double_field(array, idx, Double_val(newval));
@@ -106,7 +106,7 @@ CAMLprim value caml_array_unsafe_get(value array, value index)
 
 CAMLprim value caml_array_unsafe_set_addr(value array, value index,value newval)
 {
-  long idx = Long_val(index);
+  intnat idx = Long_val(index);
   Modify(&Field(array, idx), newval);
   return Val_unit;
 }
diff --git a/byterun/compact.c b/byterun/compact.c
index 5675308468..a6860d529c 100644
--- a/byterun/compact.c
+++ b/byterun/compact.c
@@ -26,7 +26,7 @@
 #include "roots.h"
 #include "weak.h"
 
-extern unsigned long caml_percent_free;             /* major_gc.c */
+extern uintnat caml_percent_free;                   /* major_gc.c */
 extern void caml_shrink_heap (char *);              /* memory.c */
 
 /* Encoded headers: the color is stored in the 2 least significant bits.
@@ -51,12 +51,12 @@ extern void caml_shrink_heap (char *);              /* memory.c */
 #define Tag_ehd(h) (((h) >> 2) & 0xFF)
 #define Ecolor(w) ((w) & 3)
 
-typedef unsigned long word;
+typedef uintnat word;
 
 static void invert_pointer_at (word *p)
 {
   word q = *p;
-                                              Assert (Ecolor ((long) p) == 0);
+                                            Assert (Ecolor ((intnat) p) == 0);
 
   /* Use Ecolor (q) == 0 instead of Is_block (q) because q could be an
      inverted pointer for an infix header (with Ecolor == 2). */
@@ -208,7 +208,7 @@ void caml_compact_heap (void)
           /* Get the original header of this block. */
           infixes = p + sz;
           q = *infixes;
-          while (Ecolor (q) != 3) q = * (word *) (q & ~(unsigned long)3);
+          while (Ecolor (q) != 3) q = * (word *) (q & ~(uintnat)3);
           sz = Whsize_ehd (q);
           t = Tag_ehd (q);
         }
@@ -272,7 +272,7 @@ void caml_compact_heap (void)
             /* Get the original header of this block. */
             infixes = p + sz;
             q = *infixes;                             Assert (Ecolor (q) == 2);
-            while (Ecolor (q) != 3) q = * (word *) (q & ~(unsigned long)3);
+            while (Ecolor (q) != 3) q = * (word *) (q & ~(uintnat)3);
             sz = Whsize_ehd (q);
             t = Tag_ehd (q);
           }
@@ -289,11 +289,11 @@ void caml_compact_heap (void)
           if (infixes != NULL){
             /* Rebuild the infix headers and revert the infix pointers. */
             while (Ecolor ((word) infixes) != 3){
-              infixes = (word *) ((word) infixes & ~(unsigned long) 3);
+              infixes = (word *) ((word) infixes & ~(uintnat) 3);
               q = *infixes;
               while (Ecolor (q) == 2){
                 word next;
-                q = (word) q & ~(unsigned long) 3;
+                q = (word) q & ~(uintnat) 3;
                 next = * (word *) q;
                 * (word *) q = (word) Val_hp ((word *) newadr + (infixes - p));
                 q = next;
@@ -393,7 +393,7 @@ void caml_compact_heap (void)
   caml_gc_message (0x10, "done.\n", 0);
 }
 
-unsigned long caml_percent_max;  /* used in gc_ctrl.c */
+uintnat caml_percent_max;  /* used in gc_ctrl.c */
 
 void caml_compact_heap_maybe (void)
 {
@@ -419,9 +419,12 @@ void caml_compact_heap_maybe (void)
     fp = 100.0 * fw / (Wsize_bsize (caml_stat_heap_size) - fw);
     if (fp > 1000000.0) fp = 1000000.0;
   }
-  caml_gc_message (0x200, "FL size at phase change = %lu\n",
-                   (unsigned long) caml_fl_size_at_phase_change);
-  caml_gc_message (0x200, "Estimated overhead = %lu%%\n", (unsigned long) fp);
+  caml_gc_message (0x200, "FL size at phase change = %"
+                          ARCH_INTNAT_PRINTF_FORMAT "u\n",
+                   (uintnat) caml_fl_size_at_phase_change);
+  caml_gc_message (0x200, "Estimated overhead = %"
+                          ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
+                   (uintnat) fp);
   if (fp >= caml_percent_max){
     caml_gc_message (0x200, "Automatic compaction triggered.\n", 0);
     caml_finish_major_cycle ();
@@ -429,7 +432,9 @@ void caml_compact_heap_maybe (void)
     /* We just did a complete GC, so we can measure the overhead exactly. */
     fw = caml_fl_cur_size;
     fp = 100.0 * fw / (Wsize_bsize (caml_stat_heap_size) - fw);
-    caml_gc_message (0x200, "Measured overhead: %lu%%\n", (unsigned long) fp);
+    caml_gc_message (0x200, "Measured overhead: %"
+                            ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
+                     (uintnat) fp);
 
     caml_compact_heap ();
   }
diff --git a/byterun/compare.c b/byterun/compare.c
index c16067b23a..a709b2e473 100644
--- a/byterun/compare.c
+++ b/byterun/compare.c
@@ -91,7 +91,7 @@ static struct compare_item * compare_resize_stack(struct compare_item * sp)
       < 0 and > UNORDERED v1 is less than v2
       UNORDERED           v1 and v2 cannot be compared */
 
-static long compare_val(value v1, value v2, int total)
+static intnat compare_val(value v1, value v2, int total)
 {
   struct compare_item * sp;
   tag_t t1, t2;
@@ -132,7 +132,7 @@ static long compare_val(value v1, value v2, int total)
     t2 = Tag_val(v2);
     if (t1 == Forward_tag) { v1 = Forward_val (v1); continue; }
     if (t2 == Forward_tag) { v2 = Forward_val (v2); continue; }
-    if (t1 != t2) return (long)t1 - (long)t2;
+    if (t1 != t2) return (intnat)t1 - (intnat)t2;
     switch(t1) {
     case String_tag: {
       mlsize_t len1, len2, len;
@@ -145,7 +145,7 @@ static long compare_val(value v1, value v2, int total)
              p2 = (unsigned char *) String_val(v2);
            len > 0;
            len--, p1++, p2++)
-        if (*p1 != *p2) return (long)*p1 - (long)*p2;
+        if (*p1 != *p2) return (intnat)*p1 - (intnat)*p2;
       if (len1 != len2) return len1 - len2;
       break;
     }
@@ -191,8 +191,8 @@ static long compare_val(value v1, value v2, int total)
       compare_free_stack();
       caml_invalid_argument("equal: functional value");
     case Object_tag: {
-      long oid1 = Oid_val(v1);
-      long oid2 = Oid_val(v2);
+      intnat oid1 = Oid_val(v1);
+      intnat oid2 = Oid_val(v2);
       if (oid1 != oid2) return oid1 - oid2;
       break;
     }
@@ -237,7 +237,7 @@ static long compare_val(value v1, value v2, int total)
 
 CAMLprim value caml_compare(value v1, value v2)
 {
-  long res = compare_val(v1, v2, 1);
+  intnat res = compare_val(v1, v2, 1);
   /* Free stack if needed */
   if (compare_stack != compare_stack_init) compare_free_stack();
   if (res < 0)
@@ -250,42 +250,42 @@ CAMLprim value caml_compare(value v1, value v2)
 
 CAMLprim value caml_equal(value v1, value v2)
 {
-  long res = compare_val(v1, v2, 0);
+  intnat res = compare_val(v1, v2, 0);
   if (compare_stack != compare_stack_init) compare_free_stack();
   return Val_int(res == 0);
 }
 
 CAMLprim value caml_notequal(value v1, value v2)
 {
-  long res = compare_val(v1, v2, 0);
+  intnat res = compare_val(v1, v2, 0);
   if (compare_stack != compare_stack_init) compare_free_stack();
   return Val_int(res != 0);
 }
 
 CAMLprim value caml_lessthan(value v1, value v2)
 {
-  long res = compare_val(v1, v2, 0);
+  intnat res = compare_val(v1, v2, 0);
   if (compare_stack != compare_stack_init) compare_free_stack();
   return Val_int(res - 1 < -1);
 }
 
 CAMLprim value caml_lessequal(value v1, value v2)
 {
-  long res = compare_val(v1, v2, 0);
+  intnat res = compare_val(v1, v2, 0);
   if (compare_stack != compare_stack_init) compare_free_stack();
   return Val_int(res - 1 <= -1);
 }
 
 CAMLprim value caml_greaterthan(value v1, value v2)
 {
-  long res = compare_val(v1, v2, 0);
+  intnat res = compare_val(v1, v2, 0);
   if (compare_stack != compare_stack_init) compare_free_stack();
   return Val_int(res > 0);
 }
 
 CAMLprim value caml_greaterequal(value v1, value v2)
 {
-  long res = compare_val(v1, v2, 0);
+  intnat res = compare_val(v1, v2, 0);
   if (compare_stack != compare_stack_init) compare_free_stack();
   return Val_int(res >= 0);
 }
diff --git a/byterun/compatibility.h b/byterun/compatibility.h
index f65717b62e..410ef29784 100644
--- a/byterun/compatibility.h
+++ b/byterun/compatibility.h
@@ -259,11 +259,11 @@
 #define do_local_roots caml_do_local_roots
 
 /* **** signals.c */
-#define async_signal_mode caml_async_signal_mode
-#define pending_signal caml_pending_signal
+#define pending_signals caml_pending_signals
 #define something_to_do caml_something_to_do
 #define enter_blocking_section_hook caml_enter_blocking_section_hook
 #define leave_blocking_section_hook caml_leave_blocking_section_hook
+#define try_leave_blocking_section_hook caml_try_leave_blocking_section_hook
 #define async_action_hook caml_async_action_hook
 #define enter_blocking_section caml_enter_blocking_section
 #define leave_blocking_section caml_leave_blocking_section
diff --git a/byterun/config.h b/byterun/config.h
index da9612489c..a6a59e9c9d 100644
--- a/byterun/config.h
+++ b/byterun/config.h
@@ -27,29 +27,51 @@
 #include "compatibility.h"
 #endif
 
-/* Types for signed chars, 16-bit integers, 32-bit integers, 64-bit integers */
+/* Types for signed chars, 32-bit integers, 64-bit integers,
+   native integers (as wide as a pointer type) */
 
 typedef signed char schar;
 
-typedef short int16;            /* FIXME -- not true on the Cray T3E */
-typedef unsigned short uint16;  /* FIXME -- not true on the Cray T3E */
+#if SIZEOF_PTR == SIZEOF_LONG
+/* Standard models: ILP32 or I32LP64 */
+typedef long intnat;
+typedef unsigned long uintnat;
+#define ARCH_INTNAT_PRINTF_FORMAT "l"
+#elif SIZEOF_PTR == SIZEOF_INT
+/* Hypothetical IP32L64 model */
+typedef int intnat;
+typedef unsigned int uintnat;
+#define ARCH_INTNAT_PRINTF_FORMAT ""
+#elif SIZEOF_PTR == 8 && defined(ARCH_INT64_TYPE)
+/* Win64 model: IL32LLP64 */
+typedef ARCH_INT64_TYPE intnat;
+typedef ARCH_UINT64_TYPE uintnat;
+#define ARCH_INTNAT_PRINTF_FORMAT ARCH_INT64_PRINTF_FORMAT
+#else
+#error "No integer type available to represent pointers"
+#endif
 
 #if SIZEOF_INT == 4
 typedef int int32;
 typedef unsigned int uint32;
+#define ARCH_INT32_PRINTF_FORMAT ""
 #elif SIZEOF_LONG == 4
 typedef long int32;
 typedef unsigned long uint32;
+#define ARCH_INT32_PRINTF_FORMAT "l"
 #elif SIZEOF_SHORT == 4
 typedef short int32;
 typedef unsigned short uint32;
+#define ARCH_INT32_PRINTF_FORMAT ""
+#else
+#error "No 32-bit integer type available"
 #endif
 
 #if defined(ARCH_INT64_TYPE)
 typedef ARCH_INT64_TYPE int64;
 typedef ARCH_UINT64_TYPE uint64;
 #else
-#  if ARCH_BIG_ENDIAN
+#  ifdef ARCH_BIG_ENDIAN
 typedef struct { uint32 h, l; } uint64, int64;
 #  else
 typedef struct { uint32 l, h; } uint64, int64;
@@ -85,7 +107,7 @@ typedef struct { uint32 l, h; } uint64, int64;
 /* Memory model parameters */
 
 /* The size of a page for memory management (in bytes) is [1 << Page_log].
-   It must be a multiple of [sizeof (long)]. */
+   It must be a multiple of [sizeof (value)]. */
 #define Page_log 12             /* A page is 4 kilobytes. */
 
 /* Initial size of stack (bytes). */
diff --git a/byterun/custom.c b/byterun/custom.c
index 6aca44b1e2..05ded303a2 100644
--- a/byterun/custom.c
+++ b/byterun/custom.c
@@ -22,7 +22,7 @@
 #include "mlvalues.h"
 
 CAMLexport value caml_alloc_custom(struct custom_operations * ops,
-                                   unsigned long size,
+                                   uintnat size,
                                    mlsize_t mem,
                                    mlsize_t max)
 {
diff --git a/byterun/custom.h b/byterun/custom.h
index 7caa751911..3855742f4e 100644
--- a/byterun/custom.h
+++ b/byterun/custom.h
@@ -26,11 +26,11 @@ struct custom_operations {
   char *identifier;
   void (*finalize)(value v);
   int (*compare)(value v1, value v2);
-  long (*hash)(value v);
+  intnat (*hash)(value v);
   void (*serialize)(value v, 
-                    /*out*/ unsigned long * wsize_32 /*size in bytes*/,
-                    /*out*/ unsigned long * wsize_64 /*size in bytes*/);
-  unsigned long (*deserialize)(void * dst);
+                    /*out*/ uintnat * wsize_32 /*size in bytes*/,
+                    /*out*/ uintnat * wsize_64 /*size in bytes*/);
+  uintnat (*deserialize)(void * dst);
 };
 
 #define custom_finalize_default NULL
@@ -42,7 +42,7 @@ struct custom_operations {
 #define Custom_ops_val(v) (*((struct custom_operations **) (v)))
 
 CAMLextern value caml_alloc_custom(struct custom_operations * ops,
-                                   unsigned long size, /*size in bytes*/
+                                   uintnat size, /*size in bytes*/
                                    mlsize_t mem, /*resources consumed*/
                                    mlsize_t max  /*max resources*/);
 
diff --git a/byterun/debugger.c b/byterun/debugger.c
index 41ab845441..df399fc896 100644
--- a/byterun/debugger.c
+++ b/byterun/debugger.c
@@ -30,7 +30,7 @@
 #include "sys.h"
 
 int caml_debugger_in_use = 0;
-unsigned long caml_event_count;
+uintnat caml_event_count;
 
 #if !defined(HAS_SOCKETS) || defined(_WIN32)
 
@@ -170,7 +170,7 @@ void caml_debugger(enum event_kind event)
 {
   int frame_number;
   value * frame;
-  long i, pos;
+  intnat i, pos;
   value val;
 
   if (dbg_socket == -1) return;  /* Not connected to a debugger. */
diff --git a/byterun/debugger.h b/byterun/debugger.h
index c8cbcd20ee..59e23ec0e1 100644
--- a/byterun/debugger.h
+++ b/byterun/debugger.h
@@ -23,7 +23,7 @@
 
 extern int caml_debugger_in_use;
 extern int running;
-extern unsigned long caml_event_count;
+extern uintnat caml_event_count;
 
 enum event_kind {
   EVENT_COUNT, BREAKPOINT, PROGRAM_START, PROGRAM_EXIT,
diff --git a/byterun/dynlink.c b/byterun/dynlink.c
index cbbf5ea376..251206cc60 100644
--- a/byterun/dynlink.c
+++ b/byterun/dynlink.c
@@ -122,7 +122,7 @@ static void open_shared_lib(char * name)
 
   realname = caml_search_dll_in_path(&caml_shared_libs_path, name);
   caml_gc_message(0x100, "Loading shared library %s\n",
-                  (unsigned long) realname);
+                  (uintnat) realname);
   handle = caml_dlopen(realname);
   if (handle == NULL)
     caml_fatal_error_arg2("Fatal error: cannot load shared library %s\n", name,
diff --git a/byterun/extern.c b/byterun/extern.c
index 550719fc8d..3a6b367561 100644
--- a/byterun/extern.c
+++ b/byterun/extern.c
@@ -29,123 +29,195 @@
 #include "mlvalues.h"
 #include "reverse.h"
 
-/* To keep track of sharing in externed objects */
+static uintnat obj_counter;  /* Number of objects emitted so far */
+static uintnat size_32;  /* Size in words of 32-bit block for struct. */
+static uintnat size_64;  /* Size in words of 64-bit block for struct. */
 
-typedef unsigned long byteoffset_t;
+static int extern_ignore_sharing; /* Flag to ignore sharing */
+static int extern_closures;     /* Flag to allow externing code pointers */
+
+/* Trail mechanism to undo forwarding pointers put inside objects */
 
-struct extern_obj {
-  byteoffset_t ofs;
-  value obj;
+struct trail_entry {
+  value obj;    /* address of object + initial color in low 2 bits */
+  value field0; /* initial contents of field 0 */
 };
 
-static byteoffset_t initial_ofs = 1; /* Initial value of object offsets */
-static byteoffset_t obj_counter;     /* Number of objects emitted so far */
-static struct extern_obj * extern_table = NULL; /* Table of objects seen */
-static unsigned long extern_table_size;
-static unsigned long extern_table_mask;
-static unsigned int extern_hash_shift;
-/* extern_table_size, extern_table_mask and extern_hash_shift are such that
-      extern_table_size == 1 << (wordsize - extern_hash_shift)
-      extern_table_mask == extern_table_size - 1  */
-
-/* Multiplicative Fibonacci hashing (Knuth vol 3, section 6.4, page 518).
-   HASH_FACTOR is (sqrt(5) - 1) / 2 * 2^wordsize. */
-#ifdef ARCH_SIXTYFOUR
-#define HASH_FACTOR 11400714819323198485UL
-#else
-#define HASH_FACTOR 2654435769UL
-#endif
-#define Hash(v) (((unsigned long)(v) * HASH_FACTOR) >> extern_hash_shift)
-
-/* Allocate a new extern table */
-static void alloc_extern_table(void)
-{
-  asize_t i;
-  extern_table = (struct extern_obj *)
-                 caml_stat_alloc(extern_table_size * sizeof(struct extern_obj));
-  for (i = 0; i < extern_table_size; i++) extern_table[i].ofs = 0;
-}
-
-/* Grow the extern table */
-static void resize_extern_table(void)
-{
-  asize_t oldsize;
-  struct extern_obj * oldtable;
-  value obj;
-  byteoffset_t ofs;
-  asize_t i, h;
-
-  oldsize = extern_table_size;
-  oldtable = extern_table;
-  extern_hash_shift = extern_hash_shift - 1;
-  extern_table_size = 2 * extern_table_size;
-  extern_table_mask = extern_table_size - 1;
-  alloc_extern_table();
-  for (i = 0; i < oldsize; i++) {
-    ofs = oldtable[i].ofs;
-    if (ofs >= initial_ofs) {
-      obj = oldtable[i].obj;
-      h = Hash(obj);
-      while (extern_table[h].ofs > 0) h = (h + 1) & extern_table_mask;
-      extern_table[h].ofs = ofs;
-      extern_table[h].obj = obj;
+struct trail_block {
+  struct trail_block * previous;
+  struct trail_entry entries[ENTRIES_PER_TRAIL_BLOCK];
+};
+
+static struct trail_block extern_trail_first;
+static struct trail_block * extern_trail_block;
+static struct trail_entry * extern_trail_cur, * extern_trail_limit;
+
+/* Forward declarations */
+
+static void extern_out_of_memory(void);
+
+
+/* Initialize the trail */
+
+static void init_extern_trail(void)
+{
+  extern_trail_block = &extern_trail_first;
+  extern_trail_cur = extern_trail_block->entries;
+  extern_trail_limit = extern_trail_block->entries + ENTRIES_PER_TRAIL_BLOCK;
+}
+
+/* Replay the trail, undoing the in-place modifications
+   performed on objects */
+
+static void extern_replay_trail(void)
+{
+  struct trail_block * blk, * prevblk;
+  struct trail_entry * ent, * lim;
+
+  blk = extern_trail_block;
+  lim = extern_trail_cur;
+  while (1) {
+    for (ent = &(blk->entries[0]); ent < lim; ent++) {
+      value obj = ent->obj;
+      color_t colornum = obj & 3;
+      obj = obj & ~3;
+      Hd_val(obj) = Coloredhd_hd(Hd_val(obj), colornum);
+      Field(obj, 0) = ent->field0;
     }
+    if (blk == &extern_trail_first) break;
+    prevblk = blk->previous;
+    free(blk);
+    blk = prevblk;
+    lim = &(blk->entries[ENTRIES_PER_TRAIL_BLOCK]);
   }
-  caml_stat_free(oldtable);
+  /* Protect against a second call to extern_replay_trail */
+  extern_trail_block = &extern_trail_first;
+  extern_trail_cur = extern_trail_block->entries;
 }
 
-/* Free the extern table. We keep it around for next call if
-   it's still small (we did not grow it) and the initial offset
-   does not risk overflowing next time. */
-static void free_extern_table(void)
+/* Set forwarding pointer on an object and add corresponding entry
+   to the trail. */
+
+static void extern_record_location(value obj)
 {
-  if (extern_table_size > INITIAL_EXTERN_TABLE_SIZE ||
-      initial_ofs >= INITIAL_OFFSET_MAX) {
-    caml_stat_free(extern_table);
-    extern_table = NULL;
+  header_t hdr;
+
+  if (extern_ignore_sharing) return;
+  if (extern_trail_cur == extern_trail_limit) {
+    struct trail_block * new_block = malloc(sizeof(struct trail_block));
+    if (new_block == NULL) extern_out_of_memory();
+    new_block->previous = extern_trail_block;
+    extern_trail_block = new_block;
+    extern_trail_cur = extern_trail_block->entries;
+    extern_trail_limit = extern_trail_block->entries + ENTRIES_PER_TRAIL_BLOCK;
   }
+  hdr = Hd_val(obj);
+  extern_trail_cur->obj = obj | Colornum_hd(hdr);
+  extern_trail_cur->field0 = Field(obj, 0);
+  extern_trail_cur++;
+  Hd_val(obj) = Bluehd_hd(hdr);
+  Field(obj, 0) = (value) obj_counter;
+  obj_counter++;
 }
 
 /* To buffer the output */
 
-static char * extern_block, * extern_ptr, * extern_limit;
-static int extern_block_malloced;
+static char * extern_userprovided_output;
+static char * extern_ptr, * extern_limit;
+
+struct output_block {
+  struct output_block * next;
+  char * end;
+  char data[SIZE_EXTERN_OUTPUT_BLOCK];
+};
 
-static void alloc_extern_block(void)
+static struct output_block * extern_output_first, * extern_output_block;
+
+static void init_extern_output(void)
 {
-  extern_block = caml_stat_alloc(INITIAL_EXTERN_BLOCK_SIZE);
-  extern_limit = extern_block + INITIAL_EXTERN_BLOCK_SIZE;
-  extern_ptr = extern_block;
-  extern_block_malloced = 1;
+  extern_userprovided_output = NULL;
+  extern_output_first = malloc(sizeof(struct output_block));
+  if (extern_output_first == NULL) caml_raise_out_of_memory();
+  extern_output_block = extern_output_first;
+  extern_output_block->next = NULL;
+  extern_ptr = extern_output_block->data;
+  extern_limit = extern_output_block->data + SIZE_EXTERN_OUTPUT_BLOCK;
 }
 
-static void resize_extern_block(int required)
+static void free_extern_output(void)
 {
-  long curr_pos, size, reqd_size;
+  struct output_block * blk, * nextblk;
+
+  if (extern_userprovided_output != NULL) return;
+  for (blk = extern_output_first; blk != NULL; blk = nextblk) {
+    nextblk = blk->next;
+    free(blk);
+  }
+  extern_output_first = NULL;
+}
 
-  if (! extern_block_malloced) {
-    initial_ofs += obj_counter;
-    free_extern_table();
+static void grow_extern_output(intnat required)
+{
+  struct output_block * blk;
+  intnat extra;
+
+  if (extern_userprovided_output != NULL) {
+    extern_replay_trail();
     caml_failwith("Marshal.to_buffer: buffer overflow");
   }
-  curr_pos = extern_ptr - extern_block;
-  size = extern_limit - extern_block;
-  reqd_size = curr_pos + required;
-  while (size <= reqd_size) size *= 2;
-  extern_block = caml_stat_resize(extern_block, size);
-  extern_limit = extern_block + size;
-  extern_ptr = extern_block + curr_pos;
+  extern_output_block->end = extern_ptr;
+  if (required <= SIZE_EXTERN_OUTPUT_BLOCK / 2)
+    extra = 0;
+  else
+    extra = required;
+  blk = malloc(sizeof(struct output_block) + extra);
+  if (blk == NULL) extern_out_of_memory();
+  extern_output_block->next = blk;
+  extern_output_block = blk;
+  extern_output_block->next = NULL;
+  extern_ptr = extern_output_block->data;
+  extern_limit = extern_output_block->data + SIZE_EXTERN_OUTPUT_BLOCK + extra;
+}
+
+static intnat extern_output_length(void)
+{
+  struct output_block * blk;
+  intnat len;
+
+  if (extern_userprovided_output != NULL) {
+    return extern_ptr - extern_userprovided_output;
+  } else {
+    for (len = 0, blk = extern_output_first; blk != NULL; blk = blk->next)
+      len += blk->end - blk->data;
+    return len;
+  }
+}
+
+/* Exception raising, with cleanup */
+
+static void extern_out_of_memory(void)
+{
+  extern_replay_trail();
+  free_extern_output();
+  caml_raise_out_of_memory();
+}
+
+extern void extern_invalid_argument(char *msg)
+{
+  extern_replay_trail();
+  free_extern_output();
+  caml_invalid_argument(msg);
 }
 
 /* Write characters, integers, and blocks in the output buffer */
 
 #define Write(c) \
-  if (extern_ptr >= extern_limit) resize_extern_block(1); \
+  if (extern_ptr >= extern_limit) grow_extern_output(1); \
   *extern_ptr++ = (c)
 
-static void writeblock(char *data, long int len)
+static void writeblock(char *data, intnat len)
 {
-  if (extern_ptr + len > extern_limit) resize_extern_block(len);
+  if (extern_ptr + len > extern_limit) grow_extern_output(len);
   memmove(extern_ptr, data, len);
   extern_ptr += len;
 }
@@ -158,26 +230,26 @@ static void writeblock(char *data, long int len)
   caml_serialize_block_float_8((data), (ndoubles))
 #endif
 
-static void writecode8(int code, long int val)
+static void writecode8(int code, intnat val)
 {
-  if (extern_ptr + 2 > extern_limit) resize_extern_block(2);
+  if (extern_ptr + 2 > extern_limit) grow_extern_output(2);
   extern_ptr[0] = code;
   extern_ptr[1] = val;
   extern_ptr += 2;
 }
 
-static void writecode16(int code, long int val)
+static void writecode16(int code, intnat val)
 {
-  if (extern_ptr + 3 > extern_limit) resize_extern_block(3);
+  if (extern_ptr + 3 > extern_limit) grow_extern_output(3);
   extern_ptr[0] = code;
   extern_ptr[1] = val >> 8;
   extern_ptr[2] = val;
   extern_ptr += 3;
 }
 
-static void write32(long int val)
+static void write32(intnat val)
 {
-  if (extern_ptr + 4 > extern_limit) resize_extern_block(4);
+  if (extern_ptr + 4 > extern_limit) grow_extern_output(4);
   extern_ptr[0] = val >> 24;
   extern_ptr[1] = val >> 16;
   extern_ptr[2] = val >> 8;
@@ -185,9 +257,9 @@ static void write32(long int val)
   extern_ptr += 4;
 }
 
-static void writecode32(int code, long int val)
+static void writecode32(int code, intnat val)
 {
-  if (extern_ptr + 5 > extern_limit) resize_extern_block(5);
+  if (extern_ptr + 5 > extern_limit) grow_extern_output(5);
   extern_ptr[0] = code;
   extern_ptr[1] = val >> 24;
   extern_ptr[2] = val >> 16;
@@ -197,10 +269,10 @@ static void writecode32(int code, long int val)
 }
 
 #ifdef ARCH_SIXTYFOUR
-static void writecode64(int code, long val)
+static void writecode64(int code, intnat val)
 {
   int i;
-  if (extern_ptr + 9 > extern_limit) resize_extern_block(9);
+  if (extern_ptr + 9 > extern_limit) grow_extern_output(9);
   *extern_ptr ++ = code;
   for (i = 64 - 8; i >= 0; i -= 8) *extern_ptr++ = val >> i;
 }
@@ -282,26 +354,11 @@ CAMLexport value caml_get_saved_value(int idx)
 
 /* Marshal the given value in the output buffer */
 
-static unsigned long size_32;  /* Size in words of 32-bit block for struct. */
-static unsigned long size_64;  /* Size in words of 64-bit block for struct. */
-
-static int extern_ignore_sharing; /* Flag to ignore sharing */
-static int extern_closures;     /* Flag to allow externing code pointers */
-
-
-extern void extern_invalid_argument(char *msg)
-{
-  if (extern_block_malloced) caml_stat_free(extern_block);
-  initial_ofs += obj_counter;
-  free_extern_table();
-  caml_invalid_argument(msg);
-}
-
 static void extern_rec(value v)
 {
  tailcall:
   if (Is_long(v)) {
-    long n = Long_val(v);
+    intnat n = Long_val(v);
     if (n >= 0 && n < 0x40) {
       Write(PREFIX_SMALL_INT + n);
     } else if (n >= -(1 << 7) && n < (1 << 7)) {
@@ -320,7 +377,6 @@ static void extern_rec(value v)
     header_t hd = Hd_val(v);
     tag_t tag = Tag_hd(hd);
     mlsize_t sz = Wosize_hd(hd);
-    asize_t h;
     char ctag ;
 
     if (tag == Forward_tag) {
@@ -345,28 +401,18 @@ static void extern_rec(value v)
       return;
     }
     /* Check if already seen */
-    if (! extern_ignore_sharing && tag != Infix_tag) {
-      if (2 * obj_counter >= extern_table_size) resize_extern_table();
-      h = Hash(v);
-      while (extern_table[h].ofs >= initial_ofs) {
-        if (extern_table[h].obj == v) {
-          byteoffset_t d = obj_counter - (extern_table[h].ofs - initial_ofs);
-          if (d < 0x100) {
-            writecode8(CODE_SHARED8, d);
-          } else if (d < 0x10000) {
-            writecode16(CODE_SHARED16, d);
-          } else {
-            writecode32(CODE_SHARED32, d);
-          }
-          return;
-        }
-        h = (h + 1) & extern_table_mask;
+    if (Color_hd(hd) == Caml_blue) {
+      uintnat d = obj_counter - (uintnat) Field(v, 0);
+      if (d < 0x100) {
+        writecode8(CODE_SHARED8, d);
+      } else if (d < 0x10000) {
+        writecode16(CODE_SHARED16, d);
+      } else {
+        writecode32(CODE_SHARED32, d);
       }
-      /* Not seen yet. Record the object */
-      extern_table[h].ofs = initial_ofs + obj_counter;
-      extern_table[h].obj = v;
-      obj_counter++;
+      return;
     }
+
     /* Output the contents of the object */
     switch(tag) {
     case String_tag: {
@@ -381,6 +427,7 @@ static void extern_rec(value v)
       writeblock(String_val(v), len);
       size_32 += 1 + (len + 4) / 4;
       size_64 += 1 + (len + 8) / 8;
+      extern_record_location(v);
       break;
     }
     case Double_tag: {
@@ -390,6 +437,7 @@ static void extern_rec(value v)
       writeblock_float8((double *) v, 1);
       size_32 += 1 + 2;
       size_64 += 1 + 1;
+      extern_record_location(v);
       break;
     }
     case Double_array_tag: {
@@ -405,6 +453,7 @@ static void extern_rec(value v)
       writeblock_float8((double *) v, nfloats);
       size_32 += 1 + nfloats * 2;
       size_64 += 1 + nfloats;
+      extern_record_location(v);
       break;
     }
     case Abstract_tag:
@@ -414,13 +463,7 @@ static void extern_rec(value v)
       writecode32(CODE_INFIXPOINTER, Infix_offset_hd(hd));
       extern_rec(v - Infix_offset_hd(hd));
       break;
-    /* Use default case for objects
-    case Object_tag:
-      extern_invalid_argument("output_value: object value");
-      break;
-    */
     case Custom_tag:
-   /* > JOCAML */
       ctag = CODE_CUSTOM ;
       goto custom;
     case JoCustom_tag:
@@ -428,10 +471,10 @@ static void extern_rec(value v)
     custom:
    /* < JOCAML */
     {
-      unsigned long sz_32, sz_64;
+      uintnat sz_32, sz_64;
       char * ident = Custom_ops_val(v)->identifier;
-      void (*serialize)(value v, unsigned long * wsize_32,
-                        unsigned long * wsize_64)
+      void (*serialize)(value v, uintnat * wsize_32,
+                        uintnat * wsize_64)
         = Custom_ops_val(v)->serialize;
       if (serialize == NULL) 
         extern_invalid_argument("output_value: abstract value (Custom)");
@@ -440,11 +483,10 @@ static void extern_rec(value v)
       Custom_ops_val(v)->serialize(v, &sz_32, &sz_64);
       size_32 += 2 + ((sz_32 + 3) >> 2);  /* header + ops + data */
       size_64 += 2 + ((sz_64 + 7) >> 3);
+      extern_record_location(v);
       break;
     }
-    default:
-    /* >JOCAML */
-    {
+    default: {
       int ofs = caml_find_saved_value(v) ;
       if (ofs >= 0) {
         Write(CODE_SAVEDVALUE) ;
@@ -454,6 +496,7 @@ static void extern_rec(value v)
     }
     /* <JOCAML */
      {
+      value field0;
       mlsize_t i;
       if (tag < 16 && sz < 8) {
         Write(PREFIX_SMALL_BLOCK + tag + (sz << 4));
@@ -466,14 +509,21 @@ static void extern_rec(value v)
       }
       size_32 += 1 + sz;
       size_64 += 1 + sz;
-      for (i = 0; i < sz - 1; i++) extern_rec(Field(v, i));
-      v = Field(v, i);
-      goto tailcall;
+      field0 = Field(v, 0);
+      extern_record_location(v);
+      if (sz == 1) {
+        v = field0;
+      } else {
+        extern_rec(field0);
+        for (i = 1; i < sz - 1; i++) extern_rec(Field(v, i));
+        v = Field(v, i);
       }
+      goto tailcall;
+    }
     }
-    return;
   }
-  if ((char *) v >= caml_code_area_start && (char *) v < caml_code_area_end) {
+  else if ((char *) v >= caml_code_area_start &&
+           (char *) v < caml_code_area_end) {
     /* >JOCAML */
     int ofs = caml_find_saved_code((code_t)v) ;
     if (ofs >= 0) {
@@ -486,30 +536,24 @@ static void extern_rec(value v)
       extern_invalid_argument("output_value: functional value");
     writecode32(CODE_CODEPOINTER, (char *) v - caml_code_area_start);
     writeblock((char *) caml_code_checksum(), 16);
-    return;
+  } else {
+    extern_invalid_argument("output_value: abstract value (outside heap)");
   }
-  extern_invalid_argument("output_value: abstract value (outside heap)");
 }
 
 enum { NO_SHARING = 1, CLOSURES = 2 };
 static int extern_flags[] = { NO_SHARING, CLOSURES };
 
-static long extern_value(value v, value flags)
+static intnat extern_value(value v, value flags)
 {
-  long res_len;
+  intnat res_len;
   int fl;
   /* Parse flag list */
   fl = caml_convert_flag_list(flags, extern_flags);
   extern_ignore_sharing = fl & NO_SHARING;
   extern_closures = fl & CLOSURES;
-  /* Allocate hashtable of objects already seen, if needed */
-  extern_table_size = INITIAL_EXTERN_TABLE_SIZE;
-  extern_table_mask = extern_table_size - 1;
-  extern_hash_shift = 8 * sizeof(value) - INITIAL_EXTERN_TABLE_SIZE_LOG2;
-  if (extern_table == NULL) {
-    alloc_extern_table();
-    initial_ofs = 1;
-  }
+  /* Initializations */
+  init_extern_trail();
   obj_counter = 0;
   size_32 = 0;
   size_64 = 0;
@@ -519,46 +563,54 @@ static long extern_value(value v, value flags)
   extern_ptr += 4*4;
   /* Marshal the object */
   extern_rec(v);
-  /* Update initial offset for next call to extern_value(),
-     if we decide to keep the table of shared objects. */
-  initial_ofs += obj_counter;
-  /* Free the table of shared objects (if needed) */
-  free_extern_table();
+  /* Record end of output */
+  extern_output_block->end = extern_ptr;
+  /* Undo the modifications done on externed blocks */
+  extern_replay_trail();
   /* Write the sizes */
-  res_len = extern_ptr - extern_block;
+  res_len = extern_output_length();
 #ifdef ARCH_SIXTYFOUR
   if (res_len >= (1L << 32) ||
       size_32 >= (1L << 32) || size_64 >= (1L << 32)) {
     /* The object is so big its size cannot be written in the header.
        Besides, some of the array lengths or string lengths or shared offsets
        it contains may have overflowed the 32 bits used to write them. */
+    free_extern_output();
     caml_failwith("output_value: object too big");
   }
 #endif
-  extern_ptr = extern_block + 4;
+  if (extern_userprovided_output != NULL)
+    extern_ptr = extern_userprovided_output + 4;
+  else {
+    extern_ptr = extern_output_first->data + 4;
+    extern_limit = extern_output_first->data + SIZE_EXTERN_OUTPUT_BLOCK;
+  }
   write32(res_len - 5*4);
   write32(obj_counter);
   write32(size_32);
   write32(size_64);
-  /* Result is res_len bytes starting at extern_block */
   return res_len;
 }
 
 void caml_output_val(struct channel *chan, value v, value flags)
 {
-  long len;
-  char * block;
+  intnat len;
+  struct output_block * blk, * nextblk;
 
   if (! caml_channel_binary_mode(chan))
     caml_failwith("output_value: not a binary channel");
-  alloc_extern_block();
+  init_extern_output();
   len = extern_value(v, flags);
   /* During [caml_really_putblock], concurrent [caml_output_val] operations
      can take place (via signal handlers or context switching in systhreads),
-     and [extern_block] may change. So, save the pointer in a local variable. */
-  block = extern_block;
-  caml_really_putblock(chan, extern_block, len);
-  caml_stat_free(block);
+     and [extern_output_first] may change. So, save it in a local variable. */
+  blk = extern_output_first;
+  while (blk != NULL) {
+    caml_really_putblock(chan, blk->data, blk->end - blk->data);
+    nextblk = blk->next;
+    free(blk);
+    blk = nextblk;
+  }
 }
 
 CAMLprim value caml_output_value(value vchan, value v, value flags)
@@ -574,47 +626,62 @@ CAMLprim value caml_output_value(value vchan, value v, value flags)
 
 CAMLprim value caml_output_value_to_string(value v, value flags)
 {
-  long len;
+  intnat len, ofs;
   value res;
-  alloc_extern_block();
+  struct output_block * blk;
+
+  init_extern_output();
   len = extern_value(v, flags);
   res = caml_alloc_string(len);
-  memmove(String_val(res), extern_block, len);
-  caml_stat_free(extern_block);
+  for (ofs = 0, blk = extern_output_first; blk != NULL; blk = blk->next) {
+    int n = blk->end - blk->data;
+    memmove(&Byte(res, ofs), blk->data, n);
+    ofs += n;
+  }
+  free_extern_output();
   return res;
 }
 
 CAMLprim value caml_output_value_to_buffer(value buf, value ofs, value len,
                                            value v, value flags)
 {
-  long len_res;
-  extern_block = &Byte(buf, Long_val(ofs));
-  extern_limit = extern_block + Long_val(len);
-  extern_ptr = extern_block;
-  extern_block_malloced = 0;
+  intnat len_res;
+  extern_userprovided_output = &Byte(buf, Long_val(ofs));
+  extern_ptr = extern_userprovided_output;
+  extern_limit = extern_userprovided_output + Long_val(len);
   len_res = extern_value(v, flags);
   return Val_long(len_res);
 }
 
 CAMLexport void caml_output_value_to_malloc(value v, value flags,
                                             /*out*/ char ** buf,
-                                            /*out*/ long * len)
+                                            /*out*/ intnat * len)
 {
-  long len_res;
-  alloc_extern_block();
+  intnat len_res;
+  char * res;
+  struct output_block * blk;
+
+  init_extern_output();
   len_res = extern_value(v, flags);
-  *buf = extern_block;
+  res = malloc(len_res);
+  if (res == NULL) extern_out_of_memory();
+  *buf = res;
   *len = len_res;
+  for (blk = extern_output_first; blk != NULL; blk = blk->next) {
+    int n = blk->end - blk->data;
+    memmove(res, blk->data, n);
+    res += n;
+  }
+  free_extern_output();
 }
 
-CAMLexport long caml_output_value_to_block(value v, value flags,
-                                           char * buf, long len)
+CAMLexport intnat caml_output_value_to_block(value v, value flags,
+                                             char * buf, intnat len)
 {
-  long len_res;
-  extern_block = buf;
-  extern_limit = extern_block + len;
-  extern_ptr = extern_block;
-  extern_block_malloced = 0;
+  intnat len_res;
+  extern_userprovided_output = buf;
+  extern_ptr = extern_userprovided_output;
+  extern_limit = extern_userprovided_output + len;
   len_res = extern_value(v, flags);
   return len_res;
 }
@@ -623,14 +690,14 @@ CAMLexport long caml_output_value_to_block(value v, value flags,
 
 CAMLexport void caml_serialize_int_1(int i)
 {
-  if (extern_ptr + 1 > extern_limit) resize_extern_block(1);
+  if (extern_ptr + 1 > extern_limit) grow_extern_output(1);
   extern_ptr[0] = i;
   extern_ptr += 1;
 }
 
 CAMLexport void caml_serialize_int_2(int i)
 {
-  if (extern_ptr + 2 > extern_limit) resize_extern_block(2);
+  if (extern_ptr + 2 > extern_limit) grow_extern_output(2);
   extern_ptr[0] = i >> 8;
   extern_ptr[1] = i;
   extern_ptr += 2;
@@ -638,7 +705,7 @@ CAMLexport void caml_serialize_int_2(int i)
 
 CAMLexport void caml_serialize_int_4(int32 i)
 {
-  if (extern_ptr + 4 > extern_limit) resize_extern_block(4);
+  if (extern_ptr + 4 > extern_limit) grow_extern_output(4);
   extern_ptr[0] = i >> 24;
   extern_ptr[1] = i >> 16;
   extern_ptr[2] = i >> 8;
@@ -661,16 +728,16 @@ CAMLexport void caml_serialize_float_8(double f)
   caml_serialize_block_8(&f, 1);
 }
 
-CAMLexport void caml_serialize_block_1(void * data, long len)
+CAMLexport void caml_serialize_block_1(void * data, intnat len)
 {
-  if (extern_ptr + len > extern_limit) resize_extern_block(len);
+  if (extern_ptr + len > extern_limit) grow_extern_output(len);
   memmove(extern_ptr, data, len);
   extern_ptr += len;
 }
 
-CAMLexport void caml_serialize_block_2(void * data, long len)
+CAMLexport void caml_serialize_block_2(void * data, intnat len)
 {
-  if (extern_ptr + 2 * len > extern_limit) resize_extern_block(2 * len);
+  if (extern_ptr + 2 * len > extern_limit) grow_extern_output(2 * len);
 #ifndef ARCH_BIG_ENDIAN
   {
     unsigned char * p;
@@ -685,9 +752,9 @@ CAMLexport void caml_serialize_block_2(void * data, long len)
 #endif
 }
 
-CAMLexport void caml_serialize_block_4(void * data, long len)
+CAMLexport void caml_serialize_block_4(void * data, intnat len)
 {
-  if (extern_ptr + 4 * len > extern_limit) resize_extern_block(4 * len);
+  if (extern_ptr + 4 * len > extern_limit) grow_extern_output(4 * len);
 #ifndef ARCH_BIG_ENDIAN
   {
     unsigned char * p;
@@ -702,9 +769,9 @@ CAMLexport void caml_serialize_block_4(void * data, long len)
 #endif
 }
 
-CAMLexport void caml_serialize_block_8(void * data, long len)
+CAMLexport void caml_serialize_block_8(void * data, intnat len)
 {
-  if (extern_ptr + 8 * len > extern_limit) resize_extern_block(8 * len);
+  if (extern_ptr + 8 * len > extern_limit) grow_extern_output(8 * len);
 #ifndef ARCH_BIG_ENDIAN
   {
     unsigned char * p;
@@ -719,9 +786,9 @@ CAMLexport void caml_serialize_block_8(void * data, long len)
 #endif
 }
 
-CAMLexport void caml_serialize_block_float_8(void * data, long len)
+CAMLexport void caml_serialize_block_float_8(void * data, intnat len)
 {
-  if (extern_ptr + 8 * len > extern_limit) resize_extern_block(8 * len);
+  if (extern_ptr + 8 * len > extern_limit) grow_extern_output(8 * len);
 #if ARCH_FLOAT_ENDIANNESS == 0x01234567
   memmove(extern_ptr, data, len * 8);
   extern_ptr += len * 8;
diff --git a/byterun/fail.c b/byterun/fail.c
index 64d766fe4f..7adfcccfcf 100644
--- a/byterun/fail.c
+++ b/byterun/fail.c
@@ -31,10 +31,6 @@ value caml_exn_bucket;
 
 CAMLexport void caml_raise(value v)
 {
-#ifdef DEBUG
-  extern int volatile caml_async_signal_mode;  /* from signals.c */
-  Assert(! caml_async_signal_mode);
-#endif
   Unlock_exn();
   caml_exn_bucket = v;
   if (caml_external_raise == NULL) caml_fatal_uncaught_exception(v);
diff --git a/byterun/finalise.c b/byterun/finalise.c
index 20b0394891..e411311489 100644
--- a/byterun/finalise.c
+++ b/byterun/finalise.c
@@ -27,7 +27,7 @@ struct final {
 };
 
 static struct final *final_table = NULL;
-static unsigned long old = 0, young = 0, size = 0;
+static uintnat old = 0, young = 0, size = 0;
 /* [0..old) : finalisable set
    [old..young) : recent set
    [young..size) : free space
@@ -65,8 +65,8 @@ static void alloc_to_do (int size)
 */
 void caml_final_update (void)
 {
-  unsigned long i, j, k;
-  unsigned long todo_count = 0;
+  uintnat i, j, k;
+  uintnat todo_count = 0;
   
   Assert (young == old);
   for (i = 0; i < old; i++){
@@ -154,7 +154,7 @@ void caml_final_do_calls (void)
 */
 void caml_final_do_strong_roots (scanning_action f)
 {
-  unsigned long i;
+  uintnat i;
   struct to_do *todo;
 
   Assert (old == young);
@@ -174,7 +174,7 @@ void caml_final_do_strong_roots (scanning_action f)
 */
 void caml_final_do_weak_roots (scanning_action f)
 {
-  unsigned long i;
+  uintnat i;
 
   Assert (old == young);
   for (i = 0; i < old; i++) Call_action (f, final_table[i].val);
@@ -185,7 +185,7 @@ void caml_final_do_weak_roots (scanning_action f)
 */
 void caml_final_do_young_roots (scanning_action f)
 {
-  unsigned long i;
+  uintnat i;
   
   Assert (old <= young);
   for (i = old; i < young; i++){
@@ -213,13 +213,13 @@ CAMLprim value caml_final_register (value f, value v)
   
   if (young >= size){
     if (final_table == NULL){
-      unsigned long new_size = 30;
+      uintnat new_size = 30;
       final_table = caml_stat_alloc (new_size * sizeof (struct final));
       Assert (old == 0);
       Assert (young == 0);
       size = new_size;
     }else{
-      unsigned long new_size = size * 2;
+      uintnat new_size = size * 2;
       final_table = caml_stat_resize (final_table,
                                       new_size * sizeof (struct final));
       size = new_size;
diff --git a/byterun/floats.c b/byterun/floats.c
index 16cbb5abaf..e94a4c506b 100644
--- a/byterun/floats.c
+++ b/byterun/floats.c
@@ -106,6 +106,37 @@ CAMLprim value caml_format_float(value fmt, value arg)
   return res;
 }
 
+/*CAMLprim*/ value caml_float_of_substring(value vs, value idx, value l)
+{
+  char parse_buffer[64];
+  char * buf, * src, * dst, * end;
+  mlsize_t len, lenvs;
+  double d;
+  intnat flen = Long_val(l);
+  intnat fidx = Long_val(idx);
+
+  lenvs = caml_string_length(vs);
+  len =
+    fidx >= 0 && fidx < lenvs && flen > 0 && flen <= lenvs - fidx
+    ? flen : 0;
+  buf = len < sizeof(parse_buffer) ? parse_buffer : caml_stat_alloc(len + 1);
+  src = String_val(vs) + fidx;
+  dst = buf;
+  while (len--) {
+    char c = *src++;
+    if (c != '_') *dst++ = c;
+  }
+  *dst = 0;
+  if (dst == buf) goto error;
+  d = strtod((const char *) buf, &end);
+  if (end != dst) goto error;
+  if (buf != parse_buffer) caml_stat_free(buf);
+  return caml_copy_double(d);
+ error:
+  if (buf != parse_buffer) caml_stat_free(buf);
+  caml_failwith("float_of_string");
+}
+
 CAMLprim value caml_float_of_string(value vs)
 {
   char parse_buffer[64];
@@ -122,16 +153,19 @@ CAMLprim value caml_float_of_string(value vs)
     if (c != '_') *dst++ = c;
   }
   *dst = 0;
-  if (dst == buf) caml_failwith("float_of_string");
+  if (dst == buf) goto error;
   d = strtod((const char *) buf, &end);
+  if (end != dst) goto error;
   if (buf != parse_buffer) caml_stat_free(buf);
-  if (end != dst) caml_failwith("float_of_string");
   return caml_copy_double(d);
+ error:
+  if (buf != parse_buffer) caml_stat_free(buf);
+  caml_failwith("float_of_string");
 }
 
 CAMLprim value caml_int_of_float(value f)
 {
-  return Val_long((long) Double_val(f));
+  return Val_long((intnat) Double_val(f));
 }
 
 CAMLprim value caml_float_of_int(value n)
diff --git a/byterun/freelist.c b/byterun/freelist.c
index 00b095e960..c463d91f79 100644
--- a/byterun/freelist.c
+++ b/byterun/freelist.c
@@ -55,7 +55,7 @@ static void fl_check (void)
 {
   char *cur, *prev;
   int prev_found = 0, merge_found = 0;
-  unsigned long size_found = 0;
+  uintnat size_found = 0;
 
   prev = Fl_head;
   cur = Next (prev);
diff --git a/byterun/gc.h b/byterun/gc.h
index 5784fe5518..50d9945a8d 100644
--- a/byterun/gc.h
+++ b/byterun/gc.h
@@ -51,5 +51,8 @@
 #define Is_blue_val(val) (Color_val(val) == Caml_blue)
 #define Is_black_val(val) (Color_val(val) == Caml_black)
 
+/* For extern.c */
+#define Colornum_hd(hd) ((color_t) (((hd) >> 8) & 3))
+#define Coloredhd_hd(hd,colnum) (((hd) & ~Caml_black) | ((colnum) << 8))
 
 #endif /* CAML_GC_H */
diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c
index 4dc49b8b3a..12bfc9b0a1 100644
--- a/byterun/gc_ctrl.c
+++ b/byterun/gc_ctrl.c
@@ -26,23 +26,23 @@
 #include "stacks.h"
 
 #ifndef NATIVE_CODE
-extern unsigned long caml_max_stack_size;    /* defined in stacks.c */
+extern uintnat caml_max_stack_size;    /* defined in stacks.c */
 #endif
 
 double caml_stat_minor_words = 0.0,
        caml_stat_promoted_words = 0.0,
        caml_stat_major_words = 0.0;
 
-long caml_stat_minor_collections = 0,
-     caml_stat_major_collections = 0,
-     caml_stat_heap_size = 0,              /* bytes */
-     caml_stat_top_heap_size = 0,          /* bytes */
-     caml_stat_compactions = 0,
-     caml_stat_heap_chunks = 0;
+intnat caml_stat_minor_collections = 0,
+       caml_stat_major_collections = 0,
+       caml_stat_heap_size = 0,              /* bytes */
+       caml_stat_top_heap_size = 0,          /* bytes */
+       caml_stat_compactions = 0,
+       caml_stat_heap_chunks = 0;
 
 extern asize_t caml_major_heap_increment;  /* bytes; see major_gc.c */
-extern unsigned long caml_percent_free;    /*        see major_gc.c */
-extern unsigned long caml_percent_max;     /*        see compact.c */
+extern uintnat caml_percent_free;    /*        see major_gc.c */
+extern uintnat caml_percent_max;     /*        see compact.c */
 
 #define Next(hp) ((hp) + Bhsize_hp (hp))
 
@@ -75,24 +75,14 @@ static void check_head (value v)
 
 static void check_block (char *hp)
 {
-  mlsize_t nfields = Wosize_hp (hp);
   mlsize_t i;
   value v = Val_hp (hp);
   value f;
-  mlsize_t lastbyte;
   
   check_head (v);
   switch (Tag_hp (hp)){
   case Abstract_tag: break;
   case String_tag:
-    /* not true when [caml_check_urgent_gc] is called by [caml_alloc]
-       or caml_alloc_string:
-       lastbyte = Bosize_val (v) - 1;
-       i = Byte (v, lastbyte);
-       Assert (i >= 0);
-       Assert (i < sizeof (value));
-       Assert (Byte (v, lastbyte - i) == 0);
-    */
     break;
   case Double_tag:
     Assert (Wosize_val (v) == Double_wosize);
@@ -126,9 +116,9 @@ static void check_block (char *hp)
 static value heap_stats (int returnstats)
 {
   CAMLparam0 ();
-  long live_words = 0, live_blocks = 0,
-       free_words = 0, free_blocks = 0, largest_free = 0,
-       fragments = 0, heap_chunks = 0;
+  intnat live_words = 0, live_blocks = 0,
+         free_words = 0, free_blocks = 0, largest_free = 0,
+         fragments = 0, heap_chunks = 0;
   char *chunk = caml_heap_start, *chunk_end;
   char *cur_hp, *prev_hp;
   header_t cur_hd;
@@ -213,11 +203,11 @@ static value heap_stats (int returnstats)
                       + (double) Wsize_bsize (caml_young_end - caml_young_ptr);
     double prowords = caml_stat_promoted_words;
     double majwords = caml_stat_major_words + (double) caml_allocated_words;
-    long mincoll = caml_stat_minor_collections;
-    long majcoll = caml_stat_major_collections;
-    long heap_words = Wsize_bsize (caml_stat_heap_size);
-    long cpct = caml_stat_compactions;
-    long top_heap_words = Wsize_bsize (caml_stat_top_heap_size);
+    intnat mincoll = caml_stat_minor_collections;
+    intnat majcoll = caml_stat_major_collections;
+    intnat heap_words = Wsize_bsize (caml_stat_heap_size);
+    intnat cpct = caml_stat_compactions;
+    intnat top_heap_words = Wsize_bsize (caml_stat_top_heap_size);
 
     res = caml_alloc_tuple (15);
     Store_field (res, 0, caml_copy_double (minwords));
@@ -264,12 +254,12 @@ CAMLprim value caml_gc_quick_stat(value v)
                     + (double) Wsize_bsize (caml_young_end - caml_young_ptr);
   double prowords = caml_stat_promoted_words;
   double majwords = caml_stat_major_words + (double) caml_allocated_words;
-  long mincoll = caml_stat_minor_collections;
-  long majcoll = caml_stat_major_collections;
-  long heap_words = caml_stat_heap_size / sizeof (value);
-  long top_heap_words = caml_stat_top_heap_size / sizeof (value);
-  long cpct = caml_stat_compactions;
-  long heap_chunks = caml_stat_heap_chunks;
+  intnat mincoll = caml_stat_minor_collections;
+  intnat majcoll = caml_stat_major_collections;
+  intnat heap_words = caml_stat_heap_size / sizeof (value);
+  intnat top_heap_words = caml_stat_top_heap_size / sizeof (value);
+  intnat cpct = caml_stat_compactions;
+  intnat heap_chunks = caml_stat_heap_chunks;
 
   res = caml_alloc_tuple (15);
   Store_field (res, 0, caml_copy_double (minwords));
@@ -329,17 +319,17 @@ CAMLprim value caml_gc_get(value v)
 
 #define Max(x,y) ((x) < (y) ? (y) : (x))
 
-static unsigned long norm_pfree (long unsigned int p)
+static uintnat norm_pfree (uintnat p)
 {
   return Max (p, 1);
 }
 
-static unsigned long norm_pmax (long unsigned int p)
+static uintnat norm_pmax (uintnat p)
 {
   return p;
 }
 
-static long norm_heapincr (long unsigned int i)
+static intnat norm_heapincr (uintnat i)
 {
 #define Psv (Wsize_bsize (Page_size))
   i = ((i + Psv - 1) / Psv) * Psv;
@@ -347,7 +337,7 @@ static long norm_heapincr (long unsigned int i)
   return i;
 }
 
-static long norm_minsize (long int s)
+static intnat norm_minsize (intnat s)
 {
   if (s < Minor_heap_min) s = Minor_heap_min;
   if (s > Minor_heap_max) s = Minor_heap_max;
@@ -356,7 +346,7 @@ static long norm_minsize (long int s)
 
 CAMLprim value caml_gc_set(value v)
 {
-  unsigned long newpf, newpm;
+  uintnat newpf, newpm;
   asize_t newheapincr;
   asize_t newminsize;
 
@@ -409,8 +399,9 @@ static void test_and_compact (void)
   fp = 100.0 * caml_fl_cur_size
        / (Wsize_bsize (caml_stat_heap_size) - caml_fl_cur_size);
   if (fp > 1000000.0) fp = 1000000.0;
-  caml_gc_message (0x200, "Estimated overhead (lower bound) = %lu%%\n",
-                   (unsigned long) fp);
+  caml_gc_message (0x200, "Estimated overhead (lower bound) = %"
+                          ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
+                   (uintnat) fp);
   if (fp >= caml_percent_max && caml_stat_heap_chunks > 1){
     caml_gc_message (0x200, "Automatic compaction triggered.\n", 0);
     caml_compact_heap ();
@@ -457,11 +448,11 @@ CAMLprim value caml_gc_compaction(value v)
   return Val_unit;
 }
 
-void caml_init_gc (unsigned long minor_size, unsigned long major_size,
-                   unsigned long major_incr, unsigned long percent_fr,
-                   unsigned long percent_m)
+void caml_init_gc (uintnat minor_size, uintnat major_size,
+                   uintnat major_incr, uintnat percent_fr,
+                   uintnat percent_m)
 {
-  unsigned long major_heap_size = Bsize_wsize (norm_heapincr (major_size));
+  uintnat major_heap_size = Bsize_wsize (norm_heapincr (major_size));
 
 #ifdef DEBUG
   caml_gc_message (-1, "### O'Caml runtime: debug mode ###\n", 0);
diff --git a/byterun/gc_ctrl.h b/byterun/gc_ctrl.h
index b5a2e87f79..205636d590 100644
--- a/byterun/gc_ctrl.h
+++ b/byterun/gc_ctrl.h
@@ -23,7 +23,7 @@ extern double
      caml_stat_promoted_words,
      caml_stat_major_words;
 
-extern long
+extern intnat
      caml_stat_minor_collections,
      caml_stat_major_collections,
      caml_stat_heap_size,
@@ -31,8 +31,8 @@ extern long
      caml_stat_compactions,
      caml_stat_heap_chunks;
 
-void caml_init_gc (unsigned long, unsigned long, unsigned long,
-                   unsigned long, unsigned long);
+void caml_init_gc (uintnat, uintnat, uintnat,
+                   uintnat, uintnat);
 
 
 #ifdef DEBUG
diff --git a/byterun/globroots.c b/byterun/globroots.c
index e9d3d6c116..792da34d88 100644
--- a/byterun/globroots.c
+++ b/byterun/globroots.c
@@ -61,7 +61,7 @@ CAMLexport void caml_register_global_root(value *r)
   struct global_root * e, * f;
   int i, new_level;
   
-  Assert (((long) r & 3) == 0);  /* compact.c demands this (for now) */
+  Assert (((intnat) r & 3) == 0);  /* compact.c demands this (for now) */
 
   /* Init "cursor" to list head */
   e = (struct global_root *) &caml_global_roots;
diff --git a/byterun/hash.c b/byterun/hash.c
index 17748e3933..2b8a235756 100644
--- a/byterun/hash.c
+++ b/byterun/hash.c
@@ -21,8 +21,8 @@
 #include "custom.h"
 #include "memory.h"
 
-static unsigned long hash_accu;
-static long hash_univ_limit, hash_univ_count;
+static uintnat hash_accu;
+static intnat hash_univ_limit, hash_univ_count;
 
 static void hash_aux(value obj);
 
@@ -137,7 +137,7 @@ static void hash_aux(value obj)
 
   /* Otherwise, obj is a pointer outside the heap, to an object with
      a priori unknown structure. Use its physical address as hash key. */
-  Combine((long) obj);
+  Combine((intnat) obj);
 }
 
 /* Hashing variant tags */
diff --git a/byterun/instrtrace.c b/byterun/instrtrace.c
index 03260b41e3..1932e08f61 100644
--- a/byterun/instrtrace.c
+++ b/byterun/instrtrace.c
@@ -30,7 +30,7 @@
 
 extern code_t caml_start_code;
 
-long caml_icount = 0;
+intnat caml_icount = 0;
 
 void caml_stop_here () {}
 
@@ -78,20 +78,15 @@ void caml_disasm_instr(pc)
   fflush (stdout);
 }
 
-
-
-
-char *
-caml_instr_string (code_t pc)
+char * caml_instr_string (code_t pc)
 {
-  static char buf[96];
-  char nambuf[36];
+  static char buf[256];
+  char nambuf[128];
   int instr = *pc;
-  char *nam = 0;
-  memset (buf, 0, sizeof (buf));
-#define bufprintf(Fmt,...) snprintf(buf,sizeof(buf)-1,Fmt,##__VA_ARGS__)
+  char *nam;
+
   nam = (instr < 0 || instr > STOP)
-    ? (snprintf (nambuf, sizeof (nambuf), "???%d", instr), nambuf)
+    ? (sprintf (nambuf, "???%d", instr), nambuf)
     : names_of_instructions[instr];
   pc++;
   switch (instr) {
@@ -132,7 +127,7 @@ caml_instr_string (code_t pc)
   case OFFSETREF:
   case OFFSETCLOSURE:
   case PUSHOFFSETCLOSURE:
-    bufprintf ("%s %d", nam, pc[0]);
+    sprintf(buf, "%s %d", nam, pc[0]);
     break;
     /* Instructions with two operands */
   case APPTERM:
@@ -149,16 +144,16 @@ caml_instr_string (code_t pc)
   case BGEINT:
   case BULTINT:
   case BUGEINT:
-    bufprintf ("%s %d, %d", nam, pc[0], pc[1]);
+    sprintf(buf, "%s %d, %d", nam, pc[0], pc[1]);
     break;
   case SWITCH:
-    bufprintf ("SWITCH sz%#lx=%ld::ntag%ld nint%ld",
-	       (long) pc[0], (long) pc[0], (unsigned long) pc[0] >> 16,
-	       (unsigned long) pc[0] & 0xffff);
+    sprintf(buf, "SWITCH sz%#lx=%ld::ntag%ld nint%ld",
+            (long) pc[0], (long) pc[0], (unsigned long) pc[0] >> 16,
+            (unsigned long) pc[0] & 0xffff);
     break;
     /* Instructions with a C primitive as operand */
   case C_CALLN:
-    bufprintf ("%s %d,", nam, pc[0]);
+    sprintf(buf, "%s %d,", nam, pc[0]);
     pc++;
     /* fallthrough */
   case C_CALL1:
@@ -167,12 +162,12 @@ caml_instr_string (code_t pc)
   case C_CALL4:
   case C_CALL5:
     if (pc[0] < 0 || pc[0] >= caml_prim_name_table.size)
-      bufprintf ("%s unknown primitive %d", nam, pc[0]);
+      sprintf(buf, "%s unknown primitive %d", nam, pc[0]);
     else
-      bufprintf ("%s %s", nam, (char *) caml_prim_name_table.contents[pc[0]]);
+      sprintf(buf, "%s %s", nam, (char *) caml_prim_name_table.contents[pc[0]]);
     break;
   default:
-    bufprintf ("%s", nam);
+    sprintf(buf, "%s", nam);
     break;
   };
   return buf;
@@ -193,10 +188,10 @@ caml_trace_value_file (value v, code_t prog, int proglen, FILE * f)
 	   && (code_t) v < (code_t) ((char *) prog + proglen))
     fprintf (f, "=code@%d", (code_t) v - prog);
   else if (Is_long (v))
-    fprintf (f, "=long%ld", Long_val (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", (long*)caml_stack_high - (long*)v);
+    fprintf (f, "=stack_%d", (intnat*)caml_stack_high - (intnat*)v);
   else if (Is_block (v)) {
     int s = Wosize_val (v);
     int tg = Tag_val (v);
@@ -250,7 +245,6 @@ caml_trace_value_file (value v, code_t prog, int proglen, FILE * f)
   }
 }
 
-// added by Basile
 void
 caml_trace_accu_sp_file (value accu, value * sp, code_t prog, int proglen,
 			 FILE * f)
@@ -259,7 +253,8 @@ caml_trace_accu_sp_file (value accu, value * sp, code_t prog, int proglen,
   value *p;
   fprintf (f, "accu=");
   caml_trace_value_file (accu, prog, proglen, f);
-  fprintf (f, "\n sp=%#lx @%d:", (long) sp, caml_stack_high - sp);
+  fprintf (f, "\n sp=%#" ARCH_INTNAT_PRINTF_FORMAT "x @%d:",
+           (intnat) sp, 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);
@@ -270,4 +265,3 @@ caml_trace_accu_sp_file (value accu, value * sp, code_t prog, int proglen,
 }
 
 #endif /* DEBUG */
-/* eof $Id$ */
diff --git a/byterun/instrtrace.h b/byterun/instrtrace.h
index 9df4a62352..c1ca4a7ec0 100644
--- a/byterun/instrtrace.h
+++ b/byterun/instrtrace.h
@@ -23,7 +23,7 @@
 #include "misc.h"
 
 extern int caml_trace_flag;
-extern long caml_icount;
+extern intnat caml_icount;
 void caml_stop_here (void);
 void caml_disasm_instr (code_t pc);
 void caml_trace_value_file (value v, code_t prog, int proglen, FILE * f);
diff --git a/byterun/int64_emul.h b/byterun/int64_emul.h
index 1759af0e21..04e38656f3 100644
--- a/byterun/int64_emul.h
+++ b/byterun/int64_emul.h
@@ -21,7 +21,7 @@
 
 #include <math.h>
 
-#if ARCH_BIG_ENDIAN
+#ifdef ARCH_BIG_ENDIAN
 #define I64_literal(hi,lo) { hi, lo }
 #else
 #define I64_literal(hi,lo) { lo, hi }
@@ -239,10 +239,10 @@ static int64 I64_of_int32(int32 x)
 
 #define I64_to_int32(x) ((int32) (x).l)
 
-/* Note: we assume sizeof(long) = 4 here, which is true otherwise
+/* Note: we assume sizeof(intnat) = 4 here, which is true otherwise
    autoconfiguration would have selected native 64-bit integers */
-#define I64_of_long I64_of_int32
-#define I64_to_long I64_to_int32
+#define I64_of_intnat I64_of_int32
+#define I64_to_intnat I64_to_int32
 
 static double I64_to_double(int64 x)
 {
diff --git a/byterun/int64_native.h b/byterun/int64_native.h
index fc0d0dcfef..f5bef4a6f4 100644
--- a/byterun/int64_native.h
+++ b/byterun/int64_native.h
@@ -40,8 +40,8 @@
 #define I64_lsl(x,y) ((x) << (y))
 #define I64_asr(x,y) ((x) >> (y))
 #define I64_lsr(x,y) ((uint64)(x) >> (y))
-#define I64_to_long(x) ((long) (x))
-#define I64_of_long(x) ((int64) (x))
+#define I64_to_intnat(x) ((intnat) (x))
+#define I64_of_intnat(x) ((intnat) (x))
 #define I64_to_int32(x) ((int32) (x))
 #define I64_of_int32(x) ((int64) (x))
 #define I64_to_double(x) ((double)(x))
diff --git a/byterun/intern.c b/byterun/intern.c
index b673ee7110..6b94e3fe19 100644
--- a/byterun/intern.c
+++ b/byterun/intern.c
@@ -63,8 +63,8 @@ static value intern_block;
 /* Point to the heap block allocated as destination block.
    Meaningful only if intern_extra_block is NULL. */
 
-#define Sign_extend_shift ((sizeof(long) - 1) * 8)
-#define Sign_extend(x) (((long)(x) << Sign_extend_shift) >> Sign_extend_shift)
+#define Sign_extend_shift ((sizeof(intnat) - 1) * 8)
+#define Sign_extend(x) (((intnat)(x) << Sign_extend_shift) >> Sign_extend_shift)
 
 #define read8u() (*intern_src++)
 #define read8s() Sign_extend(*intern_src++)
@@ -84,9 +84,9 @@ static value intern_block;
    (intern_src[-2] << 8) + intern_src[-1])
 
 #ifdef ARCH_SIXTYFOUR
-static long read64s(void)
+static intnat read64s(void)
 {
-  long res;
+  intnat res;
   int i;
   res = 0;
   for (i = 0; i < 8; i++) res = (res << 8) + intern_src[i];
@@ -476,7 +476,7 @@ CAMLprim value caml_input_value(value vchan)
   CAMLreturn (res);
 }
 
-CAMLexport value caml_input_val_from_string(value str, long int ofs)
+CAMLexport value caml_input_val_from_string(value str, intnat ofs)
 {
   CAMLparam1 (str);
   mlsize_t num_objects, size_32, size_64, whsize;
@@ -531,7 +531,7 @@ static value input_val_from_block(void)
   return obj;
 }
 
-CAMLexport value caml_input_value_from_malloc(char * data, long ofs)
+CAMLexport value caml_input_value_from_malloc(char * data, intnat ofs)
 {
   uint32 magic;
   mlsize_t block_len;
@@ -550,7 +550,7 @@ CAMLexport value caml_input_value_from_malloc(char * data, long ofs)
   return obj;
 }
 
-CAMLexport value caml_input_value_from_block(char * data, long len)
+CAMLexport value caml_input_value_from_block(char * data, intnat len)
 {
   uint32 magic;
   mlsize_t block_len;
@@ -678,13 +678,13 @@ CAMLexport double caml_deserialize_float_8(void)
   return f;
 }
 
-CAMLexport void caml_deserialize_block_1(void * data, long len)
+CAMLexport void caml_deserialize_block_1(void * data, intnat len)
 {
   memmove(data, intern_src, len);
   intern_src += len;
 }
 
-CAMLexport void caml_deserialize_block_2(void * data, long len)
+CAMLexport void caml_deserialize_block_2(void * data, intnat len)
 {
 #ifndef ARCH_BIG_ENDIAN
   unsigned char * p, * q;
@@ -697,7 +697,7 @@ CAMLexport void caml_deserialize_block_2(void * data, long len)
 #endif
 }
 
-CAMLexport void caml_deserialize_block_4(void * data, long len)
+CAMLexport void caml_deserialize_block_4(void * data, intnat len)
 {
 #ifndef ARCH_BIG_ENDIAN
   unsigned char * p, * q;
@@ -710,7 +710,7 @@ CAMLexport void caml_deserialize_block_4(void * data, long len)
 #endif
 }
 
-CAMLexport void caml_deserialize_block_8(void * data, long len)
+CAMLexport void caml_deserialize_block_8(void * data, intnat len)
 {
 #ifndef ARCH_BIG_ENDIAN
   unsigned char * p, * q;
@@ -723,7 +723,7 @@ CAMLexport void caml_deserialize_block_8(void * data, long len)
 #endif
 }
 
-CAMLexport void caml_deserialize_block_float_8(void * data, long len)
+CAMLexport void caml_deserialize_block_float_8(void * data, intnat len)
 {
 #if ARCH_FLOAT_ENDIANNESS == 0x01234567
   memmove(data, intern_src, len * 8);
diff --git a/byterun/interp.c b/byterun/interp.c
index abf504131a..3a75060000 100644
--- a/byterun/interp.c
+++ b/byterun/interp.c
@@ -55,11 +55,7 @@ sp is a local copy of the global variable caml_extern_sp. */
 #  ifdef DEBUG
 #    define Next goto next_instr
 #  else
-#    ifdef __ia64__
-#      define Next goto *(void *)(jumptbl_base + *((uint32 *) pc)++)
-#    else
-#      define Next goto *(void *)(jumptbl_base + *pc++)
-#    endif
+#    define Next goto *(void *)(jumptbl_base + *pc++)
 #  endif
 #else
 #  define Instruct(name) case name
@@ -143,7 +139,7 @@ sp is a local copy of the global variable caml_extern_sp. */
 #define SP_REG asm("%edi")
 #define ACCU_REG
 #endif
-#if defined(PPC) || defined(_POWER) || defined(_IBMR2)
+#ifdef __ppc__
 #define PC_REG asm("26")
 #define SP_REG asm("27")
 #define ACCU_REG asm("28")
@@ -179,13 +175,13 @@ sp is a local copy of the global variable caml_extern_sp. */
 /* Division and modulus madness */
 
 #ifdef NONSTANDARD_DIV_MOD
-extern long caml_safe_div(long p, long q);
-extern long caml_safe_mod(long p, long q);
+extern intnat caml_safe_div(intnat p, intnat q);
+extern intnat caml_safe_mod(intnat p, intnat q);
 #endif
 
 
 #ifdef DEBUG
-static long caml_bcodcount;
+static intnat caml_bcodcount;
 #endif
 
 /* The interpreter itself */
@@ -209,7 +205,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
 #endif
 #endif
   value env;
-  long extra_args;
+  intnat extra_args;
   struct longjmp_buffer * initial_external_raise;
   int initial_sp_offset;
   /* volatile ensures that initial_local_roots and saved_pc
@@ -779,13 +775,12 @@ value caml_interprete(code_t prog, asize_t prog_size)
     Instruct(SWITCH): {
       uint32 sizes = *pc++;
       if (Is_block(accu)) {
-        long index = Tag_val(accu);
-        Assert (index >= 0);
-        Assert (index < (sizes >> 16));
+        intnat index = Tag_val(accu);
+        Assert ((uintnat) index < (sizes >> 16));
         pc += pc[(sizes & 0xFFFF) + index];
       } else {
-        long index = Long_val(accu);
-        Assert ((unsigned long) index < (sizes & 0xFFFF)) ;
+        intnat index = Long_val(accu);
+        Assert ((uintnat) index < (sizes & 0xFFFF)) ;
         pc += pc[index];
       }
       Next;
@@ -939,16 +934,16 @@ value caml_interprete(code_t prog, asize_t prog_size)
 /* Integer arithmetic */
 
     Instruct(NEGINT):
-      accu = (value)(2 - (long)accu); Next;
+      accu = (value)(2 - (intnat)accu); Next;
     Instruct(ADDINT):
-      accu = (value)((long) accu + (long) *sp++ - 1); Next;
+      accu = (value)((intnat) accu + (intnat) *sp++ - 1); Next;
     Instruct(SUBINT):
-      accu = (value)((long) accu - (long) *sp++ + 1); Next;
+      accu = (value)((intnat) accu - (intnat) *sp++ + 1); Next;
     Instruct(MULINT):
       accu = Val_long(Long_val(accu) * Long_val(*sp++)); Next;
 
     Instruct(DIVINT): {
-      long divisor = Long_val(*sp++);
+      intnat divisor = Long_val(*sp++);
       if (divisor == 0) { Setup_for_c_call; caml_raise_zero_divide(); }
 #ifdef NONSTANDARD_DIV_MOD
       accu = Val_long(caml_safe_div(Long_val(accu), divisor));
@@ -958,7 +953,7 @@ value caml_interprete(code_t prog, asize_t prog_size)
       Next;
     }
     Instruct(MODINT): {
-      long divisor = Long_val(*sp++);
+      intnat divisor = Long_val(*sp++);
       if (divisor == 0) { Setup_for_c_call; caml_raise_zero_divide(); }
 #ifdef NONSTANDARD_DIV_MOD
       accu = Val_long(caml_safe_mod(Long_val(accu), divisor));
@@ -968,48 +963,48 @@ value caml_interprete(code_t prog, asize_t prog_size)
       Next;
     }
     Instruct(ANDINT):
-      accu = (value)((long) accu & (long) *sp++); Next;
+      accu = (value)((intnat) accu & (intnat) *sp++); Next;
     Instruct(ORINT):
-      accu = (value)((long) accu | (long) *sp++); Next;
+      accu = (value)((intnat) accu | (intnat) *sp++); Next;
     Instruct(XORINT):
-      accu = (value)(((long) accu ^ (long) *sp++) | 1); Next;
+      accu = (value)(((intnat) accu ^ (intnat) *sp++) | 1); Next;
     Instruct(LSLINT):
-      accu = (value)((((long) accu - 1) << Long_val(*sp++)) + 1); Next;
+      accu = (value)((((intnat) accu - 1) << Long_val(*sp++)) + 1); Next;
     Instruct(LSRINT):
-      accu = (value)((((unsigned long) accu - 1) >> Long_val(*sp++)) | 1);
+      accu = (value)((((uintnat) accu - 1) >> Long_val(*sp++)) | 1);
       Next;
     Instruct(ASRINT):
-      accu = (value)((((long) accu - 1) >> Long_val(*sp++)) | 1); Next;
+      accu = (value)((((intnat) accu - 1) >> Long_val(*sp++)) | 1); Next;
 
-#define Integer_comparison(sign,opname,tst) \
+#define Integer_comparison(typ,opname,tst) \
     Instruct(opname): \
-      accu = Val_int((sign long) accu tst (sign long) *sp++); Next;
-
-    Integer_comparison(signed,EQ, ==)
-    Integer_comparison(signed,NEQ, !=)
-    Integer_comparison(signed,LTINT, <)
-    Integer_comparison(signed,LEINT, <=)
-    Integer_comparison(signed,GTINT, >)
-    Integer_comparison(signed,GEINT, >=)
-    Integer_comparison(unsigned,ULTINT, <)
-    Integer_comparison(unsigned,UGEINT, >=)
-
-#define Integer_branch_comparison(sign,opname,tst,debug) \
+      accu = Val_int((typ) accu tst (typ) *sp++); Next;
+
+    Integer_comparison(intnat,EQ, ==)
+    Integer_comparison(intnat,NEQ, !=)
+    Integer_comparison(intnat,LTINT, <)
+    Integer_comparison(intnat,LEINT, <=)
+    Integer_comparison(intnat,GTINT, >)
+    Integer_comparison(intnat,GEINT, >=)
+    Integer_comparison(uintnat,ULTINT, <)
+    Integer_comparison(uintnat,UGEINT, >=)
+
+#define Integer_branch_comparison(typ,opname,tst,debug) \
     Instruct(opname): \
-      if ( *pc++ tst ((sign long)Long_val(accu))) { \
+      if ( *pc++ tst (typ) Long_val(accu)) { \
         pc += *pc ; \
       } else { \
         pc++ ; \
       } ; Next;
 
-    Integer_branch_comparison(signed,BEQ, ==, "==")
-    Integer_branch_comparison(signed,BNEQ, !=, "!=")
-    Integer_branch_comparison(signed,BLTINT, <, "<")
-    Integer_branch_comparison(signed,BLEINT, <=, "<=")
-    Integer_branch_comparison(signed,BGTINT, >, ">")
-    Integer_branch_comparison(signed,BGEINT, >=, ">=")
-    Integer_branch_comparison(unsigned,BULTINT, <, "<")
-    Integer_branch_comparison(unsigned,BUGEINT, >=, ">=")
+    Integer_branch_comparison(intnat,BEQ, ==, "==")
+    Integer_branch_comparison(intnat,BNEQ, !=, "!=")
+    Integer_branch_comparison(intnat,BLTINT, <, "<")
+    Integer_branch_comparison(intnat,BLEINT, <=, "<=")
+    Integer_branch_comparison(intnat,BGTINT, >, ">")
+    Integer_branch_comparison(intnat,BGEINT, >=, ">=")
+    Integer_branch_comparison(uintnat,BULTINT, <, "<")
+    Integer_branch_comparison(uintnat,BUGEINT, >=, ">=")
 
     Instruct(OFFSETINT):
       accu += *pc << 1;
@@ -1120,8 +1115,9 @@ value caml_interprete(code_t prog, asize_t prog_size)
 #if _MSC_VER >= 1200
       __assume(0);
 #else
-      caml_fatal_error_arg("Fatal error: bad opcode (%lx)\n",
-                           (char *)(long)(*(pc-1)));
+      caml_fatal_error_arg("Fatal error: bad opcode (%"
+                           ARCH_INTNAT_PRINTF_FORMAT "x)\n",
+                           (char *)(*(pc-1)));
 #endif
     }
   }
diff --git a/byterun/intext.h b/byterun/intext.h
index 7d257b808c..5bda0d40f8 100644
--- a/byterun/intext.h
+++ b/byterun/intext.h
@@ -72,26 +72,12 @@
 #define CODE_DOUBLE_ARRAY32_NATIVE CODE_DOUBLE_ARRAY32_LITTLE
 #endif
 
-/* Initial sizes of data structures for extern */
+/* Size-ing data structures for extern.  Chosen so that
+   sizeof(struct trail_block) and sizeof(struct output_block)
+   are slightly below 8Kb. */
 
-#ifndef INITIAL_EXTERN_BLOCK_SIZE
-#define INITIAL_EXTERN_BLOCK_SIZE 8192
-#endif
-
-#ifndef INITIAL_EXTERN_TABLE_SIZE_LOG2
-#define INITIAL_EXTERN_TABLE_SIZE_LOG2 11
-#endif
-
-#define INITIAL_EXTERN_TABLE_SIZE (1UL << INITIAL_EXTERN_TABLE_SIZE_LOG2)
-
-/* Maximal value of initial_ofs above which we should start again with
-   initial_ofs = 1. Should be low enough to prevent rollover of initial_ofs
-   next time we extern a structure. Since a structure contains at most 
-   2^N / (2 * sizeof(value)) heap objects (N = 32 or 64 depending on target),
-   any value below 2^N - (2^N / (2 * sizeof(value))) suffices.
-   We just take 2^(N-1) for simplicity. */
-
-#define INITIAL_OFFSET_MAX (1UL << (8 * sizeof(value) - 1))
+#define ENTRIES_PER_TRAIL_BLOCK  1025
+#define SIZE_EXTERN_OUTPUT_BLOCK 8100
 
 /* The entry points */
 
@@ -102,12 +88,12 @@ void caml_output_val (struct channel * chan, value v, value flags);
 
 CAMLextern void caml_output_value_to_malloc(value v, value flags,
                                             /*out*/ char ** buf,
-                                            /*out*/ long * len);
+                                            /*out*/ intnat * len);
   /* Output [v] with flags [flags] to a memory buffer allocated with
      malloc.  On return, [*buf] points to the buffer and [*len]
      contains the number of bytes in buffer. */
-CAMLextern long caml_output_value_to_block(value v, value flags,
-                                           char * data, long len);
+CAMLextern intnat caml_output_value_to_block(value v, value flags,
+                                             char * data, intnat len);
   /* Output [v] with flags [flags] to a user-provided memory buffer.
      [data] points to the start of this buffer, and [len] is its size
      in bytes.  Return the number of bytes actually written in buffer.
@@ -123,15 +109,15 @@ void caml_intern_cleanup(void) ;
   /* to be called, before failing in deserialize code */
 /* </private> */
 
-CAMLextern value caml_input_val_from_string (value str, long ofs);
+CAMLextern value caml_input_val_from_string (value str, intnat ofs);
   /* Read a structured value from the Caml string [str], starting
      at offset [ofs]. */
-CAMLextern value caml_input_value_from_malloc(char * data, long ofs);
+CAMLextern value caml_input_value_from_malloc(char * data, intnat ofs);
   /* Read a structured value from a malloced buffer.  [data] points
      to the beginning of the buffer, and [ofs] is the offset of the
      beginning of the externed data in this buffer.  The buffer is
      deallocated with [free] on return, or if an exception is raised. */
-CAMLextern value caml_input_value_from_block(char * data, long len);
+CAMLextern value caml_input_value_from_block(char * data, intnat len);
   /* Read a structured value from a user-provided buffer.  [data] points
      to the beginning of the externed data in this buffer,
      and [len] is the length in bytes of valid data in this buffer.
@@ -145,11 +131,11 @@ CAMLextern void caml_serialize_int_4(int32 i);
 CAMLextern void caml_serialize_int_8(int64 i);
 CAMLextern void caml_serialize_float_4(float f);
 CAMLextern void caml_serialize_float_8(double f);
-CAMLextern void caml_serialize_block_1(void * data, long len);
-CAMLextern void caml_serialize_block_2(void * data, long len);
-CAMLextern void caml_serialize_block_4(void * data, long len);
-CAMLextern void caml_serialize_block_8(void * data, long len);
-CAMLextern void caml_serialize_block_float_8(void * data, long len);
+CAMLextern void caml_serialize_block_1(void * data, intnat len);
+CAMLextern void caml_serialize_block_2(void * data, intnat len);
+CAMLextern void caml_serialize_block_4(void * data, intnat len);
+CAMLextern void caml_serialize_block_8(void * data, intnat len);
+CAMLextern void caml_serialize_block_float_8(void * data, intnat len);
 
 CAMLextern int caml_deserialize_uint_1(void);
 CAMLextern int caml_deserialize_sint_1(void);
@@ -161,11 +147,11 @@ CAMLextern uint64 caml_deserialize_uint_8(void);
 CAMLextern int64 caml_deserialize_sint_8(void);
 CAMLextern float caml_deserialize_float_4(void);
 CAMLextern double caml_deserialize_float_8(void);
-CAMLextern void caml_deserialize_block_1(void * data, long len);
-CAMLextern void caml_deserialize_block_2(void * data, long len);
-CAMLextern void caml_deserialize_block_4(void * data, long len);
-CAMLextern void caml_deserialize_block_8(void * data, long len);
-CAMLextern void caml_deserialize_block_float_8(void * data, long len);
+CAMLextern void caml_deserialize_block_1(void * data, intnat len);
+CAMLextern void caml_deserialize_block_2(void * data, intnat len);
+CAMLextern void caml_deserialize_block_4(void * data, intnat len);
+CAMLextern void caml_deserialize_block_8(void * data, intnat len);
+CAMLextern void caml_deserialize_block_float_8(void * data, intnat len);
 CAMLextern void caml_deserialize_error(char * msg);
 
 /* <private> */
diff --git a/byterun/ints.c b/byterun/ints.c
index 2106fbd663..9d18abd83b 100644
--- a/byterun/ints.c
+++ b/byterun/ints.c
@@ -58,14 +58,14 @@ static int parse_digit(char c)
     return -1;
 }
 
-static long parse_long(value s, int nbits)
+static intnat parse_intnat(value s, int nbits)
 {
   char * p;
-  unsigned long res, threshold;
+  uintnat res, threshold;
   int sign, base, d;
 
   p = parse_sign_and_base(String_val(s), &base, &sign);
-  threshold = ((unsigned long) -1) / base;
+  threshold = ((uintnat) -1) / base;
   d = parse_digit(*p);
   if (d < 0 || d >= base) caml_failwith("int_of_string");
   for (p++, res = d; /*nothing*/; p++) {
@@ -77,7 +77,7 @@ static long parse_long(value s, int nbits)
     if (res > threshold) caml_failwith("int_of_string");
     res = base * res + d;
     /* Detect overflow in addition (base * res) + d */
-    if (res < (unsigned long) d) caml_failwith("int_of_string");
+    if (res < (uintnat) d) caml_failwith("int_of_string");
   }
   if (p != String_val(s) + caml_string_length(s)){
     caml_failwith("int_of_string");
@@ -89,26 +89,26 @@ static long parse_long(value s, int nbits)
   } else {
     /* Unsigned representation expected, allow 0 to 2^nbits - 1
        and tolerate -(2^nbits - 1) to 0 */
-    if (nbits < sizeof(unsigned long) * 8 && res >= 1UL << nbits)
+    if (nbits < sizeof(uintnat) * 8 && res >= 1UL << nbits)
       caml_failwith("int_of_string");
   }
-  return sign < 0 ? -((long) res) : (long) res;
+  return sign < 0 ? -((intnat) res) : (intnat) res;
 }
 
 #ifdef NONSTANDARD_DIV_MOD
-long caml_safe_div(long p, long q)
+intnat caml_safe_div(intnat p, intnat q)
 {
-  unsigned long ap = p >= 0 ? p : -p;
-  unsigned long aq = q >= 0 ? q : -q;
-  unsigned long ar = ap / aq;
+  uintnat ap = p >= 0 ? p : -p;
+  uintnat aq = q >= 0 ? q : -q;
+  uintnat ar = ap / aq;
   return (p ^ q) >= 0 ? ar : -ar;
 }
 
-long caml_safe_mod(long p, long q)
+intnat caml_safe_mod(intnat p, intnat q)
 {
-  unsigned long ap = p >= 0 ? p : -p;
-  unsigned long aq = q >= 0 ? q : -q;
-  unsigned long ar = ap % aq;
+  uintnat ap = p >= 0 ? p : -p;
+  uintnat aq = q >= 0 ? q : -q;
+  uintnat ar = ap % aq;
   return p >= 0 ? ar : -ar;
 }
 #endif
@@ -123,7 +123,7 @@ CAMLprim value caml_int_compare(value v1, value v2)
 
 CAMLprim value caml_int_of_string(value s)
 {
-  return Val_long(parse_long(s, 8 * sizeof(value) - 1));
+  return Val_long(parse_intnat(s, 8 * sizeof(value) - 1));
 }
 
 #define FORMAT_BUFFER_SIZE 32
@@ -199,19 +199,19 @@ static int int32_cmp(value v1, value v2)
   return (i1 > i2) - (i1 < i2);
 }
 
-static long int32_hash(value v)
+static intnat int32_hash(value v)
 {
   return Int32_val(v);
 }
 
-static void int32_serialize(value v, unsigned long * wsize_32,
-                            unsigned long * wsize_64)
+static void int32_serialize(value v, uintnat * wsize_32,
+                            uintnat * wsize_64)
 {
   caml_serialize_int_4(Int32_val(v));
   *wsize_32 = *wsize_64 = 4;
 }
 
-static unsigned long int32_deserialize(void * dst)
+static uintnat int32_deserialize(void * dst)
 {
   *((int32 *) dst) = caml_deserialize_sint_4();
   return 4;
@@ -313,8 +313,9 @@ CAMLprim value caml_int32_format(value fmt, value arg)
   char conv;
   value res;
 
-  buffer = parse_format(fmt, "", format_string, default_format_buffer, &conv);
-  sprintf(buffer, format_string, (long) Int32_val(arg));
+  buffer = parse_format(fmt, ARCH_INT32_PRINTF_FORMAT,
+                        format_string, default_format_buffer, &conv);
+  sprintf(buffer, format_string, Int32_val(arg));
   res = caml_copy_string(buffer);
   if (buffer != default_format_buffer) caml_stat_free(buffer);
   return res;
@@ -322,7 +323,7 @@ CAMLprim value caml_int32_format(value fmt, value arg)
 
 CAMLprim value caml_int32_of_string(value s)
 {
-  return caml_copy_int32(parse_long(s, 32));
+  return caml_copy_int32(parse_intnat(s, 32));
 }
 
 CAMLprim value caml_int32_bits_of_float(value vd)
@@ -366,19 +367,19 @@ static int int64_cmp(value v1, value v2)
   return I64_compare(i1, i2);
 }
 
-static long int64_hash(value v)
+static intnat int64_hash(value v)
 {
-  return I64_to_long(Int64_val(v));
+  return I64_to_intnat(Int64_val(v));
 }
 
-static void int64_serialize(value v, unsigned long * wsize_32,
-                            unsigned long * wsize_64)
+static void int64_serialize(value v, uintnat * wsize_32,
+                            uintnat * wsize_64)
 {
   caml_serialize_int_8(Int64_val(v));
   *wsize_32 = *wsize_64 = 8;
 }
 
-static unsigned long int64_deserialize(void * dst)
+static uintnat int64_deserialize(void * dst)
 {
 #ifndef ARCH_ALIGN_INT64
   *((int64 *) dst) = caml_deserialize_sint_8();
@@ -459,10 +460,10 @@ CAMLprim value caml_int64_shift_right_unsigned(value v1, value v2)
 { return caml_copy_int64(I64_lsr(Int64_val(v1), Int_val(v2))); }
 
 CAMLprim value caml_int64_of_int(value v)
-{ return caml_copy_int64(I64_of_long(Long_val(v))); }
+{ return caml_copy_int64(I64_of_intnat(Long_val(v))); }
 
 CAMLprim value caml_int64_to_int(value v)
-{ return Val_long(I64_to_long(Int64_val(v))); }
+{ return Val_long(I64_to_intnat(Int64_val(v))); }
 
 CAMLprim value caml_int64_of_float(value v)
 { return caml_copy_int64(I64_of_double(Double_val(v))); }
@@ -480,10 +481,10 @@ CAMLprim value caml_int64_to_int32(value v)
 { return caml_copy_int32(I64_to_int32(Int64_val(v))); }
 
 CAMLprim value caml_int64_of_nativeint(value v)
-{ return caml_copy_int64(I64_of_long(Nativeint_val(v))); }
+{ return caml_copy_int64(I64_of_intnat(Nativeint_val(v))); }
 
 CAMLprim value caml_int64_to_nativeint(value v)
-{ return caml_copy_nativeint(I64_to_long(Int64_val(v))); }
+{ return caml_copy_nativeint(I64_to_intnat(Int64_val(v))); }
 
 CAMLprim value caml_int64_compare(value v1, value v2)
 {
@@ -565,20 +566,20 @@ CAMLprim value caml_int64_float_of_bits(value vi)
 
 static int nativeint_cmp(value v1, value v2)
 {
-  long i1 = Nativeint_val(v1);
-  long i2 = Nativeint_val(v2);
+  intnat i1 = Nativeint_val(v1);
+  intnat i2 = Nativeint_val(v2);
   return (i1 > i2) - (i1 < i2);
 }
 
-static long nativeint_hash(value v)
+static intnat nativeint_hash(value v)
 {
   return Nativeint_val(v);
 }
 
-static void nativeint_serialize(value v, unsigned long * wsize_32,
-                            unsigned long * wsize_64)
+static void nativeint_serialize(value v, uintnat * wsize_32,
+                                uintnat * wsize_64)
 {
-  long l = Nativeint_val(v);
+  intnat l = Nativeint_val(v);
 #ifdef ARCH_SIXTYFOUR
   if (l <= 0x7FFFFFFFL && l >= -0x80000000L) {
     caml_serialize_int_1(1);
@@ -595,7 +596,7 @@ static void nativeint_serialize(value v, unsigned long * wsize_32,
   *wsize_64 = 8;
 }
 
-static unsigned long nativeint_deserialize(void * dst)
+static uintnat nativeint_deserialize(void * dst)
 {
   switch (caml_deserialize_uint_1()) {
   case 1:
@@ -623,9 +624,9 @@ CAMLexport struct custom_operations caml_nativeint_ops = {
   nativeint_deserialize
 };
 
-CAMLexport value caml_copy_nativeint(long i)
+CAMLexport value caml_copy_nativeint(intnat i)
 {
-  value res = caml_alloc_custom(&caml_nativeint_ops, sizeof(long), 0, 1);
+  value res = caml_alloc_custom(&caml_nativeint_ops, sizeof(intnat), 0, 1);
   Nativeint_val(res) = i;
   return res;
 }
@@ -644,7 +645,7 @@ CAMLprim value caml_nativeint_mul(value v1, value v2)
 
 CAMLprim value caml_nativeint_div(value v1, value v2)
 {
-  long divisor = Nativeint_val(v2);
+  intnat divisor = Nativeint_val(v2);
   if (divisor == 0) caml_raise_zero_divide();
 #ifdef NONSTANDARD_DIV_MOD
   return caml_copy_nativeint(caml_safe_div(Nativeint_val(v1), divisor));
@@ -655,7 +656,7 @@ CAMLprim value caml_nativeint_div(value v1, value v2)
 
 CAMLprim value caml_nativeint_mod(value v1, value v2)
 {
-  long divisor = Nativeint_val(v2);
+  intnat divisor = Nativeint_val(v2);
   if (divisor == 0) caml_raise_zero_divide();
 #ifdef NONSTANDARD_DIV_MOD
   return caml_copy_nativeint(caml_safe_mod(Nativeint_val(v1), divisor));
@@ -680,7 +681,7 @@ CAMLprim value caml_nativeint_shift_right(value v1, value v2)
 { return caml_copy_nativeint(Nativeint_val(v1) >> Int_val(v2)); }
 
 CAMLprim value caml_nativeint_shift_right_unsigned(value v1, value v2)
-{ return caml_copy_nativeint((unsigned long)Nativeint_val(v1) >> Int_val(v2)); }
+{ return caml_copy_nativeint((uintnat)Nativeint_val(v1) >> Int_val(v2)); }
 
 CAMLprim value caml_nativeint_of_int(value v)
 { return caml_copy_nativeint(Long_val(v)); }
@@ -689,7 +690,7 @@ CAMLprim value caml_nativeint_to_int(value v)
 { return Val_long(Nativeint_val(v)); }
 
 CAMLprim value caml_nativeint_of_float(value v)
-{ return caml_copy_nativeint((long)(Double_val(v))); }
+{ return caml_copy_nativeint((intnat)(Double_val(v))); }
 
 CAMLprim value caml_nativeint_to_float(value v)
 { return caml_copy_double((double)(Nativeint_val(v))); }
@@ -702,8 +703,8 @@ CAMLprim value caml_nativeint_to_int32(value v)
 
 CAMLprim value caml_nativeint_compare(value v1, value v2)
 {
-  long i1 = Nativeint_val(v1);
-  long i2 = Nativeint_val(v2);
+  intnat i1 = Nativeint_val(v1);
+  intnat i2 = Nativeint_val(v2);
   int res = (i1 > i2) - (i1 < i2);
   return Val_int(res);
 }
@@ -716,7 +717,8 @@ CAMLprim value caml_nativeint_format(value fmt, value arg)
   char conv;
   value res;
 
-  buffer = parse_format(fmt, "l", format_string, default_format_buffer, &conv);
+  buffer = parse_format(fmt, ARCH_INTNAT_PRINTF_FORMAT,
+                        format_string, default_format_buffer, &conv);
   sprintf(buffer, format_string, (long) Nativeint_val(arg));
   res = caml_copy_string(buffer);
   if (buffer != default_format_buffer) caml_stat_free(buffer);
@@ -725,5 +727,5 @@ CAMLprim value caml_nativeint_format(value fmt, value arg)
 
 CAMLprim value caml_nativeint_of_string(value s)
 {
-  return caml_copy_nativeint(parse_long(s, 8 * sizeof(value)));
+  return caml_copy_nativeint(parse_intnat(s, 8 * sizeof(value)));
 }
diff --git a/byterun/io.c b/byterun/io.c
index 6e07ca32b4..6fb06e2078 100644
--- a/byterun/io.c
+++ b/byterun/io.c
@@ -70,6 +70,9 @@ CAMLexport struct channel * caml_open_descriptor_in(int fd)
   channel->old_revealed = 0;
   channel->refcount = 0;
   channel->next = caml_all_opened_channels;
+  channel->prev = NULL;
+  if (caml_all_opened_channels != NULL)
+    caml_all_opened_channels->prev = channel;
   caml_all_opened_channels = channel;
   return channel;
 }
@@ -85,12 +88,15 @@ CAMLexport struct channel * caml_open_descriptor_out(int fd)
 
 static void unlink_channel(struct channel *channel)
 {
-  struct channel ** cp = &caml_all_opened_channels;
-  
-  while (*cp != channel && *cp != NULL)
-    cp = &(*cp)->next;
-  if (*cp != NULL)
-    *cp = (*cp)->next;
+  if (channel->prev == NULL) {
+    Assert (channel == caml_all_opened_channels);
+    caml_all_opened_channels = caml_all_opened_channels->next;
+    if (caml_all_opened_channels != NULL)
+      caml_all_opened_channels->prev = NULL;
+  } else {
+    channel->prev->next = channel->next;
+    if (channel->next != NULL) channel->next->prev = channel->prev;
+  }
 }
 
 CAMLexport void caml_close_channel(struct channel *channel)
@@ -141,7 +147,6 @@ static int do_write(int fd, char *p, int n)
 {
   int retcode;
 
-  Assert(!Is_young((value) p));
 again:
   caml_enter_blocking_section();
   retcode = write(fd, p, n);
@@ -200,7 +205,7 @@ CAMLexport void caml_putword(struct channel *channel, uint32 w)
   putch(channel, w);
 }
 
-CAMLexport int caml_putblock(struct channel *channel, char *p, long int len)
+CAMLexport int caml_putblock(struct channel *channel, char *p, intnat len)
 {
   int n, free, towrite, written;
 
@@ -225,7 +230,8 @@ CAMLexport int caml_putblock(struct channel *channel, char *p, long int len)
   }
 }
 
-CAMLexport void caml_really_putblock(struct channel *channel, char *p, long len)
+CAMLexport void caml_really_putblock(struct channel *channel, 
+                                     char *p, intnat len)
 {
   int written;
   while (len > 0) {
@@ -254,14 +260,11 @@ CAMLexport int caml_do_read(int fd, char *p, unsigned int n)
 {
   int retcode;
 
-  /*Assert(!Is_young((value) p)); ** Is_young only applies to a true value */
-  caml_enter_blocking_section();
-#ifdef EINTR
-  do { retcode = read(fd, p, n); } while (retcode == -1 && errno == EINTR);
-#else
-  retcode = read(fd, p, n);
-#endif
-  caml_leave_blocking_section();
+  do {
+    caml_enter_blocking_section();
+    retcode = read(fd, p, n);
+    caml_leave_blocking_section();
+  } while (retcode == -1 && errno == EINTR);
   if (retcode == -1) caml_sys_error(NO_ARG);
   return retcode;
 }
@@ -292,7 +295,7 @@ CAMLexport uint32 caml_getword(struct channel *channel)
   return res;
 }
 
-CAMLexport int caml_getblock(struct channel *channel, char *p, long int len)
+CAMLexport int caml_getblock(struct channel *channel, char *p, intnat len)
 {
   int n, avail, nread;
 
@@ -318,7 +321,7 @@ CAMLexport int caml_getblock(struct channel *channel, char *p, long int len)
   }
 }
 
-CAMLexport int caml_really_getblock(struct channel *chan, char *p, long int n)
+CAMLexport int caml_really_getblock(struct channel *chan, char *p, intnat n)
 {
   int r;
   while (n > 0) {
@@ -347,7 +350,7 @@ CAMLexport file_offset caml_pos_in(struct channel *channel)
   return channel->offset - (file_offset)(channel->max - channel->curr);
 }
 
-CAMLexport long caml_input_scan_line(struct channel *channel)
+CAMLexport intnat caml_input_scan_line(struct channel *channel)
 {
   char * p;
   int n;
@@ -584,8 +587,8 @@ CAMLprim value caml_ml_output(value vchannel, value buff, value start,
 {
   CAMLparam4 (vchannel, buff, start, length);
   struct channel * channel = Channel(vchannel);
-  long pos = Long_val(start);
-  long len = Long_val(length);
+  intnat pos = Long_val(start);
+  intnat len = Long_val(length);
 
   Lock(channel);
     while (len > 0) {
@@ -641,7 +644,7 @@ CAMLprim value caml_ml_input_char(value vchannel)
 CAMLprim value caml_ml_input_int(value vchannel)
 {
   struct channel * channel = Channel(vchannel);
-  long i;
+  intnat i;
 
   Lock(channel);
   i = caml_getword(channel);
@@ -657,7 +660,7 @@ CAMLprim value caml_ml_input(value vchannel, value buff, value vstart,
 {
   CAMLparam4 (vchannel, buff, vstart, vlength);
   struct channel * channel = Channel(vchannel);
-  long start, len;
+  intnat start, len;
   int n, avail, nread;
 
   Lock(channel);
@@ -720,7 +723,7 @@ CAMLprim value caml_ml_pos_in_64(value vchannel)
 CAMLprim value caml_ml_input_scan_line(value vchannel)
 {
   struct channel * channel = Channel(vchannel);
-  long res;
+  intnat res;
 
   Lock(channel);
   res = caml_input_scan_line(channel);
diff --git a/byterun/io.h b/byterun/io.h
index 643af746b5..169ad37d6b 100644
--- a/byterun/io.h
+++ b/byterun/io.h
@@ -25,7 +25,11 @@
 #define IO_BUFFER_SIZE 4096
 #endif
 
-#ifdef HAS_OFF_T
+#if defined(_WIN32)
+typedef __int64 file_offset;
+extern __int64 _lseeki64(int, __int64, int);
+#define lseek(fd,d,m) _lseeki64(fd,d,m)
+#elif defined(HAS_OFF_T)
 #include <sys/types.h>
 typedef off_t file_offset;
 #else
@@ -39,7 +43,7 @@ struct channel {
   char * curr;                  /* Current position in the buffer */
   char * max;                   /* Logical end of the buffer (for input) */
   void * mutex;                 /* Placeholder for mutex (for systhreads) */
-  struct channel * next;        /* Linear chaining of channels (flush_all) */
+  struct channel * next, * prev;/* Double chaining of channels (flush_all) */
   int revealed;                 /* For Cash only */
   int old_revealed;             /* For Cash only */
   int refcount;                 /* For flush_all and for Cash */
@@ -73,13 +77,13 @@ CAMLextern int caml_channel_binary_mode (struct channel *);
 CAMLextern int caml_flush_partial (struct channel *);
 CAMLextern void caml_flush (struct channel *);
 CAMLextern void caml_putword (struct channel *, uint32);
-CAMLextern int caml_putblock (struct channel *, char *, long);
-CAMLextern void caml_really_putblock (struct channel *, char *, long);
+CAMLextern int caml_putblock (struct channel *, char *, intnat);
+CAMLextern void caml_really_putblock (struct channel *, char *, intnat);
 
 CAMLextern unsigned char caml_refill (struct channel *);
 CAMLextern uint32 caml_getword (struct channel *);
-CAMLextern int caml_getblock (struct channel *, char *, long);
-CAMLextern int caml_really_getblock (struct channel *, char *, long);
+CAMLextern int caml_getblock (struct channel *, char *, intnat);
+CAMLextern int caml_really_getblock (struct channel *, char *, intnat);
 
 /* Extract a struct channel * from the heap object representing it */
 
diff --git a/byterun/major_gc.c b/byterun/major_gc.c
index 26f657e45e..4457ddd1a6 100644
--- a/byterun/major_gc.c
+++ b/byterun/major_gc.c
@@ -29,8 +29,8 @@
 #include "roots.h"
 #include "weak.h"
 
-unsigned long caml_percent_free;
-long caml_major_heap_increment;
+uintnat caml_percent_free;
+intnat caml_major_heap_increment;
 CAMLexport char *caml_heap_start, *caml_heap_end;
 CAMLexport page_table_entry *caml_page_table;
 asize_t caml_page_low, caml_page_high;
@@ -41,10 +41,10 @@ static value *gray_vals_cur, *gray_vals_end;
 static asize_t gray_vals_size;
 static int heap_is_pure;   /* The heap is pure if the only gray objects
                               below [markhp] are also in [gray_vals]. */
-unsigned long caml_allocated_words;
-unsigned long caml_dependent_size, caml_dependent_allocated;
+uintnat caml_allocated_words;
+uintnat caml_dependent_size, caml_dependent_allocated;
 double caml_extra_heap_resources;
-unsigned long caml_fl_size_at_phase_change = 0;
+uintnat caml_fl_size_at_phase_change = 0;
 
 extern char *caml_fl_merge;  /* Defined in freelist.c. */
 
@@ -62,8 +62,9 @@ static void realloc_gray_vals (void)
 
   Assert (gray_vals_cur == gray_vals_end);
   if (gray_vals_size < caml_stat_heap_size / 128){
-    caml_gc_message (0x08, "Growing gray_vals to %luk bytes\n",
-                     (long) gray_vals_size * sizeof (value) / 512);
+    caml_gc_message (0x08, "Growing gray_vals to %"
+                           ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
+                     (intnat) gray_vals_size * sizeof (value) / 512);
     new = (value *) realloc ((char *) gray_vals,
                              2 * gray_vals_size * sizeof (value));
     if (new == NULL){
@@ -109,7 +110,7 @@ static void start_cycle (void)
 #endif
 }
 
-static void mark_slice (long work)
+static void mark_slice (intnat work)
 {
   value *gray_vals_ptr;  /* Local copy of gray_vals_cur */
   value v, child;
@@ -245,7 +246,7 @@ static void mark_slice (long work)
   gray_vals_cur = gray_vals_ptr;
 }
 
-static void sweep_slice (long work)
+static void sweep_slice (intnat work)
 {
   char *hp;
   header_t hd;
@@ -294,10 +295,10 @@ static void sweep_slice (long work)
    [howmuch] is the amount of work to do, 0 to let the GC compute it.
    Return the computed amount of work to do.
  */
-long caml_major_collection_slice (long howmuch)
+intnat caml_major_collection_slice (intnat howmuch)
 {
   double p, dp;
-  long computed_work;
+  intnat computed_work;
   /*
      Free memory at the start of the GC cycle (garbage + free list) (assumed):
                  FM = caml_stat_heap_size * caml_percent_free
@@ -343,17 +344,21 @@ long caml_major_collection_slice (long howmuch)
   if (p < dp) p = dp;
   if (p < caml_extra_heap_resources) p = caml_extra_heap_resources;
 
-  caml_gc_message (0x40, "allocated_words = %lu\n", caml_allocated_words);
-  caml_gc_message (0x40, "extra_heap_resources = %luu\n",
-                   (unsigned long) (caml_extra_heap_resources * 1000000));
-  caml_gc_message (0x40, "amount of work to do = %luu\n",
-                   (unsigned long) (p * 1000000));
+  caml_gc_message (0x40, "allocated_words = %" 
+                         ARCH_INTNAT_PRINTF_FORMAT "u\n",
+                   caml_allocated_words);
+  caml_gc_message (0x40, "extra_heap_resources = %"
+                         ARCH_INTNAT_PRINTF_FORMAT "uu\n",
+                   (uintnat) (caml_extra_heap_resources * 1000000));
+  caml_gc_message (0x40, "amount of work to do = %"
+                         ARCH_INTNAT_PRINTF_FORMAT "uu\n",
+                   (uintnat) (p * 1000000));
 
   if (caml_gc_phase == Phase_mark){
-    computed_work = 2 * (long) (p * Wsize_bsize (caml_stat_heap_size) * 100
+    computed_work = 2 * (intnat) (p * Wsize_bsize (caml_stat_heap_size) * 100
                                 / (100 + caml_percent_free));
   }else{
-    computed_work = 2 * (long) (p * Wsize_bsize (caml_stat_heap_size));
+    computed_work = 2 * (intnat) (p * Wsize_bsize (caml_stat_heap_size));
   }
   caml_gc_message (0x40, "ordered work = %ld words\n", howmuch);
   caml_gc_message (0x40, "computed work = %ld words\n", computed_work);
@@ -438,7 +443,7 @@ void caml_init_major_heap (asize_t heap_size)
     caml_fatal_error ("Fatal error: not enough memory for the initial heap.\n");
   Chunk_next (caml_heap_start) = NULL;
   caml_heap_end = caml_heap_start + caml_stat_heap_size;
-  Assert ((unsigned long) caml_heap_end % Page_size == 0);
+  Assert ((uintnat) caml_heap_end % Page_size == 0);
 
   caml_stat_heap_chunks = 1;
 
diff --git a/byterun/major_gc.h b/byterun/major_gc.h
index 3a53d04ac2..47aa5e59f7 100644
--- a/byterun/major_gc.h
+++ b/byterun/major_gc.h
@@ -33,10 +33,10 @@ typedef struct {
 #define Chunk_block(c) (((heap_chunk_head *) (c)) [-1]).block
 
 extern int caml_gc_phase;
-extern unsigned long caml_allocated_words;
+extern uintnat caml_allocated_words;
 extern double caml_extra_heap_resources;
-extern unsigned long caml_dependent_size, caml_dependent_allocated;
-extern unsigned long caml_fl_size_at_phase_change;
+extern uintnat caml_dependent_size, caml_dependent_allocated;
+extern uintnat caml_fl_size_at_phase_change;
 
 #define Phase_mark 0
 #define Phase_sweep 1
@@ -50,14 +50,14 @@ typedef char page_table_entry;
 
 CAMLextern char *caml_heap_start;
 CAMLextern char *caml_heap_end;
-extern unsigned long total_heap_size;
+extern uintnat total_heap_size;
 CAMLextern page_table_entry *caml_page_table;
 extern asize_t caml_page_low, caml_page_high;
 extern char *caml_gc_sweep_hp;
 
 #define In_heap 1
 #define Not_in_heap 0
-#define Page(p) ((unsigned long) (p) >> Page_log)
+#define Page(p) ((uintnat) (p) >> Page_log)
 #define Is_in_heap(p) \
   (Assert (Is_block ((value) (p))), \
    (addr)(p) >= (addr)caml_heap_start && (addr)(p) < (addr)caml_heap_end \
@@ -66,7 +66,7 @@ extern char *caml_gc_sweep_hp;
 void caml_init_major_heap (asize_t);           /* size in bytes */
 asize_t caml_round_heap_chunk_size (asize_t);  /* size in bytes */
 void caml_darken (value, value *);
-long caml_major_collection_slice (long);
+intnat caml_major_collection_slice (long);
 void major_collection (void);
 void caml_finish_major_cycle (void);
 
diff --git a/byterun/md5.c b/byterun/md5.c
index 9857174714..aa18b72404 100644
--- a/byterun/md5.c
+++ b/byterun/md5.c
@@ -39,7 +39,7 @@ CAMLprim value caml_md5_chan(value vchan, value len)
   struct channel * chan = Channel(vchan);
   struct MD5Context ctx;
   value res;
-  long toread, read;
+  intnat toread, read;
   char buffer[4096];
 
   Lock(chan);
@@ -118,7 +118,7 @@ CAMLexport void caml_MD5Init(struct MD5Context *ctx)
  * of bytes.
  */
 CAMLexport void caml_MD5Update(struct MD5Context *ctx, unsigned char *buf,
-                               unsigned long len)
+                               uintnat len)
 {
     uint32 t;
 
diff --git a/byterun/md5.h b/byterun/md5.h
index 5e50125b3b..ff8c23ee0e 100644
--- a/byterun/md5.h
+++ b/byterun/md5.h
@@ -33,7 +33,7 @@ struct MD5Context {
 
 CAMLextern void caml_MD5Init (struct MD5Context *context);
 CAMLextern void caml_MD5Update (struct MD5Context *context, unsigned char *buf, 
-                                unsigned long len);
+                                uintnat len);
 CAMLextern void caml_MD5Final (unsigned char *digest, struct MD5Context *ctx);
 CAMLextern void caml_MD5Transform (uint32 *buf, uint32 *in);
 
diff --git a/byterun/memory.c b/byterun/memory.c
index e52a2ebbcf..03d7286937 100644
--- a/byterun/memory.c
+++ b/byterun/memory.c
@@ -290,7 +290,7 @@ CAMLexport value caml_alloc_shr (mlsize_t wosize, tag_t tag)
   }
 #ifdef DEBUG
   {
-    unsigned long i;
+    uintnat i;
     for (i = 0; i < wosize; i++){
       Field (Val_hp (hp), i) = Debug_uninit_major;
     }
@@ -301,11 +301,12 @@ CAMLexport value caml_alloc_shr (mlsize_t wosize, tag_t tag)
 
 /* Dependent memory is all memory blocks allocated out of the heap
    that depend on the GC (and finalizers) for deallocation.
-   For the GC to take dependent memory in its automatic speed setting,
+   For the GC to take dependent memory into account when computing
+   its automatic speed setting,
    you must call [caml_alloc_dependent_memory] when you alloate some
    dependent memory, and [caml_free_dependent_memory] when you
-   free it.  In both cases, you pass as argument the size of the
-   block being allocated or freed.
+   free it.  In both cases, you pass as argument the size (in bytes)
+   of the block being allocated or freed.
 */
 CAMLexport void caml_alloc_dependent_memory (mlsize_t nbytes)
 {
diff --git a/byterun/memory.h b/byterun/memory.h
index 9fdff061e0..89c7712c31 100644
--- a/byterun/memory.h
+++ b/byterun/memory.h
@@ -51,7 +51,7 @@ color_t caml_allocation_color (void *hp);
 
 #ifdef DEBUG
 #define DEBUG_clear(result, wosize) do{ \
-  unsigned long caml__DEBUG_i; \
+  uintnat caml__DEBUG_i; \
   for (caml__DEBUG_i = 0; caml__DEBUG_i < (wosize); ++ caml__DEBUG_i){ \
     Field ((result), caml__DEBUG_i) = Debug_uninit_minor; \
   } \
@@ -107,8 +107,8 @@ color_t caml_allocation_color (void *hp);
 
 struct caml__roots_block {
   struct caml__roots_block *next;
-  long ntables;
-  long nitems;
+  intnat ntables;
+  intnat nitems;
   value *tables [5];
 };
 
@@ -171,7 +171,7 @@ CAMLextern struct caml__roots_block *caml_local_roots;  /* defined in roots.c */
   CAMLxparamN (x, (size))
 
 
-#if defined (__GNUC__)
+#if defined (__GNUC__) && (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ > 7))
   #define CAMLunused __attribute__ ((unused))
 #else
   #define CAMLunused
diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c
index 33b1acc3ab..f4958939b1 100644
--- a/byterun/minor_gc.c
+++ b/byterun/minor_gc.c
@@ -217,7 +217,7 @@ void caml_empty_minor_heap (void)
 */
 CAMLexport void caml_minor_collection (void)
 {
-  long prev_alloc_words = caml_allocated_words;
+  intnat prev_alloc_words = caml_allocated_words;
 
   caml_empty_minor_heap ();
 
@@ -254,7 +254,9 @@ void caml_realloc_ref_table (void)
 
     ref_table_size *= 2;
     sz = (ref_table_size + ref_table_reserve) * sizeof (value *);
-    caml_gc_message (0x08, "Growing ref_table to %ldk bytes\n", (long) sz/1024);
+    caml_gc_message (0x08, "Growing ref_table to %" 
+                           ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n",
+                     (intnat) sz/1024);
     ref_table = (value **) realloc ((char *) ref_table, sz);
     if (ref_table == NULL){
       caml_fatal_error ("Fatal error: ref_table overflow\n");
diff --git a/byterun/misc.c b/byterun/misc.c
index 8791eca42a..2a660219c4 100644
--- a/byterun/misc.c
+++ b/byterun/misc.c
@@ -31,9 +31,9 @@ int caml_failed_assert (char * expr, char * file, int line)
 
 #endif /* DEBUG */
 
-unsigned long caml_verb_gc = 0;
+uintnat caml_verb_gc = 0;
 
-void caml_gc_message (int level, char *msg, unsigned long arg)
+void caml_gc_message (int level, char *msg, uintnat arg)
 {
   if (level < 0 || (caml_verb_gc & level) != 0){
     fprintf (stderr, msg, arg);
@@ -64,20 +64,20 @@ CAMLexport void caml_fatal_error_arg2 (char *fmt1, char *arg1,
 char *caml_aligned_malloc (asize_t size, int modulo, void **block)
 {
   char *raw_mem;
-  unsigned long aligned_mem;
+  uintnat aligned_mem;
                                                   Assert (modulo < Page_size);
   raw_mem = (char *) malloc (size + Page_size);
   if (raw_mem == NULL) return NULL;
   *block = raw_mem;
   raw_mem += modulo;                /* Address to be aligned */
-  aligned_mem = (((unsigned long) raw_mem / Page_size + 1) * Page_size);
+  aligned_mem = (((uintnat) raw_mem / Page_size + 1) * Page_size);
 #ifdef DEBUG
   {
-    unsigned long *p;
-    unsigned long *p0 = (void *) *block,
-                  *p1 = (void *) (aligned_mem - modulo),
-                  *p2 = (void *) (aligned_mem - modulo + size),
-                  *p3 = (void *) ((char *) *block + size + Page_size);
+    uintnat *p;
+    uintnat *p0 = (void *) *block,
+            *p1 = (void *) (aligned_mem - modulo),
+            *p2 = (void *) (aligned_mem - modulo + size),
+            *p3 = (void *) ((char *) *block + size + Page_size);
 
     for (p = p0; p < p1; p++) *p = Debug_filler_align;
     for (p = p1; p < p2; p++) *p = Debug_uninit_align;
diff --git a/byterun/misc.h b/byterun/misc.h
index bda864fc49..a1b2b92607 100644
--- a/byterun/misc.h
+++ b/byterun/misc.h
@@ -93,8 +93,8 @@ extern void caml_ext_table_free(struct ext_table * tbl, int free_entries);
 
 /* GC flags and messages */
 
-extern unsigned long caml_verb_gc;
-void caml_gc_message (int, char *, unsigned long);
+extern uintnat caml_verb_gc;
+void caml_gc_message (int, char *, uintnat);
 
 /* Memory routines */
 
@@ -103,10 +103,10 @@ char *caml_aligned_malloc (asize_t, int, void **);
 #ifdef DEBUG
 #ifdef ARCH_SIXTYFOUR
 #define Debug_tag(x) (0xD700D7D7D700D6D7ul \
-                      | ((unsigned long) (x) << 16) \
-                      | ((unsigned long) (x) << 48))
+                      | ((uintnat) (x) << 16) \
+                      | ((uintnat) (x) << 48))
 #else
-#define Debug_tag(x) (0xD700D6D7ul | ((unsigned long) (x) << 16))
+#define Debug_tag(x) (0xD700D6D7ul | ((uintnat) (x) << 16))
 #endif /* ARCH_SIXTYFOUR */
 
 /*
diff --git a/byterun/mlvalues.h b/byterun/mlvalues.h
index 82d894d396..a29ef8e193 100644
--- a/byterun/mlvalues.h
+++ b/byterun/mlvalues.h
@@ -26,7 +26,7 @@
 
   word: Four bytes on 32 and 16 bit architectures,
         eight bytes on 64 bit architectures.
-  long: A C long integer.
+  long: A C integer having the same number of bytes as a word.
   val: The ML representation of something.  A long or a block or a pointer
        outside the heap.  If it is a block, it is the (encoded) address
        of an object.  If it is a long, it is encoded as well.
@@ -53,12 +53,12 @@
          This is for use only by the GC.
 */
 
-typedef long value;
-typedef unsigned long header_t;
-typedef unsigned long mlsize_t;
+typedef intnat value;
+typedef uintnat header_t;
+typedef uintnat mlsize_t;
 typedef unsigned int tag_t;             /* Actually, an unsigned char */
-typedef unsigned long color_t;
-typedef unsigned long mark_t;
+typedef uintnat color_t;
+typedef uintnat mark_t;
 
 /* Longs vs blocks. */
 #define Is_long(x)   (((x) & 1) != 0)
@@ -66,13 +66,13 @@ typedef unsigned long mark_t;
 
 /* Conversion macro names are always of the form  "to_from". */
 /* Example: Val_long as in "Val from long" or "Val of long". */
-#define Val_long(x)     (((long)(x) << 1) + 1)
+#define Val_long(x)     (((intnat)(x) << 1) + 1)
 #define Long_val(x)     ((x) >> 1)
 #define Max_long ((1L << (8 * sizeof(value) - 2)) - 1)
 #define Min_long (-(1L << (8 * sizeof(value) - 2)))
 #define Val_int(x) Val_long(x)
 #define Int_val(x) ((int) Long_val(x))
-#define Unsigned_long_val(x) ((unsigned long)(x) >> 1)
+#define Unsigned_long_val(x) ((uintnat)(x) >> 1)
 #define Unsigned_int_val(x)  ((int) Unsigned_long_val(x))
 
 /* Structure of the header:
@@ -259,7 +259,7 @@ struct custom_operations;       /* defined in [custom.h] */
 /* Int32.t, Int64.t and Nativeint.t are represented as custom blocks. */
 
 #define Int32_val(v) (*((int32 *) Data_custom_val(v)))
-#define Nativeint_val(v) (*((long *) Data_custom_val(v)))
+#define Nativeint_val(v) (*((intnat *) Data_custom_val(v)))
 #ifndef ARCH_ALIGN_INT64
 #define Int64_val(v) (*((int64 *) Data_custom_val(v)))
 #else
diff --git a/byterun/obj.c b/byterun/obj.c
index 8ad9515c88..ee16ba5752 100644
--- a/byterun/obj.c
+++ b/byterun/obj.c
@@ -242,5 +242,3 @@ value caml_cache_public_method2 (value *meths, value tag, value *cache)
   }
 }
 #endif /*CAML_JIT*/
-
-/* eof $Id$ */
diff --git a/byterun/roots.c b/byterun/roots.c
index 83c59dd88c..2ff8762165 100644
--- a/byterun/roots.c
+++ b/byterun/roots.c
@@ -38,7 +38,7 @@ void caml_oldify_local_roots (void)
   register value * sp;
   struct global_root * gr;
   struct caml__roots_block *lr;
-  long i, j;
+  intnat i, j;
 
   /* The stack */
   for (sp = caml_extern_sp; sp < caml_stack_high; sp++) {
diff --git a/byterun/roots.h b/byterun/roots.h
index acd406deb6..95c2f63f7a 100644
--- a/byterun/roots.h
+++ b/byterun/roots.h
@@ -29,7 +29,7 @@ CAMLextern void caml_do_local_roots (scanning_action, value *, value *,
                                      struct caml__roots_block *);
 #else
 CAMLextern void caml_do_local_roots(scanning_action f, char * bottom_of_stack,
-                                    unsigned long last_retaddr, value * gc_regs,
+                                    uintnat last_retaddr, value * gc_regs,
                                     struct caml__roots_block * local_roots);
 #endif
 
diff --git a/byterun/signals.c b/byterun/signals.c
index 0b5e50bfca..a02f6b859f 100644
--- a/byterun/signals.c
+++ b/byterun/signals.c
@@ -23,43 +23,78 @@
 #include "mlvalues.h"
 #include "roots.h"
 #include "signals.h"
+#include "signals_machdep.h"
 #include "sys.h"
 
+#ifndef NSIG
+#define NSIG 64
+#endif
+
 #ifdef _WIN32
 typedef void (*sighandler)(int sig);
 extern sighandler caml_win32_signal(int sig, sighandler action);
 #define signal(sig,act) caml_win32_signal(sig,act)
 #endif
 
-CAMLexport int volatile caml_async_signal_mode = 0;
-CAMLexport int volatile caml_pending_signal = 0;
+CAMLexport intnat volatile caml_pending_signals[NSIG];
 CAMLexport int volatile caml_something_to_do = 0;
 int volatile caml_force_major_slice = 0;
 value caml_signal_handlers = 0;
-CAMLexport void (*caml_enter_blocking_section_hook)(void) = NULL;
-CAMLexport void (*caml_leave_blocking_section_hook)(void) = NULL;
 CAMLexport void (* volatile caml_async_action_hook)(void) = NULL;
 
+static void caml_process_pending_signals(void)
+{
+  int signal_num;
+  intnat signal_state;
+
+  for (signal_num = 0; signal_num < NSIG; signal_num++) {
+    Read_and_clear(signal_state, caml_pending_signals[signal_num]);
+    if (signal_state) caml_execute_signal(signal_num, 0);
+  }
+}
+
 void caml_process_event(void)
 {
-  int signal_number;
   void (*async_action)(void);
+
   if (caml_force_major_slice) caml_minor_collection ();
                              /* FIXME should be [caml_check_urgent_gc] */
-  /* If a signal arrives between the following two instructions,
-     it will be lost.  To do: use atomic swap or atomic read-and-clear
-     for processors that support it? */
-  signal_number = caml_pending_signal;
-  caml_pending_signal = 0;
-  if (signal_number) caml_execute_signal(signal_number, 0);
-  /* If an async action is scheduled between the following two instructions,
-     it will be lost. */
-  async_action = caml_async_action_hook;
-  caml_async_action_hook = NULL;
+  caml_process_pending_signals();
+  Read_and_clear(async_action, caml_async_action_hook);
   if (async_action != NULL) (*async_action)();
 }
 
-static int rev_convert_signal_number(int signo);
+static intnat volatile caml_async_signal_mode = 0;
+
+static void caml_enter_blocking_section_default(void)
+{
+  Assert (caml_async_signal_mode == 0);
+  caml_async_signal_mode = 1;
+}
+
+static void caml_leave_blocking_section_default(void)
+{
+  Assert (caml_async_signal_mode == 1);
+  caml_async_signal_mode = 0;
+}
+
+static int caml_try_leave_blocking_section_default(void)
+{
+  intnat res;
+  Read_and_clear(res, caml_async_signal_mode);
+  return res;
+}
+
+CAMLexport void (*caml_enter_blocking_section_hook)(void) =
+   caml_enter_blocking_section_default;
+CAMLexport void (*caml_leave_blocking_section_hook)(void) =
+   caml_leave_blocking_section_default;
+CAMLexport int (*caml_try_leave_blocking_section_hook)(void) =
+   caml_try_leave_blocking_section_default;
+
+CAMLexport int caml_rev_convert_signal_number(int signo);
+
+/* Execute a signal handler immediately */
 
 void caml_execute_signal(int signal_number, int in_signal_handler)
 {
@@ -72,8 +107,9 @@ void caml_execute_signal(int signal_number, int in_signal_handler)
   sigaddset(&sigs, signal_number);
   sigprocmask(SIG_BLOCK, &sigs, &sigs);
 #endif
-  res = caml_callback_exn(Field(caml_signal_handlers, signal_number),
-                          Val_int(rev_convert_signal_number(signal_number)));
+  res = caml_callback_exn(
+           Field(caml_signal_handlers, signal_number),
+           Val_int(caml_rev_convert_signal_number(signal_number)));
 #ifdef POSIX_SIGNALS
   if (! in_signal_handler) {
     /* Restore the original signal mask */
@@ -87,19 +123,27 @@ void caml_execute_signal(int signal_number, int in_signal_handler)
   if (Is_exception_result(res)) caml_raise(Extract_exception(res));
 }
 
+/* Record the delivery of a signal, and arrange so that caml_process_event
+   is called as soon as possible. */
+
+void caml_record_signal(int signal_number)
+{
+  caml_pending_signals[signal_number] = 1;
+  caml_something_to_do = 1;
+}
+
 static void handle_signal(int signal_number)
 {
 #if !defined(POSIX_SIGNALS) && !defined(BSD_SIGNALS)
   signal(signal_number, handle_signal);
 #endif
-  if (caml_async_signal_mode){
-    caml_leave_blocking_section ();
+  if (signal_number < 0 || signal_number >= NSIG) return;
+  if (caml_try_leave_blocking_section_hook()) {
     caml_execute_signal(signal_number, 1);
-    caml_enter_blocking_section ();
+    caml_enter_blocking_section_hook();
   }else{
-    caml_pending_signal = signal_number;
-    caml_something_to_do = 1;
-  }
+    caml_record_signal(signal_number);
+ }
 }
 
 void caml_urge_major_slice (void)
@@ -110,44 +154,26 @@ void caml_urge_major_slice (void)
 
 CAMLexport void caml_enter_blocking_section(void)
 {
-  int temp;
+  int i;
+  intnat pending;
 
   while (1){
-    Assert (!caml_async_signal_mode);
-    /* If a signal arrives between the next two instructions,
-       it will be lost. */
-    temp = caml_pending_signal;   caml_pending_signal = 0;
-    if (temp) caml_execute_signal(temp, 0);
-    caml_async_signal_mode = 1;
-    if (!caml_pending_signal) break;
-    caml_async_signal_mode = 0;
-  }
-  if (caml_enter_blocking_section_hook != NULL){
-    caml_enter_blocking_section_hook();
+    /* Process all pending signals now */
+    caml_process_pending_signals();
+    caml_enter_blocking_section_hook ();
+    /* Check again for pending signals. */
+    pending = 0;
+    for (i = 0; i < NSIG; i++) pending |= caml_pending_signals[i];
+    /* If none, done; otherwise, try again */
+    if (!pending) break;
+    caml_leave_blocking_section_hook ();
   }
 }
 
 CAMLexport void caml_leave_blocking_section(void)
 {
-#ifdef _WIN32
-  int signal_number;
-#endif
-
-  if (caml_leave_blocking_section_hook != NULL){
-    caml_leave_blocking_section_hook();
-  }
-#ifdef _WIN32
-  /* Under Win32, asynchronous signals such as ctrl-C are not processed
-     immediately (see ctrl_handler in win32.c), but simply set
-     [caml_pending_signal] and let the system call run to completion.
-     Hence, test [caml_pending_signal] here and act upon it, before we get
-     a chance to process the result of the system call. */
-  signal_number = caml_pending_signal;
-  caml_pending_signal = 0;
-  if (signal_number) caml_execute_signal(signal_number, 1);
-#endif
-  Assert(caml_async_signal_mode);
-  caml_async_signal_mode = 0;
+  caml_leave_blocking_section_hook ();
+  caml_process_pending_signals();
 }
 
 #ifndef SIGABRT
@@ -228,7 +254,7 @@ CAMLexport int caml_convert_signal_number(int signo)
     return signo;
 }
 
-static int rev_convert_signal_number(int signo)
+CAMLexport int caml_rev_convert_signal_number(int signo)
 {
   int i;
   for (i = 0; i < sizeof(posix_signals) / sizeof(int); i++)
@@ -236,10 +262,6 @@ static int rev_convert_signal_number(int signo)
   return signo;
 }
 
-#ifndef NSIG
-#define NSIG 64
-#endif
-
 CAMLprim value caml_install_signal_handler(value signal_number, value action)
 {
   CAMLparam2 (signal_number, action);
@@ -289,5 +311,6 @@ CAMLprim value caml_install_signal_handler(value signal_number, value action)
     }
     caml_modify(&Field(caml_signal_handlers, sig), Field(action, 0));
   }
+  caml_process_pending_signals();
   CAMLreturn (res);
 }
diff --git a/byterun/signals.h b/byterun/signals.h
index 4330ca860f..e1b5df1907 100644
--- a/byterun/signals.h
+++ b/byterun/signals.h
@@ -24,10 +24,9 @@
 
 /* <private> */
 extern value caml_signal_handlers;
-CAMLextern int volatile caml_pending_signal;
+CAMLextern intnat volatile caml_pending_signals[];
 CAMLextern int volatile caml_something_to_do;
 extern int volatile caml_force_major_slice;
-CAMLextern int volatile caml_async_signal_mode;
 /* </private> */
 
 CAMLextern void caml_enter_blocking_section (void);
@@ -36,11 +35,14 @@ CAMLextern void caml_leave_blocking_section (void);
 /* <private> */
 void caml_urge_major_slice (void);
 CAMLextern int caml_convert_signal_number (int);
+CAMLextern int caml_rev_convert_signal_number (int);
 void caml_execute_signal(int signal_number, int in_signal_handler);
+void caml_record_signal(int signal_number);
 void caml_process_event(void);
 
 CAMLextern void (*caml_enter_blocking_section_hook)(void);
 CAMLextern void (*caml_leave_blocking_section_hook)(void);
+CAMLextern int (*caml_try_leave_blocking_section_hook)(void);
 CAMLextern void (* volatile caml_async_action_hook)(void);
 /* </private> */
 
diff --git a/byterun/stacks.c b/byterun/stacks.c
index ed8f06527b..f43a442308 100644
--- a/byterun/stacks.c
+++ b/byterun/stacks.c
@@ -30,9 +30,9 @@ CAMLexport value * caml_trapsp;
 CAMLexport value * caml_trap_barrier;
 value caml_global_data;
 
-unsigned long caml_max_stack_size;            /* also used in gc_ctrl.c */
+uintnat caml_max_stack_size;            /* also used in gc_ctrl.c */
 
-void caml_init_stack (long unsigned int initial_max_size)
+void caml_init_stack (uintnat initial_max_size)
 {
   caml_stack_low = (value *) caml_stat_alloc(Stack_size);
   caml_stack_high = caml_stack_low + Stack_size / sizeof (value);
@@ -57,8 +57,9 @@ void caml_realloc_stack(asize_t required_space)
     if (size >= caml_max_stack_size) caml_raise_stack_overflow();
     size *= 2;
   } while (size < caml_stack_high - caml_extern_sp + required_space);
-  caml_gc_message (0x08, "Growing stack to %luk bytes\n",
-                   (unsigned long) size * sizeof(value) / 1024);
+  caml_gc_message (0x08, "Growing stack to %"
+                         ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
+                   (uintnat) size * sizeof(value) / 1024);
   new_low = (value *) caml_stat_alloc(size * sizeof(value));
   new_high = new_low + size;
 
@@ -89,7 +90,7 @@ CAMLprim value caml_ensure_stack_capacity(value required_space)
   return Val_unit;
 }
 
-void caml_change_max_stack_size (long unsigned int new_max_size)
+void caml_change_max_stack_size (uintnat new_max_size)
 {
   asize_t size = caml_stack_high - caml_extern_sp
                  + Stack_threshold / sizeof (value);
diff --git a/byterun/stacks.h b/byterun/stacks.h
index f33e9ad43c..0c23a0a398 100644
--- a/byterun/stacks.h
+++ b/byterun/stacks.h
@@ -33,9 +33,9 @@ CAMLextern value * caml_trap_barrier;
 #define Trap_pc(tp) (((code_t *)(tp))[0])
 #define Trap_link(tp) (((value **)(tp))[1])
 
-void caml_init_stack (unsigned long init_max_size);
+void caml_init_stack (uintnat init_max_size);
 void caml_realloc_stack (asize_t required_size);
-void caml_change_max_stack_size (unsigned long new_max_size);
+void caml_change_max_stack_size (uintnat new_max_size);
 
 
 #endif /* CAML_STACKS_H */
diff --git a/byterun/startup.c b/byterun/startup.c
index d1c8c76b38..c2cea2c4bd 100644
--- a/byterun/startup.c
+++ b/byterun/startup.c
@@ -52,6 +52,7 @@
 #include "stacks.h"
 #include "sys.h"
 #include "startup.h"
+#include "version.h"
 
 #ifndef O_BINARY
 #define O_BINARY 0
@@ -105,7 +106,7 @@ int caml_attempt_open(char **name, struct exec_trailer *trail,
   truename = caml_search_exe_in_path(*name);
   *name = truename;
   caml_gc_message(0x100, "Opening bytecode executable %s\n",
-                  (unsigned long) truename);
+                  (uintnat) truename);
   fd = open(truename, O_RDONLY | O_BINARY);
   if (fd == -1) {
     caml_gc_message(0x100, "Cannot open file\n", 0);
@@ -219,12 +220,12 @@ Algorithm:
 
 /* Configuration parameters and flags */
 
-static unsigned long percent_free_init = Percent_free_def;
-static unsigned long max_percent_free_init = Max_percent_free_def;
-static unsigned long minor_heap_init = Minor_heap_def;
-static unsigned long heap_chunk_init = Heap_chunk_def;
-static unsigned long heap_size_init = Init_heap_def;
-static unsigned long max_stack_init = Max_stack_def;
+static uintnat percent_free_init = Percent_free_def;
+static uintnat max_percent_free_init = Max_percent_free_def;
+static uintnat minor_heap_init = Minor_heap_def;
+static uintnat heap_chunk_init = Heap_chunk_def;
+static uintnat heap_size_init = Init_heap_def;
+static uintnat max_stack_init = Max_stack_def;
 
 /* Parse options on the command line */
 
@@ -240,7 +241,12 @@ static int parse_command_line(char **argv)
       break;
 #endif
     case 'v':
-      caml_verb_gc = 0x001+0x004+0x008+0x010+0x020;
+      if (!strcmp (argv[i], "-version")){
+        printf ("The Objective Caml runtime, version " OCAML_VERSION "\n");
+        exit (0);
+      }else{
+        caml_verb_gc = 0x001+0x004+0x008+0x010+0x020;
+      }
       break;
     case 'p':
       for (j = 0; caml_names_of_builtin_cprim[j] != NULL; j++)
@@ -271,14 +277,18 @@ static int parse_command_line(char **argv)
 
 /* If you change these functions, see also their copy in asmrun/startup.c */
 
-static void scanmult (char *opt, long unsigned int *var)
+static void scanmult (char *opt, uintnat *var)
 {
   char mult = ' ';
-  sscanf (opt, "=%lu%c", var, &mult);
-  sscanf (opt, "=0x%lx%c", var, &mult);
-  if (mult == 'k') *var = *var * 1024;
-  if (mult == 'M') *var = *var * 1024 * 1024;
-  if (mult == 'G') *var = *var * 1024 * 1024 * 1024;
+  int val;
+  sscanf (opt, "=%u%c", &val, &mult);
+  sscanf (opt, "=0x%x%c", &val, &mult);
+  switch (mult) {
+  case 'k':   *var = (uintnat) val * 1024; break;
+  case 'M':   *var = (uintnat) val * 1024 * 1024; break;
+  case 'G':   *var = (uintnat) val * 1024 * 1024 * 1024; break;
+  default:    *var = (uintnat) val; break;
+  }
 }
 
 static void parse_camlrunparam(void)
diff --git a/byterun/str.c b/byterun/str.c
index 8151fa37c1..79e4ef81b5 100644
--- a/byterun/str.c
+++ b/byterun/str.c
@@ -52,14 +52,14 @@ CAMLprim value caml_create_string(value len)
 
 CAMLprim value caml_string_get(value str, value index)
 {
-  long idx = Long_val(index);
+  intnat idx = Long_val(index);
   if (idx < 0 || idx >= caml_string_length(str)) caml_array_bound_error();
   return Val_int(Byte_u(str, idx));
 }
 
 CAMLprim value caml_string_set(value str, value index, value newval)
 {
-  long idx = Long_val(index);
+  intnat idx = Long_val(index);
   if (idx < 0 || idx >= caml_string_length(str)) caml_array_bound_error();
   Byte_u(str, idx) = Int_val(newval);
   return Val_unit;
diff --git a/byterun/sys.c b/byterun/sys.c
index c5f5c60e14..2dd20312ac 100644
--- a/byterun/sys.c
+++ b/byterun/sys.c
@@ -116,17 +116,19 @@ static int sys_open_flags[] = {
   O_BINARY, O_TEXT, O_NONBLOCK
 };
 
-CAMLprim value caml_sys_open(value path, value flags, value perm)
+CAMLprim value caml_sys_open(value path, value vflags, value vperm)
 {
-  CAMLparam3(path, flags, perm);
-  int fd;
+  CAMLparam3(path, vflags, vperm);
+  int fd, flags, perm;
   char * p;
 
   p = caml_stat_alloc(caml_string_length(path) + 1);
   strcpy(p, String_val(path));
+  flags = caml_convert_flag_list(vflags, sys_open_flags);
+  perm = Int_val(vperm);
   /* open on a named FIFO can block (PR#1533) */
   caml_enter_blocking_section();
-  fd = open(p, caml_convert_flag_list(flags, sys_open_flags), Int_val(perm));
+  fd = open(p, flags, perm);
   caml_leave_blocking_section();
   caml_stat_free(p);
   if (fd == -1) caml_sys_error(path);
@@ -226,7 +228,7 @@ CAMLprim value caml_sys_system_command(value command)
   CAMLparam1 (command);
   int status, retcode;
   char *buf;
-  unsigned long len;
+  intnat len;
   
   len = caml_string_length (command);
   buf = caml_stat_alloc (len + 1);
@@ -264,7 +266,7 @@ CAMLprim value caml_sys_time(value unit)
 
 CAMLprim value caml_sys_random_seed (value unit)
 {
-  long seed;
+  intnat seed;
 #ifdef HAS_GETTIMEOFDAY
   struct timeval tv;
   gettimeofday(&tv, NULL);
diff --git a/byterun/unix.c b/byterun/unix.c
index 217c861247..7bb986008a 100644
--- a/byterun/unix.c
+++ b/byterun/unix.c
@@ -348,21 +348,21 @@ char * caml_dlerror(void)
 char *caml_aligned_mmap (asize_t size, int modulo, void **block)
 {
   char *raw_mem;
-  unsigned long aligned_mem;
+  uintnat aligned_mem;
   Assert (modulo < Page_size);
   raw_mem = (char *) mmap(NULL, size + Page_size, PROT_READ | PROT_WRITE,
                           MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
   if (raw_mem == MAP_FAILED) return NULL;
   *block = raw_mem;
   raw_mem += modulo;                /* Address to be aligned */
-  aligned_mem = (((unsigned long) raw_mem / Page_size + 1) * Page_size);
+  aligned_mem = (((uintnat) raw_mem / Page_size + 1) * Page_size);
 #ifdef DEBUG
   {
-    unsigned long *p;
-    unsigned long *p0 = (void *) *block,
-                  *p1 = (void *) (aligned_mem - modulo),
-                  *p2 = (void *) (aligned_mem - modulo + size),
-                  *p3 = (void *) ((char *) *block + size + Page_size);
+    uintnat *p;
+    uintnat *p0 = (void *) *block,
+            *p1 = (void *) (aligned_mem - modulo),
+            *p2 = (void *) (aligned_mem - modulo + size),
+            *p3 = (void *) ((char *) *block + size + Page_size);
 
     for (p = p0; p < p1; p++) *p = Debug_filler_align;
     for (p = p1; p < p2; p++) *p = Debug_uninit_align;
diff --git a/byterun/win32.c b/byterun/win32.c
index 3352471088..229a07d63d 100644
--- a/byterun/win32.c
+++ b/byterun/win32.c
@@ -70,12 +70,12 @@ char * caml_search_in_path(struct ext_table * path, char * name)
     strcpy(fullname, (char *)(path->contents[i]));
     strcat(fullname, "\\");
     strcat(fullname, name);
-    caml_gc_message(0x100, "Searching %s\n", (unsigned long) fullname);
+    caml_gc_message(0x100, "Searching %s\n", (uintnat) fullname);
     if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode)) return fullname;
     caml_stat_free(fullname);
   }
  not_found:
-  caml_gc_message(0x100, "%s not found in search path\n", (unsigned long) name);
+  caml_gc_message(0x100, "%s not found in search path\n", (uintnat) name);
   fullname = caml_stat_alloc(strlen(name) + 1);
   strcpy(fullname, name);
   return fullname;
@@ -98,7 +98,7 @@ CAMLexport char * caml_search_exe_in_path(char * name)
 			 &filepart);
     if (retcode == 0) {
       caml_gc_message(0x100, "%s not found in search path\n",
-		      (unsigned long) name);
+		      (uintnat) name);
       strcpy(fullname, name);
       break;
     }
@@ -161,7 +161,6 @@ static volatile sighandler ctrl_handler_action = SIG_DFL;
 static BOOL WINAPI ctrl_handler(DWORD event)
 {
   int saved_mode;
-  sighandler action;
 
   /* Only ctrl-C and ctrl-Break are handled */
   if (event != CTRL_C_EVENT && event != CTRL_BREAK_EVENT) return FALSE;
@@ -170,17 +169,10 @@ static BOOL WINAPI ctrl_handler(DWORD event)
   /* Ignore behavior is to do nothing, which we get by claiming that we
      have handled the event */
   if (ctrl_handler_action == SIG_IGN) return TRUE;
-  /* Reset handler to default action for consistency with signal() */
-  action = ctrl_handler_action;
-  ctrl_handler_action = SIG_DFL;
-  /* Call user-provided signal handler.  Win32 doesn't like it when
-     we do a longjmp() at this point (it looks like we're running in
-     a different thread than the main program!).  So, pretend we are not in
-     async signal mode, so that the handler simply records the signal. */
-  saved_mode = caml_async_signal_mode;
-  caml_async_signal_mode = 0;
-  action(SIGINT);
-  caml_async_signal_mode = saved_mode;
+  /* Win32 doesn't like it when we do a longjmp() at this point
+     (it looks like we're running in a different thread than
+     the main program!).  So, just record the signal. */
+  caml_record_signal(SIGINT);
   /* We have handled the event */
   return TRUE;
 }
@@ -345,7 +337,7 @@ CAMLexport void caml_expand_command_line(int * argcp, char *** argvp)
 int caml_read_directory(char * dirname, struct ext_table * contents)
 {
   char * template;
-  long h;
+  intptr_t h;
   struct _finddata_t fileinfo;
   char * p;
 
@@ -385,8 +377,7 @@ void caml_signal_thread(void * lpParam)
     if (!ret || numread != 1) caml_sys_exit(Val_int(2));
     switch (iobuf[0]) {
     case 'C':
-      caml_pending_signal = SIGINT;
-      caml_something_to_do = 1;
+      caml_record_signal(SIGINT);
       break;
     case 'T':
       raise(SIGTERM);