X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FabsCSyn%2FAbsCSyn.lhs;h=edc2bc0edc594e91bf7d4d86108fb2ad72d50913;hb=70d68b088f9531ceb1ff6fa5cad1ee285f9c7187;hp=dfaf400f06882af11f06f91d294c82b2519e2bf9;hpb=74b1006ed8565ff3c39edcdaf859d606dd652641;p=ghc-hetmet.git diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs index dfaf400..edc2bc0 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.21 1999/03/11 11:32:22 simonm Exp $ +% $Id: AbsCSyn.lhs,v 1.45 2002/02/06 11:13:47 sewardj Exp $ % \section[AbstractC]{Abstract C: the last stop before machine code} @@ -17,6 +17,7 @@ raw assembler/machine code. module AbsCSyn {- ( -- export everything AbstractC(..), + C_SRT(..) CStmtMacro(..), CExprMacro(..), CAddrMode(..), @@ -39,21 +40,21 @@ module AbsCSyn {- ( import {-# SOURCE #-} ClosureInfo ( ClosureInfo ) -#if ! OMIT_NATIVE_CODEGEN -import {-# SOURCE #-} MachMisc -#endif - import CLabel import Constants ( mAX_Vanilla_REG, mAX_Float_REG, mAX_Double_REG, spRelToInt ) import CostCentre ( CostCentre, CostCentreStack ) -import Const ( mkMachInt, Literal ) +import Literal ( mkMachInt, Literal(..) ) +import ForeignCall ( CCallSpec ) import PrimRep ( PrimRep(..) ) -import PrimOp ( PrimOp ) +import MachOp ( MachOp(..) ) import Unique ( Unique ) -import StgSyn ( SRT(..) ) +import StgSyn ( StgOp ) +import TyCon ( TyCon ) import BitSet -- for liveness masks +import FastTypes +import Outputable \end{code} @AbstractC@ is a list of Abstract~C statements, but the data structure @@ -91,9 +92,9 @@ stored in a mixed type location.) -- (for the benefit of the native code generators) -- Equivalent to CJump in C land - | CReturn -- This used to be RetVecRegRel - CAddrMode -- Any base address mode - ReturnInfo -- How to get the return address from the base address + | CReturn -- Perform a return + CAddrMode -- Address of a RET_ info table + ReturnInfo -- Whether it's a direct or vectored return | CSwitch !CAddrMode [(Literal, AbstractC)] -- alternatives @@ -113,13 +114,33 @@ stored in a mixed type location.) | CInitHdr -- to initialise the header of a closure (both fixed/var parts) ClosureInfo - RegRelative -- address of the info ptr - CAddrMode -- cost centre to place in closure + CAddrMode -- address of the info ptr + !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) @@ -148,7 +169,7 @@ 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... @@ -165,20 +186,21 @@ stored in a mixed type location.) typedefs if needs be (i.e., when generating .hc code and compiling 'foreign import dynamic's) -} - | CCallTypedef PrimOp{-CCallOp-} [CAddrMode] [CAddrMode] + | CCallTypedef Bool {- True => use "typedef"; False => use "extern"-} + 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 + 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 CLabel LivenessMask -- A bitmap to be emitted if and only if + -- it is larger than a target machine word. | CClosureInfoAndCode ClosureInfo -- Explains placement and layout of closure @@ -193,9 +215,16 @@ stored in a mixed type location.) | 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 + AbstractC -- initialisation code + | CCostCentreDecl -- A cost centre *declaration* Bool -- True <=> local => full declaration -- False <=> extern; just say so @@ -207,6 +236,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-} !Int{-length-} + +needsSRT :: C_SRT -> Bool +needsSRT NoC_SRT = False +needsSRT (C_SRT _ _ _) = True \end{code} About @CMacroStmt@, etc.: notionally, they all just call some @@ -228,13 +267,19 @@ data CStmtMacro | 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 + + | REGISTER_FOREIGN_EXPORT -- register a foreign exported fun + | REGISTER_IMPORT -- register an imported module + | REGISTER_DIMPORT -- register an imported module from + -- another DLL + | GRAN_FETCH -- for GrAnSim only -- HWL | GRAN_RESCHEDULE -- for GrAnSim only -- HWL | GRAN_FETCH_AND_RESCHEDULE -- for GrAnSim only -- HWL | THREAD_CONTEXT_SWITCH -- for GrAnSim only -- HWL | GRAN_YIELD -- for GrAnSim only -- HWL - deriving Text \end{code} Heap/Stack checks. There are far too many of these. @@ -261,7 +306,6 @@ data CCheckMacro | HP_CHK_UT_ALT -- unboxed tuple return. | HP_CHK_GEN -- generic heap check - deriving Text \end{code} \item[@CCallProfCtrMacro@:] @@ -294,12 +338,11 @@ data CAddrMode -- which gives the magic location itself -- (NB: superceded by CReg) - | CReg MagicId -- To replace (CAddr MagicId 0) + -- 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. - | CTableEntry -- CVal should be generalized to allow this - CAddrMode -- Base - CAddrMode -- Offset - PrimRep -- For casting + | CReg MagicId -- To replace (CAddr MagicId 0) | CTemp !Unique !PrimRep -- Temporary locations -- ``Temporaries'' correspond to local variables in C, and registers in @@ -310,17 +353,13 @@ data CAddrMode | CCharLike CAddrMode -- The address of a static char-like closure for -- the specified character. It is guaranteed to be in - -- the range 0..255. + -- the range mIN_CHARLIKE..mAX_CHARLIKE | CIntLike CAddrMode -- The address of a static int-like closure for the -- specified small integer. It is guaranteed to be in -- the range mIN_INTLIKE..mAX_INTLIKE - | CString FAST_STRING -- The address of the null-terminated string | CLit Literal - | CLitLit FAST_STRING -- completely literal literal: just spit this String - -- into the C output - PrimRep | CJoinPoint -- This is used as the amode of a let-no-escape-bound -- variable. @@ -334,6 +373,10 @@ data CAddrMode !PrimRep -- the kind of the result CExprMacro -- the macro to generate a value [CAddrMode] -- and its arguments + + | CBytesPerWord -- Word size, in bytes, on this platform + -- required for: half-word loads (used in fishing tags + -- out of info tables), and sizeofByteArray#. \end{code} Various C macros for values which are dependent on the back-end layout. @@ -344,7 +387,8 @@ data CExprMacro = ENTRY_CODE | ARG_TAG -- stack argument tagging | GET_TAG -- get current constructor tag - deriving(Text) + | UPD_FRAME_UPDATEE + | CCS_HDR \end{code} @@ -354,6 +398,9 @@ Convenience functions: mkIntCLit :: Int -> CAddrMode mkIntCLit i = CLit (mkMachInt (toInteger i)) +mkCString :: FAST_STRING -> CAddrMode +mkCString s = CLit (MachStr s) + mkCCostCentre :: CostCentre -> CAddrMode mkCCostCentre cc = CLbl (mkCC_Label cc) DataPtrRep @@ -369,9 +416,11 @@ mkCCostCentreStack ccs = CLbl (mkCCS_Label ccs) DataPtrRep \begin{code} data RegRelative - = HpRel FAST_INT -- } - | SpRel FAST_INT -- }- offsets in StgWords - | NodeRel FAST_INT -- } + = HpRel FastInt -- } + | SpRel FastInt -- }- offsets in StgWords + | NodeRel FastInt -- } + | CIndex CAddrMode CAddrMode PrimRep -- pointer arithmetic :-) + -- CIndex a b k === (k*)a[b] data ReturnInfo = DirectReturn -- Jump directly, if possible @@ -381,22 +430,22 @@ 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} %************************************************************************ %* * -\subsection[RegRelative]{@RegRelatives@: ???} +\subsection[Liveness]{Liveness Masks} %* * %************************************************************************ @@ -404,11 +453,18 @@ 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. When we compile via C +(especially when we bootstrap via HC files), we generate identical C +code regardless of whether words are 32- or 64-bit on the target +machine, by postponing the decision of how to store each liveness +bitmap to C compilation time (or rather, C preprocessing time). + \begin{code} type LivenessMask = [BitSet] -data Liveness = LvSmall BitSet - | LvLarge CLabel +data Liveness = Liveness CLabel LivenessMask \end{code} %************************************************************************ @@ -444,13 +500,13 @@ data MagicId -- Argument and return registers | VanillaReg -- pointers, unboxed ints and chars PrimRep - FAST_INT -- its number (1 .. mAX_Vanilla_REG) + FastInt -- its number (1 .. mAX_Vanilla_REG) | FloatReg -- single-precision floating-point registers - FAST_INT -- its number (1 .. mAX_Float_REG) + FastInt -- its number (1 .. mAX_Float_REG) | DoubleReg -- double-precision floating-point registers - FAST_INT -- its number (1 .. mAX_Double_REG) + FastInt -- its number (1 .. mAX_Double_REG) -- STG registers | Sp -- Stack ptr; points to last occupied stack location. @@ -463,38 +519,43 @@ data MagicId -- no actual register | LongReg -- long int registers (64-bit, really) PrimRep -- Int64Rep or Word64Rep - FAST_INT -- its number (1 .. mAX_Long_REG) + FastInt -- its number (1 .. mAX_Long_REG) + + | 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} We need magical @Eq@ because @VanillaReg@s come in multiple flavors. \begin{code} instance Eq MagicId where - reg1 == reg2 = tag reg1 _EQ_ tag reg2 + reg1 == reg2 = tag reg1 ==# tag reg2 where - tag BaseReg = (ILIT(0) :: FAST_INT) - tag Sp = ILIT(1) - tag Su = ILIT(2) - tag SpLim = ILIT(3) - tag Hp = ILIT(4) - tag HpLim = ILIT(5) - tag CurCostCentre = ILIT(6) - tag VoidReg = ILIT(7) - - tag (VanillaReg _ i) = ILIT(8) _ADD_ i - - tag (FloatReg i) = ILIT(8) _ADD_ maxv _ADD_ i - tag (DoubleReg i) = ILIT(8) _ADD_ maxv _ADD_ maxf _ADD_ i - tag (LongReg _ i) = ILIT(8) _ADD_ maxv _ADD_ maxf _ADD_ maxd _ADD_ i - - maxv = case mAX_Vanilla_REG of { IBOX(x) -> x } - maxf = case mAX_Float_REG of { IBOX(x) -> x } - maxd = case mAX_Double_REG of { IBOX(x) -> x } + 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) + tag CurCostCentre = _ILIT(6) + tag VoidReg = _ILIT(7) + + tag (VanillaReg _ i) = _ILIT(8) +# i + + tag (FloatReg i) = _ILIT(8) +# maxv +# i + tag (DoubleReg i) = _ILIT(8) +# maxv +# maxf +# i + tag (LongReg _ i) = _ILIT(8) +# maxv +# maxf +# maxd +# i + + maxv = iUnbox mAX_Vanilla_REG + maxf = iUnbox mAX_Float_REG + maxd = iUnbox mAX_Double_REG \end{code} Returns True for any register that {\em potentially} dies across