diff --git a/backend/amd64/emit.ml b/backend/amd64/emit.ml index d2b554b9717..1e289f42765 100644 --- a/backend/amd64/emit.ml +++ b/backend/amd64/emit.ml @@ -44,108 +44,6 @@ module ND = Asm_targets.Asm_directives_new module S = Asm_targets.Asm_symbol module L = Asm_targets.Asm_label -let rec to_x86_constant (c : ND.Directive.Constant.t) : X86_ast.constant = - match c with - | Signed_int i -> Const i - | Unsigned_int i -> Const (Numbers.Uint64.to_int64 i) - | This -> ConstThis - | Named_thing s -> - ConstLabel s - (* both seem to be printed directly to the buffer without any conversion*) - | Add (c1, c2) -> ConstAdd (to_x86_constant c1, to_x86_constant c2) - | Sub (c1, c2) -> ConstSub (to_x86_constant c1, to_x86_constant c2) - -let to_x86_constant_with_width (c : ND.Directive.Constant_with_width.t) : - X86_ast.asm_line = - let width = ND.Directive.Constant_with_width.width_in_bytes c in - let const = ND.Directive.Constant_with_width.constant c in - let const = to_x86_constant const in - match width with - | Eight -> Byte const - (* on x86 Word is 2 bytes; warning this is not the same on Arm *) - | Sixteen -> Word const - | Thirty_two -> Long const - | Sixty_four -> Quad const - -let to_x86_directive (dir : ND.Directive.t) : X86_ast.asm_line list = - let comment_lines comment = - (* CR sspies: This check is usually done in the printing function of the new - directives. Since we are skipping those at the moment (by emitting via - the X86 DSL), we do the same check here in the conversion. *) - if !Clflags.keep_asm_file && !Flambda_backend_flags.dasm_comments - then Option.to_list (Option.map (fun s -> X86_ast.Comment s) comment) - else [] - in - match dir with - | Align { bytes; fill_x86_bin_emitter } -> - let data = match fill_x86_bin_emitter with Zero -> true | Nop -> false in - [X86_ast.Align (data, bytes)] - (* The [fill_x86_bin_emitter] field is currently ignored by GAS and MASM, - but used in the binary emitter. The bytes field is only converted to the - final value when printing. *) - | Bytes { str; comment } -> comment_lines comment @ [X86_ast.Bytes str] - | Comment s -> comment_lines (Some s) - | Const { constant; comment } -> - comment_lines comment @ [to_x86_constant_with_width constant] - | Direct_assignment (s, c) -> - (* We use [.set s c] for direct assignments, since it evaluates [c] - directly. The alternative, [s = c], is sensitive to relocations. *) - [X86_ast.Set (s, to_x86_constant c)] - | File { file_num = None; _ } -> - Misc.fatal_error "file directive must always carry a number on x86" - | File { file_num = Some file_num; filename } -> - [X86_ast.File (file_num, filename)] - | Global s -> [X86_ast.Global s] - | Indirect_symbol s -> [X86_ast.Indirect_symbol s] - | Loc { file_num; line; col; discriminator } -> - (* Behavior differs for negative column values. x86 will not output - anything, but new directives will output 0. *) - [X86_ast.Loc { file_num; line; col; discriminator }] - (* CR sspies: The [typ] matters only for MASM. The convention (implemented in - asm directives) is that in the text section, we use Code (NONE) and in the - data section, we use Machine_width_data (QWORD for amd64). The two will be - emitted differently by MASM. Because some code such as the frame tables - have moved from the data section to the text section (but were previously - still emitted with QUAD), using the new directives below changes this - behavior. *) - | New_label (s, Code) -> [X86_ast.NewLabel (s, NONE)] - | New_label (s, Machine_width_data) -> [X86_ast.NewLabel (s, QWORD)] - | New_line -> [X86_ast.NewLine] - | Private_extern s -> [X86_ast.Private_extern s] - | Section { names; flags; args } -> - [X86_ast.Section (names, flags, args, false)] - (* delayed for this directive is always ignored in GAS printing, and section - is not supported in binary emitter. In MASM, it only supports .text and - .data. *) - | Size (s, c) -> [X86_ast.Size (s, to_x86_constant c)] - | Sleb128 { constant; comment } -> - comment_lines comment @ [X86_ast.Sleb128 (to_x86_constant constant)] - | Space { bytes } -> [Space bytes] - | Type (n, st) -> - let typ = ND.symbol_type_to_string st in - [Type (n, typ)] - | Uleb128 { constant; comment } -> - comment_lines comment @ [X86_ast.Uleb128 (to_x86_constant constant)] - | Cfi_adjust_cfa_offset n -> [X86_ast.Cfi_adjust_cfa_offset n] - | Cfi_def_cfa_offset n -> [X86_ast.Cfi_def_cfa_offset n] - | Cfi_endproc -> [X86_ast.Cfi_endproc] - | Cfi_offset { reg; offset } -> [X86_ast.Cfi_offset (reg, offset)] - | Cfi_startproc -> [X86_ast.Cfi_startproc] - | Cfi_remember_state -> [X86_ast.Cfi_remember_state] - | Cfi_restore_state -> [X86_ast.Cfi_restore_state] - | Cfi_def_cfa_register r -> [X86_ast.Cfi_def_cfa_register r] - | Protected s -> [X86_ast.Protected s] - | Hidden s -> [X86_ast.Hidden s] - | Weak s -> [X86_ast.Weak s] - | External s -> [X86_ast.External (s, NEAR)] - (* All uses of [.extrn] use NEAR as the type. *) - | Reloc { offset; name = R_X86_64_PLT32; expr } -> - [ X86_ast.Reloc - { offset = to_x86_constant offset; - name = R_X86_64_PLT32; - expr = to_x86_constant expr - } ] - (** Turn a Linear label into an assembly label. The section is checked against the section tracked by [D] when emitting label definitions. *) let label_to_asm_label (l : label) ~(section : Asm_targets.Asm_section.t) : L.t @@ -348,7 +246,7 @@ let emit_named_text_section ?(suffix = "") func_name = | _ -> ND.switch_to_section_raw ~names:[Printf.sprintf ".text.caml.%s%s" (emit_symbol func_name) suffix] - ~flags:(Some "ax") ~args:["@progbits"]; + ~flags:(Some "ax") ~args:["@progbits"] ~is_delayed:false; (* Warning: We set the internal section ref to Text here, because it currently does not supported named text sections. In the rest of this file, we pretend the section is called Text rather than the function @@ -2237,8 +2135,7 @@ let begin_assembly unix = ND.initialize ~big_endian:Arch.big_endian ~emit_assembly_comments:!Flambda_backend_flags.dasm_comments (* As a first step, we emit by calling the corresponding x86 emit - directives. *) ~emit:(fun d -> - List.iter directive (to_x86_directive d)); + directives. *) ~emit:(fun d -> directive (Directive d)); let code_begin = Cmm_helpers.make_symbol "code_begin" in let code_end = Cmm_helpers.make_symbol "code_end" in Emitaux.Dwarf_helpers.begin_dwarf ~code_begin ~code_end ~file_emitter; diff --git a/backend/arm64/emit.ml b/backend/arm64/emit.ml index f1c8931e588..8b7140b430b 100644 --- a/backend/arm64/emit.ml +++ b/backend/arm64/emit.ml @@ -774,7 +774,8 @@ let emit_literals p align emit_literal = D.switch_to_section_raw ~names:["__TEXT,__literal" ^ Int.to_string align] ~flags:None - ~args:[Int.to_string align ^ "byte_literals"]; + ~args:[Int.to_string align ^ "byte_literals"] + ~is_delayed:false; (* 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_internal_section_ref Text); @@ -1233,7 +1234,7 @@ let emit_named_text_section func_name = the new asm directives. *) D.switch_to_section_raw ~names:[".text.caml." ^ S.encode (S.create func_name)] - ~flags:(Some "ax") ~args:["%progbits"]; + ~flags:(Some "ax") ~args:["%progbits"] ~is_delayed:false; (* Warning: We set the internal section ref to Text here, because it currently does not supported named text sections. In the rest of this file, we pretend the section is called Text rather than the function diff --git a/backend/asm_targets/asm_directives.ml b/backend/asm_targets/asm_directives.ml index 3ef926de676..60f67e0836b 100644 --- a/backend/asm_targets/asm_directives.ml +++ b/backend/asm_targets/asm_directives.ml @@ -135,11 +135,11 @@ module Make (A : Asm_directives_intf.Arg) : Asm_directives_intf.S = struct () | _ -> current_dwarf_section_ref := Some section; - let ({ names; flags; args } : Asm_section.section_details) = + let ({ names; flags; args; is_delayed } : Asm_section.section_details) = Asm_section.details section ~first_occurrence in if not first_occurrence then new_line (); - D.section ~delayed:(Asm_section.is_delayed section) names flags args; + D.section ~delayed:is_delayed names flags args; if first_occurrence then define_label (Asm_label.for_section section) let initialize () = diff --git a/backend/asm_targets/asm_directives_new.ml b/backend/asm_targets/asm_directives_new.ml index 1ac0c98d445..301f97fe48c 100644 --- a/backend/asm_targets/asm_directives_new.ml +++ b/backend/asm_targets/asm_directives_new.ml @@ -86,14 +86,26 @@ module Directive = struct | Add of t * t | Sub of t * t - let rec print buf t = + (* The [force_decimal] option is for supporting .sleb128 directives. See the + comment in [print] below. *) + let rec print_aux ~force_decimal buf t = match t with | (Named_thing _ | Signed_int _ | Unsigned_int _ | This) as c -> - print_subterm buf c - | Add (c1, c2) -> bprintf buf "%a + %a" print_subterm c1 print_subterm c2 - | Sub (c1, c2) -> bprintf buf "%a - %a" print_subterm c1 print_subterm c2 + print_aux_subterm ~force_decimal buf c + | Add (c1, c2) -> + bprintf buf "%a + %a" + (print_aux_subterm ~force_decimal) + c1 + (print_aux_subterm ~force_decimal) + c2 + | Sub (c1, c2) -> + bprintf buf "%a - %a" + (print_aux_subterm ~force_decimal) + c1 + (print_aux_subterm ~force_decimal) + c2 - and print_subterm buf t = + and print_aux_subterm ~force_decimal buf t = match t with | This -> ( match TS.assembler () with @@ -101,25 +113,41 @@ module Directive = struct | MASM -> Buffer.add_string buf "THIS BYTE") | Named_thing name -> Buffer.add_string buf name | Signed_int n -> ( - match TS.assembler () with - (* We use %Ld and not %Lx on Unix-like platforms to ensure that - ".sleb128" directives do not end up with hex arguments (since this - denotes a variable-length encoding it would not be clear where the - sign bit is). *) - | MacOS | GAS_like -> bprintf buf "%Ld" n - | MASM -> - if Int64.compare n 0x8000_0000L >= 0 - && Int64.compare n 0x7fff_ffffL <= 0 + match TS.assembler (), force_decimal with + | _, true -> Buffer.add_string buf (Int64.to_string n) + | MASM, _ -> + if Int64.compare n 0x7FFF_FFFFL <= 0 + && Int64.compare n (-0x8000_0000L) >= 0 + (* This constant was changed from 0x8000_0000L (in the original + code for these directives) to -0x8000_0000L, matching what we do + for GAS below. See #3948. *) + then Buffer.add_string buf (Int64.to_string n) + else bprintf buf "0%LxH" n + | _, false -> + if Int64.compare n 0x7FFF_FFFFL <= 0 + && Int64.compare n (-0x8000_0000L) >= 0 then Buffer.add_string buf (Int64.to_string n) - else bprintf buf "0%LxH" n) + else bprintf buf "0x%Lx" n) | Unsigned_int n -> (* We can use the printer for [Signed_int] since we always print as an unsigned hex representation. *) - print_subterm buf (Signed_int (Uint64.to_int64 n)) + print_aux_subterm ~force_decimal buf (Signed_int (Uint64.to_int64 n)) | Add (c1, c2) -> - bprintf buf "(%a + %a)" print_subterm c1 print_subterm c2 + bprintf buf "(%a + %a)" + (print_aux_subterm ~force_decimal) + c1 + (print_aux_subterm ~force_decimal) + c2 | Sub (c1, c2) -> - bprintf buf "(%a - %a)" print_subterm c1 print_subterm c2 + bprintf buf "(%a - %a)" + (print_aux_subterm ~force_decimal) + c1 + (print_aux_subterm ~force_decimal) + c2 + + let print = print_aux ~force_decimal:false + + let print_using_decimals = print_aux ~force_decimal:true end module Constant_with_width = struct @@ -197,7 +225,8 @@ module Directive = struct | Section of { names : string list; flags : string option; - args : string list + args : string list; + is_delayed : bool } | Size of string * Constant.t | Sleb128 of @@ -222,32 +251,44 @@ module Directive = struct let bprintf = Printf.bprintf - (* CR sspies: This code is a duplicate with [emit_string_literal] in - [emitaux.ml]. Hopefully, we can deduplicate this soon. *) - let string_of_string_literal s = + (* CR sspies: This code is effectively a duplicate with [emit_string_literal] + in [emitaux.ml] and [string_of_substring_literal] in [x86_proc.ml]. + Hopefully, we can deduplicate this soon. *) + let string_of_substring_literal ~start:k ~length:n s = let between x low high = Char.compare x low >= 0 && Char.compare x high <= 0 in - let buf = Buffer.create (String.length s + 2) in + if k + n > String.length s + then + Misc.fatal_errorf + "Attempting to extract a substring that is too long: range %d..<%d \ + goes beyond the string %S of length %d." + k (k + n) s (String.length s); + if n < 0 || k < 0 + then Misc.fatal_errorf "Negative substring length %d or start index %d" n k; + let b = Buffer.create (n + 2) in let last_was_escape = ref false in - for i = 0 to String.length s - 1 do + for i = k to k + n - 1 do let c = s.[i] in if between c '0' '9' then if !last_was_escape - then Printf.bprintf buf "\\%o" (Char.code c) - else Buffer.add_char buf c + then Printf.bprintf b "\\%o" (Char.code c) + else Buffer.add_char b c else if between c ' ' '~' - && (not (Char.equal c '"' (* '"' *))) - && not (Char.equal c '\\') + && (not (Char.equal c '"')) + (* '"' *) && not (Char.equal c '\\') then ( - Buffer.add_char buf c; + Buffer.add_char b c; last_was_escape := false) else ( - Printf.bprintf buf "\\%o" (Char.code c); + Printf.bprintf b "\\%o" (Char.code c); last_was_escape := true) done; - Buffer.contents buf + Buffer.contents b + + let string_of_string_literal s = + string_of_substring_literal ~start:0 ~length:(String.length s) s let buf_bytes_directive buf ~directive s = let pos = ref 0 in @@ -266,22 +307,22 @@ module Directive = struct (* CR sspies: This code is based on [emit_string_directive] in [emitaux.ml]. We break up the string into smaller chunks. *) - let print_ascii_string_gas buf s = + let print_ascii_string_gas ~chunk_size buf s = let l = String.length s in if l = 0 then () else - (* We first print the string 80 characters at a time. *) + (* We first print the string [chunk_size] characters at a time. *) let i = ref 0 in - while l - !i > 80 do + while l - !i > chunk_size do bprintf buf "\t.ascii\t\"%s\"\n" - (string_of_string_literal (String.sub s !i 80)); - i := !i + 80 + (string_of_substring_literal ~start:!i ~length:chunk_size s); + i := !i + chunk_size done; (* Then we print the remainder. We do not append a new line, because every directive ends with a new line. *) bprintf buf "\t.ascii\t\"%s\"" - (string_of_string_literal (String.sub s !i (l - !i))) + (string_of_substring_literal ~start:!i ~length:(l - !i) s) let reloc_type_to_string = function R_X86_64_PLT32 -> "R_X86_64_PLT32" @@ -328,16 +369,23 @@ module Directive = struct comment | Bytes { str; comment } -> (match TS.system (), TS.architecture () with - | Solaris, _ | _, POWER -> buf_bytes_directive buf ~directive:".byte" str - | _ -> print_ascii_string_gas buf str); + | Solaris, _ | _, POWER -> + buf_bytes_directive buf ~directive:".byte" str + (* Very long lines can cause gas to be extremely slow, so split up large + string literals. It turns out that gas reads files in 32kb chunks so + splitting the string into blocks of 25k characters should be close to + the sweet spot even with a lot of escapes. *) + | _, X86_64 -> print_ascii_string_gas ~chunk_size:25_000 buf str + | _, AArch64 -> print_ascii_string_gas ~chunk_size:80 buf str + | _, _ -> print_ascii_string_gas ~chunk_size:80 buf str); bprintf buf "%s" (gas_comment_opt comment) - | Comment s -> if emit_comments () then bprintf buf "\t\t\t/* %s */" s + | Comment s -> if emit_comments () then bprintf buf "\t\t\t\t/* %s */" s | Global s -> bprintf buf "\t.globl\t%s" s | New_label (s, _typ) -> bprintf buf "%s:" s | New_line -> () | Section { names = [".data"]; _ } -> bprintf buf "\t.data" | Section { names = [".text"]; _ } -> bprintf buf "\t.text" - | Section { names; flags; args } -> ( + | Section { names; flags; args; is_delayed = _ } -> ( bprintf buf "\t.section %s" (String.concat "," names); (match flags with None -> () | Some flags -> bprintf buf ",%S" flags); match args with @@ -377,10 +425,16 @@ module Directive = struct bprintf buf "\t.loc\t%d\t%d%a%a" file_num line print_col col print_discriminator discriminator | Private_extern s -> bprintf buf "\t.private_extern %s" s - | Size (s, c) -> bprintf buf "\t.size %s,%a" s Constant.print c + | Size (s, c) -> + bprintf buf "\t.size %s,%a" s Constant.print c + (* We use %Ld and not %Lx on Unix-like platforms to ensure that ".sleb128" + directives do not end up with hex arguments (since this denotes a + variable-length encoding it would not be clear where the sign bit + is). *) | Sleb128 { constant; comment } -> let comment = gas_comment_opt comment in - bprintf buf "\t.sleb128\t%a%s" Constant.print constant comment + bprintf buf "\t.sleb128\t%a%s" Constant.print_using_decimals constant + comment | Type (s, typ) -> let typ = symbol_type_to_string typ in (* CR sspies: Technically, ",STT_OBJECT" violates the assembler syntax @@ -390,7 +444,8 @@ module Directive = struct bprintf buf "\t.type %s,%s" s typ | Uleb128 { constant; comment } -> let comment = gas_comment_opt comment in - bprintf buf "\t.uleb128\t%a%s" Constant.print constant comment + bprintf buf "\t.uleb128\t%a%s" Constant.print_using_decimals constant + comment | Direct_assignment (var, const) -> ( match TS.assembler () with | MacOS -> bprintf buf "\t.set %s, %a" var Constant.print const @@ -535,7 +590,8 @@ let emit (d : Directive.t) = let emit_non_masm (d : Directive.t) = match TS.assembler () with MASM -> () | MacOS | GAS_like -> emit d -let section ~names ~flags ~args = emit (Section { names; flags; args }) +let section ~names ~flags ~args ~is_delayed = + emit (Section { names; flags; args; is_delayed }) let align ~fill_x86_bin_emitter ~bytes = emit (Align { bytes; fill_x86_bin_emitter }) @@ -716,17 +772,17 @@ let switch_to_section ?(emit_label_on_first_occurrence = false) section = true) in current_section_ref := Some section; - let ({ names; flags; args } : Asm_section.section_details) = + let ({ names; flags; args; is_delayed } : Asm_section.section_details) = Asm_section.details section ~first_occurrence in (* CR sspies: We do not print an empty line here to be consistent with Arm emission. *) - emit (Section { names; flags; args }); + emit (Section { names; flags; args; is_delayed }); if first_occurrence && emit_label_on_first_occurrence then define_label (Asm_label.for_section section) -let switch_to_section_raw ~names ~flags ~args = - emit (Section { names; flags; args }) +let switch_to_section_raw ~names ~flags ~args ~is_delayed = + emit (Section { names; flags; args; is_delayed }) let unsafe_set_internal_section_ref section = current_section_ref := Some section @@ -902,6 +958,7 @@ let mark_stack_non_executable () = match TS.system () with | Linux -> section ~names:[".note.GNU-stack"] ~flags:(Some "") ~args:["%progbits"] + ~is_delayed:false | _ -> () let new_temp_var () = diff --git a/backend/asm_targets/asm_directives_new.mli b/backend/asm_targets/asm_directives_new.mli index 6ecd7899a29..5c96a1a4538 100644 --- a/backend/asm_targets/asm_directives_new.mli +++ b/backend/asm_targets/asm_directives_new.mli @@ -37,7 +37,11 @@ val switch_to_section : command. This function is only intended to be used for target-specific sections. *) val switch_to_section_raw : - names:string list -> flags:string option -> args:string list -> unit + names:string list -> + flags:string option -> + args:string list -> + is_delayed:bool -> + unit (** Abbreviation for [switch_to_section Text]. *) val text : unit -> unit @@ -439,7 +443,8 @@ module Directive : sig | Section of { names : string list; flags : string option; - args : string list + args : string list; + is_delayed : bool } | Size of string * Constant.t | Sleb128 of diff --git a/backend/asm_targets/asm_section.ml b/backend/asm_targets/asm_section.ml index 4c6e0bda06a..a1c28ee1bd9 100644 --- a/backend/asm_targets/asm_section.ml +++ b/backend/asm_targets/asm_section.ml @@ -119,7 +119,8 @@ let section_is_text = function type section_details = { names : string list; flags : string option; - args : string list + args : string list; + is_delayed : bool } let details t ~first_occurrence = @@ -210,10 +211,13 @@ let details t ~first_occurrence = | Probes, _, _ -> [".probes"], Some "wa", ["\"progbits\""] | Note_ocaml_eh, _, _ -> [".note.ocaml_eh"], Some "?", ["\"note\""] in - { names; flags; args } + let is_delayed = is_delayed t in + { names; flags; args; is_delayed } let to_string t = - let { names; flags = _; args = _ } = details t ~first_occurrence:true in + let { names; flags = _; args = _; is_delayed = _ } = + details t ~first_occurrence:true + in String.concat " " names let all_sections_in_order () = diff --git a/backend/asm_targets/asm_section.mli b/backend/asm_targets/asm_section.mli index 9a31643eaae..cff97260ea8 100644 --- a/backend/asm_targets/asm_section.mli +++ b/backend/asm_targets/asm_section.mli @@ -58,7 +58,8 @@ val to_string : t -> string type section_details = private { names : string list; flags : string option; - args : string list + args : string list; + is_delayed : bool } val dwarf_sections_in_order : unit -> t list diff --git a/backend/internal_assembler/internal_assembler.ml b/backend/internal_assembler/internal_assembler.ml index 42041a97a7e..35c22f291be 100644 --- a/backend/internal_assembler/internal_assembler.ml +++ b/backend/internal_assembler/internal_assembler.ml @@ -167,7 +167,7 @@ let assemble_one_section ~name instructions = let align = List.fold_left (fun acc i -> - match i with X86_ast.Align (data, n) when n > acc -> n | _ -> acc) + match i with X86_ast.Directive (Align { bytes=n; _ }) when n > acc -> n | _ -> acc) 0 instructions in align, diff --git a/backend/internal_assembler/symbol_entry.ml b/backend/internal_assembler/symbol_entry.ml index 80130f08040..1c48abfa4ef 100644 --- a/backend/internal_assembler/symbol_entry.ml +++ b/backend/internal_assembler/symbol_entry.ml @@ -82,13 +82,10 @@ let create_symbol (symbol : X86_binary_emitter.symbol) symbol_table sections let size = Option.value ~default:0 symbol.sy_size in let st_type = match symbol.sy_type with - (* CR mcollins - modify types to avoid string comparisons *) - | Some "@function" -> 2 - | Some "object" -> 1 - | Some "tls_object" -> 6 - | Some "common" -> 5 - | Some "notype" -> 0 - | Some s -> failwith ("Unknown symbol type" ^ s) + (* Some common additional types, which are currently not used are: + tls_object = 6, common = 5, notype = 0 *) + | Some Function -> 2 + | Some Object -> 1 | None -> 0 in let st_binding = diff --git a/backend/x86_ast.mli b/backend/x86_ast.mli index 30579c57547..ddd56d16b7f 100644 --- a/backend/x86_ast.mli +++ b/backend/x86_ast.mli @@ -213,51 +213,6 @@ type reloc = (* CR gyorsh: use inline record for Section and File constructors. *) type asm_line = | Ins of instruction - - | Align of bool * int - | Byte of constant - | Bytes of string - (** directive for an 8-bit constant *) - | Comment of string - | Global of string - | Protected of string - | Hidden of string - | Weak of string - | Long of constant - (** directive for a 32-bit constant *) - | NewLabel of string * data_type - | NewLine - | Quad of constant - (** directive for a 64-bit constant *) - | Section of string list * string option * string list * bool - | Sleb128 of constant - | Space of int - | Uleb128 of constant - | Word of constant - (** directive for a 16-bit constant *) - - (* masm only (the gas emitter will fail on them) *) - | External of string * data_type - | Mode386 - | Model of string - - (* gas only (the masm emitter will fail on them) *) - | Cfi_adjust_cfa_offset of int - | Cfi_endproc - | Cfi_startproc - | Cfi_remember_state - | Cfi_restore_state - | Cfi_def_cfa_register of string - | Cfi_def_cfa_offset of int - | Cfi_offset of int * int - | File of int * string (* (file_num, file_name) *) - | Indirect_symbol of string - | Loc of { file_num:int; line:int; col:int; discriminator: int option } - | Private_extern of string - | Set of string * constant - | Size of string * constant - | Type of string * string - | Reloc of reloc - + | Directive of Asm_targets.Asm_directives_new.Directive.t type asm_program = asm_line list diff --git a/backend/x86_binary_emitter.ml b/backend/x86_binary_emitter.ml index 42496234546..1c8ffb13388 100644 --- a/backend/x86_binary_emitter.ml +++ b/backend/x86_binary_emitter.ml @@ -19,6 +19,11 @@ open X86_ast open X86_proc module String = Misc.Stdlib.String + +module D = Asm_targets.Asm_directives_new.Directive +module C = D.Constant + + type section = { sec_name : string; mutable sec_instrs : asm_line array; @@ -69,7 +74,7 @@ type symbol_binding = Sy_local | Sy_global | Sy_weak type symbol = { sy_name : string; - mutable sy_type : string option; + mutable sy_type : Asm_targets.Asm_directives_new.symbol_type option; mutable sy_size : int option; mutable sy_binding : symbol_binding; mutable sy_protected : bool; @@ -90,7 +95,7 @@ type local_reloc = | RelocCall of string | RelocShortJump of string * int (* loc *) | RelocLongJump of string - | RelocConstant of constant * data_size + | RelocConstant of C.t * data_size type result = | Rint of int64 @@ -190,11 +195,11 @@ let label_pos b lbl = relocations. *) let eval_const b current_pos cst = let rec eval = function - | Const n -> Rint n - | ConstThis -> Rabs ("", 0L) - | ConstLabel lbl -> Rabs (lbl, 0L) - | ConstLabelOffset (lbl, o) -> Rabs (lbl, Int64.of_int o) - | ConstSub (c1, c2) -> ( + | C.Signed_int n -> Rint n + | C.Unsigned_int n -> Rint (Numbers.Uint64.to_int64 n) + | C.This -> Rabs ("", 0L) + | C.Named_thing lbl -> Rabs (lbl, 0L) + | C.Sub (c1, c2) -> ( let c1 = eval c1 and c2 = eval c2 in match (c1, c2) with | Rint n1, Rint n2 -> Rint (Int64.sub n1 n2) @@ -248,7 +253,7 @@ let eval_const b current_pos cst = | _ -> assert false) with Not_found -> assert false) | _ -> assert false) - | ConstAdd (c1, c2) -> ( + | C.Add (c1, c2) -> ( let c1 = eval c1 and c2 = eval c2 in match (c1, c2) with | Rint n1, Rint n2 -> Rint (Int64.add n1 n2) @@ -1639,67 +1644,79 @@ let assemble_instr b loc = function | LZCNT (src, dst) -> emit_lzcnt b ~dst ~src | SIMD (instr, args) -> emit_simd b instr args + +let[@warning "+4"] constant b cst (width: D.Constant_with_width.width_in_bytes) = + let open D.Constant_with_width in + match cst, width with + | C.Signed_int n, Eight -> buf_int8L b n + | C.Signed_int n, Sixteen -> buf_int16L b n + | C.Signed_int n, Thirty_two -> buf_int32L b n + | C.Signed_int n, Sixty_four -> buf_int64L b n + | C.Unsigned_int n, Eight -> buf_int8L b (Numbers.Uint64.to_int64 n) + | C.Unsigned_int n, Sixteen -> buf_int16L b (Numbers.Uint64.to_int64 n) + | C.Unsigned_int n, Thirty_two -> buf_int32L b (Numbers.Uint64.to_int64 n) + | C.Unsigned_int n, Sixty_four -> buf_int64L b (Numbers.Uint64.to_int64 n) + | (C.This | C.Named_thing _ | C.Add _ | C.Sub _), Eight -> + record_local_reloc b (RelocConstant (cst, B8)); + buf_int8L b 0L + | (C.This | C.Named_thing _ | C.Add _ | C.Sub _), Sixteen -> + record_local_reloc b (RelocConstant (cst, B16)); + buf_int16L b 0L + | (C.This | C.Named_thing _ | C.Add _ | C.Sub _), Thirty_two -> + record_local_reloc b (RelocConstant (cst, B32)); + buf_int32L b 0L + | (C.This | C.Named_thing _ | C.Add _ | C.Sub _), Sixty_four -> + record_local_reloc b (RelocConstant (cst, B64)); + buf_int64L b 0L + let assemble_line b loc ins = try match ins with | Ins instr -> assemble_instr b loc instr; incr loc - | Comment _ -> () - | Global sym -> (get_symbol b sym).sy_binding <- Sy_global - | Weak sym -> (get_symbol b sym).sy_binding <- Sy_weak - | Protected sym -> (get_symbol b sym).sy_protected <- true - | Quad (Const n) -> buf_int64L b n - | Quad cst -> - record_local_reloc b (RelocConstant (cst, B64)); - buf_int64L b 0L - | Long (Const n) -> buf_int32L b n - | Long cst -> - record_local_reloc b (RelocConstant (cst, B32)); - buf_int32L b 0L - | Word (Const n) -> buf_int16L b n - | Word cst -> - record_local_reloc b (RelocConstant (cst, B16)); - buf_int16L b 0L - | Byte (Const n) -> buf_int8L b n - | Byte cst -> - record_local_reloc b (RelocConstant (cst, B8)); - buf_int8L b 0L - | NewLabel (s, _) -> declare_label b s - | Bytes s -> Buffer.add_string b.buf s - | External (_, _) -> () - | Set (_, _) -> assert false - | Section _ -> assert false - | Mode386 -> assert (is_win32 system) - | Model _ -> assert (is_win32 system) - | Cfi_startproc -> () - | Cfi_endproc -> () - | Cfi_adjust_cfa_offset _ -> () - | Cfi_remember_state -> () - | Cfi_restore_state -> () - | Cfi_def_cfa_register _ -> () - | Cfi_def_cfa_offset _ -> () - | Cfi_offset _ -> () - | File _ -> () - | Loc _ -> () - | Private_extern _ -> assert false - | Indirect_symbol _ -> assert false - | Type (lbl, kind) -> (get_symbol b lbl).sy_type <- Some kind - | Size (lbl, cst) -> ( + | Directive (D.Comment _ )-> () + | Directive (D.Global sym) -> (get_symbol b sym).sy_binding <- Sy_global + | Directive (D.Weak sym) -> (get_symbol b sym).sy_binding <- Sy_weak + | Directive (D.Protected sym) -> (get_symbol b sym).sy_protected <- true + | Directive (D.Const {constant = c; comment = _ }) -> + constant b + (D.Constant_with_width.constant c) + (D.Constant_with_width.width_in_bytes c) + | Directive (D.New_label (s, _)) -> declare_label b s + | Directive (D.Bytes { str; comment = _ }) -> Buffer.add_string b.buf str + | Directive (D.External _) -> () + | Directive (D.Direct_assignment _) -> assert false + | Directive (D.Section _) -> assert false + | Directive D.Cfi_startproc -> () + | Directive D.Cfi_endproc -> () + | Directive (D.Cfi_adjust_cfa_offset _) -> () + | Directive (D.Cfi_remember_state) -> () + | Directive (D.Cfi_restore_state) -> () + | Directive (D.Cfi_def_cfa_register _) -> () + | Directive (D.Cfi_def_cfa_offset _) -> () + | Directive (D.Cfi_offset _) -> () + | Directive (D.File _) -> () + | Directive (D.Loc _) -> () + | Directive (D.Private_extern _) -> assert false + | Directive (D.Indirect_symbol _) -> assert false + | Directive (D.Type (lbl, kind)) -> (get_symbol b lbl).sy_type <- Some kind + | Directive (D.Size (lbl, cst)) -> ( match eval_const b (Buffer.length b.buf) cst with | Rint n -> (get_symbol b lbl).sy_size <- Some (Int64.to_int n) | _ -> assert false) - | Align (data, n) -> ( + | Directive (D.Align { fill_x86_bin_emitter=data; bytes = n}) -> ( (* TODO: Buffer.length = 0 => set section align *) let pos = Buffer.length b.buf in let current = pos mod n in if current > 0 then let n = n - current in - if data then + match data with + | Asm_targets.Asm_directives_new.Zero -> for _ = 1 to n do buf_int8 b 0x00 done - else + | Asm_targets.Asm_directives_new.Nop -> match n with | 0 -> () | 1 -> buf_int8 b 0x90 @@ -1719,18 +1736,18 @@ let assemble_line b loc ins = done; buf_opcodes b [ 0x0f; 0x1f; 0x84; 0x00 ]; buf_int32L b 0L) - | Space n -> + | Directive (D.Space { bytes = n }) -> (* TODO: in text section, should be NOP *) for _ = 1 to n do buf_int8 b 0 done - | Hidden _ | NewLine -> () - | Reloc { name = R_X86_64_PLT32; - expr = ConstSub (ConstLabel wrap_label, Const 4L); - offset = ConstSub (ConstThis, Const 4L); - } when String.Tbl.mem local_labels wrap_label -> + | Directive (D.Hidden _) | Directive D.New_line -> () + | Directive (D.Reloc { name = D.R_X86_64_PLT32; + expr = C.Sub (C.Named_thing wrap_label, C.Signed_int 4L); + offset = C.Sub (C.This, C.Signed_int 4L); + }) when String.Tbl.mem local_labels wrap_label -> record_local_reloc b ~offset:(-4) (RelocCall wrap_label) - | Reloc _ | Sleb128 _ | Uleb128 _ -> + | Directive (D.Reloc _) | Directive (D.Sleb128 _) | Directive (D.Uleb128 _) -> X86_gas.generate_asm Out_channel.stderr [ins]; Misc.fatal_errorf "x86_binary_emitter: unsupported instruction" with e -> @@ -1752,7 +1769,7 @@ let assemble_section arch section = let icount = ref 0 in ArrayLabels.iter section.sec_instrs ~f:(function - | NewLabel (lbl, _) -> + | Directive (D.New_label (lbl, _)) -> String.Tbl.add local_labels lbl !icount | Ins _ -> incr icount | _ -> ()); diff --git a/backend/x86_binary_emitter.mli b/backend/x86_binary_emitter.mli index fe54fe05208..9b96e8ad693 100644 --- a/backend/x86_binary_emitter.mli +++ b/backend/x86_binary_emitter.mli @@ -25,7 +25,7 @@ type symbol_binding = Sy_local | Sy_global | Sy_weak type symbol = { sy_name : string; - mutable sy_type : string option; + mutable sy_type : Asm_targets.Asm_directives_new.symbol_type option; mutable sy_size : int option; mutable sy_binding : symbol_binding; mutable sy_protected : bool; diff --git a/backend/x86_dsl.ml b/backend/x86_dsl.ml index 6bc1ee3c6d7..a1771203a7d 100644 --- a/backend/x86_dsl.ml +++ b/backend/x86_dsl.ml @@ -93,84 +93,6 @@ let mem64 typ ?(scale = 1) ?base ?sym displ idx = let mem64_rip typ ?(ofs = 0) s = Mem64_RIP (typ, s, ofs) -module D = struct - let section ?(delayed = false) segment flags args = - directive (Section (segment, flags, args, delayed)) - - let align ~data n = directive (Align (data, n)) - - let byte n = directive (Byte n) - - let bytes s = directive (Bytes s) - - let cfi_adjust_cfa_offset n = directive (Cfi_adjust_cfa_offset n) - - let cfi_endproc () = directive Cfi_endproc - - let cfi_startproc () = directive Cfi_startproc - - let cfi_remember_state () = directive Cfi_remember_state - - let cfi_restore_state () = directive Cfi_restore_state - - let cfi_def_cfa_register reg = directive (Cfi_def_cfa_register reg) - - let cfi_def_cfa_offset n = directive (Cfi_def_cfa_offset n) - - let comment s = directive (Comment s) - - let data () = section [".data"] None [] - - let extrn s ptr = directive (External (s, ptr)) - - let file ~file_num ~file_name = directive (File (file_num, file_name)) - - let global s = directive (Global s) - - let protected s = directive (Protected s) - - let hidden s = directive (Hidden s) - - let weak s = directive (Weak s) - - let indirect_symbol s = directive (Indirect_symbol s) - - let label ?(typ = NONE) s = directive (NewLabel (s, typ)) - - let loc ~file_num ~line ~col ?discriminator () = - directive (Loc { file_num; line; col; discriminator }) - - let long cst = directive (Long cst) - - let mode386 () = directive Mode386 - - let model name = directive (Model name) - - let new_line () = directive NewLine - - let private_extern s = directive (Private_extern s) - - let qword cst = directive (Quad cst) - - let reloc ~offset ~name ~expr = directive (Reloc { offset; name; expr }) - - let setvar (x, y) = directive (Set (x, y)) - - let size name cst = directive (Size (name, cst)) - - let sleb128 n = directive (Sleb128 n) - - let space n = directive (Space n) - - let text () = section [".text"] None [] - - let type_ name typ = directive (Type (name, typ)) - - let uleb128 n = directive (Uleb128 n) - - let word cst = directive (Word cst) -end - module I = struct let add x y = emit (ADD (x, y)) diff --git a/backend/x86_dsl.mli b/backend/x86_dsl.mli index cf4ac3f2238..869ce2f22d2 100644 --- a/backend/x86_dsl.mli +++ b/backend/x86_dsl.mli @@ -91,92 +91,6 @@ val mem64 : val mem64_rip : data_type -> ?ofs:int -> string -> arg -module D : sig - (** Directives *) - - (* If data is true then null bytes are used for padding, otherwise nops are - used *) - val align : data:bool -> int -> unit - - (** directive for an 8-bit constant *) - val byte : constant -> unit - - val bytes : string -> unit - - val cfi_adjust_cfa_offset : int -> unit - - val cfi_endproc : unit -> unit - - val cfi_startproc : unit -> unit - - val cfi_remember_state : unit -> unit - - val cfi_restore_state : unit -> unit - - val cfi_def_cfa_register : string -> unit - - val cfi_def_cfa_offset : int -> unit - - val comment : string -> unit - - val data : unit -> unit - - val extrn : string -> data_type -> unit - - val file : file_num:int -> file_name:string -> unit - - val global : string -> unit - - val protected : string -> unit - - val hidden : string -> unit - - val indirect_symbol : string -> unit - - val label : ?typ:data_type -> string -> unit - - val loc : - file_num:int -> line:int -> col:int -> ?discriminator:int -> unit -> unit - - (** directive for a 32-bit constant *) - val long : constant -> unit - - val mode386 : unit -> unit - - val model : string -> unit - - val new_line : unit -> unit - - val private_extern : string -> unit - - (** directive for a 64-bit constant *) - val qword : constant -> unit - - val reloc : offset:constant -> name:reloc_type -> expr:constant -> unit - - val section : - ?delayed:bool -> string list -> string option -> string list -> unit - - val setvar : string * constant -> unit - - val size : string -> constant -> unit - - val sleb128 : constant -> unit - - val space : int -> unit - - val text : unit -> unit - - val type_ : string -> string -> unit - - val uleb128 : constant -> unit - - val weak : string -> unit - - (** directive for a 16-bit constant *) - val word : constant -> unit -end - module I : sig (* Instructions *) diff --git a/backend/x86_gas.ml b/backend/x86_gas.ml index bf8ff37631e..d0ffa7b90b0 100644 --- a/backend/x86_gas.ml +++ b/backend/x86_gas.ml @@ -54,8 +54,6 @@ let arg_mem b { arch; typ = _; idx; scale; base; sym; displ } = if scale <> 1 then bprintf b ",%s" (Int.to_string scale); Buffer.add_char b ')') -let reloc_type_to_string = function R_X86_64_PLT32 -> "R_X86_64_PLT32" - let arg b = function | Sym x -> Buffer.add_char b '$'; @@ -70,25 +68,6 @@ let arg b = function | Mem addr -> arg_mem b addr | Mem64_RIP (_, s, displ) -> bprintf b "%s%a(%%rip)" s opt_displ displ -let rec cst b = function - | (ConstLabel _ | ConstLabelOffset _ | Const _ | ConstThis) as c -> scst b c - | ConstAdd (c1, c2) -> bprintf b "%a + %a" scst c1 scst c2 - | ConstSub (c1, c2) -> bprintf b "%a - %a" scst c1 scst c2 - -and scst b = function - | ConstThis -> Buffer.add_string b "." - | ConstLabel l -> Buffer.add_string b l - | ConstLabelOffset (l, o) -> - Buffer.add_string b l; - opt_displ b o - | Const n - when Int64.compare n 0x7FFF_FFFFL <= 0 - && Int64.compare n (-0x8000_0000L) >= 0 -> - Buffer.add_string b (Int64.to_string n) - | Const n -> bprintf b "0x%Lx" n - | ConstAdd (c1, c2) -> bprintf b "(%a + %a)" scst c1 scst c2 - | ConstSub (c1, c2) -> bprintf b "(%a - %a)" scst c1 scst c2 - let typeof = function | Mem { typ; _ } | Mem64_RIP (typ, _, _) -> typ | Reg8L _ | Reg8H _ -> BYTE @@ -258,91 +237,10 @@ let print_instr b = function Misc.fatal_errorf "unexpected instruction layout for %s (%d args)" instr.mnemonic (Array.length args)) -let print_line b = function - | Ins instr -> print_instr b instr - | Align (_data, n) -> - (* MacOSX assembler interprets the integer n as a 2^n alignment *) - let n = if is_macosx system then Misc.log2 n else n in - bprintf b "\t.align\t%d" n - | Byte n -> bprintf b "\t.byte\t%a" cst n - | Bytes s -> ( - match is_solaris system with - | true -> buf_bytes_directive b ".byte" s - | false -> - (* Very long lines can cause gas to be extremely slow so split up large - string literals. It turns out that gas reads files in 32kb chunks so - splitting the string into blocks of 25k characters should be close to - the sweet spot even with a lot of escapes. *) - let chunk_size = 25000 in - let rec chunk i = - if String.length s - i > chunk_size - then ( - bprintf b "\t.ascii\t\"%s\"\n" - (string_of_substring_literal i chunk_size s); - chunk (i + chunk_size)) - else i - in - let i = chunk 0 in - bprintf b "\t.ascii\t\"%s\"" - (string_of_substring_literal i (String.length s - i) s)) - | Comment s -> bprintf b "\t\t\t\t/* %s */" s - | Global s -> bprintf b "\t.globl\t%s" s - | Protected s -> bprintf b "\t.protected\t%s" s - | Hidden s -> bprintf b "\t.hidden\t%s" s - | Weak s -> bprintf b "\t.weak\t%s" s - | Long n -> bprintf b "\t.4byte\t%a" cst n - | NewLabel (s, _) -> bprintf b "%s:" s - | NewLine -> () - | Quad n -> bprintf b "\t.8byte\t%a" cst n - | Section ([".data"], _, _, _) -> bprintf b "\t.data" - | Section ([".text"], _, _, _) -> bprintf b "\t.text" - | Section (name, flags, args, _delayed) -> ( - bprintf b "\t.section %s" (String.concat "," name); - (match flags with None -> () | Some flags -> bprintf b ",%S" flags); - match args with [] -> () | _ -> bprintf b ",%s" (String.concat "," args)) - | Space n -> ( - match is_solaris system with - | true -> bprintf b "\t.zero\t%d" n - | false -> bprintf b "\t.space\t%d" n) - | Word n -> ( - match is_solaris system with - | true -> bprintf b "\t.value\t%a" cst n - | false -> bprintf b "\t.2byte\t%a" cst n) - | Uleb128 n -> bprintf b "\t.uleb128\t%a" cst n - | Sleb128 n -> bprintf b "\t.sleb128\t%a" cst n - (* gas only *) - | Cfi_adjust_cfa_offset n -> bprintf b "\t.cfi_adjust_cfa_offset %d" n - | Cfi_endproc -> bprintf b "\t.cfi_endproc" - | Cfi_startproc -> bprintf b "\t.cfi_startproc" - | Cfi_remember_state -> bprintf b "\t.cfi_remember_state" - | Cfi_restore_state -> bprintf b "\t.cfi_restore_state" - | Cfi_def_cfa_register reg -> bprintf b "\t.cfi_def_cfa_register %%%s" reg - | Cfi_def_cfa_offset n -> bprintf b "\t.cfi_def_cfa_offset %d" n - | Cfi_offset (reg, n) -> bprintf b "\t.cfi_offset %d, %d" reg n - | File (file_num, file_name) -> - bprintf b "\t.file\t%d\t\"%s\"" file_num - (X86_proc.string_of_string_literal file_name) - | Indirect_symbol s -> bprintf b "\t.indirect_symbol %s" s - | Loc { file_num; line; col; discriminator } -> ( - (* PR#7726: Location.none uses column -1, breaks LLVM assembler *) - (* If we don't set the optional column field, debug_line program gets the - column value from the previous .loc directive. *) - if col >= 0 - then bprintf b "\t.loc\t%d\t%d\t%d" file_num line col - else bprintf b "\t.loc\t%d\t%d\t0" file_num line; - match discriminator with - | None -> () - | Some k -> bprintf b "\tdiscriminator %d" k) - | Private_extern s -> bprintf b "\t.private_extern %s" s - | Set (arg1, arg2) -> bprintf b "\t.set %s, %a" arg1 cst arg2 - | Size (s, c) -> bprintf b "\t.size %s,%a" s cst c - | Type (s, typ) -> bprintf b "\t.type %s,%s" s typ - | Reloc { offset; name; expr } -> - bprintf b "\t.reloc %a,%s,%a" cst offset - (reloc_type_to_string name) - cst expr - (* masm only *) - | External _ | Mode386 | Model _ -> assert false +let print_line b i = + match i with + | Ins i -> print_instr b i + | Directive d -> Asm_targets.Asm_directives_new.Directive.print b d let generate_asm oc lines = let b = Buffer.create 10000 in diff --git a/backend/x86_masm.ml b/backend/x86_masm.ml index c165b6288fe..d1e27402f86 100644 --- a/backend/x86_masm.ml +++ b/backend/x86_masm.ml @@ -243,34 +243,8 @@ let print_instr b = function let print_line b = function | Ins instr -> print_instr b instr - | Align (_data, n) -> bprintf b "\tALIGN\t%d" n - | Byte n -> bprintf b "\tBYTE\t%a" cst n - | Bytes s -> buf_bytes_directive b "BYTE" s - | Comment s -> bprintf b " ; %s " s - | Global s -> bprintf b "\tPUBLIC\t%s" s - | Long n -> bprintf b "\tDWORD\t%a" cst n - | NewLabel (s, NONE) -> bprintf b "%s:" s - | NewLabel (s, ptr) -> bprintf b "%s LABEL %s" s (string_of_datatype ptr) - | NewLine -> () - | Quad n -> bprintf b "\tQWORD\t%a" cst n - | Section ([".data"], None, [], _) -> bprintf b "\t.DATA" - | Section ([".text"], None, [], _) -> bprintf b "\t.CODE" - | Section _ -> assert false - | Space n -> bprintf b "\tBYTE\t%d DUP (?)" n - | Word n -> bprintf b "\tWORD\t%a" cst n - | Sleb128 _ | Uleb128 _ -> - Misc.fatal_error "Sleb128 and Uleb128 unsupported for MASM" - (* windows only *) - | External (s, ptr) -> bprintf b "\tEXTRN\t%s: %s" s (string_of_datatype ptr) - | Mode386 -> bprintf b "\t.386" - | Model name -> bprintf b "\t.MODEL %s" name (* name = FLAT *) - (* gas / MacOS only *) - | Cfi_adjust_cfa_offset _ | Cfi_endproc | Cfi_startproc - | Cfi_def_cfa_register _ | Cfi_def_cfa_offset _ | Cfi_offset _ - | Cfi_remember_state | Cfi_restore_state | File _ | Indirect_symbol _ | Loc _ - | Private_extern _ | Set _ | Size _ | Type _ | Hidden _ | Weak _ | Reloc _ - | Protected _ -> - assert false + (* Warning: The MASM printing of these directives is untested.*) + | Directive dir -> Asm_targets.Asm_directives_new.Directive.print b dir let generate_asm oc lines = let b = Buffer.create 10000 in diff --git a/backend/x86_proc.ml b/backend/x86_proc.ml index 7b4cde1d823..5d61cb127d1 100644 --- a/backend/x86_proc.ml +++ b/backend/x86_proc.ml @@ -384,7 +384,9 @@ let create_asm_file = ref true let directive dir = if !create_asm_file then asm_code := dir :: !asm_code; match[@warning "-4"] dir with - | Section (name, flags, args, is_delayed) -> ( + | Directive + (Asm_targets.Asm_directives_new.Directive.Section + { names = name; flags; args; is_delayed }) -> ( let name = Section_name.make name flags args in let where = if is_delayed then delayed_sections else asm_code_by_section in match Section_name.Tbl.find_opt where name with