X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FStixInfo.lhs;h=b59aa89a6670312c0f661c2462c13dbb627a8ea3;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=82b88c67608f377109d39137075804fd884f98d0;hpb=7d61cb61daa5e433a0cb85b34b7f0c58b2f961ff;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/StixInfo.lhs b/ghc/compiler/nativeGen/StixInfo.lhs
index 82b88c6..b59aa89 100644
--- a/ghc/compiler/nativeGen/StixInfo.lhs
+++ b/ghc/compiler/nativeGen/StixInfo.lhs
@@ -1,147 +1,117 @@
 %
-% (c) The AQUA Project, Glasgow University, 1993-1996
+% (c) The AQUA Project, Glasgow University, 1993-1998
 %
 
 \begin{code}
-#include "HsVersions.h"
-
-module StixInfo ( genCodeInfoTable ) where
+module StixInfo ( genCodeInfoTable, genBitmapInfoTable ) where
 
-import Ubiq{-uitious-}
+#include "HsVersions.h"
 
-import AbsCSyn		( AbstractC(..), CAddrMode, ReturnInfo,
-			  RegRelative, MagicId, CStmtMacro
-			)
-import ClosureInfo	( closurePtrsSize, closureSizeWithoutFixedHdr,
-			  closureNonHdrSize, closureSemiTag, maybeSelectorInfo,
-			  closureSMRep, closureLabelFromCI,
+import AbsCSyn		( AbstractC(..), Liveness(..) )
+import CLabel		( CLabel )
+import StgSyn		( SRT(..) )
+import ClosureInfo	( closurePtrsSize,
+			  closureNonHdrSize, closureSMRep,
 			  infoTableLabelFromCI
 			)
-import HeapOffs		( hpRelToInt )
-import Maybes		( maybeToBool )
 import PrimRep		( PrimRep(..) )
-import SMRep		( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..),
-			  isSpecRep
-			)
+import SMRep		( SMRep(..), getSMRepClosureTypeInt )
 import Stix		-- all of it
-import StixPrim		( amodeToStix )
-import UniqSupply	( returnUs, UniqSM(..) )
-import Unpretty		( uppBesides, uppPStr, uppInt, uppChar )
+import UniqSupply	( returnUs, UniqSM )
+import Outputable	( int )
+import BitSet		( intBS )
+
+import Bits
+import Word
 \end{code}
 
 Generating code for info tables (arrays of data).
 
 \begin{code}
-static___rtbl	= sStLitLbl SLIT("Static___rtbl") -- out here to avoid CAF (sigh)
-const___rtbl	= sStLitLbl SLIT("Const___rtbl")
-charlike___rtbl	= sStLitLbl SLIT("CharLike___rtbl")
-intlike___rtbl	= sStLitLbl SLIT("IntLike___rtbl")
-gen_N___rtbl	= sStLitLbl SLIT("Gen_N___rtbl")
-gen_S___rtbl	= sStLitLbl SLIT("Gen_S___rtbl")
-gen_U___rtbl	= sStLitLbl SLIT("Gen_U___rtbl")
-tuple___rtbl	= sStLitLbl SLIT("Tuple___rtbl")
-data___rtbl	= sStLitLbl SLIT("Data___rtbl")
-dyn___rtbl	= sStLitLbl SLIT("Dyn___rtbl")
-
 genCodeInfoTable
     :: AbstractC
     -> UniqSM StixTreeList
 
-genCodeInfoTable (CClosureInfoAndCode cl_info _ _ upd cl_descr _)
-  = returnUs (\xs -> info : lbl : xs)
+genCodeInfoTable (CClosureInfoAndCode cl_info _ _ srt cl_descr)
+  = returnUs (\xs -> StData PtrRep table : StLabel info_lbl : xs)
 
     where
-	info = StData PtrRep table
-	lbl = StLabel info_lbl
-
-	table = case sm_rep of
-	    StaticRep _ _ -> [
-		StInt (toInteger ptrs),
-		StInt (toInteger size),
-		upd_code,
-		static___rtbl,
-		tag]
-
-	    SpecialisedRep ConstantRep _ _ _ -> [
-		StCLbl closure_lbl,
-		upd_code,
-		const___rtbl,
-		tag]
-
-	    SpecialisedRep CharLikeRep _ _ _ -> [
-		upd_code,
-		charlike___rtbl,
-		tag]
-
-	    SpecialisedRep IntLikeRep _ _ _ -> [
-		upd_code,
-		intlike___rtbl,
-		tag]
-
-	    SpecialisedRep _ _ _ updatable ->
-		let rtbl = uppBesides (
-		       if is_selector then
-			  [uppPStr SLIT("Select__"),
-			   uppInt select_word,
-			   uppPStr SLIT("_rtbl")]
-		       else
-			  [uppPStr (case updatable of
-				    SMNormalForm -> SLIT("Spec_N_")
-				    SMSingleEntry -> SLIT("Spec_S_")
-				    SMUpdatable -> SLIT("Spec_U_")
-				   ),
-			   uppInt size,
-			   uppChar '_',
-			   uppInt ptrs,
-			   uppPStr SLIT("_rtbl")])
-		in
-		    case updatable of
-			SMNormalForm -> [upd_code, StLitLbl rtbl, tag]
-			_            -> [StLitLbl rtbl, tag]
-
-	    GenericRep _ _ updatable ->
-		let rtbl = case updatable of
-			    SMNormalForm  -> gen_N___rtbl
-			    SMSingleEntry -> gen_S___rtbl
-			    SMUpdatable   -> gen_U___rtbl
-		in [
-		    StInt (toInteger ptrs),
-		    StInt (toInteger size),
-		    upd_code,
-		    rtbl,
-		    tag]
-
-	    BigTupleRep _ -> [
-		tuple___rtbl,
-		tag]
-	    DataRep _     -> [
-		data___rtbl,
-		tag]
-	    DynamicRep    -> [
-		dyn___rtbl,
-		tag]
-
-	    PhantomRep -> [
-		upd_code,
-		info_unused,	-- no rep table
-		tag]
-
-	info_lbl	= infoTableLabelFromCI cl_info
-	closure_lbl	= closureLabelFromCI   cl_info
-
-	sm_rep	= closureSMRep cl_info
-	maybe_selector = maybeSelectorInfo cl_info
-	is_selector = maybeToBool maybe_selector
-	(Just (_, select_word)) = maybe_selector
-
-	tag = StInt (toInteger (closureSemiTag cl_info))
-
-	size	= if isSpecRep sm_rep
-		  then closureNonHdrSize cl_info
-		  else hpRelToInt (closureSizeWithoutFixedHdr cl_info)
-	ptrs	= closurePtrsSize cl_info
-
-	upd_code = amodeToStix upd
-
-	info_unused = StInt (-1)
+	info_lbl = infoTableLabelFromCI cl_info
+
+	table = case srt_len of 
+		   0 -> rest_of_table
+		   _ -> srt_label : rest_of_table
+
+	rest_of_table = 
+		[
+		{- par, prof, debug -} 
+		  StInt (toInteger layout_info)
+		, StInt (toInteger type_info)
+		]
+
+	type_info :: Word32
+        type_info = (fromInt flags `shiftL` 24) .|.
+		    (fromInt closure_type `shiftL` 16) .|.
+		    (fromInt srt_len)
+	     
+	(srt_label,srt_len) = 
+	     case srt of
+		(lbl, NoSRT) -> (StInt 0, 0)
+		(lbl, SRT off len) -> 
+			(StIndex DataPtrRep (StCLbl lbl) 
+				(StInt (toInteger off)), len)
+
+	layout_info :: Word32
+	layout_info = (fromInt ptrs `shiftL` 16) .|. fromInt nptrs
+
+    	ptrs    = closurePtrsSize cl_info
+	nptrs	= size - ptrs
+
+        size = closureNonHdrSize cl_info
+
+	closure_type = getSMRepClosureTypeInt (closureSMRep cl_info)
+
+	flags = 0 -- for now
+
+
+genBitmapInfoTable
+	:: Liveness
+	-> (CLabel, SRT)
+	-> Int
+	-> Bool			-- must include SRT field (i.e. it's a vector)
+	-> UniqSM StixTreeList
+
+genBitmapInfoTable liveness srt closure_type include_srt
+  = returnUs (\xs -> StData PtrRep table : xs)
+
+  where
+	table = if srt_len == 0 && not include_srt then
+		   rest_of_table
+		else
+		   srt_label : rest_of_table
+
+	rest_of_table = 
+		[
+		{- par, prof, debug -} 
+		  layout_info
+		, StInt (toInteger type_info)
+		]
+
+	layout_info = case liveness of
+			LvSmall mask -> StInt (toInteger (intBS mask))
+			LvLarge lbl  -> StCLbl lbl
+
+	type_info :: Word32
+        type_info = (fromInt flags `shiftL` 24) .|.
+		    (fromInt closure_type `shiftL` 16) .|.
+		    (fromInt srt_len)
+	     
+	(srt_label,srt_len) = 
+	     case srt of
+		(lbl, NoSRT) -> (StInt 0, 0)
+		(lbl, SRT off len) -> 
+			(StIndex DataPtrRep (StCLbl lbl) 
+				(StInt (toInteger off)), len)
+
+	flags = 0 -- for now
 \end{code}