Mate: exposed internal functions of BasicBlocks for external benchmarks

scratch: implemented kind of benchmark (non trustworthy currently)

diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs
index 14f89997b61caf1a93d3728d504ea5af99f7ae27..59e30521b5b33937262059169ea653d5b12dfd43 100644 (file)
--- a/Mate/BasicBlocks.hs
+++ b/Mate/BasicBlocks.hs
@@ -6,7 +6,8 @@ module Mate.BasicBlocks(
   MapBB,
   printMapBB,
   parseMethod,
-  test_main
+  test_main,
+  testCFG -- added by hs to perform benches from outside
   )where
 
 import Data.Binary

diff --git a/scratch/Bench.hs b/scratch/Bench.hs
new file mode 100644 (file)
index 0000000..1f930b3
--- /dev/null
+++ b/scratch/Bench.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import Frontend
+import Graph
+import Data.Maybe
+import Control.Monad.State
+import Data.Set as S
+import Control.Monad
+
+import Mate.BasicBlocks
+
+import JVM.ClassFile
+import JVM.Converter
+import JVM.Assembler
+
+import Mate.Utilities
+import qualified Data.ByteString.Lazy as B
+
+printG' :: Ord k => G k -> [k]
+printG' g = evalState (foldGM ((: []), (++)) (\node -> let (Just v) = value node in v) [] g) S.empty
+
+value (Node val _ _) = Just val
+value (Leaf val    ) = Just val
+value Nil            = Nothing
+
+
+main = do con@(Just (ins,cls)) <- getMethodIO "../tests/AbsurdlyHuge.class" "absurdlyHuge"
+          let perform' = do
+                          let method = "absurdlyHuge"
+                          let msig = methodSignature $ (classMethods cls) !! 1
+                          --B.putStrLn (method `B.append` ": " `B.append` (encode msig))
+                          let result = testCFG $ lookupMethod method cls
+                          printMapBB result
+          let perform = do
+                 let tagged = getInstructions ins
+                 let backRefs = splitBlocksBackRef tagged
+                 let splitted = splitBlocks backRefs tagged
+                 let transitions = getTransitions splitted
+                 let nodes       = getNodes splitted
+                 --print "nodes:"
+                 --print nodes
+                 --print "transitions"
+                 --print transitions
+                 let (Just finalCyclicStructure) = indirectCFGToG splitted
+                 print "Final result"
+                 print $ printG' finalCyclicStructure
+          forM_ [0..100] (\x -> do perform)
+
+

diff --git a/scratch/Frontend.hs b/scratch/Frontend.hs
index 66b3cb96ac140d20d4901cd792989f8e9b804a64..b3ba4ecefd433af330791389ed685e93d7805ae2 100644 (file)
--- a/scratch/Frontend.hs
+++ b/scratch/Frontend.hs
@@ -97,6 +97,7 @@ getInstructions ins = zip3 (map Source $ sumSeries'' offsets) offsets ins
 getBranch :: NInst -> [Int]
 getBranch (Source s, size, IF_ICMP _ t) = [addW16Signed s t, s+size]
 getBranch (Source s, size, GOTO     t)  = [addW16Signed s t]
+getBranch (Source s, size, IRETURN   )  = [0] --actually wrong
 getBranch _                             = [] 
 
 -- a version of Prelude.span whereby the first element

diff --git a/scratch/Graph.hs b/scratch/Graph.hs
index c9a9f14939ff04869f882739868533fbe2436a5b..5bb4e96955fdd44c7da3a2b2f97e27082465534d 100644 (file)
--- a/scratch/Graph.hs
+++ b/scratch/Graph.hs
@@ -55,7 +55,7 @@ packNodes []       e = Leaf e        -- leaf
 
 -- Generates a cyclic datastructure given edges and nodes
 -- TODO: remove lists with maps in inputs
-toG :: (Ord k) => ([r] -> a -> r) -> [(k,[k])] -> k -> [(k, a)] -> Maybe r
+toG :: (Ord k,Show k) => ([r] -> a -> r) -> [(k,[k])] -> k -> [(k, a)] -> Maybe r
 toG g xs start pls = let nodeTable = M.fromList pls
                          payload s = case M.lookup s nodeTable of
                                        Just x  -> x
@@ -69,7 +69,8 @@ toG g xs start pls = let nodeTable = M.fromList pls
 
                          node f p t = case M.lookup t conn of
                                             (Just x) -> x
-                                            Nothing  -> error "illformed edge/node list in toG"
+                                            Nothing  
+                                              -> error $ "illformed edge/node list in toG" ++ (show t)
                    in M.lookup start conn
 
 

diff --git a/scratch/ScratchHS.hs b/scratch/ScratchHS.hs
index 077ba00dc5728ac44ae5a1de0adbca46c564725a..3e0acaff450c237adbc462f19b1de412b0bf6edd 100644 (file)
--- a/scratch/ScratchHS.hs
+++ b/scratch/ScratchHS.hs
@@ -143,6 +143,22 @@ fib' = do con@(Just (ins,cls)) <- getMethodIO "../tests/Fac.class" "facFor"
           print "Final result"
           print $ printG' finalCyclicStructure
 
+main = do con@(Just (ins,cls)) <- getMethodIO "../tests/AbsurdlyHuge.class" "absurdlyHuge"
+          let tagged = getInstructions ins
+          let backRefs = splitBlocksBackRef tagged
+          let splitted = splitBlocks backRefs tagged
+          let transitions = getTransitions splitted
+          let nodes       = getNodes splitted
+          print "nodes:"
+          print nodes
+          print "transitions"
+          print transitions
+          let (Just finalCyclicStructure) = indirectCFGToG splitted
+          print "Final result"
+          print $ printG' finalCyclicStructure
+
+    
+
 
 diamant ::  G String
 diamant = let start = Node "a" left right

diff --git a/tests/AbsurdlyHuge.java b/tests/AbsurdlyHuge.java
new file mode 100644 (file)
index 0000000..ba1707d
--- /dev/null
+++ b/tests/AbsurdlyHuge.java
@@ -0,0 +1,41 @@
+public class AbsurdlyHuge
+{
+public static int absurdlyHuge(int x)
+{
+for(int i=0;i<x;i++)
+{
+for(int u=0;u<x;u++)
+{
+for(int k=0;k<x;k++)
+{
+for(int v=0;v<x;v++)
+{
+for(int w=0;w<x;w++)
+{
+for(int z=0;z<x;z++)
+{
+for(int g=0;w<x;w++)
+{
+if(i+u+k+v+w+z<x)
+{
+return absurdlyHuge(k+v);
+}
+else
+{
+return absurdlyHuge(w+z);
+}
+}
+}
+}
+}
+}
+}
+}
+return 0;
+}
+
+   public static void main(String[] args)
+   {
+      absurdlyHuge(1);
+   }
+}