X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeAsm.lhs;h=f690aa69903d268e2f0ab2d4b5e89a851adef10e;hb=6d92f8127b85a52a472b692c6fa40320432dd5a5;hp=5980810f88fcbe8c1b2191b336ac7aeac8e4fd89;hpb=a7e145c050bdf08e4f4dbe4dfa68f3f87dfdeef6;p=ghc-hetmet.git

diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index 5980810..f690aa6 100644
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/compiler/ghci/ByteCodeAsm.lhs
@@ -150,7 +150,7 @@ 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
+                 | otherwise = mkInstrArray (fromIntegral n_insns) asm_insns
              !insns_barr = case insns_arr of UArray _lo _hi _n barr -> barr
 
              bitmap_arr = mkBitmapArray bsize bitmap
@@ -181,7 +181,7 @@ type AsmState = (SizedSeq Word16,
                  SizedSeq BCONPtr,
                  SizedSeq BCOPtr)
 
-data SizedSeq a = SizedSeq !Word16 [a]
+data SizedSeq a = SizedSeq !Word [a]
 emptySS :: SizedSeq a
 emptySS = SizedSeq 0 []
 
@@ -195,9 +195,12 @@ addListToSS (SizedSeq n r_xs) xs
 ssElts :: SizedSeq a -> [a]
 ssElts (SizedSeq _ r_xs) = reverse r_xs
 
-sizeSS :: SizedSeq a -> Word16
+sizeSS :: SizedSeq a -> Word
 sizeSS (SizedSeq n _) = n
 
+sizeSS16 :: SizedSeq a -> Word16
+sizeSS16 (SizedSeq n _) = fromIntegral n
+
 -- Bring in all the bci_ bytecode constants.
 #include "Bytecodes.h"
 
@@ -336,39 +339,39 @@ mkBits findLabel st proto_insns
        float (st_i0,st_l0,st_p0) f
           = do let ws = mkLitF f
                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0))
+               return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
 
        double (st_i0,st_l0,st_p0) d
           = do let ws = mkLitD d
                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0))
+               return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
 
        int (st_i0,st_l0,st_p0) i
           = do let ws = mkLitI i
                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0))
+               return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
 
        int64 (st_i0,st_l0,st_p0) i
           = do let ws = mkLitI64 i
                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0))
+               return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
 
        addr (st_i0,st_l0,st_p0) a
           = do let ws = mkLitPtr a
                st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0))
+               return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
 
        litlabel (st_i0,st_l0,st_p0) fs
           = do st_l1 <- addListToSS st_l0 [BCONPtrLbl fs]
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0))
+               return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
 
        ptr (st_i0,st_l0,st_p0) p
           = do st_p1 <- addToSS st_p0 p
-               return (sizeSS st_p0, (st_i0,st_l0,st_p1))
+               return (sizeSS16 st_p0, (st_i0,st_l0,st_p1))
 
        itbl (st_i0,st_l0,st_p0) dcon
           = do st_l1 <- addToSS st_l0 (BCONPtrItbl (getName dcon))
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0))
+               return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
 
 #ifdef mingw32_TARGET_OS
        literal st (MachLabel fs (Just sz) _)