projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
More modules that need LANGUAGE BangPatterns
[ghc-hetmet.git]
/
compiler
/
ghci
/
ByteCodeLink.lhs
diff --git
a/compiler/ghci/ByteCodeLink.lhs
b/compiler/ghci/ByteCodeLink.lhs
index
5e39fde
..
b1f7e39
100644
(file)
--- a/
compiler/ghci/ByteCodeLink.lhs
+++ b/
compiler/ghci/ByteCodeLink.lhs
@@
-4,6
+4,7
@@
ByteCodeLink: Bytecode assembler and linker
\begin{code}
ByteCodeLink: Bytecode assembler and linker
\begin{code}
+{-# LANGUAGE BangPatterns #-}
{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
{-# OPTIONS -w #-}
{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
{-# OPTIONS -w #-}
@@
-50,6
+51,8
@@
import GHC.Arr ( Array(..) )
import GHC.IOBase ( IO(..) )
import GHC.Ptr ( Ptr(..), castPtr )
import GHC.Base ( writeArray#, RealWorld, Int(..), Word# )
import GHC.IOBase ( IO(..) )
import GHC.Ptr ( Ptr(..), castPtr )
import GHC.Base ( writeArray#, RealWorld, Int(..), Word# )
+
+import Data.Word
\end{code}
\end{code}
@@
-117,13
+120,19
@@
linkBCO' ie ce (UnlinkedBCO nm arity insns_barr bitmap literalsSS ptrsSS)
let n_literals = sizeSS literalsSS
n_ptrs = sizeSS ptrsSS
let n_literals = sizeSS literalsSS
n_ptrs = sizeSS ptrsSS
- ptrs_arr <- mkPtrsArray ie ce n_ptrs ptrs
+ ptrs_arr <- if n_ptrs > 65535
+ then panic "linkBCO: >= 64k ptrs"
+ else mkPtrsArray ie ce (fromIntegral n_ptrs) ptrs
let
!ptrs_parr = case ptrs_arr of Array _lo _hi _n parr -> parr
let
!ptrs_parr = case ptrs_arr of Array _lo _hi _n parr -> parr
- literals_arr = listArray (0, n_literals-1) linked_literals
- :: UArray Int Word
+ litRange
+ | n_literals > 65535 = panic "linkBCO: >= 64k literals"
+ | n_literals > 0 = (0, fromIntegral n_literals - 1)
+ | otherwise = (1, 0)
+ literals_arr :: UArray Word16 Word
+ literals_arr = listArray litRange linked_literals
!literals_barr = case literals_arr of UArray _lo _hi _n barr -> barr
!(I# arity#) = arity
!literals_barr = case literals_arr of UArray _lo _hi _n barr -> barr
!(I# arity#) = arity
@@
-132,9
+141,10
@@
linkBCO' ie ce (UnlinkedBCO nm arity insns_barr bitmap literalsSS ptrsSS)
-- we recursively link any sub-BCOs while making the ptrs array
-- we recursively link any sub-BCOs while making the ptrs array
-mkPtrsArray :: ItblEnv -> ClosureEnv -> Int -> [BCOPtr] -> IO (Array Int HValue)
+mkPtrsArray :: ItblEnv -> ClosureEnv -> Word16 -> [BCOPtr] -> IO (Array Word16 HValue)
mkPtrsArray ie ce n_ptrs ptrs = do
mkPtrsArray ie ce n_ptrs ptrs = do
- marr <- newArray_ (0, n_ptrs-1)
+ let ptrRange = if n_ptrs > 0 then (0, n_ptrs-1) else (1, 0)
+ marr <- newArray_ ptrRange
let
fill (BCOPtrName n) i = do
ptr <- lookupName ce n
let
fill (BCOPtrName n) i = do
ptr <- lookupName ce n
@@
-165,7
+175,7
@@
instance MArray IOArray e IO where
unsafeWrite (IOArray marr) i e = stToIO (unsafeWrite marr i e)
-- XXX HACK: we should really have a new writeArray# primop that takes a BCO#.
unsafeWrite (IOArray marr) i e = stToIO (unsafeWrite marr i e)
-- XXX HACK: we should really have a new writeArray# primop that takes a BCO#.
-writeArrayBCO :: IOArray Int a -> Int -> BCO# -> IO ()
+writeArrayBCO :: IOArray Word16 a -> Int -> BCO# -> IO ()
writeArrayBCO (IOArray (STArray _ _ _ marr#)) (I# i#) bco# = IO $ \s# ->
case (unsafeCoerce# writeArray#) marr# i# bco# s# of { s# ->
(# s#, () #) }
writeArrayBCO (IOArray (STArray _ _ _ marr#)) (I# i#) bco# = IO $ \s# ->
case (unsafeCoerce# writeArray#) marr# i# bco# s# of { s# ->
(# s#, () #) }