Skip to content

Commit 0ef22fb

Browse files
spiessimonspiessimon
authored
Delete the FCM in the assembly emitters (#3892)
1 parent 48e006b commit 0ef22fb

30 files changed

+112
-256
lines changed

‎backend/amd64/emit.ml

+10-105
Original file line numberDiff line numberDiff line change
@@ -68,15 +68,20 @@ let to_x86_constant_with_width (c : ND.Directive.Constant_with_width.t) :
6868

6969
let to_x86_directive (dir : ND.Directive.t) : X86_ast.asm_line list =
7070
let comment_lines comment =
71-
Option.to_list (Option.map (fun s -> X86_ast.Comment s) comment)
71+
(* CR sspies: This check is usually done in the printing function of the new
72+
directives. Since we are skipping those at the moment (by emitting via
73+
the X86 DSL), we do the same check here in the conversion. *)
74+
if !Clflags.keep_asm_file && !Flambda_backend_flags.dasm_comments
75+
then Option.to_list (Option.map (fun s -> X86_ast.Comment s) comment)
76+
else []
7277
in
7378
match dir with
7479
| Align { bytes } ->
7580
[X86_ast.Align (false, bytes)]
7681
(* The data field is currently ignored by both assembler backends. The bytes
7782
field is only converted to the final value when printing. *)
7883
| Bytes { str; comment } -> comment_lines comment @ [X86_ast.Bytes str]
79-
| Comment s -> [X86_ast.Comment s]
84+
| Comment s -> comment_lines (Some s)
8085
| Const { constant; comment } ->
8186
comment_lines comment @ [to_x86_constant_with_width constant]
8287
| Direct_assignment (s, c) ->
@@ -619,105 +624,6 @@ let emit_jump_tables () =
619624
List.iter emit_jump_table !jump_tables;
620625
jump_tables := []
621626

622-
let file_emitter ~file_num ~file_name =
623-
ND.file ~file_num:(Some file_num) ~file_name
624-
625-
let build_asm_directives () : (module Asm_targets.Asm_directives_intf.S) =
626-
(module Asm_targets.Asm_directives.Make (struct
627-
let emit_line line = ND.comment line
628-
629-
let get_file_num file_name = Emitaux.get_file_num ~file_emitter file_name
630-
631-
let debugging_comments_in_asm_files = !Flambda_backend_flags.dasm_comments
632-
633-
module D = struct
634-
type constant = ND.Directive.Constant.t
635-
636-
let const_int64 num = ND.Directive.Constant.Signed_int num
637-
638-
let const_label str = ND.Directive.Constant.Named_thing str
639-
640-
let const_add c1 c2 = ND.Directive.Constant.Add (c1, c2)
641-
642-
let const_sub c1 c2 = ND.Directive.Constant.Sub (c1, c2)
643-
644-
(* CR sspies: The functions depending on [emit_directive] below break
645-
abstractions. This is intensional at the moment, because this is only
646-
the first step of getting rid of the first-class module entirely. *)
647-
let emit_directive d = List.iter directive (to_x86_directive d)
648-
649-
type data_type =
650-
| NONE
651-
| DWORD
652-
| QWORD
653-
| VEC128
654-
655-
let file = file_emitter
656-
657-
let loc ~file_num ~line ~col ?discriminator () =
658-
ignore discriminator;
659-
D.loc ~file_num ~line ~col ?discriminator ()
660-
661-
let comment str = D.comment str
662-
663-
let label ?data_type str =
664-
let _ = data_type in
665-
emit_directive (New_label (str, Code))
666-
667-
let section ?delayed:_ name flags args =
668-
match name, flags, args with
669-
| [".data"], _, _ -> ND.data ()
670-
| [".text"], _, _ -> ND.text ()
671-
| name, flags, args -> ND.switch_to_section_raw ~names:name ~flags ~args
672-
673-
let text () = D.text ()
674-
675-
let new_line () = D.new_line ()
676-
677-
let emit_constant const size =
678-
emit_directive
679-
(Const
680-
{ constant = ND.Directive.Constant_with_width.create const size;
681-
comment = None
682-
})
683-
684-
let global sym = emit_directive (Global sym)
685-
686-
let protected sym =
687-
if not (is_macosx system) then emit_directive (Protected sym)
688-
689-
let type_ sym typ_ =
690-
let typ_ : ND.symbol_type =
691-
match typ_ with
692-
| "@function" -> Function
693-
| "@object" -> Object
694-
| "STT_OBJECT" -> Object
695-
| "STT_FUNC" -> Function
696-
| _ -> Misc.fatal_error "Unsupported type"
697-
in
698-
emit_directive (Type (sym, typ_))
699-
700-
let byte const = emit_constant const Eight
701-
702-
let word const = emit_constant const Sixteen
703-
704-
let long const = emit_constant const Thirty_two
705-
706-
let qword const = emit_constant const Sixty_four
707-
708-
let bytes str = ND.string str
709-
710-
let uleb128 const =
711-
emit_directive (Uleb128 { constant = const; comment = None })
712-
713-
let sleb128 const =
714-
emit_directive (Sleb128 { constant = const; comment = None })
715-
716-
let direct_assignment var const =
717-
emit_directive (Direct_assignment (var, const))
718-
end
719-
end))
720-
721627
(* Names for instructions *)
722628

723629
let instr_for_intop = function
@@ -2260,15 +2166,14 @@ let begin_assembly unix =
22602166
(* We initialize the new assembly directives. *)
22612167
Asm_targets.Asm_label.initialize ~new_label:(fun () ->
22622168
Cmm.new_label () |> Label.to_int);
2263-
ND.initialize
2264-
~big_endian:Arch.big_endian
2169+
ND.initialize ~big_endian:Arch.big_endian
2170+
~emit_assembly_comments:!Flambda_backend_flags.dasm_comments
22652171
(* As a first step, we emit by calling the corresponding x86 emit
22662172
directives. *) ~emit:(fun d ->
22672173
List.iter directive (to_x86_directive d));
22682174
let code_begin = Cmm_helpers.make_symbol "code_begin" in
22692175
let code_end = Cmm_helpers.make_symbol "code_end" in
2270-
Emitaux.Dwarf_helpers.begin_dwarf ~build_asm_directives ~code_begin ~code_end
2271-
~file_emitter:D.file;
2176+
Emitaux.Dwarf_helpers.begin_dwarf ~code_begin ~code_end ~file_emitter:D.file;
22722177
if is_win64 system
22732178
then (
22742179
D.extrn "caml_call_gc" NEAR;

‎backend/arm64/emit.ml

+4-102
Original file line numberDiff line numberDiff line change
@@ -2111,116 +2111,18 @@ let data l =
21112111
emit_printf "\t.align\t3\n";
21122112
List.iter emit_item l
21132113

2114-
let emit_line str = emit_string (str ^ "\n")
2115-
21162114
let file_emitter ~file_num ~file_name =
21172115
D.file ~file_num:(Some file_num) ~file_name
21182116

2119-
let build_asm_directives () : (module Asm_targets.Asm_directives_intf.S) =
2120-
(module Asm_targets.Asm_directives.Make (struct
2121-
let emit_line = emit_line
2122-
2123-
let get_file_num file_name = Emitaux.get_file_num ~file_emitter file_name
2124-
2125-
let debugging_comments_in_asm_files = !Flambda_backend_flags.dasm_comments
2126-
2127-
module D = struct
2128-
type constant = D.Directive.Constant.t
2129-
2130-
let const_int64 num = D.Directive.Constant.Signed_int num
2131-
2132-
let const_label str = D.Directive.Constant.Named_thing str
2133-
2134-
let const_add c1 c2 = D.Directive.Constant.Add (c1, c2)
2135-
2136-
let const_sub c1 c2 = D.Directive.Constant.Sub (c1, c2)
2137-
2138-
(* CR sspies: The functions depending on [emit_directive] below break
2139-
abstractions. This is intensional at the moment, because this is only
2140-
the first step of getting rid of the first-class module entirely. *)
2141-
let emit_directive dir =
2142-
let buf = Buffer.create 80 in
2143-
D.Directive.print buf dir;
2144-
Buffer.add_string buf "\n";
2145-
Buffer.output_buffer !output_channel buf
2146-
2147-
let emit_constant const size =
2148-
emit_directive
2149-
(Const
2150-
{ constant = D.Directive.Constant_with_width.create const size;
2151-
comment = None
2152-
})
2153-
2154-
type data_type =
2155-
| NONE
2156-
| DWORD
2157-
| QWORD
2158-
| VEC128
2159-
2160-
let file = file_emitter
2161-
2162-
let loc ~file_num ~line ~col ?discriminator () =
2163-
ignore discriminator;
2164-
D.loc ~file_num ~line ~col ?discriminator ()
2165-
2166-
let comment str = D.comment str
2167-
2168-
let label ?data_type:_ str = emit_directive (New_label (str, Code))
2169-
2170-
let section ?delayed:_ name flags args =
2171-
match name, flags, args with
2172-
| [".data"], _, _ -> D.data ()
2173-
| [".text"], _, _ -> D.text ()
2174-
| name, flags, args -> D.switch_to_section_raw ~names:name ~flags ~args
2175-
2176-
let text () = D.text ()
2177-
2178-
let new_line () = D.new_line ()
2179-
2180-
let global sym = emit_directive (Global sym)
2181-
2182-
let protected sym = if not macosx then emit_directive (Protected sym)
2183-
2184-
let type_ sym typ_ =
2185-
let typ_ : D.symbol_type =
2186-
match typ_ with
2187-
| "@function" -> Function
2188-
| "@object" -> Object
2189-
| "STT_FUNC" -> Function
2190-
| "STT_OBJECT" -> Object
2191-
| _ -> Misc.fatal_errorf "Unsupported assembly type %s" typ_
2192-
in
2193-
emit_directive (Type (sym, typ_))
2194-
2195-
let byte const = emit_constant const Eight
2196-
2197-
let word const = emit_constant const Sixteen
2198-
2199-
let long const = emit_constant const Thirty_two
2200-
2201-
let qword const = emit_constant const Sixty_four
2202-
2203-
let bytes str = D.string str
2204-
2205-
let uleb128 const =
2206-
emit_directive (Uleb128 { constant = const; comment = None })
2207-
2208-
let sleb128 const =
2209-
emit_directive (Sleb128 { constant = const; comment = None })
2210-
2211-
let direct_assignment var const =
2212-
emit_directive (Direct_assignment (var, const))
2213-
end
2214-
end))
2215-
22162117
(* Beginning / end of an assembly file *)
22172118

22182119
let begin_assembly _unix =
22192120
reset_debug_info ();
22202121
Asm_targets.Asm_label.initialize ~new_label:(fun () ->
22212122
Cmm.new_label () |> Label.to_int);
22222123
let asm_line_buffer = Buffer.create 200 in
2223-
D.initialize ~big_endian:Arch.big_endian ~emit:(fun d ->
2124+
D.initialize ~big_endian:Arch.big_endian
2125+
~emit_assembly_comments:!Flambda_backend_flags.dasm_comments ~emit:(fun d ->
22242126
Buffer.clear asm_line_buffer;
22252127
D.Directive.print asm_line_buffer d;
22262128
Buffer.add_string asm_line_buffer "\n";
@@ -2244,8 +2146,8 @@ let begin_assembly _unix =
22442146
DSL.ins I.NOP [||];
22452147
emit_printf "\t.align\t3\n");
22462148
let lbl_end = Cmm_helpers.make_symbol "code_end" in
2247-
Emitaux.Dwarf_helpers.begin_dwarf ~build_asm_directives ~code_begin:lbl_begin
2248-
~code_end:lbl_end ~file_emitter
2149+
Emitaux.Dwarf_helpers.begin_dwarf ~code_begin:lbl_begin ~code_end:lbl_end
2150+
~file_emitter
22492151

22502152
let end_assembly () =
22512153
let lbl_end = Cmm_helpers.make_symbol "code_end" in

‎backend/asm_targets/asm_directives_dwarf.ml

+17
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
(**************************************************************************)
2+
(* *)
3+
(* OCaml *)
4+
(* *)
5+
(* Simon Spies, Jane Street Europe *)
6+
(* *)
7+
(* Copyright 2025 Jane Street Group LLC *)
8+
(* *)
9+
(* All rights reserved. This file is distributed under the terms of *)
10+
(* the GNU Lesser General Public License version 2.1, with the *)
11+
(* special exception on linking described in the file LICENSE. *)
12+
(* *)
13+
(**************************************************************************)
14+
15+
type t = unit
16+
17+
let build_asm_directives () = ()

‎backend/asm_targets/asm_directives_dwarf.mli

+17
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
(**************************************************************************)
2+
(* *)
3+
(* OCaml *)
4+
(* *)
5+
(* Simon Spies, Jane Street Europe *)
6+
(* *)
7+
(* Copyright 2025 Jane Street Group LLC *)
8+
(* *)
9+
(* All rights reserved. This file is distributed under the terms of *)
10+
(* the GNU Lesser General Public License version 2.1, with the *)
11+
(* special exception on linking described in the file LICENSE. *)
12+
(* *)
13+
(**************************************************************************)
14+
15+
type t
16+
17+
val build_asm_directives : unit -> t

0 commit comments

Comments
 (0)