[Git][ghc/ghc][wip/ncg-simd] more SIMD debugging

sheaf (@sheaf) gitlab at gitlab.haskell.org
Thu Jun 20 17:43:36 UTC 2024



sheaf pushed to branch wip/ncg-simd at Glasgow Haskell Compiler / GHC


Commits:
85a0b5b0 by sheaf at 2024-06-20T19:43:04+02:00
more SIMD debugging

- - - - -


6 changed files:

- compiler/GHC/CmmToAsm/Instr.hs
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- compiler/GHC/CmmToAsm/Reg/Target.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/Regs.hs


Changes:

=====================================
compiler/GHC/CmmToAsm/Instr.hs
=====================================
@@ -97,7 +97,8 @@ class Instruction instr where
 
         -- | An instruction to spill a register into a spill slot.
         mkSpillInstr
-                :: NCGConfig
+                :: HasDebugCallStack
+                => NCGConfig
                 -> RegFormat    -- ^ the reg to spill
                 -> Int          -- ^ the current stack delta
                 -> Int          -- ^ spill slots to use
@@ -106,7 +107,8 @@ class Instruction instr where
 
         -- | An instruction to reload a register from a spill slot.
         mkLoadInstr
-                :: NCGConfig
+                :: HasDebugCallStack
+                => NCGConfig
                 -> RegFormat    -- ^ the reg to reload.
                 -> Int          -- ^ the current stack delta
                 -> Int          -- ^ the spill slot to use


=====================================
compiler/GHC/CmmToAsm/Reg/Linear.hs
=====================================
@@ -440,7 +440,7 @@ raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
                           not (dst `elemUFM` assig),
                           isRealReg src || isInReg src assig -> do
            case src of
-              RegReal rr -> setAssigR (addToUFM assig dst (InReg $ RealRegUsage rr fmt))
+              RegReal rr -> setAssigR (addToUFM assig dst (InReg $ mkRealRegUsage platform rr fmt))
                 -- if src is a fixed reg, then we just map dest to this
                 -- reg in the assignment.  src must be an allocatable reg,
                 -- otherwise it wouldn't be in r_dying.
@@ -509,7 +509,7 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = do
     -- only read by this instr.  (the list is typically ~2 elements,
     -- so using nub isn't a problem).
     let virt_read :: [VirtualRegFormat]
-        virt_read = nubOrdOn virtualRegFormatReg [ VirtualRegFormat vr fmt | RegFormat (RegVirtual vr) fmt <- read ]
+        virt_read = nubOrdOn virtualRegFormatReg [ mkVirtualRegFormat vr fmt | RegFormat (RegVirtual vr) fmt <- read ]
 
 --     do
 --         let real_read       = nub [ rr      | (RegReal rr) <- read]
@@ -719,7 +719,7 @@ saveClobberedTemps clobbered dying
               (my_reg : _) -> do
                   setFreeRegsR (frAllocateReg platform my_reg freeRegs)
 
-                  let new_assign = addToUFM_Directly assig temp (InReg (RealRegUsage my_reg fmt))
+                  let new_assign = addToUFM_Directly assig temp (InReg (mkRealRegUsage platform my_reg fmt))
                   let instr = mkRegRegMoveInstr platform fmt
                                   (RegReal reg) (RegReal my_reg)
 
@@ -732,7 +732,7 @@ saveClobberedTemps clobbered dying
                   -- record why this reg was spilled for profiling
                   recordSpill (SpillClobber temp)
 
-                  let new_assign  = addToUFM_Directly assig temp (InBoth (RealRegUsage reg fmt) slot)
+                  let new_assign  = addToUFM_Directly assig temp (InBoth (mkRealRegUsage platform reg fmt) slot)
 
                   return (new_assign, (spill ++ instrs))
 
@@ -816,12 +816,12 @@ allocateRegsAndSpill
 allocateRegsAndSpill _       _    spills alloc []
         = return (spills, reverse alloc)
 
-allocateRegsAndSpill reading keep spills alloc (VirtualRegFormat r fmt:rs)
+allocateRegsAndSpill reading keep spills alloc (r@(VirtualRegFormat vr _fmt):rs)
  = do   assig <- toVRegMap <$> getAssigR
         -- pprTraceM "allocateRegsAndSpill:assig" (ppr (r:rs) $$ ppr assig)
         -- See Note [UniqFM and the register allocator]
-        let doSpill = allocRegsAndSpill_spill reading keep spills alloc (VirtualRegFormat r fmt) rs assig
-        case lookupUFM assig r of
+        let doSpill = allocRegsAndSpill_spill reading keep spills alloc r rs assig
+        case lookupUFM assig vr of
                 -- case (1a): already in a register
                 Just (InReg my_reg) ->
                         allocateRegsAndSpill reading keep spills (realReg my_reg:alloc) rs
@@ -832,14 +832,14 @@ allocateRegsAndSpill reading keep spills alloc (VirtualRegFormat r fmt:rs)
                 -- NB2. This is why we must process written registers here, even if they
                 -- are also read by the same instruction.
                 Just (InBoth my_reg _)
-                 -> do  when (not reading) (setAssigR $ toRegMap (addToUFM assig r (InReg my_reg)))
+                 -> do  when (not reading) (setAssigR $ toRegMap (addToUFM assig vr (InReg my_reg)))
                         allocateRegsAndSpill reading keep spills (realReg my_reg:alloc) rs
 
                 -- Not already in a register, so we need to find a free one...
                 Just (InMem slot) | reading   -> doSpill (ReadMem slot)
                                   | otherwise -> doSpill WriteMem
                 Nothing | reading   ->
-                   pprPanic "allocateRegsAndSpill: Cannot read from uninitialized register" (ppr r)
+                   pprPanic "allocateRegsAndSpill: Cannot read from uninitialized register" (ppr vr)
                    -- NOTE: if the input to the NCG contains some
                    -- unreachable blocks with junk code, this panic
                    -- might be triggered.  Make sure you only feed
@@ -873,14 +873,14 @@ allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr)
                         -> UniqFM VirtualReg Loc
                         -> SpillLoc
                         -> RegM freeRegs ([instr], [RealReg])
-allocRegsAndSpill_spill reading keep spills alloc (VirtualRegFormat r fmt) rs assig spill_loc
+allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegFormat vr fmt) rs assig spill_loc
  = do   platform <- getPlatform
         freeRegs <- getFreeRegsR
-        let regclass = classOfVirtualReg r
-            freeRegs_thisClass  = frGetFreeRegs platform regclass freeRegs :: [RealReg]
+        let regclass = if isIntFormat fmt then RcInteger else RcFloatOrVector
+            freeRegs_thisClass = frGetFreeRegs platform regclass freeRegs :: [RealReg]
 
         -- Can we put the variable into a register it already was?
-        pref_reg <- findPrefRealReg r
+        pref_reg <- findPrefRealReg vr
 
         case freeRegs_thisClass of
          -- case (2): we have a free register
@@ -891,10 +891,10 @@ allocRegsAndSpill_spill reading keep spills alloc (VirtualRegFormat r fmt) rs as
                         = reg
                         | otherwise
                         = first_free
-                spills'   <- loadTemp platform (VirtualRegFormat r fmt) spill_loc final_reg spills
+                spills'   <- loadTemp platform r spill_loc final_reg spills
 
                 setAssigR $ toRegMap
-                          $ (addToUFM assig r $! newLocation spill_loc $ RealRegUsage final_reg fmt)
+                          $ (addToUFM assig vr $! newLocation spill_loc $ mkRealRegUsage platform final_reg fmt)
                 setFreeRegsR $  frAllocateReg platform final_reg freeRegs
 
                 allocateRegsAndSpill reading keep spills' (final_reg : alloc) rs
@@ -916,30 +916,30 @@ allocRegsAndSpill_spill reading keep spills alloc (VirtualRegFormat r fmt) rs as
                 let candidates = nonDetUFMToList candidates'
 
                 -- the vregs we could kick out that are already in a slot
-                let compat reg' r'
+                let compat reg'
                       =  targetClassOfRealReg platform reg'
-                      == classOfVirtualReg r'
+                      == regclass
                     candidates_inBoth :: [(Unique, RealRegUsage, StackSlot)]
                     candidates_inBoth
                         = [ (temp, reg, mem)
                           | (temp, InBoth reg mem) <- candidates
-                          , compat (realReg reg) r ]
+                          , compat (realReg reg) ]
 
                 -- the vregs we could kick out that are only in a reg
                 --      this would require writing the reg to a new slot before using it.
                 let candidates_inReg
                         = [ (temp, reg)
                           | (temp, InReg reg) <- candidates
-                          , compat (realReg reg) r ]
+                          , compat (realReg reg) ]
 
                 let result
 
                         -- we have a temporary that is in both register and mem,
                         -- just free up its register for use.
-                        | (temp, myRegUse@(RealRegUsage my_reg fmt), slot) : _      <- candidates_inBoth
-                        = do    spills' <- loadTemp platform (VirtualRegFormat r fmt) spill_loc my_reg spills
+                        | (temp, (RealRegUsage my_reg _old_fmt), slot) : _ <- candidates_inBoth
+                        = do    spills' <- loadTemp platform r spill_loc my_reg spills
                                 let assig1  = addToUFM_Directly assig temp (InMem slot)
-                                let assig2  = addToUFM assig1 r $! newLocation spill_loc myRegUse
+                                let assig2  = addToUFM assig1 vr $! newLocation spill_loc (mkRealRegUsage platform my_reg fmt)
 
                                 setAssigR $ toRegMap assig2
                                 allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs
@@ -955,12 +955,12 @@ allocRegsAndSpill_spill reading keep spills alloc (VirtualRegFormat r fmt) rs as
                                 recordSpill (SpillAlloc temp_to_push_out)
 
                                 -- update the register assignment
-                                let assig1  = addToUFM_Directly assig temp_to_push_out   (InMem slot)
-                                let assig2  = addToUFM assig1 r                 $! newLocation spill_loc (RealRegUsage my_reg fmt)
+                                let assig1  = addToUFM_Directly assig temp_to_push_out (InMem slot)
+                                let assig2  = addToUFM assig1 vr $! newLocation spill_loc (mkRealRegUsage platform my_reg fmt)
                                 setAssigR $ toRegMap assig2
 
                                 -- if need be, load up a spilled temp into the reg we've just freed up.
-                                spills' <- loadTemp platform (VirtualRegFormat r fmt) spill_loc my_reg spills
+                                spills' <- loadTemp platform r spill_loc my_reg spills
 
                                 allocateRegsAndSpill reading keep
                                         (spill_store ++ spills')
@@ -971,8 +971,9 @@ allocRegsAndSpill_spill reading keep spills alloc (VirtualRegFormat r fmt) rs as
                         | otherwise
                         = pprPanic ("RegAllocLinear.allocRegsAndSpill: no spill candidates\n")
                         $ vcat
-                                [ text "allocating vreg:  " <> text (show r)
+                                [ text "allocating vreg:  " <> text (show vr)
                                 , text "assignment:       " <> ppr assig
+                                , text "format:           " <> ppr fmt
                                 , text "freeRegs:         " <> text (showRegs freeRegs)
                                 , text "initFreeRegs:     " <> text (showRegs (frInitFreeRegs platform `asTypeOf` freeRegs))
                                 ]


=====================================
compiler/GHC/CmmToAsm/Reg/Target.hs
=====================================
@@ -15,7 +15,7 @@ module GHC.CmmToAsm.Reg.Target (
         targetMkVirtualReg,
         targetRegDotColor,
         targetClassOfReg,
-        mkRegFormat, mapRegFormatSet,
+        mkVirtualRegFormat, mkRegFormat, mapRegFormatSet,
 )
 
 where
@@ -142,6 +142,17 @@ targetClassOfReg platform reg
    RegVirtual vr -> classOfVirtualReg vr
    RegReal rr -> targetClassOfRealReg platform rr
 
+mkVirtualRegFormat :: HasDebugCallStack => VirtualReg -> Format -> VirtualRegFormat
+mkVirtualRegFormat reg fmt
+  = assertPpr (regCls == fmtCls)
+    (vcat [ text "mkVirtualRegFormat: incompatible register & format"
+          , text "reg:" <+> ppr reg <+> dcolon <+> ppr regCls
+          , text "fmt:" <+> ppr fmt <+> parens (ppr fmtCls) ])
+  $ VirtualRegFormat reg fmt
+  where
+    regCls = classOfVirtualReg reg
+    fmtCls = formatRegClass fmt
+
 mkRegFormat :: HasDebugCallStack => Platform -> Reg -> Format -> RegFormat
 mkRegFormat platform reg fmt
   = assertPpr (regCls == fmtCls)


=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -35,6 +35,7 @@ import GHC.CmmToAsm.X86.Cond
 import GHC.CmmToAsm.X86.Regs
 import GHC.CmmToAsm.X86.Ppr
 import GHC.CmmToAsm.X86.RegInfo
+import GHC.CmmToAsm.Reg.Target
 
 import GHC.Platform.Regs
 import GHC.CmmToAsm.CPrim
@@ -89,6 +90,7 @@ import Data.Maybe
 import Data.Word
 
 import qualified Data.Map as M
+import GHC.Platform.Reg.Class (RegClass(..))
 
 is32BitPlatform :: NatM Bool
 is32BitPlatform = do
@@ -518,24 +520,41 @@ getSomeReg expr = do
         return (reg, code)
 
 
+mkMOV :: HasDebugCallStack => Platform -> Format -> Operand -> Operand -> Instr
+mkMOV platform fmt op1 op2 =
+  assertPpr (all (== fmtCls) $ catMaybes [cls1, cls2])
+    (vcat [ text "invalid mkMOV instruction"
+          , text "fmt:" <+> ppr fmt
+          , case op1 of { OpReg r1 -> ppr r1 <+> dcolon <+> ppr (fromJust cls1); _ -> empty }
+          , case op2 of { OpReg r2 -> ppr r2 <+> dcolon <+> ppr (fromJust cls2); _ -> empty }
+          ])
+    $ MOV fmt op1 op2
+
+  where
+    fmtCls = if isIntFormat fmt then RcInteger else RcFloatOrVector
+    cls1 = case op1 of { OpReg r1 -> Just (targetClassOfReg platform r1); _ -> Nothing }
+    cls2 = case op2 of { OpReg r2 -> Just (targetClassOfReg platform r2); _ -> Nothing }
+
 assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
 assignMem_I64Code addrTree valueTree = do
+  platform <- getPlatform
   Amode addr addr_code <- getAmode addrTree
   RegCode64 vcode rhi rlo <- iselExpr64 valueTree
   let
         -- Little-endian store
-        mov_lo = MOV II32 (OpReg rlo) (OpAddr addr)
-        mov_hi = MOV II32 (OpReg rhi) (OpAddr (fromJust (addrOffset addr 4)))
+        mov_lo = mkMOV platform II32 (OpReg rlo) (OpAddr addr)
+        mov_hi = mkMOV platform II32 (OpReg rhi) (OpAddr (fromJust (addrOffset addr 4)))
   return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
 
 
 assignReg_I64Code :: CmmReg  -> CmmExpr -> NatM InstrBlock
 assignReg_I64Code (CmmLocal dst) valueTree = do
+   platform <- getPlatform
    RegCode64 vcode r_src_hi r_src_lo <- iselExpr64 valueTree
    let
          Reg64 r_dst_hi r_dst_lo = localReg64 dst
-         mov_lo = MOV II32 (OpReg r_src_lo) (OpReg r_dst_lo)
-         mov_hi = MOV II32 (OpReg r_src_hi) (OpReg r_dst_hi)
+         mov_lo = mkMOV platform II32 (OpReg r_src_lo) (OpReg r_dst_lo)
+         mov_hi = mkMOV platform II32 (OpReg r_src_hi) (OpReg r_dst_hi)
    return (
         vcode `snocOL` mov_lo `snocOL` mov_hi
      )
@@ -545,22 +564,24 @@ assignReg_I64Code _ _
 
 iselExpr64 :: HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
 iselExpr64 (CmmLit (CmmInt i _)) = do
+  platform <- getPlatform
   Reg64 rhi rlo <- getNewReg64
   let
         r = fromIntegral (fromIntegral i :: Word32)
         q = fromIntegral (fromIntegral (i `shiftR` 32) :: Word32)
         code = toOL [
-                MOV II32 (OpImm (ImmInteger r)) (OpReg rlo),
-                MOV II32 (OpImm (ImmInteger q)) (OpReg rhi)
+                mkMOV platform II32 (OpImm (ImmInteger r)) (OpReg rlo),
+                mkMOV platform II32 (OpImm (ImmInteger q)) (OpReg rhi)
                 ]
   return (RegCode64 code rhi rlo)
 
 iselExpr64 (CmmLoad addrTree ty _) | isWord64 ty = do
+   platform <- getPlatform
    Amode addr addr_code <- getAmode addrTree
    Reg64 rhi rlo <- getNewReg64
    let
-        mov_lo = MOV II32 (OpAddr addr) (OpReg rlo)
-        mov_hi = MOV II32 (OpAddr (fromJust (addrOffset addr 4))) (OpReg rhi)
+        mov_lo = mkMOV platform II32 (OpAddr addr) (OpReg rlo)
+        mov_hi = mkMOV platform II32 (OpAddr (fromJust (addrOffset addr 4))) (OpReg rhi)
    return (
             RegCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi) rhi rlo
      )
@@ -570,41 +591,44 @@ iselExpr64 (CmmReg (CmmLocal local_reg)) = do
   return (RegCode64 nilOL hi lo)
 
 iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)]) = do
+   platform <- getPlatform
    RegCode64 code1 r1hi r1lo <- iselExpr64 e1
    Reg64 rhi rlo <- getNewReg64
    let
         r = fromIntegral (fromIntegral i :: Word32)
         q = fromIntegral (fromIntegral (i `shiftR` 32) :: Word32)
         code =  code1 `appOL`
-                toOL [ MOV II32 (OpReg r1lo) (OpReg rlo),
+                toOL [ mkMOV platform II32 (OpReg r1lo) (OpReg rlo),
                        ADD II32 (OpImm (ImmInteger r)) (OpReg rlo),
-                       MOV II32 (OpReg r1hi) (OpReg rhi),
+                       mkMOV platform II32 (OpReg r1hi) (OpReg rhi),
                        ADC II32 (OpImm (ImmInteger q)) (OpReg rhi) ]
    return (RegCode64 code rhi rlo)
 
 iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
+   platform <- getPlatform
    RegCode64 code1 r1hi r1lo <- iselExpr64 e1
    RegCode64 code2 r2hi r2lo <- iselExpr64 e2
    Reg64 rhi rlo <- getNewReg64
    let
         code =  code1 `appOL`
                 code2 `appOL`
-                toOL [ MOV II32 (OpReg r1lo) (OpReg rlo),
+                toOL [ mkMOV platform II32 (OpReg r1lo) (OpReg rlo),
                        ADD II32 (OpReg r2lo) (OpReg rlo),
-                       MOV II32 (OpReg r1hi) (OpReg rhi),
+                       mkMOV platform II32 (OpReg r1hi) (OpReg rhi),
                        ADC II32 (OpReg r2hi) (OpReg rhi) ]
    return (RegCode64 code rhi rlo)
 
 iselExpr64 (CmmMachOp (MO_Sub _) [e1,e2]) = do
+   platform <- getPlatform
    RegCode64 code1 r1hi r1lo <- iselExpr64 e1
    RegCode64 code2 r2hi r2lo <- iselExpr64 e2
    Reg64 rhi rlo <- getNewReg64
    let
         code =  code1 `appOL`
                 code2 `appOL`
-                toOL [ MOV II32 (OpReg r1lo) (OpReg rlo),
+                toOL [ mkMOV platform II32 (OpReg r1lo) (OpReg rlo),
                        SUB II32 (OpReg r2lo) (OpReg rlo),
-                       MOV II32 (OpReg r1hi) (OpReg rhi),
+                       mkMOV platform II32 (OpReg r1hi) (OpReg rhi),
                        SBB II32 (OpReg r2hi) (OpReg rhi) ]
    return (RegCode64 code rhi rlo)
 
@@ -637,44 +661,48 @@ iselExpr64 (CmmMachOp (MO_UU_Conv W8 W64) [expr]) = do
                           r_dst_lo
 
 iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do
+     platform <- getPlatform
      code <- getAnyReg expr
      Reg64 r_dst_hi r_dst_lo <- getNewReg64
      return $ RegCode64 (code r_dst_lo `snocOL`
-                          MOV II32 (OpReg r_dst_lo) (OpReg eax) `snocOL`
+                          mkMOV platform II32 (OpReg r_dst_lo) (OpReg eax) `snocOL`
                           CLTD II32 `snocOL`
-                          MOV II32 (OpReg eax) (OpReg r_dst_lo) `snocOL`
-                          MOV II32 (OpReg edx) (OpReg r_dst_hi))
+                          mkMOV platform II32 (OpReg eax) (OpReg r_dst_lo) `snocOL`
+                          mkMOV platform II32 (OpReg edx) (OpReg r_dst_hi))
                           r_dst_hi
                           r_dst_lo
 
 iselExpr64 (CmmMachOp (MO_SS_Conv W16 W64) [expr]) = do
+     platform <- getPlatform
      (r, code) <- getByteReg expr
      Reg64 r_dst_hi r_dst_lo <- getNewReg64
      return $ RegCode64 (code `appOL` toOL [
                           MOVSxL II16 (OpReg r) (OpReg eax),
                           CLTD II32,
-                          MOV II32 (OpReg eax) (OpReg r_dst_lo),
-                          MOV II32 (OpReg edx) (OpReg r_dst_hi)])
+                          mkMOV platform II32 (OpReg eax) (OpReg r_dst_lo),
+                          mkMOV platform II32 (OpReg edx) (OpReg r_dst_hi)])
                           r_dst_hi
                           r_dst_lo
 
 iselExpr64 (CmmMachOp (MO_SS_Conv W8 W64) [expr]) = do
+     platform <- getPlatform
      (r, code) <- getByteReg expr
      Reg64 r_dst_hi r_dst_lo <- getNewReg64
      return $ RegCode64 (code `appOL` toOL [
                           MOVSxL II8 (OpReg r) (OpReg eax),
                           CLTD II32,
-                          MOV II32 (OpReg eax) (OpReg r_dst_lo),
-                          MOV II32 (OpReg edx) (OpReg r_dst_hi)])
+                          mkMOV platform II32 (OpReg eax) (OpReg r_dst_lo),
+                          mkMOV platform II32 (OpReg edx) (OpReg r_dst_hi)])
                           r_dst_hi
                           r_dst_lo
 
 iselExpr64 (CmmMachOp (MO_S_Neg _) [expr]) = do
+   platform <- getPlatform
    RegCode64 code rhi rlo <- iselExpr64 expr
    Reg64 rohi rolo <- getNewReg64
    let
         ocode = code `appOL`
-                toOL [ MOV II32 (OpReg rlo) (OpReg rolo),
+                toOL [ mkMOV platform II32 (OpReg rlo) (OpReg rolo),
                        XOR II32 (OpReg rohi) (OpReg rohi),
                        NEGI II32 (OpReg rolo),
                        SBB II32 (OpReg rhi) (OpReg rohi) ]
@@ -690,6 +718,7 @@ iselExpr64 (CmmMachOp (MO_S_Neg _) [expr]) = do
 -- Note that @(r1hi * r2hi) << 64@ can be dropped because it overflows completely.
 
 iselExpr64 (CmmMachOp (MO_Mul _) [e1,e2]) = do
+   platform <- getPlatform
    RegCode64 code1 r1hi r1lo <- iselExpr64 e1
    RegCode64 code2 r2hi r2lo <- iselExpr64 e2
    Reg64 rhi rlo <- getNewReg64
@@ -697,26 +726,27 @@ iselExpr64 (CmmMachOp (MO_Mul _) [e1,e2]) = do
    let
         code =  code1 `appOL`
                 code2 `appOL`
-                toOL [ MOV  II32 (OpReg r1lo) (OpReg eax),
-                       MOV  II32 (OpReg r2lo) (OpReg tmp),
-                       MOV  II32 (OpReg r1hi) (OpReg rhi),
+                toOL [ mkMOV platform  II32 (OpReg r1lo) (OpReg eax),
+                       mkMOV platform  II32 (OpReg r2lo) (OpReg tmp),
+                       mkMOV platform  II32 (OpReg r1hi) (OpReg rhi),
                        IMUL II32 (OpReg tmp) (OpReg rhi),
-                       MOV  II32 (OpReg r2hi) (OpReg rlo),
+                       mkMOV platform  II32 (OpReg r2hi) (OpReg rlo),
                        IMUL II32 (OpReg eax) (OpReg rlo),
                        ADD  II32 (OpReg rlo) (OpReg rhi),
                        MUL2 II32 (OpReg tmp),
                        ADD  II32 (OpReg edx) (OpReg rhi),
-                       MOV  II32 (OpReg eax) (OpReg rlo)
+                       mkMOV platform  II32 (OpReg eax) (OpReg rlo)
                      ]
    return (RegCode64 code rhi rlo)
 
 iselExpr64 (CmmMachOp (MO_S_MulMayOflo W64) _) = do
+   platform <- getPlatform
    -- Performance sensitive users won't use 32 bit so let's keep it simple:
    -- We always return a (usually false) positive.
    Reg64 rhi rlo <- getNewReg64
    let code = toOL   [
-                       MOV  II32 (OpImm (ImmInt 1)) (OpReg rhi),
-                       MOV  II32 (OpImm (ImmInt 1)) (OpReg rlo)
+                       mkMOV platform  II32 (OpImm (ImmInt 1)) (OpReg rhi),
+                       mkMOV platform  II32 (OpImm (ImmInt 1)) (OpReg rlo)
                      ]
    return (RegCode64 code rhi rlo)
 
@@ -730,6 +760,7 @@ iselExpr64 (CmmMachOp (MO_S_MulMayOflo W64) _) = do
 -- the contents of @rlo@ to @rhi@ and clear @rlo at .
 
 iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do
+   platform <- getPlatform
    RegCode64 code1 r1hi r1lo <- iselExpr64 e1
    code2 <- getAnyReg e2
    Reg64 rhi rlo <- getNewReg64
@@ -738,15 +769,15 @@ iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do
    let
         code =  code1 `appOL`
                 code2 ecx `appOL`
-                toOL [ MOV II32 (OpReg r1lo) (OpReg rlo),
-                       MOV II32 (OpReg r1hi) (OpReg rhi),
+                toOL [ mkMOV platform II32 (OpReg r1lo) (OpReg rlo),
+                       mkMOV platform II32 (OpReg r1hi) (OpReg rhi),
                        SHLD II32 (OpReg ecx) (OpReg rlo) (OpReg rhi),
                        SHL II32 (OpReg ecx) (OpReg rlo),
                        TEST II32 (OpImm (ImmInt 32)) (OpReg ecx),
                        JXX EQQ lbl2,
                        JXX ALWAYS lbl1,
                        NEWBLOCK lbl1,
-                       MOV II32 (OpReg rlo) (OpReg rhi),
+                       mkMOV platform II32 (OpReg rlo) (OpReg rhi),
                        XOR II32 (OpReg rlo) (OpReg rlo),
                        JXX ALWAYS lbl2,
                        NEWBLOCK lbl2
@@ -760,6 +791,7 @@ iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do
 -- To accomplish that we shift @rhi@ by 31.
 
 iselExpr64 (CmmMachOp (MO_S_Shr _) [e1,e2]) = do
+   platform <- getPlatform
    RegCode64 code1 r1hi r1lo <- iselExpr64 e1
    (r2, code2) <- getSomeReg e2
    Reg64 rhi rlo <- getNewReg64
@@ -768,16 +800,16 @@ iselExpr64 (CmmMachOp (MO_S_Shr _) [e1,e2]) = do
    let
         code =  code1 `appOL`
                 code2 `appOL`
-                toOL [ MOV II32 (OpReg r1lo) (OpReg rlo),
-                       MOV II32 (OpReg r1hi) (OpReg rhi),
-                       MOV II32 (OpReg r2) (OpReg ecx),
+                toOL [ mkMOV platform II32 (OpReg r1lo) (OpReg rlo),
+                       mkMOV platform II32 (OpReg r1hi) (OpReg rhi),
+                       mkMOV platform II32 (OpReg r2) (OpReg ecx),
                        SHRD II32 (OpReg ecx) (OpReg rhi) (OpReg rlo),
                        SAR II32 (OpReg ecx) (OpReg rhi),
                        TEST II32 (OpImm (ImmInt 32)) (OpReg ecx),
                        JXX EQQ lbl2,
                        JXX ALWAYS lbl1,
                        NEWBLOCK lbl1,
-                       MOV II32 (OpReg rhi) (OpReg rlo),
+                       mkMOV platform II32 (OpReg rhi) (OpReg rlo),
                        SAR II32 (OpImm (ImmInt 31)) (OpReg rhi),
                        JXX ALWAYS lbl2,
                        NEWBLOCK lbl2
@@ -787,6 +819,7 @@ iselExpr64 (CmmMachOp (MO_S_Shr _) [e1,e2]) = do
 -- Similar to the above.
 
 iselExpr64 (CmmMachOp (MO_U_Shr _) [e1,e2]) = do
+   platform <- getPlatform
    RegCode64 code1 r1hi r1lo <- iselExpr64 e1
    (r2, code2) <- getSomeReg e2
    Reg64 rhi rlo <- getNewReg64
@@ -795,16 +828,16 @@ iselExpr64 (CmmMachOp (MO_U_Shr _) [e1,e2]) = do
    let
         code =  code1 `appOL`
                 code2 `appOL`
-                toOL [ MOV II32 (OpReg r1lo) (OpReg rlo),
-                       MOV II32 (OpReg r1hi) (OpReg rhi),
-                       MOV II32 (OpReg r2) (OpReg ecx),
+                toOL [ mkMOV platform II32 (OpReg r1lo) (OpReg rlo),
+                       mkMOV platform II32 (OpReg r1hi) (OpReg rhi),
+                       mkMOV platform II32 (OpReg r2) (OpReg ecx),
                        SHRD II32 (OpReg ecx) (OpReg rhi) (OpReg rlo),
                        SHR II32 (OpReg ecx) (OpReg rhi),
                        TEST II32 (OpImm (ImmInt 32)) (OpReg ecx),
                        JXX EQQ lbl2,
                        JXX ALWAYS lbl1,
                        NEWBLOCK lbl1,
-                       MOV II32 (OpReg rhi) (OpReg rlo),
+                       mkMOV platform II32 (OpReg rhi) (OpReg rlo),
                        XOR II32 (OpReg rhi) (OpReg rhi),
                        JXX ALWAYS lbl2,
                        NEWBLOCK lbl2
@@ -816,12 +849,13 @@ iselExpr64 (CmmMachOp (MO_Or  _) [e1,e2]) = iselExpr64ParallelBin OR  e1 e2
 iselExpr64 (CmmMachOp (MO_Xor _) [e1,e2]) = iselExpr64ParallelBin XOR e1 e2
 
 iselExpr64 (CmmMachOp (MO_Not _) [e1]) = do
+   platform <- getPlatform
    RegCode64 code1 r1hi r1lo <- iselExpr64 e1
    Reg64 rhi rlo <- getNewReg64
    let
         code =  code1 `appOL`
-                toOL [ MOV II32 (OpReg r1lo) (OpReg rlo),
-                       MOV II32 (OpReg r1hi) (OpReg rhi),
+                toOL [ mkMOV platform II32 (OpReg r1lo) (OpReg rlo),
+                       mkMOV platform II32 (OpReg r1hi) (OpReg rhi),
                        NOT II32 (OpReg rlo),
                        NOT II32 (OpReg rhi)
                      ]
@@ -837,14 +871,15 @@ iselExpr64 expr
 iselExpr64ParallelBin :: (Format -> Operand -> Operand -> Instr)
                       -> CmmExpr -> CmmExpr -> NatM (RegCode64 (OrdList Instr))
 iselExpr64ParallelBin op e1 e2 = do
+   platform <- getPlatform
    RegCode64 code1 r1hi r1lo <- iselExpr64 e1
    RegCode64 code2 r2hi r2lo <- iselExpr64 e2
    Reg64 rhi rlo <- getNewReg64
    let
         code =  code1 `appOL`
                 code2 `appOL`
-                toOL [ MOV II32 (OpReg r1lo) (OpReg rlo),
-                       MOV II32 (OpReg r1hi) (OpReg rhi),
+                toOL [ mkMOV platform II32 (OpReg r1lo) (OpReg rlo),
+                       mkMOV platform II32 (OpReg r1hi) (OpReg rhi),
                        op  II32 (OpReg r2lo) (OpReg rlo),
                        op  II32 (OpReg r2hi) (OpReg rhi)
                      ]
@@ -993,7 +1028,8 @@ getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W16 W64) [CmmLoad addr _ _])
 
 getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W32 W64) [CmmLoad addr _ _])
  | not is32Bit = do
-  code <- intLoadCode (MOV II32) addr -- 32-bit loads zero-extend
+  platform <- getPlatform
+  code <- intLoadCode (mkMOV platform II32) addr -- 32-bit loads zero-extend
   return (Any II64 code)
 
 getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W32 W64) [CmmLoad addr _ _])
@@ -1060,16 +1096,16 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
       MO_SS_Conv W16 W32 -> integerExtend W16 W32 MOVSxL x
       MO_SS_Conv W8  W16 -> integerExtend W8  W16 MOVSxL x
 
-      -- We don't care about the upper bits for MO_XX_Conv, so MOV is enough. However, on 32-bit we
+      -- We don't care about the upper bits for MO_XX_Conv, so mkMOV platform is enough. However, on 32-bit we
       -- have 8-bit registers only for a few registers (as opposed to x86-64 where every register
       -- has 8-bit version). So for 32-bit code, we'll just zero-extend.
       MO_XX_Conv W8  W32
           | is32Bit   -> integerExtend W8 W32 MOVZxL x
-          | otherwise -> integerExtend W8 W32 MOV x
+          | otherwise -> integerExtend W8 W32 (mkMOV platform) x
       MO_XX_Conv W8  W16
           | is32Bit   -> integerExtend W8 W16 MOVZxL x
-          | otherwise -> integerExtend W8 W16 MOV x
-      MO_XX_Conv W16 W32 -> integerExtend W16 W32 MOV x
+          | otherwise -> integerExtend W8 W16 (mkMOV platform) x
+      MO_XX_Conv W16 W32 -> integerExtend W16 W32 (mkMOV platform) x
 
       MO_UU_Conv W8  W64 | not is32Bit -> integerExtend W8  W64 MOVZxL x
       MO_UU_Conv W16 W64 | not is32Bit -> integerExtend W16 W64 MOVZxL x
@@ -1082,10 +1118,10 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
       -- away as an unnecessary reg-to-reg move, so we keep it in
       -- the form of a movzl and print it as a movl later.
       -- This doesn't apply to MO_XX_Conv since in this case we don't care about
-      -- the upper bits. So we can just use MOV.
-      MO_XX_Conv W8  W64 | not is32Bit -> integerExtend W8  W64 MOV x
-      MO_XX_Conv W16 W64 | not is32Bit -> integerExtend W16 W64 MOV x
-      MO_XX_Conv W32 W64 | not is32Bit -> integerExtend W32 W64 MOV x
+      -- the upper bits. So we can just use mkMOV platform.
+      MO_XX_Conv W8  W64 | not is32Bit -> integerExtend W8  W64 (mkMOV platform) x
+      MO_XX_Conv W16 W64 | not is32Bit -> integerExtend W16 W64 (mkMOV platform) x
+      MO_XX_Conv W32 W64 | not is32Bit -> integerExtend W32 W64 (mkMOV platform) x
 
       MO_FF_Conv W32 W64 -> coerceFP2FP W64 x
       MO_FF_Conv W64 W32 -> coerceFP2FP W32 x
@@ -1309,7 +1345,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
           (reg, exp) <- getSomeReg expr
           let fmt = VecFormat len FmtInt64
           return $ Any fmt (\dst -> exp `snocOL`
-                                    (MOV II64 (OpReg reg) (OpReg dst)) `snocOL`
+                                    (mkMOV platform II64 (OpReg reg) (OpReg dst)) `snocOL`
                                     (PUNPCKLQDQ fmt (OpReg dst) dst) `snocOL`
                                     (PUNPCKLQDQ fmt (OpReg dst) dst) `snocOL`
                                     (PUNPCKLQDQ fmt (OpReg dst) dst) `snocOL`
@@ -1704,7 +1740,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
           imm      = litToImm lit
           code dst
             = case lit of
-                CmmInt 0 _ -> exp `snocOL` (MOV FF32 (OpReg r) (OpReg dst))
+                CmmInt 0 _ -> exp `snocOL` (mkMOV platform FF32 (OpReg r) (OpReg dst))
                 CmmInt _ _ -> exp `snocOL` (VPSHUFD format imm (OpReg r) dst)
                 _          -> panic "Error in offset while unpacking"
       return (Any format code)
@@ -1715,7 +1751,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
           code dst
             = case lit of
                 CmmInt 0 _ -> exp `snocOL`
-                              (MOV FF64 (OpReg r) (OpReg dst))
+                              (mkMOV platform FF64 (OpReg r) (OpReg dst))
                 CmmInt 1 _ -> exp `snocOL`
                               (MOVHLPS format (OpReg r) dst)
                 _          -> panic "Error in offset while unpacking"
@@ -1757,10 +1793,10 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
       let code dst
             = case lit of
                 CmmInt 0 _ -> exp `snocOL`
-                              (MOV II64 (OpReg r) (OpReg dst))
+                              (mkMOV platform II64 (OpReg r) (OpReg dst))
                 CmmInt 1 _ -> exp `snocOL`
                               (MOVHLPS fmt (OpReg r) tmp) `snocOL`
-                              (MOV II64 (OpReg tmp) (OpReg dst))
+                              (mkMOV platform II64 (OpReg tmp) (OpReg dst))
                 _          -> panic "Error in offset while unpacking"
       return (Any fmt code)
     vector_int_unpack_sse _ w c e
@@ -1901,11 +1937,11 @@ getRegister' platform _is32Bit (CmmMachOp mop [x, y, z]) = do -- ternary MachOps
               = case offset of
                   CmmInt 0 _ -> valExp `appOL`
                                 vecExp `snocOL`
-                                (MOV FF64 (OpReg valReg) (OpReg dst)) `snocOL`
+                                (mkMOV platform FF64 (OpReg valReg) (OpReg dst)) `snocOL`
                                 (SHUFPD fmt (ImmInt 0b00) (OpReg vecReg) dst)
                   CmmInt 1 _ -> valExp `appOL`
                                 vecExp `snocOL`
-                                (MOV FF64 (OpReg vecReg) (OpReg dst)) `snocOL`
+                                (mkMOV platform FF64 (OpReg vecReg) (OpReg dst)) `snocOL`
                                 (SHUFPD fmt (ImmInt 0b00) (OpReg valReg) dst)
                   _ -> pprPanic "MO_VF_Insert DoubleX2: unsupported offset" (ppr offset)
          in return $ Any fmt code
@@ -1942,12 +1978,12 @@ getRegister' platform _is32Bit (CmmMachOp mop [x, y, z]) = do -- ternary MachOps
                   CmmInt 0 _ -> valExp `appOL`
                                 vecExp `snocOL`
                                 (MOVHLPS fmt (OpReg vecReg) tmp) `snocOL`
-                                (MOV II64 (OpReg valReg) (OpReg dst)) `snocOL`
+                                (mkMOV platform II64 (OpReg valReg) (OpReg dst)) `snocOL`
                                 (PUNPCKLQDQ fmt (OpReg tmp) dst)
                   CmmInt 1 _ -> valExp `appOL`
                                 vecExp `snocOL`
-                                (MOV fmt (OpReg vecReg) (OpReg dst)) `snocOL`
-                                (MOV II64 (OpReg valReg) (OpReg tmp)) `snocOL`
+                                (mkMOV platform fmt (OpReg vecReg) (OpReg dst)) `snocOL`
+                                (mkMOV platform II64 (OpReg valReg) (OpReg tmp)) `snocOL`
                                 (PUNPCKLQDQ fmt (OpReg tmp) dst)
                   _ -> pprPanic "MO_V_Insert Int64X2: unsupported offset" (ppr offset)
          in return $ Any fmt code
@@ -1983,14 +2019,16 @@ getRegister' _ _ (CmmLoad mem pk _)
 getRegister' _ is32Bit (CmmLoad mem pk _)
   | is32Bit && not (isWord64 pk)
   = do
+    platform <- getPlatform
+    let
+      instr = case width of
+                W8     -> MOVZxL II8
+                _other -> mkMOV platform format
     code <- intLoadCode instr mem
     return (Any format code)
   where
     width = typeWidth pk
     format = intFormat width
-    instr = case width of
-                W8     -> MOVZxL II8
-                _other -> MOV format
         -- We always zero-extend 8-bit loads, if we
         -- can't think of anything better.  This is because
         -- we can't guarantee access to an 8-bit variant of every register
@@ -2001,7 +2039,8 @@ getRegister' _ is32Bit (CmmLoad mem pk _)
 getRegister' _ is32Bit (CmmLoad mem pk _)
  | not is32Bit
   = do
-    code <- intLoadCode (MOV format) mem
+    platform <- getPlatform
+    code <- intLoadCode (mkMOV platform format) mem
     return (Any format code)
   where format = intFormat $ typeWidth pk
 
@@ -2042,7 +2081,7 @@ getRegister' platform is32Bit (CmmLit lit)
   | not is32Bit, isWord64 (cmmLitType platform lit), not (isBigLit lit)
   = let
         imm = litToImm lit
-        code dst = unitOL (MOV II32 (OpImm imm) (OpReg dst))
+        code dst = unitOL (mkMOV platform II32 (OpImm imm) (OpReg dst))
     in
         return (Any II64 code)
   where
@@ -2071,7 +2110,7 @@ getRegister' platform _ (CmmLit lit)
       = do
       let format = cmmTypeFormat ctype
           imm = litToImm lit
-          code dst = unitOL (MOV format (OpImm imm) (OpReg dst))
+          code dst = unitOL (mkMOV platform format (OpImm imm) (OpReg dst))
       return (Any format code)
 
 getRegister' platform _ other
@@ -2409,9 +2448,10 @@ memConstant align lit = do
 
 loadFloatAmode :: Width -> AddrMode -> InstrBlock -> NatM Register
 loadFloatAmode w addr addr_code = do
+  platform <- getPlatform
   let format = floatFormat w
       code dst = addr_code `snocOL`
-                    MOV format (OpAddr addr) (OpReg dst)
+                    mkMOV platform format (OpAddr addr) (OpReg dst)
 
   return (Any format code)
 
@@ -2584,19 +2624,19 @@ condIntCode' platform cond x y
         cmpExact :: OrdList Instr
         cmpExact =
           toOL
-            [ MOV II32 (OpReg r1_hi) (OpReg tmp1)
-            , MOV II32 (OpReg r1_lo) (OpReg tmp2)
+            [ mkMOV platform II32 (OpReg r1_hi) (OpReg tmp1)
+            , mkMOV platform II32 (OpReg r1_lo) (OpReg tmp2)
             , XOR II32 (OpReg r2_hi) (OpReg tmp1)
             , XOR II32 (OpReg r2_lo) (OpReg tmp2)
             , OR  II32 (OpReg tmp1)  (OpReg tmp2)
             ]
         cmpGE = toOL
-            [ MOV II32 (OpReg r1_hi) (OpReg tmp1)
+            [ mkMOV platform II32 (OpReg r1_hi) (OpReg tmp1)
             , CMP II32 (OpReg r2_lo) (OpReg r1_lo)
             , SBB II32 (OpReg r2_hi) (OpReg tmp1)
             ]
         cmpLE = toOL
-            [ MOV II32 (OpReg r2_hi) (OpReg tmp1)
+            [ mkMOV platform II32 (OpReg r2_hi) (OpReg tmp1)
             , CMP II32 (OpReg r1_lo) (OpReg r2_lo)
             , SBB II32 (OpReg r1_hi) (OpReg tmp1)
             ]
@@ -2736,10 +2776,10 @@ assignMem_IntCode pk addr src = do
     let
         code = code_src `appOL`
                code_addr `snocOL`
-                  MOV pk op_src (OpAddr addr)
+                  mkMOV platform pk op_src (OpAddr addr)
         -- NOTE: op_src is stable, so it will still be valid
         -- after code_addr.  This may involve the introduction
-        -- of an extra MOV to a temporary register, but we hope
+        -- of an extra mkMOV platform to a temporary register, but we hope
         -- the register allocator will get rid of it.
     --
     return code
@@ -2754,7 +2794,8 @@ assignMem_IntCode pk addr src = do
 
 -- Assign; dst is a reg, rhs is mem
 assignReg_IntCode pk reg (CmmLoad src _ _) = do
-  load_code <- intLoadCode (MOV pk) src
+  platform <- getPlatform
+  load_code <- intLoadCode (mkMOV platform pk) src
   platform <- ncgPlatform <$> getConfig
   return (load_code (getRegisterReg platform reg))
 
@@ -2767,12 +2808,13 @@ assignReg_IntCode _ reg src = do
 
 -- Floating point assignment to memory
 assignMem_FltCode pk addr src = do
+  platform <- getPlatform
   (src_reg, src_code) <- getNonClobberedReg src
   Amode addr addr_code <- getAmode addr
   let
         code = src_code `appOL`
                addr_code `snocOL`
-               MOV pk (OpReg src_reg) (OpAddr addr)
+               mkMOV platform pk (OpReg src_reg) (OpAddr addr)
 
   return code
 
@@ -3324,7 +3366,7 @@ genCCall32 addr _ dest_regs args = do
                                       in
 
                                       -- assume SSE2
-                                       MOV format (OpReg reg) (OpAddr addr)
+                                       mkMOV platform format (OpReg reg) (OpAddr addr)
 
                                      ]
                                )
@@ -3406,12 +3448,12 @@ genCCall32 addr _ dest_regs args = do
                                    -- NB: This code will need to be
                                    -- revisited once GHC does more work around
                                    -- SIGFPE f
-                                   MOV fmt (OpAddr tmp_amode) (OpReg r_dest),
+                                   mkMOV platform fmt (OpAddr tmp_amode) (OpReg r_dest),
                                    ADD II32 (OpImm (ImmInt b)) (OpReg esp),
                                    DELTA delta0]
-              | isWord64 ty    = toOL [MOV II32 (OpReg eax) (OpReg r_dest),
-                                        MOV II32 (OpReg edx) (OpReg r_dest_hi)]
-              | otherwise      = unitOL (MOV (intFormat w)
+              | isWord64 ty    = toOL [mkMOV platform II32 (OpReg eax) (OpReg r_dest),
+                                        mkMOV platform II32 (OpReg edx) (OpReg r_dest_hi)]
+              | otherwise      = unitOL (mkMOV platform (intFormat w)
                                              (OpReg eax)
                                              (OpReg r_dest))
               where
@@ -3519,7 +3561,7 @@ genCCall64 addr conv dest_regs args = do
                                 -- If we are calling a varargs function
                                 -- then we need to define ireg as well
                                 -- as freg
-                                MOV II64 (OpReg freg) (OpReg ireg))
+                                mkMOV platform II64 (OpReg freg) (OpReg ireg))
             | otherwise = do
                  arg_code <- getAnyReg arg
                  load_args_win rest (ireg : usedInt) usedFP regs
@@ -3538,7 +3580,7 @@ genCCall64 addr conv dest_regs args = do
              let code' = code `appOL` arg_code `appOL` toOL [
                             SUB (intFormat (wordWidth platform)) (OpImm (ImmInt arg_size)) (OpReg rsp),
                             DELTA (delta-arg_size),
-                            MOV (floatFormat width) (OpReg arg_reg) (OpAddr (spRel platform 0))]
+                            mkMOV platform (floatFormat width) (OpReg arg_reg) (OpAddr (spRel platform 0))]
              push_args rest code'
 
            | otherwise = do
@@ -3630,7 +3672,7 @@ genCCall64 addr conv dest_regs args = do
         -- It's not safe to omit this assignment, even if the number
         -- of SSE2 regs in use is zero.  If %al is larger than 8
         -- on entry to a varargs function, seg faults ensue.
-        assign_eax n = unitOL (MOV II32 (OpImm (ImmInt n)) (OpReg eax))
+        assign_eax n = unitOL (mkMOV platform II32 (OpImm (ImmInt n)) (OpReg eax))
 
     let call = callinsns `appOL`
                toOL (
@@ -3647,13 +3689,13 @@ genCCall64 addr conv dest_regs args = do
         assign_code []     = nilOL
         assign_code [dest] =
           case typeWidth rep of
-                W32 | isFloatType rep -> unitOL (MOV (floatFormat W32)
+                W32 | isFloatType rep -> unitOL (mkMOV platform (floatFormat W32)
                                                      (OpReg xmm0)
                                                      (OpReg r_dest))
-                W64 | isFloatType rep -> unitOL (MOV (floatFormat W64)
+                W64 | isFloatType rep -> unitOL (mkMOV platform (floatFormat W64)
                                                      (OpReg xmm0)
                                                      (OpReg r_dest))
-                _ -> unitOL (MOV (cmmTypeFormat rep) (OpReg rax) (OpReg r_dest))
+                _ -> unitOL (mkMOV platform (cmmTypeFormat rep) (OpReg rax) (OpReg r_dest))
           where
                 rep = localRegType dest
                 r_dest = getRegisterReg platform  (CmmLocal dest)
@@ -3767,7 +3809,7 @@ genSwitch expr targets = do
             let op = OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg (platformWordSizeInBytes platform)) (ImmInt 0))
                 code = e_code `appOL` toOL
                     [ LEA (archWordFormat is32bit) (OpAddr (AddrBaseIndex EABaseRip EAIndexNone (ImmCLbl lbl))) (OpReg tableReg)
-                    , MOV (archWordFormat is32bit) op (OpReg targetReg)
+                    , mkMOV platform (archWordFormat is32bit) op (OpReg targetReg)
                     , JMP_TBL (OpReg targetReg) ids (Section ReadOnlyData lbl) lbl
                     ]
             return code
@@ -4002,6 +4044,7 @@ trivialCode' _ width instr _ a b
 genTrivialCode :: Format -> (Operand -> Operand -> Instr)
                -> CmmExpr -> CmmExpr -> NatM Register
 genTrivialCode rep instr a b = do
+  platform <- getPlatform
   (b_op, b_code) <- getNonClobberedOperand b
   a_code <- getAnyReg a
   tmp <- getNewRegNat rep
@@ -4015,7 +4058,7 @@ genTrivialCode rep instr a b = do
      code dst
         | dst `regClashesWithOp` b_op =
                 b_code `appOL`
-                unitOL (MOV rep b_op (OpReg tmp)) `appOL`
+                unitOL (mkMOV platform rep b_op (OpReg tmp)) `appOL`
                 a_code dst `snocOL`
                 instr (OpReg tmp) (OpReg dst)
         | otherwise =
@@ -4169,6 +4212,7 @@ coerceFP2FP to x = do
 
 sse2NegCode :: Width -> CmmExpr -> NatM Register
 sse2NegCode w x = do
+  platform <- getPlatform
   let fmt = floatFormat w
   x_code <- getAnyReg x
   -- This is how gcc does it, so it can't be that bad:
@@ -4188,7 +4232,7 @@ sse2NegCode w x = do
   tmp <- getNewRegNat fmt
   let
     code dst = x_code dst `appOL` amode_code `appOL` toOL [
-        MOV fmt (OpAddr amode) (OpReg tmp),
+        mkMOV platform fmt (OpAddr amode) (OpReg tmp),
         XOR fmt (OpReg tmp) (OpReg dst)
         ]
   --
@@ -4285,31 +4329,34 @@ genAtomicRMW bid width amop dst addr n = do
             -> Reg       -- Register containing argument
             -> AddrMode  -- Address of location to mutate
             -> NatM (OrdList Instr,BlockId) -- TODO: Return Maybe BlockId
-    op_code dst_r arg amode = case amop of
-        -- In the common case where dst_r is a virtual register the
-        -- final move should go away, because it's the last use of arg
-        -- and the first use of dst_r.
-        AMO_Add  -> return $ (toOL [ LOCK (XADD format (OpReg arg) (OpAddr amode))
-                                   , MOV format (OpReg arg) (OpReg dst_r)
-                                   ], bid)
-        AMO_Sub  -> return $ (toOL [ NEGI format (OpReg arg)
-                                   , LOCK (XADD format (OpReg arg) (OpAddr amode))
-                                   , MOV format (OpReg arg) (OpReg dst_r)
-                                   ], bid)
-        -- In these cases we need a new block id, and have to return it so
-        -- that later instruction selection can reference it.
-        AMO_And  -> cmpxchg_code (\ src dst -> unitOL $ AND format src dst)
-        AMO_Nand -> cmpxchg_code (\ src dst -> toOL [ AND format src dst
-                                                    , NOT format dst
-                                                    ])
-        AMO_Or   -> cmpxchg_code (\ src dst -> unitOL $ OR format src dst)
-        AMO_Xor  -> cmpxchg_code (\ src dst -> unitOL $ XOR format src dst)
+    op_code dst_r arg amode = do
+        platform <- getPlatform
+        case amop of
+          -- In the common case where dst_r is a virtual register the
+          -- final move should go away, because it's the last use of arg
+          -- and the first use of dst_r.
+          AMO_Add  -> return $ (toOL [ LOCK (XADD format (OpReg arg) (OpAddr amode))
+                                     , mkMOV platform format (OpReg arg) (OpReg dst_r)
+                                     ], bid)
+          AMO_Sub  -> return $ (toOL [ NEGI format (OpReg arg)
+                                     , LOCK (XADD format (OpReg arg) (OpAddr amode))
+                                     , mkMOV platform format (OpReg arg) (OpReg dst_r)
+                                     ], bid)
+          -- In these cases we need a new block id, and have to return it so
+          -- that later instruction selection can reference it.
+          AMO_And  -> cmpxchg_code (\ src dst -> unitOL $ AND format src dst)
+          AMO_Nand -> cmpxchg_code (\ src dst -> toOL [ AND format src dst
+                                                      , NOT format dst
+                                                      ])
+          AMO_Or   -> cmpxchg_code (\ src dst -> unitOL $ OR format src dst)
+          AMO_Xor  -> cmpxchg_code (\ src dst -> unitOL $ XOR format src dst)
       where
         -- Simulate operation that lacks a dedicated instruction using
         -- cmpxchg.
         cmpxchg_code :: (Operand -> Operand -> OrdList Instr)
                      -> NatM (OrdList Instr, BlockId)
         cmpxchg_code instrs = do
+            platform <- getPlatform
             lbl1 <- getBlockIdNat
             lbl2 <- getBlockIdNat
             tmp <- getNewRegNat format
@@ -4322,12 +4369,12 @@ genAtomicRMW bid width amop dst addr n = do
             updateCfgNat (addWeightEdge lbl1 lbl1 0)
 
             return $ (toOL
-                [ MOV format (OpAddr amode) (OpReg eax)
+                [ mkMOV platform format (OpAddr amode) (OpReg eax)
                 , JXX ALWAYS lbl1
                 , NEWBLOCK lbl1
                   -- Keep old value so we can return it:
-                , MOV format (OpReg eax) (OpReg dst_r)
-                , MOV format (OpReg eax) (OpReg tmp)
+                , mkMOV platform format (OpReg eax) (OpReg dst_r)
+                , mkMOV platform format (OpReg eax) (OpReg tmp)
                 ]
                 `appOL` instrs (OpReg arg) (OpReg tmp) `appOL` toOL
                 [ LOCK (CMPXCHG format (OpReg tmp) (OpAddr amode))
@@ -4357,6 +4404,7 @@ genCtz64_32
   -> CmmExpr
   -> NatM (InstrBlock, Maybe BlockId)
 genCtz64_32 bid dst src = do
+  platform <- getPlatform
   RegCode64 vcode rhi rlo <- iselExpr64 src
   let dst_r = getLocalRegReg dst
   lbl1 <- getBlockIdNat
@@ -4380,9 +4428,9 @@ genCtz64_32 bid dst src = do
   --    dst = 64;
   --  }
   let instrs = vcode `appOL` toOL
-           ([ MOV      II32 (OpReg rhi)         (OpReg tmp_r)
+           ([ mkMOV platform      II32 (OpReg rhi)         (OpReg tmp_r)
             , OR       II32 (OpReg rlo)         (OpReg tmp_r)
-            , MOV      II32 (OpImm (ImmInt 64)) (OpReg dst_r)
+            , mkMOV platform      II32 (OpImm (ImmInt 64)) (OpReg dst_r)
             , JXX EQQ    lbl2
             , JXX ALWAYS lbl1
 
@@ -4402,6 +4450,7 @@ genCtz64_32 bid dst src = do
 -- Generic case (width <= word size)
 genCtzGeneric :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
 genCtzGeneric width dst src = do
+  platform <- getPlatform
   code_src <- getAnyReg src
   config <- getConfig
   let bw = widthInBits width
@@ -4429,10 +4478,10 @@ genCtzGeneric width dst src = do
       let instrs = code_src src_r `appOL` toOL
                ([ MOVZxL  II8    (OpReg src_r) (OpReg src_r) | width == W8 ] ++
                 [ BSF     format (OpReg src_r) tmp_r
-                , MOV     II32   (OpImm (ImmInt bw)) (OpReg dst_r)
+                , mkMOV platform     II32   (OpImm (ImmInt bw)) (OpReg dst_r)
                 , CMOV NE format (OpReg tmp_r) dst_r
                 ]) -- NB: We don't need to zero-extend the result for the
-                   -- W8/W16 cases because the 'MOV' insn already
+                   -- W8/W16 cases because the 'mkMOV platform' insn already
                    -- took care of implicitly clearing the upper bits
       return instrs
 
@@ -4494,21 +4543,21 @@ genMemCpyInlineMaybe align dst src n = do
       go :: Reg -> Reg -> Reg -> Integer -> OrdList Instr
       go dst src tmp i
           | i >= sizeBytes =
-              unitOL (MOV format (OpAddr src_addr) (OpReg tmp)) `appOL`
-              unitOL (MOV format (OpReg tmp) (OpAddr dst_addr)) `appOL`
+              unitOL (mkMOV platform format (OpAddr src_addr) (OpReg tmp)) `appOL`
+              unitOL (mkMOV platform format (OpReg tmp) (OpAddr dst_addr)) `appOL`
               go dst src tmp (i - sizeBytes)
           -- Deal with remaining bytes.
           | i >= 4 =  -- Will never happen on 32-bit
-              unitOL (MOV II32 (OpAddr src_addr) (OpReg tmp)) `appOL`
-              unitOL (MOV II32 (OpReg tmp) (OpAddr dst_addr)) `appOL`
+              unitOL (mkMOV platform II32 (OpAddr src_addr) (OpReg tmp)) `appOL`
+              unitOL (mkMOV platform II32 (OpReg tmp) (OpAddr dst_addr)) `appOL`
               go dst src tmp (i - 4)
           | i >= 2 =
               unitOL (MOVZxL II16 (OpAddr src_addr) (OpReg tmp)) `appOL`
-              unitOL (MOV II16 (OpReg tmp) (OpAddr dst_addr)) `appOL`
+              unitOL (mkMOV platform II16 (OpReg tmp) (OpAddr dst_addr)) `appOL`
               go dst src tmp (i - 2)
           | i >= 1 =
               unitOL (MOVZxL II8 (OpAddr src_addr) (OpReg tmp)) `appOL`
-              unitOL (MOV II8 (OpReg tmp) (OpAddr dst_addr)) `appOL`
+              unitOL (mkMOV platform II8 (OpReg tmp) (OpAddr dst_addr)) `appOL`
               go dst src tmp (i - 1)
           | otherwise = nilOL
         where
@@ -4581,24 +4630,24 @@ genMemSetInlineMaybe align dst c n = do
     sizeBytes :: Integer
     sizeBytes = fromIntegral (formatInBytes format)
 
-    -- Depending on size returns the widest MOV instruction and its
+    -- Depending on size returns the widest mkMOV platform instruction and its
     -- width.
     gen4 :: AddrMode -> Integer -> (InstrBlock, Integer)
     gen4 addr size
         | size >= 4 =
-            (unitOL (MOV II32 (OpImm (ImmInteger c4)) (OpAddr addr)), 4)
+            (unitOL (mkMOV platform II32 (OpImm (ImmInteger c4)) (OpAddr addr)), 4)
         | size >= 2 =
-            (unitOL (MOV II16 (OpImm (ImmInteger c2)) (OpAddr addr)), 2)
+            (unitOL (mkMOV platform II16 (OpImm (ImmInteger c2)) (OpAddr addr)), 2)
         | size >= 1 =
-            (unitOL (MOV II8 (OpImm (ImmInteger c)) (OpAddr addr)), 1)
+            (unitOL (mkMOV platform II8 (OpImm (ImmInteger c)) (OpAddr addr)), 1)
         | otherwise = (nilOL, 0)
 
-    -- Generates a 64-bit wide MOV instruction from REG to MEM.
+    -- Generates a 64-bit wide mkMOV platform instruction from REG to MEM.
     gen8 :: AddrMode -> Reg -> InstrBlock
     gen8 addr reg8byte =
-      unitOL (MOV format (OpReg reg8byte) (OpAddr addr))
+      unitOL (mkMOV platform format (OpReg reg8byte) (OpAddr addr))
 
-    -- Unrolls memset when the widest MOV is <= 4 bytes.
+    -- Unrolls memset when the widest mkMOV platform is <= 4 bytes.
     go4 :: Reg -> Integer -> InstrBlock
     go4 dst left =
       if left <= 0 then nilOL
@@ -4608,7 +4657,7 @@ genMemSetInlineMaybe align dst c n = do
         dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone (ImmInteger (n - left))
         (curMov, curWidth) = gen4 dst_addr possibleWidth
 
-    -- Unrolls memset when the widest MOV is 8 bytes (thus another Reg
+    -- Unrolls memset when the widest mkMOV platform is 8 bytes (thus another Reg
     -- argument). Falls back to go4 when all 8 byte moves are
     -- exhausted.
     go8 :: Reg -> Reg -> Integer -> InstrBlock
@@ -4675,6 +4724,7 @@ genPrefetchData n src = do
 
 genByteSwap :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
 genByteSwap width dst src = do
+  platform <- getPlatform
   is32Bit <- is32BitPlatform
   let format = intFormat width
   case width of
@@ -4682,8 +4732,8 @@ genByteSwap width dst src = do
         let Reg64 dst_hi dst_lo = localReg64 dst
         RegCode64 vcode rhi rlo <- iselExpr64 src
         return $ vcode `appOL`
-                 toOL [ MOV II32 (OpReg rlo) (OpReg dst_hi),
-                        MOV II32 (OpReg rhi) (OpReg dst_lo),
+                 toOL [ mkMOV platform II32 (OpReg rlo) (OpReg dst_hi),
+                        mkMOV platform II32 (OpReg rhi) (OpReg dst_lo),
                         BSWAP II32 dst_hi,
                         BSWAP II32 dst_lo ]
       W16 -> do
@@ -4796,6 +4846,7 @@ genPext bid width dst src mask = do
 
 genClz :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock
 genClz bid width dst src = do
+  platform <- getPlatform
   is32Bit <- is32BitPlatform
   config <- getConfig
   if is32Bit && width == W64
@@ -4829,11 +4880,11 @@ genClz bid width dst src = do
           return $ code_src src_r `appOL` toOL
                    ([ MOVZxL  II8    (OpReg src_r) (OpReg src_r) | width == W8 ] ++
                     [ BSR     format (OpReg src_r) tmp_r
-                    , MOV     II32   (OpImm (ImmInt (2*bw-1))) (OpReg dst_r)
+                    , mkMOV platform     II32   (OpImm (ImmInt (2*bw-1))) (OpReg dst_r)
                     , CMOV NE format (OpReg tmp_r) dst_r
                     , XOR     format (OpImm (ImmInt (bw-1))) (OpReg dst_r)
                     ]) -- NB: We don't need to zero-extend the result for the
-                       -- W8/W16 cases because the 'MOV' insn already
+                       -- W8/W16 cases because the 'mkMOV platform' insn already
                        -- took care of implicitly clearing the upper bits
 
 genWordToFloat :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock
@@ -4843,7 +4894,8 @@ genWordToFloat bid width dst src =
 
 genAtomicRead :: Width -> MemoryOrdering -> LocalReg -> CmmExpr -> NatM InstrBlock
 genAtomicRead width _mord dst addr = do
-  load_code <- intLoadCode (MOV (intFormat width)) addr
+  platform <- getPlatform
+  load_code <- intLoadCode (mkMOV platform (intFormat width)) addr
   return (load_code (getLocalRegReg dst))
 
 genAtomicWrite :: Width -> MemoryOrdering -> CmmExpr -> CmmExpr -> NatM InstrBlock
@@ -4880,9 +4932,9 @@ genCmpXchg bid width dst addr old new = do
       platform <- getPlatform
       let dst_r    = getRegisterReg platform  (CmmLocal dst)
           code     = toOL
-                     [ MOV format (OpReg oldval) (OpReg eax)
+                     [ mkMOV platform format (OpReg oldval) (OpReg eax)
                      , LOCK (CMPXCHG format (OpReg newval) (OpAddr amode))
-                     , MOV format (OpReg eax) (OpReg dst_r)
+                     , mkMOV platform format (OpReg eax) (OpReg dst_r)
                      ]
       return $ addr_code `appOL` newval_code newval `appOL` oldval_code oldval
           `appOL` code
@@ -4893,6 +4945,7 @@ genCmpXchg bid width dst addr old new = do
 
 genXchg :: Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
 genXchg width dst addr value = do
+  platform <- getPlatform
   is32Bit <- is32BitPlatform
 
   when (is32Bit && width == W64) $
@@ -4904,7 +4957,7 @@ genXchg width dst addr value = do
   let dst_r    = getLocalRegReg dst
   -- Copy the value into the target register, perform the exchange.
   let code     = toOL
-                 [ MOV format (OpReg newval) (OpReg dst_r)
+                 [ mkMOV platform format (OpReg newval) (OpReg dst_r)
                   -- On X86 xchg implies a lock prefix if we use a memory argument.
                   -- so this is atomic.
                  , XCHG format (OpAddr amode) dst_r
@@ -4914,6 +4967,7 @@ genXchg width dst addr value = do
 
 genFloatAbs :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
 genFloatAbs width dst src = do
+  platform <- getPlatform
   let
     format = floatFormat width
     const = case width of
@@ -4925,7 +4979,7 @@ genFloatAbs width dst src = do
   tmp <- getNewRegNat format
   let dst_r = getLocalRegReg dst
   pure $ src_code dst_r `appOL` amode_code `appOL` toOL
-           [ MOV format (OpAddr amode) (OpReg tmp)
+           [ mkMOV platform format (OpAddr amode) (OpReg tmp)
            , AND format (OpReg tmp) (OpReg dst_r)
            ]
 
@@ -4990,6 +5044,7 @@ genSignedLargeMul
   -> CmmExpr
   -> NatM (OrdList Instr)
 genSignedLargeMul width res_c res_h res_l arg_x arg_y = do
+  platform <- getPlatform
   (y_reg, y_code) <- getRegOrMem arg_y
   x_code <- getAnyReg arg_x
   reg_tmp <- getNewRegNat II8
@@ -5000,8 +5055,8 @@ genSignedLargeMul width res_c res_h res_l arg_x arg_y = do
       code = y_code `appOL`
              x_code rax `appOL`
              toOL [ IMUL2 format y_reg
-                  , MOV format (OpReg rdx) (OpReg reg_h)
-                  , MOV format (OpReg rax) (OpReg reg_l)
+                  , mkMOV platform format (OpReg rdx) (OpReg reg_h)
+                  , mkMOV platform format (OpReg rax) (OpReg reg_l)
                   , SETCC CARRY (OpReg reg_tmp)
                   , MOVZxL II8 (OpReg reg_tmp) (OpReg reg_c)
                   ]
@@ -5015,6 +5070,7 @@ genUnsignedLargeMul
   -> CmmExpr
   -> NatM (OrdList Instr)
 genUnsignedLargeMul width res_h res_l arg_x arg_y = do
+  platform <- getPlatform
   (y_reg, y_code) <- getRegOrMem arg_y
   x_code <- getAnyReg arg_x
   let format = intFormat width
@@ -5023,8 +5079,8 @@ genUnsignedLargeMul width res_h res_l arg_x arg_y = do
       code = y_code `appOL`
              x_code rax `appOL`
              toOL [MUL2 format y_reg,
-                   MOV format (OpReg rdx) (OpReg reg_h),
-                   MOV format (OpReg rax) (OpReg reg_l)]
+                   mkMOV platform format (OpReg rdx) (OpReg reg_h),
+                   mkMOV platform format (OpReg rax) (OpReg reg_l)]
   return code
 
 
@@ -5038,6 +5094,7 @@ genQuotRem
   -> CmmExpr
   -> NatM InstrBlock
 genQuotRem width signed res_q res_r m_arg_x_high arg_x_low arg_y = do
+  platform <- getPlatform
   case width of
     W8 -> do
       -- See Note [DIV/IDIV for bytes]
@@ -5067,5 +5124,5 @@ genQuotRem width signed res_q res_r m_arg_x_high arg_x_low arg_y = do
                x_low_code rax `appOL`
                x_high_code rdx `appOL`
                toOL [instr format y_reg,
-                     MOV format (OpReg rax) (OpReg reg_q),
-                     MOV format (OpReg rdx) (OpReg reg_r)]
+                     mkMOV platform format (OpReg rax) (OpReg reg_q),
+                     mkMOV platform format (OpReg rdx) (OpReg reg_r)]


=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -46,7 +46,7 @@ import GHC.Data.FastString
 import GHC.CmmToAsm.X86.Cond
 import GHC.CmmToAsm.X86.Regs
 import GHC.CmmToAsm.Format
-import GHC.CmmToAsm.Reg.Target (targetClassOfReg)
+import GHC.CmmToAsm.Reg.Target (targetClassOfReg, mkRegFormat)
 import GHC.CmmToAsm.Types
 import GHC.CmmToAsm.Utils
 import GHC.CmmToAsm.Instr (RegUsage(..), noUsage)
@@ -463,24 +463,24 @@ regUsageOfInstr platform instr
     POP    fmt op         -> mkRU fmt [] (def_W op)
     TEST   fmt src dst    -> mkRUR fmt (use_R src $! use_R dst [])
     CMP    fmt src dst    -> mkRUR fmt (use_R src $! use_R dst [])
-    SETCC  _ op         -> mkRU II64 [] (def_W op)
-    JXX    _ _          -> mkRU II64 [] []
-    JXX_GBL _ _         -> mkRU II64 [] []
-    JMP     op regs     -> mkRUR II64 (use_R op regs)
-    JMP_TBL op _ _ _    -> mkRUR II64 (use_R op [])
-    CALL (Left _)  params   -> mkRU II64 params (callClobberedRegs platform)
-    CALL (Right reg) params -> mkRU II64 (reg:params) (callClobberedRegs platform)
-    CLTD   _            -> mkRU II64 [eax] [edx]
-    NOP                 -> mkRU II64 [] []
+    SETCC  _ op         -> mkRUFormat [] (def_W op)
+    JXX    _ _          -> mkRUFormat [] []
+    JXX_GBL _ _         -> mkRUFormat [] []
+    JMP     op regs     -> mkRUFormat (use_R op regs) []
+    JMP_TBL op _ _ _    -> mkRUFormat (use_R op []) []
+    CALL (Left _)  params   -> mkRUFormat params (callClobberedRegs platform)
+    CALL (Right reg) params -> mkRUFormat (reg:params) (callClobberedRegs platform)
+    CLTD   fmt          -> mkRU fmt [eax] [edx]
+    NOP                 -> mkRUFormat [] []
 
     X87Store    fmt  dst    -> mkRUR fmt ( use_EA dst [])
 
-    CVTSS2SD   src dst  -> mkRU FF64 [src] [dst]
-    CVTSD2SS   src dst  -> mkRU FF32 [src] [dst]
-    CVTTSS2SIQ _ src dst -> mkRU FF32 (use_R src []) [dst]
-    CVTTSD2SIQ _ src dst -> mkRU FF64 (use_R src []) [dst]
-    CVTSI2SS   _ src dst -> mkRU FF32 (use_R src []) [dst]
-    CVTSI2SD   _ src dst -> mkRU FF64 (use_R src []) [dst]
+    CVTSS2SD   src dst  -> mkRUFormat [src] [dst]
+    CVTSD2SS   src dst  -> mkRUFormat [src] [dst]
+    CVTTSS2SIQ _ src dst -> mkRUFormat (use_R src []) [dst]
+    CVTTSD2SIQ _ src dst -> mkRUFormat (use_R src []) [dst]
+    CVTSI2SS   _ src dst -> mkRUFormat (use_R src []) [dst]
+    CVTSI2SD   _ src dst -> mkRUFormat (use_R src []) [dst]
     FDIV fmt     src dst  -> usageRM fmt src dst
     SQRT fmt src dst      -> mkRU fmt (use_R src []) [dst]
 
@@ -573,32 +573,32 @@ regUsageOfInstr platform instr
     -- are read.
 
     -- 2 operand form; first operand Read; second Written
-    usageRW :: Format -> Operand -> Operand -> RegUsage
+    usageRW :: HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
     usageRW fmt op (OpReg reg)      = mkRU fmt (use_R op []) [reg]
     usageRW fmt op (OpAddr ea)      = mkRUR fmt (use_R op $! use_EA ea [])
     usageRW _ _ _                   = panic "X86.RegInfo.usageRW: no match"
 
     -- 2 operand form; first operand Read; second Modified
-    usageRM :: Format -> Operand -> Operand -> RegUsage
+    usageRM :: HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
     usageRM fmt op (OpReg reg)      = mkRU fmt (use_R op [reg]) [reg]
     usageRM fmt op (OpAddr ea)      = mkRUR fmt (use_R op $! use_EA ea [])
     usageRM _ _ _                   = panic "X86.RegInfo.usageRM: no match"
 
     -- 2 operand form; first operand Modified; second Modified
-    usageMM :: Format -> Operand -> Operand -> RegUsage
+    usageMM :: HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
     usageMM fmt (OpReg src) (OpReg dst) = mkRU fmt [src, dst] [src, dst]
     usageMM fmt (OpReg src) (OpAddr ea) = mkRU fmt (use_EA ea [src]) [src]
     usageMM fmt (OpAddr ea) (OpReg dst) = mkRU fmt (use_EA ea [dst]) [dst]
     usageMM _ _ _                       = panic "X86.RegInfo.usageMM: no match"
 
     -- 3 operand form; first operand Read; second Modified; third Modified
-    usageRMM :: Format -> Operand -> Operand -> Operand -> RegUsage
+    usageRMM :: HasDebugCallStack => Format -> Operand -> Operand -> Operand -> RegUsage
     usageRMM fmt (OpReg src) (OpReg dst) (OpReg reg) = mkRU fmt [src, dst, reg] [dst, reg]
     usageRMM fmt (OpReg src) (OpAddr ea) (OpReg reg) = mkRU fmt (use_EA ea [src, reg]) [reg]
     usageRMM _ _ _ _                                 = panic "X86.RegInfo.usageRMM: no match"
 
     -- 3 operand form of FMA instructions.
-    usageFMA :: Format -> Operand -> Reg -> Reg -> RegUsage
+    usageFMA :: HasDebugCallStack => Format -> Operand -> Reg -> Reg -> RegUsage
     usageFMA fmt (OpReg src1) src2 dst
       = mkRU fmt [src1, src2, dst] [dst]
     usageFMA fmt (OpAddr ea1) src2 dst
@@ -607,7 +607,7 @@ regUsageOfInstr platform instr
       = panic "X86.RegInfo.usageFMA: no match"
 
     -- 1 operand form; operand Modified
-    usageM :: Format -> Operand -> RegUsage
+    usageM :: HasDebugCallStack => Format -> Operand -> RegUsage
     usageM fmt (OpReg reg)        = mkRU fmt [reg] [reg]
     usageM fmt (OpAddr ea)        = mkRUR fmt (use_EA ea [])
     usageM _ _                    = panic "X86.RegInfo.usageM: no match"
@@ -631,13 +631,25 @@ regUsageOfInstr platform instr
               use_index EAIndexNone   tl = tl
               use_index (EAIndex i _) tl = i : tl
 
-    mkRUR fmt src = src' `seq` RU (map (\ r -> RegFormat r fmt) src') []
+    mkRUR :: HasDebugCallStack => Format -> [Reg] -> RegUsage
+    mkRUR fmt src = src' `seq` RU (map (\ r -> mkRegFormat platform r fmt) src') []
         where src' = filter (interesting platform) src
 
-    mkRU fmt src dst = src' `seq` dst' `seq` RU (map (\ r -> RegFormat r fmt) src') (map (\ r -> RegFormat r fmt) dst')
+    mkRU :: HasDebugCallStack => Format -> [Reg] -> [Reg] -> RegUsage
+    mkRU fmt src dst = src' `seq` dst' `seq` RU (map (\ r -> mkRegFormat platform r fmt) src') (map (\ r -> mkRegFormat platform r fmt) dst')
         where src' = filter (interesting platform) src
               dst' = filter (interesting platform) dst
 
+    mkRUFormat :: HasDebugCallStack => [Reg] -> [Reg] -> RegUsage
+    mkRUFormat src dst = src' `seq` dst' `seq` RU (map mkFormat src') (map mkFormat dst')
+        where src' = filter (interesting platform) src
+              dst' = filter (interesting platform) dst
+              mkFormat reg =
+                mkRegFormat platform reg $
+                  case targetClassOfReg platform reg of
+                    RcInteger -> archWordFormat (target32Bit platform)
+                    RcFloatOrVector -> FF64
+
 -- | Is this register interesting for the register allocator?
 interesting :: Platform -> Reg -> Bool
 interesting _        (RegVirtual _)              = True
@@ -861,7 +873,8 @@ patchJumpInstr insn patchF
 -- -----------------------------------------------------------------------------
 -- | Make a spill instruction.
 mkSpillInstr
-    :: NCGConfig
+    :: HasDebugCallStack
+    => NCGConfig
     -> RegFormat -- register to spill
     -> Int       -- current stack delta
     -> Int       -- spill slot to use
@@ -877,12 +890,23 @@ mkSpillInstr config (RegFormat reg fmt) delta slot
           -> [MOVU fmt (OpReg reg) (OpAddr (spRel platform off))]
             -- NB: not using MOVA, because we have no guarantees about the stack
             -- being sufficiently aligned, including even numbered stack slots.
-        _ -> [MOV (scalarMoveFormat platform fmt) (OpReg reg) (OpAddr (spRel platform off))]
+        _ ->
+          let fmt' = scalarMoveFormat platform fmt
+              cls_f = if isIntFormat fmt' then RcInteger else RcFloatOrVector
+              cls1 = targetClassOfReg platform reg
+            in
+              assertPpr (all (== cls_f) [cls1])
+                  (vcat [ text "mkSpillInstr: incompatible formats"
+                        , text "format:" <+> ppr fmt <+> parens (ppr cls_f)
+                        , text "src:" <+> ppr reg <+> parens (ppr cls1)
+                        , callStackDoc ])
+                $ [MOV fmt' (OpReg reg) (OpAddr (spRel platform off))]
     where platform = ncgPlatform config
 
 -- | Make a spill reload instruction.
 mkLoadInstr
-    :: NCGConfig
+    :: HasDebugCallStack
+    => NCGConfig
     -> RegFormat      -- register to load
     -> Int      -- current stack delta
     -> Int      -- spill slot to use
@@ -898,7 +922,17 @@ mkLoadInstr config (RegFormat reg fmt) delta slot
             -> [MOVU fmt (OpAddr (spRel platform off)) (OpReg reg)]
             -- NB: not using MOVA, because we have no guarantees about the stack
             -- being sufficiently aligned, including even numbered stack slots.
-          _ -> [MOV (scalarMoveFormat platform fmt) (OpAddr (spRel platform off)) (OpReg reg)]
+          _ ->
+            let fmt' = scalarMoveFormat platform fmt
+                cls_f = if isIntFormat fmt' then RcInteger else RcFloatOrVector
+                cls2 = targetClassOfReg platform reg
+            in
+              assertPpr (all (== cls_f) [cls2])
+                  (vcat [ text "mkLoadInstr: incompatible formats"
+                        , text "format:" <+> ppr fmt <+> parens (ppr cls_f)
+                        , text "dst:" <+> ppr reg <+> parens (ppr cls2)
+                        , callStackDoc ])
+                $ [MOV fmt' (OpAddr (spRel platform off)) (OpReg reg)]
     where platform = ncgPlatform config
 
 spillSlotSize :: Platform -> Int
@@ -980,7 +1014,7 @@ mkRegRegMoveInstr platform fmt src dst =
                 , text "src:" <+> ppr src <+> parens (ppr cls1)
                 , text "dst:" <+> ppr dst <+> parens (ppr cls2)
                 , callStackDoc ])
-        $ MOV (scalarMoveFormat platform fmt) (OpReg src) (OpReg dst)
+        $ MOV fmt' (OpReg src) (OpReg dst)
 
 scalarMoveFormat :: Platform -> Format -> Format
 scalarMoveFormat platform fmt


=====================================
compiler/GHC/CmmToAsm/X86/Regs.hs
=====================================
@@ -378,7 +378,7 @@ callClobberedRegs platform
    -- Only xmm0-5 are caller-saves registers on 64-bit windows.
    -- For details check the Win64 ABI:
    -- https://docs.microsoft.com/en-us/cpp/build/x64-software-conventions
-   ++ map xmm [0  .. 5]
+   ++ map xmm [0 .. 5]
  | otherwise
     -- all xmm regs are caller-saves
     -- caller-saves registers



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85a0b5b00d73758142c936a0d4584f02b409f62e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85a0b5b00d73758142c936a0d4584f02b409f62e
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240620/256ea729/attachment-0001.html>


More information about the ghc-commits mailing list