X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FAbsCStixGen.lhs;h=51a29c6c3bc5c02ee5c47aadc3460f7c9e9c5ac3;hb=6c9a37e31afc41d57417a3828877577d8d270266;hp=889013d086c6726c6df35b28960226c9a030a530;hpb=c49c5ebae0a4d98348505db55cb370dfe896db6c;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs
index 889013d..51a29c6 100644
--- a/ghc/compiler/nativeGen/AbsCStixGen.lhs
+++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs
@@ -24,8 +24,7 @@ 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
@@ -45,8 +44,7 @@ import TyCon		( tyConDataCons )
 import DataCon		( dataConWrapId )
 import BitSet 		( intBS )
 import Name             ( NamedThing(..) )
-import Char		( ord )
-import CmdLineOpts	( opt_Static )
+import CmdLineOpts	( opt_Static, opt_EnsureSplittableC )
 \end{code}
 
 For each independent chunk of AbstractC code, we generate a list of
@@ -146,7 +144,7 @@ Here we handle top-level things, like @CCodeBlock@s and
        mk_StCLbl_for_SRT :: CLabel -> StixTree
        mk_StCLbl_for_SRT label
           | labelDynamic label
-          = StIndex CharRep (StCLbl label) (StInt 1)
+          = StIndex Int8Rep (StCLbl label) (StInt 1)
           | otherwise
           = StCLbl label
 
@@ -181,7 +179,7 @@ Here we handle top-level things, like @CCodeBlock@s and
 	     [ StLabel tmp_lbl
 	     , StAssign PtrRep stgSp
                         (StIndex PtrRep stgSp (StInt (-1)))
-	     , StJump (StInd WordRep stgSp)
+	     , StJump NoDestInfo (StInd WordRep stgSp)
 	     ])
 
  gentopcode absC
@@ -216,9 +214,17 @@ Here we handle top-level things, like @CCodeBlock@s and
   = returnUs (\xs -> table ++ xs)
   where
     table = StData PtrRep [StCLbl (infoTableLabelFromCI cl_info)] : 
-	    map (\amode -> StData (getAmodeRep amode) [a2stix amode]) amodes ++
+	    map do_one_amode amodes ++
 	    [StData PtrRep (padding_wds ++ static_link)]
 
+    do_one_amode amode 
+       = 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
+
     -- always at least one padding word: this is the static link field
     -- for the garbage collector.
     padding_wds = if closureUpdReqd cl_info then
@@ -263,7 +269,9 @@ split-mangler later on and used to split the assembly into chunks.
 
 \begin{code}
 
- gencode CSplitMarker = returnUs (\xs -> StLabel mkSplitMarkerLabel : xs)
+ gencode CSplitMarker
+   | opt_EnsureSplittableC = returnUs (\xs -> StLabel mkSplitMarkerLabel : xs)
+   | otherwise             = returnUs id
 
 \end{code}
 
@@ -338,22 +346,22 @@ which varies depending on whether we're profiling etc.
 \begin{code}
 
  gencode (CJump dest)
-  = returnUs (\xs -> StJump (a2stix dest) : xs)
+  = returnUs (\xs -> StJump NoDestInfo (a2stix dest) : xs)
 
  gencode (CFallThrough (CLbl lbl _))
   = returnUs (\xs -> StFallThrough lbl : xs)
 
  gencode (CReturn dest DirectReturn)
-  = returnUs (\xs -> StJump (a2stix dest) : xs)
+  = returnUs (\xs -> StJump NoDestInfo (a2stix dest) : xs)
 
  gencode (CReturn table (StaticVectoredReturn n))
-  = returnUs (\xs -> StJump dest : xs)
+  = returnUs (\xs -> StJump NoDestInfo dest : xs)
   where
     dest = StInd PtrRep (StIndex PtrRep (a2stix table)
     	    	      	    	  (StInt (toInteger (-n-fixedItblSize-1))))
 
  gencode (CReturn table (DynamicVectoredReturn am))
-  = returnUs (\xs -> StJump dest : xs)
+  = returnUs (\xs -> StJump NoDestInfo dest : xs)
   where
     dest = StInd PtrRep (StIndex PtrRep (a2stix table) dyn_off)
     dyn_off = StPrim IntSubOp [StPrim IntNegOp [a2stix am], 
@@ -464,7 +472,7 @@ be tuned.)
 \begin{code}
 
  intTag :: Literal -> Integer
- intTag (MachChar c)  = toInteger (ord c)
+ intTag (MachChar c)  = toInteger c
  intTag (MachInt i)   = i
  intTag (MachWord w)  = intTag (word2IntLit (MachWord w))
  intTag _             = panic "intTag"
@@ -496,12 +504,14 @@ be tuned.)
     	highest = if floating then targetMaxDouble else targetMaxInt
     in
     	(
-    	if not floating && choices > 4 && highTag - lowTag < toInteger (2 * choices) then
+    	if  not floating && choices > 4 
+            && highTag - lowTag < toInteger (2 * choices)
+        then
     	    mkJumpTable am' sortedAlts lowTag highTag udlbl
     	else
     	    mkBinaryTree am' floating sortedAlts choices lowest highest udlbl
     	)
-    	    	    	    	    	    	    	`thenUs` \ alt_code ->
+    	    	    	    	    	    	`thenUs` \ alt_code ->
 	gencode absC				`thenUs` \ dflt_code ->
 
     	returnUs (\xs -> alt_code (StLabel udlbl : dflt_code (StLabel ujlbl : xs)))
@@ -545,8 +555,9 @@ already finish with a jump to the join point.
     	cjmpHi = StCondJump dflt (StPrim IntGtOp [am, StInt (toInteger highTag)])
 
     	offset = StPrim IntSubOp [am, StInt lowTag]
+        dsts   = DestInfo (dflt : map fst branches)
 
-    	jump = StJump (StInd PtrRep (StIndex PtrRep (StCLbl utlbl) offset))
+    	jump = StJump dsts (StInd PtrRep (StIndex PtrRep (StCLbl utlbl) offset))
     	tlbl = StLabel utlbl
     	table = StData PtrRep (mkTable branches [lowTag..highTag] [])
     in