X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgRetConv.lhs;h=ecf7d52ae906b973539d912db306e76824f96eb3;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=0b72ebeb4e064fb131f4734a12de76f729ea3b0a;hpb=00fe57d46c18e83674cc17c77643164289abdef5;p=ghc-hetmet.git

diff --git a/ghc/compiler/codeGen/CgRetConv.lhs b/ghc/compiler/codeGen/CgRetConv.lhs
index 0b72ebe..ecf7d52 100644
--- a/ghc/compiler/codeGen/CgRetConv.lhs
+++ b/ghc/compiler/codeGen/CgRetConv.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP Project, Glasgow University, 1992-1998
 %
-% $Id: CgRetConv.lhs,v 1.29 2000/11/14 17:41:04 sewardj Exp $
+% $Id: CgRetConv.lhs,v 1.34 2003/10/09 11:58:46 simonpj Exp $
 %
 \section[CgRetConv]{Return conventions for the code generator}
 
@@ -26,7 +26,7 @@ import Constants	( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
 			  mAX_Real_Double_REG, mAX_Real_Long_REG
 			)
 import CmdLineOpts	( opt_Unregisterised )
-import Maybes		( catMaybes )
+import Maybes		( mapCatMaybes )
 import PrimRep		( isFloatingRep, PrimRep(..), is64BitRep )
 import TyCon		( TyCon, tyConFamilySize )
 import Util		( isn'tIn )
@@ -58,12 +58,16 @@ ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
 
 ctrlReturnConvAlg tycon
   = case (tyConFamilySize tycon) of
-      0 -> pprPanic "ctrlRetConvAlg" (ppr tycon)
       size -> -- we're supposed to know...
 	if (size > (1::Int) && size <= mAX_FAMILY_SIZE_FOR_VEC_RETURNS) then
 	    VectoredReturn size
 	else
-	    UnvectoredReturn size
+	    UnvectoredReturn size	
+  -- NB: unvectored returns Include size 0 (no constructors), so that
+  --     the following perverse code compiles (it crashed GHC in 5.02)
+  -- 	    data T1
+  --	    data T2 = T2 !T1 Int
+  --     The only value of type T1 is bottom, which never returns anyway.
 \end{code}
 
 %************************************************************************
@@ -75,8 +79,11 @@ ctrlReturnConvAlg tycon
 \begin{code}
 dataReturnConvPrim :: PrimRep -> MagicId
 
+dataReturnConvPrim PtrRep       = VanillaReg PtrRep  (_ILIT 1)
 dataReturnConvPrim IntRep	= VanillaReg IntRep  (_ILIT 1)
 dataReturnConvPrim WordRep	= VanillaReg WordRep (_ILIT 1)
+dataReturnConvPrim Int32Rep	= VanillaReg Int32Rep (_ILIT 1)
+dataReturnConvPrim Word32Rep	= VanillaReg Word32Rep (_ILIT 1)
 dataReturnConvPrim Int64Rep	= LongReg Int64Rep  (_ILIT 1)
 dataReturnConvPrim Word64Rep	= LongReg Word64Rep (_ILIT 1)
 dataReturnConvPrim AddrRep	= VanillaReg AddrRep (_ILIT 1)
@@ -84,18 +91,9 @@ dataReturnConvPrim CharRep	= VanillaReg CharRep (_ILIT 1)
 dataReturnConvPrim Int8Rep	= VanillaReg Int8Rep (_ILIT 1)
 dataReturnConvPrim FloatRep	= FloatReg  (_ILIT 1)
 dataReturnConvPrim DoubleRep	= DoubleReg (_ILIT 1)
+dataReturnConvPrim StablePtrRep = VanillaReg StablePtrRep  (_ILIT 1)
 dataReturnConvPrim VoidRep	= VoidReg
 
--- Return a primitive-array pointer in the usual register:
-dataReturnConvPrim ArrayRep     = VanillaReg ArrayRep     (_ILIT 1)
-dataReturnConvPrim ByteArrayRep = VanillaReg ByteArrayRep (_ILIT 1)
-dataReturnConvPrim PrimPtrRep   = VanillaReg PrimPtrRep   (_ILIT 1)
-dataReturnConvPrim ThreadIdRep  = VanillaReg ThreadIdRep  (_ILIT 1)
-
-dataReturnConvPrim StablePtrRep  = VanillaReg StablePtrRep  (_ILIT 1)
-dataReturnConvPrim ForeignObjRep = VanillaReg ForeignObjRep (_ILIT 1)
-dataReturnConvPrim WeakPtrRep    = VanillaReg WeakPtrRep    (_ILIT 1)
-
 #ifdef DEBUG
 dataReturnConvPrim rep		= pprPanic "dataReturnConvPrim:" (ppr rep)
 #endif
@@ -226,10 +224,10 @@ mkRegTbl_allRegs regs_in_use
 mkRegTbl' regs_in_use vanillas floats doubles longs
   = (ok_vanilla, ok_float, ok_double, ok_long)
   where
-    ok_vanilla = catMaybes (map (select (VanillaReg VoidRep))  vanillas)
-    ok_float   = catMaybes (map (select FloatReg)	       floats)
-    ok_double  = catMaybes (map (select DoubleReg)	       doubles)
-    ok_long    = catMaybes (map (select (LongReg Int64Rep))    longs)   
+    ok_vanilla = mapCatMaybes (select (VanillaReg VoidRep)) vanillas
+    ok_float   = mapCatMaybes (select FloatReg)	            floats
+    ok_double  = mapCatMaybes (select DoubleReg)	    doubles
+    ok_long    = mapCatMaybes (select (LongReg Int64Rep))   longs   
 				    -- rep isn't looked at, hence we can use any old rep.
 
     select :: (FastInt -> MagicId) -> Int{-cand-} -> Maybe Int