never executed always true always false
    1 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
    2 
    3 module GHC.Cmm.MachOp
    4     ( MachOp(..)
    5     , pprMachOp, isCommutableMachOp, isAssociativeMachOp
    6     , isComparisonMachOp, maybeIntComparison, machOpResultType
    7     , machOpArgReps, maybeInvertComparison, isFloatComparison
    8 
    9     -- MachOp builders
   10     , mo_wordAdd, mo_wordSub, mo_wordEq, mo_wordNe,mo_wordMul, mo_wordSQuot
   11     , mo_wordSRem, mo_wordSNeg, mo_wordUQuot, mo_wordURem
   12     , mo_wordSGe, mo_wordSLe, mo_wordSGt, mo_wordSLt, mo_wordUGe
   13     , mo_wordULe, mo_wordUGt, mo_wordULt
   14     , mo_wordAnd, mo_wordOr, mo_wordXor, mo_wordNot
   15     , mo_wordShl, mo_wordSShr, mo_wordUShr
   16     , mo_u_8To32, mo_s_8To32, mo_u_16To32, mo_s_16To32
   17     , mo_u_8ToWord, mo_s_8ToWord, mo_u_16ToWord, mo_s_16ToWord
   18     , mo_u_32ToWord, mo_s_32ToWord
   19     , mo_32To8, mo_32To16, mo_WordTo8, mo_WordTo16, mo_WordTo32, mo_WordTo64
   20 
   21     -- CallishMachOp
   22     , CallishMachOp(..), callishMachOpHints
   23     , pprCallishMachOp
   24     , machOpMemcpyishAlign
   25 
   26     -- Atomic read-modify-write
   27     , AtomicMachOp(..)
   28    )
   29 where
   30 
   31 import GHC.Prelude
   32 
   33 import GHC.Platform
   34 import GHC.Cmm.Type
   35 import GHC.Utils.Outputable
   36 
   37 -----------------------------------------------------------------------------
   38 --              MachOp
   39 -----------------------------------------------------------------------------
   40 
   41 {- |
   42 Machine-level primops; ones which we can reasonably delegate to the
   43 native code generators to handle.
   44 
   45 Most operations are parameterised by the 'Width' that they operate on.
   46 Some operations have separate signed and unsigned versions, and float
   47 and integer versions.
   48 
   49 Note that there are variety of places in the native code generator where we
   50 assume that the code produced for a MachOp does not introduce new blocks.
   51 -}
   52 
   53 data MachOp
   54   -- Integer operations (insensitive to signed/unsigned)
   55   = MO_Add Width
   56   | MO_Sub Width
   57   | MO_Eq  Width
   58   | MO_Ne  Width
   59   | MO_Mul Width                -- low word of multiply
   60 
   61   -- Signed multiply/divide
   62   | MO_S_MulMayOflo Width       -- nonzero if signed multiply overflows
   63   | MO_S_Quot Width             -- signed / (same semantics as IntQuotOp)
   64   | MO_S_Rem  Width             -- signed % (same semantics as IntRemOp)
   65   | MO_S_Neg  Width             -- unary -
   66 
   67   -- Unsigned multiply/divide
   68   | MO_U_MulMayOflo Width       -- nonzero if unsigned multiply overflows
   69   | MO_U_Quot Width             -- unsigned / (same semantics as WordQuotOp)
   70   | MO_U_Rem  Width             -- unsigned % (same semantics as WordRemOp)
   71 
   72   -- Signed comparisons
   73   | MO_S_Ge Width
   74   | MO_S_Le Width
   75   | MO_S_Gt Width
   76   | MO_S_Lt Width
   77 
   78   -- Unsigned comparisons
   79   | MO_U_Ge Width
   80   | MO_U_Le Width
   81   | MO_U_Gt Width
   82   | MO_U_Lt Width
   83 
   84   -- Floating point arithmetic
   85   | MO_F_Add  Width
   86   | MO_F_Sub  Width
   87   | MO_F_Neg  Width             -- unary -
   88   | MO_F_Mul  Width
   89   | MO_F_Quot Width
   90 
   91   -- Floating point comparison
   92   | MO_F_Eq Width
   93   | MO_F_Ne Width
   94   | MO_F_Ge Width
   95   | MO_F_Le Width
   96   | MO_F_Gt Width
   97   | MO_F_Lt Width
   98 
   99   -- Bitwise operations.  Not all of these may be supported
  100   -- at all sizes, and only integral Widths are valid.
  101   | MO_And   Width
  102   | MO_Or    Width
  103   | MO_Xor   Width
  104   | MO_Not   Width
  105   | MO_Shl   Width
  106   | MO_U_Shr Width      -- unsigned shift right
  107   | MO_S_Shr Width      -- signed shift right
  108 
  109   -- Conversions.  Some of these will be NOPs.
  110   -- Floating-point conversions use the signed variant.
  111   | MO_SF_Conv Width Width      -- Signed int -> Float
  112   | MO_FS_Conv Width Width      -- Float -> Signed int
  113   | MO_SS_Conv Width Width      -- Signed int -> Signed int
  114   | MO_UU_Conv Width Width      -- unsigned int -> unsigned int
  115   | MO_XX_Conv Width Width      -- int -> int; puts no requirements on the
  116                                 -- contents of upper bits when extending;
  117                                 -- narrowing is simply truncation; the only
  118                                 -- expectation is that we can recover the
  119                                 -- original value by applying the opposite
  120                                 -- MO_XX_Conv, e.g.,
  121                                 --   MO_XX_CONV W64 W8 (MO_XX_CONV W8 W64 x)
  122                                 -- is equivalent to just x.
  123   | MO_FF_Conv Width Width      -- Float -> Float
  124 
  125   -- Vector element insertion and extraction operations
  126   | MO_V_Insert  Length Width   -- Insert scalar into vector
  127   | MO_V_Extract Length Width   -- Extract scalar from vector
  128 
  129   -- Integer vector operations
  130   | MO_V_Add Length Width
  131   | MO_V_Sub Length Width
  132   | MO_V_Mul Length Width
  133 
  134   -- Signed vector multiply/divide
  135   | MO_VS_Quot Length Width
  136   | MO_VS_Rem  Length Width
  137   | MO_VS_Neg  Length Width
  138 
  139   -- Unsigned vector multiply/divide
  140   | MO_VU_Quot Length Width
  141   | MO_VU_Rem  Length Width
  142 
  143   -- Floating point vector element insertion and extraction operations
  144   | MO_VF_Insert  Length Width   -- Insert scalar into vector
  145   | MO_VF_Extract Length Width   -- Extract scalar from vector
  146 
  147   -- Floating point vector operations
  148   | MO_VF_Add  Length Width
  149   | MO_VF_Sub  Length Width
  150   | MO_VF_Neg  Length Width      -- unary negation
  151   | MO_VF_Mul  Length Width
  152   | MO_VF_Quot Length Width
  153 
  154   -- Alignment check (for -falignment-sanitisation)
  155   | MO_AlignmentCheck Int Width
  156   deriving (Eq, Show)
  157 
  158 pprMachOp :: MachOp -> SDoc
  159 pprMachOp mo = text (show mo)
  160 
  161 
  162 
  163 -- -----------------------------------------------------------------------------
  164 -- Some common MachReps
  165 
  166 -- A 'wordRep' is a machine word on the target architecture
  167 -- Specifically, it is the size of an Int#, Word#, Addr#
  168 -- and the unit of allocation on the stack and the heap
  169 -- Any pointer is also guaranteed to be a wordRep.
  170 
  171 mo_wordAdd, mo_wordSub, mo_wordEq, mo_wordNe,mo_wordMul, mo_wordSQuot
  172     , mo_wordSRem, mo_wordSNeg, mo_wordUQuot, mo_wordURem
  173     , mo_wordSGe, mo_wordSLe, mo_wordSGt, mo_wordSLt, mo_wordUGe
  174     , mo_wordULe, mo_wordUGt, mo_wordULt
  175     , mo_wordAnd, mo_wordOr, mo_wordXor, mo_wordNot, mo_wordShl, mo_wordSShr, mo_wordUShr
  176     , mo_u_8ToWord, mo_s_8ToWord, mo_u_16ToWord, mo_s_16ToWord, mo_u_32ToWord, mo_s_32ToWord
  177     , mo_WordTo8, mo_WordTo16, mo_WordTo32, mo_WordTo64
  178     :: Platform -> MachOp
  179 
  180 mo_u_8To32, mo_s_8To32, mo_u_16To32, mo_s_16To32
  181     , mo_32To8, mo_32To16
  182     :: MachOp
  183 
  184 mo_wordAdd      platform = MO_Add (wordWidth platform)
  185 mo_wordSub      platform = MO_Sub (wordWidth platform)
  186 mo_wordEq       platform = MO_Eq  (wordWidth platform)
  187 mo_wordNe       platform = MO_Ne  (wordWidth platform)
  188 mo_wordMul      platform = MO_Mul (wordWidth platform)
  189 mo_wordSQuot    platform = MO_S_Quot (wordWidth platform)
  190 mo_wordSRem     platform = MO_S_Rem (wordWidth platform)
  191 mo_wordSNeg     platform = MO_S_Neg (wordWidth platform)
  192 mo_wordUQuot    platform = MO_U_Quot (wordWidth platform)
  193 mo_wordURem     platform = MO_U_Rem (wordWidth platform)
  194 
  195 mo_wordSGe      platform = MO_S_Ge  (wordWidth platform)
  196 mo_wordSLe      platform = MO_S_Le  (wordWidth platform)
  197 mo_wordSGt      platform = MO_S_Gt  (wordWidth platform)
  198 mo_wordSLt      platform = MO_S_Lt  (wordWidth platform)
  199 
  200 mo_wordUGe      platform = MO_U_Ge  (wordWidth platform)
  201 mo_wordULe      platform = MO_U_Le  (wordWidth platform)
  202 mo_wordUGt      platform = MO_U_Gt  (wordWidth platform)
  203 mo_wordULt      platform = MO_U_Lt  (wordWidth platform)
  204 
  205 mo_wordAnd      platform = MO_And (wordWidth platform)
  206 mo_wordOr       platform = MO_Or  (wordWidth platform)
  207 mo_wordXor      platform = MO_Xor (wordWidth platform)
  208 mo_wordNot      platform = MO_Not (wordWidth platform)
  209 mo_wordShl      platform = MO_Shl (wordWidth platform)
  210 mo_wordSShr     platform = MO_S_Shr (wordWidth platform)
  211 mo_wordUShr     platform = MO_U_Shr (wordWidth platform)
  212 
  213 mo_u_8To32               = MO_UU_Conv W8 W32
  214 mo_s_8To32               = MO_SS_Conv W8 W32
  215 mo_u_16To32              = MO_UU_Conv W16 W32
  216 mo_s_16To32              = MO_SS_Conv W16 W32
  217 
  218 mo_u_8ToWord    platform = MO_UU_Conv W8  (wordWidth platform)
  219 mo_s_8ToWord    platform = MO_SS_Conv W8  (wordWidth platform)
  220 mo_u_16ToWord   platform = MO_UU_Conv W16 (wordWidth platform)
  221 mo_s_16ToWord   platform = MO_SS_Conv W16 (wordWidth platform)
  222 mo_s_32ToWord   platform = MO_SS_Conv W32 (wordWidth platform)
  223 mo_u_32ToWord   platform = MO_UU_Conv W32 (wordWidth platform)
  224 
  225 mo_WordTo8      platform = MO_UU_Conv (wordWidth platform) W8
  226 mo_WordTo16     platform = MO_UU_Conv (wordWidth platform) W16
  227 mo_WordTo32     platform = MO_UU_Conv (wordWidth platform) W32
  228 mo_WordTo64     platform = MO_UU_Conv (wordWidth platform) W64
  229 
  230 mo_32To8                 = MO_UU_Conv W32 W8
  231 mo_32To16                = MO_UU_Conv W32 W16
  232 
  233 
  234 -- ----------------------------------------------------------------------------
  235 -- isCommutableMachOp
  236 
  237 {- |
  238 Returns 'True' if the MachOp has commutable arguments.  This is used
  239 in the platform-independent Cmm optimisations.
  240 
  241 If in doubt, return 'False'.  This generates worse code on the
  242 native routes, but is otherwise harmless.
  243 -}
  244 isCommutableMachOp :: MachOp -> Bool
  245 isCommutableMachOp mop =
  246   case mop of
  247         MO_Add _                -> True
  248         MO_Eq _                 -> True
  249         MO_Ne _                 -> True
  250         MO_Mul _                -> True
  251         MO_S_MulMayOflo _       -> True
  252         MO_U_MulMayOflo _       -> True
  253         MO_And _                -> True
  254         MO_Or _                 -> True
  255         MO_Xor _                -> True
  256         MO_F_Add _              -> True
  257         MO_F_Mul _              -> True
  258         _other                  -> False
  259 
  260 -- ----------------------------------------------------------------------------
  261 -- isAssociativeMachOp
  262 
  263 {- |
  264 Returns 'True' if the MachOp is associative (i.e. @(x+y)+z == x+(y+z)@)
  265 This is used in the platform-independent Cmm optimisations.
  266 
  267 If in doubt, return 'False'.  This generates worse code on the
  268 native routes, but is otherwise harmless.
  269 -}
  270 isAssociativeMachOp :: MachOp -> Bool
  271 isAssociativeMachOp mop =
  272   case mop of
  273         MO_Add {} -> True       -- NB: does not include
  274         MO_Mul {} -> True --     floatint point!
  275         MO_And {} -> True
  276         MO_Or  {} -> True
  277         MO_Xor {} -> True
  278         _other    -> False
  279 
  280 
  281 -- ----------------------------------------------------------------------------
  282 -- isComparisonMachOp
  283 
  284 {- |
  285 Returns 'True' if the MachOp is a comparison.
  286 
  287 If in doubt, return False.  This generates worse code on the
  288 native routes, but is otherwise harmless.
  289 -}
  290 isComparisonMachOp :: MachOp -> Bool
  291 isComparisonMachOp mop =
  292   case mop of
  293     MO_Eq   _  -> True
  294     MO_Ne   _  -> True
  295     MO_S_Ge _  -> True
  296     MO_S_Le _  -> True
  297     MO_S_Gt _  -> True
  298     MO_S_Lt _  -> True
  299     MO_U_Ge _  -> True
  300     MO_U_Le _  -> True
  301     MO_U_Gt _  -> True
  302     MO_U_Lt _  -> True
  303     MO_F_Eq {} -> True
  304     MO_F_Ne {} -> True
  305     MO_F_Ge {} -> True
  306     MO_F_Le {} -> True
  307     MO_F_Gt {} -> True
  308     MO_F_Lt {} -> True
  309     _other     -> False
  310 
  311 {- |
  312 Returns @Just w@ if the operation is an integer comparison with width
  313 @w@, or @Nothing@ otherwise.
  314 -}
  315 maybeIntComparison :: MachOp -> Maybe Width
  316 maybeIntComparison mop =
  317   case mop of
  318     MO_Eq   w  -> Just w
  319     MO_Ne   w  -> Just w
  320     MO_S_Ge w  -> Just w
  321     MO_S_Le w  -> Just w
  322     MO_S_Gt w  -> Just w
  323     MO_S_Lt w  -> Just w
  324     MO_U_Ge w  -> Just w
  325     MO_U_Le w  -> Just w
  326     MO_U_Gt w  -> Just w
  327     MO_U_Lt w  -> Just w
  328     _ -> Nothing
  329 
  330 isFloatComparison :: MachOp -> Bool
  331 isFloatComparison mop =
  332   case mop of
  333     MO_F_Eq {} -> True
  334     MO_F_Ne {} -> True
  335     MO_F_Ge {} -> True
  336     MO_F_Le {} -> True
  337     MO_F_Gt {} -> True
  338     MO_F_Lt {} -> True
  339     _other     -> False
  340 
  341 -- -----------------------------------------------------------------------------
  342 -- Inverting conditions
  343 
  344 -- Sometimes it's useful to be able to invert the sense of a
  345 -- condition.  Not all conditional tests are invertible: in
  346 -- particular, floating point conditionals cannot be inverted, because
  347 -- there exist floating-point values which return False for both senses
  348 -- of a condition (eg. !(NaN > NaN) && !(NaN /<= NaN)).
  349 
  350 maybeInvertComparison :: MachOp -> Maybe MachOp
  351 maybeInvertComparison op
  352   = case op of  -- None of these Just cases include floating point
  353         MO_Eq r   -> Just (MO_Ne r)
  354         MO_Ne r   -> Just (MO_Eq r)
  355         MO_U_Lt r -> Just (MO_U_Ge r)
  356         MO_U_Gt r -> Just (MO_U_Le r)
  357         MO_U_Le r -> Just (MO_U_Gt r)
  358         MO_U_Ge r -> Just (MO_U_Lt r)
  359         MO_S_Lt r -> Just (MO_S_Ge r)
  360         MO_S_Gt r -> Just (MO_S_Le r)
  361         MO_S_Le r -> Just (MO_S_Gt r)
  362         MO_S_Ge r -> Just (MO_S_Lt r)
  363         _other    -> Nothing
  364 
  365 -- ----------------------------------------------------------------------------
  366 -- machOpResultType
  367 
  368 {- |
  369 Returns the MachRep of the result of a MachOp.
  370 -}
  371 machOpResultType :: Platform -> MachOp -> [CmmType] -> CmmType
  372 machOpResultType platform mop tys =
  373   case mop of
  374     MO_Add {}           -> ty1  -- Preserve GC-ptr-hood
  375     MO_Sub {}           -> ty1  -- of first arg
  376     MO_Mul    r         -> cmmBits r
  377     MO_S_MulMayOflo r   -> cmmBits r
  378     MO_S_Quot r         -> cmmBits r
  379     MO_S_Rem  r         -> cmmBits r
  380     MO_S_Neg  r         -> cmmBits r
  381     MO_U_MulMayOflo r   -> cmmBits r
  382     MO_U_Quot r         -> cmmBits r
  383     MO_U_Rem  r         -> cmmBits r
  384 
  385     MO_Eq {}            -> comparisonResultRep platform
  386     MO_Ne {}            -> comparisonResultRep platform
  387     MO_S_Ge {}          -> comparisonResultRep platform
  388     MO_S_Le {}          -> comparisonResultRep platform
  389     MO_S_Gt {}          -> comparisonResultRep platform
  390     MO_S_Lt {}          -> comparisonResultRep platform
  391 
  392     MO_U_Ge {}          -> comparisonResultRep platform
  393     MO_U_Le {}          -> comparisonResultRep platform
  394     MO_U_Gt {}          -> comparisonResultRep platform
  395     MO_U_Lt {}          -> comparisonResultRep platform
  396 
  397     MO_F_Add r          -> cmmFloat r
  398     MO_F_Sub r          -> cmmFloat r
  399     MO_F_Mul r          -> cmmFloat r
  400     MO_F_Quot r         -> cmmFloat r
  401     MO_F_Neg r          -> cmmFloat r
  402     MO_F_Eq  {}         -> comparisonResultRep platform
  403     MO_F_Ne  {}         -> comparisonResultRep platform
  404     MO_F_Ge  {}         -> comparisonResultRep platform
  405     MO_F_Le  {}         -> comparisonResultRep platform
  406     MO_F_Gt  {}         -> comparisonResultRep platform
  407     MO_F_Lt  {}         -> comparisonResultRep platform
  408 
  409     MO_And {}           -> ty1  -- Used for pointer masking
  410     MO_Or {}            -> ty1
  411     MO_Xor {}           -> ty1
  412     MO_Not   r          -> cmmBits r
  413     MO_Shl   r          -> cmmBits r
  414     MO_U_Shr r          -> cmmBits r
  415     MO_S_Shr r          -> cmmBits r
  416 
  417     MO_SS_Conv _ to     -> cmmBits to
  418     MO_UU_Conv _ to     -> cmmBits to
  419     MO_XX_Conv _ to     -> cmmBits to
  420     MO_FS_Conv _ to     -> cmmBits to
  421     MO_SF_Conv _ to     -> cmmFloat to
  422     MO_FF_Conv _ to     -> cmmFloat to
  423 
  424     MO_V_Insert  l w    -> cmmVec l (cmmBits w)
  425     MO_V_Extract _ w    -> cmmBits w
  426 
  427     MO_V_Add l w        -> cmmVec l (cmmBits w)
  428     MO_V_Sub l w        -> cmmVec l (cmmBits w)
  429     MO_V_Mul l w        -> cmmVec l (cmmBits w)
  430 
  431     MO_VS_Quot l w      -> cmmVec l (cmmBits w)
  432     MO_VS_Rem  l w      -> cmmVec l (cmmBits w)
  433     MO_VS_Neg  l w      -> cmmVec l (cmmBits w)
  434 
  435     MO_VU_Quot l w      -> cmmVec l (cmmBits w)
  436     MO_VU_Rem  l w      -> cmmVec l (cmmBits w)
  437 
  438     MO_VF_Insert  l w   -> cmmVec l (cmmFloat w)
  439     MO_VF_Extract _ w   -> cmmFloat w
  440 
  441     MO_VF_Add  l w      -> cmmVec l (cmmFloat w)
  442     MO_VF_Sub  l w      -> cmmVec l (cmmFloat w)
  443     MO_VF_Mul  l w      -> cmmVec l (cmmFloat w)
  444     MO_VF_Quot l w      -> cmmVec l (cmmFloat w)
  445     MO_VF_Neg  l w      -> cmmVec l (cmmFloat w)
  446 
  447     MO_AlignmentCheck _ _ -> ty1
  448   where
  449     (ty1:_) = tys
  450 
  451 comparisonResultRep :: Platform -> CmmType
  452 comparisonResultRep = bWord  -- is it?
  453 
  454 
  455 -- -----------------------------------------------------------------------------
  456 -- machOpArgReps
  457 
  458 -- | This function is used for debugging only: we can check whether an
  459 -- application of a MachOp is "type-correct" by checking that the MachReps of
  460 -- its arguments are the same as the MachOp expects.  This is used when
  461 -- linting a CmmExpr.
  462 
  463 machOpArgReps :: Platform -> MachOp -> [Width]
  464 machOpArgReps platform op =
  465   case op of
  466     MO_Add    r         -> [r,r]
  467     MO_Sub    r         -> [r,r]
  468     MO_Eq     r         -> [r,r]
  469     MO_Ne     r         -> [r,r]
  470     MO_Mul    r         -> [r,r]
  471     MO_S_MulMayOflo r   -> [r,r]
  472     MO_S_Quot r         -> [r,r]
  473     MO_S_Rem  r         -> [r,r]
  474     MO_S_Neg  r         -> [r]
  475     MO_U_MulMayOflo r   -> [r,r]
  476     MO_U_Quot r         -> [r,r]
  477     MO_U_Rem  r         -> [r,r]
  478 
  479     MO_S_Ge r           -> [r,r]
  480     MO_S_Le r           -> [r,r]
  481     MO_S_Gt r           -> [r,r]
  482     MO_S_Lt r           -> [r,r]
  483 
  484     MO_U_Ge r           -> [r,r]
  485     MO_U_Le r           -> [r,r]
  486     MO_U_Gt r           -> [r,r]
  487     MO_U_Lt r           -> [r,r]
  488 
  489     MO_F_Add r          -> [r,r]
  490     MO_F_Sub r          -> [r,r]
  491     MO_F_Mul r          -> [r,r]
  492     MO_F_Quot r         -> [r,r]
  493     MO_F_Neg r          -> [r]
  494     MO_F_Eq  r          -> [r,r]
  495     MO_F_Ne  r          -> [r,r]
  496     MO_F_Ge  r          -> [r,r]
  497     MO_F_Le  r          -> [r,r]
  498     MO_F_Gt  r          -> [r,r]
  499     MO_F_Lt  r          -> [r,r]
  500 
  501     MO_And   r          -> [r,r]
  502     MO_Or    r          -> [r,r]
  503     MO_Xor   r          -> [r,r]
  504     MO_Not   r          -> [r]
  505     MO_Shl   r          -> [r, wordWidth platform]
  506     MO_U_Shr r          -> [r, wordWidth platform]
  507     MO_S_Shr r          -> [r, wordWidth platform]
  508 
  509     MO_SS_Conv from _   -> [from]
  510     MO_UU_Conv from _   -> [from]
  511     MO_XX_Conv from _   -> [from]
  512     MO_SF_Conv from _   -> [from]
  513     MO_FS_Conv from _   -> [from]
  514     MO_FF_Conv from _   -> [from]
  515 
  516     MO_V_Insert  l r    -> [typeWidth (vec l (cmmBits r)),r,wordWidth platform]
  517     MO_V_Extract l r    -> [typeWidth (vec l (cmmBits r)),wordWidth platform]
  518 
  519     MO_V_Add _ r        -> [r,r]
  520     MO_V_Sub _ r        -> [r,r]
  521     MO_V_Mul _ r        -> [r,r]
  522 
  523     MO_VS_Quot _ r      -> [r,r]
  524     MO_VS_Rem  _ r      -> [r,r]
  525     MO_VS_Neg  _ r      -> [r]
  526 
  527     MO_VU_Quot _ r      -> [r,r]
  528     MO_VU_Rem  _ r      -> [r,r]
  529 
  530     MO_VF_Insert  l r   -> [typeWidth (vec l (cmmFloat r)),r,wordWidth platform]
  531     MO_VF_Extract l r   -> [typeWidth (vec l (cmmFloat r)),wordWidth platform]
  532 
  533     MO_VF_Add  _ r      -> [r,r]
  534     MO_VF_Sub  _ r      -> [r,r]
  535     MO_VF_Mul  _ r      -> [r,r]
  536     MO_VF_Quot _ r      -> [r,r]
  537     MO_VF_Neg  _ r      -> [r]
  538 
  539     MO_AlignmentCheck _ r -> [r]
  540 
  541 -----------------------------------------------------------------------------
  542 -- CallishMachOp
  543 -----------------------------------------------------------------------------
  544 
  545 -- CallishMachOps tend to be implemented by foreign calls in some backends,
  546 -- so we separate them out.  In Cmm, these can only occur in a
  547 -- statement position, in contrast to an ordinary MachOp which can occur
  548 -- anywhere in an expression.
  549 data CallishMachOp
  550   = MO_F64_Pwr
  551   | MO_F64_Sin
  552   | MO_F64_Cos
  553   | MO_F64_Tan
  554   | MO_F64_Sinh
  555   | MO_F64_Cosh
  556   | MO_F64_Tanh
  557   | MO_F64_Asin
  558   | MO_F64_Acos
  559   | MO_F64_Atan
  560   | MO_F64_Asinh
  561   | MO_F64_Acosh
  562   | MO_F64_Atanh
  563   | MO_F64_Log
  564   | MO_F64_Log1P
  565   | MO_F64_Exp
  566   | MO_F64_ExpM1
  567   | MO_F64_Fabs
  568   | MO_F64_Sqrt
  569   | MO_F32_Pwr
  570   | MO_F32_Sin
  571   | MO_F32_Cos
  572   | MO_F32_Tan
  573   | MO_F32_Sinh
  574   | MO_F32_Cosh
  575   | MO_F32_Tanh
  576   | MO_F32_Asin
  577   | MO_F32_Acos
  578   | MO_F32_Atan
  579   | MO_F32_Asinh
  580   | MO_F32_Acosh
  581   | MO_F32_Atanh
  582   | MO_F32_Log
  583   | MO_F32_Log1P
  584   | MO_F32_Exp
  585   | MO_F32_ExpM1
  586   | MO_F32_Fabs
  587   | MO_F32_Sqrt
  588 
  589   -- 64-bit int/word ops for when they exceed the native word size
  590   -- (i.e. on 32-bit architectures)
  591   | MO_I64_ToI
  592   | MO_I64_FromI
  593   | MO_W64_ToW
  594   | MO_W64_FromW
  595 
  596   | MO_x64_Neg
  597   | MO_x64_Add
  598   | MO_x64_Sub
  599   | MO_x64_Mul
  600   | MO_I64_Quot
  601   | MO_I64_Rem
  602   | MO_W64_Quot
  603   | MO_W64_Rem
  604 
  605   | MO_x64_And
  606   | MO_x64_Or
  607   | MO_x64_Xor
  608   | MO_x64_Not
  609   | MO_x64_Shl
  610   | MO_I64_Shr
  611   | MO_W64_Shr
  612 
  613   | MO_x64_Eq
  614   | MO_x64_Ne
  615   | MO_I64_Ge
  616   | MO_I64_Gt
  617   | MO_I64_Le
  618   | MO_I64_Lt
  619   | MO_W64_Ge
  620   | MO_W64_Gt
  621   | MO_W64_Le
  622   | MO_W64_Lt
  623 
  624   | MO_UF_Conv Width
  625 
  626   | MO_S_Mul2    Width
  627   | MO_S_QuotRem Width
  628   | MO_U_QuotRem Width
  629   | MO_U_QuotRem2 Width
  630   | MO_Add2      Width
  631   | MO_AddWordC  Width
  632   | MO_SubWordC  Width
  633   | MO_AddIntC   Width
  634   | MO_SubIntC   Width
  635   | MO_U_Mul2    Width
  636 
  637   | MO_ReadBarrier
  638   | MO_WriteBarrier
  639   | MO_Touch         -- Keep variables live (when using interior pointers)
  640 
  641   -- Prefetch
  642   | MO_Prefetch_Data Int -- Prefetch hint. May change program performance but not
  643                      -- program behavior.
  644                      -- the Int can be 0-3. Needs to be known at compile time
  645                      -- to interact with code generation correctly.
  646                      --  TODO: add support for prefetch WRITES,
  647                      --  currently only exposes prefetch reads, which
  648                      -- would the majority of use cases in ghc anyways
  649 
  650 
  651   -- These three MachOps are parameterised by the known alignment
  652   -- of the destination and source (for memcpy/memmove) pointers.
  653   -- This information may be used for optimisation in backends.
  654   | MO_Memcpy Int
  655   | MO_Memset Int
  656   | MO_Memmove Int
  657   | MO_Memcmp Int
  658 
  659   | MO_PopCnt Width
  660   | MO_Pdep Width
  661   | MO_Pext Width
  662   | MO_Clz Width
  663   | MO_Ctz Width
  664 
  665   | MO_BSwap Width
  666   | MO_BRev Width
  667 
  668   -- Atomic read-modify-write.
  669   | MO_AtomicRMW Width AtomicMachOp
  670   | MO_AtomicRead Width
  671   | MO_AtomicWrite Width
  672   -- | Atomic compare-and-swap. Arguments are @[dest, expected, new]@.
  673   -- Sequentially consistent.
  674   -- Possible future refactoring: should this be an'MO_AtomicRMW' variant?
  675   | MO_Cmpxchg Width
  676   -- | Atomic swap. Arguments are @[dest, new]@
  677   | MO_Xchg Width
  678 
  679   -- These rts provided functions are special: suspendThread releases the
  680   -- capability, hence we mustn't sink any use of data stored in the capability
  681   -- after this instruction.
  682   | MO_SuspendThread
  683   | MO_ResumeThread
  684   deriving (Eq, Show)
  685 
  686 -- | The operation to perform atomically.
  687 data AtomicMachOp =
  688       AMO_Add
  689     | AMO_Sub
  690     | AMO_And
  691     | AMO_Nand
  692     | AMO_Or
  693     | AMO_Xor
  694       deriving (Eq, Show)
  695 
  696 pprCallishMachOp :: CallishMachOp -> SDoc
  697 pprCallishMachOp mo = text (show mo)
  698 
  699 -- | Return (results_hints,args_hints)
  700 callishMachOpHints :: CallishMachOp -> ([ForeignHint], [ForeignHint])
  701 callishMachOpHints op = case op of
  702   MO_Memcpy _      -> ([], [AddrHint,AddrHint,NoHint])
  703   MO_Memset _      -> ([], [AddrHint,NoHint,NoHint])
  704   MO_Memmove _     -> ([], [AddrHint,AddrHint,NoHint])
  705   MO_Memcmp _      -> ([], [AddrHint, AddrHint, NoHint])
  706   MO_SuspendThread -> ([AddrHint], [AddrHint,NoHint])
  707   MO_ResumeThread  -> ([AddrHint], [AddrHint])
  708   _                -> ([],[])
  709   -- empty lists indicate NoHint
  710 
  711 -- | The alignment of a 'memcpy'-ish operation.
  712 machOpMemcpyishAlign :: CallishMachOp -> Maybe Int
  713 machOpMemcpyishAlign op = case op of
  714   MO_Memcpy  align -> Just align
  715   MO_Memset  align -> Just align
  716   MO_Memmove align -> Just align
  717   MO_Memcmp  align -> Just align
  718   _                -> Nothing