Generating x86 assembly with Haskell

A quick and dirty example:

data Exp = Lit Int -- literal value
	| Call String Exp -- calling a function
	| Bin BinOp Exp Exp -- binary operations
	| Param -- the parameter
	deriving (Show,Eq)
 
data Function = Func String Exp -- a function has a name and expression
data BinOp = Add | Subtract | Multiply | Divide deriving(Show,Eq)
 
-- an instance to allow us to write nicer definitions
instance Num Exp where
	x * y = Bin Multiply x y
	x - y = Bin Subtract x y
	x + y = Bin Add x y
	fromInteger x = Lit (fromInteger x)
 
outFunc (Func name it) = name ++ -- output function name
	":\npush ebp\nmov ebp,esp\n" ++ -- save old stack frame
	output it ++ -- output function
	"pop eax\npop ebp\n" ++ -- restore old stack frame
	"ret 4\n\n" -- remove argument from stack and return
 
output (Bin op l r) = outBin op l r -- binary operations
output (Lit x) = "push dword " ++ show x ++ "\n" -- push literal
output (Param) = "push dword [ebp+8]\n" -- push parameter
output (Call name with) = output with ++
	"call " ++ name ++
	"\npush eax\n" -- put return value onto stack
 
outBin Add = outBinGen "add"
outBin Subtract = outBinGen "sub"
outBin Multiply = outBinGen "imul"
outBin Divide = outBinGen "idiv"
 
outBinGen op l r = output l ++ output r ++
	"pop ebx\npop eax\n" ++ op ++ " eax,ebx\npush eax\n"

And an example of using it:

main = putStr $ concatMap outFunc [double,quad]
double = Func "double" (Param * 2)
quad = Func "quad" (Call "double" (2*Param))

This example outputs:

double:
	push ebp
	mov ebp,esp
	push dword [ebp+8]
	push dword 2
	pop ebx
	pop eax
	imul eax,ebx
	push eax
	pop eax
	pop ebp
	ret 4
 
quad:
	push ebp
	mov ebp,esp
	push dword 2
	push dword [ebp+8]
	pop ebx
	pop eax
	imul eax,ebx
	push eax
	call double
	push eax
	pop eax
	pop ebp
	ret 4

Not the most efficient code in the world The calling convention is somewhat ad-hoc; the callee must remove its arguments from the stack and returns its value in eax.

Post a Comment

Your email is never published nor shared. Required fields are marked *