Permalink
Browse files

Add support for {le,lt,gt,ge,eq,ne}Word#.

  • Loading branch information...
nominolo committed Oct 18, 2012
1 parent 076c029 commit 05b629a9f1f0c319e3b4af885ebcd7045d11e35b
Showing with 141 additions and 19 deletions.
  1. +2 −1 Makefile.in
  2. +7 −0 compiler/Lambdachine/Ghc/CoreToBC.hs
  3. +46 −18 compiler/Lambdachine/Serialise.hs
  4. +18 −0 tests/Bc/WordCompare.hs
  5. +11 −0 vm/assembler.cc
  6. +5 −0 vm/bytecode.hh
  7. +28 −0 vm/capability.cc
  8. +8 −0 vm/ir.hh
  9. +12 −0 vm/jit.cc
  10. +4 −0 vm/unittest.cc
View
@@ -177,7 +177,8 @@ TEST_FILES := tests/Bc/Bc0016.lcbc tests/Bc/Bc0014.lcbc \
tests/Bc/MultiReturn.lcbc tests/Bc/MultiReturn2.lcbc \
tests/Bc/MultiReturn3.lcbc tests/Bc/MultiReturnJit.lcbc \
tests/Bc/UnpackCString.lcbc tests/Bc/Monoid.lcbc \
- tests/Bc/NopPrims.lcbc tests/Bc/NegateInt.lcbc
+ tests/Bc/NopPrims.lcbc tests/Bc/NegateInt.lcbc \
+ tests/Bc/WordCompare.lcbc
lcvm: $(VM_SRCS:.cc=.o) vm/main.o
@echo "LINK $(filter %.o %.a, $^) => $@"
@@ -1463,6 +1463,13 @@ isCondPrimOp primop =
Ghc.CharLtOp -> Just (CmpLt, CharTy)
Ghc.CharLeOp -> Just (CmpLe, CharTy)
+ Ghc.WordGtOp -> Just (CmpGt, WordTy)
+ Ghc.WordGeOp -> Just (CmpGe, WordTy)
+ Ghc.WordEqOp -> Just (CmpEq, WordTy)
+ Ghc.WordNeOp -> Just (CmpNe, WordTy)
+ Ghc.WordLtOp -> Just (CmpLt, WordTy)
+ Ghc.WordLeOp -> Just (CmpLe, WordTy)
+
_ -> Nothing
-- | View expression as n-ary application. The expression in function
@@ -487,24 +487,17 @@ putLinearIns lit_ids new_addrs ins_id ins = case ins of
Lst Update ->
putIns (insAD opc_UPDATE 0 1)
Lst (CondBranch cond ty (BcReg r1 _) (BcReg r2 _) t1 t2)
- | ty == IntTy || ty == CharTy
+ | ty == IntTy || ty == CharTy || ty == WordTy
-> do
let (swap_targets, target)
| t1 == ins_id + 1 = (True, t2)
| t2 == ins_id + 1 = (False, t1)
| otherwise = error "putLinearIns: CondBranch: No branch target adjacent"
cond' | swap_targets = invertCondition cond
| otherwise = cond
- condOpcode c = case c of
- CmpGt -> opc_ISGT
- CmpLe -> opc_ISLE
- CmpGe -> opc_ISGE
- CmpLt -> opc_ISLT
- CmpEq -> opc_ISEQ
- CmpNe -> opc_ISNE
next_ins_addr = (new_addrs IM.! ins_id) + 2
offs = (new_addrs IM.! target) - next_ins_addr
- putIns $ insAD (condOpcode cond') (i2b r1) (i2h r2)
+ putIns $ insAD (condOpcode ty cond') (i2b r1) (i2h r2)
putIns $ insAJ opc_JMP 0 offs
Mid (Assign (BcReg d _) (Move (BcReg s _))) | d == s ->
return () -- redundant move instruction
@@ -552,6 +545,27 @@ putLinearIns lit_ids new_addrs ins_id ins = case ins of
binOpOpcode IntTy OpDiv = opc_DIVRR
binOpOpcode IntTy OpRem = opc_REMRR
+ isSigned :: OpTy -> Bool
+ isSigned IntTy = True
+ isSigned CharTy = True
+ isSigned WordTy = False
+
+ condOpcode :: OpTy -> CmpOp -> Word8
+ condOpcode ty c | isSigned ty = case c of
+ CmpGt -> opc_ISGT
+ CmpLe -> opc_ISLE
+ CmpGe -> opc_ISGE
+ CmpLt -> opc_ISLT
+ CmpEq -> opc_ISEQ
+ CmpNe -> opc_ISNE
+ condOpcode ty c | otherwise = case c of
+ CmpGt -> opc_ISGTU
+ CmpLe -> opc_ISLEU
+ CmpGe -> opc_ISGEU
+ CmpLt -> opc_ISLTU
+ CmpEq -> opc_ISEQ
+ CmpNe -> opc_ISNE
+
-- | Encode a case instruction.
--
-- Assumes that the default case is fall-through.
@@ -941,7 +955,7 @@ emitLinearIns bit_r lit_ids tgt_labels r ins_id ins = do
Lst Update ->
emitInsAD r opc_UPDATE 0 1
Lst (CondBranch cond ty (BcReg r1 _) (BcReg r2 _) t1 t2)
- | ty == IntTy || ty == CharTy
+ | ty == IntTy || ty == CharTy || ty == WordTy
-> do
let (swap_targets, target)
| t1 == ins_id + 1 = (True, t2)
@@ -950,14 +964,7 @@ emitLinearIns bit_r lit_ids tgt_labels r ins_id ins = do
error "emitLinearIns: CondBranch: No branch target adjacent"
cond' | swap_targets = invertCondition cond
| otherwise = cond
- condOpcode c = case c of
- CmpGt -> opc_ISGT
- CmpLe -> opc_ISLE
- CmpGe -> opc_ISGE
- CmpLt -> opc_ISLT
- CmpEq -> opc_ISEQ
- CmpNe -> opc_ISNE
- emitInsAD r (condOpcode cond') (i2b r1) (i2h r2)
+ emitInsAD r (condOpcode ty cond') (i2b r1) (i2h r2)
emitInsAJ r opc_JMP 0 (tgt_labels IM.! target)
Mid (Assign (BcReg d _) (Move (BcReg s _))) | d == s ->
return () -- redundant move instruction
@@ -1012,6 +1019,27 @@ emitLinearIns bit_r lit_ids tgt_labels r ins_id ins = do
binOpOpcode IntTy OpDiv = opc_DIVRR
binOpOpcode IntTy OpRem = opc_REMRR
+ isSigned :: OpTy -> Bool
+ isSigned IntTy = True
+ isSigned CharTy = True
+ isSigned WordTy = False
+
+ condOpcode :: OpTy -> CmpOp -> Word8
+ condOpcode ty c | isSigned ty = case c of
+ CmpGt -> opc_ISGT
+ CmpLe -> opc_ISLE
+ CmpGe -> opc_ISGE
+ CmpLt -> opc_ISLT
+ CmpEq -> opc_ISEQ
+ CmpNe -> opc_ISNE
+ condOpcode ty c | otherwise = case c of
+ CmpGt -> opc_ISGTU
+ CmpLe -> opc_ISLEU
+ CmpGe -> opc_ISGEU
+ CmpLt -> opc_ISLTU
+ CmpEq -> opc_ISEQ
+ CmpNe -> opc_ISNE
+
-- | A call like
--
-- > putArgs (map BcReg [1..6])
View
@@ -0,0 +1,18 @@
+{-# LANGUAGE MagicHash, NoImplicitPrelude, UnboxedTuples, BangPatterns #-}
+module Bc.WordCompare where
+
+import GHC.Prim
+import GHC.Base
+
+loop :: Word# -> Int# -> Int#
+loop n x =
+ if n `leWord#` int2Word# 5#
+-- if word2Int# n <=# 5#
+ then x
+ else loop (int2Word# (word2Int# n +# 1#))
+ (x +# 1#)
+
+run :: Int# -> Bool
+run n = loop (int2Word# (0# -# n)) 0# ==# n
+
+test = run 10#
View
@@ -1222,6 +1222,17 @@ void Assembler::emit(IR *ins) {
compare(ins, asm_compmap[idx] & 15);
break;
}
+ case IR::kLTU:
+ case IR::kGEU:
+ case IR::kLEU:
+ case IR::kGTU: {
+ int idx = (int)ins->opcode() - (int)IR::kLTU;
+ LC_ASSERT(idx >= 0 && idx < countof(asm_compmap));
+ LC_ASSERT(buf_->snap(snapno_).ref() == curins_);
+ LC_ASSERT(ir(curins_) == ins);
+ compare(ins, (asm_compmap[idx] >> 4) & 15);
+ break;
+ }
case IR::kEQINFO:
itblGuard(ins);
break;
View
@@ -14,6 +14,11 @@ _START_LAMBDACHINE_NAMESPACE
_(ISGT, RRJ) \
_(ISEQ, RRJ) \
_(ISNE, RRJ) \
+ /* Unsigned comparisons, order significant */ \
+ _(ISLTU, RRJ) \
+ _(ISGEU, RRJ) \
+ _(ISLEU, RRJ) \
+ _(ISGTU, RRJ) \
/* Unary ops */ \
_(NOT, RR) \
_(NEG, RR) \
View
@@ -321,6 +321,34 @@ record: {
pc += (pc - 1)->j();
DISPATCH_NEXT;
+op_ISLTU:
+ DECODE_AD;
+ ++pc;
+ if ((Word)base[opA] < (Word)base[opC])
+ pc += (pc - 1)->j();
+ DISPATCH_NEXT;
+
+op_ISGEU:
+ DECODE_AD;
+ ++pc;
+ if ((Word)base[opA] >= (Word)base[opC])
+ pc += (pc - 1)->j();
+ DISPATCH_NEXT;
+
+op_ISLEU:
+ DECODE_AD;
+ ++pc;
+ if ((Word)base[opA] <= (Word)base[opC])
+ pc += (pc - 1)->j();
+ DISPATCH_NEXT;
+
+op_ISGTU:
+ DECODE_AD;
+ ++pc;
+ if ((Word)base[opA] > (Word)base[opC])
+ pc += (pc - 1)->j();
+ DISPATCH_NEXT;
+
op_ISEQ:
DECODE_AD;
++pc;
View
@@ -40,6 +40,10 @@ typedef u4 IRRef; /* Used to pass around references */
_(GT, G, ref, ref) \
_(EQ, G, ref, ref) \
_(NE, G, ref, ref) \
+ _(LTU, G, ref, ref) \
+ _(GEU, G, ref, ref) \
+ _(LEU, G, ref, ref) \
+ _(GTU, G, ref, ref) \
_(EQRET, G, ref, ref) \
_(EQINFO, G, ref, ref) \
_(HEAPCHK, S, lit, ___) \
@@ -970,11 +974,15 @@ inline int IRBuffer::numFields(HeapEntry entry) {
// Can invert condition by toggling lowest bit.
LC_STATIC_ASSERT((IR::kLT ^ 1) == IR::kGE);
LC_STATIC_ASSERT((IR::kGT ^ 1) == IR::kLE);
+LC_STATIC_ASSERT((IR::kLTU ^ 1) == IR::kGEU);
+LC_STATIC_ASSERT((IR::kGTU ^ 1) == IR::kLEU);
LC_STATIC_ASSERT((IR::kEQ ^ 1) == IR::kNE);
// Order of comparison operations matters. Same is enforced for bytecode.
LC_STATIC_ASSERT((IR::kLT & 1) == 0);
LC_STATIC_ASSERT((IR::kLT + 2) == IR::kLE);
LC_STATIC_ASSERT((IR::kLE + 2) == IR::kEQ);
+LC_STATIC_ASSERT((IR::kLTU & 1) == 0);
+LC_STATIC_ASSERT((IR::kLTU + 2) == IR::kLEU);
_END_LAMBDACHINE_NAMESPACE
View
@@ -226,6 +226,14 @@ static bool evalCond(BcIns::Opcode opc, Word left, Word right) {
return (WordInt)left == (WordInt)right;
case BcIns::kISNE:
return (WordInt)left != (WordInt)right;
+ case BcIns::kISLTU:
+ return (Word)left < (Word)right;
+ case BcIns::kISGEU:
+ return (Word)left >= (Word)right;
+ case BcIns::kISLEU:
+ return (Word)left <= (Word)right;
+ case BcIns::kISGTU:
+ return (Word)left > (Word)right;
default:
cerr << "FATAL: (REC) Cannot evaluate condition: " << (int)opc;
exit(2);
@@ -356,6 +364,10 @@ bool Jit::recordIns(BcIns *ins, Word *base, const Code *code) {
case BcIns::kISLT:
case BcIns::kISGE:
case BcIns::kISLE:
+ case BcIns::kISGTU:
+ case BcIns::kISLTU:
+ case BcIns::kISGEU:
+ case BcIns::kISLEU:
case BcIns::kISEQ:
case BcIns::kISNE: {
bool taken = evalCond(ins->opcode(), base[ins->a()], base[ins->d()]);
View
@@ -1109,6 +1109,10 @@ TEST_F(RunFileTest, NegateInt) {
run("Bc.NegateInt");
}
+TEST_F(RunFileTest, WordCompare) {
+ run("Bc.WordCompare");
+}
+
TEST(HotCounters, Simple) {
HotCounters counters(5);
BcIns pc[] = { BcIns::ad(BcIns::kFUNC, 3, 0) };

0 comments on commit 05b629a

Please sign in to comment.