MASMGen 0.4.0.0 → 0.5.0.0
raw patch · 4 files changed
+121/−13 lines, 4 files
Files
- MASMGen.cabal +1/−1
- src/Language/MASMGen/Core.hs +50/−6
- src/Language/MASMGen/Types.hs +68/−6
- test/Main.hs +2/−0
MASMGen.cabal view
@@ -1,5 +1,5 @@ name: MASMGen-version: 0.4.0.0+version: 0.5.0.0 synopsis: Generate MASM code from haskell description: Please see README.md license: LGPL-3
src/Language/MASMGen/Core.hs view
@@ -6,8 +6,9 @@ Maintainer : petercommand@gmail.com Stability : provisional Portability : portable--}-module Language.MASMGen.Core ( mkFunc+|-}+module Language.MASMGen.Core ( newGlobalVar+ , mkFunc , initFuncState , initProgState , section@@ -40,6 +41,11 @@ , pushl , pop , popl+ , shl+ , sal+ , shr+ , sar+ , lea , label , comment )@@ -53,11 +59,17 @@ import Data.List import Data.Word + mkFunc :: String -> MASMFuncM () -> MASMProgM () mkFunc name thisFunc = do f <- gets funcs modify $ \s -> s { funcs = Func (execState thisFunc (initFuncState name)) : f } +newGlobalVar :: String -> MASMVar -> MASMProgM Var+newGlobalVar name value = do+ map <- gets globalVarMap+ modify $ \s -> s { globalVarMap = M.insert name value map } + return $ mkVar name (fst value) initFuncState :: String -> MASMFunc@@ -119,8 +131,13 @@ produceAsmGlobalVarMap :: MASMVarMap -> Writer [MASMOutput] () produceAsmGlobalVarMap varMap = let assocsList = M.assocs varMap- printVar :: (String, (MASMType, [Word8])) -> Writer [MASMOutput] ()- printVar (name, (varType, val)) = stell $ MASMOutput $ name <> " " <> show varType <> " " <> intersperse ',' (concat . map show $ val)+ printVar :: (String, (MASMType, Maybe [Lit])) -> Writer [MASMOutput] ()+ printVar (name, (varType, val)) =+ let result = case val of+ Just x -> intersperse ',' (concat . map show $ x)+ Nothing -> "?"+ in+ stell $ MASMOutput $ name <> " " <> show varType <> " " <> result in do sequence_ $ map printVar assocsList produceAsmFuncs :: [MASMTopLevel] -> Writer [MASMOutput] ()@@ -158,11 +175,18 @@ MASMInc size x -> sizedSinOp "INC" size x MASMDec size x -> sizedSinOp "DEC" size x MASMMov size x y -> sizedBinOp "MOV" size x y+ MASMMovsx x y -> binOp "MOVSX" x y+ MASMMovzx x y -> binOp "MOVZX" x y MASMFuncCall name convention _ -> error "func call not implemented" MASMGoto x -> sinOp "GOTO" x MASMLabel x -> stell $ MASMOutputNoIndent $ x <> ":" MASMPush size x -> sizedSinOp "PUSH" size x MASMPop size x -> sizedSinOp "POP" size x+ MASMShl x y -> binOp "SHL" x y+ MASMSal x y -> binOp "SAL" x y+ MASMShr x y -> binOp "SHR" x y+ MASMSar x y -> binOp "SAR" x y+ MASMLea x y -> binOp "LEA" x y MASMComment x -> stell $ MASMOutput $ ';' : x modFun :: MASMInstr -> MASMFuncM ()@@ -217,8 +241,8 @@ typedBinOp :: TypedMASMInstrBinCon -> MASMType -> Operand -> Operand -> MASMFuncM () typedBinOp instr ty x y = case operandClass x of- Pointer -> modFun $ instr (Just (Ptr ty)) x y- _ -> modFun $ instr (Just ty) x y+ Pointer -> modFun $ instr (Just (Ptr ty)) x y+ _ -> modFun $ instr (Just ty) x y movb :: Operand -> Operand -> MASMFuncM () movb = typedBinOp MASMMov DB@@ -229,6 +253,12 @@ movl :: Operand -> Operand -> MASMFuncM () movl = typedBinOp MASMMov DD +movsx :: Operand -> Operand -> MASMFuncM ()+movsx x y = modFun $ MASMMovsx x y++movzx :: Operand -> Operand -> MASMFuncM ()+movzx x y = modFun $ MASMMovzx x y+ goto :: String -> MASMFuncM () goto x = modFun $ MASMGoto x @@ -244,7 +274,21 @@ popl :: Operand -> MASMFuncM () popl x = typedSinOp MASMPop DD x +shl :: Operand -> Operand -> MASMFuncM ()+shl dest count = modFun $ MASMShl dest count++sal :: Operand -> Operand -> MASMFuncM ()+sal dest count = modFun $ MASMSal dest count+ +shr :: Operand -> Operand -> MASMFuncM ()+shr dest count = modFun $ MASMShr dest count++sar :: Operand -> Operand -> MASMFuncM ()+sar dest count = modFun $ MASMSar dest count +lea :: Operand -> Operand -> MASMFuncM ()+lea x y = modFun $ MASMLea x y+ label :: String -> MASMFuncM () label x = modFun $ MASMLabel x
src/Language/MASMGen/Types.hs view
@@ -8,7 +8,45 @@ Portability : portable -} {-# LANGUAGE GADTs, ExistentialQuantification, FlexibleContexts, StandaloneDeriving #-}-module Language.MASMGen.Types where+module Language.MASMGen.Types ( MASM(..)+ , Lit(..)+ , Var+ , Addr+ , Scale+ , Displacement+ , mkVar+ , Operand(..)+ , OpClass(..)+ , MASMMode(..)+ , Reg32(..)+ , Reg16(..)+ , Reg8(..)+ , RegXMM(..)+ , RegClass(..)+ , MASMInclude(..)+ , MASMType(..)+ , MASMVar+ , MASMVarMap+ , CallingConvention(..)+ , MASMInstr(..)+ , FuncArg+ , MASMFunc(..)+ , MASMFuncM+ , MASMProgM+ , MASMTopLevel(..)+ , MASMProg(..)+ , MASMOutput(..)+ , UntypedMASMInstrSinCon+ , UntypedMASMInstrBinCon+ , TypedMASMInstrSinCon+ , TypedMASMInstrBinCon+ , operandClass+ , def+ , showReg+ , regClass+ )++ where import qualified Data.Map as M import Data.Word import Control.Monad.State.Lazy@@ -26,20 +64,37 @@ , masmProg = return () } -data Lit = IntLit Word8 | Lits [Lit]+data Lit = Lit8 Word8 | Lit16 Word16 | Lit32 Word32+instance Show Lit where+ show (Lit8 x) = show x+ show (Lit16 x) = show x+ show (Lit32 x) = show x+ + type Addr = Word16 type Scale = Int type Displacement = Int +data Var = Var { varName :: String+ , varType :: MASMType+ }++instance Show Var where+ show = varName++mkVar :: String -> MASMType -> Var+mkVar name var = Var { varName = name+ , varType = var+ } data Operand where- Imm :: Word16 -> Operand -- to be fixed+ Imm :: Word32 -> Operand -- to be fixed Direct :: Addr -> Operand Reg :: forall a. Reg a => a -> Operand RegIndirect :: forall a. Reg a => a -> Operand RegIndex :: forall a. Reg a => a -> Displacement -> Operand RegIndexScale :: forall a. Reg a => a -> a -> Scale -> Displacement -> Operand- VarAddr :: String -> Operand+ VarAddr :: Var -> Operand data OpClass = Pointer | Register RegClass | Immediate @@ -96,8 +151,8 @@ show DW = "WORD" show DD = "DWORD" show (Ptr x) = show x ++ " PTR"- -type MASMVar = (MASMType, [Word8])++type MASMVar = (MASMType, Maybe [Lit]) type MASMVarMap = M.Map String MASMVar data CallingConvention = Default | Cdecl | FastCall | StdCall data MASMInstr = MASMAdd (Maybe MASMType) Operand Operand@@ -105,10 +160,17 @@ | MASMMul (Maybe MASMType) Operand Operand | MASMDiv (Maybe MASMType) Operand Operand | MASMMov (Maybe MASMType) Operand Operand+ | MASMMovsx Operand Operand+ | MASMMovzx Operand Operand | MASMInc (Maybe MASMType) Operand | MASMDec (Maybe MASMType) Operand | MASMPush (Maybe MASMType) Operand | MASMPop (Maybe MASMType) Operand+ | MASMShl Operand Operand+ | MASMSal Operand Operand+ | MASMShr Operand Operand+ | MASMSar Operand Operand+ | MASMLea Operand Operand | MASMFuncCall String CallingConvention [FuncArg] | MASMGoto String | MASMLabel String
test/Main.hs view
@@ -18,11 +18,13 @@ , masmProg = prog } prog = do+ var1 <- newGlobalVar "Var1" (DW, Nothing) mkFunc "start" $ do mov (Reg AX) (Imm 0) movl (RegIndirect EAX) (Reg EBX) addw (Reg AX) (Imm 10) sub (Reg AX) (Imm 100)+ movw (Reg AX) (VarAddr var1) mkFunc "testFunc1" $ do let loop n = if n > 0 then do