Home
last modified time | relevance | path

Searched refs:CmmMachOp (Results 1 – 25 of 49) sorted by relevance

12

/dports/lang/ghc/ghc-8.10.7/compiler/cmm/
H A DCmmUtils.hs252 = CmmMachOp (MO_Add rep)
348 cmmOrWord dflags e1 e2 = CmmMachOp (mo_wordOr dflags) [e1, e2]
349 cmmAndWord dflags e1 e2 = CmmMachOp (mo_wordAnd dflags) [e1, e2]
350 cmmNeWord dflags e1 e2 = CmmMachOp (mo_wordNe dflags) [e1, e2]
351 cmmEqWord dflags e1 e2 = CmmMachOp (mo_wordEq dflags) [e1, e2]
352 cmmULtWord dflags e1 e2 = CmmMachOp (mo_wordULt dflags) [e1, e2]
353 cmmUGeWord dflags e1 e2 = CmmMachOp (mo_wordUGe dflags) [e1, e2]
372 | otherwise = CmmMachOp (MO_UU_Conv w word) [e]
392 isTrivialCmmExpr (CmmMachOp _ _) = False
411 isComparisonExpr (CmmMachOp op _) = isComparisonMachOp op
[all …]
H A DPprCmmExpr.hs80 pprExpr (CmmMachOp (MO_Add rep)
101 pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
118 pprExpr7 (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
119 = pprExpr7 (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
120 pprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
129 pprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
146 CmmMachOp mop args -> genMachOp mop args
164 || isJust (infixMachOp8 mop) = parens (pprExpr (CmmMachOp mop args))
H A DCmmOpt.hs35 where f (CmmMachOp op args) = cmmMachOpFold dflags op args
51 cmmMachOpFold dflags op args = fromMaybe (CmmMachOp op args) (cmmMachOpFoldM dflags op args)
82 cmmMachOpFoldM dflags conv_outer [CmmMachOp conv_inner [x]]
182 cmmMachOpFoldM dflags mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
192 cmmMachOpFoldM dflags mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3]
204 cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op@MO_Add{} [pic, CmmLit lit]
207 = Just $ CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ]
237 cmmMachOpFoldM dflags cmp [CmmMachOp conv [x], CmmLit (CmmInt i _)]
390 signedQuotRemHelper rep p = CmmMachOp (MO_Add rep) [x, x2]
394 x1 = CmmMachOp shr [x, CmmLit (CmmInt bits rep)]
[all …]
H A DCmmExpr.hs28 , module CmmMachOp
37 import CmmMachOp
57 | CmmMachOp MachOp [CmmExpr] -- Machine operation (+, -, *, etc.) constructor
72 CmmMachOp op1 es1 == CmmMachOp op2 es2 = op1==op2 && es1==es2 function
216 cmmExprType dflags (CmmMachOp op args) = machOpResultType dflags op (map (cmmExprType dflags) args)
255 maybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op
256 return (CmmMachOp op' args)
372 expr z (CmmMachOp _ exprs) = foldRegsUsed dflags f z exprs
H A DCmmLint.hs93 lintCmmExpr expr@(CmmMachOp op args) = do
102 lintCmmExpr (CmmMachOp (MO_Add rep)
204 checkCond _ (CmmMachOp mop _) | isComparisonMachOp mop = return ()
H A DMkGraph.hs321 CmmMachOp (MO_XX_Conv (wordWidth dflags) width) [global]
337 expr = CmmMachOp (MO_XX_Conv (wordWidth dflags) width) [stack_slot]
381 CmmMachOp (MO_XX_Conv width (wordWidth dflags)) [v]
398 CmmMachOp (MO_XX_Conv (width v) (wordWidth dflags)) [v]
H A DCmmNode.hs490 wrapRecExp f (CmmMachOp op es) = f (CmmMachOp op $ map (wrapRecExp f) es)
521 wrapRecExpM f n@(CmmMachOp op es) = maybe (f n) (f . CmmMachOp op) (mapListM (wrapRecExpM f) es)
574 wrapRecExpf f e@(CmmMachOp _ es) z = foldr (wrapRecExpf f) (f e z) es
H A DCmmCommonBlockElim.hs164 hash_e (CmmMachOp _ es) = hash_list hash_e es -- pessimal - no operator check
228 CmmMachOp op1 es1 `eq` CmmMachOp op2 es2 = op1==op2 && es1 `eqs` es2 function
/dports/lang/ghc/ghc-8.10.7/compiler/GHC/StgToCmm/
H A DPrim.hs1589 CmmMachOp (mop rep (wordWidth dflags)) [CmmMachOp (mop (wordWidth dflags) rep) [arg]]
1726 CmmMachOp (mo_wordUShr dflags) [
1727 CmmMachOp (mo_wordOr dflags) [
1729 CmmMachOp (mo_wordAnd dflags) [
1753 CmmMachOp (mo_wordUShr dflags) [
1754 CmmMachOp (mo_wordOr dflags) [
1755 CmmMachOp (mo_wordAnd dflags) [
1798 CmmMachOp (mo_wordUShr dflags) [
1800 CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]],
1823 CmmMachOp (mo_wordUShr dflags) [
[all …]
H A DProf.hs162 (CmmMachOp (MO_UU_Conv (wordWidth dflags) (typeWidth alloc_rep)) $
163 [CmmMachOp (mo_wordSub dflags) [words,
311 CmmMachOp (mo_wordOr dflags) [
312 CmmMachOp (mo_wordShl dflags) [loadEra dflags, mkIntExpr dflags (lDV_SHIFT dflags)],
349 …emit =<< mkCmmIfThenElse (CmmMachOp (mo_wordUGt dflags) [loadEra dflags, CmmLit (zeroCLit dflags)])
354 loadEra dflags = CmmMachOp (MO_UU_Conv (cIntWidth dflags) (wordWidth dflags))
H A DForeign.hs380 CmmMachOp (mo_wordSub df)
389 mkStore alloc_limit (CmmMachOp (MO_Sub W64)
391 , CmmMachOp (mo_WordTo64 df) [alloc] ])
491 (CmmMachOp (mo_wordMul df) [
492 CmmMachOp (MO_SS_Conv W32 (wordWidth df))
502 CmmMachOp (mo_wordSub df) [CmmReg bdfreereg, CmmReg bdstartreg]
508 mkStore alloc_limit (CmmMachOp (MO_Add W64)
510 , CmmMachOp (mo_WordTo64 df) [alloc] ])
H A DHeap.hs608 CmmMachOp (mo_wordULt dflags)
609 [CmmMachOp (MO_Sub (typeWidth (cmmRegType dflags spReg)))
616 hp_oflo = CmmMachOp (mo_wordUGt dflags) [hpExpr, hpLimExpr]
642 let yielding = CmmMachOp (mo_wordEq dflags)
H A DHpc.hs28 = mkStore tick_box (CmmMachOp (MO_Add W64)
/dports/lang/ghc/ghc-8.10.7/compiler/nativeGen/SPARC/CodeGen/
H A DAmode.hs33 getAmode (CmmMachOp (MO_Sub _) [x, CmmLit (CmmInt i _)])
42 getAmode (CmmMachOp (MO_Add _) [x, CmmLit (CmmInt i _)])
50 getAmode (CmmMachOp (MO_Add _) [x, y])
H A DGen64.hs129 iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)])
145 iselExpr64 (CmmMachOp (MO_Add _) [e1, e2])
179 iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr])
197 iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr])
H A DGen32.hs61 getRegister (CmmMachOp (MO_UU_Conv W64 W32)
62 [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
66 getRegister (CmmMachOp (MO_SS_Conv W64 W32)
67 [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
71 getRegister (CmmMachOp (MO_UU_Conv W64 W32) [x]) = do
75 getRegister (CmmMachOp (MO_SS_Conv W64 W32) [x]) = do
112 getRegister (CmmMachOp mop [x])
184 getRegister (CmmMachOp mop [x, y])
H A DCondCode.hs28 getCondCode (CmmMachOp mop [x, y])
58 _ -> pprPanic "SPARC.CodeGen.CondCode.getCondCode" (ppr (CmmMachOp mop [x,y]))
H A DBase.hs115 = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
/dports/lang/ghc/ghc-8.10.7/compiler/nativeGen/X86/
H A DCodeGen.hs574 iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
589 iselExpr64 (CmmMachOp (MO_Sub _) [e1,e2]) = do
1094 (CmmMachOp widen [x])
1095 (CmmMachOp widen [y])
1288 getAmode' is32Bit (CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _),
1299 getAmode' _ (CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Shl _)
1304 getAmode' _ (CmmMachOp (MO_Add _)
1305 [x, CmmMachOp (MO_Add _)
1312 getAmode' _ (CmmMachOp (MO_Add _) [x,y])
1540 getCondCode (CmmMachOp mop [x, y])
[all …]
/dports/lang/ghc/ghc-8.10.7/compiler/nativeGen/PPC/
H A DCodeGen.hs358 iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
371 iselExpr64 (CmmMachOp (MO_Sub _) [e1,e2]) = do
384 iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do
392 iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do
431 getRegister' dflags (CmmMachOp (MO_UU_Conv W64 W32)
437 getRegister' dflags (CmmMachOp (MO_SS_Conv W64 W32)
553 getRegister' _ (CmmMachOp mop [x, y]) -- dyadic PrimOps
800 getAmode _ (CmmMachOp (MO_Add W32) [x, CmmLit lit])
841 getAmode _ (CmmMachOp (MO_Add W32) [x, y])
847 getAmode _ (CmmMachOp (MO_Add W64) [x, y])
[all …]
/dports/devel/hs-ormolu/ormolu-0.4.0.0/_cabal_deps/ghc-lib-parser-9.2.1.20211101/compiler/GHC/Cmm/
H A DExpr.hs59 | CmmMachOp MachOp [CmmExpr] -- Machine operation (+, -, *, etc.) constructor
75 CmmMachOp op1 es1 == CmmMachOp op2 es2 = op1==op2 && es1==es2 function
230 (CmmMachOp op args) -> machOpResultType platform op (map (cmmExprType platform) args)
270 maybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op
271 return (CmmMachOp op' args)
390 expr z (CmmMachOp _ exprs) = foldRegsUsed platform f z exprs
H A DNode.hs467 wrapRecExp f (CmmMachOp op es) = f (CmmMachOp op $ map (wrapRecExp f) es)
498 wrapRecExpM f n@(CmmMachOp op es) = maybe (f n) (f . CmmMachOp op) (mapListM (wrapRecExpM f) es)
551 wrapRecExpf f e@(CmmMachOp _ es) z = foldr (wrapRecExpf f) (f e z) es
/dports/devel/hs-hlint/hlint-3.3.4/_cabal_deps/ghc-lib-parser-9.0.1.20210324/compiler/GHC/Cmm/
H A DExpr.hs59 | CmmMachOp MachOp [CmmExpr] -- Machine operation (+, -, *, etc.) constructor
74 CmmMachOp op1 es1 == CmmMachOp op2 es2 = op1==op2 && es1==es2 function
219 (CmmMachOp op args) -> machOpResultType platform op (map (cmmExprType platform) args)
259 maybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op
260 return (CmmMachOp op' args)
376 expr z (CmmMachOp _ exprs) = foldRegsUsed dflags f z exprs
H A DNode.hs465 wrapRecExp f (CmmMachOp op es) = f (CmmMachOp op $ map (wrapRecExp f) es)
496 wrapRecExpM f n@(CmmMachOp op es) = maybe (f n) (f . CmmMachOp op) (mapListM (wrapRecExpM f) es)
549 wrapRecExpf f e@(CmmMachOp _ es) z = foldr (wrapRecExpf f) (f e z) es
/dports/lang/ghc/ghc-8.10.7/compiler/nativeGen/
H A DPIC.hs165 = CmmMachOp (MO_Add W32)
174 = CmmMachOp (MO_Add W32) -- code model medium
183 = CmmMachOp (MO_Add (wordWidth dflags))

12