Remove Istore_symbol (plus some Win64 fixes) (#955)

Changes

@@ -214,14 +214,19 @@ Next version (4.05.0):
   (Jeremy Yallop,
    review by Damien Doligez, Alain Frisch, Daniel Bünzli, Fabrice Le Fessant)
 
-- PR#7427, GPR#959: Don't delete let bodies in Cmmgen (Mark Shinwell)
+- GPR#934: check for integer overflow in Bytes.extend
+  (Jeremy Yallop, review by Gabriel Scherer)
+
+- MPR#6594, GPR#955: Remove "Istore_symbol" specific operation on x86-64.
+  This is more robust and in particular avoids assembly failures on Win64.
+  (Mark Shinwell, review by Xavier Leroy, testing by David Allsopp and
+   Olivier Andrieu)
 
 - GPR#956 Keep possibly-effectful expressions when optimizing multiplication
   by zero.
   (Jeremy Yallop)
 
-- GPR#934: check for integer overflow in Bytes.extend
-  (Jeremy Yallop, review by Gabriel Scherer)
+- PR#7427, GPR#959: Don't delete let bodies in Cmmgen (Mark Shinwell)
 
 - GPR#987: alloc_sockaddr: don't assume a null terminator. It is not inserted
   on macOS by system calls that fill in a struct sockaddr (e.g. getsockname).

asmcomp/amd64/CSE.ml

@@ -28,7 +28,7 @@ method! class_of_operation op =
   | Ispecific spec ->
     begin match spec with
     | Ilea _ -> Op_pure
-    | Istore_int(_, _, is_asg) | Istore_symbol(_, _, is_asg) -> Op_store is_asg
+    | Istore_int(_, _, is_asg) -> Op_store is_asg
     | Ioffset_loc(_, _) -> Op_store true
     | Ifloatarithmem _ | Ifloatsqrtf _ -> Op_load
     | Ibswap _ | Isqrtf -> super#class_of_operation op

asmcomp/amd64/arch.ml

@@ -36,7 +36,6 @@ type specific_operation =
     Ilea of addressing_mode             (* "lea" gives scaled adds *)
   | Istore_int of nativeint * addressing_mode * bool
                                         (* Store an integer constant *)
-  | Istore_symbol of string * addressing_mode * bool (* Store a symbol *)
   | Ioffset_loc of int * addressing_mode (* Add a constant to a location *)
   | Ifloatarithmem of float_operation * addressing_mode
                                        (* Float arith operation with memory *)
@@ -109,10 +108,6 @@ let print_specific_operation printreg op ppf arg =
       fprintf ppf "[%a] := %nd %s"
          (print_addressing printreg addr) arg n
          (if is_assign then "(assign)" else "(init)")
-  | Istore_symbol(lbl, addr, is_assign) ->
-      fprintf ppf "[%a] := \"%s\" %s"
-         (print_addressing printreg addr) arg lbl
-         (if is_assign then "(assign)" else "(init)")
   | Ioffset_loc(n, addr) ->
       fprintf ppf "[%a] +:= %i" (print_addressing printreg addr) arg n
   | Isqrtf ->
@@ -131,3 +126,8 @@ let print_specific_operation printreg op ppf arg =
                    (Array.sub arg 1 (Array.length arg - 1))
   | Ibswap i ->
       fprintf ppf "bswap_%i %a" i printreg arg.(0)
+
+let win64 =
+  match Config.system with
+  | "win64" | "mingw64" | "cygwin" -> true
+  | _                   -> false

asmcomp/amd64/emit.mlp

@@ -727,10 +727,6 @@ let emit_instr fallthrough i =
       I.lea (addressing addr NONE i 0) (res i 0)
   | Lop(Ispecific(Istore_int(n, addr, _))) ->
       I.mov (nat n) (addressing addr QWORD i 0)
-  | Lop(Ispecific(Istore_symbol(s, addr, _))) ->
-      assert (not !Clflags.pic_code && not !Clflags.dlcode);
-      add_used_symbol s;
-      load_symbol_addr s (addressing addr QWORD i 0)
   | Lop(Ispecific(Ioffset_loc(n, addr))) ->
       I.add (int n) (addressing addr QWORD i 0)
   | Lop(Ispecific(Ifloatarithmem(op, addr))) ->
@@ -988,7 +984,7 @@ let begin_assembly() =
   end;
 
 
-  if !Clflags.dlcode then begin
+  if !Clflags.dlcode || Arch.win64 then begin
     (* from amd64.S; could emit these constants on demand *)
     begin match system with
     | S_macosx -> D.section ["__TEXT";"__literal16"] None ["16byte_literals"]

asmcomp/amd64/proc.ml

@@ -26,10 +26,7 @@ let fp = Config.with_frame_pointers
 
 (* Which ABI to use *)
 
-let win64 =
-  match Config.system with
-  | "win64" | "mingw64" | "cygwin" -> true
-  | _                   -> false
+let win64 = Arch.win64
 
 (* Registers available for register allocation *)
 

asmcomp/amd64/reload.ml

@@ -94,7 +94,7 @@ method! reload_operation op arg res =
       then (arg, res)
       else super#reload_operation op arg res
   | Iconst_symbol _ ->
-      if !Clflags.pic_code || !Clflags.dlcode
+      if !Clflags.pic_code || !Clflags.dlcode || Arch.win64
       then super#reload_operation op arg res
       else (arg, res)
   | _ -> (* Other operations: all args and results in registers *)

asmcomp/amd64/selection.ml

@@ -170,8 +170,6 @@ method! select_store is_assign addr exp =
       (Ispecific(Istore_int(Nativeint.of_int n, addr, is_assign)), Ctuple [])
   | Cconst_natpointer n when self#is_immediate_natint n ->
       (Ispecific(Istore_int(n, addr, is_assign)), Ctuple [])
-  | Cconst_symbol s when not (!Clflags.pic_code || !Clflags.dlcode) ->
-      (Ispecific(Istore_symbol(s, addr, is_assign)), Ctuple [])
   | _ ->
       super#select_store is_assign addr exp