X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgRetConv.lhs;h=d6342e2c3f638d2017bcce064985324ce25f7087;hb=9dd6e1c216993624a2cd74b62ca0f0569c02c26b;hp=856a119cd259e8e6d8b69fb84a68cad7b734f9b7;hpb=5cf27e8f1731c52fe63a5b9615f927484164c61b;p=ghc-hetmet.git

diff --git a/ghc/compiler/codeGen/CgRetConv.lhs b/ghc/compiler/codeGen/CgRetConv.lhs
index 856a119..d6342e2 100644
--- a/ghc/compiler/codeGen/CgRetConv.lhs
+++ b/ghc/compiler/codeGen/CgRetConv.lhs
@@ -7,8 +7,6 @@ The datatypes and functions here encapsulate what there is to know
 about return conventions.
 
 \begin{code}
-#include "HsVersions.h"
-
 module CgRetConv (
 	CtrlReturnConvention(..), DataReturnConvention(..),
 
@@ -20,29 +18,25 @@ module CgRetConv (
 	assignPrimOpResultRegs,
 	makePrimOpArgsRobust,
 	assignRegs
-
-	-- and to make the interface self-sufficient...
     ) where
 
-import Ubiq{-uitous-}
-import AbsCLoop		-- paranoia checking
+#include "HsVersions.h"
 
 import AbsCSyn		-- quite a few things
 import AbsCUtils	( mkAbstractCs, getAmodeRep,
 			  amodeCanSurviveGC
 			)
-import CgCompInfo	( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
+import Constants	( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
 			  mAX_Vanilla_REG, mAX_Float_REG,
 			  mAX_Double_REG
 			)
 import CmdLineOpts	( opt_ReturnInRegsThreshold )
-import Id		( isDataCon, dataConSig,
-			  DataCon(..), GenId{-instance Eq-}
+import Id		( isDataCon, dataConRawArgTys,
+			  DataCon, GenId{-instance Eq-},
+			  Id
 			)
 import Maybes		( catMaybes )
-import PprStyle		( PprStyle(..) )
 import PprType		( TyCon{-instance Outputable-} )
-import PrelInfo		( integerDataCon )
 import PrimOp		( primOpCanTriggerGC,
 			  getPrimOpResultInfo, PrimOpResultInfo(..),
 			  PrimOp{-instance Outputable-}
@@ -50,9 +44,8 @@ import PrimOp		( primOpCanTriggerGC,
 import PrimRep		( isFloatingRep, PrimRep(..) )
 import TyCon		( tyConDataCons, tyConFamilySize )
 import Type		( typePrimRep )
-import Util		( zipWithEqual, mapAccumL, isn'tIn,
-			  pprError, pprTrace, panic, assertPanic
-			)
+import Util		( zipWithEqual, mapAccumL, isn'tIn )
+import Outputable
 \end{code}
 
 %************************************************************************
@@ -95,7 +88,7 @@ ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
 
 ctrlReturnConvAlg tycon
   = case (tyConFamilySize tycon) of
-      0 -> pprTrace "ctrlReturnConvAlg:" (ppr PprDebug tycon) $
+      0 -> pprTrace "ctrlReturnConvAlg:" (ppr tycon) $
 	   UnvectoredReturn 0 -- e.g., w/ "data Bin"
 
       size -> -- we're supposed to know...
@@ -119,18 +112,16 @@ then it gives up, returning @ReturnInHeap@.
 dataReturnConvAlg :: DataCon -> DataReturnConvention
 
 dataReturnConvAlg data_con
-  = ASSERT(isDataCon data_con)
+  = ASSERT2(isDataCon data_con, (ppr data_con))
     case leftover_kinds of
 	[]    ->	ReturnInRegs reg_assignment
 	other ->	ReturnInHeap	-- Didn't fit in registers
   where
-    (_, _, arg_tys, _) = dataConSig data_con
+    arg_tys = dataConRawArgTys data_con
 
     (reg_assignment, leftover_kinds)
       = assignRegs [node, infoptr] -- taken...
 		   (map typePrimRep arg_tys)
-
-    is_prim_result_ty = data_con == integerDataCon -- ***HACK***! (WDP 95/11)
 \end{code}
 
 %************************************************************************
@@ -158,7 +149,7 @@ dataReturnConvPrim ArrayRep     = VanillaReg ArrayRep ILIT(1)
 dataReturnConvPrim ByteArrayRep = VanillaReg ByteArrayRep ILIT(1)
 
 dataReturnConvPrim StablePtrRep = VanillaReg StablePtrRep ILIT(1)
-dataReturnConvPrim MallocPtrRep = VanillaReg MallocPtrRep ILIT(1)
+dataReturnConvPrim ForeignObjRep = VanillaReg ForeignObjRep ILIT(1)
 
 #ifdef DEBUG
 dataReturnConvPrim PtrRep	= panic "dataReturnConvPrim: PtrRep"
@@ -207,8 +198,8 @@ argument into it).
 
 Bug: it is assumed that robust amodes cannot contain pointers.  This
 seems reasonable but isn't true.  For example, \tr{Array#}'s
-\tr{MallocPtr#}'s are pointers.  (This is only known to bite on
-\tr{_ccall_GC_} with a MallocPtr argument.)
+\tr{ForeignObj#}'s are pointers.  (This is only known to bite on
+\tr{_ccall_GC_} with a ForeignObj argument.)
 
 See after for some ADR comments...
 
@@ -232,7 +223,7 @@ makePrimOpArgsRobust op arg_amodes
 		-- Check that all the args fit before returning arg_regs
 	final_arg_regs = case extra_args of
 			   []    -> arg_regs
-			   other -> pprError "Cannot allocate enough registers for primop (try rearranging code or reducing number of arguments?)" (ppr PprDebug op)
+			   other -> pprPanic "Cannot allocate enough registers for primop (try rearranging code or reducing number of arguments?)" (ppr op)
 
 	arg_assts
 	  = mkAbstractCs (zipWithEqual "assign_to_reg" assign_to_reg final_arg_regs non_robust_amodes)