Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Move some code from Asmgen to the middle end directory etc. (#2288) 

Followup to (#2281)
master
Mark Shinwell 2019-05-10 15:11:22 +02:00 committed by Pierre Chambart
parent 12cfc54013
commit 6cbdfad125
25 changed files with 422 additions and 281 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
.depend
View File

@ -1916,9 +1916,7 @@ asmcomp/arch.cmx : \
utils/config.cmx \
utils/clflags.cmx
asmcomp/asmgen.cmo : \
middle_end/flambda/un_anf.cmi \
lambda/translmod.cmi \
middle_end/symbol.cmi \
asmcomp/split.cmi \
asmcomp/spill.cmi \
asmcomp/selection.cmi \
@ -1930,22 +1928,17 @@ asmcomp/asmgen.cmo : \
asmcomp/printmach.cmi \
asmcomp/printlinear.cmi \
asmcomp/printcmm.cmi \
middle_end/printclambda.cmi \
typing/primitive.cmi \
typing/path.cmi \
utils/misc.cmi \
asmcomp/mach.cmi \
parsing/location.cmi \
asmcomp/liveness.cmi \
asmcomp/linscan.cmi \
middle_end/linkage_name.cmi \
asmcomp/linearize.cmi \
lambda/lambda.cmi \
asmcomp/interval.cmi \
asmcomp/interf.cmi \
typing/ident.cmi \
middle_end/flambda/flambda_to_clambda.cmi \
middle_end/flambda/flambda.cmi \
asmcomp/emitaux.cmi \
asmcomp/emit.cmi \
asmcomp/deadcode.cmi \
@ -1955,17 +1948,14 @@ asmcomp/asmgen.cmo : \
asmcomp/coloring.cmi \
asmcomp/cmmgen.cmi \
asmcomp/cmm.cmi \
middle_end/closure/closure.cmi \
utils/clflags.cmi \
middle_end/clambda.cmi \
asmcomp/CSE.cmo \
middle_end/flambda/build_export_info.cmi \
middle_end/backend_intf.cmi \
asmcomp/debug/available_regs.cmi \
asmcomp/asmgen.cmi
asmcomp/asmgen.cmx : \
middle_end/flambda/un_anf.cmx \
lambda/translmod.cmx \
middle_end/symbol.cmx \
asmcomp/split.cmx \
asmcomp/spill.cmx \
asmcomp/selection.cmx \
@ -1977,22 +1967,17 @@ asmcomp/asmgen.cmx : \
asmcomp/printmach.cmx \
asmcomp/printlinear.cmx \
asmcomp/printcmm.cmx \
middle_end/printclambda.cmx \
typing/primitive.cmx \
typing/path.cmx \
utils/misc.cmx \
asmcomp/mach.cmx \
parsing/location.cmx \
asmcomp/liveness.cmx \
asmcomp/linscan.cmx \
middle_end/linkage_name.cmx \
asmcomp/linearize.cmx \
lambda/lambda.cmx \
asmcomp/interval.cmx \
asmcomp/interf.cmx \
typing/ident.cmx \
middle_end/flambda/flambda_to_clambda.cmx \
middle_end/flambda/flambda.cmx \
asmcomp/emitaux.cmx \
asmcomp/emit.cmx \
asmcomp/deadcode.cmx \
@ -2002,18 +1987,16 @@ asmcomp/asmgen.cmx : \
asmcomp/coloring.cmx \
asmcomp/cmmgen.cmx \
asmcomp/cmm.cmx \
middle_end/closure/closure.cmx \
utils/clflags.cmx \
middle_end/clambda.cmx \
asmcomp/CSE.cmx \
middle_end/flambda/build_export_info.cmx \
middle_end/backend_intf.cmi \
asmcomp/debug/available_regs.cmx \
asmcomp/asmgen.cmi
asmcomp/asmgen.cmi : \
lambda/lambda.cmi \
typing/ident.cmi \
middle_end/flambda/flambda.cmi \
asmcomp/cmm.cmi \
middle_end/clambda.cmi \
middle_end/backend_intf.cmi
asmcomp/asmlibrarian.cmo : \
utils/misc.cmi \
@ -2098,6 +2081,7 @@ asmcomp/asmpackager.cmo : \
middle_end/compilenv.cmi \
middle_end/compilation_unit.cmi \
file_formats/cmx_format.cmi \
middle_end/closure/closure_middle_end.cmi \
utils/clflags.cmi \
utils/ccomp.cmi \
asmcomp/asmlink.cmi \
@ -2120,6 +2104,7 @@ asmcomp/asmpackager.cmx : \
middle_end/compilenv.cmx \
middle_end/compilation_unit.cmx \
file_formats/cmx_format.cmi \
middle_end/closure/closure_middle_end.cmx \
utils/clflags.cmx \
utils/ccomp.cmx \
asmcomp/asmlink.cmx \
@ -3548,6 +3533,30 @@ middle_end/closure/closure.cmi : \
lambda/lambda.cmi \
middle_end/clambda.cmi \
middle_end/backend_intf.cmi
middle_end/closure/closure_middle_end.cmo : \
middle_end/printclambda.cmi \
typing/path.cmi \
lambda/lambda.cmi \
typing/ident.cmi \
middle_end/compilenv.cmi \
middle_end/closure/closure.cmi \
utils/clflags.cmi \
middle_end/clambda.cmi \
middle_end/closure/closure_middle_end.cmi
middle_end/closure/closure_middle_end.cmx : \
middle_end/printclambda.cmx \
typing/path.cmx \
lambda/lambda.cmx \
typing/ident.cmx \
middle_end/compilenv.cmx \
middle_end/closure/closure.cmx \
utils/clflags.cmx \
middle_end/clambda.cmx \
middle_end/closure/closure_middle_end.cmi
middle_end/closure/closure_middle_end.cmi : \
lambda/lambda.cmi \
middle_end/clambda.cmi \
middle_end/backend_intf.cmi
middle_end/flambda/alias_analysis.cmo : \
middle_end/variable.cmi \
middle_end/flambda/base_types/var_within_closure.cmi \
@ -4071,65 +4080,81 @@ middle_end/flambda/flambda_iterators.cmi : \
middle_end/flambda/flambda_middle_end.cmo : \
utils/warnings.cmi \
middle_end/variable.cmi \
middle_end/flambda/un_anf.cmi \
middle_end/symbol.cmi \
middle_end/flambda/share_constants.cmi \
middle_end/flambda/remove_unused_program_constructs.cmi \
middle_end/flambda/remove_unused_closure_vars.cmi \
middle_end/flambda/ref_to_variables.cmi \
utils/profile.cmi \
middle_end/printclambda.cmi \
utils/misc.cmi \
parsing/location.cmi \
middle_end/linkage_name.cmi \
middle_end/flambda/lift_let_to_initialize_symbol.cmi \
middle_end/flambda/lift_constants.cmi \
middle_end/flambda/lift_code.cmi \
lambda/lambda.cmi \
utils/int_replace_polymorphic_compare.cmi \
middle_end/flambda/inlining_cost.cmi \
middle_end/flambda/inline_and_simplify.cmi \
middle_end/flambda/initialize_symbol_to_let_symbol.cmi \
middle_end/flambda/flambda_to_clambda.cmi \
middle_end/flambda/flambda_iterators.cmi \
middle_end/flambda/flambda_invariants.cmi \
middle_end/flambda/flambda.cmi \
lambda/debuginfo.cmi \
middle_end/compilenv.cmi \
middle_end/flambda/base_types/closure_id.cmi \
middle_end/flambda/closure_conversion.cmi \
utils/clflags.cmi \
middle_end/clambda.cmi \
middle_end/flambda/build_export_info.cmi \
middle_end/backend_intf.cmi \
middle_end/flambda/flambda_middle_end.cmi
middle_end/flambda/flambda_middle_end.cmx : \
utils/warnings.cmx \
middle_end/variable.cmx \
middle_end/flambda/un_anf.cmx \
middle_end/symbol.cmx \
middle_end/flambda/share_constants.cmx \
middle_end/flambda/remove_unused_program_constructs.cmx \
middle_end/flambda/remove_unused_closure_vars.cmx \
middle_end/flambda/ref_to_variables.cmx \
utils/profile.cmx \
middle_end/printclambda.cmx \
utils/misc.cmx \
parsing/location.cmx \
middle_end/linkage_name.cmx \
middle_end/flambda/lift_let_to_initialize_symbol.cmx \
middle_end/flambda/lift_constants.cmx \
middle_end/flambda/lift_code.cmx \
lambda/lambda.cmx \
utils/int_replace_polymorphic_compare.cmx \
middle_end/flambda/inlining_cost.cmx \
middle_end/flambda/inline_and_simplify.cmx \
middle_end/flambda/initialize_symbol_to_let_symbol.cmx \
middle_end/flambda/flambda_to_clambda.cmx \
middle_end/flambda/flambda_iterators.cmx \
middle_end/flambda/flambda_invariants.cmx \
middle_end/flambda/flambda.cmx \
lambda/debuginfo.cmx \
middle_end/compilenv.cmx \
middle_end/flambda/base_types/closure_id.cmx \
middle_end/flambda/closure_conversion.cmx \
utils/clflags.cmx \
middle_end/clambda.cmx \
middle_end/flambda/build_export_info.cmx \
middle_end/backend_intf.cmi \
middle_end/flambda/flambda_middle_end.cmi
middle_end/flambda/flambda_middle_end.cmi : \
lambda/lambda.cmi \
typing/ident.cmi \
middle_end/flambda/flambda.cmi \
middle_end/clambda.cmi \
middle_end/backend_intf.cmi
middle_end/flambda/flambda_to_clambda.cmo : \
middle_end/variable.cmi \
middle_end/flambda/base_types/var_within_closure.cmi \
middle_end/flambda/un_anf.cmi \
middle_end/flambda/base_types/tag.cmi \
middle_end/symbol.cmi \
middle_end/flambda/base_types/static_exception.cmi \
@ -4148,6 +4173,7 @@ middle_end/flambda/flambda_to_clambda.cmo : \
middle_end/flambda/export_info.cmi \
lambda/debuginfo.cmi \
middle_end/compilenv.cmi \
middle_end/compilation_unit.cmi \
middle_end/flambda/closure_offsets.cmi \
middle_end/flambda/base_types/closure_id.cmi \
utils/clflags.cmi \
@ -4158,6 +4184,7 @@ middle_end/flambda/flambda_to_clambda.cmo : \
middle_end/flambda/flambda_to_clambda.cmx : \
middle_end/variable.cmx \
middle_end/flambda/base_types/var_within_closure.cmx \
middle_end/flambda/un_anf.cmx \
middle_end/flambda/base_types/tag.cmx \
middle_end/symbol.cmx \
middle_end/flambda/base_types/static_exception.cmx \
@ -4176,6 +4203,7 @@ middle_end/flambda/flambda_to_clambda.cmx : \
middle_end/flambda/export_info.cmx \
lambda/debuginfo.cmx \
middle_end/compilenv.cmx \
middle_end/compilation_unit.cmx \
middle_end/flambda/closure_offsets.cmx \
middle_end/flambda/base_types/closure_id.cmx \
utils/clflags.cmx \
@ -5154,6 +5182,7 @@ middle_end/flambda/traverse_for_exported_symbols.cmi : \
middle_end/flambda/base_types/export_id.cmi \
middle_end/flambda/base_types/closure_id.cmi
middle_end/flambda/un_anf.cmo : \
middle_end/symbol.cmi \
middle_end/semantics_of_primitives.cmi \
middle_end/printclambda.cmi \
utils/misc.cmi \
@ -5166,6 +5195,7 @@ middle_end/flambda/un_anf.cmo : \
parsing/asttypes.cmi \
middle_end/flambda/un_anf.cmi
middle_end/flambda/un_anf.cmx : \
middle_end/symbol.cmx \
middle_end/semantics_of_primitives.cmx \
middle_end/printclambda.cmx \
utils/misc.cmx \
@ -5178,6 +5208,7 @@ middle_end/flambda/un_anf.cmx : \
parsing/asttypes.cmi \
middle_end/flambda/un_anf.cmi
middle_end/flambda/un_anf.cmi : \
middle_end/symbol.cmi \
middle_end/clambda.cmi
middle_end/flambda/unbox_closures.cmo : \
middle_end/variable.cmi \
@ -5695,6 +5726,7 @@ driver/optcompile.cmo : \
utils/config.cmi \
middle_end/compilenv.cmi \
driver/compile_common.cmi \
middle_end/closure/closure_middle_end.cmi \
utils/clflags.cmi \
asmcomp/asmgen.cmi \
driver/optcompile.cmi
@ -5709,6 +5741,7 @@ driver/optcompile.cmx : \
utils/config.cmx \
middle_end/compilenv.cmx \
driver/compile_common.cmx \
middle_end/closure/closure_middle_end.cmx \
utils/clflags.cmx \
asmcomp/asmgen.cmx \
driver/optcompile.cmi
@ -5912,6 +5945,7 @@ toplevel/opttoploop.cmo : \
driver/compmisc.cmi \
middle_end/compilenv.cmi \
driver/compenv.cmi \
middle_end/closure/closure_middle_end.cmi \
utils/clflags.cmi \
typing/btype.cmi \
middle_end/backend_intf.cmi \
@ -5958,6 +5992,7 @@ toplevel/opttoploop.cmx : \
driver/compmisc.cmx \
middle_end/compilenv.cmx \
driver/compenv.cmx \
middle_end/closure/closure_middle_end.cmx \
utils/clflags.cmx \
typing/btype.cmx \
middle_end/backend_intf.cmi \

6
Changes
View File

@ -146,7 +146,7 @@ OCaml 4.09.0
(Mark Shinwell, review by Vincent Laviron)
- #2281: Move some middle-end files around
(Mark Shinwell)
(Mark Shinwell, review by Pierre Chambart and Vincent Laviron)
- #2283: Add [is_prefix] and [find_and_chop_longest_common_prefix] to
[Misc.Stdlib.List]
@ -159,6 +159,10 @@ OCaml 4.09.0
- #2286: Functorise [Consistbl]
(Mark Shinwell, review by Gabriel Radanne)
- #2288: Move middle end code from [Asmgen] to [Clambda_middle_end] and
[Flambda_middle_end]. Run [Un_anf] from the middle end, not [Cmmgen].
(Mark Shinwell, review by Pierre Chambart)
- #2291: Add [Compute_ranges] pass
(Mark Shinwell, review by Vincent Laviron)

3
Makefile
View File

@ -189,7 +189,8 @@ ASMCOMP=\
# the native code compiler is not present for some particular target.
MIDDLE_END_CLOSURE=\
middle_end/closure/closure.cmo
middle_end/closure/closure.cmo \
middle_end/closure/closure_middle_end.cmo
# Owing to dependencies through [Compilenv], which would be
# difficult to remove, some of the lower parts of Flambda (anything that is

143
asmcomp/asmgen.ml
View File

@ -39,41 +39,6 @@ let pass_dump_linear_if ppf flag message phrase =
if !flag then fprintf ppf "*** %s@.%a@." message Printlinear.fundecl phrase;
phrase
let flambda_raw_clambda_dump_if ppf
({ Flambda_to_clambda. expr = ulambda; preallocated_blocks = _;
structured_constants; exported = _; } as input) =
if !dump_rawclambda then
begin
Format.fprintf ppf "@.clambda (before Un_anf):@.";
Printclambda.clambda ppf ulambda;
Symbol.Map.iter (fun sym cst ->
Format.fprintf ppf "%a:@ %a@."
Symbol.print sym
Printclambda.structured_constant cst)
structured_constants
end;
if !dump_cmm then Format.fprintf ppf "@.cmm:@.";
input
type clambda_and_constants =
Clambda.ulambda *
Clambda.preallocated_block list *
Clambda.preallocated_constant list
let raw_clambda_dump_if ppf
((ulambda, _, structured_constants):clambda_and_constants) =
if !dump_rawclambda || !dump_clambda then
begin
Format.fprintf ppf "@.clambda:@.";
Printclambda.clambda ppf ulambda;
List.iter (fun {Clambda.symbol; definition} ->
Format.fprintf ppf "%s:@ %a@."
symbol
Printclambda.structured_constant definition)
structured_constants
end;
if !dump_cmm then Format.fprintf ppf "@.cmm:@."
let rec regalloc ~ppf_dump round fd =
if round > 50 then
fatal_error(fd.Mach.fun_name ^
@ -102,7 +67,6 @@ let (++) x f = f x
let compile_fundecl ~ppf_dump fd_cmm =
Proc.init ();
Cmmgen.reset ();
Reg.reset();
fd_cmm
++ Profile.record ~accumulate:true "selection" Selection.fundecl
@ -145,8 +109,7 @@ let compile_genfuns ~ppf_dump f =
| _ -> ())
(Cmmgen.generic_functions true [Compilenv.current_unit_infos ()])
let compile_unit _output_prefix asm_filename keep_asm
obj_filename gen =
let compile_unit asm_filename keep_asm obj_filename gen =
let create_asm = keep_asm || not !Emitaux.binary_backend_available in
Emitaux.create_asm_file := create_asm;
Misc.try_finally
@ -167,109 +130,49 @@ let compile_unit _output_prefix asm_filename keep_asm
if create_asm && not keep_asm then remove_file asm_filename
)
let set_export_info (ulambda, prealloc, structured_constants, export) =
Compilenv.set_export_info export;
(ulambda, prealloc, structured_constants)
let end_gen_implementation ?toplevel ~ppf_dump
(clambda:clambda_and_constants) =
(clambda : Clambda.with_constants) =
Emit.begin_assembly ();
clambda
++ Profile.record "cmm" (Cmmgen.compunit ~ppf_dump)
++ Profile.record "cmm" Cmmgen.compunit
++ Profile.record "compile_phrases" (List.iter (compile_phrase ~ppf_dump))
++ (fun () -> ());
(match toplevel with None -> () | Some f -> compile_genfuns ~ppf_dump 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_dump
(Cmmgen.reference_symbols
(List.filter (fun s -> s <> "" && s.[0] <> '%')
(List.map Primitive.native_name !Translmod.primitive_declarations))
);
(List.filter_map (fun prim ->
if not (Primitive.native_name_is_external prim) then None
else Some (Primitive.native_name prim))
!Translmod.primitive_declarations));
Emit.end_assembly ()
let flambda_gen_implementation ?toplevel ~backend ~ppf_dump
(program:Flambda.program) =
let export = Build_export_info.build_transient ~backend program in
let (clambda, preallocated, constants) =
Profile.record_call "backend" (fun () ->
(program, export)
++ Flambda_to_clambda.convert
++ flambda_raw_clambda_dump_if ppf_dump
++ (fun { Flambda_to_clambda. expr; preallocated_blocks;
structured_constants; exported; } ->
(* "init_code" following the name used in
[Cmmgen.compunit_and_constants]. *)
Un_anf.apply ~ppf_dump expr ~what:"init_code", preallocated_blocks,
structured_constants, exported)
++ set_export_info)
in
let constants =
List.map (fun (symbol, definition) ->
{ Clambda.symbol = Linkage_name.to_string (Symbol.label symbol);
exported = true;
definition;
provenance = None;
})
(Symbol.Map.bindings constants)
in
end_gen_implementation ?toplevel ~ppf_dump
(clambda, preallocated, constants)
type middle_end =
backend:(module Backend_intf.S)
-> filename:string
-> prefixname:string
-> ppf_dump:Format.formatter
-> Lambda.program
-> Clambda.with_constants
let lambda_gen_implementation ?toplevel ~backend ~ppf_dump
(lambda:Lambda.program) =
let clambda =
Closure.intro ~backend ~size:lambda.main_module_block_size lambda.code
in
let provenance : Clambda.usymbol_provenance =
{ original_idents = [];
module_path =
Path.Pident (Ident.create_persistent (Compilenv.current_unit_name ()));
}
in
let preallocated_block =
Clambda.{
symbol = Compilenv.make_symbol None;
exported = true;
tag = 0;
fields = List.init lambda.main_module_block_size (fun _ -> None);
provenance = Some provenance;
}
in
let clambda_and_constants =
clambda, [preallocated_block], Compilenv.structured_constants ()
in
Compilenv.clear_structured_constants ();
raw_clambda_dump_if ppf_dump clambda_and_constants;
end_gen_implementation ?toplevel ~ppf_dump clambda_and_constants
let compile_implementation_gen ?toplevel prefixname
~required_globals ~ppf_dump gen_implementation program =
let compile_implementation ?toplevel ~backend ~filename ~prefixname ~middle_end
~ppf_dump (program : Lambda.program) =
let asmfile =
if !keep_asm_file || !Emitaux.binary_backend_available
then prefixname ^ ext_asm
else Filename.temp_file "camlasm" ext_asm
in
compile_unit prefixname asmfile !keep_asm_file
(prefixname ^ ext_obj) (fun () ->
Ident.Set.iter Compilenv.require_global required_globals;
gen_implementation ?toplevel ~ppf_dump program)
let compile_implementation_clambda ?toplevel prefixname
~backend ~ppf_dump (program:Lambda.program) =
compile_implementation_gen ?toplevel prefixname
~required_globals:program.Lambda.required_globals
~ppf_dump (lambda_gen_implementation ~backend) program
let compile_implementation_flambda ?toplevel prefixname
~required_globals ~backend ~ppf_dump (program:Flambda.program) =
compile_implementation_gen ?toplevel prefixname
~required_globals ~ppf_dump (flambda_gen_implementation ~backend) program
compile_unit asmfile !keep_asm_file (prefixname ^ ext_obj)
(fun () ->
Ident.Set.iter Compilenv.require_global program.required_globals;
let clambda_with_constants =
middle_end ~backend ~filename ~prefixname ~ppf_dump program
in
end_gen_implementation ?toplevel ~ppf_dump clambda_with_constants)
(* Error report *)

32
asmcomp/asmgen.mli
View File

@ -13,20 +13,27 @@
(* *)
(**************************************************************************)
(* From lambda to assembly code *)
(** From Lambda to assembly code *)
val compile_implementation_flambda :
?toplevel:(string -> bool) ->
string ->
required_globals:Ident.Set.t ->
backend:(module Backend_intf.S) ->
ppf_dump:Format.formatter -> Flambda.program -> unit
(** The type of converters from Lambda to Clambda. *)
type middle_end =
backend:(module Backend_intf.S)
-> filename:string
-> prefixname:string
-> ppf_dump:Format.formatter
-> Lambda.program
-> Clambda.with_constants
val compile_implementation_clambda :
?toplevel:(string -> bool) ->
string ->
backend:(module Backend_intf.S) ->
ppf_dump:Format.formatter -> Lambda.program -> unit
(** Compile an implementation from Lambda using the given middle end. *)
val compile_implementation
: ?toplevel:(string -> bool)
-> backend:(module Backend_intf.S)
-> filename:string
-> prefixname:string
-> middle_end:middle_end
-> ppf_dump:Format.formatter
-> Lambda.program
-> unit
val compile_phrase :
ppf_dump:Format.formatter -> Cmm.phrase -> unit
@ -37,6 +44,5 @@ val report_error: Format.formatter -> error -> unit
val compile_unit:
string(*prefixname*) ->
string(*asm file*) -> bool(*keep asm*) ->
string(*obj file*) -> (unit -> unit) -> unit

4
asmcomp/asmlink.ml
View File

@ -287,7 +287,7 @@ let link_shared ~ppf_dump objfiles output_name =
then output_name ^ ".startup" ^ ext_asm
else Filename.temp_file "camlstartup" ext_asm in
let startup_obj = output_name ^ ".startup" ^ ext_obj in
Asmgen.compile_unit output_name
Asmgen.compile_unit
startup !Clflags.keep_startup_file startup_obj
(fun () ->
make_shared_startup_file ~ppf_dump
@ -352,7 +352,7 @@ let link ~ppf_dump objfiles output_name =
then output_name ^ ".startup" ^ ext_asm
else Filename.temp_file "camlstartup" ext_asm in
let startup_obj = Filename.temp_file "camlstartup" ext_obj in
Asmgen.compile_unit output_name
Asmgen.compile_unit
startup !Clflags.keep_startup_file startup_obj
(fun () -> make_startup_file ~ppf_dump units_tolink ~crc_interfaces);
Misc.try_finally

58
asmcomp/asmpackager.ml
View File

@ -99,27 +99,42 @@ let make_package_object ~ppf_dump members targetobj targetname coercion
members in
let module_ident = Ident.create_persistent targetname in
let prefixname = Filename.remove_extension objtemp in
if Config.flambda then begin
let size, lam = Translmod.transl_package_flambda components coercion in
let flam =
Flambda_middle_end.middle_end ~ppf_dump
~prefixname
~backend
~size
~filename:targetname
~module_ident
~module_initializer:lam
in
Asmgen.compile_implementation_flambda
prefixname ~backend ~required_globals:Ident.Set.empty ~ppf_dump flam;
end else begin
let main_module_block_size, code =
Translmod.transl_store_package
components (Ident.create_persistent targetname) coercion in
Asmgen.compile_implementation_clambda
prefixname ~backend ~ppf_dump { Lambda.code; main_module_block_size;
module_ident; required_globals = Ident.Set.empty }
end;
let required_globals = Ident.Set.empty in
let program, middle_end =
if Config.flambda then
let main_module_block_size, code =
Translmod.transl_package_flambda components coercion
in
let program =
{ Lambda.
code;
main_module_block_size;
module_ident;
required_globals;
}
in
program, Flambda_middle_end.lambda_to_clambda
else
let main_module_block_size, code =
Translmod.transl_store_package components
(Ident.create_persistent targetname) coercion
in
let program =
{ Lambda.
code;
main_module_block_size;
module_ident;
required_globals;
}
in
program, Closure_middle_end.lambda_to_clambda
in
Asmgen.compile_implementation ~backend
~filename:targetname
~prefixname
~middle_end
~ppf_dump
program;
let objfiles =
List.map
(fun m -> Filename.remove_extension m.pm_file ^ Config.ext_obj)
@ -130,6 +145,7 @@ let make_package_object ~ppf_dump members targetobj targetname coercion
remove_file objtemp;
if not ok then raise(Error Linking_error)
)
(* Make the .cmx file for the package *)
let get_export_info ui =

33
asmcomp/cmmgen.ml
View File

@ -3225,13 +3225,8 @@ and transl_letrec env bindings cont =
(* Translate a function definition *)
let transl_function ~ppf_dump f =
let body =
if Config.flambda then
Un_anf.apply ~ppf_dump f.body ~what:f.label
else
f.body
in
let transl_function f =
let body = f.body in
let cmm_body =
let env = create_env ~environment_param:f.env in
if !Clflags.afl_instrument then
@ -3252,17 +3247,17 @@ let transl_function ~ppf_dump f =
(* Translate all function definitions *)
let rec transl_all_functions ~ppf_dump already_translated cont =
let rec transl_all_functions already_translated cont =
match Cmmgen_state.next_function () with
| None -> cont, already_translated
| Some f ->
let sym = f.label in
if String.Set.mem sym already_translated then
transl_all_functions ~ppf_dump already_translated cont
transl_all_functions already_translated cont
else begin
transl_all_functions ~ppf_dump
transl_all_functions
(String.Set.add sym already_translated)
((f.dbg, transl_function ~ppf_dump f) :: cont)
((f.dbg, transl_function f) :: cont)
end
(* Emit constant closures *)
@ -3349,16 +3344,16 @@ let emit_cmm_data_items_for_constants cont =
c := (Cdata cmm) :: !c
| Const_table (global, elems) ->
c := (Cdata (emit_constant_table (symbol, global) elems)) :: !c)
(Cmmgen_state.constants ());
Cdata (Cmmgen_state.data_items ()) :: !c
(Cmmgen_state.get_and_clear_constants ());
Cdata (Cmmgen_state.get_and_clear_data_items ()) :: !c
let transl_all_functions ~ppf_dump cont =
let transl_all_functions cont =
let rec aux already_translated cont translated_functions =
if Cmmgen_state.no_more_functions ()
then cont, translated_functions
else
let translated_functions, already_translated =
transl_all_functions ~ppf_dump already_translated translated_functions
transl_all_functions already_translated translated_functions
in
aux already_translated cont translated_functions
in
@ -3422,7 +3417,8 @@ let emit_preallocated_blocks preallocated_blocks cont =
(* Translate a compilation unit *)
let compunit ~ppf_dump (ulam, preallocated_blocks, constants) =
let compunit (ulam, preallocated_blocks, constants) =
assert (Cmmgen_state.no_more_functions ());
let dbg = Debuginfo.none in
let init_code =
if !Clflags.afl_instrument then
@ -3444,7 +3440,7 @@ let compunit ~ppf_dump (ulam, preallocated_blocks, constants) =
else [ Reduce_code_size ];
fun_dbg = Debuginfo.none }] in
let c2 = transl_clambda_constants constants c1 in
let c3 = transl_all_functions ~ppf_dump c2 in
let c3 = transl_all_functions c2 in
let c4 = emit_preallocated_blocks preallocated_blocks c3 in
emit_cmm_data_items_for_constants c4
@ -3943,6 +3939,3 @@ let plugin_header units =
} in
global_data "caml_plugin_header"
{ dynu_magic = Config.cmxs_magic_number; dynu_units = List.map mk units }
let reset () =
Cmmgen_state.reset ()

7
asmcomp/cmmgen.mli
View File

@ -15,9 +15,8 @@
(* Translation from closed lambda to C-- *)
val compunit:
ppf_dump:Format.formatter
-> Clambda.ulambda
val compunit
: Clambda.ulambda
* Clambda.preallocated_block list
* Clambda.preallocated_constant list
-> Cmm.phrase list
@ -38,5 +37,3 @@ val code_segment_table: string list -> Cmm.phrase
val predef_exception: int -> string -> Cmm.phrase
val plugin_header: (Cmx_format.unit_infos * Digest.t) list -> Cmm.phrase
val black_block_header: (*tag:*)int -> (*size:*)int -> nativeint
val reset : unit -> unit

15
asmcomp/cmmgen_state.ml
View File

@ -39,11 +39,6 @@ let empty = {
let state = empty
let reset () =
state.constants <- S.Map.empty;
state.data_items <- [];
Queue.clear state.functions
let add_constant sym cst =
state.constants <- S.Map.add sym cst state.constants
@ -53,9 +48,15 @@ let add_data_items items =
let add_function func =
Queue.add func state.functions
let constants () = state.constants
let get_and_clear_constants () =
let constants = state.constants in
state.constants <- S.Map.empty;
constants
let data_items () = List.concat (List.rev state.data_items)
let get_and_clear_data_items () =
let data_items = List.concat (List.rev state.data_items) in
state.data_items <- [];
data_items
let next_function () =
match Queue.take state.functions with

6
asmcomp/cmmgen_state.mli
View File

@ -19,8 +19,6 @@
[@@@ocaml.warning "+a-4-30-40-41-42"]
val reset : unit -> unit
type is_global = Global | Local
type constant =
@ -33,9 +31,9 @@ val add_data_items : Cmm.data_item list -> unit
val add_function : Clambda.ufunction -> unit
val constants : unit -> constant Misc.Stdlib.String.Map.t
val get_and_clear_constants : unit -> constant Misc.Stdlib.String.Map.t
val data_items : unit -> Cmm.data_item list
val get_and_clear_data_items : unit -> Cmm.data_item list
val next_function : unit -> Clambda.ufunction option

33
driver/optcompile.ml
View File

@ -48,17 +48,22 @@ let flambda i backend typed =
|>> print_if i.ppf_dump Clflags.dump_rawlambda Printlambda.lambda
|>> Simplif.simplify_lambda
|>> print_if i.ppf_dump Clflags.dump_lambda Printlambda.lambda
|> (fun ((module_ident, size), lam) ->
Flambda_middle_end.middle_end
~ppf_dump:i.ppf_dump
~prefixname:i.output_prefix
~size
~filename:i.source_file
~module_ident
|> (fun ((module_ident, main_module_block_size), code) ->
let program : Lambda.program =
{ Lambda.
module_ident;
main_module_block_size;
required_globals;
code;
}
in
Asmgen.compile_implementation
~backend
~module_initializer:lam)
|> Asmgen.compile_implementation_flambda
i.output_prefix ~required_globals ~backend ~ppf_dump:i.ppf_dump;
~filename:i.source_file
~prefixname:i.output_prefix
~middle_end:Flambda_middle_end.lambda_to_clambda
~ppf_dump:i.ppf_dump
program);
Compilenv.save_unit_info (cmx i))
let clambda i backend typed =
@ -72,8 +77,12 @@ let clambda i backend typed =
let code = Simplif.simplify_lambda program.Lambda.code in
{ program with Lambda.code }
|> print_if i.ppf_dump Clflags.dump_lambda Printlambda.program
|> Asmgen.compile_implementation_clambda
i.output_prefix ~backend ~ppf_dump:i.ppf_dump;
|> Asmgen.compile_implementation
~backend
~filename:i.source_file
~prefixname:i.output_prefix
~middle_end:Closure_middle_end.lambda_to_clambda
~ppf_dump:i.ppf_dump;
Compilenv.save_unit_info (cmx i))
let implementation ~backend ~source_file ~output_prefix =

3
middle_end/clambda.ml
View File

@ -136,6 +136,9 @@ type preallocated_constant = {
provenance : usymbol_provenance option;
}
type with_constants =
ulambda * preallocated_block list * preallocated_constant list
(* Comparison functions for constants. We must not use Stdlib.compare
because it compares "0.0" and "-0.0" equal. (PR#6442) *)

3
middle_end/clambda.mli
View File

@ -151,3 +151,6 @@ type preallocated_constant = {
definition : ustructured_constant;
provenance : usymbol_provenance option;
}
type with_constants =
ulambda * preallocated_block list * preallocated_constant list

58
middle_end/closure/closure_middle_end.ml Normal file
View File

@ -0,0 +1,58 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
[@@@ocaml.warning "+a-4-30-40-41-42"]
let raw_clambda_dump_if ppf
((ulambda, _, structured_constants) : Clambda.with_constants) =
if !Clflags.dump_rawclambda || !Clflags.dump_clambda then
begin
Format.fprintf ppf "@.clambda:@.";
Printclambda.clambda ppf ulambda;
List.iter (fun { Clambda. symbol; definition; _ } ->
Format.fprintf ppf "%s:@ %a@."
symbol
Printclambda.structured_constant definition)
structured_constants
end;
if !Clflags.dump_cmm then Format.fprintf ppf "@.cmm:@."
let lambda_to_clambda ~backend ~filename:_ ~prefixname:_ ~ppf_dump
(lambda : Lambda.program) =
let clambda =
Closure.intro ~backend ~size:lambda.main_module_block_size lambda.code
in
let provenance : Clambda.usymbol_provenance =
{ original_idents = [];
module_path =
Path.Pident (Ident.create_persistent (Compilenv.current_unit_name ()));
}
in
let preallocated_block =
Clambda.{
symbol = Compilenv.make_symbol None;
exported = true;
tag = 0;
fields = List.init lambda.main_module_block_size (fun _ -> None);
provenance = Some provenance;
}
in
let constants = Compilenv.structured_constants () in
Compilenv.clear_structured_constants ();
let clambda_and_constants =
clambda, [preallocated_block], constants
in
raw_clambda_dump_if ppf_dump clambda_and_constants;
clambda_and_constants

22
middle_end/closure/closure_middle_end.mli Normal file
View File

@ -0,0 +1,22 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
val lambda_to_clambda
: backend:(module Backend_intf.S)
-> filename:string
-> prefixname:string
-> ppf_dump:Format.formatter
-> Lambda.program
-> Clambda.with_constants

62
middle_end/flambda/flambda_middle_end.ml
View File

@ -6,7 +6,7 @@
(* Mark Shinwell and Leo White, Jane Street Europe *)
(* *)
(* Copyright 2013--2016 OCamlPro SAS *)
(* Copyright 2014--2016 Jane Street Group LLC *)
(* Copyright 2014--2019 Jane Street Group LLC *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
@ -14,7 +14,7 @@
(* *)
(**************************************************************************)
[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
[@@@ocaml.warning "+a-4-30-40-41-42-66"]
open! Int_replace_polymorphic_compare
let _dump_function_sizes flam ~backend =
@ -31,11 +31,8 @@ let _dump_function_sizes flam ~backend =
| None -> assert false)
set_of_closures.function_decls.funs)
let middle_end ~ppf_dump ~prefixname ~backend
~size
~filename
~module_ident
~module_initializer =
let lambda_to_flambda ~ppf_dump ~prefixname ~backend ~size ~filename
~module_ident ~module_initializer =
Profile.record_call "flambda" (fun () ->
let previous_warning_reporter = !Location.warning_reporter in
let module WarningSet =
@ -198,3 +195,54 @@ let middle_end ~ppf_dump ~prefixname ~backend
(* dump_function_sizes flam ~backend; *)
flam))
)
let flambda_raw_clambda_dump_if ppf
({ Flambda_to_clambda. expr = ulambda; preallocated_blocks = _;
structured_constants; exported = _; } as input) =
if !Clflags.dump_rawclambda then
begin
Format.fprintf ppf "@.clambda (before Un_anf):@.";
Printclambda.clambda ppf ulambda;
Symbol.Map.iter (fun sym cst ->
Format.fprintf ppf "%a:@ %a@."
Symbol.print sym
Printclambda.structured_constant cst)
structured_constants
end;
if !Clflags.dump_cmm then Format.fprintf ppf "@.cmm:@.";
input
let lambda_to_clambda ~backend ~filename ~prefixname ~ppf_dump
(program : Lambda.program) =
let program =
lambda_to_flambda ~ppf_dump ~prefixname ~backend
~size:program.main_module_block_size
~filename
~module_ident:program.module_ident
~module_initializer:program.code
in
let export = Build_export_info.build_transient ~backend program in
let clambda, preallocated_blocks, constants =
Profile.record_call "backend" (fun () ->
(program, export)
|> Flambda_to_clambda.convert ~ppf_dump
|> flambda_raw_clambda_dump_if ppf_dump
|> (fun { Flambda_to_clambda. expr; preallocated_blocks;
structured_constants; exported; } ->
Compilenv.set_export_info exported;
let clambda =
Un_anf.apply ~what:(Compilenv.current_unit_symbol ())
~ppf_dump expr
in
clambda, preallocated_blocks, structured_constants))
in
let constants =
List.map (fun (symbol, definition) ->
{ Clambda.symbol = Linkage_name.to_string (Symbol.label symbol);
exported = true;
definition;
provenance = None;
})
(Symbol.Map.bindings constants)
in
clambda, preallocated_blocks, constants

16
middle_end/flambda/flambda_middle_end.mli
View File

@ -16,14 +16,12 @@
[@@@ocaml.warning "+a-4-9-30-40-41-42"]
(* Translate Lambda code to Flambda code and then optimize it. *)
(** Translate Lambda code to Flambda code, optimize it, and produce Clambda. *)
val middle_end
: ppf_dump:Format.formatter
-> prefixname:string
-> backend:(module Backend_intf.S)
-> size:int
val lambda_to_clambda
: backend:(module Backend_intf.S)
-> filename:string
-> module_ident:Ident.t
-> module_initializer:Lambda.lambda
-> Flambda.program
-> prefixname:string
-> ppf_dump:Format.formatter
-> Lambda.program
-> Clambda.with_constants

66
middle_end/flambda/flambda_to_clambda.ml
View File

@ -31,6 +31,9 @@ type t = {
Set_of_closures_id.t for_one_or_more_units;
imported_units :
Simple_value_approx.function_declarations for_one_or_more_units;
ppf_dump : Format.formatter;
mutable constants_for_instrumentation :
Clambda.ustructured_constant Symbol.Map.t;
}
let get_fun_offset t closure_id =
@ -70,7 +73,7 @@ let is_function_constant t closure_id =
(* Instrumentation of closure and field accesses to try to catch compiler
bugs. *)
let check_closure ulam named : Clambda.ulambda =
let check_closure t ulam named : Clambda.ulambda =
if not !Clflags.clambda_checks then ulam
else
let desc =
@ -78,14 +81,19 @@ let check_closure ulam named : Clambda.ulambda =
~arity:2 ~alloc:false
in
let str = Format.asprintf "%a" Flambda.print_named named in
let str_const =
Compilenv.new_structured_constant (Uconst_string str) ~shared:true
let sym = Compilenv.new_const_symbol () in
let sym' =
Symbol.of_global_linkage (Compilation_unit.get_current_exn ())
(Linkage_name.create sym)
in
t.constants_for_instrumentation <-
Symbol.Map.add sym' (Clambda.Uconst_string str)
t.constants_for_instrumentation;
Uprim (Pccall desc,
[ulam; Clambda.Uconst (Uconst_ref (str_const, None))],
[ulam; Clambda.Uconst (Uconst_ref (sym, None))],
Debuginfo.none)
let check_field ulam pos named_opt : Clambda.ulambda =
let check_field t ulam pos named_opt : Clambda.ulambda =
if not !Clflags.clambda_checks then ulam
else
let desc =
@ -97,11 +105,16 @@ let check_field ulam pos named_opt : Clambda.ulambda =
| None -> "<none>"
| Some named -> Format.asprintf "%a" Flambda.print_named named
in
let str_const =
Compilenv.new_structured_constant (Uconst_string str) ~shared:true
let sym = Compilenv.new_const_symbol () in
let sym' =
Symbol.of_global_linkage (Compilation_unit.get_current_exn ())
(Linkage_name.create sym)
in
t.constants_for_instrumentation <-
Symbol.Map.add sym' (Clambda.Uconst_string str)
t.constants_for_instrumentation;
Uprim (Pccall desc, [ulam; Clambda.Uconst (Uconst_int pos);
Clambda.Uconst (Uconst_ref (str_const, None))],
Clambda.Uconst (Uconst_ref (sym, None))],
Debuginfo.none)
module Env : sig
@ -258,7 +271,7 @@ let rec to_clambda t env (flam : Flambda.t) : Clambda.ulambda =
to_clambda_direct_apply t func args direct_func dbg env
| Apply { func; args; kind = Indirect; dbg = dbg } ->
let callee = subst_var env func in
Ugeneric_apply (check_closure callee (Flambda.Expr (Var func)),
Ugeneric_apply (check_closure t callee (Flambda.Expr (Var func)),
subst_vars env args, dbg)
| Switch (arg, sw) ->
let aux () : Clambda.ulambda =
@ -368,15 +381,15 @@ and to_clambda_named t env var (named : Flambda.named) : Clambda.ulambda =
a [Uoffset] construction in the event that the offset is zero, otherwise
we might break pattern matches in Cmmgen (in particular for the
compilation of "let rec"). *)
check_closure (
check_closure t (
build_uoffset
(check_closure (subst_var env set_of_closures)
(check_closure t (subst_var env set_of_closures)
(Flambda.Expr (Var set_of_closures)))
(get_fun_offset t closure_id))
named
| Move_within_set_of_closures { closure; start_from; move_to } ->
check_closure (build_uoffset
(check_closure (subst_var env closure)
check_closure t (build_uoffset
(check_closure t (subst_var env closure)
(Flambda.Expr (Var closure)))
((get_fun_offset t move_to) - (get_fun_offset t start_from)))
named
@ -386,13 +399,14 @@ and to_clambda_named t env var (named : Flambda.named) : Clambda.ulambda =
let var_offset = get_fv_offset t var in
let pos = var_offset - fun_offset in
Uprim (Pfield pos,
[check_field (check_closure ulam (Expr (Var closure))) pos (Some named)],
[check_field t (check_closure t ulam (Expr (Var closure)))
pos (Some named)],
Debuginfo.none)
| Prim (Pfield index, [block], dbg) ->
Uprim (Pfield index, [check_field (subst_var env block) index None], dbg)
Uprim (Pfield index, [check_field t (subst_var env block) index None], dbg)
| Prim (Psetfield (index, maybe_ptr, init), [block; new_value], dbg) ->
Uprim (Psetfield (index, maybe_ptr, init), [
check_field (subst_var env block) index None;
check_field t (subst_var env block) index None;
subst_var env new_value;
], dbg)
| Prim (Popaque, args, dbg) ->
@ -569,11 +583,15 @@ and to_clambda_closed_set_of_closures t env symbol
env, id :: params)
function_decl.params (env, [])
in
let body =
Un_anf.apply ~ppf_dump:t.ppf_dump ~what:symbol
(to_clambda t env_body function_decl.body)
in
{ label = Compilenv.function_label (Closure_id.wrap id);
arity = Flambda_utils.function_arity function_decl;
params = List.map (fun var -> VP.create var, Lambda.Pgenval) params;
return = Lambda.Pgenval;
body = to_clambda t env_body function_decl.body;
body;
dbg = function_decl.dbg;
env = None;
}
@ -698,7 +716,7 @@ type result = {
exported : Export_info.t;
}
let convert (program, exported_transient) : result =
let convert ~ppf_dump (program, exported_transient) : result =
let current_unit =
let closures =
Closure_id.Map.keys (Flambda_utils.make_closure_map program)
@ -733,10 +751,20 @@ let convert (program, exported_transient) : result =
closures;
}
in
let t = { current_unit; imported_units; } in
let t =
{ current_unit;
imported_units;
constants_for_instrumentation = Symbol.Map.empty;
ppf_dump;
}
in
let expr, structured_constants, preallocated_blocks =
to_clambda_program t Env.empty Symbol.Map.empty program
in
let structured_constants =
Symbol.Map.disjoint_union structured_constants
t.constants_for_instrumentation
in
let exported =
Export_info.t_of_transient exported_transient
~program

5
middle_end/flambda/flambda_to_clambda.mli
View File

@ -35,4 +35,7 @@ type result = {
For direct calls, the hidden closure parameter is added. Switch
tables are also built.
*)
val convert : Flambda.program * Export_info.transient -> result
val convert
: ppf_dump:Format.formatter
-> Flambda.program * Export_info.transient
-> result

6
middle_end/flambda/un_anf.ml
View File

@ -799,7 +799,7 @@ and un_anf_list var_info env clams : Clambda.ulambda list =
and un_anf_array var_info env clams : Clambda.ulambda array =
Array.map (un_anf var_info env) clams
let apply ~ppf_dump clam ~what =
let apply ~what ~ppf_dump clam =
let var_info = make_var_info clam in
let let_bound_vars_that_can_be_moved =
let_bound_vars_that_can_be_moved var_info clam
@ -812,6 +812,8 @@ let apply ~ppf_dump clam ~what =
let clam = un_anf var_info V.Map.empty clam in
if !Clflags.dump_clambda then begin
Format.fprintf ppf_dump
"@.un-anf (%s):@ %a@." what Printclambda.clambda clam
"@.un-anf (%a):@ %a@."
Symbol.print what
Printclambda.clambda clam
end;
clam

4
middle_end/flambda/un_anf.mli
View File

@ -17,7 +17,7 @@
(** Expand ANF-like constructs so that pattern matches in [Cmmgen] will
work correctly. *)
val apply
: ppf_dump:Format.formatter
: what:Symbol.t
-> ppf_dump:Format.formatter
-> Clambda.ulambda
-> what:string
-> Clambda.ulambda

31
toplevel/opttoploop.ml
View File

@ -248,19 +248,24 @@ let load_lambda ppf ~module_ident ~required_globals lam size =
if !Clflags.keep_asm_file then !phrase_name ^ ext_dll
else Filename.temp_file ("caml" ^ !phrase_name) ext_dll
in
let fn = Filename.chop_extension dll in
if not Config.flambda then
Asmgen.compile_implementation_clambda
~toplevel:need_symbol fn ~backend ~ppf_dump:ppf
{ Lambda.code=slam ; main_module_block_size=size;
module_ident; required_globals }
else
Asmgen.compile_implementation_flambda
~required_globals ~backend ~toplevel:need_symbol fn ~ppf_dump:ppf
(Flambda_middle_end.middle_end ~ppf_dump:ppf ~prefixname:"" ~backend ~size
~module_ident ~module_initializer:slam ~filename:"toplevel");
Asmlink.call_linker_shared [fn ^ ext_obj] dll;
Sys.remove (fn ^ ext_obj);
let filename = Filename.chop_extension dll in
let program =
{ Lambda.
code = slam;
main_module_block_size = size;
module_ident;
required_globals;
}
in
let middle_end =
if Config.flambda then Flambda_middle_end.lambda_to_clambda
else Closure_middle_end.lambda_to_clambda
in
Asmgen.compile_implementation ~toplevel:need_symbol
~backend ~filename ~prefixname:""
~middle_end ~ppf_dump:ppf program;
Asmlink.call_linker_shared [filename ^ ext_obj] dll;
Sys.remove (filename ^ ext_obj);
let dll =
if Filename.is_implicit dll

3
typing/primitive.ml
View File

@ -200,6 +200,9 @@ let native_name p =
let byte_name p =
p.prim_name
let native_name_is_external p =
p.prim_native_name <> "" && p.prim_native_name.[0] <> '%'
let report_error ppf err =
match err with
| Old_style_float_with_native_repr_attribute ->

5
typing/primitive.mli
View File

@ -63,6 +63,11 @@ val print
val native_name: description -> string
val byte_name: description -> string
(** [native_name_is_externa] returns [true] iff the [native_name] for the
given primitive identifies that the primitive is not implemented in the
compiler itself. *)
val native_name_is_external : description -> bool
type error =
| Old_style_float_with_native_repr_attribute
| Old_style_noalloc_with_noalloc_attribute