Simpler symbols

backend/amd64/emit.mlp

@@ -500,7 +500,7 @@ let emit_float_constant f lbl =
   D.qword (Const f)
 
 let emit_global_label s =
-  let lbl = Compilenv.make_symbol (Some s) in
+  let lbl = Cmm_helpers.make_symbol s in
   add_def_symbol lbl;
   let lbl = emit_symbol lbl in
   D.global lbl;
@@ -577,7 +577,7 @@ type probe =
 
 let probe_handler_wrapper_name probe_label =
   let w = Printf.sprintf "probe_wrapper_%d" probe_label in
-  Compilenv.make_symbol (Some w)
+  Cmm_helpers.make_symbol w
   |> emit_symbol
 
 let probes = ref []
@@ -1327,7 +1327,7 @@ let begin_assembly ~init_dwarf =
   D.data ();
   emit_global_label "data_begin";
 
-  emit_named_text_section (Compilenv.make_symbol (Some "code_begin"));
+  emit_named_text_section (Cmm_helpers.make_symbol "code_begin");
   emit_global_label "code_begin";
   if system = S_macosx then I.nop (); (* PR#4690 *)
   ()
@@ -1641,7 +1641,7 @@ let end_assembly dwarf =
   (* Emit probe handler wrappers *)
   List.iter emit_probe_handler_wrapper !probes;
 
-  emit_named_text_section (Compilenv.make_symbol (Some "code_end"));
+  emit_named_text_section (Cmm_helpers.make_symbol "code_end");
   if system = S_macosx then I.nop ();
   (* suppress "ld warning: atom sorting error" *)
 
@@ -1686,7 +1686,7 @@ let end_assembly dwarf =
     };
 
   if system = S_linux then begin
-    let frametable = emit_symbol (Compilenv.make_symbol (Some "frametable")) in
+    let frametable = emit_symbol (Cmm_helpers.make_symbol "frametable") in
     D.size frametable (ConstSub (ConstThis, ConstLabel frametable))
   end;
 

backend/arm64/emit.mlp

@@ -1089,28 +1089,28 @@ let data l =
 let begin_assembly ~init_dwarf:_ =
   reset_debug_info();
   `	.file	\"\"\n`;  (* PR#7037 *)
-  let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
+  let lbl_begin = Cmm_helpers.make_symbol "data_begin" in
   `	.data\n`;
   `	.globl	{emit_symbol lbl_begin}\n`;
   `{emit_symbol lbl_begin}:\n`;
-  let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
+  let lbl_begin = Cmm_helpers.make_symbol "code_begin" in
   emit_named_text_section lbl_begin;
   `	.globl	{emit_symbol lbl_begin}\n`;
   `{emit_symbol lbl_begin}:\n`
 
 let end_assembly _dwarf =
-  let lbl_end = Compilenv.make_symbol (Some "code_end") in
+  let lbl_end = Cmm_helpers.make_symbol "code_end" in
   emit_named_text_section lbl_end;
   `	.globl	{emit_symbol lbl_end}\n`;
   `{emit_symbol lbl_end}:\n`;
-  let lbl_end = Compilenv.make_symbol (Some "data_end") in
+  let lbl_end = Cmm_helpers.make_symbol "data_end" in
   `	.data\n`;
   `	.quad	0\n`;  (* PR#6329 *)
   `	.globl	{emit_symbol lbl_end}\n`;
   `{emit_symbol lbl_end}:\n`;
   `	.quad	0\n`;
   `	.align	3\n`;  (* #7887 *)
-  let lbl = Compilenv.make_symbol (Some "frametable") in
+  let lbl = Cmm_helpers.make_symbol "frametable" in
   `	.globl	{emit_symbol lbl}\n`;
   `{emit_symbol lbl}:\n`;
   emit_frames

backend/asmgen.ml

@@ -27,7 +27,7 @@ open Dwarf_ocaml
 
 type error =
   | Assembler_error of string
-  | Mismatched_for_pack of string option
+  | Mismatched_for_pack of Compilation_unit.Prefix.t
   | Asm_generation of string * Emitaux.error
 
 exception Error of error
@@ -68,15 +68,13 @@ let should_save_cfg_before_emit () =
   should_save_ir_after Compiler_pass.Simplify_cfg && (not !start_from_emit)
 
 let linear_unit_info =
-  { Linear_format.unit_name = "";
+  { Linear_format.unit = Compilation_unit.dummy;
     items = [];
-    for_pack = None;
   }
 
 let new_cfg_unit_info () =
-  { Cfg_format.unit_name = "";
+  { Cfg_format.unit = Compilation_unit.dummy;
     items = [];
-    for_pack = None;
   }
 
 let cfg_unit_info = new_cfg_unit_info ()
@@ -92,20 +90,17 @@ let reset () =
   start_from_emit := false;
   Compiler_pass_map.iter (fun pass (cfg_unit_info : Cfg_format.cfg_unit_info) ->
     if should_save_ir_after pass then begin
-      cfg_unit_info.unit_name <- Compilenv.current_unit_name ();
+      cfg_unit_info.unit <- Compilation_unit.get_current_exn ();
       cfg_unit_info.items <- [];
-      cfg_unit_info.for_pack <- !Clflags.for_package;
     end)
     pass_to_cfg;
   if should_save_before_emit () then begin
-    linear_unit_info.unit_name <- Compilenv.current_unit_name ();
+    linear_unit_info.unit <- Compilation_unit.get_current_exn ();
     linear_unit_info.items <- [];
-    linear_unit_info.for_pack <- !Clflags.for_package;
   end;
   if should_save_cfg_before_emit () then begin
-    cfg_unit_info.unit_name <- Compilenv.current_unit_name ();
+    cfg_unit_info.unit <- Compilation_unit.get_current_exn ();
     cfg_unit_info.items <- [];
-    cfg_unit_info.for_pack <- !Clflags.for_package;
   end
 
 let save_data dl =
@@ -500,13 +495,17 @@ let compile_unit ~output_prefix ~asm_filename ~keep_asm ~obj_filename ~may_reduc
 
 let build_dwarf ~asm_directives:(module Asm_directives : Asm_targets.Asm_directives_intf.S) sourcefile =
   let unit_name =
-    Compilation_unit.get_persistent_ident (Compilation_unit.get_current_exn ())
+    (* CR lmaurer: This doesn't actually need to be an [Ident.t] *)
+    Symbol.for_current_unit ()
+    |> Symbol.linkage_name
+    |> Linkage_name.to_string
+    |> Ident.create_persistent
   in
   let code_begin =
-    Compilenv.make_symbol (Some "code_begin") |> Asm_targets.Asm_symbol.create
+    Cmm_helpers.make_symbol "code_begin" |> Asm_targets.Asm_symbol.create
   in
   let code_end =
-    Compilenv.make_symbol (Some "code_end") |> Asm_targets.Asm_symbol.create
+    Cmm_helpers.make_symbol "code_end" |> Asm_targets.Asm_symbol.create
   in
   Dwarf.create
     ~sourcefile
@@ -657,10 +656,12 @@ let compile_implementation_flambda2 unix ?toplevel ?(keep_symbol_tables=true)
 let linear_gen_implementation unix filename =
   let open Linear_format in
   let linear_unit_info, _ = restore filename in
-  (match !Clflags.for_package, linear_unit_info.for_pack with
-   | None, None -> ()
-   | Some expected, Some saved when String.equal expected saved -> ()
-   | _, saved -> raise(Error(Mismatched_for_pack saved)));
+  let current_package = Compilation_unit.Prefix.from_clflags () in
+  let saved_package =
+    Compilation_unit.for_pack_prefix linear_unit_info.unit
+  in
+  if not (Compilation_unit.Prefix.equal current_package saved_package)
+  then raise(Error(Mismatched_for_pack saved_package));
   let emit_item ~dwarf = function
     | Data dl -> emit_data dl
     | Func f -> emit_fundecl ~dwarf f
@@ -687,13 +688,15 @@ let report_error ppf = function
       fprintf ppf "Assembler error, input left in file %a"
         Location.print_filename file
   | Mismatched_for_pack saved ->
-    let msg = function
-       | None -> "without -for-pack"
-       | Some s -> "with -for-pack "^s
+    let msg prefix =
+      if Compilation_unit.Prefix.is_empty prefix
+      then "without -for-pack"
+      else "with -for-pack " ^ Compilation_unit.Prefix.to_string prefix
      in
      fprintf ppf
        "This input file cannot be compiled %s: it was generated %s."
-       (msg !Clflags.for_package) (msg saved)
+       (msg (Compilation_unit.Prefix.from_clflags ()))
+       (msg saved)
   | Asm_generation(fn, err) ->
      fprintf ppf
        "Error producing assembly code for %s: %a"

backend/asmgen.mli

@@ -77,7 +77,7 @@ val compile_phrase
 
 type error =
   | Assembler_error of string
-  | Mismatched_for_pack of string option
+  | Mismatched_for_pack of Compilation_unit.Prefix.t
   | Asm_generation of string * Emitaux.error
 
 exception Error of error

backend/asmlibrarian.ml

@@ -79,8 +79,7 @@ let create_archive file_list lib_name =
        let units =
          List.map (fun (unit, crc) ->
            Cmm_helpers.Generic_fns_tbl.add genfns unit.ui_generic_fns;
-           { li_name = unit.ui_name;
-             li_symbol = unit.ui_symbol;
+           { li_name = unit.ui_unit;
              li_crc = crc;
              li_defines = unit.ui_defines;
              li_force_link = unit.ui_force_link;