Factorize the sequencing of operations for setting up the assembly output, calling the assembler, closing/removing the assembly output.

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

asmcomp/amd64/emit.mlp

@@ -1040,7 +1040,6 @@ let end_assembly() =
   _end ();
 
   let oc = !Emitaux.output_channel in
-
   let bprint_instr =
     if Intel_proc.masm then Intel_masm.bprint_instr
     else Intel_gas.bprint_instr

asmcomp/asmgen.ml

@@ -99,43 +99,53 @@ let compile_genfuns ppf f =
        | _ -> ())
     (Cmmgen.generic_functions true [Compilenv.current_unit_infos ()])
 
+let compile_unit asm_filename keep_asm obj_filename gen =
+  try
+    Emitaux.output_channel := open_out asm_filename;
+    begin try
+      gen ();
+      close_out !Emitaux.output_channel;
+    with exn ->
+      close_out !Emitaux.output_channel;
+      if not keep_asm then remove_file asm_filename;
+      raise exn
+    end;
+    if Proc.assemble_file asm_filename obj_filename <> 0
+    then raise(Error(Assembler_error asm_filename));
+    if not keep_asm then remove_file asm_filename
+  with exn ->
+    remove_file obj_filename;
+    raise exn
+
+let gen_implementation ?toplevel ppf (size, lam) =
+  Emit.begin_assembly ();
+  Closure.intro size lam
+  ++ clambda_dump_if ppf
+  ++ Cmmgen.compunit size
+  ++ List.iter (compile_phrase ppf) ++ (fun () -> ());
+  (match toplevel with None -> () | Some f -> compile_genfuns ppf f);
+
+  (* We add explicit references to external primitive symbols.  This
+     is to ensure that the object files that define these symbols,
+     when part of a C library, won't be discarded by the linker.
+     This is important if a module that uses such a symbol is later
+     dynlinked. *)
+
+  compile_phrase ppf
+    (Cmmgen.reference_symbols
+       (List.filter (fun s -> s <> "" && s.[0] <> '%')
+          (List.map Primitive.native_name !Translmod.primitive_declarations))
+    );
+  Emit.end_assembly ()
+
 let compile_implementation ?toplevel prefixname ppf (size, lam) =
   let asmfile =
     if !keep_asm_file
     then prefixname ^ ext_asm
-    else Filename.temp_file "camlasm" ext_asm in
-  let oc = open_out asmfile in
-  begin try
-    Emitaux.output_channel := oc;
-    Emit.begin_assembly();
-    Closure.intro size lam
-    ++ clambda_dump_if ppf
-    ++ Cmmgen.compunit size
-    ++ List.iter (compile_phrase ppf) ++ (fun () -> ());
-    (match toplevel with None -> () | Some f -> compile_genfuns ppf f);
-
-    (* We add explicit references to external primitive symbols.  This
-       is to ensure that the object files that define these symbols,
-       when part of a C library, won't be discarded by the linker.
-       This is important if a module that uses such a symbol is later
-       dynlinked. *)
-
-    compile_phrase ppf
-      (Cmmgen.reference_symbols
-         (List.filter (fun s -> s <> "" && s.[0] <> '%')
-            (List.map Primitive.native_name !Translmod.primitive_declarations))
-      );
-
-    Emit.end_assembly();
-    close_out oc
-  with x ->
-    close_out oc;
-    if !keep_asm_file then () else remove_file asmfile;
-    raise x
-  end;
-  if Proc.assemble_file asmfile (prefixname ^ ext_obj) <> 0
-  then raise(Error(Assembler_error asmfile));
-  if !keep_asm_file then () else remove_file asmfile
+    else Filename.temp_file "camlasm" ext_asm
+  in
+  compile_unit asmfile !keep_asm_file (prefixname ^ ext_obj)
+    (fun () -> gen_implementation ?toplevel ppf (size, lam))
 
 (* Error report *)
 

asmcomp/asmgen.mli

@@ -21,3 +21,8 @@ val compile_phrase :
 type error = Assembler_error of string
 exception Error of error
 val report_error: Format.formatter -> error -> unit
+
+
+val compile_unit:
+  string(*asm file*) -> bool(*keep asm*) ->
+  string(*obj file*) -> (unit -> unit) -> unit

asmcomp/asmlink.ml

@@ -197,13 +197,11 @@ let scan_file obj_name tolink = match read_file obj_name with
 
 (* Second pass: generate the startup file and link it with everything else *)
 
-let make_startup_file ppf filename units_list =
+let make_startup_file ppf units_list =
   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"; (* set name of "current" input *)
   Compilenv.reset "_startup"; (* set the name of the "current" compunit *)
-  Emit.begin_assembly();
+  Emit.begin_assembly ();
   let name_list =
     List.flatten (List.map (fun (info,_,_) -> info.ui_defines) units_list) in
   compile_phrase (Cmmgen.entry_point name_list);
@@ -230,17 +228,13 @@ let make_startup_file ppf filename units_list =
   compile_phrase(Cmmgen.code_segment_table ("_startup" :: name_list));
   compile_phrase
     (Cmmgen.frame_table("_startup" :: "_system" :: name_list));
+  Emit.end_assembly ()
 
-  Emit.end_assembly();
-  close_out oc
-
-let make_shared_startup_file ppf units filename =
+let make_shared_startup_file ppf units =
+  Emit.begin_assembly ();
   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);
@@ -249,10 +243,7 @@ let make_shared_startup_file ppf units filename =
        (List.map (fun (ui,_) -> ui.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
-
+  Emit.end_assembly ()
 
 let call_linker_shared file_list output_name =
   if not (Ccomp.call_linker Ccomp.Dll output_name file_list "")
@@ -272,12 +263,13 @@ let link_shared ppf objfiles output_name =
     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;
+  Asmgen.compile_unit
+    startup !Clflags.keep_startup_file startup_obj
+    (fun () ->
+       make_shared_startup_file ppf
+         (List.map (fun (ui,_,crc) -> (ui,crc)) units_tolink)
+    );
   call_linker_shared (startup_obj :: objfiles) output_name;
   remove_file startup_obj
 
@@ -327,17 +319,12 @@ let link ppf objfiles output_name =
   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
-    raise(Error(Assembler_error startup));
-  try
-    call_linker (List.map object_file_name objfiles) startup_obj output_name;
-    if not !Clflags.keep_startup_file then remove_file startup;
-    remove_file startup_obj
-  with x ->
-    remove_file startup_obj;
-    raise x
+  Asmgen.compile_unit
+    startup !Clflags.keep_startup_file startup_obj
+    (fun () -> make_startup_file ppf units_tolink);
+  call_linker (List.map object_file_name objfiles) startup_obj output_name;
+  remove_file startup_obj
 
 (* Error report *)