ghc/compiler/codeGen/CgRetConv.lhs

   1 %
   2 % (c) The GRASP Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: CgRetConv.lhs,v 1.23 2000/07/11 16:03:37 simonmar Exp $
   5 %
   6 \section[CgRetConv]{Return conventions for the code generator}
   7
   8 The datatypes and functions here encapsulate what there is to know
   9 about return conventions.
  10
  11 \begin{code}
  12 module CgRetConv (
  13         CtrlReturnConvention(..),
  14         ctrlReturnConvAlg,
  15         dataReturnConvPrim,
  16         assignRegs, assignAllRegs
  17     ) where
  18
  19 #include "HsVersions.h"
  20
  21 import AbsCSyn          -- quite a few things
  22 import Constants        ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
  23                           mAX_Vanilla_REG, mAX_Float_REG,
  24                           mAX_Double_REG, mAX_Long_REG
  25                         )
  26 import CmdLineOpts      ( opt_UseVanillaRegs, opt_UseFloatRegs,
  27                           opt_UseDoubleRegs, opt_UseLongRegs
  28                         )
  29 import Maybes           ( catMaybes )
  30 import PrimRep          ( isFloatingRep, PrimRep(..), is64BitRep )
  31 import TyCon            ( TyCon, tyConFamilySize )
  32 import Util             ( isn'tIn )
  33
  34 import Outputable
  35 \end{code}
  36
  37 %************************************************************************
  38 %*                                                                      *
  39 \subsection[CgRetConv-possibilities]{Data types that encode possible return conventions}
  40 %*                                                                      *
  41 %************************************************************************
  42
  43 A @CtrlReturnConvention@ says how {\em control} is returned.
  44 \begin{code}
  45 data CtrlReturnConvention
  46   = VectoredReturn      Int     -- size of the vector table (family size)
  47   | UnvectoredReturn    Int     -- family size
  48 \end{code}
  49
  50 %************************************************************************
  51 %*                                                                      *
  52 \subsection[CgRetConv-algebraic]{Return conventions for algebraic datatypes}
  53 %*                                                                      *
  54 %************************************************************************
  55
  56 \begin{code}
  57 ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
  58
  59 ctrlReturnConvAlg tycon
  60   = case (tyConFamilySize tycon) of
  61       0 -> panic "ctrlRetConvAlg"
  62       size -> -- we're supposed to know...
  63         if (size > (1::Int) && size <= mAX_FAMILY_SIZE_FOR_VEC_RETURNS) then
  64             VectoredReturn size
  65         else
  66             UnvectoredReturn size
  67 \end{code}
  68
  69 %************************************************************************
  70 %*                                                                      *
  71 \subsection[CgRetConv-prim]{Return conventions for primitive datatypes}
  72 %*                                                                      *
  73 %************************************************************************
  74
  75 \begin{code}
  76 dataReturnConvPrim :: PrimRep -> MagicId
  77
  78 dataReturnConvPrim IntRep       = VanillaReg IntRep  ILIT(1)
  79 dataReturnConvPrim WordRep      = VanillaReg WordRep ILIT(1)
  80 dataReturnConvPrim Int64Rep     = LongReg Int64Rep  ILIT(1)
  81 dataReturnConvPrim Word64Rep    = LongReg Word64Rep ILIT(1)
  82 dataReturnConvPrim AddrRep      = VanillaReg AddrRep ILIT(1)
  83 dataReturnConvPrim CharRep      = VanillaReg CharRep ILIT(1)
  84 dataReturnConvPrim FloatRep     = FloatReg  ILIT(1)
  85 dataReturnConvPrim DoubleRep    = DoubleReg ILIT(1)
  86 dataReturnConvPrim VoidRep      = VoidReg
  87
  88 -- Return a primitive-array pointer in the usual register:
  89 dataReturnConvPrim ArrayRep     = VanillaReg ArrayRep ILIT(1)
  90 dataReturnConvPrim ByteArrayRep = VanillaReg ByteArrayRep ILIT(1)
  91
  92 dataReturnConvPrim StablePtrRep = VanillaReg StablePtrRep ILIT(1)
  93 dataReturnConvPrim ForeignObjRep = VanillaReg ForeignObjRep ILIT(1)
  94 dataReturnConvPrim WeakPtrRep   = VanillaReg WeakPtrRep ILIT(1)
  95
  96 #ifdef DEBUG
  97 dataReturnConvPrim PtrRep       = panic "dataReturnConvPrim: PtrRep"
  98 dataReturnConvPrim _            = panic "dataReturnConvPrim: other"
  99 #endif
 100 \end{code}
 101
 102 %************************************************************************
 103 %*                                                                      *
 104 \subsubsection[CgRetConv-regs]{Register assignment}
 105 %*                                                                      *
 106 %************************************************************************
 107
 108 How to assign registers for
 109
 110         1) Calling a fast entry point.
 111         2) Returning an unboxed tuple.
 112         3) Invoking an out-of-line PrimOp.
 113
 114 Registers are assigned in order.
 115
 116 If we run out, we don't attempt to assign any further registers (even
 117 though we might have run out of only one kind of register); we just
 118 return immediately with the left-overs specified.
 119
 120 The alternative version @assignAllRegs@ uses the complete set of
 121 registers, including those that aren't mapped to real machine
 122 registers.  This is used for calling special RTS functions and PrimOps
 123 which expect their arguments to always be in the same registers.
 124
 125 \begin{code}
 126 assignRegs, assignAllRegs
 127         :: [MagicId]    -- Unavailable registers
 128         -> [PrimRep]    -- Arg or result kinds to assign
 129         -> ([MagicId],  -- Register assignment in same order
 130                                 -- for *initial segment of* input list
 131             [PrimRep])-- leftover kinds
 132
 133 assignRegs regs_in_use kinds
 134  = assign_reg kinds [] (mkRegTbl regs_in_use)
 135
 136 assignAllRegs regs_in_use kinds
 137  = assign_reg kinds [] (mkRegTbl_allRegs regs_in_use)
 138
 139 assign_reg
 140         :: [PrimRep]              -- arg kinds being scrutinized
 141         -> [MagicId]              -- accum. regs assigned so far (reversed)
 142         -> AvailRegs              -- regs still avail: Vanilla, Float, Double, longs
 143         -> ([MagicId], [PrimRep])
 144
 145 assign_reg (VoidRep:ks) acc supply
 146         = assign_reg ks (VoidReg:acc) supply
 147         -- one VoidReg is enough for everybody!
 148
 149 assign_reg (FloatRep:ks) acc (vanilla_rs, IBOX(f):float_rs, double_rs, long_rs)
 150         = assign_reg ks (FloatReg f:acc) (vanilla_rs, float_rs, double_rs, long_rs)
 151
 152 assign_reg (DoubleRep:ks) acc (vanilla_rs, float_rs, IBOX(d):double_rs, long_rs)
 153         = assign_reg ks (DoubleReg d:acc) (vanilla_rs, float_rs, double_rs, long_rs)
 154
 155 assign_reg (Word64Rep:ks) acc (vanilla_rs, float_rs, double_rs, IBOX(u):long_rs)
 156         = assign_reg ks (LongReg Word64Rep u:acc) (vanilla_rs, float_rs, double_rs, long_rs)
 157
 158 assign_reg (Int64Rep:ks) acc (vanilla_rs, float_rs, double_rs, IBOX(l):long_rs)
 159         = assign_reg ks (LongReg Int64Rep l:acc) (vanilla_rs, float_rs, double_rs, long_rs)
 160
 161 assign_reg (k:ks) acc (IBOX(v):vanilla_rs, float_rs, double_rs, long_rs)
 162         | not (isFloatingRep k || is64BitRep k)
 163         = assign_reg ks (VanillaReg k v:acc) (vanilla_rs, float_rs, double_rs, long_rs)
 164
 165 -- The catch-all.  It can happen because either
 166 --      (a) we've assigned all the regs so leftover_ks is []
 167 --  (b) we couldn't find a spare register in the appropriate supply
 168 --  or, I suppose,
 169 --  (c) we came across a Kind we couldn't handle (this one shouldn't happen)
 170 assign_reg leftover_ks acc _ = (reverse acc, leftover_ks)
 171
 172 \end{code}
 173
 174 Register supplies.  Vanilla registers can contain pointers, Ints, Chars.
 175 Floats and doubles have separate register supplies.
 176
 177 We take these register supplies from the *real* registers, i.e. those
 178 that are guaranteed to map to machine registers.
 179
 180 \begin{code}
 181 vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: [Int]
 182 vanillaRegNos    = regList opt_UseVanillaRegs
 183 floatRegNos      = regList opt_UseFloatRegs
 184 doubleRegNos     = regList opt_UseDoubleRegs
 185 longRegNos       = regList opt_UseLongRegs
 186
 187 allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos :: [Int]
 188 allVanillaRegNos = regList mAX_Vanilla_REG
 189 allFloatRegNos   = regList mAX_Float_REG
 190 allDoubleRegNos  = regList mAX_Double_REG
 191 allLongRegNos    = regList mAX_Long_REG
 192
 193 regList 0 = []
 194 regList n = [1 .. n]
 195
 196 type AvailRegs = ( [Int]   -- available vanilla regs.
 197                  , [Int]   -- floats
 198                  , [Int]   -- doubles
 199                  , [Int]   -- longs (int64 and word64)
 200                  )
 201
 202 mkRegTbl :: [MagicId] -> AvailRegs
 203 mkRegTbl regs_in_use
 204   = mkRegTbl' regs_in_use vanillaRegNos floatRegNos doubleRegNos longRegNos
 205
 206 mkRegTbl_allRegs :: [MagicId] -> AvailRegs
 207 mkRegTbl_allRegs regs_in_use
 208   = mkRegTbl' regs_in_use allVanillaRegNos allFloatRegNos allDoubleRegNos allLongRegNos
 209
 210 mkRegTbl' regs_in_use vanillas floats doubles longs
 211   = (ok_vanilla, ok_float, ok_double, ok_long)
 212   where
 213     ok_vanilla = catMaybes (map (select (VanillaReg VoidRep))  vanillas)
 214     ok_float   = catMaybes (map (select FloatReg)              floats)
 215     ok_double  = catMaybes (map (select DoubleReg)             doubles)
 216     ok_long    = catMaybes (map (select (LongReg Int64Rep))    longs)
 217                                     -- rep isn't looked at, hence we can use any old rep.
 218
 219     select :: (FAST_INT -> MagicId) -> Int{-cand-} -> Maybe Int
 220         -- one we've unboxed the Int, we make a MagicId
 221         -- and see if it is already in use; if not, return its number.
 222
 223     select mk_reg_fun cand@IBOX(i)
 224       = let
 225             reg = mk_reg_fun i
 226         in
 227         if reg `not_elem` regs_in_use
 228         then Just cand
 229         else Nothing
 230       where
 231         not_elem = isn'tIn "mkRegTbl"
 232 \end{code}