X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FabsCSyn%2FAbsCSyn.lhs;h=3c8a470aae2f4eb2233f979ba0ff9370fe7daf2f;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=6bd34a6fb82cd55fa4167eb951ab720a627c210e;hpb=30d559930fff086ad3a8ef4162e7d748d1e96b70;p=ghc-hetmet.git diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs index 6bd34a6..3c8a470 100644 --- a/ghc/compiler/absCSyn/AbsCSyn.lhs +++ b/ghc/compiler/absCSyn/AbsCSyn.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: AbsCSyn.lhs,v 1.34 2000/10/12 13:11:46 simonmar Exp $ +% $Id: AbsCSyn.lhs,v 1.56 2003/11/17 14:47:53 simonmar Exp $ % \section[AbstractC]{Abstract C: the last stop before machine code} @@ -14,26 +14,7 @@ From @AbstractC@, one may convert to real C (for portability) or to raw assembler/machine code. \begin{code} -module AbsCSyn {- ( - -- export everything - AbstractC(..), - CStmtMacro(..), - CExprMacro(..), - CAddrMode(..), - ReturnInfo(..), - mkAbstractCs, mkAbsCStmts, mkAlgAltsCSwitch, - mkIntCLit, - mkAbsCStmtList, - mkCCostCentre, - - -- RegRelatives - RegRelative(..), - - -- registers - MagicId(..), node, infoptr, - isVolatileReg, - CostRes(Cost) - )-} where +module AbsCSyn where -- export everything #include "HsVersions.h" @@ -44,20 +25,21 @@ import Constants ( mAX_Vanilla_REG, mAX_Float_REG, mAX_Double_REG, spRelToInt ) import CostCentre ( CostCentre, CostCentreStack ) import Literal ( mkMachInt, Literal(..) ) +import ForeignCall ( CCallSpec ) import PrimRep ( PrimRep(..) ) -import PrimOp ( PrimOp, CCall ) +import MachOp ( MachOp(..) ) import Unique ( Unique ) -import StgSyn ( SRT(..) ) +import StgSyn ( StgOp ) import TyCon ( TyCon ) -import BitSet -- for liveness masks - +import Bitmap ( Bitmap, mAX_SMALL_BITMAP_SIZE ) +import SMRep ( StgWord, StgHalfWord ) +import FastTypes +import FastString \end{code} @AbstractC@ is a list of Abstract~C statements, but the data structure is tree-ish, for easier and more efficient putting-together. \begin{code} -absCNop = AbsCNop - data AbstractC = AbsCNop | AbsCStmts AbstractC AbstractC @@ -111,12 +93,32 @@ stored in a mixed type location.) | CInitHdr -- to initialise the header of a closure (both fixed/var parts) ClosureInfo CAddrMode -- address of the info ptr - CAddrMode -- cost centre to place in closure + !CAddrMode -- cost centre to place in closure -- CReg CurCostCentre or CC_HDR(R1.p{-Node-}) + Int -- size of closure, for profiling + + -- NEW CASES FOR EXPANDED PRIMOPS + + | CMachOpStmt -- Machine-level operation + CAddrMode -- result + MachOp + [CAddrMode] -- Arguments + (Maybe [MagicId]) -- list of regs which need to be preserved + -- across the primop. This is allowed to be Nothing only if + -- machOpIsDefinitelyInline returns True. And that in turn may + -- only return True if we are absolutely sure that the mach op + -- can be done inline on all platforms. + + | CSequential -- Do the nested AbstractCs sequentially. + [AbstractC] -- In particular, as far as the AbsCUtils.doSimultaneously + -- is concerned, these stmts are to be treated as atomic + -- and are not to be reordered. + + -- end of NEW CASES FOR EXPANDED PRIMOPS | COpStmt [CAddrMode] -- Results - PrimOp + StgOp [CAddrMode] -- Arguments [MagicId] -- Potentially volatile/live registers -- (to save/restore around the call/op) @@ -145,13 +147,13 @@ stored in a mixed type location.) | CRetDirect -- Direct return !Unique -- for making labels AbstractC -- return code - (CLabel,SRT) -- SRT info + C_SRT -- SRT info Liveness -- stack liveness at the return point -- see the notes about these next few; they follow below... | CMacroStmt CStmtMacro [CAddrMode] - | CCallProfCtrMacro FAST_STRING [CAddrMode] - | CCallProfCCMacro FAST_STRING [CAddrMode] + | CCallProfCtrMacro FastString [CAddrMode] + | CCallProfCCMacro FastString [CAddrMode] {- The presence of this constructor is a makeshift solution; it being used to work around a gcc-related problem of @@ -163,42 +165,45 @@ stored in a mixed type location.) compiling 'foreign import dynamic's) -} | CCallTypedef Bool {- True => use "typedef"; False => use "extern"-} - CCall [CAddrMode] [CAddrMode] + CCallSpec Unique [CAddrMode] [CAddrMode] -- *** the next three [or so...] are DATA (those above are CODE) *** | CStaticClosure - CLabel -- The (full, not base) label to use for labelling the closure. - ClosureInfo + CLabel -- The closure's label + ClosureInfo -- Todo: maybe info_lbl & closure_lbl instead? CAddrMode -- cost centre identifier to place in closure [CAddrMode] -- free vars; ptrs, then non-ptrs. | CSRT CLabel [CLabel] -- SRT declarations: basically an array of -- pointers to static closures. - | CBitmap CLabel LivenessMask -- A larger-than-32-bits bitmap. + | CBitmap Liveness -- A "large" bitmap to be emitted + + | CSRTDesc -- A "large" SRT descriptor (one that doesn't + -- fit into the half-word bitmap in the itbl). + !CLabel -- Label for this SRT descriptor + !CLabel -- Pointer to the SRT + !Int -- Offset within the SRT + !Int -- Length + !Bitmap -- Bitmap | CClosureInfoAndCode ClosureInfo -- Explains placement and layout of closure - AbstractC -- Slow entry point code - (Maybe AbstractC) - -- Fast entry point code, if any - String -- Closure description; NB we can't get this - -- from ClosureInfo, because the latter refers - -- to the *right* hand side of a defn, whereas - -- the "description" refers to *left* hand side + AbstractC -- Entry point code | CRetVector -- A labelled block of static data CLabel [CAddrMode] - (CLabel,SRT) -- SRT info + C_SRT -- SRT info Liveness -- stack liveness at the return point | CClosureTbl -- table of constructors for enumerated types TyCon -- which TyCon this table is for | CModuleInitBlock -- module initialisation block - CLabel -- label for init block + CLabel -- "plain" label for init block + CLabel -- label for init block (with ver + way info) AbstractC -- initialisation code | CCostCentreDecl -- A cost centre *declaration* @@ -212,6 +217,16 @@ stored in a mixed type location.) -- CostCentre.lhs) | CSplitMarker -- Split into separate object modules here + +-- C_SRT is what StgSyn.SRT gets translated to... +-- we add a label for the table, and expect only the 'offset/length' form + +data C_SRT = NoC_SRT + | C_SRT !CLabel !Int{-offset-} !StgHalfWord{-bitmap or escape-} + +needsSRT :: C_SRT -> Bool +needsSRT NoC_SRT = False +needsSRT (C_SRT _ _ _) = True \end{code} About @CMacroStmt@, etc.: notionally, they all just call some @@ -226,15 +241,14 @@ macros. An example is @STK_CHK@, which checks for stack-space overflow. This enumeration type lists all such macros: \begin{code} data CStmtMacro - = ARGS_CHK -- arg satisfaction check - | ARGS_CHK_LOAD_NODE -- arg check for top-level functions - | UPD_CAF -- update CAF closure with indirection + = UPD_CAF -- update CAF closure with indirection | UPD_BH_UPDATABLE -- eager backholing | UPD_BH_SINGLE_ENTRY -- more eager blackholing | PUSH_UPD_FRAME -- push update frame - | PUSH_SEQ_FRAME -- push seq frame - | UPDATE_SU_FROM_UPD_FRAME -- pull Su out of the update frame | SET_TAG -- set TagReg if it exists + -- dataToTag# primop -- *only* used in unregisterised builds. + -- (see AbsCUtils.dsCOpStmt) + | DATA_TO_TAGZH | REGISTER_FOREIGN_EXPORT -- register a foreign exported fun | REGISTER_IMPORT -- register an imported module @@ -256,11 +270,10 @@ data CCheckMacro = HP_CHK_NP -- heap/stack checks when | STK_CHK_NP -- node points to the closure | HP_STK_CHK_NP - | HP_CHK_SEQ_NP -- for 'seq' style case alternatives - | HP_CHK -- heap/stack checks when - | STK_CHK -- node doesn't point - | HP_STK_CHK + | HP_CHK_FUN -- heap/stack checks when + | STK_CHK_FUN -- node doesn't point + | HP_STK_CHK_FUN -- case alternative heap checks: | HP_CHK_NOREGS -- no registers live @@ -269,9 +282,8 @@ data CCheckMacro | HP_CHK_F1 -- FloatReg1 (only) is live | HP_CHK_D1 -- DblReg1 (only) is live | HP_CHK_L1 -- LngReg1 (only) is live - | HP_CHK_UT_ALT -- unboxed tuple return. - | HP_CHK_GEN -- generic heap check + | HP_CHK_UNBX_TUPLE -- unboxed tuple heap check \end{code} \item[@CCallProfCtrMacro@:] @@ -304,6 +316,10 @@ data CAddrMode -- which gives the magic location itself -- (NB: superceded by CReg) + -- JRS 2002-02-05: CAddr is really scummy and should be fixed. + -- The effect is that the semantics of CAddr depend on what the + -- contained RegRelative is; it is decidely non-orthogonal. + | CReg MagicId -- To replace (CAddr MagicId 0) | CTemp !Unique !PrimRep -- Temporary locations @@ -345,9 +361,10 @@ data CExprMacro = ENTRY_CODE | ARG_TAG -- stack argument tagging | GET_TAG -- get current constructor tag - | UPD_FRAME_UPDATEE | CCS_HDR - + | BYTE_ARR_CTS -- used when passing a ByteArray# to a ccall + | PTRS_ARR_CTS -- similarly for an Array# + | ForeignObj_CLOSURE_DATA -- and again for a ForeignObj# \end{code} Convenience functions: @@ -356,7 +373,10 @@ Convenience functions: mkIntCLit :: Int -> CAddrMode mkIntCLit i = CLit (mkMachInt (toInteger i)) -mkCString :: FAST_STRING -> CAddrMode +mkWordCLit :: StgWord -> CAddrMode +mkWordCLit wd = CLit (MachWord (fromIntegral wd)) + +mkCString :: FastString -> CAddrMode mkCString s = CLit (MachStr s) mkCCostCentre :: CostCentre -> CAddrMode @@ -388,16 +408,16 @@ data ReturnInfo hpRel :: VirtualHeapOffset -- virtual offset of Hp -> VirtualHeapOffset -- virtual offset of The Thing -> RegRelative -- integer offset -hpRel _IBOX(hp) _IBOX(off) = HpRel (hp _SUB_ off) +hpRel hp off = HpRel (iUnbox (hp - off)) spRel :: VirtualSpOffset -- virtual offset of Sp -> VirtualSpOffset -- virtual offset of The Thing -> RegRelative -- integer offset -spRel sp off = SpRel (case spRelToInt sp off of { _IBOX(i) -> i }) +spRel sp off = SpRel (iUnbox (spRelToInt sp off)) nodeRel :: VirtualHeapOffset -> RegRelative -nodeRel _IBOX(off) = NodeRel off +nodeRel off = NodeRel (iUnbox off) \end{code} @@ -411,11 +431,17 @@ We represent liveness bitmaps as a BitSet (whose internal representation really is a bitmap). These are pinned onto case return vectors to indicate the state of the stack for the garbage collector. +In the compiled program, liveness bitmaps that fit inside a single +word (StgWord) are stored as a single word, while larger bitmaps are +stored as a pointer to an array of words. + \begin{code} -type LivenessMask = [BitSet] +data Liveness = Liveness CLabel !Int Bitmap -data Liveness = LvSmall BitSet - | LvLarge CLabel +maybeLargeBitmap :: Liveness -> AbstractC +maybeLargeBitmap liveness@(Liveness _ size _) + | size <= mAX_SMALL_BITMAP_SIZE = AbsCNop + | otherwise = CBitmap liveness \end{code} %************************************************************************ @@ -433,9 +459,6 @@ type HeapOffset = Int -- ToDo: remove type VirtualHeapOffset = HeapOffset type VirtualSpOffset = Int - -type HpRelOffset = HeapOffset -type SpRelOffset = Int \end{code} %************************************************************************ @@ -461,7 +484,6 @@ data MagicId -- STG registers | Sp -- Stack ptr; points to last occupied stack location. - | Su -- Stack update frame pointer | SpLim -- Stack limit | Hp -- Heap ptr; points to last occupied heap location. | HpLim -- Heap limit register @@ -474,10 +496,11 @@ data MagicId | CurrentTSO -- pointer to current thread's TSO | CurrentNursery -- pointer to allocation area + | HpAlloc -- allocation count for heap check failure -node = VanillaReg PtrRep _ILIT(1) -- A convenient alias for Node -tagreg = VanillaReg WordRep _ILIT(2) -- A convenient alias for TagReg +node = VanillaReg PtrRep (_ILIT 1) -- A convenient alias for Node +tagreg = VanillaReg WordRep (_ILIT 2) -- A convenient alias for TagReg nodeReg = CReg node \end{code} @@ -490,7 +513,6 @@ instance Eq MagicId where where tag BaseReg = (_ILIT(0) :: FastInt) tag Sp = _ILIT(1) - tag Su = _ILIT(2) tag SpLim = _ILIT(3) tag Hp = _ILIT(4) tag HpLim = _ILIT(5)