new directives on x86

Author: spiessimon

backend/amd64/emit.ml

@@ -771,7 +771,7 @@ let emit_literals p align emit_literal =
       (* CR sspies: The following section is incorrect. We are in a data section
          here. Fix this when cleaning up the section mechanism. *)
       D.unsafe_set_interal_section_ref Text);
-    D.align ~bytes:align;
+    D.align ~data_section:false ~bytes:align;
     List.iter emit_literal !p;
     p := [])
 
@@ -2062,7 +2062,7 @@ let fundecl fundecl =
   contains_calls := fundecl.fun_contains_calls;
   emit_named_text_section !function_name;
   let fun_sym = S.create fundecl.fun_name in
-  D.align ~bytes:8;
+  D.align ~data_section:false ~bytes:8;
   D.global fun_sym;
   D.type_symbol ~ty:Function fun_sym;
   D.define_symbol_label ~section:Text fun_sym;
@@ -2126,11 +2126,11 @@ let emit_item (d : Cmm.data_item) =
     D.symbol_plus_offset ~offset_in_bytes:(Targetint.of_int o) sym
   | Cstring s -> D.string s
   | Cskip n -> if n > 0 then D.space ~bytes:n
-  | Calign n -> D.align ~bytes:n
+  | Calign n -> D.align ~data_section:true ~bytes:n
 
 let data l =
   D.data ();
-  D.align ~bytes:8;
+  D.align ~data_section:true ~bytes:8;
   List.iter emit_item l
 
 let file_emitter ~file_num ~file_name =
@@ -2168,7 +2168,7 @@ let begin_assembly _unix =
   if macosx
   then (
     DSL.ins I.NOP [||];
-    D.align ~bytes:8);
+    D.align ~data_section:false ~bytes:8);
   let code_end = Cmm_helpers.make_symbol "code_end" in
   Emitaux.Dwarf_helpers.begin_dwarf ~code_begin ~code_end ~file_emitter
 
@@ -2186,7 +2186,7 @@ let end_assembly () =
   D.global data_end_sym;
   D.define_symbol_label ~section:Data data_end_sym;
   D.int64 0L;
-  D.align ~bytes:8;
+  D.align ~data_section:true ~bytes:8;
   (* #7887 *)
   let frametable = Cmm_helpers.make_symbol "frametable" in
   let frametable_sym = S.create frametable in
@@ -2215,7 +2215,7 @@ let end_assembly () =
       (* [efa_word] is [D.targetint (Targetint.of_int_exn n)] in
          mshinwell/ocaml#gdb-names-gpr x86 emitter *)
       efa_word = (fun n -> D.targetint (Targetint.of_int_exn n));
-      efa_align = (fun n -> D.align ~bytes:n);
+      efa_align = (fun n -> D.align ~data_section:true ~bytes:n);
       efa_label_rel =
         (fun lbl ofs ->
           let lbl = label_to_asm_label ~section:Data lbl in

backend/arm64/emit.ml

@@ -150,10 +150,15 @@ module Directive = struct
     | Code
     | Machine_width_data
 
+  type reloc_type = R_X86_64_PLT32
+
   type comment = string
 
   type t =
-    | Align of { bytes : int }
+    | Align of
+        { bytes : int;
+          data_section : bool
+        }
     | Bytes of
         { str : string;
           comment : string option
@@ -166,6 +171,9 @@ module Directive = struct
           offset : int
         }
     | Cfi_startproc
+    | Cfi_remember_state
+    | Cfi_restore_state
+    | Cfi_def_cfa_register of string
     | Comment of comment
     | Const of
         { constant : Constant_with_width.t;
@@ -204,6 +212,14 @@ module Directive = struct
           comment : string option
         }
     | Protected of string
+    | Hidden of string
+    | Weak of string
+    | External of string
+    | Reloc of
+        { offset : Constant.t;
+          name : reloc_type;
+          expr : Constant.t
+        }
 
   let bprintf = Printf.bprintf
 
@@ -268,6 +284,8 @@ module Directive = struct
       bprintf buf "\t.ascii\t\"%s\""
         (string_of_string_literal (String.sub s !i (l - !i)))
 
+  let reloc_type_to_string = function R_X86_64_PLT32 -> "R_X86_64_PLT32"
+
   let print_gas buf t =
     let gas_comment_opt comment_opt =
       if not (emit_comments ())
@@ -278,7 +296,9 @@ module Directive = struct
         | Some comment -> Printf.sprintf "\t/* %s */" comment
     in
     match t with
-    | Align { bytes = n } ->
+    | Align { bytes = n; data_section = _ } ->
+      (* The data_section is only relevant for the binary emitter. On GAS, we
+         can ignore it and just use [.align] in both cases. *)
       (* Some assemblers interpret the integer n as a 2^n alignment and others
          as a number of bytes. *)
       let n =
@@ -333,6 +353,9 @@ module Directive = struct
     | Cfi_offset { reg; offset } ->
       bprintf buf "\t.cfi_offset %d, %d" reg offset
     | Cfi_startproc -> bprintf buf "\t.cfi_startproc"
+    | Cfi_remember_state -> bprintf buf "\t.cfi_remember_state"
+    | Cfi_restore_state -> bprintf buf "\t.cfi_restore_state"
+    | Cfi_def_cfa_register reg -> bprintf buf "\t.cfi_def_cfa_register %%%s" reg
     | File { file_num = None; filename } ->
       bprintf buf "\t.file\t\"%s\"" filename
     | File { file_num = Some file_num; filename } ->
@@ -375,6 +398,14 @@ module Directive = struct
         Misc.fatal_error
           "Cannot emit [Direct_assignment] except on macOS-like assemblers")
     | Protected s -> bprintf buf "\t.protected\t%s" s
+    | Hidden s -> bprintf buf "\t.hidden\t%s" s
+    | Weak s -> bprintf buf "\t.weak\t%s" s
+    (* masm only *)
+    | External _ -> assert false
+    | Reloc { offset; name; expr } ->
+      bprintf buf "\t.reloc\t%a, %s, %a" Constant.print offset
+        (reloc_type_to_string name)
+        Constant.print expr
 
   let print_masm buf t =
     let unsupported name =
@@ -389,7 +420,10 @@ module Directive = struct
         | Some comment -> Printf.sprintf "\t; %s" comment
     in
     match t with
-    | Align { bytes } -> bprintf buf "\tALIGN\t%d" bytes
+    | Align { bytes; data_section = _ } ->
+      (* The data_section is only relevant for the binary emitter. On MASM, we
+         can ignore it. *)
+      bprintf buf "\tALIGN\t%d" bytes
     | Bytes { str; comment } ->
       buf_bytes_directive buf ~directive:"BYTE" str;
       bprintf buf "%s" (masm_comment_opt comment)
@@ -422,6 +456,9 @@ module Directive = struct
     | Cfi_endproc -> unsupported "Cfi_endproc"
     | Cfi_offset _ -> unsupported "Cfi_offset"
     | Cfi_startproc -> unsupported "Cfi_startproc"
+    | Cfi_remember_state -> unsupported "Cfi_remember_state"
+    | Cfi_restore_state -> unsupported "Cfi_restore_state"
+    | Cfi_def_cfa_register _ -> unsupported "Cfi_def_cfa_register"
     | File _ -> unsupported "File"
     | Indirect_symbol _ -> unsupported "Indirect_symbol"
     | Loc _ -> unsupported "Loc"
@@ -432,6 +469,11 @@ module Directive = struct
     | Uleb128 _ -> unsupported "Uleb128"
     | Direct_assignment _ -> unsupported "Direct_assignment"
     | Protected _ -> unsupported "Protected"
+    | Hidden _ -> unsupported "Hidden"
+    | Weak _ -> unsupported "Weak"
+    | External s -> bprintf buf "\tEXTRN\t%s: NEAR" s
+    (* The only supported "type" on EXTRN declarations i NEAR. *)
+    | Reloc _ -> unsupported "Reloc"
 
   let print b t =
     match TS.assembler () with
@@ -476,6 +518,13 @@ let const_variable var = Variable var
 
 let const_int64 i : expr = Signed_int i
 
+let const_with_offset const (offset : int64) =
+  if Int64.equal offset 0L
+  then const
+  else if Int64.compare offset 0L < 0
+  then Add (const, Signed_int (Int64.neg offset))
+  else Add (const, Signed_int offset)
+
 let emit_ref = ref None
 
 let emit (d : Directive.t) =
@@ -488,7 +537,7 @@ let emit_non_masm (d : Directive.t) =
 
 let section ~names ~flags ~args = emit (Section { names; flags; args })
 
-let align ~bytes = emit (Align { bytes })
+let align ~data_section ~bytes = emit (Align { bytes; data_section })
 
 let should_generate_cfi () =
   (* We generate CFI info even if we're not generating any other debugging
@@ -512,6 +561,14 @@ let cfi_offset ~reg ~offset =
 
 let cfi_startproc () = if should_generate_cfi () then emit Cfi_startproc
 
+let cfi_remember_state () =
+  if should_generate_cfi () then emit Cfi_remember_state
+
+let cfi_restore_state () = if should_generate_cfi () then emit Cfi_restore_state
+
+let cfi_def_cfa_register ~reg =
+  if should_generate_cfi () then emit (Cfi_def_cfa_register reg)
+
 let comment text = if emit_comments () then emit (Comment text)
 
 let loc ~file_num ~line ~col ?discriminator () =
@@ -531,8 +588,16 @@ let indirect_symbol symbol = emit (Indirect_symbol (Asm_symbol.encode symbol))
 
 let private_extern symbol = emit (Private_extern (Asm_symbol.encode symbol))
 
+let extrn symbol = emit (External (Asm_symbol.encode symbol))
+
+let hidden symbol = emit (Hidden (Asm_symbol.encode symbol))
+
+let weak symbol = emit (Weak (Asm_symbol.encode symbol))
+
 let size symbol cst = emit (Size (Asm_symbol.encode symbol, lower_expr cst))
 
+let size_const sym n = emit (Size (Asm_symbol.encode sym, Signed_int n))
+
 let type_ symbol ~type_ = emit (Type (symbol, type_))
 
 let sleb128 ?comment i =
@@ -609,7 +674,7 @@ let label ?comment label = const_machine_width ?comment (Label label)
 let label_plus_offset ?comment lab ~offset_in_bytes =
   let offset_in_bytes = Targetint.to_int64 offset_in_bytes in
   let lab = const_label lab in
-  const_machine_width ?comment (const_add lab (const_int64 offset_in_bytes))
+  const_machine_width ?comment (const_with_offset lab offset_in_bytes)
 
 let define_label label =
   let lbl_section = Asm_label.section label in
@@ -780,7 +845,7 @@ let symbol ?comment sym = const_machine_width ?comment (Symbol sym)
 
 let symbol_plus_offset symbol ~offset_in_bytes =
   let offset_in_bytes = Targetint.to_int64 offset_in_bytes in
-  const_machine_width (Add (Symbol symbol, Signed_int offset_in_bytes))
+  const_machine_width (const_with_offset (Symbol symbol) offset_in_bytes)
 
 let int8 ?comment i =
   const ?comment (Signed_int (Int64.of_int (Int8.to_int i))) Eight
@@ -873,9 +938,11 @@ let between_labels_16_bit ?comment:_ ~upper:_ ~lower:_ () =
   (* CR poechsel: use the arguments *)
   Misc.fatal_error "between_labels_16_bit not implemented yet"
 
-let between_labels_32_bit ?comment:_ ~upper:_ ~lower:_ () =
-  (* CR poechsel: use the arguments *)
-  Misc.fatal_error "between_labels_32_bit not implemented yet"
+let between_labels_32_bit ?comment:_comment ~upper ~lower () =
+  let expr = const_sub (const_label upper) (const_label lower) in
+  (* CR sspies: Following the x86 implementation, we *do not* force an assembly
+     time constant here. *)
+  const expr Thirty_two
 
 let between_labels_64_bit ?comment:_ ~upper:_ ~lower:_ () =
   (* CR poechsel: use the arguments *)
@@ -1048,3 +1115,14 @@ let offset_into_dwarf_section_symbol ?comment:_comment
   match width with
   | Thirty_two -> const expr Thirty_two
   | Sixty_four -> const expr Sixty_four
+
+let reloc_x86_64_plt32 ~offset_from_this ~target_symbol ~rel_offset_from_next =
+  emit
+    (Reloc
+       { offset = Sub (This, Signed_int offset_from_this);
+         name = R_X86_64_PLT32;
+         expr =
+           Sub
+             ( Named_thing (Asm_symbol.encode target_symbol),
+               Signed_int rel_offset_from_next )
+       })

backend/asm_targets/asm_directives_new.ml

@@ -145,12 +145,21 @@ val cfi_startproc : unit -> unit
 (** Mark the end of a function, for CFI purposes. *)
 val cfi_endproc : unit -> unit
 
+(** Remember the current state for CFI purposes. *)
+val cfi_remember_state : unit -> unit
+
+(** Restore the state for CFI purposes. *)
+val cfi_restore_state : unit -> unit
+
+(** Define a CFA register, for CFI purposes. *)
+val cfi_def_cfa_register : reg:string -> unit
+
 (** Mark that the call stack is not to be executable at runtime.  Not
     supported on all platforms. *)
 val mark_stack_non_executable : unit -> unit
 
 (** Leave as much space as is required to achieve the given alignment. *)
-val align : bytes:int -> unit
+val align : data_section:bool -> bytes:int -> unit
 
 (** Emit a directive giving the displacement between the given symbol and
     the current position.  This should only be used to state sizes of
@@ -159,6 +168,8 @@ val align : bytes:int -> unit
     from that whose size is being stated (e.g. on POWER with ELF ABI v1). *)
 val size : ?size_of:Asm_symbol.t -> Asm_symbol.t -> unit
 
+val size_const : Asm_symbol.t -> int64 -> unit
+
 (** Leave a gap in the object file. *)
 val space : bytes:int -> unit
 
@@ -188,6 +199,15 @@ val protected : Asm_symbol.t -> unit
     details). *)
 val private_extern : Asm_symbol.t -> unit
 
+(** Mark an already encoded symbol as external. *)
+val extrn : Asm_symbol.t -> unit
+
+(** Mark an already encoded symbol or label as hidden. *)
+val hidden : Asm_symbol.t -> unit
+
+(** Mark an already encoded symbol or label as weak. *)
+val weak : Asm_symbol.t -> unit
+
 (** Marker inside the definition of a lazy symbol stub (see platform or
     assembler documentation for details). *)
 val indirect_symbol : Asm_symbol.t -> unit
@@ -297,6 +317,12 @@ val offset_into_dwarf_section_symbol :
   Asm_symbol.t ->
   unit
 
+val reloc_x86_64_plt32 :
+  offset_from_this:int64 ->
+  target_symbol:Asm_symbol.t ->
+  rel_offset_from_next:int64 ->
+  unit
+
 module Directive : sig
   module Constant : sig
     (* CR sspies: make this private again once the first-class module has been
@@ -345,6 +371,10 @@ module Directive : sig
      removed *)
   type comment = string
 
+  (* ELF specific *)
+  type reloc_type = R_X86_64_PLT32
+  (* X86 only *)
+
   (* CR sspies: make this private again once the first-class module has been
      removed *)
 
@@ -354,7 +384,14 @@ module Directive : sig
       have had all necessary prefixing, mangling, escaping and suffixing
       applied. *)
   type t =
-    | Align of { bytes : int }
+    | Align of
+        { bytes : int;
+              (** The number of bytes to align to. This will be taken log2 by the emitter on
+          Arm and macOS platforms.*)
+          data_section : bool
+              (** The data_section flag controls whether the binary emitter emits NOP instructions
+          or null bytes. *)
+        }
     | Bytes of
         { str : string;
           comment : string option
@@ -367,6 +404,9 @@ module Directive : sig
           offset : int
         }
     | Cfi_startproc
+    | Cfi_remember_state
+    | Cfi_restore_state
+    | Cfi_def_cfa_register of string
     | Comment of comment
     | Const of
         { constant : Constant_with_width.t;
@@ -405,6 +445,14 @@ module Directive : sig
           comment : string option
         }
     | Protected of string
+    | Hidden of string
+    | Weak of string
+    | External of string
+    | Reloc of
+        { offset : Constant.t;
+          name : reloc_type;
+          expr : Constant.t
+        }
 
   (** Translate the given directive to textual form.  This produces output
       suitable for either gas or MASM as appropriate. *)