ghc/compiler/codeGen/CgRetConv.lhs

   1 %
   2 % (c) The GRASP Project, Glasgow University, 1992-1995
   3 %
   4 \section[CgRetConv]{Return conventions for the code generator}
   5
   6 The datatypes and functions here encapsulate what there is to know
   7 about return conventions.
   8
   9 \begin{code}
  10 module CgRetConv (
  11         CtrlReturnConvention(..), DataReturnConvention(..),
  12
  13         ctrlReturnConvAlg,
  14         dataReturnConvAlg,
  15
  16         dataReturnConvPrim,
  17
  18         assignPrimOpResultRegs,
  19         makePrimOpArgsRobust,
  20         assignRegs
  21     ) where
  22
  23 #include "HsVersions.h"
  24
  25 import AbsCSyn          -- quite a few things
  26 import AbsCUtils        ( mkAbstractCs, getAmodeRep,
  27                           amodeCanSurviveGC
  28                         )
  29 import Constants        ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
  30                           mAX_Vanilla_REG, mAX_Float_REG,
  31                           mAX_Double_REG
  32                         )
  33 import CmdLineOpts      ( opt_ReturnInRegsThreshold )
  34 import Id               ( isDataCon, dataConRawArgTys,
  35                           DataCon, GenId{-instance Eq-},
  36                           Id
  37                         )
  38 import Maybes           ( catMaybes )
  39 import PprType          ( TyCon{-instance Outputable-} )
  40 import PrimOp           ( primOpCanTriggerGC,
  41                           getPrimOpResultInfo, PrimOpResultInfo(..),
  42                           PrimOp{-instance Outputable-}
  43                         )
  44 import PrimRep          ( isFloatingRep, PrimRep(..) )
  45 import TyCon            ( tyConDataCons, tyConFamilySize )
  46 import Type             ( typePrimRep )
  47 import Util             ( zipWithEqual, mapAccumL, isn'tIn )
  48 import Outputable
  49 \end{code}
  50
  51 %************************************************************************
  52 %*                                                                      *
  53 \subsection[CgRetConv-possibilities]{Data types that encode possible return conventions}
  54 %*                                                                      *
  55 %************************************************************************
  56
  57 A @CtrlReturnConvention@ says how {\em control} is returned.
  58 \begin{code}
  59 data CtrlReturnConvention
  60   = VectoredReturn      Int     -- size of the vector table (family size)
  61   | UnvectoredReturn    Int     -- family size
  62 \end{code}
  63
  64 A @DataReturnConvention@ says how the data for a particular
  65 data-constructor is returned.
  66 \begin{code}
  67 data DataReturnConvention
  68   = ReturnInHeap
  69   | ReturnInRegs        [MagicId]
  70 \end{code}
  71 The register assignment given by a @ReturnInRegs@ obeys three rules:
  72 \begin{itemize}
  73 \item   R1 is dead.
  74 \item   R2 points to the info table for the phantom constructor
  75 \item   The list of @MagicId@ is in the same order as the arguments
  76         to the constructor.
  77 \end{itemize}
  78
  79
  80 %************************************************************************
  81 %*                                                                      *
  82 \subsection[CgRetConv-algebraic]{Return conventions for algebraic datatypes}
  83 %*                                                                      *
  84 %************************************************************************
  85
  86 \begin{code}
  87 ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
  88
  89 ctrlReturnConvAlg tycon
  90   = case (tyConFamilySize tycon) of
  91       0 -> pprTrace "ctrlReturnConvAlg:" (ppr tycon) $
  92            UnvectoredReturn 0 -- e.g., w/ "data Bin"
  93
  94       size -> -- we're supposed to know...
  95         if (size > (1::Int) && size <= mAX_FAMILY_SIZE_FOR_VEC_RETURNS) then
  96             VectoredReturn size
  97         else
  98             UnvectoredReturn size
  99 \end{code}
 100
 101 @dataReturnConvAlg@ determines the return conventions from the
 102 (possibly specialised) data constructor.
 103
 104 (See also @getDataConReturnConv@ (in @Id@).)  We grab the types
 105 of the data constructor's arguments.  We feed them and a list of
 106 available registers into @assign_reg@, which sequentially assigns
 107 registers of the appropriate types to the arguments, based on the
 108 types.  If @assign_reg@ runs out of a particular kind of register,
 109 then it gives up, returning @ReturnInHeap@.
 110
 111 \begin{code}
 112 dataReturnConvAlg :: DataCon -> DataReturnConvention
 113
 114 dataReturnConvAlg data_con
 115   = ASSERT2(isDataCon data_con, (ppr data_con))
 116     case leftover_kinds of
 117         []    ->        ReturnInRegs reg_assignment
 118         other ->        ReturnInHeap    -- Didn't fit in registers
 119   where
 120     arg_tys = dataConRawArgTys data_con
 121
 122     (reg_assignment, leftover_kinds)
 123       = assignRegs [node, infoptr] -- taken...
 124                    (map typePrimRep arg_tys)
 125 \end{code}
 126
 127 %************************************************************************
 128 %*                                                                      *
 129 \subsection[CgRetConv-prim]{Return conventions for primitive datatypes}
 130 %*                                                                      *
 131 %************************************************************************
 132
 133 WARNING! If you add a return convention which can return a pointer,
 134 make sure you alter CgCase (cgPrimDefault) to generate the right sort
 135 of heap check!
 136 \begin{code}
 137 dataReturnConvPrim :: PrimRep -> MagicId
 138
 139 dataReturnConvPrim IntRep       = VanillaReg IntRep  ILIT(1)
 140 dataReturnConvPrim WordRep      = VanillaReg WordRep ILIT(1)
 141 dataReturnConvPrim AddrRep      = VanillaReg AddrRep ILIT(1)
 142 dataReturnConvPrim CharRep      = VanillaReg CharRep ILIT(1)
 143 dataReturnConvPrim FloatRep     = FloatReg  ILIT(1)
 144 dataReturnConvPrim DoubleRep    = DoubleReg ILIT(1)
 145 dataReturnConvPrim VoidRep      = VoidReg
 146
 147 -- Return a primitive-array pointer in the usual register:
 148 dataReturnConvPrim ArrayRep     = VanillaReg ArrayRep ILIT(1)
 149 dataReturnConvPrim ByteArrayRep = VanillaReg ByteArrayRep ILIT(1)
 150
 151 dataReturnConvPrim StablePtrRep = VanillaReg StablePtrRep ILIT(1)
 152 dataReturnConvPrim ForeignObjRep = VanillaReg ForeignObjRep ILIT(1)
 153
 154 #ifdef DEBUG
 155 dataReturnConvPrim PtrRep       = panic "dataReturnConvPrim: PtrRep"
 156 dataReturnConvPrim _            = panic "dataReturnConvPrim: other"
 157 #endif
 158 \end{code}
 159
 160 %********************************************************
 161 %*                                                      *
 162 \subsection[primop-stuff]{Argument and return conventions for Prim Ops}
 163 %*                                                      *
 164 %********************************************************
 165
 166 \begin{code}
 167 assignPrimOpResultRegs
 168     :: PrimOp           -- The constructors in canonical order
 169     -> [MagicId]        -- The return regs all concatenated to together,
 170                         -- (*including* one for the tag if necy)
 171
 172 assignPrimOpResultRegs op
 173  = case (getPrimOpResultInfo op) of
 174
 175         ReturnsPrim kind -> [dataReturnConvPrim kind]
 176
 177         ReturnsAlg tycon
 178           -> let
 179                 cons        = tyConDataCons tycon
 180                 result_regs = concat (map get_return_regs cons)
 181              in
 182              -- As R1 is dead, it can hold the tag if necessary
 183              case cons of
 184                 [_]   -> result_regs
 185                 other -> (VanillaReg IntRep ILIT(1)) : result_regs
 186   where
 187     get_return_regs con
 188       = case (dataReturnConvAlg con) of
 189           ReturnInRegs regs -> regs
 190           ReturnInHeap      -> panic "getPrimOpAlgResultRegs"
 191 \end{code}
 192
 193 @assignPrimOpArgsRobust@ is used only for primitive ops which may
 194 trigger GC. [MAYBE (WDP 94/05)] For these, we pass all (nonRobust)
 195 arguments in registers.  This function assigns them and tells us which
 196 of those registers are now live (because we've shoved a followable
 197 argument into it).
 198
 199 Bug: it is assumed that robust amodes cannot contain pointers.  This
 200 seems reasonable but isn't true.  For example, \tr{Array#}'s
 201 \tr{ForeignObj#}'s are pointers.  (This is only known to bite on
 202 \tr{_ccall_GC_} with a ForeignObj argument.)
 203
 204 See after for some ADR comments...
 205
 206 \begin{code}
 207 makePrimOpArgsRobust
 208         :: PrimOp
 209         -> [CAddrMode]          -- Arguments
 210         -> ([CAddrMode],        -- Arg registers
 211             Int,                -- Liveness mask
 212             AbstractC)          -- Simultaneous assignments to assign args to regs
 213
 214 makePrimOpArgsRobust op arg_amodes
 215   = ASSERT (primOpCanTriggerGC op)
 216     let
 217         non_robust_amodes = filter (not . amodeCanSurviveGC) arg_amodes
 218         arg_kinds = map getAmodeRep non_robust_amodes
 219
 220         (arg_regs, extra_args)
 221           = assignRegs [{-nothing live-}] arg_kinds
 222
 223                 -- Check that all the args fit before returning arg_regs
 224         final_arg_regs = case extra_args of
 225                            []    -> arg_regs
 226                            other -> pprPanic "Cannot allocate enough registers for primop (try rearranging code or reducing number of arguments?)" (ppr op)
 227
 228         arg_assts
 229           = mkAbstractCs (zipWithEqual "assign_to_reg" assign_to_reg final_arg_regs non_robust_amodes)
 230
 231         assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
 232
 233         safe_arg regs arg
 234                 | amodeCanSurviveGC arg = (regs, arg)
 235                 | otherwise             = (tail regs, CReg (head regs))
 236         safe_amodes = snd (mapAccumL safe_arg final_arg_regs arg_amodes)
 237
 238         liveness_mask = mkLiveRegsMask final_arg_regs
 239     in
 240     (safe_amodes, liveness_mask, arg_assts)
 241 \end{code}
 242
 243 %************************************************************************
 244 %*                                                                      *
 245 \subsubsection[CgRetConv-regs]{Register assignment}
 246 %*                                                                      *
 247 %************************************************************************
 248
 249 How to assign registers.
 250 Registers are assigned in order.
 251
 252 If we run out, we don't attempt to assign
 253 any further registers (even though we might have run out of only one kind of
 254 register); we just return immediately with the left-overs specified.
 255
 256 \begin{code}
 257 assignRegs  :: [MagicId]        -- Unavailable registers
 258             -> [PrimRep]        -- Arg or result kinds to assign
 259             -> ([MagicId],      -- Register assignment in same order
 260                                 -- for *initial segment of* input list
 261                 [PrimRep])-- leftover kinds
 262
 263 assignRegs regs_in_use kinds
 264  = assign_reg kinds [] (mkRegTbl regs_in_use)
 265  where
 266
 267     assign_reg  :: [PrimRep]  -- arg kinds being scrutinized
 268                 -> [MagicId]        -- accum. regs assigned so far (reversed)
 269                 -> ([Int], [Int], [Int])
 270                         -- regs still avail: Vanilla, Float, Double
 271                 -> ([MagicId], [PrimRep])
 272
 273     assign_reg (VoidRep:ks) acc supply
 274         = assign_reg ks (VoidReg:acc) supply -- one VoidReg is enough for everybody!
 275
 276     assign_reg (FloatRep:ks) acc (vanilla_rs, IBOX(f):float_rs, double_rs)
 277         = assign_reg ks (FloatReg f:acc) (vanilla_rs, float_rs, double_rs)
 278
 279     assign_reg (DoubleRep:ks) acc (vanilla_rs, float_rs, IBOX(d):double_rs)
 280         = assign_reg ks (DoubleReg d:acc) (vanilla_rs, float_rs, double_rs)
 281
 282     assign_reg (k:ks) acc (IBOX(v):vanilla_rs, float_rs, double_rs)
 283         | not (isFloatingRep k)
 284         = assign_reg ks (VanillaReg k v:acc) (vanilla_rs, float_rs, double_rs)
 285
 286     -- The catch-all.  It can happen because either
 287     --  (a) we've assigned all the regs so leftover_ks is []
 288     --  (b) we couldn't find a spare register in the appropriate supply
 289     --  or, I suppose,
 290     --  (c) we came across a Kind we couldn't handle (this one shouldn't happen)
 291     assign_reg leftover_ks acc _ = (reverse acc, leftover_ks)
 292 \end{code}
 293
 294 Register supplies.  Vanilla registers can contain pointers, Ints, Chars.
 295
 296 \begin{code}
 297 vanillaRegNos :: [Int]
 298 vanillaRegNos   = [1 .. mAX_Vanilla_REG]
 299 \end{code}
 300
 301 Floats and doubles have separate register supplies.
 302
 303 \begin{code}
 304 floatRegNos, doubleRegNos :: [Int]
 305 floatRegNos     = [1 .. mAX_Float_REG]
 306 doubleRegNos    = [1 .. mAX_Double_REG]
 307
 308 mkRegTbl :: [MagicId] -> ([Int], [Int], [Int])
 309
 310 mkRegTbl regs_in_use
 311   = (ok_vanilla, ok_float, ok_double)
 312   where
 313     ok_vanilla = catMaybes (map (select (VanillaReg VoidRep)) (taker vanillaRegNos))
 314     ok_float   = catMaybes (map (select FloatReg)              floatRegNos)
 315     ok_double  = catMaybes (map (select DoubleReg)             doubleRegNos)
 316
 317     taker :: [Int] -> [Int]
 318     taker rs
 319       = case (opt_ReturnInRegsThreshold) of
 320           Nothing -> rs -- no flag set; use all of them
 321           Just  n -> take n rs
 322
 323     select :: (FAST_INT -> MagicId) -> Int{-cand-} -> Maybe Int
 324         -- one we've unboxed the Int, we make a MagicId
 325         -- and see if it is already in use; if not, return its number.
 326
 327     select mk_reg_fun cand@IBOX(i)
 328       = let
 329             reg = mk_reg_fun i
 330         in
 331         if reg `not_elem` regs_in_use
 332         then Just cand
 333         else Nothing
 334       where
 335         not_elem = isn'tIn "mkRegTbl"
 336 \end{code}