From 0328da2d1c6b4a6ee41a4bd2aa7caee888195317 Mon Sep 17 00:00:00 2001
From: Bernhard Urban <lewurm@gmail.com>
Date: Tue, 4 Sep 2012 19:18:14 +0200
Subject: [PATCH] basiblock: remove `markBackwardTargets'

... and fold it into `calculateInstructionOffsets', using state monad power.
I added an older testcase, as it forces this situation. However, it won't fail
when removing this feature, but it would lead to code duplication on basicblock
level.
---
 Mate/BasicBlocks.hs | 35 ++++++++++++-----------------------
 tests/FacOld.java   | 19 +++++++++++++++++++
 2 files changed, 31 insertions(+), 23 deletions(-)
 create mode 100644 tests/FacOld.java

diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs
index e812820..7fefb60 100644
--- a/Mate/BasicBlocks.hs
+++ b/Mate/BasicBlocks.hs
@@ -119,26 +119,7 @@ buildCFG :: [Instruction] -> MapBB
 buildCFG xs = buildCFG' M.empty xs' xs'
   where
   xs' :: [OffIns]
-  xs' = evalState (calculateInstructionOffset xs >>= markBackwardTargets) []
-
--- get already calculated jmp-targets and mark the predecessor of the
--- target-instruction as "FallThrough". we just care about backwards
--- jumps here (forward jumps are handled in buildCFG')
-markBackwardTargets :: [OffIns] -> AnalyseState
-markBackwardTargets [] = return []
-markBackwardTargets (x:[]) = return [x]
-markBackwardTargets (x@(x_off,x_bbend,x_ins):y@(y_off,_,_):xs) = do
-  rest <- markBackwardTargets (y:xs)
-  targets <- get
-  let isTarget = y_off `elem` targets
-      x_new = case x_bbend of
-        Just _ -> x -- already marked, don't change
-        Nothing -> if isTarget then checkX y_off else x
-      checkX w16 = case x_bbend of
-        Nothing -> (x_off, Just $ FallThrough w16, x_ins) -- mark previous insn
-        _ -> error "basicblock: something is wrong"
-  return $ x_new:rest
-
+  xs' = evalState (calculateInstructionOffset xs) []
 
 
 buildCFG' :: MapBB -> [OffIns] -> [OffIns] -> MapBB
@@ -205,8 +186,15 @@ calculateInstructionOffset = cio' (0, Nothing, NOP)
         IRETURN -> notarget
         ARETURN -> notarget
         RETURN -> notarget
-        _ -> ((off, Nothing, x):) <$> next
+        _ -> normalins
       where
+        normalins = do
+          tailinsns <- next -- eval remaining instructions
+          isNextInsATarget <- (elem newoffset) <$> get
+          let bbtyp = if isNextInsATarget
+                then Just $ FallThrough newoffset
+                else Nothing
+          return $ (off, bbtyp, x):tailinsns
         notarget = ((off, Just Return, x):) <$> next
         onetarget w16 = do
           let jump = off `addW16Signed` w16
@@ -218,8 +206,9 @@ calculateInstructionOffset = cio' (0, Nothing, NOP)
           let jump = off `addW16Signed` w16
           modify (jump:)
           ((off, Just $ TwoTarget nojump jump, x):) <$> next
-        next = cio' newoffset xs
-        newoffset = (off + insnLength x, Nothing, NOP)
+        next = cio' nextins xs
+        nextins = (newoffset, Nothing, NOP)
+        newoffset = off + insnLength x
 
 -- TODO(bernhard): does GHC memomize results? i.e. does it calculate the size
 --                 of `NOP' only once?
diff --git a/tests/FacOld.java b/tests/FacOld.java
new file mode 100644
index 0000000..22a4522
--- /dev/null
+++ b/tests/FacOld.java
@@ -0,0 +1,19 @@
+package tests;
+
+public class FacOld {
+	public static void main(String args[]) {
+		for (int i = 0; i < 10; i++) {
+			fac(i);
+			System.out.printf("fac(%d): 0x%08x\n", i, fac(i));
+		}
+	}
+
+	public static int fac(int a) {
+		int b = 1;
+		while (a > 0) {
+			b *= a;
+			a--;
+		}
+		return b;
+	}
+}
-- 
2.25.1