Added 'return' to C--, and made arguments to 'jump' into CmmExpr

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index a6c3ec4..c2f8d48 100644 (file)
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -130,8 +130,11 @@ data CmmStmt
        --      one  -> second block etc
        -- Undefined outside range, and when there's a Nothing
 
        --      one  -> second block etc
        -- Undefined outside range, and when there's a Nothing
 

-  | CmmJump CmmExpr [LocalReg]    -- Jump to another function, with these 
-                                 -- parameters.
+  | CmmJump CmmExpr               -- Jump to another function,
+    [(CmmExpr, MachHint)]         -- with these parameters.
+
+  | CmmReturn                     -- Return from a function,
+    [(CmmExpr, MachHint)]         -- with these return values.

 
 {-
 Discussion
 
 {-
 Discussion

diff --git a/compiler/cmm/CmmLex.x b/compiler/cmm/CmmLex.x
index a1aa276..dffb355 100644 (file)
--- a/compiler/cmm/CmmLex.x
+++ b/compiler/cmm/CmmLex.x
@@ -139,6 +139,7 @@ data CmmToken
   | CmmT_jump
   | CmmT_foreign
   | CmmT_prim
   | CmmT_jump
   | CmmT_foreign
   | CmmT_prim

+  | CmmT_return

   | CmmT_import
   | CmmT_switch
   | CmmT_case
   | CmmT_import
   | CmmT_switch
   | CmmT_case

@@ -214,6 +215,7 @@ reservedWordsFM = listToUFM $
        ( "jump",               CmmT_jump ),
        ( "foreign",            CmmT_foreign ),
        ( "prim",               CmmT_prim ),
        ( "jump",               CmmT_jump ),
        ( "foreign",            CmmT_foreign ),
        ( "prim",               CmmT_prim ),

+       ( "return",             CmmT_return ),

        ( "import",             CmmT_import ),
        ( "switch",             CmmT_switch ),
        ( "case",               CmmT_case ),
        ( "import",             CmmT_import ),
        ( "switch",             CmmT_switch ),
        ( "case",               CmmT_case ),

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index b3f68a9..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 }

diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index e8176ba..b718ec9 100644 (file)
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -167,6 +167,7 @@ pprStmt stmt = case stmt of
     CmmBranch ident          -> genBranch ident
     CmmCondBranch expr ident -> genCondBranch expr ident
     CmmJump expr params      -> genJump expr params
     CmmBranch ident          -> genBranch ident
     CmmCondBranch expr ident -> genCondBranch expr ident
     CmmJump expr params      -> genJump expr params

+    CmmReturn params         -> genReturn params

     CmmSwitch arg ids        -> genSwitch arg ids
 
 -- --------------------------------------------------------------------------
     CmmSwitch arg ids        -> genSwitch arg ids
 
 -- --------------------------------------------------------------------------

@@ -195,8 +196,8 @@ genCondBranch expr ident =
 --
 --     jump foo(a, b, c);
 --
 --
 --     jump foo(a, b, c);
 --

-genJump :: CmmExpr -> [LocalReg] -> SDoc
-genJump expr actuals = 
+genJump :: CmmExpr -> [(CmmExpr, MachHint)] -> SDoc
+genJump expr args = 

 
     hcat [ ptext SLIT("jump")
          , space
 
     hcat [ ptext SLIT("jump")
          , space

@@ -205,12 +206,21 @@ genJump expr actuals =
                 else case expr of
                     CmmLoad (CmmReg _) _ -> pprExpr expr 
                     _ -> parens (pprExpr expr)
                 else case expr of
                     CmmLoad (CmmReg _) _ -> pprExpr expr 
                     _ -> parens (pprExpr expr)

-         , pprActuals actuals
+         , parens  ( commafy $ map ppr args )

          , semi ]
 
          , semi ]
 

-  where
-    pprActuals [] = empty
-    pprActuals as = parens ( commafy $ map pprLocalReg as ) 
+-- --------------------------------------------------------------------------
+-- Return from a function. [1], Section 6.8.2 of version 1.128
+--
+--     return (a, b, c);
+--
+genReturn :: [(CmmExpr, MachHint)] -> SDoc
+genReturn args = 
+
+    hcat [ ptext SLIT("return")
+         , space
+         , parens  ( commafy $ map ppr args )
+         , semi ]

 
 -- --------------------------------------------------------------------------
 -- Tabled jump to local label
 
 -- --------------------------------------------------------------------------
 -- Tabled jump to local label