instr2Large st2 bci_TESTLT_I np (findLabel l)
TESTEQ_I i l -> do (np, st2) <- int st i
instr2Large st2 bci_TESTEQ_I np (findLabel l)
+ TESTLT_W w l -> do (np, st2) <- word st w
+ instr2Large st2 bci_TESTLT_W np (findLabel l)
+ TESTEQ_W w l -> do (np, st2) <- word st w
+ instr2Large st2 bci_TESTEQ_W np (findLabel l)
TESTLT_F f l -> do (np, st2) <- float st f
instr2Large st2 bci_TESTLT_F np (findLabel l)
TESTEQ_F f l -> do (np, st2) <- float st f
st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
return (sizeSS16 st_l0, (st_i0,st_l1,st_p0))
+ word (st_i0,st_l0,st_p0) w
+ = do let ws = [w]
+ st_l1 <- addListToSS st_l0 (map BCONPtrWord ws)
+ 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)
LABEL{} -> 0 -- !!
TESTLT_I{} -> 3
TESTEQ_I{} -> 3
+ TESTLT_W{} -> 3
+ TESTEQ_W{} -> 3
TESTLT_F{} -> 3
TESTEQ_F{} -> 3
TESTLT_D{} -> 3
= 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)
\(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,
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
_ `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
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
-- Describes case alts
data Discr
= DiscrI Int
+ | DiscrW Word
| DiscrF Float
| DiscrD Double
| DiscrP Word16
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
| LABEL LocalLabel
| TESTLT_I Int LocalLabel
| TESTEQ_I Int LocalLabel
+ | TESTLT_W Word LocalLabel
+ | TESTEQ_W Word LocalLabel
| TESTLT_F Float LocalLabel
| TESTEQ_F Float LocalLabel
| TESTLT_D Double LocalLabel
ppr (LABEL lab) = text "__" <> ppr lab <> colon
ppr (TESTLT_I i lab) = text "TESTLT_I" <+> int i <+> text "__" <> ppr lab
ppr (TESTEQ_I i lab) = text "TESTEQ_I" <+> int i <+> text "__" <> ppr lab
+ ppr (TESTLT_W i lab) = text "TESTLT_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
+ ppr (TESTEQ_W i lab) = text "TESTEQ_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
ppr (TESTLT_F f lab) = text "TESTLT_F" <+> float f <+> text "__" <> ppr lab
ppr (TESTEQ_F f lab) = text "TESTEQ_F" <+> float f <+> text "__" <> ppr lab
ppr (TESTLT_D d lab) = text "TESTLT_D" <+> double d <+> text "__" <> ppr lab
bciStackUse LABEL{} = 0
bciStackUse TESTLT_I{} = 0
bciStackUse TESTEQ_I{} = 0
+bciStackUse TESTLT_W{} = 0
+bciStackUse TESTEQ_W{} = 0
bciStackUse TESTLT_F{} = 0
bciStackUse TESTEQ_F{} = 0
bciStackUse TESTLT_D{} = 0
#define bci_RETURN_L 52
#define bci_RETURN_V 53
#define bci_BRK_FUN 54
+#define bci_TESTLT_W 55
+#define bci_TESTEQ_W 56
/* If you need to go past 255 then you will run into the flags */
/* If you need to go below 0x0100 then you will run into the instructions */
goto nextInsn;
}
+ case bci_TESTLT_W: {
+ // There should be an Int at Sp[1], and an info table at Sp[0].
+ int discr = BCO_NEXT;
+ int failto = BCO_GET_LARGE_ARG;
+ W_ stackWord = (W_)Sp[1];
+ if (stackWord >= (W_)BCO_LIT(discr))
+ bciPtr = failto;
+ goto nextInsn;
+ }
+
+ case bci_TESTEQ_W: {
+ // There should be an Int at Sp[1], and an info table at Sp[0].
+ int discr = BCO_NEXT;
+ int failto = BCO_GET_LARGE_ARG;
+ W_ stackWord = (W_)Sp[1];
+ if (stackWord != (W_)BCO_LIT(discr)) {
+ bciPtr = failto;
+ }
+ goto nextInsn;
+ }
+
case bci_TESTLT_D: {
// There should be a Double at Sp[1], and an info table at Sp[0].
int discr = BCO_NEXT;