) where
#include "HsVersions.h"
+#include "../includes/config.h"
import AbsCSyn
import CLabel ( mkMAP_FROZEN_infoLabel )
import Unique ( Unique{-instance Eq-} )
import UniqSupply ( uniqFromSupply, uniqsFromSupply, splitUniqSupply,
UniqSupply )
-import CmdLineOpts ( opt_EmitCExternDecls )
-import ForeignCall ( ForeignCall(..), CCallSpec(..), CCallTarget(..), Safety(..),
- isDynamicTarget, isCasmTarget, defaultCCallConv )
+import CmdLineOpts ( opt_EmitCExternDecls, opt_Unregisterised )
+import ForeignCall ( ForeignCall(..), CCallSpec(..),
+ isDynamicTarget, isCasmTarget )
import StgSyn ( StgOp(..) )
import SMRep ( arrPtrsHdrSize, arrWordsHdrSize, fixedHdrSize )
import Outputable
magicIdPrimRep (DoubleReg _) = DoubleRep
magicIdPrimRep (LongReg kind _) = kind
magicIdPrimRep Sp = PtrRep
-magicIdPrimRep Su = PtrRep
magicIdPrimRep SpLim = PtrRep
magicIdPrimRep Hp = PtrRep
magicIdPrimRep HpLim = PtrRep
magicIdPrimRep CurCostCentre = CostCentreRep
magicIdPrimRep VoidReg = VoidRep
-magicIdPrimRep CurrentTSO = ThreadIdRep
+magicIdPrimRep CurrentTSO = PtrRep
magicIdPrimRep CurrentNursery = PtrRep
magicIdPrimRep HpAlloc = WordRep
\end{code}
returnFlt (mkAbsCStmts inline_s1 inline_s2,
mkAbsCStmts top_s1 top_s2)
-flatAbsC (CClosureInfoAndCode cl_info slow maybe_fast descr)
- = flatAbsC slow `thenFlt` \ (slow_heres, slow_tops) ->
- flat_maybe maybe_fast `thenFlt` \ (fast_heres, fast_tops) ->
- returnFlt (AbsCNop, mkAbstractCs [slow_tops, fast_tops,
- CClosureInfoAndCode cl_info slow_heres fast_heres descr]
+flatAbsC (CClosureInfoAndCode cl_info entry)
+ = flatAbsC entry `thenFlt` \ (entry_heres, entry_tops) ->
+ returnFlt (AbsCNop, mkAbstractCs [entry_tops,
+ CClosureInfoAndCode cl_info entry_heres]
)
flatAbsC (CCodeBlock lbl abs_C)
-- the TICKY_CTR macro always needs to be hoisted out to the top level.
-- This is a HACK.
flatAbsC stmt@(CCallProfCtrMacro str amodes)
- | str == SLIT("TICK_CTR") = returnFlt (AbsCNop, stmt)
+ | str == FSLIT("TICK_CTR") = returnFlt (AbsCNop, stmt)
| otherwise = returnFlt (stmt, AbsCNop)
-- Some statements need no flattening at all:
= COpStmt
[]
(StgFCallOp
- (CCall (CCallSpec (CasmTarget (_PK_ (mktxt op_str)))
- defaultCCallConv PlaySafe))
+ (CCall (CCallSpec (CasmTarget (mkFastString (mktxt op_str)))
+ defaultCCallConv (PlaySafe False)))
uu
)
[CReg VoidReg]
-- Some statements only make sense at the top level, so we always float
-- them. This probably isn't necessary.
-flatAbsC stmt@(CStaticClosure _ _ _) = returnFlt (AbsCNop, stmt)
+flatAbsC stmt@(CStaticClosure _ _ _ _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CClosureTbl _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CSRT _ _) = returnFlt (AbsCNop, stmt)
-flatAbsC stmt@(CBitmap _ _) = returnFlt (AbsCNop, stmt)
+flatAbsC stmt@(CBitmap _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CCostCentreDecl _ _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CCostCentreStackDecl _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CSplitMarker) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CRetVector _ _ _ _) = returnFlt (AbsCNop, stmt)
-flatAbsC stmt@(CModuleInitBlock _ _) = returnFlt (AbsCNop, stmt)
+flatAbsC stmt@(CModuleInitBlock _ _ _) = returnFlt (AbsCNop, stmt)
\end{code}
\begin{code}
t2
)
+-- IA64 mangler doesn't place tables next to code
+tablesNextToCode :: Bool
+#ifdef ia64_TARGET_ARCH
+tablesNextToCode = False
+#else
+tablesNextToCode = not opt_Unregisterised
+#endif
+
------------------------------------------------------------------------------
-- This is the main top-level desugarer PrimOps into MachOps. First we
CMachOpStmt res MO_Nat_Eq [sn1,sn2] Nothing
]
+dscCOpStmt [res] ReallyUnsafePtrEqualityOp [arg1,arg2] vols
+ = mkTemps [WordRep, WordRep] `thenFlt` \ [w1,w2] ->
+ (returnFlt . CSequential) [
+ CMachOpStmt w1 MO_NatP_to_NatU [arg1] Nothing,
+ CMachOpStmt w2 MO_NatP_to_NatU [arg2] Nothing,
+ CMachOpStmt res MO_Nat_Eq [w1,w2] Nothing{- because it's inline? -}
+ ]
+
-- #define addrToHValuezh(r,a) r=(P_)a
dscCOpStmt [res] AddrToHValueOp [arg] vols
= returnFlt
(CAssign res arg)
-- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
+--
+-- In the unregisterised case, we don't attempt to compute the location
+-- of the tag halfword, just a macro. For this build, fixing on layout
+-- info has only got drawbacks.
+--
+-- Should this arrangement deeply offend you for some reason, code which
+-- computes the offset can be found below also.
+-- -- sof 3/02
+--
dscCOpStmt [res] DataToTagOp [arg] vols
+ | not tablesNextToCode
+ = returnFlt (CMacroStmt DATA_TO_TAGZH [res,arg])
+ | otherwise
= mkTemps [PtrRep, WordRep] `thenFlt` \ [t_infoptr, t_theword] ->
mkHalfWord_HIADDR res t_theword `thenFlt` \ select_ops ->
(returnFlt . CSequential) [
CAssign t_infoptr (mkDerefOff PtrRep arg 0),
+ {-
+ Get at the tag within the info table; two cases to consider:
+
+ - reversed info tables next to the entry point code;
+ one word above the end of the info table (which is
+ what t_infoptr is really pointing to).
+ - info tables with their entry points stored somewhere else,
+ which is how the unregisterised (nee TABLES_NEXT_TO_CODE)
+ world operates.
+
+ The t_infoptr points to the start of the info table, so add
+ the length of the info table & subtract one word.
+ -}
CAssign t_theword (mkDerefOff WordRep t_infoptr (-1)),
+{- UNUSED - see above comment.
+ (if opt_Unregisterised then
+ (fixedItblSize - 1)
+ else (-1))),
+-}
select_ops
]
dscCOpStmt [] WriteOffAddrOp_Word [a,i,x] vols = doWriteOffAddrOp Nothing WordRep a i x
dscCOpStmt [] WriteOffAddrOp_Addr [a,i,x] vols = doWriteOffAddrOp Nothing AddrRep a i x
dscCOpStmt [] WriteOffAddrOp_Float [a,i,x] vols = doWriteOffAddrOp Nothing FloatRep a i x
-dscCOpStmt [] WriteOffAddrOp_ForeignObj [a,i,x] vols = doWriteOffAddrOp Nothing ForeignObjRep a i x
+dscCOpStmt [] WriteOffAddrOp_ForeignObj [a,i,x] vols = doWriteOffAddrOp Nothing PtrRep a i x
dscCOpStmt [] WriteOffAddrOp_Double [a,i,x] vols = doWriteOffAddrOp Nothing DoubleRep a i x
dscCOpStmt [] WriteOffAddrOp_StablePtr [a,i,x] vols = doWriteOffAddrOp Nothing StablePtrRep a i x