summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
e4caa74)
When we used derived pointers into the middle of an object,
we need to keep the pointer to the start of the object live.
We use a "fat machine instruction" with the primitive MO_Touch
to propagate this information through the back end.
| MO_F32_Exp
| MO_F32_Sqrt
| MO_WriteBarrier
| MO_F32_Exp
| MO_F32_Sqrt
| MO_WriteBarrier
+ | MO_Touch -- Keep variables live (when using interior pointers)
deriving (Eq, Show)
pprCallishMachOp :: CallishMachOp -> SDoc
deriving (Eq, Show)
pprCallishMachOp :: CallishMachOp -> SDoc
mid (MidComment s) = CmmComment s
mid (MidAssign l r) = CmmAssign l r
mid (MidStore l r) = CmmStore l r
mid (MidComment s) = CmmComment s
mid (MidAssign l r) = CmmAssign l r
mid (MidStore l r) = CmmStore l r
+ mid (MidForeignCall _ (PrimTarget MO_Touch) _ _) = CmmNop
mid (MidForeignCall _ target ress args)
= CmmCall (cmm_target target)
(add_hints conv Results ress)
mid (MidForeignCall _ target ress args)
= CmmCall (cmm_target target)
(add_hints conv Results ress)
-- the call goes into a loop.
}
-- the call goes into a loop.
}
-data MidCallTarget -- The target of a MidUnsafeCall
- = ForeignTarget -- A foreign procedure
- CmmExpr -- Its address
- ForeignConvention -- Its calling convention
+data MidCallTarget -- The target of a MidUnsafeCall
+ = ForeignTarget -- A foreign procedure
+ CmmExpr -- Its address
+ ForeignConvention -- Its calling convention
- | PrimTarget -- A possibly-side-effecting machine operation
- CallishMachOp -- Which one
+ | PrimTarget -- A possibly-side-effecting machine operation
+ CallishMachOp -- Which one
deriving Eq
data Convention
deriving Eq
data Convention
foldRegsUsed f z (ForeignTarget e _) = foldRegsUsed f z e
instance UserOfSlots MidCallTarget where
foldRegsUsed f z (ForeignTarget e _) = foldRegsUsed f z e
instance UserOfSlots MidCallTarget where
+ foldSlotsUsed f z (ForeignTarget e _) = foldSlotsUsed f z e
foldSlotsUsed _f z (PrimTarget _) = z
foldSlotsUsed _f z (PrimTarget _) = z
- foldSlotsUsed f z (ForeignTarget e _) = foldSlotsUsed f z e
instance (UserOfLocalRegs a) => UserOfLocalRegs (Maybe a) where
foldRegsUsed f z (Just x) = foldRegsUsed f z x
instance (UserOfLocalRegs a) => UserOfLocalRegs (Maybe a) where
foldRegsUsed f z (Just x) = foldRegsUsed f z x
fc = ForeignConvention CCallConv arg_hints result_hints
fc = ForeignConvention CCallConv arg_hints result_hints
-emitPrimCall :: CmmFormal -> CallishMachOp -> CmmActuals -> FCode ()
+emitPrimCall :: CmmFormals -> CallishMachOp -> CmmActuals -> FCode ()
- = emitForeignCall PlayRisky [res] (PrimTarget op) args NoC_SRT CmmMayReturn
+ = emitForeignCall PlayRisky res (PrimTarget op) args NoC_SRT CmmMayReturn
-- alternative entry point, used by CmmParse
emitForeignCall
-- alternative entry point, used by CmmParse
emitForeignCall
-- #define touchzh(o) /* nothing */
-- #define touchzh(o) /* nothing */
-emitPrimOp [] TouchOp [_arg]
- = nopC
+emitPrimOp res@[] TouchOp args@[_arg]
+ = do emitPrimCall res MO_Touch args
-- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
emitPrimOp [res] ByteArrayContents_Char [arg]
-- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
emitPrimOp [res] ByteArrayContents_Char [arg]
= emit (mkAssign (CmmLocal res) $
CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]])
= emit (mkAssign (CmmLocal res) $
CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]])
-emitPrimOp [res] op args
+emitPrimOp r@[res] op args
| Just prim <- callishOp op
| Just prim <- callishOp op
- = do emitPrimCall res prim args
+ = do emitPrimCall r prim args
| Just mop <- translateOp op
= let stmt = mkAssign (CmmLocal res) (CmmMachOp mop args) in
| Just mop <- translateOp op
= let stmt = mkAssign (CmmLocal res) (CmmMachOp mop args) in