projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Added 'return' to C--, and made arguments to 'jump' into CmmExpr
[ghc-hetmet.git]
/
compiler
/
cmm
/
CmmParse.y
diff --git
a/compiler/cmm/CmmParse.y
b/compiler/cmm/CmmParse.y
index
ae23e19
..
38c30b2
100644
(file)
--- a/
compiler/cmm/CmmParse.y
+++ b/
compiler/cmm/CmmParse.y
@@
-104,6
+104,7
@@
import System.Exit
'jump' { L _ (CmmT_jump) }
'foreign' { L _ (CmmT_foreign) }
'prim' { L _ (CmmT_prim) }
'jump' { L _ (CmmT_jump) }
'foreign' { L _ (CmmT_foreign) }
'prim' { L _ (CmmT_prim) }
+ 'return' { L _ (CmmT_return) }
'import' { L _ (CmmT_import) }
'switch' { L _ (CmmT_switch) }
'case' { L _ (CmmT_case) }
'import' { L _ (CmmT_import) }
'switch' { L _ (CmmT_switch) }
'case' { L _ (CmmT_case) }
@@
-279,8
+280,10
@@
stmt :: { ExtCode }
{ doSwitch $2 $3 $5 $6 }
| 'goto' NAME ';'
{ do l <- lookupLabel $2; stmtEC (CmmBranch l) }
{ doSwitch $2 $3 $5 $6 }
| 'goto' NAME ';'
{ do l <- lookupLabel $2; stmtEC (CmmBranch l) }
- | 'jump' expr {-maybe_actuals-} ';'
- { do e <- $2; stmtEC (CmmJump e []) }
+ | 'jump' expr maybe_actuals ';'
+ { do e1 <- $2; e2 <- sequence $3; stmtEC (CmmJump e1 e2) }
+ | 'return' maybe_actuals ';'
+ { do e <- sequence $2; stmtEC (CmmReturn e) }
| 'if' bool_expr '{' body '}' else
{ ifThenElse $2 $4 $6 }
| 'if' bool_expr '{' body '}' else
{ ifThenElse $2 $4 $6 }
@@
-372,6
+375,10
@@
maybe_ty :: { MachRep }
: {- empty -} { wordRep }
| '::' type { $2 }
: {- empty -} { wordRep }
| '::' type { $2 }
+maybe_actuals :: { [ExtFCode (CmmExpr, MachHint)] }
+ : {- empty -} { [] }
+ | '(' hint_exprs0 ')' { $2 }
+
hint_exprs0 :: { [ExtFCode (CmmExpr, MachHint)] }
: {- empty -} { [] }
| hint_exprs { $1 }
hint_exprs0 :: { [ExtFCode (CmmExpr, MachHint)] }
: {- empty -} { [] }
| hint_exprs { $1 }
@@
-724,16
+731,19
@@
conInfo name ptrs nptrs srt_bitmap cl_type desc_str ty_str = do
return (lbl, info1, [desc_field])
basicInfo name layout srt_bitmap cl_type desc_str ty_str = do
return (lbl, info1, [desc_field])
basicInfo name layout srt_bitmap cl_type desc_str ty_str = do
+ let info_lbl = mkRtsInfoLabelFS name
lit1 <- if opt_SccProfilingOn
lit1 <- if opt_SccProfilingOn
- then code $ mkStringCLit desc_str
+ then code $ do lit <- mkStringCLit desc_str
+ return (makeRelativeRefTo info_lbl lit)
else return (mkIntCLit 0)
lit2 <- if opt_SccProfilingOn
else return (mkIntCLit 0)
lit2 <- if opt_SccProfilingOn
- then code $ mkStringCLit ty_str
+ then code $ do lit <- mkStringCLit ty_str
+ return (makeRelativeRefTo info_lbl lit)
else return (mkIntCLit 0)
let info1 = mkStdInfoTable lit1 lit2 (fromIntegral cl_type)
(fromIntegral srt_bitmap)
layout
else return (mkIntCLit 0)
let info1 = mkStdInfoTable lit1 lit2 (fromIntegral cl_type)
(fromIntegral srt_bitmap)
layout
- return (mkRtsInfoLabelFS name, info1, [])
+ return (info_lbl, info1, [])
funInfo name ptrs nptrs cl_type desc_str ty_str fun_type = do
(label,info1,_) <- stdInfo name ptrs nptrs 0{-srt_bitmap-}
funInfo name ptrs nptrs cl_type desc_str ty_str fun_type = do
(label,info1,_) <- stdInfo name ptrs nptrs 0{-srt_bitmap-}