[project @ 2003-06-27 18:28:31 by sof]
[ghc-hetmet.git] / ghc / compiler / absCSyn / AbsCUtils.lhs
index 02a1d31..ac75ca1 100644 (file)
@@ -38,6 +38,7 @@ import SMRep          ( arrPtrsHdrSize, arrWordsHdrSize, fixedHdrSize )
 import Outputable
 import Panic           ( panic )
 import FastTypes
+import Constants       ( wORD_SIZE, wORD_SIZE_IN_BITS )
 
 import Maybe           ( isJust )
 
@@ -144,7 +145,6 @@ magicIdPrimRep (FloatReg _)     = FloatRep
 magicIdPrimRep (DoubleReg _)       = DoubleRep
 magicIdPrimRep (LongReg kind _)            = kind
 magicIdPrimRep Sp                  = PtrRep
-magicIdPrimRep Su                  = PtrRep
 magicIdPrimRep SpLim               = PtrRep
 magicIdPrimRep Hp                  = PtrRep
 magicIdPrimRep HpLim               = PtrRep
@@ -320,11 +320,10 @@ flatAbsC (AbsCStmts s1 s2)
     returnFlt (mkAbsCStmts inline_s1 inline_s2,
               mkAbsCStmts top_s1    top_s2)
 
-flatAbsC (CClosureInfoAndCode cl_info slow maybe_fast descr)
-  = flatAbsC slow              `thenFlt` \ (slow_heres, slow_tops) ->
-    flat_maybe maybe_fast      `thenFlt` \ (fast_heres, fast_tops) ->
-    returnFlt (AbsCNop, mkAbstractCs [slow_tops, fast_tops,
-       CClosureInfoAndCode cl_info slow_heres fast_heres descr]
+flatAbsC (CClosureInfoAndCode cl_info entry)
+  = flatAbsC entry             `thenFlt` \ (entry_heres, entry_tops) ->
+    returnFlt (AbsCNop, mkAbstractCs [entry_tops, 
+       CClosureInfoAndCode cl_info entry_heres]
     )
 
 flatAbsC (CCodeBlock lbl abs_C)
@@ -418,10 +417,11 @@ flatAbsC (CSequential abcs)
 
 -- Some statements only make sense at the top level, so we always float
 -- them.  This probably isn't necessary.
-flatAbsC stmt@(CStaticClosure _ _ _)           = returnFlt (AbsCNop, stmt)
+flatAbsC stmt@(CStaticClosure _ _ _ _)                 = returnFlt (AbsCNop, stmt)
 flatAbsC stmt@(CClosureTbl _)                  = returnFlt (AbsCNop, stmt)
 flatAbsC stmt@(CSRT _ _)                       = returnFlt (AbsCNop, stmt)
-flatAbsC stmt@(CBitmap _ _)                    = returnFlt (AbsCNop, stmt)
+flatAbsC stmt@(CSRTDesc _ _ _ _ _)             = returnFlt (AbsCNop, stmt)
+flatAbsC stmt@(CBitmap _)                      = returnFlt (AbsCNop, stmt)
 flatAbsC stmt@(CCostCentreDecl _ _)            = returnFlt (AbsCNop, stmt)
 flatAbsC stmt@(CCostCentreStackDecl _)         = returnFlt (AbsCNop, stmt)
 flatAbsC stmt@(CSplitMarker)                   = returnFlt (AbsCNop, stmt)
@@ -607,27 +607,24 @@ rrConflictsWithRR s1b s2b rr1 rr2 = rr rr1 rr2
 -- why it needs to take into account endianness.
 --
 mkHalfWord_HIADDR res arg
-   = mkTemp IntRep                     `thenFlt` \ t_hw_shift ->
-     mkTemp WordRep                    `thenFlt` \ t_hw_mask1 ->
+   = mkTemp WordRep                    `thenFlt` \ t_hw_mask1 ->
      mkTemp WordRep                    `thenFlt` \ t_hw_mask2 ->
-     let a_hw_shift 
-            = CMachOpStmt t_hw_shift
-                          MO_Nat_Shl [CBytesPerWord, CLit (mkMachInt 2)] Nothing
+     let 
+        hw_shift = mkIntCLit (wORD_SIZE_IN_BITS `quot` 2)
+
          a_hw_mask1
             = CMachOpStmt t_hw_mask1
-                          MO_Nat_Shl [CLit (mkMachWord 1), t_hw_shift] Nothing
+                          MO_Nat_Shl [CLit (mkMachWord 1), hw_shift] Nothing
          a_hw_mask2
             = CMachOpStmt t_hw_mask2
                           MO_Nat_Sub [t_hw_mask1, CLit (mkMachWord 1)] Nothing
          final
 #        if WORDS_BIGENDIAN
-            = CSequential [ a_hw_shift, a_hw_mask1, a_hw_mask2,
+            = CSequential [ a_hw_mask1, a_hw_mask2,
                  CMachOpStmt res MO_Nat_And [arg, t_hw_mask2] Nothing
               ]
 #        else
-            = CSequential [ a_hw_shift,
-                 CMachOpStmt res MO_Nat_Shr [arg, t_hw_shift] Nothing
-              ]
+            = CMachOpStmt res MO_Nat_Shr [arg, hw_shift] Nothing
 #        endif
      in
          returnFlt final
@@ -728,19 +725,6 @@ translateOp_dyadic_cast1 mop res cast_arg1_to arg1 arg2 vols
            (if isDefinitelyInlineMachOp mop then Nothing else Just vols)
      ]
 
-getBitsPerWordMinus1 :: FlatM (AbstractC, CAddrMode)
-getBitsPerWordMinus1
-   = mkTemps [IntRep, IntRep]          `thenFlt` \ [t1,t2] ->
-     returnFlt (
-        CSequential [
-           CMachOpStmt t1 MO_Nat_Shl 
-                       [CBytesPerWord, CLit (mkMachInt 3)] Nothing,
-           CMachOpStmt t2 MO_Nat_Sub
-                       [t1, CLit (mkMachInt 1)] Nothing
-        ],
-        t2
-     )
-
 -- IA64 mangler doesn't place tables next to code
 tablesNextToCode :: Bool
 #ifdef ia64_TARGET_ARCH
@@ -792,15 +776,14 @@ dscCOpStmt [res_r,res_c] IntAddCOp [aa,bb] vols
    c  = t4 >>unsigned BITS_IN(I_)-1
 -}
    = mkTemps [IntRep,IntRep,IntRep,IntRep]     `thenFlt` \ [t1,t2,t3,t4] ->
-     getBitsPerWordMinus1                      `thenFlt` \ (bpw1_code,bpw1_t) ->
+     let bpw1 = mkIntCLit (wORD_SIZE_IN_BITS - 1) in
      (returnFlt . CSequential) [
         CMachOpStmt res_r MO_Nat_Add [aa,bb] Nothing,
         CMachOpStmt t1 MO_Nat_Xor [aa,bb] Nothing,
         CMachOpStmt t2 MO_Nat_Not [t1] Nothing,
         CMachOpStmt t3 MO_Nat_Xor [aa,res_r] Nothing,
         CMachOpStmt t4 MO_Nat_And [t2,t3] Nothing,
-        bpw1_code,
-        CMachOpStmt res_c MO_Nat_Shr [t4, bpw1_t] Nothing
+        CMachOpStmt res_c MO_Nat_Shr [t4, bpw1] Nothing
      ]
 
 
@@ -820,14 +803,13 @@ dscCOpStmt [res_r,res_c] IntSubCOp [aa,bb] vols
    c  = t3 >>unsigned BITS_IN(I_)-1
 -}
    = mkTemps [IntRep,IntRep,IntRep]            `thenFlt` \ [t1,t2,t3] ->
-     getBitsPerWordMinus1                      `thenFlt` \ (bpw1_code,bpw1_t) ->
+     let bpw1 = mkIntCLit (wORD_SIZE_IN_BITS - 1) in
      (returnFlt . CSequential) [
         CMachOpStmt res_r MO_Nat_Sub [aa,bb] Nothing,
         CMachOpStmt t1 MO_Nat_Xor [aa,bb] Nothing,
         CMachOpStmt t2 MO_Nat_Xor [aa,res_r] Nothing,
         CMachOpStmt t3 MO_Nat_And [t1,t2] Nothing,
-        bpw1_code,
-        CMachOpStmt res_c MO_Nat_Shr [t3, bpw1_t] Nothing
+        CMachOpStmt res_c MO_Nat_Shr [t3, bpw1] Nothing
      ]
 
 
@@ -866,7 +848,7 @@ dscCOpStmt [res] SizeofByteArrayOp [arg] vols
    = mkTemp WordRep                    `thenFlt` \ w ->
      (returnFlt . CSequential) [
         CAssign w (mkDerefOff WordRep arg fixedHdrSize),
-        CMachOpStmt w MO_NatU_Mul [w, CBytesPerWord] (Just vols),
+        CMachOpStmt w MO_NatU_Mul [w, mkIntCLit wORD_SIZE] (Just vols),
         CAssign res w
      ]