-----------------------------------------------------------------------------
--
--- CgCallConv
+-- (c) The University of Glasgow 2004-2006
+--
+-- CgCallConv
--
-- The datatypes and functions here encapsulate the
-- calling and return conventions used by the code generator.
--
--- (c) The University of Glasgow 2004
---
-----------------------------------------------------------------------------
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
module CgCallConv (
-- Argument descriptors
mkArgDescr, argDescrType,
-- Liveness
- isBigLiveness, buildContLiveness, mkRegLiveness,
+ isBigLiveness, mkRegLiveness,
smallLiveness, mkLivenessCLit,
-- Register assignment
constructSlowCall, slowArgs, slowCallPattern,
-- Returns
- CtrlReturnConvention(..),
- ctrlReturnConvAlg,
dataReturnConvPrim,
getSequelAmode
) where
#include "HsVersions.h"
-import CgUtils ( emitRODataLits, mkWordCLit )
+import CgUtils
import CgMonad
-
-import Constants ( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
- mAX_Vanilla_REG, mAX_Float_REG,
- mAX_Double_REG, mAX_Long_REG,
- mAX_Real_Vanilla_REG, mAX_Real_Float_REG,
- mAX_Real_Double_REG, mAX_Real_Long_REG,
- bITMAP_BITS_SHIFT
- )
-
-import ClosureInfo ( ArgDescr(..), Liveness(..) )
-import CgStackery ( getSpRelOffset )
import SMRep
-import MachOp ( wordRep )
-import Cmm ( CmmExpr(..), GlobalReg(..), CmmLit(..), CmmReg(..), node )
-import CmmUtils ( mkLblExpr )
+
+import MachOp
+import Cmm
import CLabel
-import Maybes ( mapCatMaybes )
-import Id ( Id )
-import Name ( Name )
-import TyCon ( TyCon, tyConFamilySize )
-import Bitmap ( Bitmap, mAX_SMALL_BITMAP_SIZE,
- mkBitmap, intsToReverseBitmap )
-import Util ( isn'tIn, sortLe )
-import StaticFlags ( opt_Unregisterised )
-import FastString ( LitString )
+
+import Constants
+import ClosureInfo
+import CgStackery
+import CmmUtils
+import Maybes
+import Id
+import Name
+import Bitmap
+import Util
+import StaticFlags
+import FastString
import Outputable
-import DATA_BITS
+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
--
-------------------------------------------------------------------------
projects / ghc-hetmet.git / blobdiff