diff options
author | Ian Lynagh <igloo@earth.li> | 2009-02-06 14:02:49 +0000 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2009-02-06 14:02:49 +0000 |
commit | 497302c44ad08c6c27d0e15d94a787f332c0cfec (patch) | |
tree | a78fd252a39c2d49b5a5219a2c968004c5a1c029 /compiler/codeGen | |
parent | 1353826e5159c9a5a81e75e0b7459271f27c08ea (diff) | |
download | haskell-497302c44ad08c6c27d0e15d94a787f332c0cfec.tar.gz |
When generating C, don't pretend functions are data
We used to generated things like:
extern StgWordArray (newCAF) __attribute__((aligned (8)));
((void (*)(void *))(W_)&newCAF)((void *)R1.w);
(which is to say, pretend that newCAF is some data, then cast it to a
function and call it).
This goes wrong on at least IA64, where:
A function pointer on the ia64 does not point to the first byte of
code. Intsead, it points to a structure that describes the function.
The first quadword in the structure is the address of the first byte
of code
so we end up dereferencing function pointers one time too many, and
segfaulting.
Diffstat (limited to 'compiler/codeGen')
-rw-r--r-- | compiler/codeGen/CgForeignCall.hs | 3 | ||||
-rw-r--r-- | compiler/codeGen/CgHpc.hs | 5 | ||||
-rw-r--r-- | compiler/codeGen/CgUtils.hs | 2 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmForeign.hs | 2 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmHpc.hs | 2 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmUtils.hs | 2 |
6 files changed, 10 insertions, 6 deletions
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs index ceff757d3d..cf99f316c3 100644 --- a/compiler/codeGen/CgForeignCall.hs +++ b/compiler/codeGen/CgForeignCall.hs @@ -34,6 +34,7 @@ import Constants import StaticFlags import Outputable import FastString +import BasicTypes import Control.Monad @@ -77,7 +78,7 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live (call_args, cmm_target) = case target of StaticTarget lbl -> (args, CmmLit (CmmLabel - (mkForeignLabel lbl call_size False))) + (mkForeignLabel lbl call_size False IsFunction))) DynamicTarget -> case args of (CmmHinted fn _):rest -> (rest, fn) [] -> panic "emitForeignCall: DynamicTarget []" diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs index 9ae576944b..faee9c2d3f 100644 --- a/compiler/codeGen/CgHpc.hs +++ b/compiler/codeGen/CgHpc.hs @@ -21,6 +21,9 @@ import FastString import HscTypes import Panic import Char +import StaticFlags +import BasicTypes +import PackageConfig import Data.Word @@ -66,7 +69,7 @@ initHpc this_mod (HpcInfo tickCount hashNo) PlayRisky [CmmHinted id NoHint] (CmmCallee - (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False) + (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False IsFunction) CCallConv ) [ CmmHinted (mkLblExpr mkHpcModuleNameLabel) AddrHint diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs index b14d318c66..fad85f7e16 100644 --- a/compiler/codeGen/CgUtils.hs +++ b/compiler/codeGen/CgUtils.hs @@ -110,7 +110,7 @@ mkSimpleLit (MachWord i) = CmmInt i wordWidth mkSimpleLit (MachWord64 i) = CmmInt i W64 mkSimpleLit (MachFloat r) = CmmFloat r W32 mkSimpleLit (MachDouble r) = CmmFloat r W64 -mkSimpleLit (MachLabel fs ms) = CmmLabel (mkForeignLabel fs ms is_dyn) +mkSimpleLit (MachLabel fs ms fod) = CmmLabel (mkForeignLabel fs ms is_dyn fod) where is_dyn = False -- ToDo: fix me diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs index a4b5cf9f15..711b79e13f 100644 --- a/compiler/codeGen/StgCmmForeign.hs +++ b/compiler/codeGen/StgCmmForeign.hs @@ -58,7 +58,7 @@ cgForeignCall results result_hints (CCall (CCallSpec target cconv safety)) stg_a (call_args, cmm_target) = case target of StaticTarget lbl -> (args, CmmLit (CmmLabel - (mkForeignLabel lbl (call_size args) False))) + (mkForeignLabel lbl (call_size args) False IsFunction))) DynamicTarget -> case args of fn:rest -> (rest, fn) [] -> panic "cgForeignCall []" diff --git a/compiler/codeGen/StgCmmHpc.hs b/compiler/codeGen/StgCmmHpc.hs index f53c5c6839..afc238a252 100644 --- a/compiler/codeGen/StgCmmHpc.hs +++ b/compiler/codeGen/StgCmmHpc.hs @@ -54,7 +54,7 @@ initHpc this_mod (HpcInfo tickCount hashNo) ; id <- newTemp bWord -- TODO FIXME NOW ; emitCCall [(id,NoHint)] - (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False) + (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False IsFunction) [ (mkLblExpr mkHpcModuleNameLabel,AddrHint) , (CmmLit $ mkIntCLit tickCount,NoHint) , (CmmLit $ mkIntCLit hashNo,NoHint) diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 4803f5fba7..dc7fb8b9d1 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -99,7 +99,7 @@ mkSimpleLit (MachWord i) = CmmInt i wordWidth mkSimpleLit (MachWord64 i) = CmmInt i W64 mkSimpleLit (MachFloat r) = CmmFloat r W32 mkSimpleLit (MachDouble r) = CmmFloat r W64 -mkSimpleLit (MachLabel fs ms) = CmmLabel (mkForeignLabel fs ms is_dyn) +mkSimpleLit (MachLabel fs ms fod) = CmmLabel (mkForeignLabel fs ms is_dyn fod) where is_dyn = False -- ToDo: fix me mkSimpleLit other = pprPanic "mkSimpleLit" (ppr other) |