%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[AbstractC]{Abstract C: the last stop before machine code}
\begin{code}
#include "HsVersions.h"
-module AbsCSyn (
+module AbsCSyn {- (
-- export everything
AbstractC(..),
CStmtMacro(..),
CAddrMode(..),
ReturnInfo(..),
mkAbstractCs, mkAbsCStmts, mkAlgAltsCSwitch,
- mkIntCLit,
+ 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,
+ isVolatileReg, noLiveRegsMask, mkLiveRegsMask,
+ CostRes(Cost)
+ )-} where
- -- stuff from AbsCFuns and PprAbsC...
- nonemptyAbsC, flattenAbsC, getAmodeKind,
- mixedTypeLocn, mixedPtrLocn,
-#ifdef __GLASGOW_HASKELL__
- writeRealC,
-#endif
- dumpRealC,
- kindFromMagicId, -- UNUSED: getDestinationRegs,
- amodeCanSurviveGC,
-
-#ifdef GRAN
- CostRes(Cost),
+IMP_Ubiq(){-uitous-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
+IMPORT_DELOOPER(AbsCLoop)
+#else
+# if ! OMIT_NATIVE_CODEGEN
+import {-# SOURCE #-} MachMisc
+# endif
+import {-# SOURCE #-} ClosureInfo ( ClosureInfo )
+import {-# SOURCE #-} CLabel ( CLabel )
#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 Constants ( mAX_Vanilla_REG, mAX_Float_REG,
+ mAX_Double_REG, lIVENESS_R1, lIVENESS_R2,
+ lIVENESS_R3, lIVENESS_R4, lIVENESS_R5,
+ lIVENESS_R6, lIVENESS_R7, lIVENESS_R8
)
-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 HeapOffs ( SYN_IE(VirtualSpAOffset), SYN_IE(VirtualSpBOffset),
+ SYN_IE(VirtualHeapOffset), HeapOffset
+ )
+import CostCentre ( CostCentre )
+import Literal ( mkMachInt, Literal )
+import PrimRep ( isFollowableRep, PrimRep(..) )
+import PrimOp ( PrimOp )
+import Unique ( Unique )
+
\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
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}
| 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)
ReturnInfo -- How to get the return address from the base address
| CSwitch CAddrMode
- [(BasicLit, AbstractC)] -- alternatives
+ [(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.
-- 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
| CStaticClosure
CLabel -- The (full, not base) label to use for labelling the closure.
- ClosureInfo
- CAddrMode -- cost centre identifier to place in closure
+ ClosureInfo
+ CAddrMode -- cost centre identifier to place in closure
[CAddrMode] -- free vars; ptrs, then non-ptrs
-- 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
-- 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 -}
\end{code}
About @CMacroStmt@, etc.: notionally, they all just call some
| 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
-
+ | 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}
\item[@CCallProfCtrMacro@:]
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)
| CTableEntry -- CVal should be generalized to allow this
CAddrMode -- Base
CAddrMode -- Offset
- PrimKind -- For casting
+ PrimRep -- For casting
- | 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
+ PrimRep -- 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
- | 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.
-- range mIN_INTLIKE..mAX_INTLIKE
| CString FAST_STRING -- The address of the null-terminated string
- | CLit BasicLit
+ | CLit Literal
| CLitLit FAST_STRING -- completely literal literal: just spit this String
-- into the C output
- PrimKind
+ PrimRep
| COffset HeapOffset -- A literal constant, not an offset *from* anything!
-- ToDo: this should really be CLitOffset
-- 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
+ [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).
= DirectReturn -- Jump directly, if possible
| StaticVectoredReturn Int -- Fixed tag, starting at zero
| DynamicVectoredReturn CAddrMode -- Dynamic tag given by amode, starting at zero
-
\end{code}
%************************************************************************
-- Argument and return registers
| VanillaReg -- pointers, unboxed ints and chars
- PrimKind -- PtrKind, IntKind, CharKind, StablePtrKind or MallocPtrKind
+ PrimRep -- PtrRep, IntRep, CharRep, StablePtrRep or ForeignObjRep
-- (in case we need to distinguish)
FAST_INT -- its number (1 .. mAX_Vanilla_REG)
| LivenessReg -- (parallel only) used when we need to record explicitly
-- what registers are live
- | ActivityReg -- mentioned only in nativeGen
| StdUpdRetVecReg -- mentioned only in nativeGen
| StkStubReg -- register holding STK_STUB_closure (for stubbing dead stack slots)
| VoidReg -- see "VoidPrim" type; just a placeholder; no actual register
-#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 PtrKind ILIT(1) -- A convenient alias for Node
-infoptr = VanillaReg DataPtrKind ILIT(2) -- An alias for InfoPtr
+node = VanillaReg PtrRep ILIT(1) -- A convenient alias for Node
+infoptr = VanillaReg DataPtrRep ILIT(2) -- An alias for InfoPtr
+
+--------------------
+noLiveRegsMask :: Int -- Mask indicating nothing live
+noLiveRegsMask = 0
+
+mkLiveRegsMask
+ :: [MagicId] -- Candidate live regs; depends what they have in them
+ -> Int
+
+mkLiveRegsMask regs
+ = foldl do_reg noLiveRegsMask regs
+ where
+ do_reg acc (VanillaReg kind reg_no)
+ | isFollowableRep kind
+ = acc + (reg_tbl !! IBOX(reg_no _SUB_ ILIT(1)))
+
+ do_reg acc anything_else = acc
+
+ reg_tbl -- ToDo: mk Array!
+ = [lIVENESS_R1, lIVENESS_R2, lIVENESS_R3, lIVENESS_R4,
+ lIVENESS_R5, lIVENESS_R6, lIVENESS_R7, lIVENESS_R8]
\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)
-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 _EQ_ tag reg2
+ where
+ tag BaseReg = (ILIT(0) :: FAST_INT)
+ tag StkOReg = ILIT(1)
+ tag TagReg = ILIT(2)
+ tag RetReg = ILIT(3)
+ tag SpA = ILIT(4)
+ tag SuA = ILIT(5)
+ tag SpB = ILIT(6)
+ tag SuB = ILIT(7)
+ tag Hp = ILIT(8)
+ tag HpLim = ILIT(9)
+ tag LivenessReg = ILIT(10)
+ tag StdUpdRetVecReg = ILIT(12)
+ tag StkStubReg = ILIT(13)
+ tag CurCostCentre = ILIT(14)
+ tag VoidReg = ILIT(15)
+
+ tag (VanillaReg _ i) = ILIT(15) _ADD_ i
+
+ tag (FloatReg i) = ILIT(15) _ADD_ maxv _ADD_ i
+ where
+ maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
+
+ tag (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 }
\end{code}
Returns True for any register that {\em potentially} dies across
\begin{code}
isVolatileReg :: MagicId -> Bool
-isVolatileReg any = True
+isVolatileReg any = True
--isVolatileReg (FloatReg _) = True
--isVolatileReg (DoubleReg _) = True
\end{code}
%************************************************************************
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 -}
-\end{code}
projects / ghc-hetmet.git / blobdiff