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-0dff7051ff02master
parent
ac226bf931
commit
0652dda14d
|
@ -1040,7 +1040,6 @@ let end_assembly() =
|
||||||
_end ();
|
_end ();
|
||||||
|
|
||||||
let oc = !Emitaux.output_channel in
|
let oc = !Emitaux.output_channel in
|
||||||
|
|
||||||
let bprint_instr =
|
let bprint_instr =
|
||||||
if Intel_proc.masm then Intel_masm.bprint_instr
|
if Intel_proc.masm then Intel_masm.bprint_instr
|
||||||
else Intel_gas.bprint_instr
|
else Intel_gas.bprint_instr
|
||||||
|
|
|
@ -99,43 +99,53 @@ let compile_genfuns ppf f =
|
||||||
| _ -> ())
|
| _ -> ())
|
||||||
(Cmmgen.generic_functions true [Compilenv.current_unit_infos ()])
|
(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 compile_implementation ?toplevel prefixname ppf (size, lam) =
|
||||||
let asmfile =
|
let asmfile =
|
||||||
if !keep_asm_file
|
if !keep_asm_file
|
||||||
then prefixname ^ ext_asm
|
then prefixname ^ ext_asm
|
||||||
else Filename.temp_file "camlasm" ext_asm in
|
else Filename.temp_file "camlasm" ext_asm
|
||||||
let oc = open_out asmfile in
|
in
|
||||||
begin try
|
compile_unit asmfile !keep_asm_file (prefixname ^ ext_obj)
|
||||||
Emitaux.output_channel := oc;
|
(fun () -> 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();
|
|
||||||
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
|
|
||||||
|
|
||||||
(* Error report *)
|
(* Error report *)
|
||||||
|
|
||||||
|
|
|
@ -21,3 +21,8 @@ val compile_phrase :
|
||||||
type error = Assembler_error of string
|
type error = Assembler_error of string
|
||||||
exception Error of error
|
exception Error of error
|
||||||
val report_error: Format.formatter -> error -> unit
|
val report_error: Format.formatter -> error -> unit
|
||||||
|
|
||||||
|
|
||||||
|
val compile_unit:
|
||||||
|
string(*asm file*) -> bool(*keep asm*) ->
|
||||||
|
string(*obj file*) -> (unit -> unit) -> unit
|
||||||
|
|
|
@ -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 *)
|
(* 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 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 *)
|
Location.input_name := "caml_startup"; (* set name of "current" input *)
|
||||||
Compilenv.reset "_startup"; (* set the name of the "current" compunit *)
|
Compilenv.reset "_startup"; (* set the name of the "current" compunit *)
|
||||||
Emit.begin_assembly();
|
Emit.begin_assembly ();
|
||||||
let name_list =
|
let name_list =
|
||||||
List.flatten (List.map (fun (info,_,_) -> info.ui_defines) units_list) in
|
List.flatten (List.map (fun (info,_,_) -> info.ui_defines) units_list) in
|
||||||
compile_phrase (Cmmgen.entry_point name_list);
|
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.code_segment_table ("_startup" :: name_list));
|
||||||
compile_phrase
|
compile_phrase
|
||||||
(Cmmgen.frame_table("_startup" :: "_system" :: name_list));
|
(Cmmgen.frame_table("_startup" :: "_system" :: name_list));
|
||||||
|
Emit.end_assembly ()
|
||||||
|
|
||||||
Emit.end_assembly();
|
let make_shared_startup_file ppf units =
|
||||||
close_out oc
|
Emit.begin_assembly ();
|
||||||
|
|
||||||
let make_shared_startup_file ppf units filename =
|
|
||||||
let compile_phrase p = Asmgen.compile_phrase ppf p in
|
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";
|
Location.input_name := "caml_startup";
|
||||||
Compilenv.reset "_shared_startup";
|
Compilenv.reset "_shared_startup";
|
||||||
Emit.begin_assembly();
|
|
||||||
List.iter compile_phrase
|
List.iter compile_phrase
|
||||||
(Cmmgen.generic_functions true (List.map fst units));
|
(Cmmgen.generic_functions true (List.map fst units));
|
||||||
compile_phrase (Cmmgen.plugin_header 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));
|
(List.map (fun (ui,_) -> ui.ui_symbol) units));
|
||||||
(* this is to force a reference to all units, otherwise the linker
|
(* this is to force a reference to all units, otherwise the linker
|
||||||
might drop some of them (in case of libraries) *)
|
might drop some of them (in case of libraries) *)
|
||||||
|
Emit.end_assembly ()
|
||||||
Emit.end_assembly();
|
|
||||||
close_out oc
|
|
||||||
|
|
||||||
|
|
||||||
let call_linker_shared file_list output_name =
|
let call_linker_shared file_list output_name =
|
||||||
if not (Ccomp.call_linker Ccomp.Dll output_name file_list "")
|
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
|
if !Clflags.keep_startup_file
|
||||||
then output_name ^ ".startup" ^ ext_asm
|
then output_name ^ ".startup" ^ ext_asm
|
||||||
else Filename.temp_file "camlstartup" ext_asm in
|
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
|
let startup_obj = output_name ^ ".startup" ^ ext_obj in
|
||||||
if Proc.assemble_file startup startup_obj <> 0
|
Asmgen.compile_unit
|
||||||
then raise(Error(Assembler_error startup));
|
startup !Clflags.keep_startup_file startup_obj
|
||||||
if not !Clflags.keep_startup_file then remove_file startup;
|
(fun () ->
|
||||||
|
make_shared_startup_file ppf
|
||||||
|
(List.map (fun (ui,_,crc) -> (ui,crc)) units_tolink)
|
||||||
|
);
|
||||||
call_linker_shared (startup_obj :: objfiles) output_name;
|
call_linker_shared (startup_obj :: objfiles) output_name;
|
||||||
remove_file startup_obj
|
remove_file startup_obj
|
||||||
|
|
||||||
|
@ -327,17 +319,12 @@ let link ppf objfiles output_name =
|
||||||
let startup =
|
let startup =
|
||||||
if !Clflags.keep_startup_file then output_name ^ ".startup" ^ ext_asm
|
if !Clflags.keep_startup_file then output_name ^ ".startup" ^ ext_asm
|
||||||
else Filename.temp_file "camlstartup" ext_asm in
|
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
|
let startup_obj = Filename.temp_file "camlstartup" ext_obj in
|
||||||
if Proc.assemble_file startup startup_obj <> 0 then
|
Asmgen.compile_unit
|
||||||
raise(Error(Assembler_error startup));
|
startup !Clflags.keep_startup_file startup_obj
|
||||||
try
|
(fun () -> make_startup_file ppf units_tolink);
|
||||||
call_linker (List.map object_file_name objfiles) startup_obj output_name;
|
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
|
||||||
remove_file startup_obj
|
|
||||||
with x ->
|
|
||||||
remove_file startup_obj;
|
|
||||||
raise x
|
|
||||||
|
|
||||||
(* Error report *)
|
(* Error report *)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue