[project @ 2002-10-18 13:36:17 by simonpj]

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

diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs
index 5643da8..02a1d31 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
@@ -150,7 +150,7 @@ 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}
@@ -367,7 +367,7 @@ flatAbsC stmt@(CCheck macro amodes code)
 -- 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:
@@ -401,7 +401,7 @@ flatAbsC stmt@(COpStmt results (StgPrimOp op) args vol_regs)
            = COpStmt 
                 []
                 (StgFCallOp
-                    (CCall (CCallSpec (CasmTarget (_PK_ (mktxt op_str))) 
+                    (CCall (CCallSpec (CasmTarget (mkFastString (mktxt op_str))) 
                                       defaultCCallConv (PlaySafe False)))
                     uu
                 )
@@ -426,7 +426,7 @@ 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 +741,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 +904,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 +921,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 +1120,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