diff options
| author | Michael D. Adams <t-madams@microsoft.com> | 2007-06-27 15:09:03 +0000 |
|---|---|---|
| committer | Michael D. Adams <t-madams@microsoft.com> | 2007-06-27 15:09:03 +0000 |
| commit | affbe8dae5d7eb350686b42ddbd4f3561b7bd0ec (patch) | |
| tree | 7558970725c9e17e0017d6c825949d8e178d3445 /compiler/cmm/CmmParse.y | |
| parent | 207802589da0d23c3f16195f453b24a1e46e322d (diff) | |
| download | haskell-affbe8dae5d7eb350686b42ddbd4f3561b7bd0ec.tar.gz | |
Added an SRT to each CmmCall and added the current SRT to the CgMonad
Diffstat (limited to 'compiler/cmm/CmmParse.y')
| -rw-r--r-- | compiler/cmm/CmmParse.y | 21 |
1 files changed, 13 insertions, 8 deletions
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 567dd606ad..dda1ca246b 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -267,10 +267,11 @@ stmt :: { ExtCode } -- { do reg <- head $1; e <- $3; stmtEC (CmmAssign (fst reg) e) } | type '[' expr ']' '=' expr ';' { doStore $1 $3 $6 } +-- TODO: add real SRT to parsed Cmm | maybe_results 'foreign' STRING expr '(' hint_exprs0 ')' vols ';' - {% foreignCall $3 $1 $4 $6 $8 } + {% foreignCall $3 $1 $4 $6 $8 NoC_SRT } | maybe_results 'prim' '%' NAME '(' hint_exprs0 ')' vols ';' - {% primCall $1 $4 $6 $8 } + {% primCall $1 $4 $6 $8 NoC_SRT } -- stmt-level macros, stealing syntax from ordinary C-- function calls. -- Perhaps we ought to use the %%-form? | NAME '(' exprs0 ')' ';' @@ -818,8 +819,10 @@ foreignCall -> [ExtFCode (CmmFormal,MachHint)] -> ExtFCode CmmExpr -> [ExtFCode (CmmExpr,MachHint)] - -> Maybe [GlobalReg] -> P ExtCode -foreignCall conv_string results_code expr_code args_code vols + -> Maybe [GlobalReg] + -> C_SRT + -> P ExtCode +foreignCall conv_string results_code expr_code args_code vols srt = do convention <- case conv_string of "C" -> return CCallConv "C--" -> return CmmCallConv @@ -829,20 +832,22 @@ foreignCall conv_string results_code expr_code args_code vols expr <- expr_code args <- sequence args_code code (emitForeignCall' PlayRisky results - (CmmForeignCall expr convention) args vols) where + (CmmForeignCall expr convention) args vols srt) where primCall :: [ExtFCode (CmmFormal,MachHint)] -> FastString -> [ExtFCode (CmmExpr,MachHint)] - -> Maybe [GlobalReg] -> P ExtCode -primCall results_code name args_code vols + -> Maybe [GlobalReg] + -> C_SRT + -> P ExtCode +primCall results_code name args_code vols srt = case lookupUFM callishMachOps name of Nothing -> fail ("unknown primitive " ++ unpackFS name) Just p -> return $ do results <- sequence results_code args <- sequence args_code - code (emitForeignCall' PlayRisky results (CmmPrim p) args vols) + code (emitForeignCall' PlayRisky results (CmmPrim p) args vols srt) doStore :: MachRep -> ExtFCode CmmExpr -> ExtFCode CmmExpr -> ExtCode doStore rep addr_code val_code |