From 8d1996a73234eed84ba68dae7ef09b4faec2a7ea Mon Sep 17 00:00:00 2001 From: Bernhard Urban Date: Tue, 8 May 2012 23:56:03 +0200 Subject: [PATCH] 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. --- HACKING | 5 +++ Makefile | 11 ++++-- Mate.hs | 6 +--- Mate/BasicBlocks.hs | 21 ++++++----- Mate/ClassPool.hs | 38 ++++++++++---------- Mate/Debug.hs | 47 +++++++++++++++++++++++++ Mate/MethodPool.hs | 20 +++++------ Mate/RegisterAllocation.hs | 1 + Mate/Strings.hs | 6 ++-- Mate/X86CodeGen.hs | 1 + debug.h | 72 ++++++++++++++++++++++++++++++++++++++ doc/TODO | 5 +++ ffi/trap.c | 4 ++- 13 files changed, 182 insertions(+), 55 deletions(-) create mode 100644 HACKING create mode 100644 Mate/Debug.hs create mode 100644 debug.h diff --git a/HACKING b/HACKING new file mode 100644 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 6a1922e..0fe827e 100644 --- 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 5e6df74..4c73290 100644 --- 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 1b03622..92120e0 100644 --- 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 29cef29..710b6a5 100644 --- 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 "" 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 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 85010eb..067a989 100644 --- 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 ' diff --git a/Mate/RegisterAllocation.hs b/Mate/RegisterAllocation.hs index 9fc43ae..6dfaa80 100644 --- 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 ba21663..fb7f0af 100644 --- 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 9f68c65..ea986d2 100644 --- 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 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 cef2691..0b3b28e 100644 --- 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 3b5e783..1d18eba 100644 --- a/ffi/trap.c +++ b/ffi/trap.c @@ -1,6 +1,8 @@ #include #include +#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...) -- 2.25.1