[project @ 2004-08-13 10:45:16 by simonmar]

[ghc-hetmet.git] / ghc / compiler / nativeGen / AbsCStixGen.lhs

diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs
index 5bc8073..4a53f14 100644 (file)
--- a/ghc/compiler/nativeGen/AbsCStixGen.lhs
+++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs
@@ -34,12 +34,11 @@ import UniqSupply   ( returnUs, thenUs, mapUs, getUniqueUs, UniqSM )
 import Util            ( naturalMergeSortLe )
 import Panic           ( panic )
 import TyCon           ( tyConDataCons )
-import Constants       ( wORD_SIZE, bITMAP_BITS_SHIFT )
-import DataCon         ( dataConWrapId )
 import Name             ( NamedThing(..) )
-import CmdLineOpts     ( opt_Static, opt_EnsureSplittableC )
+import CmdLineOpts     ( opt_EnsureSplittableC )
 import Outputable      ( assertPanic )
-import BitSet          ( BitSet, intBS )
+
+import Char            ( ord )
 
 -- DEBUGGING ONLY
 --import TRACE         ( trace )
@@ -64,7 +63,6 @@ genCodeAbstractC absC
  a2stix'     = amodeToStix'
  volsaves    = volatileSaves
  volrestores = volatileRestores
- macro_code  = macroCode
  -- real code follows... ---------
 \end{code}
 
@@ -84,14 +82,9 @@ Here we handle top-level things, like @CCodeBlock@s and
 
  gentopcode stmt@(CStaticClosure lbl closure_info _ _)
   = genCodeStaticClosure stmt                  `thenUs` \ code ->
-    returnUs (
-       if   opt_Static
-       then StSegment DataSegment 
-            : StLabel lbl : code []
-       else StSegment DataSegment 
-            : StData PtrRep [StInt 0] -- DLLised world, need extra zero word
-            : StLabel lbl : code []
-    )
+    returnUs ( StSegment DataSegment 
+             : StLabel lbl : code []
+             )
 
  gentopcode stmt@(CRetVector lbl amodes srt liveness)
   = returnUs ( StSegment TextSegment
@@ -140,23 +133,26 @@ Here we handle top-level things, like @CCodeBlock@s and
           = StCLbl label
 
  gentopcode stmt@(CBitmap l@(Liveness lbl size mask))
-  | isBigLiveness l
   = returnUs 
        [ StSegment TextSegment 
        , StLabel lbl 
-       , StData WordRep (map StInt (toInteger size : bitmapToIntegers mask))
+       , StData WordRep (map StInt (toInteger size : map toInteger mask))
+       ]
+
+ gentopcode stmt@(CSRTDesc lbl srt_lbl off len bitmap)
+  = returnUs 
+       [ StSegment TextSegment 
+       , StLabel lbl 
+       , StData WordRep (
+               StIndex PtrRep (StCLbl srt_lbl) (StInt (toInteger off)) :
+               map StInt (toInteger len : map toInteger bitmap)
+           )
        ]
-  | otherwise
-  = returnUs []
-  where
-    -- ToDo: translate out bitmaps earlier, like info tables
-    isBigLiveness (Liveness _ size _) = size > mAX_SMALL_BITMAP_SIZE
-    mAX_SMALL_BITMAP_SIZE = (wORD_SIZE * 8) - bITMAP_BITS_SHIFT
 
  gentopcode stmt@(CClosureTbl tycon)
   = returnUs [ StSegment TextSegment
              , StLabel (mkClosureTblLabel tycon)
-             , StData DataPtrRep (map (StCLbl . mkClosureLabel . getName . dataConWrapId) 
+             , StData DataPtrRep (map (StCLbl . mkClosureLabel . getName) 
                                       (tyConDataCons tycon) )
              ]
 
@@ -430,7 +426,7 @@ Finally, all of the disgusting AbstractC macros.
 
 \begin{code}
 
- gencode (CMacroStmt macro args) = macro_code macro args
+ gencode (CMacroStmt macro args) = macroCode macro (map amodeToStix args)
 
  gencode (CCallProfCtrMacro macro _)
   = returnUs (\xs -> StComment macro : xs)
@@ -454,7 +450,7 @@ be tuned.)
 \begin{code}
 
  intTag :: Literal -> Integer
- intTag (MachChar c)  = toInteger c
+ intTag (MachChar c)  = toInteger (ord c)
  intTag (MachInt i)   = i
  intTag (MachWord w)  = intTag (word2IntLit (MachWord w))
  intTag _             = panic "intTag"
@@ -659,25 +655,6 @@ mkJoin code lbl
 
 %---------------------------------------------------------------------------
 
-\begin{code}
-bitmapToIntegers :: [BitSet] -> [Integer]
-bitmapToIntegers = bundle . map (toInteger . intBS)
-  where
-#if BYTES_PER_WORD == 4
-    bundle = id
-#else
-    bundle [] = []
-    bundle is = case splitAt (BYTES_PER_WORD/4) is of
-                (these, those) ->
-                   ( foldr1 (\x y -> x + 4294967296 * y)
-                            [x `mod` 4294967296 | x <- these]
-                   : bundle those
-                   )
-#endif
-\end{code}
-
-%---------------------------------------------------------------------------
-
 This answers the question: Can the code fall through to the next
 line(s) of code?  This errs towards saying True if it can't choose,
 because it is used for eliminating needless jumps.  In other words, if