[project @ 2002-03-08 15:50:53 by simonpj]

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

diff --git a/ghc/compiler/codeGen/CgRetConv.lhs b/ghc/compiler/codeGen/CgRetConv.lhs
index 4c6d89b..f3ef813 100644 (file)
--- 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.27 2000/10/12 15:17:08 sewardj Exp $
+% $Id: CgRetConv.lhs,v 1.31 2002/01/28 16:52:37 simonpj Exp $
 %
 \section[CgRetConv]{Return conventions for the code generator}
 
@@ -21,11 +21,11 @@ module CgRetConv (
 import AbsCSyn         -- quite a few things
 import Constants       ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
                          mAX_Vanilla_REG, mAX_Float_REG,
-                         mAX_Double_REG, mAX_Long_REG
-                       )
-import CmdLineOpts     ( opt_UseVanillaRegs, opt_UseFloatRegs,
-                         opt_UseDoubleRegs, opt_UseLongRegs
+                         mAX_Double_REG, mAX_Long_REG,
+                         mAX_Real_Vanilla_REG, mAX_Real_Float_REG,
+                         mAX_Real_Double_REG, mAX_Real_Long_REG
                        )
+import CmdLineOpts     ( opt_Unregisterised )
 import Maybes          ( catMaybes )
 import PrimRep         ( isFloatingRep, PrimRep(..), is64BitRep )
 import TyCon           ( TyCon, tyConFamilySize )
@@ -58,12 +58,16 @@ ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
 
 ctrlReturnConvAlg tycon
   = case (tyConFamilySize tycon) of
-      0 -> panic "ctrlRetConvAlg"
       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}
 
 %************************************************************************
@@ -77,6 +81,8 @@ dataReturnConvPrim :: PrimRep -> MagicId
 
 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)
@@ -185,11 +191,20 @@ We take these register supplies from the *real* registers, i.e. those
 that are guaranteed to map to machine registers.
 
 \begin{code}
+useVanillaRegs | opt_Unregisterised = 0
+              | otherwise          = mAX_Real_Vanilla_REG
+useFloatRegs   | opt_Unregisterised = 0
+              | otherwise          = mAX_Real_Float_REG
+useDoubleRegs  | opt_Unregisterised = 0
+              | otherwise          = mAX_Real_Double_REG
+useLongRegs    | opt_Unregisterised = 0
+              | otherwise          = mAX_Real_Long_REG
+
 vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: [Int]
-vanillaRegNos   = regList opt_UseVanillaRegs
-floatRegNos     = regList opt_UseFloatRegs
-doubleRegNos    = regList opt_UseDoubleRegs
-longRegNos       = regList opt_UseLongRegs
+vanillaRegNos   = regList useVanillaRegs
+floatRegNos     = regList useFloatRegs
+doubleRegNos    = regList useDoubleRegs
+longRegNos       = regList useLongRegs
 
 allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos :: [Int]
 allVanillaRegNos = regList mAX_Vanilla_REG