[project @ 2002-05-01 13:16:04 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 c3a63f9..1a3fcf8 100644 (file)
--- a/ghc/compiler/absCSyn/AbsCUtils.lhs
+++ b/ghc/compiler/absCSyn/AbsCUtils.lhs
@@ -17,6 +17,7 @@ module AbsCUtils (
     ) where
 
 #include "HsVersions.h"
+#include "../includes/config.h"
 
 import AbsCSyn
 import CLabel          ( mkMAP_FROZEN_infoLabel )
@@ -29,9 +30,9 @@ import MachOp         ( MachOp(..), isDefinitelyInlineMachOp )
 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
@@ -366,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:
@@ -400,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
                 )
@@ -895,18 +896,59 @@ 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 
         (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. [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]
+--
+--   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
+   = 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
      ]