Support mergeable sections for fixed-size literals

On platforms that support them (ELF, macOS), use mergeable sections
(like `.rodata.cst8`) for 4-, 8- and 16-byte wide literals.

Works only if the LITERAL section is the default one.  If the user
provided their own LITERAL section, all literals are put in it
regardless of their sizes.

Support for mergeable string sections is introduced in this commit too
but needs further changes in C2C.ml .

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";