X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2FnativeGen%2FStixInfo.lhs;h=7dcae06d48b6035392da40bb21f14391f5d91cde;hb=06fa575f4b4c51ab48fc4e7f5bd512b8c30325f9;hp=16feabc46ebf0c428fb387fa5c02bbe711581d3f;hpb=ff755dd9a0a0ad2f106c323852553ea247f16141;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/StixInfo.lhs b/ghc/compiler/nativeGen/StixInfo.lhs
index 16feabc..7dcae06 100644
--- a/ghc/compiler/nativeGen/StixInfo.lhs
+++ b/ghc/compiler/nativeGen/StixInfo.lhs
@@ -3,32 +3,33 @@
 %
 
 \begin{code}
-module StixInfo ( genCodeInfoTable, genBitmapInfoTable ) where
+module StixInfo (
+
+	genCodeInfoTable, genBitmapInfoTable,
+
+	bitmapToIntegers, bitmapIsSmall, livenessIsSmall
+
+    ) where
 
 #include "HsVersions.h"
 #include "../includes/config.h"
+#include "NCG.h"
 
-import AbsCSyn		( AbstractC(..), Liveness(..) )
-import CLabel		( CLabel )
-import StgSyn		( SRT(..) )
+import AbsCSyn		( AbstractC(..), Liveness(..), C_SRT(..), needsSRT )
 import ClosureInfo	( closurePtrsSize,
 			  closureNonHdrSize, closureSMRep,
 			  infoTableLabelFromCI,
-			  infoTblNeedsSRT, getSRTInfo, closureSemiTag
+			  closureSRT, closureSemiTag
 			)
 import PrimRep		( PrimRep(..) )
-import SMRep		( SMRep(..), getSMRepClosureTypeInt )
+import SMRep		( getSMRepClosureTypeInt )
 import Stix		-- all of it
 import UniqSupply	( returnUs, UniqSM )
-import BitSet		( intBS )
+import BitSet		( BitSet, intBS )
 import Maybes		( maybeToBool )
 
-import Bits
-import Word
-
-#if __GLASGOW_HASKELL__ >= 404
-import GlaExts		( fromInt )
-#endif
+import DATA_BITS
+import DATA_WORD
 \end{code}
 
 Generating code for info tables (arrays of data).
@@ -36,14 +37,13 @@ Generating code for info tables (arrays of data).
 \begin{code}
 genCodeInfoTable
     :: AbstractC
-    -> UniqSM StixTreeList
+    -> UniqSM StixStmtList
 
 genCodeInfoTable (CClosureInfoAndCode cl_info _ _ cl_descr)
   = returnUs (\xs -> StData PtrRep table : StLabel info_lbl : xs)
 
     where
 	info_lbl  = infoTableLabelFromCI cl_info
-        needs_srt = infoTblNeedsSRT cl_info
 
 	table | needs_srt = srt_label : rest_of_table
 	      | otherwise = rest_of_table
@@ -59,24 +59,22 @@ genCodeInfoTable (CClosureInfoAndCode cl_info _ _ cl_descr)
 	-- ToDo: do this using .byte and .word directives.
 	type_info :: Word32
 #ifdef WORDS_BIGENDIAN
-        type_info = (fromInt closure_type `shiftL` 16) .|.
-		    (fromInt srt_len)
+        type_info = (fromIntegral closure_type `shiftL` 16) .|.
+		    (fromIntegral srt_len)
 #else 
-        type_info = (fromInt closure_type) .|.
-		    (fromInt srt_len `shiftL` 16)
+        type_info = (fromIntegral closure_type) .|.
+		    (fromIntegral srt_len `shiftL` 16)
 #endif	     
-	srt = getSRTInfo cl_info	     
+	srt	  = closureSRT cl_info	     
+        needs_srt = needsSRT srt
 
 	(srt_label,srt_len)
            | is_constr
            = (StInt 0, tag)
-           | needs_srt
-	   = case srt of
-		(lbl, SRT off len) -> 
-			(StIndex DataPtrRep (StCLbl lbl) 
-				(StInt (toInteger off)), len)
            | otherwise
-           = (StInt 0, 0)
+	   = case srt of
+		NoC_SRT 	  -> (StInt 0, 0)
+		C_SRT lbl off len -> (StIndex DataPtrRep (StCLbl lbl) (StInt (toInteger off)), len)
 
         maybe_tag = closureSemiTag cl_info
         is_constr = maybeToBool maybe_tag
@@ -84,9 +82,9 @@ genCodeInfoTable (CClosureInfoAndCode cl_info _ _ cl_descr)
 
 	layout_info :: Word32
 #ifdef WORDS_BIGENDIAN
-	layout_info = (fromInt ptrs `shiftL` 16) .|. fromInt nptrs
+	layout_info = (fromIntegral ptrs `shiftL` 16) .|. fromIntegral nptrs
 #else 
-	layout_info = (fromInt ptrs) .|. (fromInt nptrs `shiftL` 16)
+	layout_info = (fromIntegral ptrs) .|. (fromIntegral nptrs `shiftL` 16)
 #endif	     
 
     	ptrs    = closurePtrsSize cl_info
@@ -100,10 +98,10 @@ genCodeInfoTable (CClosureInfoAndCode cl_info _ _ cl_descr)
 
 genBitmapInfoTable
 	:: Liveness
-	-> (CLabel, SRT)
+	-> C_SRT
 	-> Int
 	-> Bool			-- must include SRT field (i.e. it's a vector)
-	-> UniqSM StixTreeList
+	-> UniqSM StixStmtList
 
 genBitmapInfoTable liveness srt closure_type include_srt
   = returnUs (\xs -> StData PtrRep table : xs)
@@ -122,22 +120,49 @@ genBitmapInfoTable liveness srt closure_type include_srt
 		]
 
 	layout_info = case liveness of
-			LvSmall mask -> StInt (toInteger (intBS mask))
-			LvLarge lbl  -> StCLbl lbl
+		      Liveness lbl mask ->
+			case bitmapToIntegers mask of
+			[ ] -> StInt 0
+			[i] -> StInt i
+			_   -> StCLbl lbl
 
 	type_info :: Word32
 #ifdef WORDS_BIGENDIAN
-        type_info = (fromInt closure_type `shiftL` 16) .|.
-		    (fromInt srt_len)
+        type_info = (fromIntegral closure_type `shiftL` 16) .|.
+		    (fromIntegral srt_len)
 #else 
-        type_info = (fromInt closure_type) .|.
-		    (fromInt srt_len `shiftL` 16)
+        type_info = (fromIntegral closure_type) .|.
+		    (fromIntegral srt_len `shiftL` 16)
 #endif	     
 
 	(srt_label,srt_len) = 
 	     case srt of
-		(lbl, NoSRT) -> (StInt 0, 0)
-		(lbl, SRT off len) -> 
+		NoC_SRT -> (StInt 0, 0)
+		C_SRT lbl off len -> 
 			(StIndex DataPtrRep (StCLbl lbl) 
 				(StInt (toInteger off)), len)
+
+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
+
+bitmapIsSmall :: [BitSet] -> Bool
+bitmapIsSmall bitmap
+  = case bitmapToIntegers bitmap of
+    _:_:_ -> False
+    _     -> True
+
+livenessIsSmall :: Liveness -> Bool
+livenessIsSmall (Liveness _ mask) = bitmapIsSmall mask
 \end{code}