X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FabsCSyn%2FAbsCSyn.lhs;h=6bd34a6fb82cd55fa4167eb951ab720a627c210e;hb=30d559930fff086ad3a8ef4162e7d748d1e96b70;hp=cb65a7f23940bebb63a09bdeab16b734e816e0ed;hpb=aba5a247c8911531630003569a2d5355ecf1a599;p=ghc-hetmet.git diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs index cb65a7f..6bd34a6 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.25 1999/10/31 15:35:32 sof Exp $ +% $Id: AbsCSyn.lhs,v 1.34 2000/10/12 13:11:46 simonmar Exp $ % \section[AbstractC]{Abstract C: the last stop before machine code} @@ -39,17 +39,13 @@ 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 PrimRep ( PrimRep(..) ) -import PrimOp ( PrimOp ) +import PrimOp ( PrimOp, CCall ) import Unique ( Unique ) import StgSyn ( SRT(..) ) import TyCon ( TyCon ) @@ -167,7 +163,7 @@ stored in a mixed type location.) compiling 'foreign import dynamic's) -} | CCallTypedef Bool {- True => use "typedef"; False => use "extern"-} - PrimOp{-CCallOp-} [CAddrMode] [CAddrMode] + CCall [CAddrMode] [CAddrMode] -- *** the next three [or so...] are DATA (those above are CODE) *** @@ -201,6 +197,10 @@ stored in a mixed type location.) | 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 @@ -235,6 +235,12 @@ data CStmtMacro | 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 @@ -309,7 +315,7 @@ 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 @@ -317,10 +323,6 @@ data CAddrMode | 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. VirtualSpOffset -- Sp value after any volatile free vars @@ -344,6 +346,7 @@ data CExprMacro | ARG_TAG -- stack argument tagging | GET_TAG -- get current constructor tag | UPD_FRAME_UPDATEE + | CCS_HDR \end{code} @@ -371,9 +374,9 @@ 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] @@ -385,16 +388,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 _IBOX(hp) _IBOX(off) = HpRel (hp _SUB_ 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 (case spRelToInt sp off of { _IBOX(i) -> i }) nodeRel :: VirtualHeapOffset -> RegRelative -nodeRel IBOX(off) = NodeRel off +nodeRel _IBOX(off) = NodeRel off \end{code} @@ -448,13 +451,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. @@ -467,38 +470,42 @@ 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 -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