X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FAbsCStixGen.lhs;h=f62c174279f06a3ee89b37a3d2649694026cf9ac;hb=110a35dc422a67e79baf1e101a19284dc7168908;hp=2a3fe2d9059b2388bcc2ea7d3797c4e4cd5ca579;hpb=b71148fc3dc7f89c92c144c8e2c30c3eada8a83d;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs
index 2a3fe2d..f62c174 100644
--- a/ghc/compiler/nativeGen/AbsCStixGen.lhs
+++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs
@@ -24,29 +24,29 @@ import SMRep		( fixedItblSize,
 import Constants   	( mIN_UPD_SIZE )
 import CLabel           ( CLabel, mkReturnInfoLabel, mkReturnPtLabel,
                           mkClosureTblLabel, mkClosureLabel,
-			  moduleRegdLabel, labelDynamic,
-			  mkSplitMarkerLabel )
+			  labelDynamic, mkSplitMarkerLabel )
 import ClosureInfo	( infoTableLabelFromCI, entryLabelFromCI,
 			  fastLabelFromCI, closureUpdReqd,
 			  staticClosureNeedsLink
 			)
 import Literal		( Literal(..), word2IntLit )
 import Maybes	    	( maybeToBool )
+import StgSyn		( StgOp(..) )
 import PrimOp		( primOpNeedsWrapper, PrimOp(..) )
 import PrimRep	    	( isFloatingRep, PrimRep(..) )
-import StixInfo	    	( genCodeInfoTable, genBitmapInfoTable )
+import StixInfo	    	( genCodeInfoTable, genBitmapInfoTable,
+			  livenessIsSmall, bitmapToIntegers )
 import StixMacro	( macroCode, checkCode )
-import StixPrim		( primCode, amodeToStix, amodeToStix' )
+import StixPrim		( primCode, foreignCallCode, amodeToStix, amodeToStix' )
 import Outputable       ( pprPanic, ppr )
 import UniqSupply	( returnUs, thenUs, mapUs, getUniqueUs, UniqSM )
 import Util		( naturalMergeSortLe )
 import Panic		( panic )
 import TyCon		( tyConDataCons )
 import DataCon		( dataConWrapId )
-import BitSet 		( intBS )
 import Name             ( NamedThing(..) )
-import Char		( ord )
 import CmdLineOpts	( opt_Static, opt_EnsureSplittableC )
+import Outputable	( assertPanic )
 \end{code}
 
 For each independent chunk of AbstractC code, we generate a list of
@@ -106,9 +106,7 @@ Here we handle top-level things, like @CCodeBlock@s and
   where 
 	lbl_info = mkReturnInfoLabel uniq
 	lbl_ret  = mkReturnPtLabel uniq
- 	closure_type = case liveness of
-			 LvSmall _ -> rET_SMALL
-			 LvLarge _ -> rET_BIG
+ 	closure_type = if livenessIsSmall liveness then rET_SMALL else rET_BIG
 
  gentopcode stmt@(CClosureInfoAndCode cl_info slow Nothing _)
 
@@ -151,11 +149,13 @@ Here we handle top-level things, like @CCodeBlock@s and
           = StCLbl label
 
  gentopcode stmt@(CBitmap lbl mask)
-  = returnUs [ StSegment TextSegment 
-	     , StLabel lbl 
-	     , StData WordRep (StInt (toInteger (length mask)) : 
-				map  (StInt . toInteger . intBS) mask)
-	     ]
+  = returnUs $ case bitmapToIntegers mask of
+	       mask'@(_:_:_) ->
+		 [ StSegment TextSegment 
+		 , StLabel lbl 
+		 , StData WordRep (map StInt (toInteger (length mask') : mask'))
+		 ]
+	       _ -> []
 
  gentopcode stmt@(CClosureTbl tycon)
   = returnUs [ StSegment TextSegment
@@ -200,9 +200,7 @@ Here we handle top-level things, like @CCodeBlock@s and
     returnUs (\xs -> vectbl : itbl xs)
   where
     vectbl = StData PtrRep (reverse (map a2stix amodes))
-    closure_type = case liveness of
-		    LvSmall _ -> rET_VEC_SMALL
-		    LvLarge _ -> rET_VEC_BIG
+    closure_type = if livenessIsSmall liveness then rET_VEC_SMALL else rET_VEC_BIG
 
 \end{code}
 
@@ -223,19 +221,18 @@ Here we handle top-level things, like @CCodeBlock@s and
        = StData (promote_to_word (getAmodeRep amode)) [a2stix amode]
 
     -- We need to promote any item smaller than a word to a word
-    promote_to_word Int8Rep = IntRep
-    promote_to_word CharRep = IntRep
-    promote_to_word other   = other
+    promote_to_word pk 
+       | sizeOf pk >= sizeOf IntRep  = pk
+       | otherwise                   = IntRep
+
+    upd_reqd = closureUpdReqd cl_info
 
-    -- always at least one padding word: this is the static link field
-    -- for the garbage collector.
-    padding_wds = if closureUpdReqd cl_info then
-    	    		take (max 0 (mIN_UPD_SIZE - length amodes)) zeros
-    	   	  else
-    	    		[]
+    padding_wds
+	| upd_reqd  = take (max 0 (mIN_UPD_SIZE - length amodes)) zeros
+	| otherwise = []
 
-    static_link | staticClosureNeedsLink cl_info = [StInt 0]
-	        | otherwise                      = []
+    static_link | upd_reqd || staticClosureNeedsLink cl_info = [StInt 0]
+	        | otherwise                                  = []
 
     zeros = StInt 0 : zeros
 
@@ -374,12 +371,15 @@ which varies depending on whether we're profiling etc.
 Now the PrimOps, some of which may need caller-saves register wrappers.
 
 \begin{code}
+ gencode (COpStmt results (StgFCallOp fcall _) args vols)
+  = ASSERT( null vols )
+    foreignCallCode (nonVoid results) fcall (nonVoid args)
 
- gencode (COpStmt results op args vols)
+ gencode (COpStmt results (StgPrimOp op) args vols)
   -- ToDo (ADR?): use that liveness mask
   | primOpNeedsWrapper op
   = let
-	saves = volsaves vols
+	saves    = volsaves vols
     	restores = volrestores vols
     in
     	p2stix (nonVoid results) op (nonVoid args)
@@ -387,9 +387,6 @@ Now the PrimOps, some of which may need caller-saves register wrappers.
     	returnUs (\xs -> saves ++ code (restores ++ xs))
 
   | otherwise = p2stix (nonVoid results) op (nonVoid args)
-    where
-	nonVoid = filter ((/= VoidRep) . getAmodeRep)
-
 \end{code}
 
 Now the dreaded conditional jump.
@@ -464,6 +461,8 @@ Finally, all of the disgusting AbstractC macros.
 
  gencode other
   = pprPanic "AbsCStixGen.gencode" (dumpRealC other)
+
+ nonVoid = filter ((/= VoidRep) . getAmodeRep)
 \end{code}
 
 Here, we generate a jump table if there are more than four (integer)