Nouveau module Marshal dans stdlib

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

37 files changed, 781 insertions, 253 deletions

diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml
index 0fc392b9f..6ff2436a5 100644
--- a/asmcomp/asmlink.ml
+++ b/asmcomp/asmlink.ml
@@ -164,6 +164,7 @@ let make_startup_file filename info_list =
     Runtimedef.builtin_exceptions;
   Asmgen.compile_phrase(Cmmgen.global_table name_list);
   Asmgen.compile_phrase(Cmmgen.data_segment_table name_list);
+  Asmgen.compile_phrase(Cmmgen.code_segment_table name_list);
   Asmgen.compile_phrase
     (Cmmgen.frame_table("startup" :: "system" :: name_list));
   Emit.end_assembly();
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index fe06d2ead..04b2e53a3 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -1127,17 +1127,23 @@ let frame_table namelist =
         List.map (fun name -> Csymbol_address(name ^ "_frametable")) namelist @
         [cint_zero])
 
-(* Generate the table of module data segments *)
+(* Generate the table of module data and code segments *)
 
-let data_segment_table namelist =
-  Cdata(Cdefine_symbol "caml_data_segments" ::
+let segment_table namelist symbol begname endname =
+  Cdata(Cdefine_symbol symbol ::
         List.fold_right
           (fun name lst ->
-            Csymbol_address(name ^ "_begin") ::
-            Csymbol_address(name ^ "_end") :: lst)
+            Csymbol_address(name ^ begname) ::
+            Csymbol_address(name ^ endname) :: lst)
           namelist
           [cint_zero])
 
+let data_segment_table namelist =
+  segment_table namelist "caml_data_segments" "_data_begin" "_data_end"
+
+let code_segment_table namelist =
+  segment_table namelist "caml_code_segments" "_code_begin" "_code_end"
+
 (* Initialize a predefined exception *)
 
 let predef_exception name =
diff --git a/asmcomp/cmmgen.mli b/asmcomp/cmmgen.mli
index fc54974b3..7f7f100fb 100644
--- a/asmcomp/cmmgen.mli
+++ b/asmcomp/cmmgen.mli
@@ -21,4 +21,5 @@ val entry_point: string list -> Cmm.phrase
 val global_table: string list -> Cmm.phrase
 val frame_table: string list -> Cmm.phrase
 val data_segment_table: string list -> Cmm.phrase
+val code_segment_table: string list -> Cmm.phrase
 val predef_exception: string -> Cmm.phrase
diff --git a/asmcomp/emit_alpha.mlp b/asmcomp/emit_alpha.mlp
index 323446d5a..8e36b5498 100644
--- a/asmcomp/emit_alpha.mlp
+++ b/asmcomp/emit_alpha.mlp
@@ -633,13 +633,21 @@ let begin_assembly() =
      of line numbers for the debugger, 'cos they make .o files larger
      and slow down linking. *)
   `	.file	1 \"{emit_string !Location.input_name}\"\n\n`;
-  let lbl_begin = Compilenv.current_unit_name() ^ "_begin" in
+  let lbl_begin = Compilenv.current_unit_name() ^ "_data_begin" in
   `	.data\n`;
   `	.globl	{emit_symbol lbl_begin}\n`;
+  `{emit_symbol lbl_begin}:\n`;
+  let lbl_begin = Compilenv.current_unit_name() ^ "_code_begin" in
+  `	.text\n`;
+  `	.globl	{emit_symbol lbl_begin}\n`;
   `{emit_symbol lbl_begin}:\n`
 
 let end_assembly () =
-  let lbl_end = Compilenv.current_unit_name() ^ "_end" in
+  let lbl_end = Compilenv.current_unit_name() ^ "_code_end" in
+  `	.text\n`;
+  `	.globl	{emit_symbol lbl_end}\n`;
+  `{emit_symbol lbl_end}:\n`;
+  let lbl_end = Compilenv.current_unit_name() ^ "_data_end" in
   `	.data\n`;
   `	.globl	{emit_symbol lbl_end}\n`;
   `{emit_symbol lbl_end}:\n`;
diff --git a/asmcomp/emit_hppa.mlp b/asmcomp/emit_hppa.mlp
index eb9c46921..dc9186a16 100644
--- a/asmcomp/emit_hppa.mlp
+++ b/asmcomp/emit_hppa.mlp
@@ -1040,15 +1040,24 @@ let begin_assembly() =
   defined_symbols := StringSet.empty;
   called_symbols := StringSet.empty;
   Hashtbl.clear stub_label_table;
-  let lbl_begin = Compilenv.current_unit_name() ^ "_begin" in
+  let lbl_begin = Compilenv.current_unit_name() ^ "_data_begin" in
   `	.data\n`;
   emit_global lbl_begin;
+  `{emit_symbol lbl_begin}:\n`;
+  let lbl_begin = Compilenv.current_unit_name() ^ "_code_begin" in
+  `	.code\n`;
+  emit_global lbl_begin;
   `{emit_symbol lbl_begin}:\n`
 
+
 let end_assembly() =
   if not hpux then emit_stubs();
+  `	.code\n`;
+  let lbl_end = Compilenv.current_unit_name() ^ "_code_end" in
+  emit_global lbl_end;
+  `{emit_symbol lbl_end}:\n`;
   `	.data\n`;
-  let lbl_end = Compilenv.current_unit_name() ^ "_end" in
+  let lbl_end = Compilenv.current_unit_name() ^ "_data_end" in
   emit_global lbl_end;
   `{emit_symbol lbl_end}:\n`;
   `	.long	0\n`;
diff --git a/asmcomp/emit_i386.mlp b/asmcomp/emit_i386.mlp
index 052df0ed7..a7dbd365a 100644
--- a/asmcomp/emit_i386.mlp
+++ b/asmcomp/emit_i386.mlp
@@ -772,14 +772,22 @@ let data l =
 (* Beginning / end of an assembly file *)
 
 let begin_assembly() =
-  let lbl_begin = Compilenv.current_unit_name() ^ "_begin" in
+  let lbl_begin = Compilenv.current_unit_name() ^ "_data_begin" in
   `	.data\n`;
   `	.globl	{emit_symbol lbl_begin}\n`;
+  `{emit_symbol lbl_begin}:\n`;
+  let lbl_begin = Compilenv.current_unit_name() ^ "_code_begin" in
+  `	.text\n`;
+  `	.globl	{emit_symbol lbl_begin}\n`;
   `{emit_symbol lbl_begin}:\n`
 
 let end_assembly() =
+  let lbl_end = Compilenv.current_unit_name() ^ "_code_end" in
+  `	.text\n`;
+  `	.globl	{emit_symbol lbl_end}\n`;
+  `{emit_symbol lbl_end}:\n`;
   `	.data\n`;
-  let lbl_end = Compilenv.current_unit_name() ^ "_end" in
+  let lbl_end = Compilenv.current_unit_name() ^ "_data_end" in
   `	.globl	{emit_symbol lbl_end}\n`;
   `{emit_symbol lbl_end}:\n`;
   `	.long	0\n`;
diff --git a/asmcomp/emit_i386nt.mlp b/asmcomp/emit_i386nt.mlp
index 37ffbdd56..57eea3aeb 100644
--- a/asmcomp/emit_i386nt.mlp
+++ b/asmcomp/emit_i386nt.mlp
@@ -769,14 +769,24 @@ let begin_assembly() =
   `	EXTERN _caml_alloc3: PROC\n`;
   `	EXTERN _array_bound_error: PROC\n`;
   `	.DATA\n`;
-  let lbl_begin = Compilenv.current_unit_name() ^ "_begin" in
+  let lbl_begin = Compilenv.current_unit_name() ^ "_data_begin" in
+  add_def_symbol lbl_begin;
+  `	PUBLIC	{emit_symbol lbl_begin}\n`;
+  `{emit_symbol lbl_begin}	LABEL	DWORD\n`
+  `	.CODE\n`;
+  let lbl_begin = Compilenv.current_unit_name() ^ "_code_begin" in
   add_def_symbol lbl_begin;
   `	PUBLIC	{emit_symbol lbl_begin}\n`;
   `{emit_symbol lbl_begin}	LABEL	DWORD\n`
 
 let end_assembly() =
+  `	.CODE\n`;
+  let lbl_end = Compilenv.current_unit_name() ^ "_code_end" in
+  add_def_symbol lbl_end;
+  `	PUBLIC	{emit_symbol lbl_end}\n`;
+  `{emit_symbol lbl_end}	LABEL	DWORD\n`;
   `	.DATA\n`;
-  let lbl_end = Compilenv.current_unit_name() ^ "_end" in
+  let lbl_end = Compilenv.current_unit_name() ^ "_data_end" in
   add_def_symbol lbl_end;
   `	PUBLIC	{emit_symbol lbl_end}\n`;
   `{emit_symbol lbl_end}	LABEL	DWORD\n`;
diff --git a/asmcomp/emit_m68k.mlp b/asmcomp/emit_m68k.mlp
index aeb8efe6c..4cc345070 100644
--- a/asmcomp/emit_m68k.mlp
+++ b/asmcomp/emit_m68k.mlp
@@ -703,14 +703,22 @@ let data l =
 (* Beginning / end of an assembly file *)
 
 let begin_assembly() =
-  let lbl_begin = Compilenv.current_unit_name() ^ "_begin" in
+  let lbl_begin = Compilenv.current_unit_name() ^ "_data_begin" in
   `	.data\n`;
   `	.globl	{emit_symbol lbl_begin}\n`;
+  `{emit_symbol lbl_begin}:\n`;
+  let lbl_begin = Compilenv.current_unit_name() ^ "_code_begin" in
+  `	.text\n`;
+  `	.globl	{emit_symbol lbl_begin}\n`;
   `{emit_symbol lbl_begin}:\n`
 
 let end_assembly() =
+  `	.text\n`;
+  let lbl_end = Compilenv.current_unit_name() ^ "_code_end" in
+  `	.globl	{emit_symbol lbl_end}\n`;
+  `{emit_symbol lbl_end}:\n`;
   `	.data\n`;
-  let lbl_end = Compilenv.current_unit_name() ^ "_end" in
+  let lbl_end = Compilenv.current_unit_name() ^ "_data_end" in
   `	.globl	{emit_symbol lbl_end}\n`;
   `{emit_symbol lbl_end}:\n`;
   `	.long	0\n`;
diff --git a/asmcomp/emit_mips.mlp b/asmcomp/emit_mips.mlp
index ebfe0ec73..32af7294b 100644
--- a/asmcomp/emit_mips.mlp
+++ b/asmcomp/emit_mips.mlp
@@ -606,12 +606,20 @@ let begin_assembly() =
   (* The following .file directive is intended to prevent the generation
      of line numbers for the debugger, since they make .o files larger. *)
   `	.file	1 \"{emit_string !Location.input_name}\"\n\n`;
-  let lbl_begin = Compilenv.current_unit_name() ^ "_begin" in
+  let lbl_begin = Compilenv.current_unit_name() ^ "_data_begin" in
   `	.data\n`;
   `	.globl	{emit_symbol lbl_begin}\n`;
+  `{emit_symbol lbl_begin}:\n`;
+  let lbl_begin = Compilenv.current_unit_name() ^ "_code_begin" in
+  `	.text\n`;
+  `	.globl	{emit_symbol lbl_begin}\n`;
   `{emit_symbol lbl_begin}:\n`
 
 let end_assembly () =
+  let lbl_end = Compilenv.current_unit_name() ^ "_code_end" in
+  `	.text\n`;
+  `	.globl	{emit_symbol lbl_end}\n`;
+  `{emit_symbol lbl_end}:\n`;
   let lbl_end = Compilenv.current_unit_name() ^ "_end" in
   `	.data\n`;
   `	.globl	{emit_symbol lbl_end}\n`;
diff --git a/asmcomp/emit_power.mlp b/asmcomp/emit_power.mlp
index 081c3a917..2b1053c1b 100644
--- a/asmcomp/emit_power.mlp
+++ b/asmcomp/emit_power.mlp
@@ -92,6 +92,18 @@ let label_prefix = if toc then "L.." else ".L"
 let emit_label lbl =
   emit_string label_prefix; emit_int lbl
 
+(* Section switching *)
+
+let data_space =
+  if toc
+  then "	.csect  .data[RW]\n"
+  else "	.section \".data\"\n"
+
+let code_space =
+  if toc
+  then "	.csect  .text[PR]\n"
+  else "	.section \".text\"\n"
+
 (* Output a pseudo-register *)
 
 let emit_reg r =
@@ -728,14 +740,12 @@ let fundecl fundecl =
     `	.globl	.{emit_symbol fundecl.fun_name}\n`;
     `	.csect	{emit_symbol fundecl.fun_name}[DS]\n`;
     `{emit_symbol fundecl.fun_name}:\n`;
-    `	.long	.{emit_symbol fundecl.fun_name}, TOC[tc0], 0\n`;
-    `	.csect	.text[PR]\n`;
-    `	.align	2\n`
+    `	.long	.{emit_symbol fundecl.fun_name}, TOC[tc0], 0\n`
   end else begin
-    `	.type	{emit_symbol fundecl.fun_name}, @function\n`;
-    `	.section \".text\"\n`;
-    `	.align	2\n`
+    `	.type	{emit_symbol fundecl.fun_name}, @function\n`
   end;
+  emit_string code_space;
+  `	.align	2\n`;
   `{emit_codesymbol fundecl.fun_name}:\n`;
   let n = frame_size() in
   if !contains_calls then begin
@@ -770,11 +780,6 @@ let fundecl fundecl =
 
 (* Emission of data *)
 
-let data_space =
-  if toc
-  then "	.csect  .data[RW]\n"
-  else "	.section \".data\"\n"
-
 let declare_global_data s =
   `	.globl	{emit_symbol s}\n`;
   if not toc then `	.type	{emit_symbol s}, @object\n`
@@ -817,10 +822,14 @@ let begin_assembly() =
   num_jumptbl_entries := 0;
   jumptbl_entries := [];
   lbl_jumptbl := 0;
-  (* Emit the beginning of the data segment *)
-  let lbl_begin = Compilenv.current_unit_name() ^ "_begin" in
+  (* Emit the beginning of the segments *)
+  let lbl_begin = Compilenv.current_unit_name() ^ "_data_begin" in
   emit_string data_space;
   declare_global_data lbl_begin;
+  `{emit_symbol lbl_begin}:\n`;
+  let lbl_begin = Compilenv.current_unit_name() ^ "_code_begin" in
+  emit_string code_space;
+  declare_global_data lbl_begin;
   `{emit_symbol lbl_begin}:\n`
 
 let end_assembly() =
@@ -849,9 +858,13 @@ let end_assembly() =
     Hashtbl.iter emit_symbol_constant symbol_constants;
     Hashtbl.iter emit_float_constant float_constants
   end;
+  (* Emit the end of the segments *)
+  emit_string code_space;
+  let lbl_end = Compilenv.current_unit_name() ^ "_code_end" in
+  declare_global_data lbl_end;
+  `{emit_symbol lbl_end}:\n`;
   emit_string data_space;
-  (* Emit the end of the data segment *)
-  let lbl_end = Compilenv.current_unit_name() ^ "_end" in
+  let lbl_end = Compilenv.current_unit_name() ^ "_data_end" in
   declare_global_data lbl_end;
   `{emit_symbol lbl_end}:\n`;
   `	.long	0\n`;
diff --git a/asmcomp/emit_sparc.mlp b/asmcomp/emit_sparc.mlp
index ab3fe1ba5..bb689acf5 100644
--- a/asmcomp/emit_sparc.mlp
+++ b/asmcomp/emit_sparc.mlp
@@ -656,14 +656,22 @@ let data l =
 (* Beginning / end of an assembly file *)
 
 let begin_assembly() =
-  let lbl_begin = Compilenv.current_unit_name() ^ "_begin" in
+  let lbl_begin = Compilenv.current_unit_name() ^ "_data_begin" in
   `	.data\n`;
   `	.global	{emit_symbol lbl_begin}\n`;
+  `{emit_symbol lbl_begin}:\n`;
+  let lbl_begin = Compilenv.current_unit_name() ^ "_code_begin" in
+  `	.text\n`;
+  `	.global	{emit_symbol lbl_begin}\n`;
   `{emit_symbol lbl_begin}:\n`
 
 let end_assembly() =
+  `	.text\n`;
+  let lbl_end = Compilenv.current_unit_name() ^ "_code_end" in
+  `	.global	{emit_symbol lbl_end}\n`;
+  `{emit_symbol lbl_end}:\n`;
   `	.data\n`;
-  let lbl_end = Compilenv.current_unit_name() ^ "_end" in
+  let lbl_end = Compilenv.current_unit_name() ^ "_data_end" in
   `	.global	{emit_symbol lbl_end}\n`;
   `{emit_symbol lbl_end}:\n`;
   `	.word	0\n`;
diff --git a/asmrun/.depend b/asmrun/.depend
index 9b506db84..0e2a85cc2 100644
--- a/asmrun/.depend
+++ b/asmrun/.depend
@@ -56,7 +56,7 @@ intern.o: intern.c ../byterun/alloc.h ../byterun/misc.h \
  ../byterun/mlvalues.h ../byterun/fail.h ../byterun/gc.h \
  ../byterun/intext.h ../byterun/io.h ../byterun/memory.h \
  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/reverse.h
+ ../byterun/reverse.h ../byterun/md5.h
 ints.o: ints.c ../byterun/alloc.h ../byterun/misc.h \
  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
  ../byterun/mlvalues.h ../byterun/fail.h ../byterun/memory.h \
@@ -83,7 +83,8 @@ major_gc.o: major_gc.c ../byterun/compact.h ../byterun/config.h \
  ../byterun/roots.h ../byterun/weak.h
 md5.o: md5.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
  ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/fail.h ../byterun/io.h
+ ../byterun/mlvalues.h ../byterun/fail.h ../byterun/md5.h \
+ ../byterun/io.h ../byterun/reverse.h
 memory.o: memory.c ../byterun/fail.h ../byterun/misc.h \
  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
  ../byterun/mlvalues.h ../byterun/freelist.h ../byterun/gc.h \
@@ -198,7 +199,7 @@ intern.d.o: intern.c ../byterun/alloc.h ../byterun/misc.h \
  ../byterun/mlvalues.h ../byterun/fail.h ../byterun/gc.h \
  ../byterun/intext.h ../byterun/io.h ../byterun/memory.h \
  ../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
- ../byterun/reverse.h
+ ../byterun/reverse.h ../byterun/md5.h
 ints.d.o: ints.c ../byterun/alloc.h ../byterun/misc.h \
  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
  ../byterun/mlvalues.h ../byterun/fail.h ../byterun/memory.h \
@@ -225,7 +226,8 @@ major_gc.d.o: major_gc.c ../byterun/compact.h ../byterun/config.h \
  ../byterun/roots.h ../byterun/weak.h
 md5.d.o: md5.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
  ../byterun/../config/m.h ../byterun/../config/s.h \
- ../byterun/mlvalues.h ../byterun/fail.h ../byterun/io.h
+ ../byterun/mlvalues.h ../byterun/fail.h ../byterun/md5.h \
+ ../byterun/io.h ../byterun/reverse.h
 memory.d.o: memory.c ../byterun/fail.h ../byterun/misc.h \
  ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
  ../byterun/mlvalues.h ../byterun/freelist.h ../byterun/gc.h \
diff --git a/asmrun/startup.c b/asmrun/startup.c
index f1dbc709a..c78fff4dc 100644
--- a/asmrun/startup.c
+++ b/asmrun/startup.c
@@ -27,23 +27,33 @@
 
 header_t atom_table[256];
 char * static_data_start, * static_data_end;
+char * code_area_start, * code_area_end;
 
-/* Initialize the atom table */
+/* Initialize the atom table and the static data and code area limits. */
 
+struct segment { char * begin; char * end; };
+
+static void minmax_table(table, min, max)
+     struct segment table[];
+     char ** min, ** max;
+{
+  int i;
+  *min = table[0].begin;
+  *max = table[0].end;
+  for (i = 1; table[i].begin != 0; i++) {
+    if (table[i].begin < *min) *min = table[i].begin;
+    if (table[i].end > *max)   *max = table[i].end;
+  }
+}
+  
 static void init_atoms()
 {
   int i;
-  extern struct { char * begin; char * end; } caml_data_segments[];
+  extern struct segment caml_data_segments[], caml_code_segments[];
 
   for (i = 0; i < 256; i++) atom_table[i] = Make_header(0, i, White);
-  static_data_start = caml_data_segments[0].begin;
-  static_data_end = caml_data_segments[0].end;
-  for (i = 1; caml_data_segments[i].begin != 0; i++) {
-    if (caml_data_segments[i].begin < static_data_start)
-      static_data_start = caml_data_segments[i].begin;
-    if (caml_data_segments[i].end > static_data_end)
-      static_data_end = caml_data_segments[i].end;
-  }
+  minmax_table(caml_data_segments, &static_data_start, &static_data_end);
+  minmax_table(caml_code_segments, &code_area_start, &code_area_end);
 }
 
 /* Configuration parameters and flags */
diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml
index 80a9307a0..62fd5c8ed 100644
--- a/bytecomp/bytelink.ml
+++ b/bytecomp/bytelink.ml
@@ -316,7 +316,7 @@ let link_bytecode_as_c objfiles outfile =
     (* The table of global data *)
     output_string outchan "static char * caml_data =\n";
     output_data_string outchan
-       (Obj.marshal(Obj.repr(Symtable.initial_global_table())));
+      (Marshal.to_string (Symtable.initial_global_table()) []);
     (* The table of primitives *)
     Symtable.output_primitive_table outchan;
     (* The entry point *)
diff --git a/byterun/.depend b/byterun/.depend
index c82613c5a..f8fab9c77 100644
--- a/byterun/.depend
+++ b/byterun/.depend
@@ -15,14 +15,14 @@ debugger.o: debugger.c config.h ../config/m.h ../config/s.h debugger.h \
  misc.h mlvalues.h fail.h fix_code.h instruct.h intext.h io.h stacks.h \
  memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h
 extern.o: extern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
- mlvalues.h fail.h gc.h intext.h io.h memory.h major_gc.h freelist.h \
- minor_gc.h reverse.h str.h
+ mlvalues.h fail.h gc.h intext.h io.h fix_code.h memory.h major_gc.h \
+ freelist.h minor_gc.h reverse.h str.h
 fail.o: fail.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
  mlvalues.h fail.h gc.h memory.h major_gc.h freelist.h minor_gc.h \
  signals.h stacks.h
 fix_code.o: fix_code.c config.h ../config/m.h ../config/s.h debugger.h \
- misc.h mlvalues.h fix_code.h instruct.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h reverse.h
+ misc.h mlvalues.h fix_code.h instruct.h md5.h io.h memory.h gc.h \
+ major_gc.h freelist.h minor_gc.h reverse.h
 floats.o: floats.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
  mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
  stacks.h
@@ -35,8 +35,8 @@ hash.o: hash.c mlvalues.h config.h ../config/m.h ../config/s.h misc.h \
  memory.h gc.h major_gc.h freelist.h minor_gc.h str.h
 instrtrace.o: instrtrace.c
 intern.o: intern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
- mlvalues.h fail.h gc.h intext.h io.h memory.h major_gc.h freelist.h \
- minor_gc.h reverse.h
+ mlvalues.h fail.h gc.h intext.h io.h fix_code.h memory.h major_gc.h \
+ freelist.h minor_gc.h reverse.h
 interp.o: interp.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
  mlvalues.h callback.h debugger.h fail.h fix_code.h instrtrace.h \
  instruct.h interp.h major_gc.h freelist.h memory.h gc.h minor_gc.h \
@@ -57,7 +57,7 @@ major_gc.o: major_gc.c compact.h config.h ../config/m.h ../config/s.h \
  misc.h fail.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h roots.h \
  weak.h
 md5.o: md5.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
- mlvalues.h fail.h io.h
+ mlvalues.h fail.h md5.h io.h reverse.h
 memory.o: memory.c fail.h misc.h config.h ../config/m.h ../config/s.h \
  mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h minor_gc.h \
  signals.h
@@ -115,14 +115,14 @@ debugger.d.o: debugger.c config.h ../config/m.h ../config/s.h debugger.h \
  misc.h mlvalues.h fail.h fix_code.h instruct.h intext.h io.h stacks.h \
  memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h
 extern.d.o: extern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
- mlvalues.h fail.h gc.h intext.h io.h memory.h major_gc.h freelist.h \
- minor_gc.h reverse.h str.h
+ mlvalues.h fail.h gc.h intext.h io.h fix_code.h memory.h major_gc.h \
+ freelist.h minor_gc.h reverse.h str.h
 fail.d.o: fail.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
  mlvalues.h fail.h gc.h memory.h major_gc.h freelist.h minor_gc.h \
  signals.h stacks.h
 fix_code.d.o: fix_code.c config.h ../config/m.h ../config/s.h debugger.h \
- misc.h mlvalues.h fix_code.h instruct.h memory.h gc.h major_gc.h \
- freelist.h minor_gc.h reverse.h
+ misc.h mlvalues.h fix_code.h instruct.h md5.h io.h memory.h gc.h \
+ major_gc.h freelist.h minor_gc.h reverse.h
 floats.d.o: floats.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
  mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
  stacks.h
@@ -136,8 +136,8 @@ hash.d.o: hash.c mlvalues.h config.h ../config/m.h ../config/s.h misc.h \
 instrtrace.d.o: instrtrace.c instruct.h misc.h config.h ../config/m.h \
  ../config/s.h mlvalues.h opnames.h
 intern.d.o: intern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
- mlvalues.h fail.h gc.h intext.h io.h memory.h major_gc.h freelist.h \
- minor_gc.h reverse.h
+ mlvalues.h fail.h gc.h intext.h io.h fix_code.h memory.h major_gc.h \
+ freelist.h minor_gc.h reverse.h
 interp.d.o: interp.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
  mlvalues.h callback.h debugger.h fail.h fix_code.h instrtrace.h \
  instruct.h interp.h major_gc.h freelist.h memory.h gc.h minor_gc.h \
@@ -158,7 +158,7 @@ major_gc.d.o: major_gc.c compact.h config.h ../config/m.h ../config/s.h \
  misc.h fail.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h roots.h \
  weak.h
 md5.d.o: md5.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
- mlvalues.h fail.h io.h
+ mlvalues.h fail.h md5.h io.h reverse.h
 memory.d.o: memory.c fail.h misc.h config.h ../config/m.h ../config/s.h \
  mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h memory.h minor_gc.h \
  signals.h
diff --git a/byterun/debugger.c b/byterun/debugger.c
index 542d8dab2..fb87f1978 100644
--- a/byterun/debugger.c
+++ b/byterun/debugger.c
@@ -159,7 +159,7 @@ static void safe_output_value(chan, val)
   saved_external_raise = external_raise;
   if (sigsetjmp(raise_buf.buf, 1) == 0) {
     external_raise = &raise_buf;
-    output_value(chan, val);
+    output_value(chan, val, Val_unit);
   } else {
     /* Send wrong magic number, will cause input_value to fail */
     really_putblock(chan, "\000\000\000\000", 4);
diff --git a/byterun/extern.c b/byterun/extern.c
index 94a930d0a..12530c1c3 100644
--- a/byterun/extern.c
+++ b/byterun/extern.c
@@ -34,9 +34,10 @@ struct extern_obj {
   value obj;
 };
 
-static byteoffset_t initial_ofs = 1;
+static byteoffset_t initial_ofs = 1; /* Initial value of object offsets */
 static struct extern_obj * extern_table = NULL;
 static unsigned long extern_table_size;
+static byteoffset_t obj_counter;    /* Number of objects emitted so far */
 
 #ifdef ARCH_SIXTYFOUR
 #define Hash(v) (((unsigned long) ((v) >> 3)) % extern_table_size)
@@ -97,12 +98,14 @@ static void free_extern_table()
 /* To buffer the output */
 
 static char * extern_block, * extern_ptr, * extern_limit;
+static int extern_block_malloced;
 
 static void alloc_extern_block()
 {
   extern_block = stat_alloc(INITIAL_EXTERN_BLOCK_SIZE);
   extern_limit = extern_block + INITIAL_EXTERN_BLOCK_SIZE;
   extern_ptr = extern_block;
+  extern_block_malloced = 1;
 }
 
 static void resize_extern_block(required)
@@ -110,6 +113,11 @@ static void resize_extern_block(required)
 {
   long curr_pos, size, reqd_size;
 
+  if (! extern_block_malloced) {
+    initial_ofs += obj_counter;
+    free_extern_table();
+    failwith("Marshal.to_buffer: buffer overflow");
+  }
   curr_pos = extern_ptr - extern_block;
   size = extern_limit - extern_block;
   reqd_size = curr_pos + required;
@@ -119,12 +127,12 @@ static void resize_extern_block(required)
   extern_ptr = extern_block + curr_pos;
 }
 
+/* Write characters, integers, and blocks in the output buffer */
+
 #define Write(c) \
   if (extern_ptr >= extern_limit) resize_extern_block(1); \
   *extern_ptr++ = (c)
 
-/* Write integers and blocks in the output buffer */
-
 static void writeblock(data, len)
      char * data;
      long len;
@@ -193,14 +201,16 @@ static void writecode64(code, val)
 
 /* Marshal the given value in the output buffer */
 
-static byteoffset_t obj_counter;    /* Number of objects emitted so far */
 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 */
+
 static void extern_invalid_argument(msg)
      char * msg;
 {
-  stat_free(extern_block);
+  if (extern_block_malloced) stat_free(extern_block);
   initial_ofs += obj_counter;
   free_extern_table();
   invalid_argument(msg);
@@ -224,9 +234,9 @@ static void extern_rec(v)
 #endif
     } else
       writecode32(CODE_INT32, n);
-  } else if (!Is_atom(v) && !Is_young(v) && !Is_in_heap(v)) {
-    extern_invalid_argument("output_value: abstract value");
-  } else {
+    return;
+  }
+  if (Is_young(v) || Is_in_heap(v) || Is_atom(v)) {
     header_t hd = Hd_val(v);
     tag_t tag = Tag_hd(hd);
     mlsize_t sz = Wosize_hd(hd);
@@ -239,8 +249,10 @@ static void extern_rec(v)
       } else {
         writecode32(CODE_BLOCK32, hd);
       }
-    } else {
-      /* Check if already seen */
+      return;
+    }
+    /* Check if already seen */
+    if (! extern_ignore_sharing) {
       if (2 * obj_counter >= extern_table_size) resize_extern_table();
       h = Hash(v);
       while (extern_table[h].ofs >= initial_ofs) {
@@ -258,85 +270,100 @@ static void extern_rec(v)
         h++;
         if (h >= extern_table_size) h = 0;
       }
-      /* Not seen yet. Record the object and output its contents. */
+      /* Not seen yet. Record the object */
       extern_table[h].ofs = initial_ofs + obj_counter;
       extern_table[h].obj = v;
       obj_counter++;
-      switch(tag) {
-      case String_tag: {
-        mlsize_t len = string_length(v);
-        if (len < 0x20) {
-          Write(PREFIX_SMALL_STRING + len);
-        } else if (len < 0x100) {
-          writecode8(CODE_STRING8, len);
-        } else {
-          writecode32(CODE_STRING32, len);
-        }
-        writeblock(String_val(v), len);
-        size_32 += 1 + (len + 4) / 4;
-        size_64 += 1 + (len + 8) / 8;
-        break;
-      }
-      case Double_tag: {
-        if (sizeof(double) != 8)
-          extern_invalid_argument("output_value: non-standard floats");
-        Write(CODE_DOUBLE_NATIVE);
-        writeblock((char *) v, 8);
-        size_32 += 1 + 2;
-        size_64 += 1 + 1;
-        break;
+    }
+    /* Output the contents of the object */
+    switch(tag) {
+    case String_tag: {
+      mlsize_t len = string_length(v);
+      if (len < 0x20) {
+        Write(PREFIX_SMALL_STRING + len);
+      } else if (len < 0x100) {
+        writecode8(CODE_STRING8, len);
+      } else {
+        writecode32(CODE_STRING32, len);
       }
-      case Double_array_tag: {
-        mlsize_t nfloats;
-        if (sizeof(double) != 8)
-          extern_invalid_argument("output_value: non-standard floats");
-        nfloats = Wosize_val(v) / Double_wosize;
-        if (nfloats < 0x100) {
-          writecode8(CODE_DOUBLE_ARRAY8_NATIVE, nfloats);
-        } else {
-          writecode32(CODE_DOUBLE_ARRAY32_NATIVE, nfloats);
-        }
-        writeblock((char *) v, Bosize_val(v));
-        size_32 += 1 + nfloats * 2;
-        size_64 += 1 + nfloats;
-        break;
+      writeblock(String_val(v), len);
+      size_32 += 1 + (len + 4) / 4;
+      size_64 += 1 + (len + 8) / 8;
+      break;
+    }
+    case Double_tag: {
+      if (sizeof(double) != 8)
+        extern_invalid_argument("output_value: non-standard floats");
+      Write(CODE_DOUBLE_NATIVE);
+      writeblock((char *) v, 8);
+      size_32 += 1 + 2;
+      size_64 += 1 + 1;
+      break;
+    }
+    case Double_array_tag: {
+      mlsize_t nfloats;
+      if (sizeof(double) != 8)
+        extern_invalid_argument("output_value: non-standard floats");
+      nfloats = Wosize_val(v) / Double_wosize;
+      if (nfloats < 0x100) {
+        writecode8(CODE_DOUBLE_ARRAY8_NATIVE, nfloats);
+      } else {
+        writecode32(CODE_DOUBLE_ARRAY32_NATIVE, nfloats);
       }
-      case Abstract_tag:
-      case Final_tag:
-        extern_invalid_argument("output_value: abstract value");
-        break;
-      case Closure_tag:
-      case Infix_tag:
-        extern_invalid_argument("output_value: functional value");
-        break;
-      case Object_tag:
-        extern_invalid_argument("output_value: object value");
-        break;
-      default: {
-        mlsize_t i;
-        if (tag < 16 && sz < 8) {
-          Write(PREFIX_SMALL_BLOCK + tag + (sz << 4));
-        } else {
-          writecode32(CODE_BLOCK32, hd & ~Black);
-        }
-        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;
+      writeblock((char *) v, Bosize_val(v));
+      size_32 += 1 + nfloats * 2;
+      size_64 += 1 + nfloats;
+      break;
+    }
+    case Abstract_tag:
+    case Final_tag:
+      extern_invalid_argument("output_value: abstract value");
+      break;
+    case Infix_tag:
+      writecode32(CODE_INFIXPOINTER, Infix_offset_hd(hd));
+      extern_rec(v - Infix_offset_hd(hd));
+      break;
+    case Object_tag:
+      extern_invalid_argument("output_value: object value");
+      break;
+    default: {
+      mlsize_t i;
+      if (tag < 16 && sz < 8) {
+        Write(PREFIX_SMALL_BLOCK + tag + (sz << 4));
+      } else {
+        writecode32(CODE_BLOCK32, hd & ~Black);
       }
+      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;
       }
     }
+    return;
   }
+  if ((char *) v >= code_area_start && (char *) v < code_area_end) {
+    if (!extern_closures)
+      extern_invalid_argument("output_value: functional value");
+    writecode32(CODE_CODEPOINTER, (char *) v - code_area_start);
+    writeblock(code_checksum(), 16);
+    return;
+  }
+  extern_invalid_argument("output_value: abstract value");
 }
 
-static long extern_value(v)
-     value v;
+enum { NO_SHARING = 1, CLOSURES = 2 };
+static int extern_flags[] = { NO_SHARING, CLOSURES };
+
+static long extern_value(v, flags)
+     value v, flags;
 {
   long res_len;
-
-  /* Allocate buffer for holding the result */
-  alloc_extern_block();
+  int fl;
+  /* Parse flag list */
+  fl = 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;
   if (extern_table == NULL) {
@@ -376,25 +403,40 @@ static long extern_value(v)
   return res_len;
 }
 
-value output_value(chan, v) /* ML */
+value output_value(chan, v, flags) /* ML */
      struct channel * chan;
-     value v;
+     value v, flags;
 {
   long len;
-  len = extern_value(v);
+  alloc_extern_block();
+  len = extern_value(v, flags);
   really_putblock(chan, extern_block, len);
   stat_free(extern_block);
   return Val_unit;
 }
 
-value output_value_to_string(v) /* ML */
-     value v;
+value output_value_to_string(v, flags) /* ML */
+     value v, flags;
 {
   long len;
   value res;
-  len = extern_value(v);
+  alloc_extern_block();
+  len = extern_value(v, flags);
   res = alloc_string(len);
   bcopy(extern_block, String_val(res), len);
   stat_free(extern_block);
   return res;
 }
+
+value output_value_to_buffer(buf, ofs, len, v, flags) /* ML */
+     value buf, ofs, len, v, 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;
+  len_res = extern_value(v, flags);
+  return Val_long(len_res);
+}
+
diff --git a/byterun/fix_code.c b/byterun/fix_code.c
index d00e77bce..a68cb2f93 100644
--- a/byterun/fix_code.c
+++ b/byterun/fix_code.c
@@ -17,6 +17,7 @@
 #include "debugger.h"
 #include "fix_code.h"
 #include "instruct.h"
+#include "md5.h"
 #include "memory.h"
 #include "misc.h"
 #include "mlvalues.h"
@@ -28,6 +29,7 @@
 code_t start_code;
 asize_t code_size;
 unsigned char * saved_code;
+char code_md5[16];
 
 /* Read the main bytecode block from a file */
 
@@ -36,11 +38,15 @@ void load_code(fd, len)
      asize_t len;
 {
   int i;
+  struct MD5Context ctx;
 
   code_size = len;
   start_code = (code_t) stat_alloc(code_size);
   if (read(fd, (char *) start_code, code_size) != code_size)
     fatal_error("Fatal error: truncated bytecode file.\n");
+  MD5Init(&ctx);
+  MD5Update(&ctx, (unsigned char *) start_code, code_size);
+  MD5Final(code_md5, &ctx);
 #ifdef ARCH_BIG_ENDIAN
   fixup_endianness(start_code, code_size);
 #endif
diff --git a/byterun/fix_code.h b/byterun/fix_code.h
index e6149b091..8027f0e4f 100644
--- a/byterun/fix_code.h
+++ b/byterun/fix_code.h
@@ -24,6 +24,7 @@
 extern code_t start_code;
 extern asize_t code_size;
 extern unsigned char * saved_code;
+extern char code_md5[16];
 
 void load_code P((int fd, asize_t len));
 void fixup_endianness P((code_t code, asize_t len));
diff --git a/byterun/intern.c b/byterun/intern.c
index b58dd43a4..15064ce81 100644
--- a/byterun/intern.c
+++ b/byterun/intern.c
@@ -81,9 +81,10 @@ static void intern_rec(dest)
   unsigned int code;
   tag_t tag;
   mlsize_t size, len, ofs_ind;
-  value v;
+  value v, clos;
   asize_t ofs;
   header_t header;
+  char cksum[16];
 
  tailcall:
   code = read8u();
@@ -98,7 +99,7 @@ static void intern_rec(dest)
       } else {
         v = Val_hp(intern_dest);
         *dest = v;
-        intern_obj_table[obj_counter++] = v;
+        if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
         dest = (value *) (intern_dest + 1);
         *intern_dest = Make_header(size, tag, intern_color);
         intern_dest += 1 + size;
@@ -117,7 +118,7 @@ static void intern_rec(dest)
     read_string:
       size = (len + sizeof(value)) / sizeof(value);
       v = Val_hp(intern_dest);
-      intern_obj_table[obj_counter++] = v;
+      if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
       *intern_dest = Make_header(size, String_tag, intern_color);
       intern_dest += 1 + size;
       Field(v, size - 1) = 0;
@@ -147,7 +148,7 @@ static void intern_rec(dest)
       case CODE_SHARED8:
         ofs = read8u();
       read_shared:
-        Assert(ofs > 0 && ofs <= obj_counter); 
+        Assert(ofs > 0 && ofs <= obj_counter && intern_obj_table != NULL); 
         v = intern_obj_table[obj_counter - ofs];
         break;
       case CODE_SHARED16:
@@ -174,7 +175,7 @@ static void intern_rec(dest)
           invalid_argument("input_value: non-standard floats");
         }
         v = Val_hp(intern_dest);
-        intern_obj_table[obj_counter++] = v;
+        if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
         *intern_dest = Make_header(Double_wosize, Double_tag, intern_color);
         intern_dest += 1 + Double_wosize;
         readblock((char *) v, 8);
@@ -191,7 +192,7 @@ static void intern_rec(dest)
         }
         size = len * Double_wosize;
         v = Val_hp(intern_dest);
-        intern_obj_table[obj_counter++] = v;
+        if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
         *intern_dest = Make_header(size, Double_array_tag, intern_color);
         intern_dest += 1 + size;
         readblock((char *) v, len * 8);
@@ -209,8 +210,23 @@ static void intern_rec(dest)
       case CODE_DOUBLE_ARRAY32_BIG:
         len = read32u();
         goto read_double_array;
+      case CODE_CODEPOINTER:
+        ofs = read32u();
+        readblock(cksum, 16);
+        if (memcmp(cksum, code_checksum(), 16) != 0) {
+          intern_cleanup();
+          failwith("input_value: code mismatch");
+        }
+        v = (value) (code_area_start + ofs);
+        break;
+      case CODE_INFIXPOINTER:
+        ofs = read32u();
+        intern_rec(&clos);
+        v = clos + ofs;
+        break;
       default:
-        fatal_error("intern_rec");
+        intern_cleanup();
+        failwith("input_value: ill-formed message");
       }
     }
   }
@@ -237,7 +253,10 @@ static void intern_alloc(whsize, num_objects)
     Assert (intern_color == White || intern_color == Black);
     intern_dest = (header_t *) Hp_val(intern_block);
     obj_counter = 0;
-    intern_obj_table = (value *) stat_alloc(num_objects * sizeof(value));
+    if (num_objects > 0)
+      intern_obj_table = (value *) stat_alloc(num_objects * sizeof(value));
+    else
+      intern_obj_table = NULL;
   }
 }
 
@@ -280,36 +299,75 @@ value input_value(chan)         /* ML */
 value input_value_from_string(str, ofs) /* ML */
      value str, ofs;
 {
-  uint32 magic;
-  mlsize_t block_len, num_objects, size_32, size_64, whsize;
-  value res;
-  value obj = Val_unit;
+  mlsize_t num_objects, size_32, size_64, whsize;
+  value obj;
 
-  Begin_roots2(str, obj);
-    intern_src = &Byte_u(str, Long_val(ofs));
-    intern_input_malloced = 0;
-    magic = read32u();
-    if (magic != Intext_magic_number) failwith("input_value: bad object");
-    block_len = read32u();
-    num_objects = read32u();
-    size_32 = read32u();
-    size_64 = read32u();
-    /* Allocate result */
+  intern_src = &Byte_u(str, Long_val(ofs) + 2*4);
+  intern_input_malloced = 0;
+  num_objects = read32u();
+  size_32 = read32u();
+  size_64 = read32u();
+  /* Allocate result */
 #ifdef ARCH_SIXTYFOUR
-    whsize = size_64;
+  whsize = size_64;
 #else
-    whsize = size_32;
+  whsize = size_32;
 #endif
+  Begin_root(str);
     intern_alloc(whsize, num_objects);
-    intern_src = &Byte_u(str, Long_val(ofs) + 5*4); /* If a GC occurred */
-    /* Fill it in */
-    intern_rec(&obj);
-    /* Free everything */
-    if (intern_obj_table != NULL) stat_free((char *) intern_obj_table);
-    /* Build result */
-    res = alloc_tuple(2);
-    Field(res, 0) = obj;
-    Field(res, 1) = Val_long(Long_val(ofs) + 5*4 + block_len);
   End_roots();
-  return res;
+  intern_src = &Byte_u(str, Long_val(ofs) + 5*4); /* If a GC occurred */
+  /* Fill it in */
+  intern_rec(&obj);
+  /* Free everything */
+  if (intern_obj_table != NULL) stat_free((char *) intern_obj_table);
+  return obj;
 }
+
+value marshal_data_size(buff, ofs) /* ML */
+     value buff, ofs;
+{
+  uint32 magic;
+  mlsize_t block_len;
+
+  intern_src = &Byte_u(buff, Long_val(ofs));
+  intern_input_malloced = 0;
+  magic = read32u();
+  if (magic != Intext_magic_number) failwith("Marshal.data_size: bad object");
+  block_len = read32u();
+  return Val_long(block_len);
+}
+
+/* Return an MD5 checksum of the code area */
+
+#ifdef NATIVE_CODE
+
+#include "md5.h"
+
+char * code_checksum()
+{
+  static char checksum[16];
+  static int checksum_computed = 0;
+
+  if (! checksum_computed) {
+    struct MD5Context ctx;
+    MD5Init(&ctx);
+    MD5Update(&ctx,
+              (unsigned char *) code_area_start,
+              code_area_end - code_area_start);
+    MD5Final(checksum, &ctx);
+    checksum_computed = 1;
+  }
+  return checksum;
+}
+
+#else
+
+#include "fix_code.h"
+
+char * code_checksum()
+{
+  return code_md5;
+}
+
+#endif
diff --git a/byterun/intext.h b/byterun/intext.h
index 0eed0363e..9fc88d348 100644
--- a/byterun/intext.h
+++ b/byterun/intext.h
@@ -45,6 +45,8 @@
 #define CODE_DOUBLE_ARRAY8_LITTLE 0xE
 #define CODE_DOUBLE_ARRAY32_BIG 0xF
 #define CODE_DOUBLE_ARRAY32_LITTLE 0x7
+#define CODE_CODEPOINTER 0x10
+#define CODE_INFIXPOINTER 0x11
 
 #ifdef ARCH_BIG_ENDIAN
 #define CODE_DOUBLE_NATIVE CODE_DOUBLE_BIG
@@ -77,9 +79,21 @@
 
 /* The entry points */
 
-value output_value P((struct channel *, value));
-value input_value P((struct channel *));
-value input_value_from_string P((value, value));
+value output_value P((struct channel * chan, value v, value flags));
+value input_value P((struct channel * chan));
+value input_value_from_string P((value str, value ofs));
+
+/* Auxiliary stuff for sending code pointers */
+char * code_checksum P((void));
+
+#ifndef NATIVE_CODE
+#include "fix_code.h"
+#define code_area_start ((char *) start_code)
+#define code_area_end ((char *) start_code + code_size)
+#else
+extern char * code_area_start, * code_area_end;
+#endif
+
 
 #endif
 
diff --git a/byterun/md5.c b/byterun/md5.c
index 9c8b0bbc3..534342bea 100644
--- a/byterun/md5.c
+++ b/byterun/md5.c
@@ -14,23 +14,13 @@
 #include <string.h>
 #include "alloc.h"
 #include "fail.h"
+#include "md5.h"
 #include "mlvalues.h"
 #include "io.h"
+#include "reverse.h"
 
 /* MD5 message digest */
 
-struct MD5Context {
-        uint32 buf[4];
-        uint32 bits[2];
-        unsigned char in[64];
-};
-
-static void MD5Init P((struct MD5Context *context));
-static void MD5Update P((struct MD5Context *context, unsigned char *buf,
-               unsigned len));
-static void MD5Final P((unsigned char digest[16], struct MD5Context *ctx));
-static void MD5Transform P((uint32 buf[4], uint32 in[16]));
-
 value md5_string(str, ofs, len) /* ML */
      value str, ofs, len;
 {
@@ -86,7 +76,7 @@ value md5_chan(chan, len)       /* ML */
 #ifndef ARCH_BIG_ENDIAN
 #define byteReverse(buf, len)   /* Nothing */
 #else
-void byteReverse(buf, longs)
+static void byteReverse(buf, longs)
      unsigned char *buf;
      unsigned longs;
 {
@@ -104,7 +94,7 @@ void byteReverse(buf, longs)
  * Start MD5 accumulation.  Set bit count to 0 and buffer to mysterious
  * initialization constants.
  */
-static void MD5Init(ctx)
+void MD5Init(ctx)
      struct MD5Context *ctx;
 {
     ctx->buf[0] = 0x67452301;
@@ -120,7 +110,7 @@ static void MD5Init(ctx)
  * Update context to reflect the concatenation of another buffer full
  * of bytes.
  */
-static void MD5Update(ctx, buf, len)
+void MD5Update(ctx, buf, len)
      struct MD5Context *ctx;
      unsigned char *buf;
      unsigned len;
@@ -171,7 +161,7 @@ static void MD5Update(ctx, buf, len)
  * Final wrapup - pad to 64-byte boundary with the bit pattern 
  * 1 0* (64-bit count of bits processed, MSB-first)
  */
-static void MD5Final(digest, ctx)
+void MD5Final(digest, ctx)
      unsigned char digest[16];
      struct MD5Context *ctx;
 {
@@ -231,7 +221,7 @@ static void MD5Final(digest, ctx)
  * reflect the addition of 16 longwords of new data.  MD5Update blocks
  * the data and converts bytes into longwords for this routine.
  */
-static void MD5Transform(buf, in)
+void MD5Transform(buf, in)
      uint32 buf[4];
      uint32 in[16];
 {
diff --git a/byterun/reverse.h b/byterun/reverse.h
index 124b90888..7d112a124 100644
--- a/byterun/reverse.h
+++ b/byterun/reverse.h
@@ -11,21 +11,11 @@
 
 /* $Id$ */
 
-/* Swap byte-order in 16-bit, 32-bit and 64-bit words */
+/* Swap byte-order in 32-bit integers and in words */
 
 #ifndef _reverse_
 #define _reverse_
 
-
-#define Reverse_short(s) {                                                    \
-  char * _p;                                                                  \
-  int _a;                                                                     \
-  _p = (char *) (s);                                                          \
-  _a = _p[0];                                                                 \
-  _p[0] = _p[1];                                                              \
-  _p[1] = _a;                                                                 \
-}
-
 #define Reverse_int32(w) {                                                    \
   char * _p;                                                                  \
   int _a;                                                                     \
@@ -56,12 +46,7 @@
   _p[4] = _a;                                                                 \
 }
 
-#ifdef ARCH_SIXTYFOUR
-#define Reverse_word Reverse_int64
-#else
-#define Reverse_word Reverse_int32
-#endif
-
 #define Reverse_double Reverse_int64
 
+
 #endif /* _reverse_ */
diff --git a/byterun/startup.c b/byterun/startup.c
index ebd5d6bdf..98a08b2d4 100644
--- a/byterun/startup.c
+++ b/byterun/startup.c
@@ -340,7 +340,7 @@ void caml_startup_code(code, code_size, data, argv)
     thread_code(start_code, code_size);
 #endif
     /* Load the globals */
-    global_data = Field(input_value_from_string((value)data, Val_int(0)), 0);
+    global_data = input_value_from_string((value)data, Val_int(0));
     /* Ensure that the globals are in the major heap. */
     oldify(global_data, &global_data);
     /* Run the code */
diff --git a/emacs/Makefile b/emacs/Makefile
index b9c4f63ab..c727ebf62 100644
--- a/emacs/Makefile
+++ b/emacs/Makefile
@@ -16,14 +16,14 @@ COMPILECMD=(progn \
 
 install:
 	@if test "$(EMACSDIR)" = ""; then \
-          dir=`($(EMACS) --batch --eval "(mapcar 'print load-path)") \
-                2>/dev/null | \
-                sed -n -e '/\/site-lisp/s/"//gp'`; \
-          if test "$$dir" = ""; then \
+          set xxx `($(EMACS) --batch --eval "(mapcar 'print load-path)") \
+                   2>/dev/null | \
+                   sed -n -e '/\/site-lisp/s/"//gp'`; \
+          if test "$$2" = ""; then \
             echo "Cannot determine Emacs site-lisp directory"; \
             exit 2; \
           fi; \
-          $(MAKE) EMACSDIR="$$dir" simple-install; \
+          $(MAKE) EMACSDIR="$$2" simple-install; \
         else \
           $(MAKE) simple-install; \
         fi
diff --git a/otherlibs/systhreads/pervasives.ml b/otherlibs/systhreads/pervasives.ml
index a86f44d72..362c4a022 100644
--- a/otherlibs/systhreads/pervasives.ml
+++ b/otherlibs/systhreads/pervasives.ml
@@ -238,7 +238,8 @@ let output_byte = wrap2 output_byte_unlocked
 external output_binary_int_unlocked : out_channel -> int -> unit = "output_int"
 let output_binary_int = wrap2 output_binary_int_unlocked
 
-external output_value_unlocked : out_channel -> 'a -> unit = "output_value"
+external marshal_to_channel : out_channel -> 'a -> unit list -> unit = "output_value"
+let output_value_unlocked chan v = marshal_to_channel chan v []
 let output_value oc v = wrap2 output_value_unlocked oc v
 
 external seek_out_unlocked : out_channel -> int -> unit = "seek_out"
diff --git a/otherlibs/threads/pervasives.ml b/otherlibs/threads/pervasives.ml
index c9c4f32ab..35494f515 100644
--- a/otherlibs/threads/pervasives.ml
+++ b/otherlibs/threads/pervasives.ml
@@ -242,9 +242,8 @@ let output_binary_int oc n =
   output_byte oc (n asr 8);
   output_byte oc n
 
-external marshal : 'a -> string = "output_value_to_string"
-
-let output_value oc v = output_string oc (marshal v)
+external marshal_to_string : 'a -> unit list -> string = "output_value_to_string"
+let output_value oc v = output_string oc (marshal_to_string v [])
 
 external seek_out_blocking : out_channel -> int -> unit = "seek_out"
 
@@ -325,22 +324,17 @@ let input_binary_int ic =
   let b4 = input_byte ic in
   (n1 lsl 24) + (b2 lsl 16) + (b3 lsl 8) + b4
 
-external unmarshal : string -> int -> 'a * int = "input_value_from_string"
-external char_code: char -> int = "%identity"
+external unmarshal : string -> int -> 'a = "input_value_from_string"
+external marshal_data_size : string -> int -> int = "marshal_data_size"
 
 let input_value ic =
   let header = string_create 20 in
   really_input ic header 0 20;
-  let bsize =
-    (char_code header.[4] lsl 24) +
-    (char_code header.[5] lsl 16) +
-    (char_code header.[6] lsl 8) +
-    char_code header.[7] in
+  let bsize = marshal_data_size header 0 in
   let buffer = string_create (20 + bsize) in
   string_blit header 0 buffer 0 20;
   really_input ic buffer 20 bsize;
-  let (res, pos) = unmarshal buffer 0 in
-  res
+  unmarshal buffer 0
 
 external seek_in : in_channel -> int -> unit = "seek_in"
 external pos_in : in_channel -> int = "pos_in"
diff --git a/parsing/parse.ml b/parsing/parse.ml
index d59fc3da4..02a9a56fa 100644
--- a/parsing/parse.ml
+++ b/parsing/parse.ml
@@ -34,7 +34,9 @@ let maybe_skip_phrase lexbuf =
 
 let wrap parsing_fun lexbuf =
   try
-    parsing_fun Lexer.token lexbuf
+    let ast = parsing_fun Lexer.token lexbuf in
+    Parsing.clear_parser();
+    ast
   with
     | Lexer.Error(Lexer.Unterminated_comment, _, _) as err -> raise err
     | Lexer.Error(Lexer.Unterminated_string, _, _) as err -> raise err
diff --git a/stdlib/.depend b/stdlib/.depend
index b68e07b60..4619dc539 100644
--- a/stdlib/.depend
+++ b/stdlib/.depend
@@ -26,6 +26,8 @@ list.cmo: list.cmi
 list.cmx: list.cmi 
 map.cmo: map.cmi 
 map.cmx: map.cmi 
+marshal.cmo: string.cmi marshal.cmi 
+marshal.cmx: string.cmx marshal.cmi 
 obj.cmo: obj.cmi 
 obj.cmx: obj.cmi 
 oo.cmo: array.cmi hashtbl.cmi list.cmi map.cmi obj.cmi random.cmi sort.cmi \
diff --git a/stdlib/Makefile b/stdlib/Makefile
index 217c987a0..fe75a8924 100644
--- a/stdlib/Makefile
+++ b/stdlib/Makefile
@@ -13,7 +13,7 @@ OBJS=pervasives.cmo list.cmo char.cmo string.cmo array.cmo sys.cmo \
   hashtbl.cmo sort.cmo filename.cmo obj.cmo lexing.cmo parsing.cmo \
   set.cmo map.cmo stack.cmo queue.cmo stream.cmo \
   printf.cmo format.cmo arg.cmo printexc.cmo gc.cmo \
-  digest.cmo random.cmo oo.cmo genlex.cmo callback.cmo weak.cmo
+  digest.cmo random.cmo oo.cmo genlex.cmo callback.cmo weak.cmo marshal.cmo
 
 all: stdlib.cma std_exit.cmo camlheader
 
diff --git a/stdlib/marshal.ml b/stdlib/marshal.ml
new file mode 100644
index 000000000..163acb9f0
--- /dev/null
+++ b/stdlib/marshal.ml
@@ -0,0 +1,48 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  Automatique.  Distributed only by permission.                      *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+type extern_flags =
+    No_sharing
+  | Closures
+
+external to_channel: out_channel -> 'a -> extern_flags list -> unit
+    = "output_value"
+external to_string: 'a -> extern_flags list -> string = "output_value_to_string"
+external to_buffer_unsafe:
+      string -> int -> int -> 'a -> extern_flags list -> unit
+    = "output_value_to_buffer"
+
+let to_buffer buff ofs len v flags =
+  if ofs < 0 or len < 0 or ofs + len > String.length buff
+  then invalid_arg "Marshal.to_buffer: substring out of bounds"
+  else to_buffer_unsafe buff ofs len v flags
+
+external from_channel: in_channel -> 'a = "input_value"
+external from_string_unsafe: string -> int -> 'a = "input_value_from_string"
+external data_size_unsafe: string -> int -> int = "marshal_data_size"
+
+let header_size = 20
+let data_size buff ofs =
+  if ofs < 0 || ofs + header_size > String.length buff
+  then invalid_arg "Marshal.data_size"
+  else data_size_unsafe buff ofs
+
+let from_string buff ofs =
+  if ofs < 0 || ofs + header_size > String.length buff
+  then invalid_arg "Marshal.from_size"
+  else begin
+    let len = data_size_unsafe buff ofs in
+    if ofs + header_size + len > String.length buff
+    then invalid_arg "Marshal.from_string"
+    else from_string_unsafe buff ofs
+  end  
diff --git a/stdlib/marshal.mli b/stdlib/marshal.mli
new file mode 100644
index 000000000..2049569d5
--- /dev/null
+++ b/stdlib/marshal.mli
@@ -0,0 +1,125 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  Automatique.  Distributed only by permission.                      *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* Module [Marshal]: marshaling of data structures *)
+
+(* This module provides functions to encode arbitrary data structures
+   as sequences of bytes, which can then be written on a file or
+   sent over a pipe or network connection.  The bytes can then
+   be read back later, possibly in another process, and decoded back
+   into a data structure. The format for the byte sequences
+   is compatible across all machines for a given version of Objective Caml.
+
+   Warning: marshaling is currently not type-safe. The type
+   of marshaled data is not transmitted along the value of the data,
+   making it impossible to check that the data read back possesses the
+   type expected by the context. In particular, the result type of
+   the [Marshal.from_*] functions is given as ['a], but this is
+   misleading: the returned Caml value does not possess type ['a]
+   for all ['a]; it has one, unique type which cannot be determined
+   at compile-type.  The programmer should explicitly give the expected
+   type of the returned value, using the following syntax:
+                     [(Marshal.from_channel chan : type)].
+   The behavior is unspecified if the object in the file does not
+   belong to the given type.
+
+   The representation of marshaled values is not human-readable,
+   and uses bytes that are not printable characters. Therefore,
+   input and output channels used in conjunction with [Marshal.to_channel]
+   and [Marshal.from_channel] must be opened in binary mode, using e.g.
+   [open_out_bin] or [open_in_bin]; channels opened in text mode will
+   cause unmarshaling errors on platforms where text channels behave
+   differently than binary channels, e.g. Windows. *)
+
+type extern_flags =
+    No_sharing                          (* Don't preserve sharing *)
+  | Closures                            (* Send function closures *)
+        (* The flags to the [Marshal.to_*] functions below. *)
+
+external to_channel: out_channel -> 'a -> extern_flags list -> unit
+    = "output_value"
+        (* [Marshal.to_channel chan v flags] writes the representation
+           of [v] on channel [chan]. The [flags] argument is a
+           possibly empty list of flags that governs the marshaling
+           behavior with respect to sharing and functional values.
+
+           If [flags] does not contain [Marshal.No_sharing], circularities 
+           and sharing inside the value [v] are detected and preserved
+           in the sequence of bytes produced. In particular, this
+           guarantees that marshaling always terminates. Sharing
+           between values marshaled by successive calls to
+           [Marshal.to_channel] is not detected, though.
+           If [flags] contains [Marshal.No_sharing], sharing is ignored.
+           This results in faster marshaling if [v] contains no shared
+           substructures, but may cause slower marshaling and larger
+           byte representations if [v] actually contains sharing,
+           or even non-termination if [v] contains cycles.
+
+           If [flags] does not contain [Marshal.Closures],
+           marshaling fails when it encounters a functional value
+           inside [v]: only ``pure'' data structures, containing neither
+           functions nor objects, can safely be transmitted between
+           different programs. If [flags] contains [Marshal.Closures],
+           functional values will be marshaled as a position in the code
+           of the program. In this case, the output of marshaling can
+           only be read back in processes that run exactly the same program,
+           with exactly the same compiled code. (This is checked
+           at un-marshaling time, using an MD5 digest of the code
+           transmitted along with the code position.) *)
+
+external to_string: 'a -> extern_flags list -> string
+    = "output_value_to_string"
+        (* [Marshal.to_string v flags] returns a string containing
+           the representation of [v] as a sequence of bytes.
+           The [flags] argument has the same meaning as for
+           [Marshal.to_channel]. *)
+
+val to_buffer: string -> int -> int -> 'a -> extern_flags list -> unit
+        (* [Marshal.to_buffer v buff ofs len flags] marshals the value [v],
+           storing its byte representation in the string [buff],
+           starting at character number [ofs], and writing at most
+           [len] characters.  If the byte representation of [v]
+           does not fit in [len] characters, the exception [Failure]
+           is raised. *)
+
+external from_channel: in_channel -> 'a = "input_value"
+        (* [Marshal.from_channel chan] reads from channel [chan] the
+           byte representation of a structured value, as produced by
+           one of the [Marshal.to_*] functions, and reconstructs and
+           returns the corresponding value.*)
+
+val from_string: string -> int -> 'a
+        (* [Marshal.from_string buff ofs] unmarshals a structured value
+           like [Marshal.from_channel] does, except that the byte
+           representation is not read from a channel, but taken from
+           the string [buff], starting at position [ofs]. *)
+
+val header_size : int
+val data_size : string -> int -> int
+        (* The bytes representing a marshaled value are composed of
+           a fixed-size header and a variable-sized data part,
+           whose size can be determined from the header.
+           [Marshal.header_size] is the size, in characters, of the header.
+           [Marshal.data_size buff ofs] is the size, in characters,
+           of the data part, assuming a valid header is stored in
+           [buff] starting at position [ofs].  It raises [Failure]
+           if [buff], [ofs] does not contain a valid header.
+
+           To read the byte representation of a marshaled value into
+           a string buffer, one needs to read first [Marshal.header_size]
+           characters into the buffer, then determine the length of the
+           remainder of the representation using [Marshal.data_size],
+           make sure the buffer is large enough to hold the variable
+           size, then read it, and finally call [Marshal.from_string]
+           to unmarshal the value. *)
+
diff --git a/stdlib/obj.ml b/stdlib/obj.ml
index ec1abeb59..13f16db40 100644
--- a/stdlib/obj.ml
+++ b/stdlib/obj.ml
@@ -24,5 +24,3 @@ external size : t -> int = "%obj_size"
 external field : t -> int -> t = "%obj_field"
 external set_field : t -> int -> t -> unit = "%obj_set_field"
 external new_block : int -> int -> t = "obj_block"
-external marshal : t -> string = "output_value_to_string"
-external unmarshal : string -> int -> t * int = "input_value_from_string"
diff --git a/stdlib/obj.mli b/stdlib/obj.mli
index aee5777ac..d70a86415 100644
--- a/stdlib/obj.mli
+++ b/stdlib/obj.mli
@@ -26,5 +26,3 @@ external size : t -> int = "%obj_size"
 external field : t -> int -> t = "%obj_field"
 external set_field : t -> int -> t -> unit = "%obj_set_field"
 external new_block : int -> int -> t = "obj_block"
-external marshal : t -> string = "output_value_to_string"
-external unmarshal : string -> int -> t * int = "input_value_from_string"
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
index 1904da847..cf7cd1d15 100644
--- a/stdlib/pervasives.ml
+++ b/stdlib/pervasives.ml
@@ -195,7 +195,10 @@ let output oc s ofs len =
 
 external output_byte : out_channel -> int -> unit = "output_char"
 external output_binary_int : out_channel -> int -> unit = "output_int"
-external output_value : out_channel -> 'a -> unit = "output_value"
+
+external marshal_to_channel : out_channel -> 'a -> unit list -> unit
+     = "output_value"
+let output_value chan v = marshal_to_channel chan v []
 
 external seek_out : out_channel -> int -> unit = "seek_out"
 external pos_out : out_channel -> int = "pos_out"
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index 43e99ca6b..9b707b654 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -437,8 +437,9 @@ val output_value : out_channel -> 'a -> unit
         (* Write the representation of a structured value of any type
            to a channel. Circularities and sharing inside the value
            are detected and preserved. The object can be read back,
-           by the function [input_value]. The format is compatible across
-           all machines for a given version of Objective Caml. *)
+           by the function [input_value]. See the description of module
+           [Marshal] for more information. [output_value] is equivalent
+           to [Marshal.to_channel] with an empty list of flags. *)
 val seek_out : out_channel -> int -> unit
         (* [seek_out chan pos] sets the current writing position to [pos]
            for channel [chan]. This works only for regular files. On
@@ -510,14 +511,9 @@ val input_binary_int : in_channel -> int
 val input_value : in_channel -> 'a
         (* Read the representation of a structured value, as produced
            by [output_value], and return the corresponding value.
-           This is not type-safe. The type of the returned object is
-           not ['a] properly speaking: the returned object has one
-           unique type, which cannot be determined at compile-time.
-           The programmer should explicitly give the expected type of the
-           returned value, using the following syntax:
-                     [(input_value chan : type)].
-           The behavior is unspecified if the object in the file does not
-           belong to the given type. *)
+           This function is identical to [Marshal.from_channel];
+           see the description of module [Marshal] for more information,
+           in particular concerning the lack of type safety. *)
 val seek_in : in_channel -> int -> unit
         (* [seek_in chan pos] sets the current reading position to [pos]
            for channel [chan]. This works only for regular files. On
diff --git a/test/Moretest/intext.ml b/test/Moretest/intext.ml
index c0a82b398..6794b9b0d 100644
--- a/test/Moretest/intext.ml
+++ b/test/Moretest/intext.ml
@@ -15,6 +15,9 @@ let verylongstring =
  0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
  0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
 
+let rec fib n =
+  if n < 2 then 1 else fib(n-1) + fib(n-2)
+
 let test_out filename =
   let oc = open_out_bin filename in
   output_value oc 1;
@@ -44,6 +47,8 @@ let test_out filename =
   output_value oc [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|];
   let rec big n = if n <= 0 then A else H(n, big(n-1)) in
   output_value oc (big 1000);
+  Marshal.to_channel oc y [Marshal.No_sharing];
+  Marshal.to_channel oc fib [Marshal.Closures];
   close_out oc
 
 
@@ -106,11 +111,179 @@ let test_in filename =
                  | _ -> test 23 false
   in
     check_big 1000 (input_value ic);
+  test 24 (match input_value ic with
+    G((D "sharing" as t1), (D "sharing" as t2)) -> t1 != t2
+  | _ -> false);
+  test 25 (let fib = input_value ic in fib 5 = 8 && fib 10 = 89);
   close_in ic
 
+let test_string () =
+  let s = Marshal.to_string 1 [] in
+  test 101 (Marshal.from_string s 0 = 1);
+  let s = Marshal.to_string (-1) [] in
+  test 102 (Marshal.from_string s 0 = (-1));
+  let s = Marshal.to_string 258 [] in
+  test 103 (Marshal.from_string s 0 = 258);
+  let s = Marshal.to_string 20000 [] in
+  test 104 (Marshal.from_string s 0 = 20000);
+  let s = Marshal.to_string 0x12345678 [] in
+  test 105 (Marshal.from_string s 0 = 0x12345678);
+  let s = Marshal.to_string 0x123456789ABCDEF0 [] in
+  test 106 (Marshal.from_string s 0 = 0x123456789ABCDEF0);
+  let s = Marshal.to_string "foobargeebuz" [] in
+  test 107 (Marshal.from_string s 0 = "foobargeebuz");
+  let s = Marshal.to_string longstring [] in
+  test 108 (Marshal.from_string s 0 = longstring);
+  let s = Marshal.to_string verylongstring [] in
+  test 109 (Marshal.from_string s 0 = verylongstring);
+  let s = Marshal.to_string 3.141592654 [] in
+  test 110 (Marshal.from_string s 0 = 3.141592654);
+  let s = Marshal.to_string () [] in
+  test 111 (Marshal.from_string s 0 = ());
+  let s = Marshal.to_string A [] in
+  test 112 (match Marshal.from_string s 0 with
+    A -> true
+  | _ -> false);
+  let s = Marshal.to_string (B 1) [] in
+  test 113 (match Marshal.from_string s 0 with
+    (B 1) -> true
+  | _ -> false);
+  let s = Marshal.to_string (C 2.718) [] in
+  test 114 (match Marshal.from_string s 0 with
+    (C f) -> f = 2.718
+  | _ -> false);
+  let s = Marshal.to_string (D "hello, world!") [] in
+  test 115 (match Marshal.from_string s 0 with
+    (D "hello, world!") -> true
+  | _ -> false);
+  let s = Marshal.to_string (E 'l') [] in
+  test 116 (match Marshal.from_string s 0 with
+    (E 'l') -> true
+  | _ -> false);
+  let s = Marshal.to_string (F(B 1)) [] in
+  test 117 (match Marshal.from_string s 0 with
+    (F(B 1)) -> true
+  | _ -> false);
+  let s = Marshal.to_string (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [] in
+  test 118 (match Marshal.from_string s 0 with
+    (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) -> true
+  | _ -> false);
+  let s = Marshal.to_string (H(1, A)) [] in
+  test 119 (match Marshal.from_string s 0 with
+    (H(1, A)) -> true
+  | _ -> false);
+  let s = Marshal.to_string (I(B 2, 1e-6)) [] in
+  test 120 (match Marshal.from_string s 0 with
+    (I(B 2, 1e-6)) -> true
+  | _ -> false);
+  let x = D "sharing" in
+  let y = G(x, x) in
+  let z = G(y, G(x, y)) in
+  let s = Marshal.to_string z [] in
+  test 121 (match Marshal.from_string s 0 with
+    G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) ->
+      t1 == t2 & t3 == t5 & t4 == t1
+  | _ -> false);
+  let s = Marshal.to_string [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|] [] in
+  test 122 (Marshal.from_string s 0 = [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]);
+  let rec big n = if n <= 0 then A else H(n, big(n-1)) in
+  let s = Marshal.to_string (big 1000) [] in
+  let rec check_big n t =
+    if n <= 0 then
+      test 123 (match t with A -> true | _ -> false)
+    else
+      match t with H(m, s) -> if m = n then check_big (n-1) s
+                                       else test 123 false
+                 | _ -> test 123 false
+  in
+    check_big 1000 (Marshal.from_string s 0)
+
+let test_buffer () =
+  let s = String.create 512 in
+  Marshal.to_buffer s 0 512 1 [];
+  test 201 (Marshal.from_string s 0 = 1);
+  Marshal.to_buffer s 0 512 (-1) [];
+  test 202 (Marshal.from_string s 0 = (-1));
+  Marshal.to_buffer s 0 512 258 [];
+  test 203 (Marshal.from_string s 0 = 258);
+  Marshal.to_buffer s 0 512 20000 [];
+  test 204 (Marshal.from_string s 0 = 20000);
+  Marshal.to_buffer s 0 512 0x12345678 [];
+  test 205 (Marshal.from_string s 0 = 0x12345678);
+  Marshal.to_buffer s 0 512 0x123456789ABCDEF0 [];
+  test 206 (Marshal.from_string s 0 = 0x123456789ABCDEF0);
+  Marshal.to_buffer s 0 512 "foobargeebuz" [];
+  test 207 (Marshal.from_string s 0 = "foobargeebuz");
+  Marshal.to_buffer s 0 512 longstring [];
+  test 208 (Marshal.from_string s 0 = longstring);
+  test 209
+    (try Marshal.to_buffer s 0 512 verylongstring []; false
+     with Failure "Marshal.to_buffer: buffer overflow" -> true);
+  Marshal.to_buffer s 0 512 3.141592654 [];
+  test 210 (Marshal.from_string s 0 = 3.141592654);
+  Marshal.to_buffer s 0 512 () [];
+  test 211 (Marshal.from_string s 0 = ());
+  Marshal.to_buffer s 0 512 A [];
+  test 212 (match Marshal.from_string s 0 with
+    A -> true
+  | _ -> false);
+  Marshal.to_buffer s 0 512 (B 1) [];
+  test 213 (match Marshal.from_string s 0 with
+    (B 1) -> true
+  | _ -> false);
+  Marshal.to_buffer s 0 512 (C 2.718) [];
+  test 214 (match Marshal.from_string s 0 with
+    (C f) -> f = 2.718
+  | _ -> false);
+  Marshal.to_buffer s 0 512 (D "hello, world!") [];
+  test 215 (match Marshal.from_string s 0 with
+    (D "hello, world!") -> true
+  | _ -> false);
+  Marshal.to_buffer s 0 512 (E 'l') [];
+  test 216 (match Marshal.from_string s 0 with
+    (E 'l') -> true
+  | _ -> false);
+  Marshal.to_buffer s 0 512 (F(B 1)) [];
+  test 217 (match Marshal.from_string s 0 with
+    (F(B 1)) -> true
+  | _ -> false);
+  Marshal.to_buffer s 0 512 (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [];
+  test 218 (match Marshal.from_string s 0 with
+    (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) -> true
+  | _ -> false);
+  Marshal.to_buffer s 0 512 (H(1, A)) [];
+  test 219 (match Marshal.from_string s 0 with
+    (H(1, A)) -> true
+  | _ -> false);
+  Marshal.to_buffer s 0 512 (I(B 2, 1e-6)) [];
+  test 220 (match Marshal.from_string s 0 with
+    (I(B 2, 1e-6)) -> true
+  | _ -> false);
+  let x = D "sharing" in
+  let y = G(x, x) in
+  let z = G(y, G(x, y)) in
+  Marshal.to_buffer s 0 512 z [];
+  test 221 (match Marshal.from_string s 0 with
+    G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) ->
+      t1 == t2 & t3 == t5 & t4 == t1
+  | _ -> false);
+  Marshal.to_buffer s 0 512 [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|] [];
+  test 222 (Marshal.from_string s 0 = [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]);
+  let rec big n = if n <= 0 then A else H(n, big(n-1)) in
+  test 223
+    (try Marshal.to_buffer s 0 512 (big 1000) []; false
+     with Failure "Marshal.to_buffer: buffer overflow" -> true)
+
+let test_size() =
+  let s = Marshal.to_string (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [] in
+  test 300 (Marshal.header_size + Marshal.data_size s 0 = String.length s)
 
 let main() =
   test_out "intext.data"; test_in "intext.data";
-  test_out "intext.data"; test_in "intext.data"
+  test_out "intext.data"; test_in "intext.data";
+  Sys.remove "intext.data";
+  test_string();
+  test_buffer();
+  test_size()
 
 let _ = Printexc.catch main (); exit 0