[project @ 2000-08-21 15:40:14 by sewardj]

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

diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs
index 604e41a..2a3fe2d 100644 (file)
--- a/ghc/compiler/nativeGen/AbsCStixGen.lhs
+++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs
@@ -24,7 +24,8 @@ import SMRep          ( fixedItblSize,
 import Constants       ( mIN_UPD_SIZE )
 import CLabel           ( CLabel, mkReturnInfoLabel, mkReturnPtLabel,
                           mkClosureTblLabel, mkClosureLabel,
-                         moduleRegdLabel, labelDynamic )
+                         moduleRegdLabel, labelDynamic,
+                         mkSplitMarkerLabel )
 import ClosureInfo     ( infoTableLabelFromCI, entryLabelFromCI,
                          fastLabelFromCI, closureUpdReqd,
                          staticClosureNeedsLink
@@ -45,7 +46,7 @@ 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
@@ -145,7 +146,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
 
@@ -180,7 +181,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
@@ -215,9 +216,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
@@ -257,11 +266,14 @@ Now the individual AbstractC statements.
 
 \end{code}
 
-Split markers are a NOP in this land.
+Split markers just insert a __stg_split_marker, which is caught by the
+split-mangler later on and used to split the assembly into chunks.
 
 \begin{code}
 
- gencode CSplitMarker = returnUs id
+ gencode CSplitMarker
+   | opt_EnsureSplittableC = returnUs (\xs -> StLabel mkSplitMarkerLabel : xs)
+   | otherwise             = returnUs id
 
 \end{code}
 
@@ -336,22 +348,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], 
@@ -462,7 +474,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"
@@ -494,12 +506,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)))
@@ -543,8 +557,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