X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeAsm.lhs;h=f048b9f81d25fbd66a678fc109a03ca0bb847614;hb=98e1486635c889e023097d63da0c9b68393de1fd;hp=28263f9f74598c9e9da3b0c7839ddf8a4d456434;hpb=b067bdc33ce1a0bb01957b0bcfbb1c516dba53a4;p=ghc-hetmet.git

diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index 28263f9..f048b9f 100644
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/compiler/ghci/ByteCodeAsm.lhs
@@ -46,7 +46,7 @@ import Data.Bits
 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(..) )
 
@@ -71,13 +71,15 @@ data UnlinkedBCO
 	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
@@ -153,13 +155,12 @@ assembleBCO (ProtoBCO nm instrs bitmap bsize arity origin malloced)
              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
@@ -167,9 +168,9 @@ assembleBCO (ProtoBCO nm instrs bitmap bsize arity origin malloced)
          -- 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
@@ -299,6 +300,10 @@ mkBits findLabel st proto_insns
                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
@@ -448,6 +453,7 @@ instrSize16s instr
         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