ghc/compiler/codeGen/CgCallConv.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 --              CgCallConv
   4 --
   5 -- The datatypes and functions here encapsulate the
   6 -- calling and return conventions used by the code generator.
   7 --
   8 -- (c) The University of Glasgow 2004
   9 --
  10 -----------------------------------------------------------------------------
  11
  12
  13 module CgCallConv (
  14         -- Argument descriptors
  15         mkArgDescr, argDescrType,
  16
  17         -- Liveness
  18         isBigLiveness, buildContLiveness, mkRegLiveness,
  19         smallLiveness, mkLivenessCLit,
  20
  21         -- Register assignment
  22         assignCallRegs, assignReturnRegs, assignPrimOpCallRegs,
  23
  24         -- Calls
  25         constructSlowCall, slowArgs, slowCallPattern,
  26
  27         -- Returns
  28         CtrlReturnConvention(..),
  29         ctrlReturnConvAlg,
  30         dataReturnConvPrim,
  31         getSequelAmode
  32     ) where
  33
  34 #include "HsVersions.h"
  35
  36 import CgUtils          ( emitRODataLits, mkWordCLit )
  37 import CgMonad
  38
  39 import Constants        ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
  40                           mAX_Vanilla_REG, mAX_Float_REG,
  41                           mAX_Double_REG, mAX_Long_REG,
  42                           mAX_Real_Vanilla_REG, mAX_Real_Float_REG,
  43                           mAX_Real_Double_REG, mAX_Real_Long_REG,
  44                           bITMAP_BITS_SHIFT
  45                         )
  46
  47 import ClosureInfo      ( ArgDescr(..), Liveness(..) )
  48 import CgStackery       ( getSpRelOffset )
  49 import SMRep
  50 import MachOp           ( wordRep )
  51 import Cmm              ( CmmExpr(..), GlobalReg(..), CmmLit(..), CmmReg(..), node )
  52 import CmmUtils         ( mkLblExpr )
  53 import CLabel
  54 import Maybes           ( mapCatMaybes )
  55 import Id               ( Id )
  56 import Name             ( Name )
  57 import TyCon            ( TyCon, tyConFamilySize )
  58 import Bitmap           ( Bitmap, mAX_SMALL_BITMAP_SIZE,
  59                           mkBitmap, intsToReverseBitmap )
  60 import Util             ( isn'tIn, sortLe )
  61 import StaticFlags      ( opt_Unregisterised )
  62 import FastString       ( LitString )
  63 import Outputable
  64 import DATA_BITS
  65
  66
  67 -------------------------------------------------------------------------
  68 --
  69 --      Making argument descriptors
  70 --
  71 --  An argument descriptor describes the layout of args on the stack,
  72 --  both for    * GC (stack-layout) purposes, and
  73 --              * saving/restoring registers when a heap-check fails
  74 --
  75 -- Void arguments aren't important, therefore (contrast constructSlowCall)
  76 --
  77 -------------------------------------------------------------------------
  78
  79 -- bring in ARG_P, ARG_N, etc.
  80 #include "../includes/StgFun.h"
  81
  82 -------------------------
  83 argDescrType :: ArgDescr -> Int
  84 -- The "argument type" RTS field type
  85 argDescrType (ArgSpec n) = n
  86 argDescrType (ArgGen liveness)
  87   | isBigLiveness liveness = ARG_GEN_BIG
  88   | otherwise              = ARG_GEN
  89
  90
  91 mkArgDescr :: Name -> [Id] -> FCode ArgDescr
  92 mkArgDescr nm args
  93   = case stdPattern arg_reps of
  94         Just spec_id -> return (ArgSpec spec_id)
  95         Nothing      -> do { liveness <- mkLiveness nm size bitmap
  96                            ; return (ArgGen liveness) }
  97   where
  98     arg_reps = filter nonVoidArg (map idCgRep args)
  99         -- Getting rid of voids eases matching of standard patterns
 100
 101     bitmap   = mkBitmap arg_bits
 102     arg_bits = argBits arg_reps
 103     size     = length arg_bits
 104
 105 argBits :: [CgRep] -> [Bool]    -- True for non-ptr, False for ptr
 106 argBits []              = []
 107 argBits (PtrArg : args) = False : argBits args
 108 argBits (arg    : args) = take (cgRepSizeW arg) (repeat True) ++ argBits args
 109
 110 stdPattern :: [CgRep] -> Maybe Int
 111 stdPattern []          = Just ARG_NONE  -- just void args, probably
 112
 113 stdPattern [PtrArg]    = Just ARG_P
 114 stdPattern [FloatArg]  = Just ARG_F
 115 stdPattern [DoubleArg] = Just ARG_D
 116 stdPattern [LongArg]   = Just ARG_L
 117 stdPattern [NonPtrArg] = Just ARG_N
 118
 119 stdPattern [NonPtrArg,NonPtrArg] = Just ARG_NN
 120 stdPattern [NonPtrArg,PtrArg]    = Just ARG_NP
 121 stdPattern [PtrArg,NonPtrArg]    = Just ARG_PN
 122 stdPattern [PtrArg,PtrArg]       = Just ARG_PP
 123
 124 stdPattern [NonPtrArg,NonPtrArg,NonPtrArg] = Just ARG_NNN
 125 stdPattern [NonPtrArg,NonPtrArg,PtrArg]    = Just ARG_NNP
 126 stdPattern [NonPtrArg,PtrArg,NonPtrArg]    = Just ARG_NPN
 127 stdPattern [NonPtrArg,PtrArg,PtrArg]       = Just ARG_NPP
 128 stdPattern [PtrArg,NonPtrArg,NonPtrArg]    = Just ARG_PNN
 129 stdPattern [PtrArg,NonPtrArg,PtrArg]       = Just ARG_PNP
 130 stdPattern [PtrArg,PtrArg,NonPtrArg]       = Just ARG_PPN
 131 stdPattern [PtrArg,PtrArg,PtrArg]          = Just ARG_PPP
 132
 133 stdPattern [PtrArg,PtrArg,PtrArg,PtrArg]               = Just ARG_PPPP
 134 stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg]        = Just ARG_PPPPP
 135 stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPPPP
 136 stdPattern other = Nothing
 137
 138
 139 -------------------------------------------------------------------------
 140 --
 141 --      Liveness info
 142 --
 143 -------------------------------------------------------------------------
 144
 145 mkLiveness :: Name -> Int -> Bitmap -> FCode Liveness
 146 mkLiveness name size bits
 147   | size > mAX_SMALL_BITMAP_SIZE                -- Bitmap does not fit in one word
 148   = do  { let lbl = mkBitmapLabel name
 149         ; emitRODataLits lbl ( mkWordCLit (fromIntegral size)
 150                              : map mkWordCLit bits)
 151         ; return (BigLiveness lbl) }
 152
 153   | otherwise           -- Bitmap fits in one word
 154   = let
 155         small_bits = case bits of
 156                         []  -> 0
 157                         [b] -> fromIntegral b
 158                         _   -> panic "livenessToAddrMode"
 159     in
 160     return (smallLiveness size small_bits)
 161
 162 smallLiveness :: Int -> StgWord -> Liveness
 163 smallLiveness size small_bits = SmallLiveness bits
 164   where bits = fromIntegral size .|. (small_bits `shiftL` bITMAP_BITS_SHIFT)
 165
 166 -------------------
 167 isBigLiveness :: Liveness -> Bool
 168 isBigLiveness (BigLiveness _)   = True
 169 isBigLiveness (SmallLiveness _) = False
 170
 171 -------------------
 172 mkLivenessCLit :: Liveness -> CmmLit
 173 mkLivenessCLit (BigLiveness lbl)    = CmmLabel lbl
 174 mkLivenessCLit (SmallLiveness bits) = mkWordCLit bits
 175
 176
 177 -------------------------------------------------------------------------
 178 --
 179 --              Bitmap describing register liveness
 180 --              across GC when doing a "generic" heap check
 181 --              (a RET_DYN stack frame).
 182 --
 183 -- NB. Must agree with these macros (currently in StgMacros.h):
 184 -- GET_NON_PTRS(), GET_PTRS(), GET_LIVENESS().
 185 -------------------------------------------------------------------------
 186
 187 mkRegLiveness :: [(Id, GlobalReg)] -> Int -> Int -> StgWord
 188 mkRegLiveness regs ptrs nptrs
 189   = (fromIntegral nptrs `shiftL` 16) .|.
 190     (fromIntegral ptrs  `shiftL` 24) .|.
 191     all_non_ptrs `xor` reg_bits regs
 192   where
 193     all_non_ptrs = 0xff
 194
 195     reg_bits [] = 0
 196     reg_bits ((id, VanillaReg i) : regs) | isFollowableArg (idCgRep id)
 197         = (1 `shiftL` (i - 1)) .|. reg_bits regs
 198     reg_bits (_ : regs)
 199         = reg_bits regs
 200
 201 -------------------------------------------------------------------------
 202 --
 203 --              Pushing the arguments for a slow call
 204 --
 205 -------------------------------------------------------------------------
 206
 207 -- For a slow call, we must take a bunch of arguments and intersperse
 208 -- some stg_ap_<pattern>_ret_info return addresses.
 209 constructSlowCall
 210         :: [(CgRep,CmmExpr)]
 211         -> (CLabel,             -- RTS entry point for call
 212            [(CgRep,CmmExpr)],   -- args to pass to the entry point
 213            [(CgRep,CmmExpr)])   -- stuff to save on the stack
 214
 215    -- don't forget the zero case
 216 constructSlowCall []
 217   = (mkRtsApFastLabel SLIT("stg_ap_0"), [], [])
 218
 219 constructSlowCall amodes
 220   = (stg_ap_pat, these, rest)
 221   where
 222     stg_ap_pat = mkRtsApFastLabel arg_pat
 223     (arg_pat, these, rest) = matchSlowPattern amodes
 224
 225 enterRtsRetLabel arg_pat
 226   | tablesNextToCode = mkRtsRetInfoLabel arg_pat
 227   | otherwise        = mkRtsRetLabel arg_pat
 228
 229 -- | 'slowArgs' takes a list of function arguments and prepares them for
 230 -- pushing on the stack for "extra" arguments to a function which requires
 231 -- fewer arguments than we currently have.
 232 slowArgs :: [(CgRep,CmmExpr)] -> [(CgRep,CmmExpr)]
 233 slowArgs [] = []
 234 slowArgs amodes = (NonPtrArg, mkLblExpr stg_ap_pat) : args ++ slowArgs rest
 235   where (arg_pat, args, rest) = matchSlowPattern amodes
 236         stg_ap_pat = mkRtsRetInfoLabel arg_pat
 237
 238 matchSlowPattern :: [(CgRep,CmmExpr)]
 239                  -> (LitString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)])
 240 matchSlowPattern amodes = (arg_pat, these, rest)
 241   where (arg_pat, n)  = slowCallPattern (map fst amodes)
 242         (these, rest) = splitAt n amodes
 243
 244 -- These cases were found to cover about 99% of all slow calls:
 245 slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (SLIT("stg_ap_pppppp"), 6)
 246 slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _)     = (SLIT("stg_ap_ppppp"), 5)
 247 slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _)     = (SLIT("stg_ap_pppp"), 4)
 248 slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _)    = (SLIT("stg_ap_pppv"), 4)
 249 slowCallPattern (PtrArg: PtrArg: PtrArg: _)             = (SLIT("stg_ap_ppp"), 3)
 250 slowCallPattern (PtrArg: PtrArg: VoidArg: _)            = (SLIT("stg_ap_ppv"), 3)
 251 slowCallPattern (PtrArg: PtrArg: _)                     = (SLIT("stg_ap_pp"), 2)
 252 slowCallPattern (PtrArg: VoidArg: _)                    = (SLIT("stg_ap_pv"), 2)
 253 slowCallPattern (PtrArg: _)                             = (SLIT("stg_ap_p"), 1)
 254 slowCallPattern (VoidArg: _)                            = (SLIT("stg_ap_v"), 1)
 255 slowCallPattern (NonPtrArg: _)                          = (SLIT("stg_ap_n"), 1)
 256 slowCallPattern (FloatArg: _)                           = (SLIT("stg_ap_f"), 1)
 257 slowCallPattern (DoubleArg: _)                          = (SLIT("stg_ap_d"), 1)
 258 slowCallPattern (LongArg: _)                            = (SLIT("stg_ap_l"), 1)
 259 slowCallPattern _  = panic "CgStackery.slowCallPattern"
 260
 261 -------------------------------------------------------------------------
 262 --
 263 --              Return conventions
 264 --
 265 -------------------------------------------------------------------------
 266
 267 -- A @CtrlReturnConvention@ says how {\em control} is returned.
 268
 269 data CtrlReturnConvention
 270   = VectoredReturn      Int     -- size of the vector table (family size)
 271   | UnvectoredReturn    Int     -- family size
 272
 273 ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
 274 ctrlReturnConvAlg tycon
 275   = case (tyConFamilySize tycon) of
 276       size -> -- we're supposed to know...
 277         if (size > (1::Int) && size <= mAX_FAMILY_SIZE_FOR_VEC_RETURNS) then
 278             VectoredReturn size
 279         else
 280             UnvectoredReturn size
 281   -- NB: unvectored returns Include size 0 (no constructors), so that
 282   --     the following perverse code compiles (it crashed GHC in 5.02)
 283   --        data T1
 284   --        data T2 = T2 !T1 Int
 285   --     The only value of type T1 is bottom, which never returns anyway.
 286
 287 dataReturnConvPrim :: CgRep -> CmmReg
 288 dataReturnConvPrim PtrArg    = CmmGlobal (VanillaReg 1)
 289 dataReturnConvPrim NonPtrArg = CmmGlobal (VanillaReg 1)
 290 dataReturnConvPrim LongArg   = CmmGlobal (LongReg 1)
 291 dataReturnConvPrim FloatArg  = CmmGlobal (FloatReg 1)
 292 dataReturnConvPrim DoubleArg = CmmGlobal (DoubleReg 1)
 293 dataReturnConvPrim VoidArg   = panic "dataReturnConvPrim: void"
 294
 295
 296 -- getSequelAmode returns an amode which refers to an info table.  The info
 297 -- table will always be of the RET(_VEC)?_(BIG|SMALL) kind.  We're careful
 298 -- not to handle real code pointers, just in case we're compiling for
 299 -- an unregisterised/untailcallish architecture, where info pointers and
 300 -- code pointers aren't the same.
 301 -- DIRE WARNING.
 302 -- The OnStack case of sequelToAmode delivers an Amode which is only
 303 -- valid just before the final control transfer, because it assumes
 304 -- that Sp is pointing to the top word of the return address.  This
 305 -- seems unclean but there you go.
 306
 307 getSequelAmode :: FCode CmmExpr
 308 getSequelAmode
 309   = do  { EndOfBlockInfo virt_sp sequel <- getEndOfBlockInfo
 310         ; case sequel of
 311             OnStack -> do { sp_rel <- getSpRelOffset virt_sp
 312                           ; returnFC (CmmLoad sp_rel wordRep) }
 313
 314             UpdateCode             -> returnFC (CmmLit (CmmLabel mkUpdInfoLabel))
 315             CaseAlts lbl _ _ True  -> returnFC (CmmLit (CmmLabel mkSeqInfoLabel))
 316             CaseAlts lbl _ _ False -> returnFC (CmmLit (CmmLabel lbl))
 317         }
 318
 319 -------------------------------------------------------------------------
 320 --
 321 --              Build a liveness mask for the current stack
 322 --
 323 -------------------------------------------------------------------------
 324
 325 -- There are four kinds of things on the stack:
 326 --
 327 --      - pointer variables (bound in the environment)
 328 --      - non-pointer variables (boudn in the environment)
 329 --      - free slots (recorded in the stack free list)
 330 --      - non-pointer data slots (recorded in the stack free list)
 331 --
 332 -- We build up a bitmap of non-pointer slots by searching the environment
 333 -- for all the pointer variables, and subtracting these from a bitmap
 334 -- with initially all bits set (up to the size of the stack frame).
 335
 336 buildContLiveness :: Name               -- Basis for label (only)
 337                   -> [VirtualSpOffset]  -- Live stack slots
 338                   -> FCode Liveness
 339 buildContLiveness name live_slots
 340  = do   { stk_usg    <- getStkUsage
 341         ; let   StackUsage { realSp = real_sp,
 342                              frameSp = frame_sp } = stk_usg
 343
 344                 start_sp :: VirtualSpOffset
 345                 start_sp = real_sp - retAddrSizeW
 346                 -- In a continuation, we want a liveness mask that
 347                 -- starts from just after the return address, which is
 348                 -- on the stack at real_sp.
 349
 350                 frame_size :: WordOff
 351                 frame_size = start_sp - frame_sp
 352                 -- real_sp points to the frame-header for the current
 353                 -- stack frame, and the end of this frame is frame_sp.
 354                 -- The size is therefore real_sp - frame_sp - retAddrSizeW
 355                 -- (subtract one for the frame-header = return address).
 356
 357                 rel_slots :: [WordOff]
 358                 rel_slots = sortLe (<=)
 359                     [ start_sp - ofs  -- Get slots relative to top of frame
 360                     | ofs <- live_slots ]
 361
 362                 bitmap = intsToReverseBitmap frame_size rel_slots
 363
 364         ; WARN( not (all (>=0) rel_slots),
 365                 ppr name $$ ppr live_slots $$ ppr frame_size $$ ppr start_sp $$ ppr rel_slots )
 366           mkLiveness name frame_size bitmap }
 367
 368
 369 -------------------------------------------------------------------------
 370 --
 371 --              Register assignment
 372 --
 373 -------------------------------------------------------------------------
 374
 375 --  How to assign registers for
 376 --
 377 --      1) Calling a fast entry point.
 378 --      2) Returning an unboxed tuple.
 379 --      3) Invoking an out-of-line PrimOp.
 380 --
 381 -- Registers are assigned in order.
 382 --
 383 -- If we run out, we don't attempt to assign any further registers (even
 384 -- though we might have run out of only one kind of register); we just
 385 -- return immediately with the left-overs specified.
 386 --
 387 -- The alternative version @assignAllRegs@ uses the complete set of
 388 -- registers, including those that aren't mapped to real machine
 389 -- registers.  This is used for calling special RTS functions and PrimOps
 390 -- which expect their arguments to always be in the same registers.
 391
 392 assignCallRegs, assignPrimOpCallRegs, assignReturnRegs
 393         :: [(CgRep,a)]          -- Arg or result values to assign
 394         -> ([(a, GlobalReg)],   -- Register assignment in same order
 395                                 -- for *initial segment of* input list
 396                                 --   (but reversed; doesn't matter)
 397                                 -- VoidRep args do not appear here
 398             [(CgRep,a)])        -- Leftover arg or result values
 399
 400 assignCallRegs args
 401   = assign_regs args (mkRegTbl [node])
 402         -- The entry convention for a function closure
 403         -- never uses Node for argument passing; instead
 404         -- Node points to the function closure itself
 405
 406 assignPrimOpCallRegs args
 407  = assign_regs args (mkRegTbl_allRegs [])
 408         -- For primops, *all* arguments must be passed in registers
 409
 410 assignReturnRegs args
 411  = assign_regs args (mkRegTbl [])
 412         -- For returning unboxed tuples etc,
 413         -- we use all regs
 414
 415 assign_regs :: [(CgRep,a)]      -- Arg or result values to assign
 416             -> AvailRegs        -- Regs still avail: Vanilla, Float, Double, Longs
 417             -> ([(a, GlobalReg)], [(CgRep, a)])
 418 assign_regs args supply
 419   = go args [] supply
 420   where
 421     go [] acc supply = (acc, [])        -- Return the results reversed (doesn't matter)
 422     go ((VoidArg,_) : args) acc supply  -- Skip void arguments; they aren't passed, and
 423         = go args acc supply            -- there's nothign to bind them to
 424     go ((rep,arg) : args) acc supply
 425         = case assign_reg rep supply of
 426                 Just (reg, supply') -> go args ((arg,reg):acc) supply'
 427                 Nothing             -> (acc, (rep,arg):args)    -- No more regs
 428
 429 assign_reg :: CgRep -> AvailRegs -> Maybe (GlobalReg, AvailRegs)
 430 assign_reg FloatArg  (vs, f:fs, ds, ls) = Just (FloatReg f,   (vs, fs, ds, ls))
 431 assign_reg DoubleArg (vs, fs, d:ds, ls) = Just (DoubleReg d,  (vs, fs, ds, ls))
 432 assign_reg LongArg   (vs, fs, ds, l:ls) = Just (LongReg l,    (vs, fs, ds, ls))
 433 assign_reg PtrArg    (v:vs, fs, ds, ls) = Just (VanillaReg v, (vs, fs, ds, ls))
 434 assign_reg NonPtrArg (v:vs, fs, ds, ls) = Just (VanillaReg v, (vs, fs, ds, ls))
 435     -- PtrArg and NonPtrArg both go in a vanilla register
 436 assign_reg other     not_enough_regs    = Nothing
 437
 438
 439 -------------------------------------------------------------------------
 440 --
 441 --              Register supplies
 442 --
 443 -------------------------------------------------------------------------
 444
 445 -- Vanilla registers can contain pointers, Ints, Chars.
 446 -- Floats and doubles have separate register supplies.
 447 --
 448 -- We take these register supplies from the *real* registers, i.e. those
 449 -- that are guaranteed to map to machine registers.
 450
 451 useVanillaRegs | opt_Unregisterised = 0
 452                | otherwise          = mAX_Real_Vanilla_REG
 453 useFloatRegs   | opt_Unregisterised = 0
 454                | otherwise          = mAX_Real_Float_REG
 455 useDoubleRegs  | opt_Unregisterised = 0
 456                | otherwise          = mAX_Real_Double_REG
 457 useLongRegs    | opt_Unregisterised = 0
 458                | otherwise          = mAX_Real_Long_REG
 459
 460 vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: [Int]
 461 vanillaRegNos    = regList useVanillaRegs
 462 floatRegNos      = regList useFloatRegs
 463 doubleRegNos     = regList useDoubleRegs
 464 longRegNos       = regList useLongRegs
 465
 466 allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos :: [Int]
 467 allVanillaRegNos = regList mAX_Vanilla_REG
 468 allFloatRegNos   = regList mAX_Float_REG
 469 allDoubleRegNos  = regList mAX_Double_REG
 470 allLongRegNos    = regList mAX_Long_REG
 471
 472 regList 0 = []
 473 regList n = [1 .. n]
 474
 475 type AvailRegs = ( [Int]   -- available vanilla regs.
 476                  , [Int]   -- floats
 477                  , [Int]   -- doubles
 478                  , [Int]   -- longs (int64 and word64)
 479                  )
 480
 481 mkRegTbl :: [GlobalReg] -> AvailRegs
 482 mkRegTbl regs_in_use
 483   = mkRegTbl' regs_in_use vanillaRegNos floatRegNos doubleRegNos longRegNos
 484
 485 mkRegTbl_allRegs :: [GlobalReg] -> AvailRegs
 486 mkRegTbl_allRegs regs_in_use
 487   = mkRegTbl' regs_in_use allVanillaRegNos allFloatRegNos allDoubleRegNos allLongRegNos
 488
 489 mkRegTbl' regs_in_use vanillas floats doubles longs
 490   = (ok_vanilla, ok_float, ok_double, ok_long)
 491   where
 492     ok_vanilla = mapCatMaybes (select VanillaReg) vanillas
 493     ok_float   = mapCatMaybes (select FloatReg)   floats
 494     ok_double  = mapCatMaybes (select DoubleReg)  doubles
 495     ok_long    = mapCatMaybes (select LongReg)    longs
 496                                     -- rep isn't looked at, hence we can use any old rep.
 497
 498     select :: (Int -> GlobalReg) -> Int{-cand-} -> Maybe Int
 499         -- one we've unboxed the Int, we make a GlobalReg
 500         -- and see if it is already in use; if not, return its number.
 501
 502     select mk_reg_fun cand
 503       = let
 504             reg = mk_reg_fun cand
 505         in
 506         if reg `not_elem` regs_in_use
 507         then Just cand
 508         else Nothing
 509       where
 510         not_elem = isn'tIn "mkRegTbl"
 511
 512