%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: AbsCSyn.lhs,v 1.18 1998/12/02 13:17:16 simonm Exp $
+% $Id: AbsCSyn.lhs,v 1.55 2003/07/28 16:05:30 simonmar Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
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"
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 BitSet -- for liveness masks
-
+import StgSyn ( StgOp )
+import TyCon ( TyCon )
+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
\begin{code}
| CAssign
- CAddrMode -- target
- CAddrMode -- source
+ !CAddrMode -- target
+ !CAddrMode -- source
| CJump
CAddrMode -- Put this in the program counter
-- (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_<blah> info table
+ ReturnInfo -- Whether it's a direct or vectored return
- | CSwitch CAddrMode
+ | CSwitch !CAddrMode
[(Literal, AbstractC)] -- alternatives
AbstractC -- default; if there is no real Abstract C in here
-- (e.g., all comments; see function "nonemptyAbsC"),
| 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)
AbstractC
| CRetDirect -- Direct return
- Unique -- for making labels
+ !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
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
+ 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
- (CLabel,SRT) -- SRT info
- 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 -- "plain" label for init block
+ CLabel -- label for init block (with ver + way info)
+ AbstractC -- initialisation code
+
| CCostCentreDecl -- A cost centre *declaration*
Bool -- True <=> local => full declaration
-- False <=> extern; just say so
-- 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
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
| 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
+ | 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.
= 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
| 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
- deriving Text
+ | HP_CHK_UNBX_TUPLE -- unboxed tuple heap check
\end{code}
\item[@CCallProfCtrMacro@:]
-- 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
+ | CTemp !Unique !PrimRep -- Temporary locations
-- ``Temporaries'' correspond to local variables in C, and registers in
-- native code.
| 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.
= ENTRY_CODE
| ARG_TAG -- stack argument tagging
| GET_TAG -- get current constructor tag
- deriving(Text)
-
+ | 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:
mkIntCLit :: Int -> CAddrMode
mkIntCLit i = CLit (mkMachInt (toInteger i))
+mkWordCLit :: StgWord -> CAddrMode
+mkWordCLit wd = CLit (MachWord (fromIntegral wd))
+
+mkCString :: FastString -> CAddrMode
+mkCString s = CLit (MachStr s)
+
mkCCostCentre :: CostCentre -> CAddrMode
mkCCostCentre cc = CLbl (mkCC_Label cc) 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
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}
%* *
%************************************************************************
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}
%************************************************************************
-- 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.
- | Su -- Stack update frame pointer
| SpLim -- Stack limit
| Hp -- Heap ptr; points to last occupied heap location.
| HpLim -- Heap limit register
-- 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 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