X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FabsCSyn%2FAbsCSyn.lhs;h=3c8a470aae2f4eb2233f979ba0ff9370fe7daf2f;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=23e72202134c81b399a86b44f156f4ad3efb0b69;hpb=10521d8418fd3a1cf32882718b5bd28992db36fd;p=ghc-hetmet.git diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs index 23e7220..3c8a470 100644 --- a/ghc/compiler/absCSyn/AbsCSyn.lhs +++ b/ghc/compiler/absCSyn/AbsCSyn.lhs @@ -1,5 +1,7 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 +% +% $Id: AbsCSyn.lhs,v 1.56 2003/11/17 14:47:53 simonmar Exp $ % \section[AbstractC]{Abstract C: the last stop before machine code} @@ -12,98 +14,27 @@ From @AbstractC@, one may convert to real C (for portability) or to raw assembler/machine code. \begin{code} +module AbsCSyn where -- export everything + #include "HsVersions.h" -module AbsCSyn ( - -- export everything - AbstractC(..), - CStmtMacro(..), - CExprMacro(..), - CAddrMode(..), - ReturnInfo(..), - mkAbstractCs, mkAbsCStmts, mkAlgAltsCSwitch, - mkIntCLit, - mkAbsCStmtList, - mkCCostCentre, - - -- HeapOffsets, plus some convenient synonyms... - HeapOffset, - zeroOff, intOff, fixedHdrSize, totHdrSize, varHdrSize, - maxOff, addOff, subOff, intOffsetIntoGoods, - isZeroOff, possiblyEqualHeapOffset, - pprHeapOffset, - VirtualHeapOffset(..), HpRelOffset(..), - VirtualSpAOffset(..), VirtualSpBOffset(..), - SpARelOffset(..), SpBRelOffset(..), - - -- RegRelatives - RegRelative(..), - - -- registers - MagicId(..), node, infoptr, - isVolatileReg, - - -- closure info - ClosureInfo, LambdaFormInfo, UpdateFlag, SMRep, - - -- stuff from AbsCFuns and PprAbsC... - nonemptyAbsC, flattenAbsC, getAmodeKind, - mixedTypeLocn, mixedPtrLocn, -#ifdef __GLASGOW_HASKELL__ - writeRealC, -#endif - dumpRealC, - kindFromMagicId, -- UNUSED: getDestinationRegs, - amodeCanSurviveGC, - -#ifdef GRAN - CostRes(Cost), -#endif - - -- and stuff to make the interface self-sufficient - Outputable(..), NamedThing(..), - PrettyRep, ExportFlag, SrcLoc, Unique, - CSeq, PprStyle, Pretty(..), Unpretty(..), - -- blargh... - UniType, - - PrimKind(..), -- re-exported NON-ABSTRACTLY - BasicLit(..), mkMachInt, mkMachWord, -- re-exported NON-ABSTRACTLY - Id, ConTag(..), Maybe, PrimOp, SplitUniqSupply, TyCon, - CLabel, GlobalSwitch, CostCentre, - SimplifierSwitch, UniqSet(..), UniqFM, StgExpr, StgAtom - ) where - -import AbsCFuns -- used, and re-exported -import ClosureInfo -- ditto -import Costs -import PprAbsC -- ditto -import HeapOffs hiding ( hpRelToInt ) - -import AbsPrel ( PrimOp - IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp) - IF_ATTACK_PRAGMAS(COMMA pprPrimOp) - ) -import CLabelInfo -import CmdLineOpts ( GlobalSwitch(..), SimplifierSwitch ) -import BasicLit ( mkMachInt, mkMachWord, BasicLit(..) ) -import Id ( Id, ConTag(..), DataCon(..) ) -import Maybes ( Maybe ) -import Outputable -import Unpretty -- ********** NOTE ********** -import PrimKind ( PrimKind(..) ) -import CostCentre -- for CostCentre type -import StgSyn ( StgExpr, StgAtom, StgBinderInfo ) -import UniqSet ( UniqSet(..), UniqFM ) -import Unique ( Unique ) -import Util - -#ifndef DPH -import CgCompInfo ( mAX_Vanilla_REG, mAX_Float_REG, mAX_Double_REG ) -#else -import CgCompInfo ( spARelToInt, spBRelToInt ) -import DapInfo ( virtualHeapOffsetToInt ) -#endif {- Data Parallel Haskell -} +import {-# SOURCE #-} ClosureInfo ( ClosureInfo ) + +import CLabel +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 MachOp ( MachOp(..) ) +import Unique ( Unique ) +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 @@ -120,17 +51,17 @@ A note on @CAssign@: In general, the type associated with an assignment is the type of the lhs. However, when the lhs is a pointer to mixed types (e.g. SpB relative), the type of the assignment is the type of the rhs for float types, or the generic StgWord for all other types. -(In particular, a CharKind on the rhs is promoted to IntKind when +(In particular, a CharRep on the rhs is promoted to IntRep when stored in a mixed type location.) \begin{code} | CAssign - CAddrMode -- target - CAddrMode -- source + !CAddrMode -- target + !CAddrMode -- source | CJump CAddrMode -- Put this in the program counter - -- eg `CJump (CReg (VanillaReg PtrKind 1))' puts Ret1 in PC + -- eg `CJump (CReg (VanillaReg PtrRep 1))' puts Ret1 in PC -- Enter can be done by: -- CJump (CVal NodeRel zeroOff) @@ -139,12 +70,12 @@ 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 - [(BasicLit, AbstractC)] -- alternatives + | CSwitch !CAddrMode + [(Literal, AbstractC)] -- alternatives AbstractC -- default; if there is no real Abstract C in here -- (e.g., all comments; see function "nonemptyAbsC"), -- then that means the default _cannot_ occur. @@ -154,7 +85,6 @@ stored in a mixed type location.) -- CSwitch m [(tag,code)] AbsCNop == code | CCodeBlock CLabel AbstractC - -- [amode analog: CLabelledCode] -- A labelled block of code; this "statement" is not -- executed; rather, the labelled code will be hoisted -- out to the top level (out of line) & it can be @@ -162,28 +92,46 @@ 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-}) - Bool -- inplace update or allocate + 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 - Int -- Live registers (may be obtainable from volatility? ADR) [MagicId] -- Potentially volatile/live registers -- (to save/restore around the call/op) -- INVARIANT: When a PrimOp which can cause GC is used, the -- only live data is tidily on the STG stacks or in the STG -- registers (the code generator ensures this). - -- + -- -- Why this? Because if the arguments were arbitrary -- addressing modes, they might be things like (Hp+6) which -- will get utterly spongled by GC. - | CSimultaneous -- Perform simultaneously all the statements + | CSimultaneous -- Perform simultaneously all the statements AbstractC -- in the nested AbstractC. They are only -- allowed to be CAssigns, COpStmts and AbsCNops, so the -- "simultaneous" part just concerns making @@ -191,78 +139,94 @@ stored in a mixed type location.) -- For example { a := b, b := a } -- needs to go via (at least one) temporary + | CCheck -- heap or stack checks, or both. + CCheckMacro -- These might include some code to fill in tags + [CAddrMode] -- on the stack, so we can't use CMacroStmt below. + AbstractC + + | CRetDirect -- Direct return + !Unique -- for making labels + AbstractC -- return code + 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 + handling typedefs within statement blocks (or, rather, + the inability to do so.) + + The AbstractC flattener takes care of lifting out these + typedefs if needs be (i.e., when generating .hc code and + compiling 'foreign import dynamic's) + -} + | 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 - CAddrMode -- cost centre identifier to place in closure - [CAddrMode] -- free vars; ptrs, then non-ptrs - + 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 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 - CAddrMode -- Address of update code; Nothing => should never be used - -- (which is the case for all except constructors) - 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 - Int -- Liveness info; this is here because it is - -- easy to produce w/in the CgMonad; hard - -- thereafter. (WDP 95/11) - - | CRetVector -- Return vector with "holes" - -- (Nothings) for the default - CLabel -- vector-table label - [Maybe CAddrMode] - AbstractC -- (and what to put in a "hole" [when Nothing]) - - | CRetUnVector -- Direct return - CLabel -- unvector-table label - CAddrMode -- return code - - | CFlatRetVector -- A labelled block of static data - CLabel -- This is the flattened version of CRetVector + ClosureInfo -- Explains placement and layout of closure + AbstractC -- Entry point code + + | CRetVector -- A labelled block of static data + CLabel [CAddrMode] + 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 + | CCostCentreDecl -- A cost centre *declaration* + Bool -- True <=> local => full declaration + -- False <=> extern; just say so CostCentre -{-UNUSED: - | CComment -- to insert a comment into the output - FAST_STRING --} - - | CClosureUpdInfo - AbstractC -- InRegs Info Table (CClosureInfoTable) - -- ^^^^^^^^^^^^^^^^^ - -- out of date -- HWL - - | CSplitMarker -- Split into separate object modules here - -#ifdef DPH - | CNativeInfoTableAndCode - ClosureInfo -- Explains placement and layout of closure - String -- closure description - AbstractC -- We want to apply the trick outlined in the STG - -- paper of putting the info table before the normal - -- entry point to a function (well a very similar - -- trick, see nativeDap/NOTES.static). By putting the - -- abstractC here we stop the info table - -- wandering off :-) (No post mangler hacking going - -- on here Will :-) -#endif {- Data Parallel Haskell -} + | CCostCentreStackDecl -- A cost centre stack *declaration* + CostCentreStack -- this is the declaration for a + -- pre-defined singleton CCS (see + -- 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 @@ -277,32 +241,49 @@ 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_A_LOAD_NODE - | ARGS_CHK_A - | ARGS_CHK_B_LOAD_NODE - | ARGS_CHK_B - | HEAP_CHK - | STK_CHK - | UPD_CAF - | UPD_IND - | UPD_INPLACE_NOPTRS - | UPD_INPLACE_PTRS - | UPD_BH_UPDATABLE - | UPD_BH_SINGLE_ENTRY - | PUSH_STD_UPD_FRAME - | POP_STD_UPD_FRAME ---UNUSED: | PUSH_CON_UPD_FRAME - | SET_ARITY - | CHK_ARITY - | SET_TAG -#ifdef GRAN - | 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 -#endif - deriving Text + = 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 + | 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 +\end{code} + +Heap/Stack checks. There are far too many of these. +\begin{code} +data CCheckMacro + + = HP_CHK_NP -- heap/stack checks when + | STK_CHK_NP -- node points to the closure + | HP_STK_CHK_NP + + | 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_UNPT_R1 -- R1 is boxed/unlifted + | HP_CHK_UNBX_R1 -- R1 is unboxed + | HP_CHK_F1 -- FloatReg1 (only) is live + | HP_CHK_D1 -- DblReg1 (only) is live + | HP_CHK_L1 -- LngReg1 (only) is live + + | HP_CHK_UNBX_TUPLE -- unboxed tuple heap check \end{code} \item[@CCallProfCtrMacro@:] @@ -314,50 +295,15 @@ The @String@ names a macro that, if \tr{#define}d, will perform some cost-centre-profiling-related action. \end{description} -HERE ARE SOME OLD NOTES ABOUT HEAP-CHK ENTRY POINTS: - -\item[@CCallStgC@:] -Some parts of the system, {\em notably the storage manager}, are -implemented by C~routines that must know something about the internals -of the STG world, e.g., where the heap-pointer is. (The -``C-as-assembler'' documents describes this stuff in detail.) - -This is quite a tricky business, especially with ``optimised~C,'' so -we keep close tabs on these fellows. This enumeration type lists all -such ``STG~C'' routines: - -HERE ARE SOME *OLD* NOTES ABOUT HEAP-CHK ENTRY POINTS: - -Heap overflow invokes the garbage collector (of your choice :-), and -we have different entry points, to tell the GC the exact configuration -before it. -\begin{description} -\item[Branch of a boxed case:] -The @Node@ register points off to somewhere legitimate, the @TagReg@ -holds the tag, and the @RetReg@ points to the code for the -alterative which should be resumed. (ToDo: update) - -\item[Branch of an unboxed case:] -The @Node@ register points nowhere of any particular interest, a -kind-specific register (@IntReg@, @FloatReg@, etc.) holds the unboxed -value, and the @RetReg@ points to the code for the alternative -which should be resumed. (ToDo: update) - -\item[Closure entry:] -The @Node@ register points to the closure, and the @RetReg@ points -to the code to be resumed. (ToDo: update) -\end{description} - %************************************************************************ %* * \subsection[CAddrMode]{C addressing modes} %* * %************************************************************************ -Addressing modes: these have @PrimitiveKinds@ pinned on them. \begin{code} data CAddrMode - = CVal RegRelative PrimKind + = CVal RegRelative PrimRep -- On RHS of assign: Contents of Magic[n] -- On LHS of assign: location Magic[n] -- (ie at addr Magic+n) @@ -370,73 +316,41 @@ 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 - PrimKind -- For casting + | CReg MagicId -- To replace (CAddr MagicId 0) - | CTemp Unique PrimKind -- Temporary locations + | CTemp !Unique !PrimRep -- Temporary locations -- ``Temporaries'' correspond to local variables in C, and registers in -- native code. - -- OLD: The kind (that used to be there) is redundant, but it's REALLY helpful for - -- generating C declarations | CLbl CLabel -- Labels in the runtime system, etc. - -- See comment under CLabelledData about (String,Name) - PrimKind -- the kind is so we can generate accurate C decls - - | CUnVecLbl -- A choice of labels left up to the back end - CLabel -- direct - CLabel -- vectored + PrimRep -- the kind is so we can generate accurate C decls - | CCharLike CAddrMode -- The address of a static char-like closure for + | 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 BasicLit - | CLitLit FAST_STRING -- completely literal literal: just spit this String - -- into the C output - PrimKind - - | COffset HeapOffset -- A literal constant, not an offset *from* anything! - -- ToDo: this should really be CLitOffset - - | CCode AbstractC -- Some code. Used mainly for return addresses. - - | CLabelledCode CLabel AbstractC -- Almost defunct? (ToDo?) --JSM - -- Some code that must have a particular label - -- (which is jumpable to) - - | CJoinPoint -- This is used as the amode of a let-no-escape-bound variable - VirtualSpAOffset -- SpA and SpB values after any volatile free vars - VirtualSpBOffset -- of the rhs have been saved on stack. - -- Just before the code for the thing is jumped to, - -- SpA/B will be set to these values, - -- and then any stack-passed args pushed, - -- then the code for this thing will be entered - + -- specified small integer. It is guaranteed to be in + -- the range mIN_INTLIKE..mAX_INTLIKE + + | CLit Literal + + | CJoinPoint -- This is used as the amode of a let-no-escape-bound + -- variable. + VirtualSpOffset -- Sp value after any volatile free vars + -- of the rhs have been saved on stack. + -- Just before the code for the thing is jumped to, + -- Sp will be set to this value, + -- and then any stack-passed args pushed, + -- then the code for this thing will be entered | CMacroExpr - PrimKind -- the kind of the result + !PrimRep -- the kind of the result CExprMacro -- the macro to generate a value - [CAddrMode] -- and its arguments - - | CCostCentre -- If Bool is True ==> it to be printed as a String, - CostCentre -- (*not* as a C identifier or some such). - Bool -- (It's not just the double-quotes on either side; - -- spaces and other funny characters will have been - -- fiddled in the non-String variant.) - -mkCCostCentre cc - = --ASSERT(not (currentOrSubsumedCosts cc)) - --FALSE: We do put subsumedCC in static closures - CCostCentre cc False + [CAddrMode] -- and its arguments \end{code} Various C macros for values which are dependent on the back-end layout. @@ -444,18 +358,32 @@ Various C macros for values which are dependent on the back-end layout. \begin{code} data CExprMacro - = INFO_PTR - | ENTRY_CODE - | INFO_TAG - | EVAL_TAG - deriving(Text) - + = ENTRY_CODE + | ARG_TAG -- stack argument tagging + | GET_TAG -- get current constructor tag + | 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} -A tiny convenience: +Convenience functions: + \begin{code} 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 + +mkCCostCentreStack :: CostCentreStack -> CAddrMode +mkCCostCentreStack ccs = CLbl (mkCCS_Label ccs) DataPtrRep \end{code} %************************************************************************ @@ -466,227 +394,147 @@ mkIntCLit i = CLit (mkMachInt (toInteger i)) \begin{code} data RegRelative - = HpRel VirtualHeapOffset -- virtual offset of Hp - VirtualHeapOffset -- virtual offset of The Thing - | SpARel VirtualSpAOffset -- virtual offset of SpA - VirtualSpAOffset -- virtual offset of The Thing - | SpBRel VirtualSpBOffset -- virtual offset of SpB - VirtualSpBOffset -- virtual offset of The Thing - | NodeRel VirtualHeapOffset + = 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 | StaticVectoredReturn Int -- Fixed tag, starting at zero | DynamicVectoredReturn CAddrMode -- Dynamic tag given by amode, starting at zero +hpRel :: VirtualHeapOffset -- virtual offset of Hp + -> VirtualHeapOffset -- virtual offset of The Thing + -> RegRelative -- integer offset +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 (iUnbox (spRelToInt sp off)) + +nodeRel :: VirtualHeapOffset + -> RegRelative +nodeRel off = NodeRel (iUnbox off) + \end{code} %************************************************************************ %* * -\subsection[MagicId]{@MagicIds@: registers and such} +\subsection[Liveness]{Liveness Masks} %* * %************************************************************************ -Much of what happens in Abstract-C is in terms of ``magic'' locations, -such as the stack pointer, heap pointer, etc. If possible, these will -be held in registers. - -Here are some notes about what's active when: -\begin{description} -\item[Always active:] - Hp, HpLim, SpA, SpB, SuA, SuB - -\item[Entry set:] - ArgPtr1 (= Node)... +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. -\item[Return set:] -Ptr regs: RetPtr1 (= Node), RetPtr2... -Int/char regs: RetData1 (= TagReg = IntReg), RetData2... -Float regs: RetFloat1, ... -Double regs: RetDouble1, ... -\end{description} +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} -data MagicId - = BaseReg -- mentioned only in nativeGen - - | StkOReg -- mentioned only in nativeGen - - -- Argument and return registers - | VanillaReg -- pointers, unboxed ints and chars - PrimKind -- PtrKind, IntKind, CharKind, StablePtrKind or MallocPtrKind - -- (in case we need to distinguish) - FAST_INT -- its number (1 .. mAX_Vanilla_REG) +data Liveness = Liveness CLabel !Int Bitmap - | FloatReg -- single-precision floating-point registers - FAST_INT -- its number (1 .. mAX_Float_REG) +maybeLargeBitmap :: Liveness -> AbstractC +maybeLargeBitmap liveness@(Liveness _ size _) + | size <= mAX_SMALL_BITMAP_SIZE = AbsCNop + | otherwise = CBitmap liveness +\end{code} - | DoubleReg -- double-precision floating-point registers - FAST_INT -- its number (1 .. mAX_Double_REG) +%************************************************************************ +%* * +\subsection[HeapOffset]{@Heap Offsets@} +%* * +%************************************************************************ - | TagReg -- to return constructor tags; as almost all returns are vectored, - -- this is rarely used. +This used to be a grotesquely complicated datatype in an attempt to +hide the details of header sizes from the compiler itself. Now these +constants are imported from the RTS, and we deal in real Ints. - | RetReg -- topmost return address from the B stack +\begin{code} +type HeapOffset = Int -- ToDo: remove - | SpA -- Stack ptr; points to last occupied stack location. - -- Stack grows downward. - | SuA -- mentioned only in nativeGen +type VirtualHeapOffset = HeapOffset +type VirtualSpOffset = Int +\end{code} - | SpB -- Basic values, return addresses and update frames. - -- Grows upward. - | SuB -- mentioned only in nativeGen +%************************************************************************ +%* * +\subsection[MagicId]{@MagicIds@: registers and such} +%* * +%************************************************************************ - | Hp -- Heap ptr; points to last occupied heap location. - -- Free space at lower addresses. +\begin{code} +data MagicId + = BaseReg -- mentioned only in nativeGen - | HpLim -- Heap limit register: mentioned only in nativeGen + -- Argument and return registers + | VanillaReg -- pointers, unboxed ints and chars + PrimRep + FastInt -- its number (1 .. mAX_Vanilla_REG) - | LivenessReg -- (parallel only) used when we need to record explicitly - -- what registers are live + | FloatReg -- single-precision floating-point registers + FastInt -- its number (1 .. mAX_Float_REG) - | ActivityReg -- mentioned only in nativeGen (UNUSED) - | StdUpdRetVecReg -- mentioned only in nativeGen - | StkStubReg -- register holding STK_STUB_closure (for stubbing dead stack slots) + | DoubleReg -- double-precision floating-point registers + FastInt -- its number (1 .. mAX_Double_REG) - | CurCostCentre -- current cost centre register. + -- STG registers + | Sp -- Stack ptr; points to last occupied stack location. + | SpLim -- Stack limit + | Hp -- Heap ptr; points to last occupied heap location. + | HpLim -- Heap limit register + | CurCostCentre -- current cost centre register. + | VoidReg -- see "VoidPrim" type; just a placeholder; + -- no actual register + | LongReg -- long int registers (64-bit, really) + PrimRep -- Int64Rep or Word64Rep + FastInt -- its number (1 .. mAX_Long_REG) - | VoidReg -- see "VoidPrim" type; just a placeholder; no actual register + | CurrentTSO -- pointer to current thread's TSO + | CurrentNursery -- pointer to allocation area + | HpAlloc -- allocation count for heap check failure -#ifdef DPH --- In DPH we use: --- (VanillaReg X) for pointers, ints, chars floats --- (DataReg X) for ints chars or floats --- (DoubleReg X) first 32 bits of double in register X, second 32 in --- register X+1; DoubleReg is a synonymn for --- DataReg X; DataReg X+1 - | DataReg - PrimKind - Int -#endif {- Data Parallel Haskell -} +node = VanillaReg PtrRep (_ILIT 1) -- A convenient alias for Node +tagreg = VanillaReg WordRep (_ILIT 2) -- A convenient alias for TagReg -node = VanillaReg PtrKind ILIT(1) -- A convenient alias for Node -infoptr = VanillaReg DataPtrKind ILIT(2) -- An alias for InfoPtr +nodeReg = CReg node \end{code} We need magical @Eq@ because @VanillaReg@s come in multiple flavors. \begin{code} instance Eq MagicId where -#ifdef DPH - (FloatReg f1) == (FloatReg f2) = f1 == f2 - (DoubleReg d1) == (DoubleReg d2) = d1 == d2 - (DataReg _ d1) == (DataReg _ d2) = d1 == d2 -#endif {- Data Parallel Haskell -} - reg1 == reg2 = tagOf_MagicId reg1 _EQ_ tagOf_MagicId reg2 - -tagOf_MagicId BaseReg = (ILIT(0) :: FAST_INT) -tagOf_MagicId StkOReg = ILIT(1) -tagOf_MagicId TagReg = ILIT(2) -tagOf_MagicId RetReg = ILIT(3) -tagOf_MagicId SpA = ILIT(4) -tagOf_MagicId SuA = ILIT(5) -tagOf_MagicId SpB = ILIT(6) -tagOf_MagicId SuB = ILIT(7) -tagOf_MagicId Hp = ILIT(8) -tagOf_MagicId HpLim = ILIT(9) -tagOf_MagicId LivenessReg = ILIT(10) ---tagOf_MagicId ActivityReg = ILIT(11) -- UNUSED -tagOf_MagicId StdUpdRetVecReg = ILIT(12) -tagOf_MagicId StkStubReg = ILIT(13) -tagOf_MagicId CurCostCentre = ILIT(14) -tagOf_MagicId VoidReg = ILIT(15) - -tagOf_MagicId (VanillaReg _ i) = ILIT(15) _ADD_ i - -#ifndef DPH -tagOf_MagicId (FloatReg i) = ILIT(15) _ADD_ maxv _ADD_ i - where - maxv = case mAX_Vanilla_REG of { IBOX(x) -> x } - -tagOf_MagicId (DoubleReg i) = ILIT(15) _ADD_ maxv _ADD_ maxf _ADD_ i - where - maxv = case mAX_Vanilla_REG of { IBOX(x) -> x } - maxf = case mAX_Float_REG of { IBOX(x) -> x } - -#else -tagOf_MagicId (DoubleReg i) = ILIT(1066) _ADD_ i -- Hacky, but we want disjoint -tagOf_MagicId (DataReg _ IBOX(i)) = ILIT(1066) _ADD_ i -- range with Vanillas -#endif {- Data Parallel Haskell -} + reg1 == reg2 = tag reg1 ==# tag reg2 + where + 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 C calls (or anything near equivalent). We just say @True@ and let the (machine-specific) registering macros sort things out... -\begin{code} -isVolatileReg :: MagicId -> Bool - -isVolatileReg any = True ---isVolatileReg (FloatReg _) = True ---isVolatileReg (DoubleReg _) = True -\end{code} - -%************************************************************************ -%* * -\subsection[AbsCSyn-printing]{Pretty-printing Abstract~C} -%* * -%************************************************************************ - -It's in \tr{PprAbsC.lhs}. - -%************************************************************************ -%* * -\subsection[EqInstances]{Eq instance for RegRelative & CAddrMode} -%* * -%************************************************************************ - -DPH requires CAddrMode to be in class Eq for its register allocation -algorithm. The code for equality is rather conservative --- it doesnt -matter if two things are determined to be not equal (even if they really are, -i.e with CVal's), we just generate less efficient code. - -NOTE(07/04/93) It does matter, its doing really bad with the reg relative - stuff. \begin{code} -#ifdef DPH -instance Eq CAddrMode where - (CVal r _) == (CVal r' _) = r `eqRRel` r' - (CAddr r) == (CAddr r') = r `eqRRel` r' - (CReg reg) == (CReg reg') = reg == reg' - (CTemp u _) == (CTemp u' _) = u == u' - (CLbl l _) == (CLbl l' _) = l == l' - (CUnVecLbl d v) == (CUnVecLbl d' v') = d == d' && v == v' - (CCharLike c) == (CCharLike c') = c == c' - (CIntLike c) == (CIntLike c') = c == c' - (CString str) == (CString str') = str == str' - (CLit lit) == (CLit lit') = lit == lit' - (COffset off) == (COffset off') = possiblyEqualHeapOffset off off' - (CCode _) == (CCode _) = panic "(==) Code in CAddrMode" - (CLabelledCode _ _) == (CLabelledCode _ _)= panic "(==) LabCode in CAddrMode" - _ == _ = False - - -eqRRel :: RegRelative -> RegRelative -> Bool -eqRRel (NodeRel x) (NodeRel y) - = virtualHeapOffsetToInt x == virtualHeapOffsetToInt y - -eqRRel l@(SpARel _ _) r@(SpARel _ _) - = spARelToInt l == spARelToInt r - -eqRRel l@(SpBRel _ _) r@(SpBRel _ _) - = spBRelToInt l == spBRelToInt r - -eqRRel (HpRel hp off) (HpRel hp' off') - = (virtualHeapOffsetToInt (hp `subOff` off)) == - (virtualHeapOffsetToInt (hp' `subOff` off')) - -eqRRel _ _ = False - -eqRetInfo:: ReturnInfo -> ReturnInfo -> Bool -eqRetInfo DirectReturn DirectReturn = True -eqRetInfo (StaticVectoredReturn x) (StaticVectoredReturn x') = x == x' -eqRetInfo _ _ = False -#endif {- Data Parallel Haskell -} +isVolatileReg :: MagicId -> Bool +isVolatileReg any = True \end{code}