scratch/ScratchHS.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE TemplateHaskell #-}
   3
   4 -- Purpose of this file is just do test some Intermediate representations and stuff ;-)
   5
   6 {- Some important material:
   7  -
   8  - Java HotSpot™ Client Compiler: www.cdl.uni-saarland.de/ssasem/talks/Christian.Wimmer.pdf
   9  - http://www.complang.tuwien.ac.at/andi/185A50
  10  -
  11  - [Poletto:1999] http://dl.acm.org/citation.cfm?doid=330249.330250
  12  - [Wimmer:2010] http://dl.acm.org/citation.cfm?id=1772954.1772979
  13  -
  14  -}
  15
  16
  17 module ScratchHS where
  18
  19 import Data.Maybe
  20
  21 import Harpy
  22 import Harpy.X86Disassembler
  23
  24 import Foreign
  25 import Control.Monad
  26
  27 import JVM.ClassFile
  28 import JVM.Converter
  29 import JVM.Dump
  30
  31 import qualified JVM.Assembler as JAsm
  32
  33 import Mate.Utilities
  34 import Mate.BasicBlocks
  35
  36 $(callDecl "callAsWord32" [t|Word32|])
  37
  38 data SimpleStack = PushLit Int
  39                  | Mul
  40                  | Add
  41                  | Ld String
  42                  | Print
  43
  44 testP = [PushLit 3, PushLit 2, Mul]
  45
  46 type Reg = Int
  47 data ROp = RMul | RAdd
  48
  49 data RegIL = RMov Reg Reg
  50            | RLoad Reg String
  51            | RBin  Reg Reg Reg ROp
  52
  53 data MateState = MateState String
  54
  55 compileRegIL :: RegIL -> CodeGen (Ptr Int32) MateState ()
  56 compileRegIL (RMov t s) = do
  57                            mateState <- getState
  58                            let (mt,ms) = (eax,eax)
  59                            mov mt ms
  60
  61
  62 entryCode :: CodeGen e s ()
  63 entryCode = do push ebp
  64                mov ebp esp
  65
  66 exitCode :: CodeGen e s ()
  67 exitCode = do mov esp ebp
  68               pop ebp
  69               ret
  70
  71
  72
  73 run :: [RegIL] -> Ptr Int32 -> IO (MateState, Either ErrMsg [Instruction])
  74 run program env = let compileAndFeedback = mapM_ compileRegIL program >> disassemble
  75                   in runCodeGen compileAndFeedback env (MateState "none")
  76
  77
  78 -- Allocates a buffer with size n. All zero.
  79 emptyMemory ::  (Storable a, Num a) => Int -> IO (Ptr a)
  80 emptyMemory n = mallocArray n
  81                   >>= (\ptr -> pokeArray ptr (replicate n 0) >> return ptr)
  82
  83
  84 testEnv p' = do
  85               ptr <- emptyMemory 26
  86               (_, Right code) <- run p' ptr
  87               return $ map showIntel code
  88
  89
  90 simpleTest ::  [RegIL]
  91 simpleTest = [RMov 0 1]
  92
  93
  94 -- Just some class file sand
  95 loadMethod methodName classFile = do cls <- parseClassFile classFile
  96                                      dumpClass cls
  97                                      return (cls, lookupMethod methodName cls)
  98
  99
 100 getFib = do (cls, Just m) <- loadMethod "ackermann" "../tests/Ackermann.class"
 101             return (cls, m)
 102
 103 fibBasicBlocks = do (cls,m) <- getFib
 104                     hmap <- parseMethod cls "ackermann"
 105                     printMapBB hmap
 106                     return ()