review fixes

Author: stedolan

backend/amd64/arch.ml

@@ -65,8 +65,10 @@ let command_line_options =
 
 open Format
 
+type sym_global = Global | Local
+
 type addressing_mode =
-    Ibased of string * bool * int       (* symbol + displ *)
+    Ibased of string * sym_global * int (* symbol + displ *)
   | Iindexed of int                     (* reg + displ *)
   | Iindexed2 of int                    (* reg + reg + displ *)
   | Iscaled of int * int                (* reg * scale + displ *)
@@ -306,7 +308,7 @@ let float_cond_and_need_swap cond =
 let equal_addressing_mode left right =
   match left, right with
   | Ibased (left_sym, left_glob, left_displ), Ibased (right_sym, right_glob, right_displ) ->
-    String.equal left_sym right_sym && Bool.equal left_glob right_glob && Int.equal left_displ right_displ
+    String.equal left_sym right_sym && left_glob = right_glob && Int.equal left_displ right_displ
   | Iindexed left_displ, Iindexed right_displ ->
     Int.equal left_displ right_displ
   | Iindexed2 left_displ, Iindexed2 right_displ ->

backend/amd64/emit.mlp

@@ -321,10 +321,11 @@ let res32 i n = emit_subreg reg_low_32_name DWORD i.res.(n)
 
 let addressing addr typ i n =
   match addr with
-  | Ibased(s, glob, ofs) ->
-      add_used_symbol s;
-      let s : Cmm.symbol = { sym_name = s; sym_global = if glob then Global else Local } in
-      mem64_rip typ (emit_cmm_symbol s) ~ofs
+  | Ibased(sym_name, sym_global, ofs) ->
+      add_used_symbol sym_name;
+      let sym_global : Cmm.is_global =
+        match sym_global with Global -> Global | Local -> Local in
+      mem64_rip typ (emit_cmm_symbol { sym_name ; sym_global }) ~ofs
   | Iindexed d ->
       mem64 typ d (arg64 i n)
   | Iindexed2 d ->
@@ -1249,7 +1250,7 @@ let emit_instr fallthrough i =
        to control ocaml probe handlers independently from stap probe handlers.
        It is placed immediately after stap semaphore, and is the same
        size - hence offset 2. *)
-    I.mov (addressing (Ibased(semaphore_sym, true, 2)) WORD i 0) (res16 i 0);
+    I.mov (addressing (Ibased(semaphore_sym, Global, 2)) WORD i 0) (res16 i 0);
     (* If the semaphore is 0, then the result is 0, otherwise 1. *)
     I.cmp (int 0) (res16 i 0);
     I.set (cond (Iunsigned Cne)) (res8 i 0);
@@ -1399,6 +1400,9 @@ let fundecl fundecl =
     D.private_extern (emit_symbol fundecl.fun_name)
   else
     D.global (emit_symbol fundecl.fun_name);
+  (* Even if the function name is Local, still emit an
+     actual linker symbol for it. This provides symbols
+     for perf, gdb, and similar tools *)
   D.label (emit_symbol fundecl.fun_name);
   D.label (label_name (emit_symbol fundecl.fun_name));
   emit_debug_info fundecl.fun_dbg;

backend/amd64/selection.ml

@@ -245,7 +245,9 @@ method select_addressing _chunk exp =
   then (Iindexed 0, exp)
   else match a with
     | Asymbol s ->
-        (Ibased(s.sym_name, s.sym_global = Cmm.Global, d), Ctuple [])
+        let glob : Arch.sym_global =
+          match s.sym_global with Global -> Global | Local -> Local in
+        (Ibased(s.sym_name, glob, d), Ctuple [])
     | Alinear e ->
         (Iindexed d, e)
     | Aadd(e1, e2) ->

backend/arm64/emit.mlp

@@ -49,6 +49,8 @@ let emit_label lbl =
 
 (* Symbols *)
 
+(* CR sdolan: Support local symbol definitions & references on arm64 *)
+
 let emit_symbol s =
   if macosx then emit_string "_";
   Emitaux.emit_symbol '$' s

backend/cmm_helpers.ml

@@ -3614,7 +3614,6 @@ let emit_constant_closure symb fundecls clos_vars cont =
         let is_last = match rem with [] -> true | _ :: _ -> false in
         match f2.arity with
         | { function_kind = Curried _; params_layout = [] | [_]; _ } as arity ->
-          (* FIXME: is sym_global correct here? *)
           (Cint (infix_header pos) :: closure_symbol f2)
           @ Csymbol_address
               { sym_name = f2.label; sym_global = symb.sym_global }
@@ -3690,8 +3689,8 @@ let preallocate_block cont { Clambda.symbol; exported; tag; fields } =
 let emit_preallocated_blocks preallocated_blocks cont =
   let symbols =
     List.map
-      (fun ({ Clambda.symbol } : Clambda.preallocated_block) ->
-        global_symbol symbol)
+      (fun ({ Clambda.symbol; exported } : Clambda.preallocated_block) ->
+        { sym_name = symbol; sym_global = (if exported then Global else Local) })
       preallocated_blocks
   in
   let c1 = emit_gc_roots_table ~symbols cont in