Revert "globalmaphack: use old school CPP"
authorBernhard Urban <lewurm@gmail.com>
Fri, 24 Aug 2012 17:48:14 +0000 (19:48 +0200)
committerBernhard Urban <lewurm@gmail.com>
Fri, 24 Aug 2012 18:17:55 +0000 (20:17 +0200)
fall back to "standard" cpp by ghc, since cpphs doesn't work with ghc-mod.

This reverts commit 94985402292306da1db46b1750927ef46bdb87d3.

Conflicts:

Makefile

Makefile
Mate/NativeMachine.hs
Mate/NativeSizes.hs
Mate/Types.hs
Mate/X86CodeGen.hs

index f05bf977c067f0c1dd97cd141509876cd4433335..837c67cc6160606dcb2bc7c10c621647987ee2ff 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -15,10 +15,10 @@ PACKAGES_ := bytestring harpy hs-java plugins
 PACKAGES := $(addprefix -package ,$(PACKAGES_))
 
 
-# use `cpphs'
-GHC_CPP := -cpp -pgmP cpphs -optP --cpp
+GHC_CPP := -DARCH_X86
 
 GHC_OPT  = -I. -O0 -Wall -fno-warn-unused-do-bind -fwarn-tabs
+# TODO: define this in cabal... (see cpu package @ hackage)
 # see *.gdb target. also useful for profiling (-p at call)
 GHC_OPT += -rtsopts # -prof -auto-all
 GHC_OPT += $(GHC_CPP)
index 51e1bdf814bc90eee96ed330e906e685548f3a54..14747410d3d8dcc28f55b3a8627a47eff25089b1 100644 (file)
@@ -7,7 +7,7 @@ module Mate.NativeMachine(
   NativeWord
   )where
 
-#ifdef i386_HOST_ARCH
+#ifdef ARCH_X86
 import Mate.X86CodeGen
 import Mate.X86TrapHandling
 import Mate.NativeSizes
index 07c437191261f2b6790a90b06975407fd80ed9b9..0ba612842eb7233522a5d8321f002ecd4fa5dd52 100644 (file)
@@ -1,9 +1,10 @@
+{-# LANGUAGE CPP #-}
 module Mate.NativeSizes where
 
 import Data.Word
 
 ptrSize, longSize :: NativeWord
-#ifdef i386_HOST_ARCH
+#if defined(ARCH_X86)
 ptrSize = 4
 longSize = 8
 
index 5c5428ca8be81683e82dbc0a392bcce8b9e0db0f..2f4ef6d245edd0501ee30a6c7f377bb1f6641bba 100644 (file)
@@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
 module Mate.Types where
 
 import Data.Int
@@ -112,7 +111,6 @@ toString :: B.ByteString -> String
 toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
 -}
 
--- better solutions for a global map hack are welcome! (typeclasses, TH, ...?)
 
 data MateCtx = MateCtx {
   ctxMethodMap :: MethodMap,
@@ -130,32 +128,79 @@ mateCtx :: IORef MateCtx
 {-# NOINLINE mateCtx #-}
 mateCtx = unsafePerformIO $ newIORef emptyMateCtx
 
--- TODO(bernhard): if we ever have thread support, don't forget MVars
-#define SETMAP(name) set##name :: name -> IO (); \
-  set##name m = do ctx <- readIORef mateCtx; \
-  writeIORef mateCtx $ ctx { ctx##name = m };
 
-#define GETMAP(name) get##name :: IO name ; \
-  get##name = do ctx <- readIORef mateCtx; \
-  return $ ctx##name ctx;
+setMethodMap :: MethodMap -> IO ()
+setMethodMap m = do
+  ctx <- readIORef mateCtx
+  writeIORef mateCtx $ ctx { ctxMethodMap = m }
 
-SETMAP(MethodMap);
-GETMAP(MethodMap)
+getMethodMap :: IO MethodMap
+getMethodMap = do
+  ctx <- readIORef mateCtx
+  return $ ctxMethodMap ctx
 
-SETMAP(TrapMap)
-GETMAP(TrapMap)
 
-SETMAP(ClassMap)
-GETMAP(ClassMap)
+setTrapMap :: TrapMap -> IO ()
+setTrapMap m = do
+  ctx <- readIORef mateCtx
+  writeIORef mateCtx $ ctx { ctxTrapMap = m }
 
-SETMAP(VirtualMap)
-GETMAP(VirtualMap)
+getTrapMap :: IO TrapMap
+getTrapMap = do
+  ctx <- readIORef mateCtx
+  return $ ctxTrapMap ctx
 
-SETMAP(StringMap)
-GETMAP(StringMap)
 
-SETMAP(InterfaceMap)
-GETMAP(InterfaceMap)
+setClassMap :: ClassMap -> IO ()
+setClassMap m = do
+  ctx <- readIORef mateCtx
+  writeIORef mateCtx $ ctx { ctxClassMap = m }
 
-SETMAP(InterfaceMethodMap)
-GETMAP(InterfaceMethodMap)
+getClassMap :: IO ClassMap
+getClassMap = do
+  ctx <- readIORef mateCtx
+  return $ ctxClassMap ctx
+
+
+setVirtualMap :: VirtualMap -> IO ()
+setVirtualMap m = do
+  ctx <- readIORef mateCtx
+  writeIORef mateCtx $ ctx { ctxVirtualMap = m }
+
+getVirtualMap :: IO VirtualMap
+getVirtualMap = do
+  ctx <- readIORef mateCtx
+  return $ ctxVirtualMap ctx
+
+
+setStringMap :: StringMap -> IO ()
+setStringMap m = do
+  ctx <- readIORef mateCtx
+  writeIORef mateCtx $ ctx { ctxStringMap = m }
+
+getStringMap :: IO StringMap
+getStringMap = do
+  ctx <- readIORef mateCtx
+  return $ ctxStringMap ctx
+
+
+setInterfaceMap :: InterfaceMap -> IO ()
+setInterfaceMap m = do
+  ctx <- readIORef mateCtx
+  writeIORef mateCtx $ ctx { ctxInterfaceMap = m }
+
+getInterfaceMap :: IO InterfaceMap
+getInterfaceMap = do
+  ctx <- readIORef mateCtx
+  return $ ctxInterfaceMap ctx
+
+
+setInterfaceMethodMap :: InterfaceMethodMap -> IO ()
+setInterfaceMethodMap m = do
+  ctx <- readIORef mateCtx
+  writeIORef mateCtx $ ctx { ctxInterfaceMethodMap = m }
+
+getInterfaceMethodMap :: IO InterfaceMethodMap
+getInterfaceMethodMap = do
+  ctx <- readIORef mateCtx
+  return $ ctxInterfaceMethodMap ctx
index 40b826214bb7dc0561a8bf8f53b742f8e909cf89..2f0f6e44edfb75b90e295eda3597a223304457a9 100644 (file)
@@ -324,6 +324,7 @@ emitFromBB cls method = do
     emit IRETURN = do pop eax; emit RETURN
     emit invalid = error $ "insn not implemented yet: " ++ show invalid
 
+    -- TODO(bernhard): delay to runtime (find counter example!)
     emitFieldOffset :: Word16 -> CodeGen e s Int32
     emitFieldOffset x = do
       pop eax -- this pointer