Add PrimCall to the STG layer and update Core -> STG translation

[ghc-hetmet.git] / compiler / codeGen / CgCon.lhs

diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index b22e56f..0fb90b0 100644 (file)
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -9,13 +9,6 @@ with {\em constructors} on the RHSs of let(rec)s.  See also
 @CgClosure@, which deals with closures.
 
 \begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 module CgCon (
        cgTopRhsCon, buildDynCon,
        bindConArgs, bindUnboxedTupleComponents,
@@ -54,6 +47,9 @@ import Outputable
 import ListSetOps
 import Util
 import FastString
+import StaticFlags
+
+import Control.Monad
 \end{code}
 
 
@@ -141,7 +137,7 @@ which have exclusively size-zero (VoidRep) args, we generate no code
 at all.
 
 \begin{code}
-buildDynCon binder cc con []
+buildDynCon binder _ con []
   = returnFC (taggedStableIdInfo binder
                           (mkLblExpr (mkClosureLabel (dataConName con)
                                       (idCafInfo binder)))
@@ -171,7 +167,7 @@ which is guaranteed in range.
 Because of this, we use can safely return an addressing mode.
 
 \begin{code}
-buildDynCon binder cc con [arg_amode]
+buildDynCon binder _ con [arg_amode]
   | maybeIntLikeCon con 
   , (_, CmmLit (CmmInt val _)) <- arg_amode
   , let val_int = (fromIntegral val) :: Int
@@ -182,7 +178,7 @@ buildDynCon binder cc con [arg_amode]
              intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
        ; returnFC (taggedStableIdInfo binder intlike_amode (mkConLFInfo con) con) }
 
-buildDynCon binder cc con [arg_amode]
+buildDynCon binder _ con [arg_amode]
   | maybeCharLikeCon con 
   , (_, CmmLit (CmmInt val _)) <- arg_amode
   , let val_int = (fromIntegral val) :: Int
@@ -303,6 +299,11 @@ sure the @amodes@ passed don't conflict with each other.
 cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
 
 cgReturnDataCon con amodes
+  | isUnboxedTupleCon con = returnUnboxedTuple amodes
+      -- when profiling we can't shortcut here, we have to enter the closure
+      -- for it to be marked as "used" for LDV profiling.
+  | opt_SccProfilingOn    = build_it_then enter_it
+  | otherwise
   = ASSERT( amodes `lengthIs` dataConRepArity con )
     do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
        ; case sequel of
@@ -326,11 +327,12 @@ cgReturnDataCon con amodes
                        | isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
                        | otherwise         -> build_it_then (jump_to deflt_lbl) }
     
-           other_sequel        -- The usual case
-             | isUnboxedTupleCon con -> returnUnboxedTuple amodes
-              | otherwise -> build_it_then emitReturnInstr
+           _otherwise  -- The usual case
+              -> build_it_then emitReturnInstr
        }
   where
+    enter_it    = stmtsC [ CmmAssign nodeReg (cmmUntag (CmmReg nodeReg)),
+                           CmmJump (entryCode (closureInfoPtr (CmmReg nodeReg))) [] ]
     jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
     build_it_then return_code
       = do {   -- BUILD THE OBJECT IN THE HEAP