Added pointerhood to LocalReg

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

diff --git a/compiler/codeGen/CgCase.lhs b/compiler/codeGen/CgCase.lhs
index 23310dd..a473e91 100644 (file)
--- a/compiler/codeGen/CgCase.lhs
+++ b/compiler/codeGen/CgCase.lhs
@@ -108,8 +108,8 @@ cgCase (StgLit lit) live_in_whole_case live_in_alts bndr srt
        alt_type@(PrimAlt tycon) alts
   = do { tmp_reg <- bindNewToTemp bndr
        ; cm_lit <- cgLit lit
-       ; stmtC (CmmAssign tmp_reg (CmmLit cm_lit))
-       ; cgPrimAlts NoGC alt_type tmp_reg alts }
+       ; stmtC (CmmAssign (CmmLocal tmp_reg) (CmmLit cm_lit))
+       ; cgPrimAlts NoGC alt_type (CmmLocal tmp_reg) alts }
 \end{code}
 
 Special case #2: scrutinising a primitive-typed variable.      No
@@ -129,8 +129,8 @@ cgCase (StgApp v []) live_in_whole_case live_in_alts bndr srt
          v_info <- getCgIdInfo v
        ; amode <- idInfoToAmode v_info
        ; tmp_reg <- bindNewToTemp bndr
-       ; stmtC (CmmAssign tmp_reg amode)
-       ; cgPrimAlts NoGC alt_type tmp_reg alts }
+       ; stmtC (CmmAssign (CmmLocal tmp_reg) amode)
+       ; cgPrimAlts NoGC alt_type (CmmLocal tmp_reg) alts }
 \end{code}
 
 Special case #3: inline PrimOps and foreign calls.
@@ -168,7 +168,7 @@ cgCase (StgOpApp op@(StgFCallOp fcall _) args _)
    unsafe_foreign_call
         = case fcall of
                CCall (CCallSpec _ _ s) -> not (playSafe s)
-               _other                  -> False                                
+               _other                  -> False
 \end{code}
 
 Special case: scrutinising a non-primitive variable.
@@ -197,7 +197,7 @@ cgCase (StgApp fun args)
                        (do { deAllocStackTop retAddrSizeW
                            ; cgEvalAlts maybe_cc_slot bndr srt alt_type alts })
 
-       ; setEndOfBlockInfo (maybeReserveSeqFrame alt_type scrut_eob_info)
+       ; setEndOfBlockInfo scrut_eob_info
                            (performTailCall fun_info arg_amodes save_assts) }
 \end{code}
 
@@ -234,8 +234,7 @@ cgCase expr live_in_whole_case live_in_alts bndr srt alt_type alts
                           (do  { deAllocStackTop retAddrSizeW
                                ; cgEvalAlts maybe_cc_slot bndr srt alt_type alts })
 
-       ; setEndOfBlockInfo (maybeReserveSeqFrame alt_type scrut_eob_info)
-                           (cgExpr expr)
+       ; setEndOfBlockInfo scrut_eob_info (cgExpr expr)
     }
 \end{code}
 
@@ -265,13 +264,6 @@ consequence of this is that activation records on the stack don't
 follow the layout of closures when we're profiling.  The CCS could be
 anywhere within the record).
 
-\begin{code}
-maybeReserveSeqFrame PolyAlt (EndOfBlockInfo args_sp (CaseAlts amode stuff bndr _))
-   = EndOfBlockInfo (args_sp + retAddrSizeW) (CaseAlts amode stuff bndr True)
-maybeReserveSeqFrame other scrut_eob_info = scrut_eob_info
-\end{code}
-
-
 %************************************************************************
 %*                                                                     *
                Inline primops
@@ -293,7 +285,7 @@ cgInlinePrimOp primop args bndr (PrimAlt tycon) live_in_alts alts
   = do {       -- PRIMITIVE ALTS, with non-void result
          tmp_reg <- bindNewToTemp bndr
        ; cgPrimOp [tmp_reg] primop args live_in_alts
-       ; cgPrimAlts NoGC (PrimAlt tycon) tmp_reg alts }
+       ; cgPrimAlts NoGC (PrimAlt tycon) (CmmLocal tmp_reg) alts }
 
 cgInlinePrimOp primop args bndr (UbxTupAlt tycon) live_in_alts alts
   = ASSERT( isSingleton alts )
@@ -323,7 +315,9 @@ cgInlinePrimOp primop args bndr (AlgAlt tycon) live_in_alts alts
        ; this_pkg <- getThisPackage
        ; whenC (not (isDeadBinder bndr))
                (do { tmp_reg <- bindNewToTemp bndr
-                   ; stmtC (CmmAssign tmp_reg (tagToClosure this_pkg tycon tag_amode)) })
+                   ; stmtC (CmmAssign
+                             (CmmLocal tmp_reg)
+                             (tagToClosure this_pkg tycon tag_amode)) })
 
                -- Compile the alts
        ; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
@@ -340,9 +334,9 @@ cgInlinePrimOp primop args bndr (AlgAlt tycon) live_in_alts alts
          (_,e) <- getArgAmode arg
         return e
     do_enum_primop primop
-      = do tmp <- newTemp wordRep
+      = do tmp <- newNonPtrTemp wordRep
           cgPrimOp [tmp] primop args live_in_alts
-          returnFC (CmmReg tmp)
+          returnFC (CmmReg (CmmLocal tmp))
 
 cgInlinePrimOp primop arg_amodes bndr PolyAlt live_in_alts alts
   = pprPanic "cgCase: case of primop has polymorphic type" (ppr bndr)
@@ -380,8 +374,8 @@ cgEvalAlts cc_slot bndr srt alt_type@(PrimAlt tycon) alts
                ; restoreCurrentCostCentre cc_slot True
                ; cgPrimAlts GCMayHappen alt_type reg alts }
 
-       ; lbl <- emitDirectReturnTarget (idName bndr) abs_c srt
-       ; returnFC (CaseAlts lbl Nothing bndr False) }
+       ; lbl <- emitReturnTarget (idName bndr) abs_c srt
+       ; returnFC (CaseAlts lbl Nothing bndr) }
 
 cgEvalAlts cc_slot bndr srt (UbxTupAlt _) [(con,args,_,rhs)]
   =    -- Unboxed tuple case
@@ -392,7 +386,7 @@ cgEvalAlts cc_slot bndr srt (UbxTupAlt _) [(con,args,_,rhs)]
     ASSERT2( case con of { DataAlt _ -> True; other -> False },
             text "cgEvalAlts: dodgy case of unboxed tuple type" )
     do {       -- forkAbsC for the RHS, so that the envt is
-               -- not changed for the emitDirectReturn call
+               -- not changed for the emitReturn call
          abs_c <- forkProc $ do 
                { (live_regs, ptrs, nptrs, _) <- bindUnboxedTupleComponents args
                        -- Restore the CC *after* binding the tuple components, 
@@ -402,8 +396,8 @@ cgEvalAlts cc_slot bndr srt (UbxTupAlt _) [(con,args,_,rhs)]
                        -- and finally the code for the alternative
                ; unbxTupleHeapCheck live_regs ptrs nptrs noStmts
                                     (cgExpr rhs) }
-       ; lbl <- emitDirectReturnTarget (idName bndr) abs_c srt
-       ; returnFC (CaseAlts lbl Nothing bndr False) }
+       ; lbl <- emitReturnTarget (idName bndr) abs_c srt
+       ; returnFC (CaseAlts lbl Nothing bndr) }
 
 cgEvalAlts cc_slot bndr srt alt_type alts
   =    -- Algebraic and polymorphic case
@@ -422,13 +416,13 @@ cgEvalAlts cc_slot bndr srt alt_type alts
        ; (alts, mb_deflt) <- cgAlgAlts GCMayHappen cc_slot alt_type alts
 
        ; (lbl, branches) <- emitAlgReturnTarget (idName bndr) 
-                               alts mb_deflt srt ret_conv
+                               alts mb_deflt srt fam_sz
 
-       ; returnFC (CaseAlts lbl branches bndr False) }
+       ; returnFC (CaseAlts lbl branches bndr) }
   where
-    ret_conv = case alt_type of
-               AlgAlt tc -> ctrlReturnConvAlg tc
-               PolyAlt   -> UnvectoredReturn 0
+    fam_sz = case alt_type of
+               AlgAlt tc -> tyConFamilySize tc
+               PolyAlt   -> 0
 \end{code}