X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FByteCodeGen.lhs;h=5d1bd27ca8a9054ca3be670d3d63d7e05ae85407;hp=8a4b5e29a959368906745aa90192d046e4745e65;hb=6e9c0431a7cf2bf1a48f01db48c6a1d41fe15a09;hpb=b0046dd679244886fdc62e5cc2a73128d2e018bb

diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index 8a4b5e2..5d1bd27 100644
--- a/compiler/ghci/ByteCodeGen.lhs
+++ b/compiler/ghci/ByteCodeGen.lhs
@@ -438,7 +438,7 @@ schemeE d s p (AnnLet binds (_,body))
 
 	 compile_bind d' fvs x rhs size arity off = do
 		bco <- schemeR fvs (x,rhs)
-		build_thunk (fromIntegral d') fvs size bco off arity
+		build_thunk d' fvs size bco off arity
 
 	 compile_binds = 
 	    [ compile_bind d' fvs x rhs size arity n
@@ -844,6 +844,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
            = DiscrP (fromIntegral (dataConTag dc - fIRST_TAG))
         my_discr (LitAlt l, _, _)
            = case l of MachInt i     -> DiscrI (fromInteger i)
+                       MachWord w    -> DiscrW (fromInteger w)
                        MachFloat r   -> DiscrF (fromRational r)
                        MachDouble r  -> DiscrD (fromRational r)
                        MachChar i    -> DiscrI (ord i)
@@ -1027,14 +1028,15 @@ generateCCall d0 s p (CCallSpec target cconv _) fn args_r_to_l
             = case target of
                  DynamicTarget
                     -> return (False, panic "ByteCodeGen.generateCCall(dyn)")
-                 StaticTarget target
+
+                 StaticTarget target _
                     -> do res <- ioToBc (lookupStaticPtr stdcall_adj_target)
                           return (True, res)
                    where
                       stdcall_adj_target
 #ifdef mingw32_TARGET_OS
                           | StdCallConv <- cconv
-                          = let size = a_reps_sizeW * wORD_SIZE in
+                          = let size = fromIntegral a_reps_sizeW * wORD_SIZE in
                             mkFastString (unpackFS target ++ '@':show size)
 #endif
                           | otherwise
@@ -1203,7 +1205,7 @@ pushAtom d p (AnnVar v)
    = return (unitOL (PUSH_PRIMOP primop), 1)
 
    | Just d_v <- lookupBCEnv_maybe p v  -- v is a local variable
-   = let l = d - fromIntegral d_v + sz - 2
+   = let l = d - d_v + sz - 2
      in return (toOL (genericReplicate sz (PUSH_L l)), sz)
 	 -- d - d_v 		    the number of words between the TOS 
 	 --			    and the 1st slot of the object
@@ -1334,6 +1336,10 @@ mkMultiBranch maybe_ncons raw_ways
                             \(DiscrI i) fail_label -> TESTEQ_I i fail_label,
                             DiscrI minBound,
                             DiscrI maxBound );
+              DiscrW _ -> ( \(DiscrW i) fail_label -> TESTLT_W i fail_label,
+                            \(DiscrW i) fail_label -> TESTEQ_W i fail_label,
+                            DiscrW minBound,
+                            DiscrW maxBound );
               DiscrF _ -> ( \(DiscrF f) fail_label -> TESTLT_F f fail_label,
                             \(DiscrF f) fail_label -> TESTEQ_F f fail_label,
                             DiscrF minF,
@@ -1356,6 +1362,7 @@ mkMultiBranch maybe_ncons raw_ways
                  Nothing -> (minBound, maxBound)
 
          (DiscrI i1) `eqAlt` (DiscrI i2) = i1 == i2
+         (DiscrW w1) `eqAlt` (DiscrW w2) = w1 == w2
          (DiscrF f1) `eqAlt` (DiscrF f2) = f1 == f2
          (DiscrD d1) `eqAlt` (DiscrD d2) = d1 == d2
          (DiscrP i1) `eqAlt` (DiscrP i2) = i1 == i2
@@ -1363,6 +1370,7 @@ mkMultiBranch maybe_ncons raw_ways
          _           `eqAlt` _           = False
 
          (DiscrI i1) `leAlt` (DiscrI i2) = i1 <= i2
+         (DiscrW w1) `leAlt` (DiscrW w2) = w1 <= w2
          (DiscrF f1) `leAlt` (DiscrF f2) = f1 <= f2
          (DiscrD d1) `leAlt` (DiscrD d2) = d1 <= d2
          (DiscrP i1) `leAlt` (DiscrP i2) = i1 <= i2
@@ -1373,6 +1381,7 @@ mkMultiBranch maybe_ncons raw_ways
          isNoDiscr _       = False
 
          dec (DiscrI i) = DiscrI (i-1)
+         dec (DiscrW w) = DiscrW (w-1)
          dec (DiscrP i) = DiscrP (i-1)
          dec other      = other		-- not really right, but if you
 		-- do cases on floating values, you'll get what you deserve
@@ -1394,6 +1403,7 @@ mkMultiBranch maybe_ncons raw_ways
 -- Describes case alts
 data Discr 
    = DiscrI Int
+   | DiscrW Word
    | DiscrF Float
    | DiscrD Double
    | DiscrP Word16
@@ -1401,6 +1411,7 @@ data Discr
 
 instance Outputable Discr where
    ppr (DiscrI i) = int i
+   ppr (DiscrW w) = text (show w)
    ppr (DiscrF f) = text (show f)
    ppr (DiscrD d) = text (show d)
    ppr (DiscrP i) = ppr i
@@ -1534,7 +1545,10 @@ recordItblMallocBc a
 
 getLabelBc :: BcM Word16
 getLabelBc
-  = BcM $ \st -> return (st{nextlabel = 1 + nextlabel st}, nextlabel st)
+  = BcM $ \st -> do let nl = nextlabel st
+                    when (nl == maxBound) $
+                        panic "getLabelBc: Ran out of labels"
+                    return (st{nextlabel = nl + 1}, nl)
 
 getLabelsBc :: Word16 -> BcM [Word16]
 getLabelsBc n