From: Harald Steinlechner <haraldsteinlechner@gmail.com>
Date: Tue, 17 Apr 2012 10:11:10 +0000 (+0200)
Subject: added scratch - for design experimentation and sandboxing
X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=mate.git;a=commitdiff_plain;h=560d48e326aa22e44c646e9ee9fbd4ceb1fcda19

added scratch - for design experimentation and sandboxing
---

diff --git a/scratch/.ScratchHS.hs.swp b/scratch/.ScratchHS.hs.swp
new file mode 100644
index 0000000..513731c
Binary files /dev/null and b/scratch/.ScratchHS.hs.swp differ
diff --git a/scratch/ScratchHS.hs b/scratch/ScratchHS.hs
new file mode 100644
index 0000000..a6808b0
--- /dev/null
+++ b/scratch/ScratchHS.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+-- Purpose of this file is just do test some Intermediate representations and stuff ;-)
+
+{- Some important material:
+ - 
+ - Java HotSpot™ Client Compiler: www.cdl.uni-saarland.de/ssasem/talks/Christian.Wimmer.pdf
+ - http://www.complang.tuwien.ac.at/andi/185A50
+ - 
+ - [Poletto:1999] http://dl.acm.org/citation.cfm?doid=330249.330250
+ - [Wimmer:2010] http://dl.acm.org/citation.cfm?id=1772954.1772979
+ -
+ -}
+
+
+module ScratchHS where
+
+import Data.Maybe
+
+import Harpy
+import Harpy.X86Disassembler
+
+import Foreign
+import Control.Monad
+
+import JVM.ClassFile
+import JVM.Converter
+import JVM.Dump
+
+import qualified JVM.Assembler as JAsm
+
+import Mate.Utilities
+import Mate.BasicBlocks
+
+$(callDecl "callAsWord32" [t|Word32|])
+
+data SimpleStack = PushLit Int
+                 | Mul
+                 | Add
+                 | Ld String
+                 | Print
+
+testP = [PushLit 3, PushLit 2, Mul]
+
+type Reg = Int 
+data ROp = RMul | RAdd
+
+data RegIL = RMov Reg Reg
+           | RLoad Reg String 
+           | RBin  Reg Reg Reg ROp
+
+data MateState = MateState String
+
+compileRegIL :: RegIL -> CodeGen (Ptr Int32) MateState ()
+compileRegIL (RMov t s) = do 
+                           mateState <- getState
+                           let (mt,ms) = (eax,eax)
+                           mov mt ms
+
+
+entryCode :: CodeGen e s ()
+entryCode = do push ebp
+               mov ebp esp
+
+exitCode :: CodeGen e s ()
+exitCode = do mov esp ebp
+              pop ebp 
+              ret
+
+
+
+run :: [RegIL] -> Ptr Int32 -> IO (MateState, Either ErrMsg [Instruction])
+run program env = let compileAndFeedback = mapM_ compileRegIL program >> disassemble
+                  in runCodeGen compileAndFeedback env (MateState "none")
+
+
+-- Allocates a buffer with size n. All zero.
+emptyMemory ::  (Storable a, Num a) => Int -> IO (Ptr a)
+emptyMemory n = mallocArray n 
+                  >>= (\ptr -> pokeArray ptr (replicate n 0) >> return ptr)
+
+
+testEnv p' = do 
+              ptr <- emptyMemory 26
+              (_, Right code) <- run p' ptr
+              return $ map showIntel code
+
+
+simpleTest ::  [RegIL]
+simpleTest = [RMov 0 1]
+
+
+-- Just some class file sand
+loadMethod methodName classFile = do cls <- parseClassFile classFile
+                                     dumpClass cls
+                                     return (cls, lookupMethod methodName cls)
+
+
+getFib = do (cls, Just m) <- loadMethod "ackermann" "../tests/Ackermann.class"
+            return (cls, m)
+
+fibBasicBlocks = do (cls,m) <- getFib
+                    hmap <- parseMethod cls "ackermann"
+                    printMapBB hmap
+                    return ()
diff --git a/scratch/run.sh b/scratch/run.sh
new file mode 100755
index 0000000..ab1b00c
--- /dev/null
+++ b/scratch/run.sh
@@ -0,0 +1,3 @@
+#!/bin/bash
+
+ghci ScratchHS.hs -i'../'