mkArgDescr, argDescrType,
-- Liveness
- isBigLiveness, buildContLiveness, mkRegLiveness,
+ isBigLiveness, mkRegLiveness,
smallLiveness, mkLivenessCLit,
-- Register assignment
constructSlowCall, slowArgs, slowCallPattern,
-- Returns
- CtrlReturnConvention(..),
- ctrlReturnConvAlg,
dataReturnConvPrim,
getSequelAmode
) where
import Maybes
import Id
import Name
-import TyCon
import Bitmap
import Util
import StaticFlags
import FastString
import Outputable
+import Unique
import Data.Bits
#include "../includes/StgFun.h"
-------------------------
-argDescrType :: ArgDescr -> Int
+argDescrType :: ArgDescr -> StgHalfWord
-- The "argument type" RTS field type
argDescrType (ArgSpec n) = n
argDescrType (ArgGen liveness)
argBits (PtrArg : args) = False : argBits args
argBits (arg : args) = take (cgRepSizeW arg) (repeat True) ++ argBits args
-stdPattern :: [CgRep] -> Maybe Int
+stdPattern :: [CgRep] -> Maybe StgHalfWord
stdPattern [] = Just ARG_NONE -- just void args, probably
stdPattern [PtrArg] = Just ARG_P
--
-------------------------------------------------------------------------
+-- TODO: This along with 'mkArgDescr' should be unified
+-- with 'CmmInfo.mkLiveness'. However that would require
+-- potentially invasive changes to the 'ClosureInfo' type.
+-- For now, 'CmmInfo.mkLiveness' handles only continuations and
+-- this one handles liveness everything else. Another distinction
+-- between these two is that 'CmmInfo.mkLiveness' information
+-- about the stack layout, and this one is information about
+-- the heap layout of PAPs.
mkLiveness :: Name -> Int -> Bitmap -> FCode Liveness
mkLiveness name size bits
| size > mAX_SMALL_BITMAP_SIZE -- Bitmap does not fit in one word
- = do { let lbl = mkBitmapLabel name
+ = do { let lbl = mkBitmapLabel (getUnique name)
; emitRODataLits lbl ( mkWordCLit (fromIntegral size)
: map mkWordCLit bits)
; return (BigLiveness lbl) }
stg_ap_pat = mkRtsApFastLabel arg_pat
(arg_pat, these, rest) = matchSlowPattern amodes
-enterRtsRetLabel arg_pat
- | tablesNextToCode = mkRtsRetInfoLabel arg_pat
- | otherwise = mkRtsRetLabel arg_pat
-
-- | 'slowArgs' takes a list of function arguments and prepares them for
-- pushing on the stack for "extra" arguments to a function which requires
-- fewer arguments than we currently have.
--
-------------------------------------------------------------------------
--- A @CtrlReturnConvention@ says how {\em control} is returned.
-
-data CtrlReturnConvention
- = VectoredReturn Int -- size of the vector table (family size)
- | UnvectoredReturn Int -- family size
-
-ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
-ctrlReturnConvAlg tycon
- = case (tyConFamilySize tycon) of
- size -> -- we're supposed to know...
- if (size > (1::Int) && size <= mAX_FAMILY_SIZE_FOR_VEC_RETURNS) then
- VectoredReturn size
- else
- 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.
-
dataReturnConvPrim :: CgRep -> CmmReg
dataReturnConvPrim PtrArg = CmmGlobal (VanillaReg 1)
dataReturnConvPrim NonPtrArg = CmmGlobal (VanillaReg 1)
-- getSequelAmode returns an amode which refers to an info table. The info
--- table will always be of the RET(_VEC)?_(BIG|SMALL) kind. We're careful
+-- table will always be of the RET_(BIG|SMALL) kind. We're careful
-- not to handle real code pointers, just in case we're compiling for
-- an unregisterised/untailcallish architecture, where info pointers and
-- code pointers aren't the same.
OnStack -> do { sp_rel <- getSpRelOffset virt_sp
; returnFC (CmmLoad sp_rel wordRep) }
- UpdateCode -> returnFC (CmmLit (CmmLabel mkUpdInfoLabel))
- CaseAlts lbl _ _ True -> returnFC (CmmLit (CmmLabel mkSeqInfoLabel))
- CaseAlts lbl _ _ False -> returnFC (CmmLit (CmmLabel lbl))
+ UpdateCode -> returnFC (CmmLit (CmmLabel mkUpdInfoLabel))
+ CaseAlts lbl _ _ -> returnFC (CmmLit (CmmLabel lbl))
}
-------------------------------------------------------------------------
--
--- Build a liveness mask for the current stack
---
--------------------------------------------------------------------------
-
--- There are four kinds of things on the stack:
---
--- - pointer variables (bound in the environment)
--- - non-pointer variables (boudn in the environment)
--- - free slots (recorded in the stack free list)
--- - non-pointer data slots (recorded in the stack free list)
---
--- We build up a bitmap of non-pointer slots by searching the environment
--- for all the pointer variables, and subtracting these from a bitmap
--- with initially all bits set (up to the size of the stack frame).
-
-buildContLiveness :: Name -- Basis for label (only)
- -> [VirtualSpOffset] -- Live stack slots
- -> FCode Liveness
-buildContLiveness name live_slots
- = do { stk_usg <- getStkUsage
- ; let StackUsage { realSp = real_sp,
- frameSp = frame_sp } = stk_usg
-
- start_sp :: VirtualSpOffset
- start_sp = real_sp - retAddrSizeW
- -- In a continuation, we want a liveness mask that
- -- starts from just after the return address, which is
- -- on the stack at real_sp.
-
- frame_size :: WordOff
- frame_size = start_sp - frame_sp
- -- real_sp points to the frame-header for the current
- -- stack frame, and the end of this frame is frame_sp.
- -- The size is therefore real_sp - frame_sp - retAddrSizeW
- -- (subtract one for the frame-header = return address).
-
- rel_slots :: [WordOff]
- rel_slots = sortLe (<=)
- [ start_sp - ofs -- Get slots relative to top of frame
- | ofs <- live_slots ]
-
- bitmap = intsToReverseBitmap frame_size rel_slots
-
- ; WARN( not (all (>=0) rel_slots),
- ppr name $$ ppr live_slots $$ ppr frame_size $$ ppr start_sp $$ ppr rel_slots )
- mkLiveness name frame_size bitmap }
-
-
--------------------------------------------------------------------------
---
-- Register assignment
--
-------------------------------------------------------------------------