X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgRetConv.lhs;h=ecf7d52ae906b973539d912db306e76824f96eb3;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=77a37f373defe3e8b432810822992106d573c707;hpb=7e602b0a11e567fcb035d1afd34015aebcf9a577;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgRetConv.lhs b/ghc/compiler/codeGen/CgRetConv.lhs index 77a37f3..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.16 1998/12/18 17:40:52 simonpj Exp $ +% $Id: CgRetConv.lhs,v 1.34 2003/10/09 11:58:46 simonpj Exp $ % \section[CgRetConv]{Return conventions for the code generator} @@ -21,20 +21,16 @@ 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_Double_REG, mAX_Long_REG, mAX_Real_Vanilla_REG, mAX_Real_Float_REG, - mAX_Real_Double_REG, - mAX_Long_REG + mAX_Real_Double_REG, mAX_Real_Long_REG ) -import Maybes ( catMaybes ) -import DataCon ( dataConRawArgTys, DataCon ) -import PrimOp ( PrimOp{-instance Outputable-} ) +import CmdLineOpts ( opt_Unregisterised ) +import Maybes ( mapCatMaybes ) import PrimRep ( isFloatingRep, PrimRep(..), is64BitRep ) -import TyCon ( TyCon, tyConDataCons, tyConFamilySize ) -import Type ( Type, typePrimRep, isUnLiftedType, - splitAlgTyConApp_maybe ) +import TyCon ( TyCon, tyConFamilySize ) import Util ( isn'tIn ) - +import FastTypes import Outputable \end{code} @@ -62,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} %************************************************************************ @@ -79,27 +79,23 @@ ctrlReturnConvAlg tycon \begin{code} dataReturnConvPrim :: PrimRep -> MagicId -dataReturnConvPrim IntRep = VanillaReg IntRep ILIT(1) -dataReturnConvPrim WordRep = VanillaReg WordRep ILIT(1) -dataReturnConvPrim Int64Rep = LongReg Int64Rep ILIT(1) -dataReturnConvPrim Word64Rep = LongReg Word64Rep ILIT(1) -dataReturnConvPrim AddrRep = VanillaReg AddrRep ILIT(1) -dataReturnConvPrim CharRep = VanillaReg CharRep ILIT(1) -dataReturnConvPrim FloatRep = FloatReg ILIT(1) -dataReturnConvPrim DoubleRep = DoubleReg ILIT(1) +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) +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 StablePtrRep = VanillaReg StablePtrRep ILIT(1) -dataReturnConvPrim ForeignObjRep = VanillaReg ForeignObjRep ILIT(1) -dataReturnConvPrim WeakPtrRep = VanillaReg WeakPtrRep ILIT(1) - #ifdef DEBUG -dataReturnConvPrim PtrRep = panic "dataReturnConvPrim: PtrRep" -dataReturnConvPrim _ = panic "dataReturnConvPrim: other" +dataReturnConvPrim rep = pprPanic "dataReturnConvPrim:" (ppr rep) #endif \end{code} @@ -150,21 +146,26 @@ assign_reg (VoidRep:ks) acc supply = assign_reg ks (VoidReg:acc) supply -- one VoidReg is enough for everybody! -assign_reg (FloatRep:ks) acc (vanilla_rs, IBOX(f):float_rs, double_rs, long_rs) - = assign_reg ks (FloatReg f:acc) (vanilla_rs, float_rs, double_rs, long_rs) +assign_reg (FloatRep:ks) acc (vanilla_rs, f:float_rs, double_rs, long_rs) + = assign_reg ks (FloatReg (iUnbox f):acc) + (vanilla_rs, float_rs, double_rs, long_rs) -assign_reg (DoubleRep:ks) acc (vanilla_rs, float_rs, IBOX(d):double_rs, long_rs) - = assign_reg ks (DoubleReg d:acc) (vanilla_rs, float_rs, double_rs, long_rs) +assign_reg (DoubleRep:ks) acc (vanilla_rs, float_rs, d:double_rs, long_rs) + = assign_reg ks (DoubleReg (iUnbox d):acc) + (vanilla_rs, float_rs, double_rs, long_rs) -assign_reg (Word64Rep:ks) acc (vanilla_rs, float_rs, double_rs, IBOX(u):long_rs) - = assign_reg ks (LongReg Word64Rep u:acc) (vanilla_rs, float_rs, double_rs, long_rs) +assign_reg (Word64Rep:ks) acc (vanilla_rs, float_rs, double_rs, u:long_rs) + = assign_reg ks (LongReg Word64Rep (iUnbox u):acc) + (vanilla_rs, float_rs, double_rs, long_rs) -assign_reg (Int64Rep:ks) acc (vanilla_rs, float_rs, double_rs, IBOX(l):long_rs) - = assign_reg ks (LongReg Int64Rep l:acc) (vanilla_rs, float_rs, double_rs, long_rs) +assign_reg (Int64Rep:ks) acc (vanilla_rs, float_rs, double_rs, l:long_rs) + = assign_reg ks (LongReg Int64Rep (iUnbox l):acc) + (vanilla_rs, float_rs, double_rs, long_rs) -assign_reg (k:ks) acc (IBOX(v):vanilla_rs, float_rs, double_rs, long_rs) +assign_reg (k:ks) acc (v:vanilla_rs, float_rs, double_rs, long_rs) | not (isFloatingRep k || is64BitRep k) - = assign_reg ks (VanillaReg k v:acc) (vanilla_rs, float_rs, double_rs, long_rs) + = assign_reg ks (VanillaReg k (iUnbox v):acc) + (vanilla_rs, float_rs, double_rs, long_rs) -- The catch-all. It can happen because either -- (a) we've assigned all the regs so leftover_ks is [] @@ -182,17 +183,29 @@ We take these register supplies from the *real* registers, i.e. those that are guaranteed to map to machine registers. \begin{code} -vanillaRegNos, floatRegNos, doubleRegNos :: [Int] -vanillaRegNos = [1 .. mAX_Real_Vanilla_REG] -floatRegNos = [1 .. mAX_Real_Float_REG] -doubleRegNos = [1 .. mAX_Real_Double_REG] -longRegNos = [1 .. mAX_Long_REG] +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 useVanillaRegs +floatRegNos = regList useFloatRegs +doubleRegNos = regList useDoubleRegs +longRegNos = regList useLongRegs allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos :: [Int] -allVanillaRegNos = [1 .. mAX_Vanilla_REG] -allFloatRegNos = [1 .. mAX_Float_REG] -allDoubleRegNos = [1 .. mAX_Double_REG] -allLongRegNos = [1 .. mAX_Double_REG] +allVanillaRegNos = regList mAX_Vanilla_REG +allFloatRegNos = regList mAX_Float_REG +allDoubleRegNos = regList mAX_Double_REG +allLongRegNos = regList mAX_Long_REG + +regList 0 = [] +regList n = [1 .. n] type AvailRegs = ( [Int] -- available vanilla regs. , [Int] -- floats @@ -211,19 +224,19 @@ 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 :: (FAST_INT -> MagicId) -> Int{-cand-} -> Maybe Int + select :: (FastInt -> MagicId) -> Int{-cand-} -> Maybe Int -- one we've unboxed the Int, we make a MagicId -- and see if it is already in use; if not, return its number. - select mk_reg_fun cand@IBOX(i) + select mk_reg_fun cand = let - reg = mk_reg_fun i + reg = mk_reg_fun (iUnbox cand) in if reg `not_elem` regs_in_use then Just cand