X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FCgExpr.lhs;h=e58fda7156bd8bc72d3d4e5daf85b8905da8934d;hp=33d72f16086ea7bf9cf49010cd74557c79a51dd8;hb=9ff76535edb25ab7434284adddb5c64708ecb547;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1

diff --git a/compiler/codeGen/CgExpr.lhs b/compiler/codeGen/CgExpr.lhs
index 33d72f1..e58fda7 100644
--- a/compiler/codeGen/CgExpr.lhs
+++ b/compiler/codeGen/CgExpr.lhs
@@ -1,56 +1,46 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgExpr.lhs,v 1.62 2005/06/21 10:44:41 simonmar Exp $
-%
-%********************************************************
-%*							*
-\section[CgExpr]{Converting @StgExpr@s}
-%*							*
-%********************************************************
 
 \begin{code}
 module CgExpr ( cgExpr ) where
 
 #include "HsVersions.h"
 
-import Constants	( mAX_SPEC_SELECTEE_SIZE, mAX_SPEC_AP_SIZE )
+import Constants
 import StgSyn
 import CgMonad
 
-import SMRep		( fixedHdrSize, isFollowableArg, CgRep(..), argMachRep,
-			  nonVoidArg, idCgRep, typeCgRep, typeHint,
-			  primRepToCgRep )
-import CoreSyn		( AltCon(..) )
-import CgProf		( emitSetCCC )
-import CgHeapery	( layOutDynConstr )
-import CgBindery	( getArgAmodes, getArgAmode, CgIdInfo, 
-			  nukeDeadBindings, addBindC, addBindsC )
-import CgCase		( cgCase, saveVolatileVarsAndRegs )
-import CgClosure	( cgRhsClosure, cgStdRhsClosure )
-import CgCon		( buildDynCon, cgReturnDataCon )
-import CgLetNoEscape	( cgLetNoEscapeClosure )
-import CgCallConv	( dataReturnConvPrim )
+import SMRep
+import CoreSyn
+import CgProf
+import CgHeapery
+import CgBindery
+import CgCase
+import CgClosure
+import CgCon
+import CgLetNoEscape
+import CgCallConv
 import CgTailCall
-import CgInfoTbls	( emitDirectReturnInstr )
-import CgForeignCall	( emitForeignCall, shimForeignCallArg )
-import CgPrimOp		( cgPrimOp )
-import CgUtils		( addIdReps, newTemp, assignTemp, cgLit, tagToClosure )
-import ClosureInfo	( mkSelectorLFInfo, mkApLFInfo )
-import Cmm		( CmmExpr(..), CmmStmt(..), CmmReg, nodeReg )
-import MachOp		( wordRep, MachHint )
+import CgInfoTbls
+import CgForeignCall
+import CgPrimOp
+import CgHpc
+import CgUtils
+import ClosureInfo
+import Cmm
+import MachOp
 import VarSet
-import Literal		( literalType )
-import PrimOp		( primOpOutOfLine, getPrimOpResultInfo, 
-			  PrimOp(..), PrimOpResultInfo(..) )
-import Id		( Id )
-import TyCon		( isUnboxedTupleTyCon, isEnumerationTyCon )
-import Type		( Type, tyConAppArgs, tyConAppTyCon, repType,
-			  PrimRep(VoidRep) )
-import Maybes		( maybeToBool )
-import ListSetOps	( assocMaybe )
-import BasicTypes	( RecFlag(..) )
-import Util             ( lengthIs )
+import Literal
+import PrimOp
+import Id
+import TyCon
+import Type
+import Maybes
+import ListSetOps
+import BasicTypes
+import Util
 import Outputable
 \end{code}
 
@@ -98,7 +88,7 @@ cgExpr (StgLit lit)
   = do  { cmm_lit <- cgLit lit
 	; performPrimReturn rep (CmmLit cmm_lit) }
   where
-    rep = typeCgRep (literalType lit)
+    rep = (typeCgRep) (literalType lit)
 \end{code}
 
 
@@ -131,11 +121,8 @@ cgExpr (StgOpApp (StgFCallOp fcall _) stg_args res_ty) = do
 		    | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes, 
 		      nonVoidArg rep]
 
-    -- in
     arg_tmps <- mapM assignTemp arg_exprs
-    let
-	arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
-    -- in
+    let	arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
     {-
 	Now, allocate some result regs.
     -}
@@ -152,9 +139,9 @@ cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
     do	{ (_,amode) <- getArgAmode arg
 	; amode' <- assignTemp amode	-- We're going to use it twice,
 					-- so save in a temp if non-trivial
-	; hmods <- getHomeModules
-	; stmtC (CmmAssign nodeReg (tagToClosure hmods tycon amode'))
-	; performReturn (emitAlgReturnCode tycon amode') }
+	; this_pkg <- getThisPackage
+	; stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon amode'))
+	; performReturn emitReturnInstr }
    where
 	  -- If you're reading this code in the attempt to figure
 	  -- out why the compiler panic'ed here, it is probably because
@@ -170,12 +157,12 @@ cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
 
   | ReturnsPrim VoidRep <- result_info
 	= do cgPrimOp [] primop args emptyVarSet
-	     performReturn emitDirectReturnInstr
+	     performReturn emitReturnInstr
 
   | ReturnsPrim rep <- result_info
 	= do cgPrimOp [dataReturnConvPrim (primRepToCgRep rep)] 
 			primop args emptyVarSet
-	     performReturn emitDirectReturnInstr
+	     performReturn emitReturnInstr
 
   | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
 	= do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
@@ -185,10 +172,10 @@ cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
   | ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
 	-- c.f. cgExpr (...TagToEnumOp...)
 	= do tag_reg <- newTemp wordRep
-	     hmods <- getHomeModules
+	     this_pkg <- getThisPackage
 	     cgPrimOp [tag_reg] primop args emptyVarSet
-	     stmtC (CmmAssign nodeReg (tagToClosure hmods tycon (CmmReg tag_reg)))
-	     performReturn (emitAlgReturnCode tycon (CmmReg tag_reg))
+	     stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon (CmmReg tag_reg)))
+	     performReturn emitReturnInstr
   where
 	result_info = getPrimOpResultInfo primop
 \end{code}
@@ -263,6 +250,16 @@ cgExpr (StgSCC cc expr) = do emitSetCCC cc; cgExpr expr
 \end{code}
 
 %********************************************************
+%*                                                     *
+%*             Hpc Tick Boxes                          *
+%*                                                     *
+%********************************************************
+
+\begin{code}
+cgExpr (StgTick m n expr) = do cgTickBox m n; cgExpr expr
+\end{code}
+
+%********************************************************
 %*							*
 %*		Non-top-level bindings			*
 %*							*
@@ -282,8 +279,8 @@ cgRhs name (StgRhsCon maybe_cc con args)
 	; returnFC (name, idinfo) }
 
 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
-  = do hmods <- getHomeModules
-       mkRhsClosure hmods name cc bi srt fvs upd_flag args body
+  = do this_pkg <- getThisPackage
+       mkRhsClosure this_pkg name cc bi srt fvs upd_flag args body
 \end{code}
 
 mkRhsClosure looks for two special forms of the right-hand side:
@@ -306,7 +303,7 @@ form:
 
 
 \begin{code}
-mkRhsClosure	hmods bndr cc bi srt
+mkRhsClosure	this_pkg bndr cc bi srt
 		[the_fv]   		-- Just one free var
 		upd_flag		-- Updatable thunk
 		[]			-- A thunk
@@ -328,7 +325,7 @@ mkRhsClosure	hmods bndr cc bi srt
   where
     lf_info 		  = mkSelectorLFInfo bndr offset_into_int
 				 (isUpdatable upd_flag)
-    (_, params_w_offsets) = layOutDynConstr hmods con (addIdReps params)
+    (_, params_w_offsets) = layOutDynConstr this_pkg con (addIdReps params)
 			-- Just want the layout
     maybe_offset	  = assocMaybe params_w_offsets selectee
     Just the_offset 	  = maybe_offset
@@ -352,7 +349,7 @@ We only generate an Ap thunk if all the free variables are pointers,
 for semi-obvious reasons.
 
 \begin{code}
-mkRhsClosure 	hmods bndr cc bi srt
+mkRhsClosure 	this_pkg bndr cc bi srt
 		fvs
 		upd_flag
 		[]			-- No args; a thunk
@@ -377,7 +374,7 @@ mkRhsClosure 	hmods bndr cc bi srt
 The default case
 ~~~~~~~~~~~~~~~~
 \begin{code}
-mkRhsClosure hmods bndr cc bi srt fvs upd_flag args body
+mkRhsClosure this_pkg bndr cc bi srt fvs upd_flag args body
   = cgRhsClosure bndr cc bi srt fvs upd_flag args body
 \end{code}