[commit: ghc] master: Fix BCO bitmap generation on 32-bit platforms (#8377) (3bd7861)

git at git.haskell.org git at git.haskell.org
Mon Sep 30 00:23:31 CEST 2013


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/3bd786147fc9eff8d03ec9ac2697ada826282b08/ghc

>---------------------------------------------------------------

commit 3bd786147fc9eff8d03ec9ac2697ada826282b08
Author: Takano Akio <aljee at hyper.cx>
Date:   Sat Sep 28 17:45:47 2013 +0900

    Fix BCO bitmap generation on 32-bit platforms (#8377)
    
    On 32-bit platforms, the bitmap should be an array of
    32-bit words, not Word64s.
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>


>---------------------------------------------------------------

3bd786147fc9eff8d03ec9ac2697ada826282b08
 compiler/cmm/SMRep.lhs        |   40 ----------------------------------------
 compiler/ghci/ByteCodeAsm.lhs |   20 +++++++++-----------
 2 files changed, 9 insertions(+), 51 deletions(-)

diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs
index c54f6d5..0185aba 100644
--- a/compiler/cmm/SMRep.lhs
+++ b/compiler/cmm/SMRep.lhs
@@ -16,11 +16,6 @@ module SMRep (
         WordOff, ByteOff,
         roundUpToWords,
 
-#if __GLASGOW_HASKELL__ > 706
-        -- ** Immutable arrays of StgWords
-        UArrayStgWord, listArray, toByteArray,
-#endif
-
         -- * Closure repesentation
         SMRep(..), -- CmmInfo sees the rep; no one else does
         IsStatic,
@@ -54,12 +49,6 @@ import DynFlags
 import Outputable
 import Platform
 import FastString
-import qualified Data.Array.Base as Array
-
-#if __GLASGOW_HASKELL__ > 706
-import GHC.Base ( ByteArray# )
-import Data.Ix
-#endif
 
 import Data.Char( ord )
 import Data.Word
@@ -90,10 +79,6 @@ newtype StgWord = StgWord Word64
 #if __GLASGOW_HASKELL__ < 706
               Num,
 #endif
-
-#if __GLASGOW_HASKELL__ <= 706
-              Array.IArray Array.UArray,
-#endif
               Bits)
 
 fromStgWord :: StgWord -> Integer
@@ -141,31 +126,6 @@ hALF_WORD_SIZE_IN_BITS dflags = platformWordSize (targetPlatform dflags) `shiftL
 
 %************************************************************************
 %*                                                                      *
-                Immutable arrays of StgWords
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
-
-#if __GLASGOW_HASKELL__ > 706
--- TODO: Improve with newtype coercions!
-
-newtype UArrayStgWord i = UArrayStgWord (Array.UArray i Word64)
-
-listArray :: Ix i => (i, i) -> [StgWord] -> UArrayStgWord i
-listArray (i,j) words
-  = UArrayStgWord $ Array.listArray (i,j) (map unStgWord words)
-  where unStgWord (StgWord w64) = w64
-
-toByteArray :: UArrayStgWord i -> ByteArray#
-toByteArray (UArrayStgWord (Array.UArray _ _ _ b)) = b
-
-#endif
-
-\end{code}
-
-%************************************************************************
-%*                                                                      *
 \subsubsection[SMRep-datatype]{@SMRep at ---storage manager representation}
 %*                                                                      *
 %************************************************************************
diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index 7e5ef35..9ec783a 100644
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/compiler/ghci/ByteCodeAsm.lhs
@@ -167,8 +167,8 @@ assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = d
       insns_arr = Array.listArray (0, n_insns - 1) asm_insns
       !insns_barr = barr insns_arr
 
-      bitmap_arr = mkBitmapArray dflags bsize bitmap
-      !bitmap_barr = toByteArray bitmap_arr
+      bitmap_arr = mkBitmapArray bsize bitmap
+      !bitmap_barr = barr bitmap_arr
 
       ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits final_ptrs
 
@@ -179,15 +179,13 @@ assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = d
 
   return ul_bco
 
-#if __GLASGOW_HASKELL__ > 706
-mkBitmapArray :: DynFlags -> Word16 -> [StgWord] -> UArrayStgWord Int
-mkBitmapArray dflags bsize bitmap
-  = SMRep.listArray (0, length bitmap) (toStgWord dflags (toInteger bsize) : bitmap)
-#else
-mkBitmapArray :: DynFlags -> Word16 -> [StgWord] -> UArray Int StgWord
-mkBitmapArray dflags bsize bitmap
-  = Array.listArray (0, length bitmap) (toStgWord dflags (toInteger bsize) : bitmap)
-#endif
+mkBitmapArray :: Word16 -> [StgWord] -> UArray Int Word
+-- Here the return type must be an array of Words, not StgWords,
+-- because the underlying ByteArray# will end up as a component
+-- of a BCO object.
+mkBitmapArray bsize bitmap
+  = Array.listArray (0, length bitmap) $
+      fromIntegral bsize : map (fromInteger . fromStgWord) bitmap
 
 -- instrs nonptrs ptrs
 type AsmState = (SizedSeq Word16,




More information about the ghc-commits mailing list