debug: get rid of #ifdef guards

this can be done differently. unfortunately it requires some hacks, see
`Mate/Debug.hs' and `debug.h', but I think it's more convient to use.

note, that there're now different `printf_*' functions to use, in
order to map the desired debuglevel.

also see the file `HACKING' for usage.

diff --git a/HACKING b/HACKING
new file mode 100644 (file)
index 0000000..5772b87
--- /dev/null
+++ b/HACKING
@@ -0,0 +1,5 @@
+for a debug build, use
+$ DBGFLAGS='-DDBG_JIT -DDBG_BB' make tests/Fib.dbg
+
+`make clean' is needed if you change $DBGFLAGS.
+for all available flags, see `debug.h'.

diff --git a/Makefile b/Makefile
index 6a1922e79407a05857bb3a1d5334e1466570f705..0fe827e16f442936c1c00fba044264e5a4db70a3 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -11,7 +11,7 @@ O_FILES = $(shell ls Mate/*.o) $(wildcard ffi/*.o)
 PACKAGES_ := bytestring harpy hs-java
 PACKAGES := $(addprefix -package ,$(PACKAGES_))
 
-GHC_OPT := -dynamic -Wall -O0 -fno-warn-unused-do-bind
+GHC_OPT := -I. -dynamic -Wall -O0 -fno-warn-unused-do-bind
 GHC_LD := -optl-Xlinker -optl-x
 
 
@@ -37,10 +37,15 @@ mate: Mate.hs ffi/trap.c $(HS_FILES) $(HS_BOOT) ffi/native.o
 %.dbg: %.class mate.dbg
        ./mate.dbg $(basename $<)
 
+ifeq (${DBGFLAGS},)
+DEBUGFLAGS = -DDBG_JIT -DDBG_MP
+else
+DEBUGFLAGS = ${DBGFLAGS}
+endif
 mate.dbg: Mate.hs ffi/trap.c $(HS_FILES) $(HS_BOOT) ffi/native.o
        @mkdir -p build/debug/{ffi,Mate,}
-       gcc -Wall -DDEBUG -O0 -c ffi/trap.c -o build/debug/ffi/trap.o
-       ghc --make -DDEBUG $(GHC_OPT) Mate.hs build/debug/ffi/trap.o -o $@ $(GHC_LD) -outputdir build/debug
+       gcc -Wall $(DEBUGFLAGS) -O0 -c ffi/trap.c -o build/debug/ffi/trap.o
+       ghc --make $(DEBUGFLAGS) $(GHC_OPT) Mate.hs build/debug/ffi/trap.o -o $@ $(GHC_LD) -outputdir build/debug
 
 clean:
        rm -rf build mate mate.dbg ffi/native.o tests/*.class

diff --git a/Mate.hs b/Mate.hs
index 5e6df74f9c77f6925d62ded17039f13676af621b..4c732908af3d6fca2ad794f2d8d3519f3213b3b4 100644 (file)
--- a/Mate.hs
+++ b/Mate.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
+#include "debug.h"
 module Main where
 
 import System.Environment
@@ -9,8 +10,6 @@ import qualified Data.ByteString.Lazy as B
 
 #ifdef DEBUG
 import Text.Printf
-
-import JVM.Dump
 #endif
 import JVM.ClassFile
 
@@ -29,9 +28,6 @@ main = do
     [clspath] -> do
       let bclspath = B.pack $ map (fromIntegral . ord) clspath
       cls <- getClassFile bclspath
-#ifdef DEBUG
-      dumpClass cls
-#endif
       hmap <- parseMethod cls "main"
       case hmap of
         Just hmap' -> do

diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs
index 1b03622c2369ebef3530529a9ea8c7d82a042613..92120e0722c32819964c32444ba7bd2a1132b9c9 100644 (file)
--- a/Mate/BasicBlocks.hs
+++ b/Mate/BasicBlocks.hs
@@ -1,11 +1,12 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
+#include "debug.h"
 module Mate.BasicBlocks(
   BlockID,
   BasicBlock (..),
   BBEnd (..),
   MapBB,
-#ifdef DEBUG
+#ifdef DBG_BB
   printMapBB,
   test_main,
 #endif
@@ -25,6 +26,7 @@ import JVM.Assembler
 
 import Mate.Utilities
 import Mate.Types
+import Mate.Debug
 
 #ifdef DEBUG
 import Text.Printf
@@ -35,7 +37,7 @@ type Offset = (Int, Maybe BBEnd) -- (offset in bytecode, offset to jump target)
 type OffIns = (Offset, Instruction)
 
 
-#ifdef DEBUG
+#ifdef DBG_BB
 printMapBB :: Maybe MapBB -> IO ()
 printMapBB Nothing = putStrLn "No BasicBlock"
 printMapBB (Just hmap) = do
@@ -60,7 +62,7 @@ printMapBB (Just hmap) = do
                   Nothing -> error $ "BlockID " ++ show i ++ " not found."
 #endif
 
-#ifdef DEBUG
+#ifdef DBG_BB
 testInstance :: String -> B.ByteString -> IO ()
 testInstance cf method = do
                       cls <- parseClassFile cf
@@ -68,7 +70,7 @@ testInstance cf method = do
                       printMapBB hmap
 #endif
 
-#ifdef DEBUG
+#ifdef DBG_BB
 test_main :: IO ()
 test_main = do
   test_01
@@ -87,21 +89,18 @@ test_04 = testInstance "./tests/Fac.class" "fac"
 parseMethod :: Class Resolved -> B.ByteString -> IO (Maybe MapBB)
 parseMethod cls method = do
                      let maybe_bb = testCFG $ lookupMethod method cls
-#ifdef DEBUG
-                     putStr "BB: analysing: "
                      let msig = methodSignature $ (classMethods cls) !! 1
-                     putStrLn $ toString (method `B.append` ": " `B.append` (encode msig))
+                     printf_bb "BB: analysing \"%s\"\n" $ toString (method `B.append` ": " `B.append` (encode msig))
+#ifdef DBG_BB
                      printMapBB maybe_bb
 #endif
-#ifdef DEBUG
                      -- small example how to get information about
                      -- exceptions of a method
                      -- TODO: remove ;-)
                      let (Just m) = lookupMethod method cls
                      case attrByName m "Code" of
-                      Nothing -> printf "exception: no handler for this method\n"
-                      Just exceptionstream -> printf "exception: \"%s\"\n" (show $ codeExceptions $ decodeMethod exceptionstream)
-#endif
+                      Nothing -> printf_bb "exception: no handler for this method\n"
+                      Just exceptionstream -> printf_bb "exception: \"%s\"\n" (show $ codeExceptions $ decodeMethod exceptionstream)
                      return maybe_bb
 
 

diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs
index 29cef29db184cabacf1835e820759945d30557b1..710b6a57239afc6af43e1926a291dbd605d8ba10 100644 (file)
--- a/Mate/ClassPool.hs
+++ b/Mate/ClassPool.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
+#include "debug.h"
 module Mate.ClassPool (
   getClassInfo,
   getClassFile,
@@ -23,6 +24,9 @@ import Control.Monad
 #ifdef DEBUG
 import Text.Printf
 #endif
+#ifdef DBG_CLASS
+import JVM.Dump
+#endif
 
 import Foreign.Ptr
 import Foreign.C.Types
@@ -36,6 +40,7 @@ import Mate.BasicBlocks
 import {-# SOURCE #-} Mate.MethodPool
 import Mate.Types
 import Mate.Utilities
+import Mate.Debug
 
 getClassInfo :: B.ByteString -> IO ClassInfo
 getClassInfo path = do
@@ -100,13 +105,14 @@ getInterfaceMethodOffset ifname meth sig = do
     Just w32 -> return $ (+4) w32
     Nothing -> error $ "getInterfaceMethodOffset: no offset set"
 
+
 loadClass :: B.ByteString -> IO ClassInfo
 loadClass path = do
-#ifdef DEBUG
-  printf "loadClass: \"%s\"\n" $ toString path
-#endif
   let rpath = toString $ path `B.append` ".class"
   cfile <- parseClassFile rpath
+#ifdef DBG_CLASS
+  dumpClass cfile
+#endif
   -- load all interfaces, which are implemented by this class
   sequence_ [ loadInterface i | i <- interfaces cfile ]
   superclass <- case (path /= "java/lang/Object") of
@@ -127,14 +133,12 @@ loadClass path = do
   let w32_iftable = fromIntegral $ ptrToIntPtr iftable :: Word32
   -- store interface-table at offset 0 in method-table
   pokeElemOff (intPtrToPtr $ fromIntegral mbase) 0 w32_iftable
-#ifdef DEBUG
-  printf "staticmap: %s @ %s\n" (show staticmap) (toString path)
-  printf "fieldmap:  %s @ %s\n" (show fieldmap) (toString path)
-  printf "methodmap: %s @ %s\n" (show methodmap) (toString path)
-  printf "mbase: 0x%08x\n" mbase
-  printf "interfacemethod: %s @ %s\n" (show immap) (toString path)
-  printf "iftable: 0x%08x\n" w32_iftable
-#endif
+  printf_cp "staticmap: %s @ %s\n" (show staticmap) (toString path)
+  printf_cp "fieldmap:  %s @ %s\n" (show fieldmap) (toString path)
+  printf_cp "methodmap: %s @ %s\n" (show methodmap) (toString path)
+  printf_cp "mbase: 0x%08x\n" mbase
+  printf_cp "interfacemethod: %s @ %s\n" (show immap) (toString path)
+  printf_cp "iftable: 0x%08x\n" w32_iftable
   virtual_map <- get_virtualmap >>= ptr2virtualmap
   let virtual_map' = M.insert mbase path virtual_map
   virtualmap2ptr virtual_map' >>= set_virtualmap
@@ -153,9 +157,7 @@ loadInterface path = do
   case M.lookup path imap of
     Just _ -> return ()
     Nothing -> do
-#ifdef DEBUG
-      printf "interface: loading \"%s\"\n" $ toString path
-#endif
+      printf_cp "interface: loading \"%s\"\n" $ toString path
       let ifpath = toString $ path `B.append` ".class"
       cfile <- parseClassFile ifpath
       -- load "superinterfaces" first
@@ -253,13 +255,9 @@ loadAndInitClass path = do
           let mi = (MethodInfo "<clinit>" path (methodSignature m))
           entry <- compileBB hmap' mi
           addMethodRef entry mi [path]
-#ifdef DEBUG
-          printf "executing static initializer from %s now\n" (toString path)
-#endif
+          printf_cp "executing static initializer from %s now\n" (toString path)
           executeFuncPtr entry
-#ifdef DEBUG
-          printf "static initializer from %s done\n" (toString path)
-#endif
+          printf_cp "static initializer from %s done\n" (toString path)
         Nothing -> error $ "loadClass: static initializer not found (WTF?). abort"
     Nothing -> return ()
 

diff --git a/Mate/Debug.hs b/Mate/Debug.hs
new file mode 100644 (file)
index 0000000..b5ee689
--- /dev/null
+++ b/Mate/Debug.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+#include "debug.h"
+
+module Mate.Debug where
+
+{- we cannot use `PrintfType' from Text.Printf, as it isn't exported.
+ - so we implement a `VarArgsFake' here.
+ - http://www.haskell.org/haskellwiki/Varargs -}
+class VarArgsFake t where
+  varFake :: [String] -> t
+
+instance VarArgsFake (IO a) where
+  varFake _ = return undefined
+
+instance (Show a, VarArgsFake r) => VarArgsFake (a -> r) where
+  varFake _ = \_ -> varFake []
+
+printf_fake :: String -> (VarArgsFake t) => t
+printf_fake _ = varFake []
+
+
+-- see counterpart at `debug.h'
+#ifndef DBG_JIT
+printf_jit :: String -> (VarArgsFake t) => t
+printf_jit = printf_fake
+#endif
+
+#ifndef DBG_BB
+printf_bb :: String -> (VarArgsFake t) => t
+printf_bb = printf_fake
+#endif
+
+#ifndef DBG_MP
+printf_mp :: String -> (VarArgsFake t) => t
+printf_mp = printf_fake
+#endif
+
+#ifndef DBG_CP
+printf_cp :: String -> (VarArgsFake t) => t
+printf_cp = printf_fake
+#endif
+
+#ifndef DBG_STR
+printf_str :: String -> (VarArgsFake t) => t
+printf_str = printf_fake
+#endif

diff --git a/Mate/MethodPool.hs b/Mate/MethodPool.hs
index 85010eb9d11677545db7a30e3832477fbee9e700..067a9898585acdd9b2ecca60c3df6ae7841c2b14 100644 (file)
--- a/Mate/MethodPool.hs
+++ b/Mate/MethodPool.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
+#include "debug.h"
 module Mate.MethodPool where
 
 import Data.Binary
@@ -17,9 +18,9 @@ import Foreign.C.String
 import JVM.ClassFile
 
 import Harpy
-#ifdef DEBUG
 import Harpy.X86Disassembler
 
+#ifdef DEBUG
 import Text.Printf
 #endif
 
@@ -28,7 +29,7 @@ import Mate.Types
 import Mate.X86CodeGen
 import Mate.Utilities
 import Mate.ClassPool
-
+import Mate.Debug
 
 foreign import ccall "dynamic"
    code_void :: FunPtr (IO ()) -> (IO ())
@@ -69,9 +70,7 @@ getMethodEntry signal_from methodtable = do
   case M.lookup mi' mmap of
     Nothing -> do
       cls <- getClassFile cm
-#ifdef DEBUG
-      printf "getMethodEntry(from 0x%08x): no method \"%s\" found. compile it\n" w32_from (show mi')
-#endif
+      printf_mp "getMethodEntry(from 0x%08x): no method \"%s\" found. compile it\n" w32_from (show mi')
       mm <- lookupMethodRecursive method [] cls
       case mm of
         Just (mm', clsnames, cls') -> do
@@ -88,9 +87,7 @@ getMethodEntry signal_from methodtable = do
               True -> do
                 -- TODO(bernhard): cleaner please... *do'h*
                 let symbol = (replace "/" "_" $ toString cm) ++ "__" ++ (toString method) ++ "__" ++ (replace ";" "_" $ replace "/" "_" $ replace "(" "_" (replace ")" "_" $ toString $ encode sig))
-#ifdef DEBUG
-                printf "native-call: symbol: %s\n" symbol
-#endif
+                printf_mp "native-call: symbol: %s\n" symbol
                 nf <- loadNativeFunction symbol
                 let w32_nf = fromIntegral nf
                 let mmap' = M.insert mi' w32_nf mmap
@@ -168,10 +165,9 @@ compileBB hmap methodinfo = do
   let tmap' = M.union tmap new_tmap -- prefers elements in cmap
   trapmap2ptr tmap' >>= set_trapmap
 
-#ifdef DEBUG
-  printf "disasm:\n"
-  mapM_ (putStrLn . showAtt) (snd right)
-#endif
+  printf_jit "generated code of \"%s\":\n" (toString $ methName methodinfo)
+  mapM_ (printf_jit "%s\n" . showAtt) (snd right)
+  printf_jit "\n\n"
   -- UNCOMMENT NEXT LINE FOR GDB FUN
   -- _ <- getLine
   -- (1) start it with `gdb ./mate' and then `run <classfile>'

diff --git a/Mate/RegisterAllocation.hs b/Mate/RegisterAllocation.hs
index 9fc43ae51d5a4deeb6de6e3ba994e70ae8cfa7dc..6dfaa80aee5a45c7c6ab8b9baf8c2226cc1a1662 100644 (file)
--- a/Mate/RegisterAllocation.hs
+++ b/Mate/RegisterAllocation.hs
@@ -1,3 +1,4 @@
+#include "debug.h"
 module Mate.RegisterAllocation where
 
 import Data.List

diff --git a/Mate/Strings.hs b/Mate/Strings.hs
index ba2166364aca3c3537ac119655a34924b708eb15..fb7f0afb298184559606ebdc06e30f2a9ab9566e 100644 (file)
--- a/Mate/Strings.hs
+++ b/Mate/Strings.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
+#include "debug.h"
 module Mate.Strings (
   getUniqueStringAddr
   ) where
@@ -19,6 +20,7 @@ import Foreign.Marshal.Utils
 import Foreign.Marshal.Array
 
 import Mate.Types
+import Mate.Debug
 
 
 getUniqueStringAddr :: B.ByteString -> IO Word32
@@ -42,7 +44,5 @@ allocateJavaString str = do
   BI.memset newstr 0 (fromIntegral $ strlen + 1)
   copyBytes newstr arr strlen
   let w32_ptr = fromIntegral $ ptrToIntPtr newstr
-#ifdef DEBUG
-  printf "new str ptr: 0x%08x (%s)@%d\n" w32_ptr (toString str) strlen
-#endif
+  printf_str "new str ptr: 0x%08x (%s)@%d\n" w32_ptr (toString str) strlen
   return w32_ptr

diff --git a/Mate/X86CodeGen.hs b/Mate/X86CodeGen.hs
index 9f68c659f2087004e3c2dbff8e2ee08ba28f246c..ea986d2fc568b9da9f585c7d2b9e03343f1a9e02 100644 (file)
--- a/Mate/X86CodeGen.hs
+++ b/Mate/X86CodeGen.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
+#include "debug.h"
 module Mate.X86CodeGen where
 
 import Data.Binary

diff --git a/debug.h b/debug.h
new file mode 100644 (file)
index 0000000..58fbf3b
--- /dev/null
+++ b/debug.h
@@ -0,0 +1,72 @@
+/* DBG_JIT .... see generated code and CodeGen information
+ * DBG_BB ..... BasicBlock information
+ * DBG_MP ..... MethodPool.hs
+ * DBG_CP ..... ClassPool.hs
+ * DBG_STR .... Strings.hs
+ * // no printf_* defined
+ * DBG_TRAP ... show information @ trap.c
+ * DBG_CLASS .. dump classfile
+ */
+
+/* ooops defines */
+#ifdef BG_JIT
+#define DBG_JIT
+#endif
+
+#ifdef BG_BB
+#define DBG_BB
+#endif
+
+#ifdef BG_MP
+#define DBG_MP
+#endif
+
+#ifdef BG_CP
+#define DBG_CP
+#endif
+
+#ifdef BG_STR
+#define DBG_STR
+#endif
+
+#ifdef BG_TRAP
+#define DBG_TRAP
+#endif
+
+#ifdef BG_CLASS
+#define DBG_CLASS
+#endif
+
+/* if one constant from above is defined, we want to import
+ * libraries like Text.Printf
+ * needed for gettting proper `-Wall' output on a release build */
+
+#if defined(DBG_JIT) || defined(DBG_BB) || defined(DBG_MP) || defined(DBG_CP) || defined(DBG_STR)
+#define DEBUG
+#endif
+
+/* it would be awesome if we could just write
+ * > printf_fake = printf
+ * here, but the type can't be infered, since `PrintfType'
+ * isn't visible (at least this is my explanation :/).
+ * if I'm wrong, move this to `Mate/Debug.hs'
+ */
+#ifdef DBG_JIT
+#define printf_jit printf
+#endif
+
+#ifdef DBG_BB
+#define printf_bb printf
+#endif
+
+#ifdef DBG_MP
+#define printf_mp printf
+#endif
+
+#ifdef DBG_CP
+#define printf_cp printf
+#endif
+
+#ifdef DBG_STR
+#define printf_str printf
+#endif

diff --git a/doc/TODO b/doc/TODO
index cef269182f7175088f6ab295166b11be7b18bf4e..0b3b28eab11063194bd5522321e3f471faa843d2 100644 (file)
--- a/doc/TODO
+++ b/doc/TODO
@@ -36,6 +36,11 @@
 
 (h) so much cleanup...
 
+(h) get rid of trap.c
+       -> it's C. we don't want that.
+       -> at the moment System.Posix.Signal isn't powerful enough
+       -> wait for: http://hackage.haskell.org/trac/ghc/ticket/2451
+
 (l) check different types (byte, long, ...)
 
 (l) floating point support

diff --git a/ffi/trap.c b/ffi/trap.c
index 3b5e78309dbf301656fa33001bd962fb6be2f144..1d18ebade214e270d77b06a4c3763f7ea2d85c25 100644 (file)
--- a/ffi/trap.c
+++ b/ffi/trap.c
@@ -1,6 +1,8 @@
 #include <stdio.h>
 #include <stdlib.h>
 
+#include "../debug.h"
+
 /* TODO(bernhard): use {u,}int* types */
 
 #define __USE_GNU
@@ -23,7 +25,7 @@ unsigned int getMethodEntry(unsigned int, unsigned int);
 unsigned int getStaticFieldAddr(unsigned int, void*);
 unsigned int getTrapType(unsigned int, unsigned int);
 
-#ifdef DEBUG
+#ifdef DBG_TRAP
 #define dprintf(args...) do { printf (args); } while (0);
 #else
 #define dprintf(args...)