Emit each function in a separate section (amd64,i386,arm,arm64)

Add --enable-function-sections option to configure. With this option,
the compiler will emit each function in a separate named text section,
on supported targets. This enables function reordering using a linker
script. With this option, the compiler also emits caml_hot__code_begin
and caml_hot__code_end sections. This allows a linker script to
move function sections outside of the segments they belong to,
without breaking caml_code_segments.
master
Greta Yorsh 2019-02-20 18:46:43 +00:00
parent 6582335689
commit 27a92a9445
18 changed files with 332 additions and 20 deletions

View File

@ -231,6 +231,7 @@ WINDOWS_UNICODE=@windows_unicode@
AFL_INSTRUMENT=@afl@
MAX_TESTSUITE_DIR_RETRIES=@max_testsuite_dir_retries@
FLAT_FLOAT_ARRAY=@flat_float_array@
FUNCTION_SECTIONS=@function_sections@
AWK=@AWK@

View File

@ -478,6 +478,26 @@ let emit_global_label s =
D.global lbl;
_label lbl
(* Output .text section directive, or named .text.<name> if enabled and
supported on the target system. *)
let emit_named_text_section func_name =
if Config.function_sections then
begin match system with
| S_macosx
(* Names of section segments in macosx are restricted to 16 characters,
but function names are often longer, especially anonymous functions. *)
| S_win64 | S_mingw64 | S_cygwin
(* Win systems provide named text sections, but configure on these
systems does not support function sections. *)
-> assert false
| _ -> D.section
[ ".text."^(emit_symbol func_name) ]
(Some "ax")
["@progbits"]
end
else D.text ()
(* Output the assembly code for an instruction *)
(* Name of current function *)
@ -852,7 +872,7 @@ let emit_instr fallthrough i =
D.long (ConstSub (ConstLabel(emit_label jumptbl.(i)),
ConstLabel lbl))
done;
D.text ()
emit_named_text_section !function_name
| Lentertrap ->
()
| Ladjust_trap_depth { delta_traps; } ->
@ -915,7 +935,7 @@ let fundecl fundecl =
bound_error_sites := [];
bound_error_call := 0;
all_functions := fundecl :: !all_functions;
D.text ();
emit_named_text_section !function_name;
D.align 16;
add_def_symbol fundecl.fun_name;
if system = S_macosx
@ -1017,7 +1037,7 @@ let begin_assembly() =
D.data ();
emit_global_label "data_begin";
D.text ();
emit_named_text_section (Compilenv.make_symbol (Some "code_begin"));
emit_global_label "code_begin";
if system = S_macosx then I.nop (); (* PR#4690 *)
()
@ -1067,7 +1087,7 @@ let end_assembly() =
List.iter (fun (cst,lbl) -> emit_float_constant cst lbl) !float_constants
end;
D.text ();
emit_named_text_section (Compilenv.make_symbol (Some "code_end"));
if system = S_macosx then I.nop ();
(* suppress "ld warning: atom sorting error" *)

View File

@ -435,6 +435,16 @@ let emit_load_handler_address handler =
` add lr, pc, lr\n`;
2
(* Output .text section directive, or named .text.<name> if enabled. *)
let emit_named_text_section func_name =
if Config.function_sections then begin
` .text.{emit_symbol func_name},{emit_string_literal "ax"},{emit_string_literal "%progbits"}\n`
end
else
` .text\n`
(* Output the assembly code for an instruction *)
let emit_instr i =
@ -947,7 +957,7 @@ let fundecl fundecl =
stack_offset := 0;
call_gc_sites := [];
bound_error_sites := [];
` .text\n`;
emit_named_text_section !function_name;
` .align 2\n`;
` .globl {emit_symbol fundecl.fun_name}\n`;
if !arch > ARMv6 && !thumb then
@ -1015,13 +1025,13 @@ let begin_assembly() =
` .globl {emit_symbol lbl_begin}\n`;
`{emit_symbol lbl_begin}:\n`;
let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
` .text\n`;
emit_named_text_section lbl_begin;
` .globl {emit_symbol lbl_begin}\n`;
`{emit_symbol lbl_begin}:\n`
let end_assembly () =
let lbl_end = Compilenv.make_symbol (Some "code_end") in
` .text\n`;
emit_named_text_section lbl_end;
` .globl {emit_symbol lbl_end}\n`;
`{emit_symbol lbl_end}:\n`;
let lbl_end = Compilenv.make_symbol (Some "data_end") in

View File

@ -563,6 +563,15 @@ let assembly_code_for_allocation ?label_after_call_gc i ~n ~far =
`{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`
end
(* Output .text section directive, or named .text.<name> if enabled. *)
let emit_named_text_section func_name =
if Config.function_sections then begin
` .text.{emit_symbol func_name},{emit_string_literal "ax"},{emit_string_literal "%progbits"}\n`
end
else
` .text\n`
(* Output the assembly code for an instruction *)
let emit_instr i =
@ -910,7 +919,7 @@ let fundecl fundecl =
stack_offset := 0;
call_gc_sites := [];
bound_error_sites := [];
` .text\n`;
emit_named_text_section !function_name;
` .align 3\n`;
` .globl {emit_symbol fundecl.fun_name}\n`;
` .type {emit_symbol fundecl.fun_name}, %function\n`;
@ -974,13 +983,13 @@ let begin_assembly() =
` .globl {emit_symbol lbl_begin}\n`;
`{emit_symbol lbl_begin}:\n`;
let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
` .text\n`;
emit_named_text_section lbl_begin;
` .globl {emit_symbol lbl_begin}\n`;
`{emit_symbol lbl_begin}:\n`
let end_assembly () =
let lbl_end = Compilenv.make_symbol (Some "code_end") in
` .text\n`;
emit_named_text_section lbl_end;
` .globl {emit_symbol lbl_end}\n`;
`{emit_symbol lbl_end}:\n`;
let lbl_end = Compilenv.make_symbol (Some "data_end") in

View File

@ -240,7 +240,10 @@ let make_startup_file ~ppf_dump units_list ~crc_interfaces =
let globals_map = make_globals_map units_list ~crc_interfaces in
compile_phrase (Cmmgen.globals_map globals_map);
compile_phrase(Cmmgen.data_segment_table ("_startup" :: name_list));
compile_phrase(Cmmgen.code_segment_table ("_startup" :: name_list));
if (Config.function_sections) then
compile_phrase(Cmmgen.code_segment_table ("_hot" :: "_startup" :: name_list))
else
compile_phrase(Cmmgen.code_segment_table ("_startup" :: name_list));
let all_names = "_startup" :: "_system" :: name_list in
compile_phrase (Cmmgen.frame_table all_names);
if Config.spacetime then begin

View File

@ -461,6 +461,16 @@ let emit_global_label s =
D.global lbl;
_label lbl
(* Output .text section directive, or named .text.<name> if enabled. *)
let emit_named_text_section func_name =
if Config.function_sections then
begin match system with
| S_macosx | S_mingw | S_cygwin | S_win32 -> D.text ()
| _ -> D.section [ ".text."^(emit_symbol func_name) ] (Some "ax") ["@progbits"]
end
else D.text ()
(* Output the assembly code for an instruction *)
(* Name of current function *)
@ -843,7 +853,7 @@ let emit_instr fallthrough i =
for i = 0 to Array.length jumptbl - 1 do
D.long (ConstLabel (emit_label jumptbl.(i)))
done;
D.text ()
emit_named_text_section !function_name
| Lentertrap ->
()
| Ladjust_trap_depth { delta_traps } ->
@ -896,7 +906,7 @@ let fundecl fundecl =
call_gc_sites := [];
bound_error_sites := [];
bound_error_call := 0;
D.text ();
emit_named_text_section !function_name;
add_def_symbol fundecl.fun_name;
D.align (if system = S_win32 then 4 else 16);
D.global (emit_symbol fundecl.fun_name);
@ -963,8 +973,7 @@ let begin_assembly() =
D.data ();
emit_global_label "data_begin";
D.text ();
emit_named_text_section (Compilenv.make_symbol (Some "code_begin"));
emit_global_label "code_begin"
let end_assembly() =
@ -973,8 +982,7 @@ let end_assembly() =
List.iter (fun (cst,lbl) -> emit_float_constant cst lbl) !float_constants
end;
D.text ();
emit_named_text_section (Compilenv.make_symbol (Some "code_end"));
emit_global_label "code_end";
D.data ();

60
configure vendored
View File

@ -695,6 +695,7 @@ flexdll_chain
default_safe_string
force_safe_string
afl
function_sections
flat_float_array
windows_unicode
max_testsuite_dir_retries
@ -845,6 +846,7 @@ with_target_bindir
enable_reserved_header_bits
enable_force_safe_string
enable_flat_float_array
enable_function_sections
with_afl
enable_shared
enable_static
@ -1519,6 +1521,9 @@ Optional Features:
force strings to be safe
--disable-flat-float-array
do not use flat float arrays
--enable-function-sections
generate each function in a separate section if
target supports it
--enable-shared[=PKGS] build shared libraries [default=yes]
--enable-static[=PKGS] build static libraries [default=yes]
--enable-fast-install[=PKGS]
@ -2812,6 +2817,7 @@ VERSION=4.10.0+dev0-2019-04-23
## Generated files
@ -3164,6 +3170,12 @@ if test "${enable_flat_float_array+set}" = set; then :
fi
# Check whether --enable-function-sections was given.
if test "${enable_function_sections+set}" = set; then :
enableval=$enable_function_sections;
fi
# Check whether --with-afl was given.
if test "${with_afl+set}" = set; then :
@ -16517,6 +16529,54 @@ else
flat_float_array=true
fi
if test x"$enable_function_sections" = "xyes"; then :
case $arch in #(
amd64|i386|arm|arm64) :
case $target in #(
*-*-cygwin*|*-*-mingw*|*-pc-windows) :
function_sections=false;
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Disabling function sections. No target support." >&5
$as_echo "$as_me: WARNING: Disabling function sections. No target support." >&2;} ;; #(
*) :
case $ocaml_cv_cc_vendor in #(
gcc-0123-*|gcc-4-01234567) :
function_sections=false;
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Disabling function sections.
Not supported in GCC prior to version 4.8." >&5
$as_echo "$as_me: WARNING: Disabling function sections.
Not supported in GCC prior to version 4.8." >&2;} ;; #(
clang-012-*|clang-3-01234) :
function_sections=false;
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Disabling function sections.
Not supported in Clang prior to version 3.5." >&5
$as_echo "$as_me: WARNING: Disabling function sections.
Not supported in Clang prior to version 3.5." >&2;} ;; #(
gcc-*|clang-*) :
function_sections=true;
common_cflags="$common_cflags -ffunction-sections";
$as_echo "#define FUNCTION_SECTIONS 1" >>confdefs.h
;; #(
*) :
function_sections=false;
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Disabling function sections.
Compiler not supported." >&5
$as_echo "$as_me: WARNING: Disabling function sections.
Compiler not supported." >&2;} ;; #(
*) :
;;
esac ;; #(
*) :
;;
esac ;; #(
*) :
function_sections=false
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Disabling function sections on this target." >&5
$as_echo "$as_me: WARNING: Disabling function sections on this target." >&2;} ;;
esac
else
function_sections=false
fi
if test x"$with_afl" = "xyes"; then :
afl=true
else

View File

@ -156,6 +156,7 @@ AC_SUBST([flambda_invariants])
AC_SUBST([max_testsuite_dir_retries])
AC_SUBST([windows_unicode])
AC_SUBST([flat_float_array])
AC_SUBST([function_sections])
AC_SUBST([afl])
AC_SUBST([force_safe_string])
AC_SUBST([default_safe_string])
@ -352,6 +353,10 @@ AC_ARG_ENABLE([flat-float-array],
[AS_HELP_STRING([--disable-flat-float-array],
[do not use flat float arrays])])
AC_ARG_ENABLE([function-sections],
[AS_HELP_STRING([--enable-function-sections],
[generate each function in a separate section if target supports it])])
AC_ARG_WITH([afl],
[AS_HELP_STRING([--with-afl],
[use the AFL fuzzer])])
@ -1613,6 +1618,35 @@ AS_IF([test x"$enable_flat_float_array" = "xno"],
[AC_DEFINE([FLAT_FLOAT_ARRAY])
flat_float_array=true])
AS_IF([test x"$enable_function_sections" = "xyes"],
[AS_CASE([$arch],
[amd64|i386|arm|arm64],
[AS_CASE([$target],
[*-*-cygwin*|*-*-mingw*|*-pc-windows],
[function_sections=false;
AC_MSG_WARN([Disabling function sections. No target support.])],
[*],
[AS_CASE([$ocaml_cv_cc_vendor],
[gcc-[0123]-*|gcc-4-[01234567]],
[function_sections=false;
AC_MSG_WARN([Disabling function sections.
Not supported in GCC prior to version 4.8.])],
[clang-[012]-*|clang-3-[01234]],
[function_sections=false;
AC_MSG_WARN([Disabling function sections.
Not supported in Clang prior to version 3.5.])],
[gcc-*|clang-*],
[function_sections=true;
common_cflags="$common_cflags -ffunction-sections";
AC_DEFINE([FUNCTION_SECTIONS])],
[*],
[function_sections=false;
AC_MSG_WARN([Disabling function sections.
Compiler not supported.])])])],
[function_sections=false
AC_MSG_WARN([Disabling function sections on this target.])])],
[function_sections=false])
AS_IF([test x"$with_afl" = "xyes"],
[afl=true],
[afl=false])

View File

@ -26,6 +26,7 @@
#define G(r) _##r
#define GREL(r) _##r@GOTPCREL
#define GCALL(r) _##r
#define TEXT_SECTION(name) .text
#define FUNCTION_ALIGN 2
#define EIGHT_ALIGN 3
#define SIXTEEN_ALIGN 4
@ -40,10 +41,16 @@
#define G(r) r
#undef GREL
#define GCALL(r) r
#if defined(FUNCTION_SECTIONS)
#define TEXT_SECTION(name) .section .text.##name
#else
#define TEXT_SECTION(name)
#endif
#define FUNCTION_ALIGN 4
#define EIGHT_ALIGN 8
#define SIXTEEN_ALIGN 16
#define FUNCTION(name) \
TEXT_SECTION(name); \
.globl name; \
.align FUNCTION_ALIGN; \
name:
@ -54,10 +61,16 @@
#define G(r) r
#define GREL(r) r@GOTPCREL
#define GCALL(r) r@PLT
#if defined(FUNCTION_SECTIONS)
#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
#else
#define TEXT_SECTION(name)
#endif
#define FUNCTION_ALIGN 4
#define EIGHT_ALIGN 8
#define SIXTEEN_ALIGN 16
#define FUNCTION(name) \
TEXT_SECTION(name); \
.globl name; \
.type name,@function; \
.align FUNCTION_ALIGN; \
@ -287,6 +300,16 @@
#define C_ARG_2 %rsi
#define C_ARG_3 %rdx
#define C_ARG_4 %rcx
#endif
#if defined(FUNCTION_SECTIONS)
TEXT_SECTION(caml_hot__code_begin)
.globl G(caml_hot__code_begin)
G(caml_hot__code_begin):
TEXT_SECTION(caml_hot__code_end)
.globl G(caml_hot__code_end)
G(caml_hot__code_end):
#endif
.text

View File

@ -99,11 +99,27 @@ alloc_limit .req r11
#define CFI_OFFSET(r,n)
#endif
/* Allocation functions and GC interface */
#if defined(FUNCTION_SECTIONS)
#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
#else
#define TEXT_SECTION(name)
#endif
#if defined(FUNCTION_SECTIONS)
TEXT_SECTION(caml_hot__code_begin)
.globl caml_hot__code_begin
caml_hot__code_begin:
TEXT_SECTION(caml_hot__code_end)
.globl caml_hot__code_end
caml_hot__code_end:
#endif
/* Allocation functions and GC interface */
.globl caml_system__code_begin
caml_system__code_begin:
TEXT_SECTION(caml_call_gc)
.align 2
.globl caml_call_gc
caml_call_gc:
@ -154,6 +170,7 @@ caml_call_gc:
.type caml_call_gc, %function
.size caml_call_gc, .-caml_call_gc
TEXT_SECTION(caml_alloc1)
.align 2
.globl caml_alloc1
caml_alloc1:
@ -177,6 +194,7 @@ caml_alloc1:
.type caml_alloc1, %function
.size caml_alloc1, .-caml_alloc1
TEXT_SECTION(caml_alloc2)
.align 2
.globl caml_alloc2
caml_alloc2:
@ -200,6 +218,7 @@ caml_alloc2:
.type caml_alloc2, %function
.size caml_alloc2, .-caml_alloc2
TEXT_SECTION(caml_alloc3)
.align 2
.globl caml_alloc3
.type caml_alloc3, %function
@ -224,6 +243,7 @@ caml_alloc3:
.type caml_alloc3, %function
.size caml_alloc3, .-caml_alloc3
TEXT_SECTION(caml_allocN)
.align 2
.globl caml_allocN
caml_allocN:
@ -251,6 +271,7 @@ caml_allocN:
/* Call a C function from OCaml */
/* Function to call is in r7 */
TEXT_SECTION(caml_c_call)
.align 2
.globl caml_c_call
caml_c_call:
@ -282,6 +303,7 @@ caml_c_call:
/* Start the OCaml program */
TEXT_SECTION(caml_start_program)
.align 2
.globl caml_start_program
caml_start_program:
@ -382,6 +404,7 @@ caml_start_program:
/* Raise an exception from OCaml */
TEXT_SECTION(caml_raise_exn)
.align 2
.globl caml_raise_exn
caml_raise_exn:
@ -409,6 +432,7 @@ caml_raise_exn:
/* Raise an exception from C */
TEXT_SECTION(caml_raise_exception)
.align 2
.globl caml_raise_exception
caml_raise_exception:
@ -444,6 +468,7 @@ caml_raise_exception:
/* Callback from C to OCaml */
TEXT_SECTION(caml_callback_exn)
.align 2
.globl caml_callback_exn
caml_callback_exn:
@ -458,6 +483,7 @@ caml_callback_exn:
.type caml_callback_exn, %function
.size caml_callback_exn, .-caml_callback_exn
TEXT_SECTION(caml_callback2_exn)
.align 2
.globl caml_callback2_exn
caml_callback2_exn:
@ -473,6 +499,7 @@ caml_callback2_exn:
.type caml_callback2_exn, %function
.size caml_callback2_exn, .-caml_callback2_exn
TEXT_SECTION(caml_callback3_exn)
.align 2
.globl caml_callback3_exn
caml_callback3_exn:
@ -490,6 +517,7 @@ caml_callback3_exn:
.type caml_callback3_exn, %function
.size caml_callback3_exn, .-caml_callback3_exn
TEXT_SECTION(caml_ml_array_bound_error)
.align 2
.globl caml_ml_array_bound_error
caml_ml_array_bound_error:

View File

@ -83,11 +83,27 @@
#endif
/* Allocation functions and GC interface */
#if defined(FUNCTION_SECTIONS)
#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
#else
#define TEXT_SECTION(name)
#endif
#if defined(FUNCTION_SECTIONS)
TEXT_SECTION(caml_hot__code_begin)
.globl caml_hot__code_begin
caml_hot__code_begin:
TEXT_SECTION(caml_hot__code_end)
.globl caml_hot__code_end
caml_hot__code_end:
#endif
/* Allocation functions and GC interface */
.globl caml_system__code_begin
caml_system__code_begin:
TEXT_SECTION(caml_call_gc)
.align 2
.globl caml_call_gc
caml_call_gc:
@ -177,6 +193,7 @@ caml_call_gc:
.type caml_call_gc, %function
.size caml_call_gc, .-caml_call_gc
TEXT_SECTION(caml_alloc1)
.align 2
.globl caml_alloc1
caml_alloc1:
@ -239,6 +256,7 @@ caml_alloc2:
.type caml_alloc2, %function
.size caml_alloc2, .-caml_alloc2
TEXT_SECTION(caml_alloc3)
.align 2
.globl caml_alloc3
caml_alloc3:
@ -268,6 +286,7 @@ caml_alloc3:
.type caml_alloc3, %function
.size caml_alloc3, .-caml_alloc3
TEXT_SECTION(caml_allocN)
.align 2
.globl caml_allocN
caml_allocN:
@ -300,6 +319,7 @@ caml_allocN:
/* Call a C function from OCaml */
/* Function to call is in ARG */
TEXT_SECTION(caml_c_call)
.align 2
.globl caml_c_call
caml_c_call:
@ -327,6 +347,7 @@ caml_c_call:
/* Start the OCaml program */
TEXT_SECTION(caml_start_program)
.align 2
.globl caml_start_program
caml_start_program:
@ -423,6 +444,7 @@ caml_start_program:
/* Raise an exception from OCaml */
TEXT_SECTION(caml_raise_exn)
.align 2
.globl caml_raise_exn
caml_raise_exn:
@ -453,6 +475,7 @@ caml_raise_exn:
/* Raise an exception from C */
TEXT_SECTION(caml_raise_exception)
.align 2
.globl caml_raise_exception
caml_raise_exception:
@ -487,6 +510,7 @@ caml_raise_exception:
/* Callback from C to OCaml */
TEXT_SECTION(caml_callback_exn)
.align 2
.globl caml_callback_exn
caml_callback_exn:
@ -501,6 +525,7 @@ caml_callback_exn:
.type caml_callback_exn, %function
.size caml_callback_exn, .-caml_callback_exn
TEXT_SECTION(caml_callback2_exn)
.align 2
.globl caml_callback2_exn
caml_callback2_exn:
@ -516,6 +541,7 @@ caml_callback2_exn:
.type caml_callback2_exn, %function
.size caml_callback2_exn, .-caml_callback2_exn
TEXT_SECTION(caml_callback3_exn)
.align 2
.globl caml_callback3_exn
caml_callback3_exn:
@ -533,6 +559,7 @@ caml_callback3_exn:
.type caml_callback3_exn, %function
.size caml_callback3_exn, .-caml_callback3_exn
TEXT_SECTION(caml_ml_array_bound_error)
.align 2
.globl caml_ml_array_bound_error
caml_ml_array_bound_error:

View File

@ -102,3 +102,5 @@
#undef CAML_SAFE_STRING
#undef FLAT_FLOAT_ARRAY
#undef FUNCTION_SECTIONS

View File

@ -44,7 +44,20 @@
#define FUNCTION_ALIGN 2
#endif
#if defined(FUNCTION_SECTIONS)
#if defined(SYS_macosx)
#define TEXT_SECTION(name) .text
#elif defined(SYS_mingw) || defined(SYS_cygwin)
#define TEXT_SECTION(name) .section .text.##name
#else
#define TEXT_SECTION(name) .section .text.##name,"ax",%progbits
#endif
#else
#define TEXT_SECTION(name)
#endif
#define FUNCTION(name) \
TEXT_SECTION(name); \
.globl G(name); \
.align FUNCTION_ALIGN; \
G(name):
@ -72,8 +85,17 @@
#define ALIGN_STACK(amount) subl $ amount, %esp ; CFI_ADJUST(amount)
#define UNDO_ALIGN_STACK(amount) addl $ amount, %esp ; CFI_ADJUST(-amount)
/* Allocation */
#if defined(FUNCTION_SECTIONS)
TEXT_SECTION(caml_hot__code_begin)
.globl G(caml_hot__code_begin)
G(caml_hot__code_begin):
TEXT_SECTION(caml_hot__code_end)
.globl G(caml_hot__code_end)
G(caml_hot__code_end):
#endif
/* Allocation */
.text
.globl G(caml_system__code_begin)
G(caml_system__code_begin):

View File

@ -0,0 +1,57 @@
(* TEST
* native
*)
(* Test for anonymous functions which result in a mangled symbol *)
let f4 list =
List.map (fun s -> String.length s) list
let test1 () =
f4 ["a";"asfda";"afda"]
(* Test for jump tables*)
let g1 s = s^"*"
let g2 s = "*"^s
let g3 s = "*"^s^"*"
let f5 = function
| 1 -> g1 "a"
| 2 -> g2 "b"
| 3 -> g3 "c"
| 4 -> g1 "d"
| 5 -> g2 "e"
| 6 -> g3 "f"
| _ -> "x"
let test2 () =
let list = [f5 5;
f5 7;
f5 15;
f5 26]
in
ignore list
let iter = 1_000
let f0 x = x - 7;
[@@inline never]
let f1 x = x + iter
[@@inline never]
let f2 x = f1(x)
[@@inline never]
let f3 x = f2(x)*f0(x)
[@@inline never]
let test3 () =
f3 iter
let () =
ignore (test1 ());
ignore (test2 ());
ignore (test3 ());
()

View File

@ -9,3 +9,4 @@ static_float_array_flambda.ml
static_float_array_flambda_opaque.ml
unrolling_flambda2.ml
unrolling_flambda.ml
func_sections.ml

View File

@ -110,6 +110,7 @@ config.ml: config.mlp $(ROOTDIR)/Makefile.config Makefile
$(call SUBST,WITH_SPACETIME) \
$(call SUBST,ENABLE_CALL_COUNTS) \
$(call SUBST,FLAT_FLOAT_ARRAY) \
$(call SUBST,FUNCTION_SECTIONS) \
$(call SUBST,CC_HAS_DEBUG_PREFIX_MAP) \
$(call SUBST,AS_HAS_DEBUG_PREFIX_MAP) \
$< > $@

View File

@ -223,6 +223,10 @@ val flat_float_array : bool
(** Whether the compiler and runtime automagically flatten float
arrays *)
val function_sections : bool
(** Whether the compiler was configured to generate
functions in separate section *)
val windows_unicode: bool
(** Whether Windows Unicode runtime is enabled *)

View File

@ -80,6 +80,7 @@ let supports_shared_libraries = %%SUPPORTS_SHARED_LIBRARIES%%
let flat_float_array = %%FLAT_FLOAT_ARRAY%%
let function_sections = %%FUNCTION_SECTIONS%%
let afl_instrument = %%AFL_INSTRUMENT%%
let exec_magic_number = "Caml1999X025"
@ -195,6 +196,7 @@ let configuration_variables =
p_bool "safe_string" safe_string;
p_bool "default_safe_string" default_safe_string;
p_bool "flat_float_array" flat_float_array;
p_bool "function_sections" function_sections;
p_bool "afl_instrument" afl_instrument;
p_bool "windows_unicode" windows_unicode;
p_bool "supports_shared_libraries" supports_shared_libraries;