\begin{code}
{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module ByteCodeAsm (
assembleBCOs, assembleBCO,
import Data.Int ( Int64 )
import Data.Char ( ord )
-import GHC.Base ( ByteArray# )
+import GHC.Base ( ByteArray#, MutableByteArray#, RealWorld )
import GHC.IOBase ( IO(..) )
import GHC.Ptr ( Ptr(..) )
unlinkedBCOInstrs :: ByteArray#, -- insns
unlinkedBCOBitmap :: ByteArray#, -- bitmap
unlinkedBCOLits :: (SizedSeq BCONPtr), -- non-ptrs
- unlinkedBCOPtrs :: (SizedSeq BCOPtr) -- ptrs
+ unlinkedBCOPtrs :: (SizedSeq BCOPtr) -- ptrs
}
data BCOPtr
= BCOPtrName Name
| BCOPtrPrimOp PrimOp
| BCOPtrBCO UnlinkedBCO
+ | BCOPtrBreakInfo BreakInfo
+ | BCOPtrArray (MutableByteArray# RealWorld)
data BCONPtr
= BCONPtrWord Word
insns_arr
| n_insns > 65535 = panic "linkBCO: >= 64k insns in BCO"
| otherwise = mkInstrArray n_insns asm_insns
- insns_barr = case insns_arr of UArray _lo _hi barr -> barr
+ insns_barr = case insns_arr of UArray _lo _hi _n barr -> barr
bitmap_arr = mkBitmapArray bsize bitmap
- bitmap_barr = case bitmap_arr of UArray _lo _hi barr -> barr
+ bitmap_barr = case bitmap_arr of UArray _lo _hi _n barr -> barr
- let ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits
- final_ptrs
+ let ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits final_ptrs
-- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
-- objects, since they might get run too early. Disable this until
-- when (notNull malloced) (addFinalizer ul_bco (mapM_ zonk malloced))
return ul_bco
- where
- zonk ptr = do -- putStrLn ("freeing malloc'd block at " ++ show (A# a#))
- free ptr
+ -- where
+ -- zonk ptr = do -- putStrLn ("freeing malloc'd block at " ++ show (A# a#))
+ -- free ptr
mkBitmapArray :: Int -> [StgWord] -> UArray Int StgWord
mkBitmapArray bsize bitmap
SLIDE n by -> instr3 st bci_SLIDE n by
ALLOC_AP n -> instr2 st bci_ALLOC_AP n
+ ALLOC_AP_NOUPD n -> instr2 st bci_ALLOC_AP_NOUPD n
ALLOC_PAP arity n -> instr3 st bci_ALLOC_PAP arity n
MKAP off sz -> instr3 st bci_MKAP off sz
MKPAP off sz -> instr3 st bci_MKPAP off sz
RETURN_UBX rep -> instr1 st (return_ubx rep)
CCALL off m_addr -> do (np, st2) <- addr st m_addr
instr3 st2 bci_CCALL off np
+ BRK_FUN array index info -> do
+ (p1, st2) <- ptr st (BCOPtrArray array)
+ (p2, st3) <- ptr st2 (BCOPtrBreakInfo info)
+ instr4 st3 bci_BRK_FUN p1 index p2
i2s :: Int -> Word16
i2s = fromIntegral
PUSH_APPLY_PPPPPP{} -> 1
SLIDE{} -> 3
ALLOC_AP{} -> 2
+ ALLOC_AP_NOUPD{} -> 2
ALLOC_PAP{} -> 3
MKAP{} -> 3
MKPAP{} -> 3
RETURN_UBX{} -> 1
CCALL{} -> 3
SWIZZLE{} -> 3
+ BRK_FUN{} -> 4
-- Make lists of host-sized words for literals, so that when the
-- words are placed in memory at increasing addresses, the