aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--aarch64/TargetPrinter.ml57
-rw-r--r--arm/TargetPrinter.ml13
-rw-r--r--backend/JsonAST.ml9
-rw-r--r--backend/PrintAsm.ml7
-rw-r--r--backend/PrintAsmaux.ml27
-rw-r--r--cfrontend/C2C.ml4
-rw-r--r--common/Sections.ml25
-rw-r--r--common/Sections.mli7
-rw-r--r--powerpc/TargetPrinter.ml27
-rw-r--r--riscV/TargetPrinter.ml51
-rw-r--r--x86/TargetPrinter.ml41
11 files changed, 145 insertions, 123 deletions
diff --git a/aarch64/TargetPrinter.ml b/aarch64/TargetPrinter.ml
index a9d47bdd..ce6c51fc 100644
--- a/aarch64/TargetPrinter.ml
+++ b/aarch64/TargetPrinter.ml
@@ -165,8 +165,10 @@ module ELF_System : SYSTEM =
variable_section ~sec:".data" ~bss:".bss" i
| Section_const i | Section_small_const i ->
variable_section ~sec:".section .rodata" i
- | Section_string -> ".section .rodata"
- | Section_literal -> ".section .rodata"
+ | Section_string sz ->
+ elf_mergeable_string_section sz ".section .rodata"
+ | Section_literal sz ->
+ elf_mergeable_literal_section sz ".section .rodata"
| Section_jumptable -> ".section .rodata"
| Section_debug_info _ -> ".section .debug_info,\"\",%progbits"
| Section_debug_loc -> ".section .debug_loc,\"\",%progbits"
@@ -227,8 +229,10 @@ module MacOS_System : SYSTEM =
variable_section ~sec:".data" i
| Section_const i | Section_small_const i ->
variable_section ~sec:".const" ~reloc:".const_data" i
- | Section_string -> ".const"
- | Section_literal -> ".const"
+ | Section_string sz ->
+ macos_mergeable_string_section sz
+ | Section_literal sz ->
+ macos_mergeable_literal_section sz
| Section_jumptable -> ".text"
| Section_user(s, wr, ex) ->
sprintf ".section \"%s\", %s, %s"
@@ -273,25 +277,21 @@ module Target(System: SYSTEM): TARGET =
(* Associate labels to floating-point constants and to symbols. *)
let emit_constants oc lit =
- if exists_constants () then begin
- section oc lit;
- if Hashtbl.length literal64_labels > 0 then
- begin
- fprintf oc " .balign 8\n";
- Hashtbl.iter
- (fun bf lbl -> fprintf oc "%a: .quad 0x%Lx\n" label lbl bf)
- literal64_labels
- end;
- if Hashtbl.length literal32_labels > 0 then
- begin
- fprintf oc " .balign 4\n";
- Hashtbl.iter
- (fun bf lbl ->
- fprintf oc "%a: .long 0x%lx\n" label lbl bf)
- literal32_labels
- end;
- reset_literals ()
- end
+ if Hashtbl.length literal64_labels > 0 then begin
+ section oc (Sections.with_size 8 lit);
+ fprintf oc " .balign 8\n";
+ Hashtbl.iter
+ (fun bf lbl -> fprintf oc "%a: .quad 0x%Lx\n" label lbl bf)
+ literal64_labels
+ end;
+ if Hashtbl.length literal32_labels > 0 then begin
+ section oc (Sections.with_size 4 lit);
+ fprintf oc " .balign 4\n";
+ Hashtbl.iter
+ (fun bf lbl -> fprintf oc "%a: .long 0x%lx\n" label lbl bf)
+ literal32_labels
+ end;
+ reset_literals ()
(* Emit .file / .loc debugging directives *)
@@ -644,17 +644,10 @@ module Target(System: SYSTEM): TARGET =
assert false
end
- let get_section_names name =
- let (text, lit) =
- match C2C.atom_sections name with
- | t :: l :: _ -> (t, l)
- | _ -> (Section_text, Section_literal) in
- text,lit,Section_jumptable
-
let print_align oc alignment =
fprintf oc " .balign %d\n" alignment
- let print_jumptable oc jmptbl =
+ let print_jumptable oc _jmptbl =
let print_tbl oc (lbl, tbl) =
fprintf oc "%a:\n" label lbl;
List.iter
@@ -663,7 +656,7 @@ module Target(System: SYSTEM): TARGET =
tbl in
if !jumptables <> [] then
begin
- section oc jmptbl;
+ section oc Section_jumptable;
fprintf oc " .balign 4\n";
List.iter (print_tbl oc) !jumptables;
jumptables := []
diff --git a/arm/TargetPrinter.ml b/arm/TargetPrinter.ml
index 43dac44a..57359f11 100644
--- a/arm/TargetPrinter.ml
+++ b/arm/TargetPrinter.ml
@@ -151,8 +151,8 @@ struct
variable_section ~sec:".data" ~bss:".bss" i
| Section_const i | Section_small_const i ->
variable_section ~sec:".section .rodata" i
- | Section_string -> ".section .rodata"
- | Section_literal -> ".text"
+ | Section_string _ -> ".section .rodata"
+ | Section_literal _ -> ".text"
| Section_jumptable -> ".text"
| Section_user(s, wr, ex) ->
sprintf ".section \"%s\",\"a%s%s\",%%progbits"
@@ -529,13 +529,6 @@ struct
ireg r1 print_label lbl comment symbol_offset (id, ofs)
- let get_section_names name =
- let (text, lit) =
- match C2C.atom_sections name with
- | t :: l :: _ -> (t, l)
- | _ -> (Section_text, Section_literal) in
- text,lit,Section_jumptable
-
let print_align oc alignment =
fprintf oc " .balign %d\n" alignment
@@ -572,7 +565,7 @@ struct
let emit_constants oc lit =
if not !Constantexpand.literals_in_code && exists_constants () then begin
- section oc lit;
+ section oc (Sections.with_size 8 lit);
fprintf oc " .balign 4\n";
Hashtbl.iter (print_literal64 oc) literal64_labels;
end;
diff --git a/backend/JsonAST.ml b/backend/JsonAST.ml
index 8ab874b1..c79fbde8 100644
--- a/backend/JsonAST.ml
+++ b/backend/JsonAST.ml
@@ -35,6 +35,11 @@ let pp_section pp sec =
pp_jobject_start pp;
pp_jmember ~first:true pp "Section Name" pp_jstring name;
pp_jmember pp "Init" pp_init init;
+ pp_jobject_end pp
+ and pp_complex_int name sz =
+ pp_jobject_start pp;
+ pp_jmember ~first:true pp "Section Name" pp_jstring name;
+ pp_jmember pp "Size" pp_jint sz;
pp_jobject_end pp in
match sec with
@@ -43,8 +48,8 @@ let pp_section pp sec =
| Section_small_data init -> pp_complex "Small Data" init
| Section_const init -> pp_complex "Const" init
| Section_small_const init -> pp_complex "Small Const" init
- | Section_string -> pp_simple "String"
- | Section_literal -> pp_simple "Literal"
+ | Section_string sz -> pp_complex_int "String" sz
+ | Section_literal sz -> pp_complex_int "Literal" sz
| Section_jumptable -> pp_simple "Jumptable"
| Section_user (s,w,e) ->
pp_jobject_start pp;
diff --git a/backend/PrintAsm.ml b/backend/PrintAsm.ml
index 22df68ae..6d1fafd6 100644
--- a/backend/PrintAsm.ml
+++ b/backend/PrintAsm.ml
@@ -37,10 +37,15 @@ module Printer(Target:TARGET) =
let print_location oc loc =
if loc <> Cutil.no_loc then Target.print_file_line oc (fst loc) (snd loc)
+ let get_section_names name =
+ match C2C.atom_sections name with
+ | [t;l;j] -> (t, l, j)
+ | _ -> (Section_text, Section_literal 0, Section_jumptable)
+
let print_function oc name fn =
Hashtbl.clear current_function_labels;
Debug.symbol_printed (extern_atom name);
- let (text, lit, jmptbl) = Target.get_section_names name in
+ let (text, lit, jmptbl) = get_section_names name in
Target.section oc text;
let alignment =
match !Clflags.option_falignfunctions with Some n -> n | None -> Target.default_falignment in
diff --git a/backend/PrintAsmaux.ml b/backend/PrintAsmaux.ml
index e39ba8aa..841f4579 100644
--- a/backend/PrintAsmaux.ml
+++ b/backend/PrintAsmaux.ml
@@ -28,7 +28,6 @@ module type TARGET =
val print_comm_symb: out_channel -> Z.t -> P.t -> int -> unit
val print_var_info: out_channel -> P.t -> unit
val print_fun_info: out_channel -> P.t -> unit
- val get_section_names: P.t -> section_name * section_name * section_name
val print_file_line: out_channel -> string -> int -> unit
val print_optional_fun_info: out_channel -> unit
val cfi_startproc: out_channel -> unit
@@ -328,3 +327,29 @@ let variable_section ~sec ?bss ?reloc ?(common = !Clflags.option_fcommon) i =
| Init -> sec
| Init_reloc ->
begin match reloc with Some s -> s | None -> sec end
+
+(** ELF and macOS mergeable section names for literals and strings. *)
+
+let elf_mergeable_literal_section sz sec =
+ match sz with
+ | 0 -> sec
+ | 4 | 8 | 16 -> sprintf "%s.cst%d,\"aM\",@progbits,%d" sec sz sz
+ | _ -> assert false
+
+let elf_mergeable_string_section sz sec =
+ match sz with
+ | 0 -> sec
+ | 1 | 2 | 4 -> sprintf "%s.str%d.%d,\"aMS\",@progbits,%d" sec sz sz sz
+ | _ -> assert false
+
+let macos_mergeable_literal_section sz =
+ match sz with
+ | 0 -> ".const"
+ | 4 | 8 | 16 -> sprintf ".literal%d" sz
+ | _ -> assert false
+
+let macos_mergeable_string_section sz =
+ match sz with
+ | 0 | 2 | 4 -> ".const"
+ | 1 -> ".cstring"
+ | _ -> assert false
diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml
index 7c6a4994..17c0a5cd 100644
--- a/cfrontend/C2C.ml
+++ b/cfrontend/C2C.ml
@@ -304,7 +304,7 @@ let name_for_string_literal s =
{ a_storage = C.Storage_static;
a_alignment = Some 1;
a_size = Some (Int64.of_int (String.length s + 1));
- a_sections = [Sections.for_stringlit()];
+ a_sections = [Sections.for_stringlit 0];
a_access = Sections.Access_default;
a_inline = No_specifier;
a_loc = Cutil.no_loc };
@@ -337,7 +337,7 @@ let name_for_wide_string_literal s =
a_alignment = Some wchar_size;
a_size = Some (Int64.(mul (of_int (List.length s + 1))
(of_int wchar_size)));
- a_sections = [Sections.for_stringlit()];
+ a_sections = [Sections.for_stringlit 0];
a_access = Sections.Access_default;
a_inline = No_specifier;
a_loc = Cutil.no_loc };
diff --git a/common/Sections.ml b/common/Sections.ml
index 794b8470..32e43b17 100644
--- a/common/Sections.ml
+++ b/common/Sections.ml
@@ -27,8 +27,8 @@ type section_name =
| Section_small_data of initialized
| Section_const of initialized
| Section_small_const of initialized
- | Section_string
- | Section_literal
+ | Section_string of int (* character size; zero if unknown *)
+ | Section_literal of int (* literal size; zero if unknown *)
| Section_jumptable
| Section_user of string * bool (*writable*) * bool (*executable*)
| Section_debug_abbrev
@@ -39,6 +39,11 @@ type section_name =
| Section_debug_str
| Section_ais_annotation
+let with_size sz = function
+ | Section_string prev -> assert (prev = 0); Section_string sz
+ | Section_literal prev -> assert (prev = 0); Section_literal sz
+ | sec -> sec
+
type access_mode =
| Access_default
| Access_near
@@ -96,15 +101,15 @@ let builtin_sections = [
sec_writable = false; sec_executable = false;
sec_access = Access_near};
"STRING",
- {sec_name_init = Section_string;
- sec_name_init_reloc = Section_string;
- sec_name_uninit = Section_string;
+ {sec_name_init = Section_string 0;
+ sec_name_init_reloc = Section_string 0;
+ sec_name_uninit = Section_string 0;
sec_writable = false; sec_executable = false;
sec_access = Access_default};
"LITERAL",
- {sec_name_init = Section_literal;
- sec_name_init_reloc = Section_literal;
- sec_name_uninit = Section_literal;
+ {sec_name_init = Section_literal 0;
+ sec_name_init_reloc = Section_literal 0;
+ sec_name_uninit = Section_literal 0;
sec_writable = false; sec_executable = false;
sec_access = Access_default};
"JUMPTABLE",
@@ -258,10 +263,10 @@ let for_function env loc id attr =
(* Determine section for a string literal *)
-let for_stringlit() =
+let for_stringlit sz =
let si =
try
Hashtbl.find current_section_table "STRING"
with Not_found ->
assert false in
- si.sec_name_init
+ with_size sz (si.sec_name_init)
diff --git a/common/Sections.mli b/common/Sections.mli
index 8ec98e40..33fdeab8 100644
--- a/common/Sections.mli
+++ b/common/Sections.mli
@@ -28,8 +28,8 @@ type section_name =
| Section_small_data of initialized
| Section_const of initialized
| Section_small_const of initialized
- | Section_string
- | Section_literal
+ | Section_string of int (* character size; zero if unknown *)
+ | Section_literal of int (* literal size; zero if unknown *)
| Section_jumptable
| Section_user of string * bool (*writable*) * bool (*executable*)
| Section_debug_abbrev
@@ -55,4 +55,5 @@ val use_section_for: AST.ident -> string -> bool
val for_variable: Env.t -> C.location -> AST.ident -> C.typ -> initialized ->
section_name * access_mode
val for_function: Env.t -> C.location -> AST.ident -> C.attributes -> section_name list
-val for_stringlit: unit -> section_name
+val for_stringlit: int -> section_name
+val with_size: int -> section_name -> section_name
diff --git a/powerpc/TargetPrinter.ml b/powerpc/TargetPrinter.ml
index 5c414b56..567b0598 100644
--- a/powerpc/TargetPrinter.ml
+++ b/powerpc/TargetPrinter.ml
@@ -128,8 +128,10 @@ module Linux_System : SYSTEM =
variable_section ~sec:".rodata" i
| Section_small_const i ->
variable_section ~sec:".section .sdata2,\"a\",@progbits" i
- | Section_string -> ".rodata"
- | Section_literal -> ".section .rodata"
+ | Section_string sz ->
+ elf_mergeable_string_section sz ".section .rodata"
+ | Section_literal sz ->
+ elf_mergeable_literal_section sz ".section .rodata"
| Section_jumptable -> ".text"
| Section_user(s, wr, ex) ->
sprintf ".section \"%s\",\"a%s%s\",@progbits"
@@ -218,8 +220,8 @@ module Diab_System : SYSTEM =
variable_section ~sec:".sdata" ~bss:".sbss" ~common:false i
| Section_const _ -> ".text"
| Section_small_const _ -> ".sdata2"
- | Section_string -> ".text"
- | Section_literal -> ".text"
+ | Section_string _ -> ".text"
+ | Section_literal _ -> ".text"
| Section_jumptable -> ".text"
| Section_user(s, wr, ex) ->
sprintf ".section \"%s\",,%c"
@@ -919,21 +921,20 @@ module Target (System : SYSTEM):TARGET =
let print_fun_info = elf_print_fun_info
let emit_constants oc lit =
- if exists_constants () then begin
- section oc lit;
+ if Hashtbl.length literal64_labels > 0 then begin
+ section oc (Sections.with_size 8 lit);
fprintf oc " .balign 8\n";
- Hashtbl.iter (print_literal64 oc) literal64_labels;
- Hashtbl.iter (print_literal32 oc) literal32_labels;
+ Hashtbl.iter (print_literal64 oc) literal64_labels
+ end;
+ if Hashtbl.length literal32_labels > 0 then begin
+ section oc (Sections.with_size 4 lit);
+ fprintf oc " .balign 4\n";
+ Hashtbl.iter (print_literal32 oc) literal32_labels
end;
reset_literals ()
let print_optional_fun_info _ = ()
- let get_section_names name =
- match C2C.atom_sections name with
- | [t;l;j] -> (t, l, j)
- | _ -> (Section_text, Section_literal, Section_jumptable)
-
let print_var_info = elf_print_var_info
let print_comm_symb oc sz name align =
diff --git a/riscV/TargetPrinter.ml b/riscV/TargetPrinter.ml
index 366dc02e..f86664e9 100644
--- a/riscV/TargetPrinter.ml
+++ b/riscV/TargetPrinter.ml
@@ -111,8 +111,10 @@ module Target : TARGET =
variable_section ~sec:".data" ~bss:".bss" i
| Section_const i | Section_small_const i ->
variable_section ~sec:".section .rodata" i
- | Section_string -> ".section .rodata"
- | Section_literal -> ".section .rodata"
+ | Section_string sz ->
+ elf_mergeable_string_section sz ".section .rodata"
+ | Section_literal sz ->
+ elf_mergeable_literal_section sz ".section .rodata"
| Section_jumptable -> ".section .rodata"
| Section_debug_info _ -> ".section .debug_info,\"\",%progbits"
| Section_debug_loc -> ".section .debug_loc,\"\",%progbits"
@@ -131,25 +133,21 @@ module Target : TARGET =
(* Associate labels to floating-point constants and to symbols. *)
let emit_constants oc lit =
- if exists_constants () then begin
- section oc lit;
- if Hashtbl.length literal64_labels > 0 then
- begin
- fprintf oc " .align 3\n";
- Hashtbl.iter
- (fun bf lbl -> fprintf oc "%a: .quad 0x%Lx\n" label lbl bf)
- literal64_labels
- end;
- if Hashtbl.length literal32_labels > 0 then
- begin
- fprintf oc " .align 2\n";
- Hashtbl.iter
- (fun bf lbl ->
- fprintf oc "%a: .long 0x%lx\n" label lbl bf)
- literal32_labels
- end;
- reset_literals ()
- end
+ if Hashtbl.length literal64_labels > 0 then begin
+ section oc (Sections.with_size 8 lit);
+ fprintf oc " .align 3\n";
+ Hashtbl.iter
+ (fun bf lbl -> fprintf oc "%a: .quad 0x%Lx\n" label lbl bf)
+ literal64_labels
+ end;
+ if Hashtbl.length literal32_labels > 0 then begin
+ section oc (Sections.with_size 4 lit);
+ fprintf oc " .align 2\n";
+ Hashtbl.iter
+ (fun bf lbl -> fprintf oc "%a: .long 0x%lx\n" label lbl bf)
+ literal32_labels
+ end;
+ reset_literals ()
(* Generate code to load the address of id + ofs in register r *)
@@ -590,17 +588,10 @@ module Target : TARGET =
assert false
end
- let get_section_names name =
- let (text, lit) =
- match C2C.atom_sections name with
- | t :: l :: _ -> (t, l)
- | _ -> (Section_text, Section_literal) in
- text,lit,Section_jumptable
-
let print_align oc alignment =
fprintf oc " .balign %d\n" alignment
- let print_jumptable oc jmptbl =
+ let print_jumptable oc _jmptbl =
let print_tbl oc (lbl, tbl) =
fprintf oc "%a:\n" label lbl;
List.iter
@@ -609,7 +600,7 @@ module Target : TARGET =
tbl in
if !jumptables <> [] then
begin
- section oc jmptbl;
+ section oc Section_jumptable;
fprintf oc " .balign 4\n";
List.iter (print_tbl oc) !jumptables;
jumptables := []
diff --git a/x86/TargetPrinter.ml b/x86/TargetPrinter.ml
index 65e44f7d..9b7490f7 100644
--- a/x86/TargetPrinter.ml
+++ b/x86/TargetPrinter.ml
@@ -138,8 +138,10 @@ module ELF_System : SYSTEM =
variable_section ~sec:".data" ~bss:".bss" i
| Section_const i | Section_small_const i ->
variable_section ~sec:".section .rodata" i
- | Section_string -> ".section .rodata"
- | Section_literal -> ".section .rodata"
+ | Section_string sz ->
+ elf_mergeable_string_section sz ".section .rodata"
+ | Section_literal sz ->
+ elf_mergeable_literal_section sz ".section .rodata"
| Section_jumptable -> ".text"
| Section_user(s, wr, ex) ->
sprintf ".section \"%s\",\"a%s%s\",@progbits"
@@ -200,8 +202,10 @@ module MacOS_System : SYSTEM =
variable_section ~sec:".data" i
| Section_const i | Section_small_const i ->
variable_section ~sec:".const" ~reloc:".const_data" i
- | Section_string -> ".const"
- | Section_literal -> ".const"
+ | Section_string sz ->
+ macos_mergeable_string_section sz
+ | Section_literal sz ->
+ macos_mergeable_literal_section sz
| Section_jumptable -> ".text"
| Section_user(s, wr, ex) ->
sprintf ".section \"%s\", %s, %s"
@@ -265,8 +269,8 @@ module Cygwin_System : SYSTEM =
variable_section ~sec:".data" ~bss:".bss" i
| Section_const i | Section_small_const i ->
variable_section ~sec:".section .rdata,\"dr\"" i
- | Section_string -> ".section .rdata,\"dr\""
- | Section_literal -> ".section .rdata,\"dr\""
+ | Section_string _ -> ".section .rdata,\"dr\""
+ | Section_literal _ -> ".section .rdata,\"dr\""
| Section_jumptable -> ".text"
| Section_user(s, wr, ex) ->
sprintf ".section %s, \"%s\"\n"
@@ -887,13 +891,17 @@ module Target(System: SYSTEM):TARGET =
let name_of_section = name_of_section
let emit_constants oc lit =
- if exists_constants () then begin
- section oc lit;
- print_align oc 8;
- Hashtbl.iter (print_literal64 oc) literal64_labels;
- Hashtbl.iter (print_literal32 oc) literal32_labels;
- reset_literals ()
- end
+ if Hashtbl.length literal64_labels > 0 then begin
+ section oc (Sections.with_size 8 lit);
+ print_align oc 8;
+ Hashtbl.iter (print_literal64 oc) literal64_labels
+ end;
+ if Hashtbl.length literal32_labels > 0 then begin
+ section oc (Sections.with_size 4 lit);
+ print_align oc 4;
+ Hashtbl.iter (print_literal32 oc) literal32_labels
+ end;
+ reset_literals ()
let cfi_startproc = cfi_startproc
let cfi_endproc = cfi_endproc
@@ -904,11 +912,6 @@ module Target(System: SYSTEM):TARGET =
let print_optional_fun_info _ = ()
- let get_section_names name =
- match C2C.atom_sections name with
- | [t;l;j] -> (t, l, j)
- | _ -> (Section_text, Section_literal, Section_jumptable)
-
let print_fun_info = print_fun_info
let print_var_info = print_var_info
@@ -922,7 +925,7 @@ module Target(System: SYSTEM):TARGET =
let print_epilogue oc =
if !need_masks then begin
- section oc Section_literal;
+ section oc (Section_literal 16);
print_align oc 16;
fprintf oc "%a: .quad 0x8000000000000000, 0\n"
raw_symbol "__negd_mask";
generated by cgit (git 2.34.1) at 2024-05-20 11:19:29 +0000