[project @ 2002-12-12 14:35:57 by simonmar]

[ghc-hetmet.git] / ghc / compiler / absCSyn / AbsCUtils.lhs

diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs
index 90988cd..36e74ef 100644 (file)
--- a/ghc/compiler/absCSyn/AbsCUtils.lhs
+++ b/ghc/compiler/absCSyn/AbsCUtils.lhs
@@ -31,8 +31,8 @@ import Unique         ( Unique{-instance Eq-} )
 import UniqSupply      ( uniqFromSupply, uniqsFromSupply, splitUniqSupply, 
                          UniqSupply )
 import CmdLineOpts      ( opt_EmitCExternDecls, opt_Unregisterised )
-import ForeignCall     ( ForeignCall(..), CCallSpec(..), CCallTarget(..), Safety(..),
-                         isDynamicTarget, isCasmTarget, defaultCCallConv )
+import ForeignCall     ( ForeignCall(..), CCallSpec(..),
+                         isDynamicTarget, isCasmTarget )
 import StgSyn          ( StgOp(..) )
 import SMRep           ( arrPtrsHdrSize, arrWordsHdrSize, fixedHdrSize )
 import Outputable
@@ -144,13 +144,12 @@ magicIdPrimRep (FloatReg _)           = FloatRep
 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}
@@ -320,11 +319,10 @@ flatAbsC (AbsCStmts s1 s2)
     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)
@@ -418,15 +416,15 @@ flatAbsC (CSequential abcs)
 
 -- 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}
@@ -741,6 +739,14 @@ getBitsPerWordMinus1
         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
@@ -896,6 +902,14 @@ dscCOpStmt [res] EqStableNameOp [arg1,arg2] vols
         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 
@@ -905,17 +919,14 @@ dscCOpStmt [res] AddrToHValueOp [arg] vols
 -- 
 --   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. [NOTE: We're faking it slightly here,
---   info table layout is a separate issue from having an unregistered
---   impl of the STG machine, but currently only the unregisterised build
---   doesn't have TABLES_NEXT_TO_CODE]
+--   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
-   | opt_Unregisterised
+   | not tablesNextToCode
    = returnFlt (CMacroStmt DATA_TO_TAGZH [res,arg])
    | otherwise
    = mkTemps [PtrRep, WordRep]         `thenFlt` \ [t_infoptr, t_theword] ->
@@ -1107,7 +1118,7 @@ dscCOpStmt [] WriteOffAddrOp_Int        [a,i,x] vols = doWriteOffAddrOp Nothing
 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