diff options
| author | dias@cs.tufts.edu <unknown> | 2009-09-18 19:07:53 +0000 |
|---|---|---|
| committer | dias@cs.tufts.edu <unknown> | 2009-09-18 19:07:53 +0000 |
| commit | 787b08bdea84cca4bf9490d87c059453bffc5ad2 (patch) | |
| tree | 2716161b7fc6c951e6d572c6356defae08073f72 /compiler/codeGen | |
| parent | e4caa74b6c809cd17c5d1f7d472b9a47b2ea6f1c (diff) | |
| download | haskell-787b08bdea84cca4bf9490d87c059453bffc5ad2.tar.gz | |
Keep Touch'd variables live through the back end
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.
Diffstat (limited to 'compiler/codeGen')
| -rw-r--r-- | compiler/codeGen/StgCmmForeign.hs | 4 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 8 |
2 files changed, 6 insertions, 6 deletions
diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs index fae4f2f6bb..89a2b27833 100644 --- a/compiler/codeGen/StgCmmForeign.hs +++ b/compiler/codeGen/StgCmmForeign.hs @@ -97,9 +97,9 @@ emitCCall hinted_results fn hinted_args fc = ForeignConvention CCallConv arg_hints result_hints -emitPrimCall :: CmmFormal -> CallishMachOp -> CmmActuals -> FCode () +emitPrimCall :: CmmFormals -> CallishMachOp -> CmmActuals -> FCode () emitPrimCall res op args - = 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 diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index e5ff8f73ff..3318ec9cad 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -232,8 +232,8 @@ emitPrimOp [res] SizeofMutableByteArrayOp [arg] -- #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] @@ -413,9 +413,9 @@ emitPrimOp [res] op [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 - = do emitPrimCall res prim args + = do emitPrimCall r prim args | Just mop <- translateOp op = let stmt = mkAssign (CmmLocal res) (CmmMachOp mop args) in |