Merge the natdynlink branch into HEAD.

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

16 files changed, 447 insertions, 173 deletions

diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index 4f2d54d172..215cec3265 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -56,6 +56,24 @@ let slot_offset loc cl =
 let emit_symbol s =
   Emitaux.emit_symbol '$' s
 
+let emit_call s =
+  if !Clflags.dlcode
+  then `call	{emit_symbol s}@PLT`
+  else `call	{emit_symbol s}`
+
+let emit_jump s =
+  if !Clflags.dlcode
+  then `jmp	{emit_symbol s}@PLT`
+  else `jmp	{emit_symbol s}`
+
+let load_symbol_addr s =
+  if !Clflags.dlcode
+  then `movq	{emit_symbol s}@GOTPCREL(%rip)`
+  else if !pic_code 
+  then `leaq	{emit_symbol s}(%rip)`
+  else `movq	${emit_symbol s}`
+
+
 (* Output a label *)
 
 let emit_label lbl =
@@ -111,7 +129,8 @@ let emit_reg32 r = emit_subreg reg_low_32_name r
 
 let emit_addressing addr r n =
   match addr with
-    Ibased(s, d) ->
+  | Ibased _ when !Clflags.dlcode -> assert false
+  | Ibased(s, d) ->
       `{emit_symbol s}`;
       if d <> 0 then ` + {emit_int d}`;
       `(%rip)`
@@ -164,7 +183,7 @@ type gc_call =
 let call_gc_sites = ref ([] : gc_call list)
 
 let emit_call_gc gc =
-  `{emit_label gc.gc_lbl}:	call	{emit_symbol "caml_call_gc"}\n`;
+  `{emit_label gc.gc_lbl}:	{emit_call "caml_call_gc"}\n`;
   `{emit_label gc.gc_frame}:	jmp	{emit_label gc.gc_return_lbl}\n`
 
 (* Record calls to caml_ml_array_bound_error.
@@ -191,13 +210,13 @@ let bound_error_label dbg =
  end
 
 let emit_call_bound_error bd =
-  `{emit_label bd.bd_lbl}:	call	{emit_symbol "caml_ml_array_bound_error"}\n`;
+  `{emit_label bd.bd_lbl}:	{emit_call "caml_ml_array_bound_error"}\n`;
   `{emit_label bd.bd_frame}:\n`
 
 let emit_call_bound_errors () =
   List.iter emit_call_bound_error !bound_error_sites;
   if !bound_error_call > 0 then
-    `{emit_label !bound_error_call}:	jmp	{emit_symbol "caml_ml_array_bound_error"}\n`
+    `{emit_label !bound_error_call}:	{emit_jump "caml_ml_array_bound_error"}\n`
 
 (* Names for instructions *)
 
@@ -326,15 +345,12 @@ let emit_instr fallthrough i =
           `	movlpd	{emit_label lbl}(%rip), {emit_reg i.res.(0)}\n`
         end
     | Lop(Iconst_symbol s) ->
-        if !pic_code then
-          `	leaq	{emit_symbol s}(%rip), {emit_reg i.res.(0)}\n`
-        else
-          `	movq	${emit_symbol s}, {emit_reg i.res.(0)}\n`
+        `	{load_symbol_addr s}, {emit_reg i.res.(0)}\n`
     | Lop(Icall_ind) ->
         `	call	*{emit_reg i.arg.(0)}\n`;
         record_frame i.live i.dbg
     | Lop(Icall_imm(s)) ->
-        `	call	{emit_symbol s}\n`;
+        `	{emit_call s}\n`;
         record_frame i.live i.dbg
     | Lop(Itailcall_ind) ->
         output_epilogue();
@@ -344,15 +360,15 @@ let emit_instr fallthrough i =
           `	jmp	{emit_label !tailrec_entry_point}\n`
         else begin
           output_epilogue();
-          `	jmp	{emit_symbol s}\n`
+	  `	{emit_jump s}\n`
         end
     | Lop(Iextcall(s, alloc)) ->
         if alloc then begin
-          `	leaq	{emit_symbol s}(%rip), %rax\n`;
-          `	call	{emit_symbol "caml_c_call"}\n`;
+          `	{load_symbol_addr s}, %rax\n`;
+          `	{emit_call "caml_c_call"}\n`;
           record_frame i.live i.dbg
         end else begin
-          `	call	{emit_symbol s}\n`
+          `	{emit_call s}\n`
         end
     | Lop(Istackoffset n) ->
         if n < 0
@@ -401,7 +417,11 @@ let emit_instr fallthrough i =
         if !fastcode_flag then begin
           let lbl_redo = new_label() in
           `{emit_label lbl_redo}:	subq	${emit_int n}, %r15\n`;
-          `	cmpq	{emit_symbol "caml_young_limit"}(%rip), %r15\n`;
+	  if !Clflags.dlcode then begin
+            `	{load_symbol_addr "caml_young_limit"}, %rax\n`;
+            `	cmpq	(%rax), %r15\n`;
+	  end else
+            `	cmpq	{emit_symbol "caml_young_limit"}(%rip), %r15\n`;
           let lbl_call_gc = new_label() in
           let lbl_frame = record_frame_label i.live Debuginfo.none in
           `	jb	{emit_label lbl_call_gc}\n`;
@@ -412,11 +432,11 @@ let emit_instr fallthrough i =
               gc_frame = lbl_frame } :: !call_gc_sites
         end else begin
           begin match n with
-            16  -> `	call	{emit_symbol "caml_alloc1"}\n`
-          | 24 -> `	call	{emit_symbol "caml_alloc2"}\n`
-          | 32 -> `	call	{emit_symbol "caml_alloc3"}\n`
+            16  -> `	{emit_call "caml_alloc1"}\n`
+          | 24 -> `	{emit_call "caml_alloc2"}\n`
+          | 32 -> `	{emit_call "caml_alloc3"}\n`
           | _  -> `	movq	${emit_int n}, %rax\n`;
-                  `	call	{emit_symbol "caml_allocN"}\n`
+                  `	{emit_call "caml_allocN"}\n`
           end;
           `{record_frame i.live Debuginfo.none}	leaq	8(%r15), {emit_reg i.res.(0)}\n`
         end
@@ -487,7 +507,7 @@ let emit_instr fallthrough i =
     | Lop(Ispecific(Istore_int(n, addr))) ->
         `	movq	${emit_nativeint n}, {emit_addressing addr i.arg 0}\n`
     | Lop(Ispecific(Istore_symbol(s, addr))) ->
-        assert (not !pic_code);
+        assert (not !pic_code && not !Clflags.dlcode);
         `	movq	${emit_symbol s}, {emit_addressing addr i.arg 0}\n`
     | Lop(Ispecific(Ioffset_loc(n, addr))) ->
         `	addq	${emit_int n}, {emit_addressing addr i.arg 0}\n`
@@ -548,7 +568,7 @@ let emit_instr fallthrough i =
             end
     | Lswitch jumptbl ->
         let lbl = new_label() in
-        if !pic_code then begin
+        if !pic_code || !Clflags.dlcode then begin
           `	leaq	{emit_label lbl}(%rip), %r11\n`;
           `	jmp	*(%r11, {emit_reg i.arg.(0)}, 8)\n`
         end else begin
@@ -573,7 +593,7 @@ let emit_instr fallthrough i =
         stack_offset := !stack_offset - 16
     | Lraise ->
         if !Clflags.debug then begin
-          `	call    {emit_symbol "caml_raise_exn"}\n`;
+          `	{emit_call "caml_raise_exn"}\n`;
           record_frame Reg.Set.empty i.dbg
         end else begin
           `	movq	%r14, %rsp\n`;
@@ -605,7 +625,7 @@ let emit_profile () =
       `	pushq	%r10\n`;
       `	movq	%rsp, %rbp\n`;
       `	pushq	%r11\n`;
-      `	call	{emit_symbol "mcount"}\n`;
+      `	{emit_call "mcount"}\n`;
       `	popq	%r11\n`;
       `	popq	%r10\n`
   | _ ->
@@ -679,6 +699,14 @@ let data l =
 (* Beginning / end of an assembly file *)
 
 let begin_assembly() =
+  if !Clflags.dlcode then begin
+    (* from amd64.S; could emit these constants on demand *)
+    `	.section        .rodata.cst8,\"a\",@progbits\n`;
+    `	.align  16\n`;
+    `caml_negf_mask:	.quad   0x8000000000000000, 0\n`;
+    `	.align  16\n`;
+    `caml_absf_mask:	.quad   0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF\n`;
+  end;
   let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
   `	.data\n`;
   `	.globl	{emit_symbol lbl_begin}\n`;
diff --git a/asmcomp/amd64/proc.ml b/asmcomp/amd64/proc.ml
index 2b0cdc6d18..32d669dbbe 100644
--- a/asmcomp/amd64/proc.ml
+++ b/asmcomp/amd64/proc.ml
@@ -170,7 +170,7 @@ let destroyed_at_oper = function
   | Iop(Istore(Single, _)) -> [| rxmm15 |]
   | Iop(Ialloc _ | Iintop(Icomp _) | Iintop_imm((Idiv|Imod|Icomp _), _))
         -> [| rax |]
-  | Iswitch(_, _) when !pic_code -> [| r11 |]
+  | Iswitch(_, _) when !pic_code || !Clflags.dlcode -> [| r11 |]
   | _ -> [||]
 
 let destroyed_at_raise = all_phys_regs
diff --git a/asmcomp/amd64/reload.ml b/asmcomp/amd64/reload.ml
index 99413edcc1..6901b5594e 100644
--- a/asmcomp/amd64/reload.ml
+++ b/asmcomp/amd64/reload.ml
@@ -93,7 +93,7 @@ method reload_operation op arg res =
       then (arg, res)
       else super#reload_operation op arg res
   | Iconst_symbol _ ->
-      if !pic_code
+      if !pic_code || !Clflags.dlcode
       then super#reload_operation op arg res
       else (arg, res)
   | _ -> (* Other operations: all args and results in registers *)
diff --git a/asmcomp/amd64/selection.ml b/asmcomp/amd64/selection.ml
index d33ae744cc..6ee3ee160d 100644
--- a/asmcomp/amd64/selection.ml
+++ b/asmcomp/amd64/selection.ml
@@ -32,7 +32,7 @@ type addressing_expr =
 
 let rec select_addr exp =
   match exp with
-    Cconst_symbol s ->
+    Cconst_symbol s when not !Clflags.dlcode ->
       (Asymbol s, 0)
   | Cop((Caddi | Cadda), [arg; Cconst_int m]) ->
       let (a, n) = select_addr arg in (a, n + m)
@@ -144,7 +144,7 @@ method select_store addr exp =
       (Ispecific(Istore_int(Nativeint.of_int n, addr)), Ctuple [])
   | Cconst_natpointer n when self#is_immediate_natint n ->
       (Ispecific(Istore_int(n, addr)), Ctuple [])
-  | Cconst_symbol s when not !pic_code ->
+  | Cconst_symbol s when not (!pic_code || !Clflags.dlcode) ->
       (Ispecific(Istore_symbol(s, addr)), Ctuple [])
   | _ ->
       super#select_store addr exp
diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml
index 341d71c7b2..93364628c5 100644
--- a/asmcomp/asmgen.ml
+++ b/asmcomp/asmgen.ml
@@ -83,7 +83,18 @@ let compile_phrase ppf p =
   | Cfunction fd -> compile_fundecl ppf fd
   | Cdata dl -> Emit.data dl
 
-let compile_implementation prefixname ppf (size, lam) =
+
+(* For the native toplevel: generates generic functions unless
+   they are already available in the process *)
+let compile_genfuns ppf f =
+  List.iter
+    (function
+       | (Cfunction {fun_name = name}) as ph when f name ->
+	   compile_phrase ppf ph
+       | _ -> ())
+    (Cmmgen.generic_functions true [Compilenv.current_unit_infos ()])
+
+let compile_implementation ?toplevel prefixname ppf (size, lam) =
   let asmfile =
     if !keep_asm_file
     then prefixname ^ ext_asm
@@ -95,6 +106,7 @@ let compile_implementation prefixname ppf (size, lam) =
     Closure.intro size lam
     ++ Cmmgen.compunit size
     ++ List.iter (compile_phrase ppf) ++ (fun () -> ());
+    (match toplevel with None -> () | Some f -> compile_genfuns ppf f);
     Emit.end_assembly();
     close_out oc
   with x ->
diff --git a/asmcomp/asmgen.mli b/asmcomp/asmgen.mli
index 0f6b831ceb..fe578bd4f5 100644
--- a/asmcomp/asmgen.mli
+++ b/asmcomp/asmgen.mli
@@ -15,6 +15,7 @@
 (* From lambda to assembly code *)
 
 val compile_implementation :
+    ?toplevel:(string -> bool) ->
     string -> Format.formatter -> int * Lambda.lambda -> unit
 val compile_phrase :
     Format.formatter -> Cmm.phrase -> unit
diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml
index 0b79aa3983..eeb318d0fb 100644
--- a/asmcomp/asmlink.ml
+++ b/asmcomp/asmlink.ml
@@ -96,6 +96,30 @@ let add_ccobjs l =
     lib_ccopts := l.lib_ccopts @ !lib_ccopts
   end
 
+let runtime_lib () =  
+  let libname =
+    if !Clflags.gprofile
+    then "libasmrunp" ^ ext_lib
+    else "libasmrun" ^ ext_lib in
+  try
+    if !Clflags.nopervasives then ""
+    else find_in_path !load_path libname
+  with Not_found ->
+    raise(Error(File_not_found libname))
+
+let object_file_name name =
+  let file_name =
+    try
+      find_in_path !load_path name
+    with Not_found ->
+      fatal_error "Asmlink.object_file_name: not found" in
+  if Filename.check_suffix file_name ".cmx" then
+    Filename.chop_suffix file_name ".cmx" ^ ext_obj
+  else if Filename.check_suffix file_name ".cmxa" then
+    Filename.chop_suffix file_name ".cmxa" ^ ext_lib
+  else
+    fatal_error "Asmlink.object_file_name: bad ext"
+
 (* First pass: determine which units are needed *)
 
 let missing_globals = (Hashtbl.create 17 : (string, string list ref) Hashtbl.t)
@@ -119,7 +143,11 @@ let extract_missing_globals () =
   Hashtbl.iter (fun md rq -> mg := (md, !rq) :: !mg) missing_globals;
   !mg
 
-let scan_file obj_name tolink =
+type file = 
+  | Unit of string * Compilenv.unit_infos * Digest.t
+  | Library of string * Compilenv.library_infos
+
+let read_file obj_name =
   let file_name =
     try
       find_in_path !load_path obj_name
@@ -129,45 +157,46 @@ let scan_file obj_name tolink =
     (* This is a .cmx file. It must be linked in any case.
        Read the infos to see which modules it requires. *)
     let (info, crc) = Compilenv.read_unit_info file_name in
-    remove_required info.ui_name;
-    List.iter (add_required file_name) info.ui_imports_cmx;
-    (info, file_name, crc) :: tolink
+    Unit (file_name,info,crc)
   end
   else if Filename.check_suffix file_name ".cmxa" then begin
-    (* This is an archive file. Each unit contained in it will be linked
-       in only if needed. *)
-    let ic = open_in_bin file_name in
-    let buffer = String.create (String.length cmxa_magic_number) in
-    really_input ic buffer 0 (String.length cmxa_magic_number);
-    if buffer <> cmxa_magic_number then
-      raise(Error(Not_an_object_file file_name));
-    let infos = (input_value ic : library_infos) in
-    close_in ic;
-    add_ccobjs infos;
-    List.fold_right
-      (fun (info, crc) reqd ->
-        if info.ui_force_link
-        || !Clflags.link_everything
-        || is_required info.ui_name
-        then begin
-          remove_required info.ui_name;
-          List.iter (add_required (Printf.sprintf "%s(%s)"
-                                                  file_name info.ui_name))
-                    info.ui_imports_cmx;
-          (info, file_name, crc) :: reqd
-        end else
-          reqd)
-    infos.lib_units tolink
+    let infos = 
+      try Compilenv.read_library_info file_name
+      with Compilenv.Error(Not_a_unit_info _) ->
+	raise(Error(Not_an_object_file file_name))
+    in
+    Library (file_name,infos)
   end
   else raise(Error(Not_an_object_file file_name))
 
-(* Second pass: generate the startup file and link it with everything else *)
+let scan_file obj_name tolink = match read_file obj_name with
+  | Unit (file_name,info,crc) ->
+      (* This is a .cmx file. It must be linked in any case.
+	 Read the infos to see which modules it requires. *)
+      let (info, crc) = Compilenv.read_unit_info file_name in
+      remove_required info.ui_name;
+      List.iter (add_required file_name) info.ui_imports_cmx;
+      (info, file_name, crc) :: tolink
+  | Library (file_name,infos) ->
+      (* This is an archive file. Each unit contained in it will be linked
+	 in only if needed. *)
+      add_ccobjs infos;
+      List.fold_right
+	(fun (info, crc) reqd ->
+           if info.ui_force_link
+             || !Clflags.link_everything
+             || is_required info.ui_name
+           then begin
+             remove_required info.ui_name;
+             List.iter (add_required (Printf.sprintf "%s(%s)"
+                                        file_name info.ui_name))
+               info.ui_imports_cmx;
+             (info, file_name, crc) :: reqd
+           end else
+             reqd)
+	infos.lib_units tolink
 
-module IntSet = Set.Make(
-  struct
-    type t = int
-    let compare = compare
-  end)
+(* Second pass: generate the startup file and link it with everything else *)
 
 let make_startup_file ppf filename units_list =
   let compile_phrase p = Asmgen.compile_phrase ppf p in
@@ -179,64 +208,134 @@ let make_startup_file ppf filename units_list =
   let name_list =
     List.flatten (List.map (fun (info,_,_) -> info.ui_defines) units_list) in
   compile_phrase (Cmmgen.entry_point name_list);
-  let apply_functions = ref (IntSet.add 2 (IntSet.add 3 IntSet.empty)) in
-  (* The callback functions always reference caml_apply[23] *)
-  let send_functions = ref IntSet.empty in
-  let curry_functions = ref IntSet.empty in
-  List.iter
-    (fun (info,_,_) ->
-      List.iter
-        (fun n -> apply_functions := IntSet.add n !apply_functions)
-        info.ui_apply_fun;
-      List.iter
-        (fun n -> send_functions := IntSet.add n !send_functions)
-        info.ui_send_fun;
-      List.iter
-        (fun n -> curry_functions := IntSet.add n !curry_functions)
-        info.ui_curry_fun)
-    units_list;
-  IntSet.iter
-    (fun n -> compile_phrase (Cmmgen.apply_function n))
-    !apply_functions;
-  IntSet.iter
-    (fun n -> compile_phrase (Cmmgen.send_function n))
-    !send_functions;
-  IntSet.iter
-    (fun n -> List.iter (compile_phrase) (Cmmgen.curry_function n))
-    !curry_functions;
+  let units = List.map (fun (info,_,_) -> info) units_list in
+  List.iter compile_phrase (Cmmgen.generic_functions false units);
   Array.iter
     (fun name -> compile_phrase (Cmmgen.predef_exception name))
     Runtimedef.builtin_exceptions;
   compile_phrase (Cmmgen.global_table name_list);
   compile_phrase
     (Cmmgen.globals_map
-      (List.map
-        (fun (unit,_,_) ->
-          try (unit.ui_name, List.assoc unit.ui_name unit.ui_imports_cmi)
-          with Not_found -> assert false)
-        units_list));
+       (List.map
+          (fun (unit,_,crc) ->
+             try (unit.ui_name, List.assoc unit.ui_name unit.ui_imports_cmi, 
+		  crc,
+		  unit.ui_defines)
+             with Not_found -> assert false)
+          units_list));
   compile_phrase(Cmmgen.data_segment_table ("_startup" :: name_list));
   compile_phrase(Cmmgen.code_segment_table ("_startup" :: name_list));
   compile_phrase
     (Cmmgen.frame_table("_startup" :: "_system" :: name_list));
+
   Emit.end_assembly();
   close_out oc
 
+let make_shared_startup_file ppf units filename =
+  let compile_phrase p = Asmgen.compile_phrase ppf p in
+  let oc = open_out filename in
+  Emitaux.output_channel := oc;
+  Location.input_name := "caml_startup";
+  Compilenv.reset "_shared_startup"; 
+  Emit.begin_assembly();
+  List.iter compile_phrase 
+    (Cmmgen.generic_functions true (List.map fst units));
+  compile_phrase (Cmmgen.plugin_header units);
+  compile_phrase
+    (Cmmgen.global_table 
+       (List.map (fun (ui,_) -> ui.Compilenv.ui_symbol) units));
+  (* this is to force a reference to all units, otherwise the linker
+     might drop some of them (in case of libraries) *)
+
+  Emit.end_assembly();
+  close_out oc
+
+
+let call_linker_shared file_list output_name =
+  let files = Ccomp.quote_files file_list in
+  let cmd = match Config.system with
+    | "mingw" | "win32" | "cygwin" ->
+	Printf.sprintf
+	  "flexlink -merge-manifest -chain %s -o %s %s %s %s %s %s"
+	  (match Config.system with 
+	     | "mingw" -> "mingw"
+	     | "win32" -> "msvc"
+	     | "cygwin" -> "cygwin"
+	     | _ -> assert false)
+	  (Filename.quote output_name)
+	  (String.concat " "
+	     (List.map (fun s -> if s = "" then "" else
+			  "-I " ^ (Filename.quote s)) !load_path))
+	  files
+	  (if !Clflags.verbose then "-v" else "")
+          (Ccomp.make_link_options !Clflags.ccopts) 
+	  (if !Clflags.verbose then "" else ">NUL")
+    | _ ->
+	Printf.sprintf 
+	  "gcc %s %s %s %s -o %s %s"
+	  (match Config.system with
+	     | "macosx" | "rhapsody" -> "-bundle -flat_namespace -undefined suppress -all_load"
+	     | _ -> "-shared")
+          (Clflags.std_include_flag "-I")
+	  (Ccomp.quote_files
+	     (List.map (fun dir -> if dir = "" then "" else "-L" ^ dir)
+		!load_path))
+          (String.concat " " (List.rev !Clflags.ccopts))
+	  (Filename.quote output_name)
+	  files
+  in
+  if Ccomp.command cmd <> 0 then raise(Error Linking_error)
+
+let link_shared ppf objfiles output_name =
+  let units_tolink = List.fold_right scan_file objfiles [] in
+  List.iter
+    (fun (info, file_name, crc) -> check_consistency file_name info crc)
+    units_tolink;
+  Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs;
+  let objfiles = List.rev (List.map object_file_name objfiles) @ 
+    !Clflags.ccobjs in
+
+  let startup =
+    if !Clflags.keep_startup_file
+    then output_name ^ ".startup" ^ ext_asm
+    else Filename.temp_file "camlstartup" ext_asm in
+  make_shared_startup_file ppf 
+    (List.map (fun (ui,_,crc) -> (ui,crc)) units_tolink) startup;
+  let startup_obj = output_name ^ ".startup" ^ ext_obj in
+  if Proc.assemble_file startup startup_obj <> 0
+  then raise(Error(Assembler_error startup));
+  if not !Clflags.keep_startup_file then remove_file startup;
+  call_linker_shared (startup_obj :: objfiles) output_name;
+  remove_file startup_obj
+
 let call_linker file_list startup_file output_name =
-  let libname =
-    if !Clflags.gprofile
-    then "libasmrunp" ^ ext_lib
-    else "libasmrun" ^ ext_lib in
-  let runtime_lib =
-    try
-      if !Clflags.nopervasives then ""
-      else find_in_path !load_path libname
-    with Not_found ->
-      raise(Error(File_not_found libname)) in
   let c_lib =
     if !Clflags.nopervasives then "" else Config.native_c_libraries in
-  match Config.ccomp_type with
-  | "cc" ->
+  match Config.system, Config.ccomp_type with
+  | (("win32"|"mingw"|"cygwin"), _) when not !Clflags.output_c_object ->
+      let cmd =
+        Printf.sprintf 
+	  "flexlink -chain %s -merge-manifest -exe -o %s %s %s %s %s %s %s %s %s"
+	  (match Config.system with
+	     | "win32" -> "msvc"
+	     | "mingw" -> "mingw"
+	     | "cygwin" -> "cygwin"
+	     | _ -> assert false)
+          (Filename.quote output_name)
+	  (String.concat " "
+	     (List.map (fun s -> if s = "" then "" else
+			  "-I " ^ (Filename.quote s)) !load_path))
+          (Filename.quote startup_file)
+          (Ccomp.quote_files (List.rev file_list))
+          (Ccomp.quote_files (List.rev !Clflags.ccobjs))
+          (Filename.quote (runtime_lib ()))
+          c_lib
+	  (if !Clflags.verbose then " -v" else "")
+          (Ccomp.make_link_options !Clflags.ccopts) 
+	in
+	let res = Ccomp.command cmd in
+	if res <> 0 then raise(Error Linking_error)
+  | _,"cc" ->
       let cmd =
         if not !Clflags.output_c_object then
           Printf.sprintf "%s %s -o %s %s %s %s %s %s %s %s %s"
@@ -251,7 +350,7 @@ let call_linker file_list startup_file output_name =
               (List.map (fun dir -> if dir = "" then "" else "-L" ^ dir)
                         !load_path))
             (Ccomp.quote_files (List.rev !Clflags.ccobjs))
-            (Filename.quote runtime_lib)
+            (Filename.quote (runtime_lib ()))
             c_lib
         else
           Printf.sprintf "%s -o %s %s %s"
@@ -260,46 +359,16 @@ let call_linker file_list startup_file output_name =
             (Filename.quote startup_file)
             (Ccomp.quote_files (List.rev file_list))
       in if Ccomp.command cmd <> 0 then raise(Error Linking_error)
-  | "msvc" ->
-      if not !Clflags.output_c_object then begin
-        let cmd =
-          Printf.sprintf "%s /Fe%s %s %s %s %s %s %s %s"
-            !Clflags.c_linker
-            (Filename.quote output_name)
-            (Clflags.std_include_flag "-I")
-            (Filename.quote startup_file)
-            (Ccomp.quote_files (List.rev file_list))
-            (Ccomp.quote_files 
-              (List.rev_map Ccomp.expand_libname !Clflags.ccobjs))
-            (Filename.quote runtime_lib)
-            c_lib
-            (Ccomp.make_link_options !Clflags.ccopts) in
-        if Ccomp.command cmd <> 0 then raise(Error Linking_error);
-        if Ccomp.merge_manifest output_name <> 0 then raise(Error Linking_error)
-      end else begin
-        let cmd =
-          Printf.sprintf "%s /out:%s %s %s"
-            Config.native_partial_linker
-            (Filename.quote output_name)
-            (Filename.quote startup_file)
-            (Ccomp.quote_files (List.rev file_list))
-        in if Ccomp.command cmd <> 0 then raise(Error Linking_error)
-      end
+  | (("win32"|"mingw"|"cygwin"), _) when !Clflags.output_c_object ->
+      let cmd =
+        Printf.sprintf "%s /out:%s %s %s"
+          Config.native_partial_linker
+          (Filename.quote output_name)
+          (Filename.quote startup_file)
+          (Ccomp.quote_files (List.rev file_list))
+      in if Ccomp.command cmd <> 0 then raise(Error Linking_error)
   | _ -> assert false
 
-let object_file_name name =
-  let file_name =
-    try
-      find_in_path !load_path name
-    with Not_found ->
-      fatal_error "Asmlink.object_file_name: not found" in
-  if Filename.check_suffix file_name ".cmx" then
-    Filename.chop_suffix file_name ".cmx" ^ ext_obj
-  else if Filename.check_suffix file_name ".cmxa" then
-    Filename.chop_suffix file_name ".cmxa" ^ ext_lib
-  else
-    fatal_error "Asmlink.object_file_name: bad ext"
-
 (* Main entry point *)
 
 let link ppf objfiles output_name =
@@ -322,7 +391,9 @@ let link ppf objfiles output_name =
     units_tolink;
   Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs;
   Clflags.ccopts := !lib_ccopts @ !Clflags.ccopts; (* put user's opts first *)
-  let startup = Filename.temp_file "camlstartup" ext_asm in
+  let startup = 
+    if !Clflags.keep_startup_file then output_name ^ ".startup" ^ ext_asm
+    else Filename.temp_file "camlstartup" ext_asm in
   make_startup_file ppf startup units_tolink;
   let startup_obj = Filename.temp_file "camlstartup" ext_obj in
   if Proc.assemble_file startup startup_obj <> 0 then
diff --git a/asmcomp/asmlink.mli b/asmcomp/asmlink.mli
index 28c5287daf..2070c815d8 100644
--- a/asmcomp/asmlink.mli
+++ b/asmcomp/asmlink.mli
@@ -12,12 +12,16 @@
 
 (* $Id$ *)
 
-(* Link a set of .cmx/.o files and produce an executable *)
+(* Link a set of .cmx/.o files and produce an executable or a plugin *)
 
 open Format
 
 val link: formatter -> string list -> string -> unit
 
+val link_shared: formatter -> string list -> string -> unit
+
+val call_linker_shared: string list -> string -> unit
+
 val check_consistency: string -> Compilenv.unit_infos -> Digest.t -> unit
 val extract_crc_interfaces: unit -> (string * Digest.t) list
 val extract_crc_implementations: unit -> (string * Digest.t) list
diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml
index 4469e77e6a..aabb876e4d 100644
--- a/asmcomp/asmpackager.ml
+++ b/asmcomp/asmpackager.ml
@@ -80,10 +80,14 @@ let check_units members =
 (* Make the .o file for the package *)
 
 let make_package_object ppf members targetobj targetname coercion =
-  (* Put the full name of the module in the temporary file name
-     to avoid collisions with MSVC's link /lib in case of successive packs *)
   let objtemp =
-    Filename.temp_file (Compilenv.make_symbol (Some "")) Config.ext_obj in
+    if !Clflags.keep_asm_file
+    then chop_extension_if_any targetobj ^ ".pack" ^ Config.ext_obj
+    else 
+      (* Put the full name of the module in the temporary file name
+	 to avoid collisions with MSVC's link /lib in case of successive 
+	 packs *)
+      Filename.temp_file (Compilenv.make_symbol (Some "")) Config.ext_obj in
   let components =
     List.map
       (fun m ->
@@ -146,7 +150,7 @@ let build_package_cmx members cmxfile =
       ui_send_fun =
           union(List.map (fun info -> info.ui_send_fun) units);
       ui_force_link =
-          List.exists (fun info -> info.ui_force_link) units
+          List.exists (fun info -> info.ui_force_link) units;
     } in
   Compilenv.write_unit_info pkg_infos cmxfile
 
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 9f5e4f29b6..a51f0a28ad 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -1927,6 +1927,36 @@ let curry_function arity =
   then intermediate_curry_functions arity 0
   else [tuplify_function (-arity)]
 
+
+module IntSet = Set.Make(
+  struct
+    type t = int
+    let compare = compare
+  end)
+
+let default_apply = IntSet.add 2 (IntSet.add 3 IntSet.empty)
+  (* These apply funs are always present in the main program.
+     TODO: add more, and do the same for send and curry funs
+     (maybe up to 10-15?). *)
+
+let generic_functions shared units =
+  let (apply,send,curry) =
+    List.fold_left
+      (fun (apply,send,curry) ui ->
+	 List.fold_right IntSet.add ui.Compilenv.ui_apply_fun apply,
+	 List.fold_right IntSet.add ui.Compilenv.ui_send_fun send,
+	 List.fold_right IntSet.add ui.Compilenv.ui_curry_fun curry)
+      (IntSet.empty,IntSet.empty,IntSet.empty)
+      units
+  in
+  let apply =
+    if shared then IntSet.diff apply default_apply
+    else IntSet.union apply default_apply
+  in
+  let accu = IntSet.fold (fun n accu -> apply_function n :: accu) apply [] in
+  let accu = IntSet.fold (fun n accu -> send_function n :: accu) send accu in
+  IntSet.fold (fun n accu -> curry_function n @ accu) curry accu
+
 (* Generate the entry point *)
 
 let entry_point namelist =
@@ -1961,10 +1991,12 @@ let global_table namelist =
         List.map mksym namelist @
         [cint_zero])
 
-let globals_map namelist =
-  Cdata(Cglobal_symbol "caml_globals_map" ::
-        emit_constant "caml_globals_map"
-          (Const_base (Const_string (Marshal.to_string namelist []))) [])
+let global_data name v =
+  Cdata(Cglobal_symbol name ::
+          emit_constant name
+          (Const_base (Const_string (Marshal.to_string v []))) [])
+
+let globals_map v = global_data "caml_globals_map" v
 
 (* Generate the master table of frame descriptors *)
 
@@ -2006,3 +2038,33 @@ let predef_exception name =
           Cint(block_header 0 1);
           Cdefine_symbol bucketname;
           Csymbol_address symname ])
+
+(* Header for a plugin *)
+
+let mapflat f l = List.flatten (List.map f l)
+
+type dynunit = {
+  name: string;
+  crc: Digest.t;
+  imports_cmi: (string * Digest.t) list;
+  imports_cmx: (string * Digest.t) list;
+  defines: string list;
+}
+
+type dynheader = {
+  magic: string;
+  units: dynunit list;
+}
+
+let dyn_magic_number = "Caml2007D001"
+
+let plugin_header units =
+  let mk (ui,crc) =
+    { name = ui.Compilenv.ui_name;
+      crc = crc;
+      imports_cmi = ui.Compilenv.ui_imports_cmi;
+      imports_cmx = ui.Compilenv.ui_imports_cmx;
+      defines = ui.Compilenv.ui_defines 
+    } in
+  global_data "caml_plugin_header"
+    { magic = dyn_magic_number; units = List.map mk units }
diff --git a/asmcomp/cmmgen.mli b/asmcomp/cmmgen.mli
index fa4dba277a..f73d6fcb32 100644
--- a/asmcomp/cmmgen.mli
+++ b/asmcomp/cmmgen.mli
@@ -19,10 +19,13 @@ val compunit: int -> Clambda.ulambda -> Cmm.phrase list
 val apply_function: int -> Cmm.phrase
 val send_function: int -> Cmm.phrase
 val curry_function: int -> Cmm.phrase list
+val generic_functions: bool -> Compilenv.unit_infos list -> Cmm.phrase list
 val entry_point: string list -> Cmm.phrase
 val global_table: string list -> Cmm.phrase
-val globals_map: (string * string) list -> Cmm.phrase
+val globals_map: (string * Digest.t * Digest.t * string list) 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
+val plugin_header: (Compilenv.unit_infos * Digest.t) list -> Cmm.phrase
diff --git a/asmcomp/compilenv.ml b/asmcomp/compilenv.ml
index 9f4288821c..e0f999c208 100644
--- a/asmcomp/compilenv.ml
+++ b/asmcomp/compilenv.ml
@@ -126,6 +126,17 @@ let read_unit_info filename =
     close_in ic;
     raise(Error(Corrupted_unit_info(filename)))
 
+let read_library_info filename =
+  let ic = open_in_bin filename in
+  let buffer = String.create (String.length cmxa_magic_number) in
+  really_input ic buffer 0 (String.length cmxa_magic_number);
+  if buffer <> cmxa_magic_number then
+    raise(Error(Not_a_unit_info filename));
+  let infos = (input_value ic : library_infos) in
+  close_in ic;
+  infos
+
+
 (* Read and cache info on global identifiers *)
 
 let cmx_not_found_crc =
@@ -160,10 +171,18 @@ let cache_unit_info ui =
 
 (* Return the approximation of a global identifier *)
 
+let toplevel_approx = Hashtbl.create 16
+
+let record_global_approx_toplevel id =
+  Hashtbl.add toplevel_approx current_unit.ui_name current_unit.ui_approx
+
 let global_approx id =
-  match get_global_info id with
-  | None -> Value_unknown
-  | Some ui -> ui.ui_approx
+  if Ident.is_predef_exn id then Value_unknown
+  else try Hashtbl.find toplevel_approx (Ident.name id)
+  with Not_found -> 
+    match get_global_info id with
+      | None -> Value_unknown
+      | Some ui -> ui.ui_approx
 
 (* Return the symbol used to refer to a global identifier *)
 
diff --git a/asmcomp/compilenv.mli b/asmcomp/compilenv.mli
index 3b547872a1..762123b012 100644
--- a/asmcomp/compilenv.mli
+++ b/asmcomp/compilenv.mli
@@ -70,6 +70,9 @@ val global_approx: Ident.t -> Clambda.value_approximation
         (* Return the approximation for the given global identifier *)
 val set_global_approx: Clambda.value_approximation -> unit
         (* Record the approximation of the unit being compiled *)
+val record_global_approx_toplevel: unit -> unit
+        (* Record the current approximation for the current toplevel phrase *)
+
 
 val need_curry_fun: int -> unit
 val need_apply_fun: int -> unit
@@ -77,6 +80,7 @@ val need_send_fun: int -> unit
         (* Record the need of a currying (resp. application,
            message sending) function with the given arity *)
 
+
 val read_unit_info: string -> unit_infos * Digest.t
         (* Read infos and CRC from a [.cmx] file. *)
 val write_unit_info: unit_infos -> string -> unit
@@ -92,6 +96,8 @@ val cmx_not_found_crc: Digest.t
         (* Special digest used in the [ui_imports_cmx] list to signal
            that no [.cmx] file was found and used for the imported unit *)
 
+val read_library_info: string -> library_infos
+
 type error =
     Not_a_unit_info of string
   | Corrupted_unit_info of string
@@ -100,3 +106,5 @@ type error =
 exception Error of error
 
 val report_error: Format.formatter -> error -> unit
+
+
diff --git a/asmcomp/i386/proc_nt.ml b/asmcomp/i386/proc_nt.ml
index 2c460f78bd..fa9d605906 100644
--- a/asmcomp/i386/proc_nt.ml
+++ b/asmcomp/i386/proc_nt.ml
@@ -171,4 +171,5 @@ let contains_calls = ref false
 
 let assemble_file infile outfile =
   Ccomp.command (Config.asm ^
-                 Filename.quote outfile ^ " " ^ Filename.quote infile ^ ">NUL")
+                 Filename.quote outfile ^ " " ^ Filename.quote infile ^
+		 (if !Clflags.verbose then "" else ">NUL"))
diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp
index 81a1894e5d..f36d44129e 100644
--- a/asmcomp/power/emit.mlp
+++ b/asmcomp/power/emit.mlp
@@ -81,15 +81,17 @@ let data_space =
   | "rhapsody"    -> "	.data\n"
   | _ -> assert false
 
-let code_space =
+let code_space () =
   match Config.system with
   | "elf" | "bsd" -> "	.section \".text\"\n"
-  | "rhapsody"    -> "	.text\n"
+  | "rhapsody" when !Clflags.dlcode -> "	.section __TEXT,__selfmod,regular,self_modifying_code\n"
+  | "rhapsody"    -> "	.text\n" 
   | _ -> assert false
 
-let rodata_space =
+let rodata_space () =
   match Config.system with
   | "elf" | "bsd" -> "	.section \".rodata\"\n"
+  | "rhapsody" when !Clflags.dlcode -> "	.data\n"
   | "rhapsody"    -> "	.const\n"
   | _ -> assert false
 
@@ -251,6 +253,37 @@ let emit_external s =
   `	.indirect_symbol {emit_symbol s}\n`;
   `	{emit_string datag}	0\n`
 
+
+let external_stubs = ref StringSet.empty
+let external_non_lazy = ref StringSet.empty
+
+let emit_stub s =
+  let lbl = new_label() in
+  `	.section __TEXT,__picsymbolstub1,symbol_stubs,pure_instructions,32\n`;
+  `	.align 5\n`;
+  `L{emit_symbol s}$stub:\n`;
+  `	.indirect_symbol {emit_symbol s}\n`;
+  `	mflr r0\n`;
+  `	bcl 20,31,{emit_label lbl}\n`;
+  `{emit_label lbl}:\n`;
+  `	mflr r11\n`;
+  `	addis r11,r11,ha16(L{emit_symbol s}$lazy_ptr-{emit_label lbl})\n`;
+  `	mtlr r0\n`;
+  `	lwzu r12,lo16(L{emit_symbol s}$lazy_ptr-{emit_label lbl})(r11)\n`;
+  `	mtctr r12\n`;
+  `	bctr\n`;
+  `	.lazy_symbol_pointer\n`;
+  `L{emit_symbol s}$lazy_ptr:\n`;
+  `	.indirect_symbol {emit_symbol s}\n`;
+  `	.long	dyld_stub_binding_helper\n`
+
+let emit_non_lazy s =
+  `	.non_lazy_symbol_pointer\n`;
+  `L{emit_symbol s}$non_lazy_ptr:\n`;
+  `	.indirect_symbol {emit_symbol s}\n`;
+  `	{emit_string datag}	0\n`
+
+
 (* Names for conditional branches after comparisons *)
 
 let branch_for_comparison = function
@@ -478,14 +511,28 @@ let rec emit_instr i dslot =
         `	addis	{emit_gpr 11}, 0, {emit_upper emit_label lbl}\n`;
         `	lfd	{emit_reg i.res.(0)}, {emit_lower emit_label lbl}({emit_gpr 11})\n`
     | Lop(Iconst_symbol s) ->
-        `	addis	{emit_reg i.res.(0)}, 0, {emit_upper emit_symbol s}\n`;
-        `	addi	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_lower emit_symbol s}\n`
+	if !Clflags.dlcode then begin
+	  let lbl = new_label () in
+	  external_non_lazy := StringSet.add s !external_non_lazy;
+	  `	bcl 20,31,{emit_label lbl}\n`;
+	  `{emit_label lbl}:\n`;
+	  `	mflr {emit_reg i.res.(0)}\n`;
+          `	addis	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, ha16(L{emit_symbol s}$non_lazy_ptr-{emit_label lbl})\n`;
+          `	addi	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, lo16(L{emit_symbol s}$non_lazy_ptr-{emit_label lbl})\n`
+	end else begin
+          `	addis	{emit_reg i.res.(0)}, 0, {emit_upper emit_symbol s}\n`;
+          `	addi	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_lower emit_symbol s}\n`
+	end
     | Lop(Icall_ind) ->
         `	mtctr	{emit_reg i.arg.(0)}\n`;
         `	bctrl\n`;
         record_frame i.live i.dbg
     | Lop(Icall_imm s) ->
-        `	bl	{emit_symbol s}\n`;
+	if !Clflags.dlcode then begin
+          external_stubs := StringSet.add s !external_stubs;
+          `	bl	L{emit_symbol s}$stub\n`;
+	end else	
+          `	bl	{emit_symbol s}\n`;
         record_frame i.live i.dbg
     | Lop(Itailcall_ind) ->
         let n = frame_size() in
@@ -524,7 +571,12 @@ let rec emit_instr i dslot =
             `	addis	{emit_gpr 11}, 0, {emit_upper emit_symbol s}\n`;
             `	addi	{emit_gpr 11}, {emit_gpr 11}, {emit_lower emit_symbol s}\n`
           end;
-          `	bl	{emit_symbol "caml_c_call"}\n`;
+	  if !Clflags.dlcode then begin
+	    (* WRONG: stub will destroy r11 *)
+	    external_stubs := StringSet.add "caml_c_call" !external_stubs;
+	    `	bl	L{emit_symbol "caml_c_call"}$stub\n`;
+	  end else
+            `	bl	{emit_symbol "caml_c_call"}\n`;
           record_frame i.live i.dbg
         end else begin
           if pic_externals then begin
@@ -748,12 +800,12 @@ let rec emit_instr i dslot =
         `	add	{emit_gpr 0}, {emit_gpr 11}, {emit_gpr 0}\n`;
         `	mtctr	{emit_gpr 0}\n`;
         `	bctr\n`;
-        emit_string rodata_space;
+        emit_string (rodata_space ());
         `{emit_label lbl}:`;
         for i = 0 to Array.length jumptbl - 1 do
           `	.long	{emit_label jumptbl.(i)} - {emit_label lbl}\n`
         done;
-        emit_string code_space
+        emit_string (code_space ())
     | Lsetuptrap lbl ->
         `	bl	{emit_label lbl}\n`
     | Lpushtrap ->
@@ -841,7 +893,7 @@ let fundecl fundecl =
       `	.type	{emit_symbol fundecl.fun_name}, @function\n`
   | _ -> ()
   end;
-  emit_string code_space;
+  emit_string (code_space ());
   `	.align	2\n`;
   `{emit_symbol fundecl.fun_name}:\n`;
   let n = frame_size() in
@@ -859,11 +911,16 @@ let fundecl fundecl =
   (* Emit the glue code to call the GC *)
   if !call_gc_label > 0 then begin
     `{emit_label !call_gc_label}:\n`;
-    `	b	{emit_symbol "caml_call_gc"}\n`
+(*    if !Clflags.dlcode then begin
+      (* WRONG: stub will destroy r11 *)
+      external_stubs := StringSet.add "caml_call_gc" !external_stubs;
+      `	b	L{emit_symbol "caml_call_gc"}$stub\n`;
+    end else *)
+      `	b	{emit_symbol "caml_call_gc"}\n`
   end;
   (* Emit the numeric literals *)
   if !float_literals <> [] || !int_literals <> [] then begin
-    emit_string rodata_space;
+    emit_string (rodata_space ());
     `	.align	3\n`;
     List.iter
       (fun (f, lbl) ->
@@ -921,13 +978,15 @@ let data l =
 let begin_assembly() =
   defined_functions := StringSet.empty;
   external_functions := StringSet.empty;
+  external_stubs := StringSet.empty;
+  external_non_lazy := StringSet.empty;
   (* Emit the beginning of the segments *)
   let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
   emit_string data_space;
   declare_global_data lbl_begin;
   `{emit_symbol lbl_begin}:\n`;
   let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
-  emit_string code_space;
+  emit_string (code_space ());
   declare_global_data lbl_begin;
   `{emit_symbol lbl_begin}:\n`
 
@@ -935,8 +994,10 @@ let end_assembly() =
   if pic_externals then
     (* Emit the pointers to external functions *)
     StringSet.iter emit_external !external_functions;
+  StringSet.iter emit_stub !external_stubs;
+  StringSet.iter emit_non_lazy !external_non_lazy;
   (* Emit the end of the segments *)
-  emit_string code_space;
+  emit_string (code_space ());
   let lbl_end = Compilenv.make_symbol (Some "code_end") in
   declare_global_data lbl_end;
   `{emit_symbol lbl_end}:\n`;
@@ -947,7 +1008,7 @@ let end_assembly() =
   `{emit_symbol lbl_end}:\n`;
   `	{emit_string datag}	0\n`;
   (* Emit the frame descriptors *)
-  emit_string rodata_space;
+  emit_string (rodata_space ());
   let lbl = Compilenv.make_symbol (Some "frametable") in
   declare_global_data lbl;
   `{emit_symbol lbl}:\n`;
diff --git a/asmcomp/power/selection.ml b/asmcomp/power/selection.ml
index f3880b0da6..1b2b3b5332 100644
--- a/asmcomp/power/selection.ml
+++ b/asmcomp/power/selection.ml
@@ -28,7 +28,7 @@ type addressing_expr =
   | Aadd of expression * expression
 
 let rec select_addr = function
-    Cconst_symbol s ->
+    Cconst_symbol s when not !Clflags.dlcode ->
       (Asymbol s, 0)
   | Cop((Caddi | Cadda), [arg; Cconst_int m]) ->
       let (a, n) = select_addr arg in (a, n + m)