diff options
author | Isaac Dupree <id@isaac.cedarswampstudios.org> | 2008-01-04 10:53:39 +0000 |
---|---|---|
committer | Isaac Dupree <id@isaac.cedarswampstudios.org> | 2008-01-04 10:53:39 +0000 |
commit | d76b6a05ab36066e8aeb67d58e25992d1ef83a8a (patch) | |
tree | 6a1994b9d1cac97252b4435219b33477cd80e139 /compiler/codeGen/CgForeignCall.hs | |
parent | 84629bd7dc7377a5f1138df7185a0b9771880834 (diff) | |
download | haskell-d76b6a05ab36066e8aeb67d58e25992d1ef83a8a.tar.gz |
change CmmActual, CmmFormal to use a data CmmHinted rather than tuple (#1405)
This allows the instance of UserOfLocalRegs to be within Haskell98, and IMHO
makes the code a little cleaner generally.
This is one small (though tedious) step towards making GHC's code more
portable...
Diffstat (limited to 'compiler/codeGen/CgForeignCall.hs')
-rw-r--r-- | compiler/codeGen/CgForeignCall.hs | 23 |
1 files changed, 12 insertions, 11 deletions
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs index fec1a8f058..8e1be19beb 100644 --- a/compiler/codeGen/CgForeignCall.hs +++ b/compiler/codeGen/CgForeignCall.hs @@ -64,7 +64,8 @@ cgForeignCall results fcall stg_args live | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes, nonVoidArg rep] - arg_hints = zip arg_exprs (map (typeHint.stgArgType) stg_args) + arg_hints = zipWith CmmHinted + arg_exprs (map (typeHint.stgArgType) stg_args) -- in emitForeignCall results fcall arg_hints live @@ -72,7 +73,7 @@ cgForeignCall results fcall stg_args live emitForeignCall :: CmmFormals -- where to put the results -> ForeignCall -- the op - -> [(CmmExpr,MachHint)] -- arguments + -> [CmmHinted CmmExpr] -- arguments -> StgLiveVars -- live vars, in case we need to save them -> Code @@ -86,14 +87,14 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live = case target of StaticTarget lbl -> (args, CmmLit (CmmLabel (mkForeignLabel lbl call_size False))) - DynamicTarget -> case args of (fn,_):rest -> (rest, fn) + DynamicTarget -> case args of (CmmHinted fn _):rest -> (rest, fn) -- in the stdcall calling convention, the symbol needs @size appended -- to it, where size is the total number of bytes of arguments. We -- attach this info to the CLabel here, and the CLabel pretty printer -- will generate the suffix when the label is printed. call_size - | StdCallConv <- cconv = Just (sum (map (arg_size.cmmExprRep.fst) args)) + | StdCallConv <- cconv = Just (sum (map (arg_size.cmmExprRep.hintlessCmm) args)) | otherwise = Nothing -- ToDo: this might not be correct for 64-bit API @@ -108,7 +109,7 @@ emitForeignCall' :: Safety -> CmmFormals -- where to put the results -> CmmCallTarget -- the op - -> [(CmmExpr,MachHint)] -- arguments + -> [CmmHinted CmmExpr] -- arguments -> Maybe [GlobalReg] -- live vars, in case we need to save them -> C_SRT -- the SRT of the calls continuation -> CmmReturnInfo @@ -137,13 +138,13 @@ emitForeignCall' safety results target args vols srt ret -- and the CPS will will be the one to convert that -- to this sequence of three CmmUnsafe calls. stmtC (CmmCall (CmmCallee suspendThread CCallConv) - [ (id,PtrHint) ] - [ (CmmReg (CmmGlobal BaseReg), PtrHint) ] + [ CmmHinted id PtrHint ] + [ CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint ] CmmUnsafe ret) stmtC (CmmCall temp_target results temp_args CmmUnsafe ret) stmtC (CmmCall (CmmCallee resumeThread CCallConv) - [ (new_base, PtrHint) ] - [ (CmmReg (CmmLocal id), PtrHint) ] + [ CmmHinted new_base PtrHint ] + [ CmmHinted (CmmReg (CmmLocal id)) PtrHint ] CmmUnsafe ret) -- Assign the result to BaseReg: we -- might now have a different Capability! @@ -163,9 +164,9 @@ resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("resumeThread"))) -- This is a HACK; really it should be done in the back end, but -- it's easier to generate the temporaries here. load_args_into_temps = mapM arg_assign_temp - where arg_assign_temp (e,hint) = do + where arg_assign_temp (CmmHinted e hint) = do tmp <- maybe_assign_temp e - return (tmp,hint) + return (CmmHinted tmp hint) load_target_into_temp (CmmCallee expr conv) = do tmp <- maybe_assign_temp expr |