diff --git a/src/Expr.lama b/src/Expr.lama index b75803563..008acfc0c 100644 --- a/src/Expr.lama +++ b/src/Expr.lama @@ -14,5 +14,28 @@ import State; -- Binop (string, expr, expr) public fun evalExpr (st, expr) { - failure ("evalExpr not implemented\n") + case expr of + Var (name) -> st (name) + | Const (num) -> num + | Binop (op, l, r) -> evalOp (op, evalExpr (st, l), evalExpr (st, r)) + esac +} + +public fun evalOp (op, l, r) { + case op of + "+" -> l + r + | "-" -> l - r + | "*" -> l * r + | "/" -> l / r + | "%" -> l % r + | "==" -> l == r + | "!=" -> l != r + | "<" -> l < r + | "<=" -> l <= r + | ">" -> l > r + | ">=" -> l >= r + | "&&" -> l && r + | "!!" -> l !! r + | _ -> failure ("unknown operation %s\n", op) + esac } diff --git a/src/SM.lama b/src/SM.lama index 5e9e82bd9..a5f519513 100644 --- a/src/SM.lama +++ b/src/SM.lama @@ -24,10 +24,24 @@ public fun showSM (prg) { map (fun (i) {showSMInsn (i) ++ "\n"}, prg).stringcat } +fun evalInsn (c, i) { + case i of + READ -> case readWorld (c.trd) of [z, w_] -> c . onFst (fun (st) { z : st }) . onTrd (fun (_) { w_ }) esac + | WRITE -> case c.fst of z : st -> c . onFst (fun (_) { st }) . onTrd (fun (w) { writeWorld (z, w) }) esac + | BINOP (s) -> case c.fst of y : x : st -> c . onFst (fun (_) { evalOp (s, x, y) : st }) esac + | LD (x) -> c . onFst (fun (st) { (c.snd) (x) : st }) + | ST (x) -> case c.fst of z : st -> c . onFst (fun (_) { st }) . onSnd (fun (s) { s <- [x, z] }) esac + | CONST (n) -> c . onFst (fun (st) { n : st }) + esac +} + -- Stack machine interpreter. Takes an SM-configuration and a program, -- returns a final configuration fun eval (c, insns) { - failure ("SM eval not implemented\n") + case insns of + {} -> c + | insn : oinsns -> c . evalInsn (insn) . eval (oinsns) + esac } -- Runs a stack machine for a given input and a given program, returns an output @@ -35,15 +49,53 @@ public fun evalSM (input, insns) { eval ([{}, emptyState, createWorld (input)], insns)[2].getOutput } +-- Functions for work with state of Stack machine +fun onFst (triple, f) { + case triple of + [x, y, z] -> [f (x), y, z] + | _ -> failure ("object is not a triple\n") + esac +} + +fun onSnd (triple, f) { + case triple of + [x, y, z] -> [x, f (y), z] + | _ -> failure ("object is not a triple\n") + esac +} + +fun onTrd (triple, f) { + case triple of + [x, y, z] -> [x, y, f (z)] + | _ -> failure ("object is not a triple\n") + esac +} + +fun trd (object) { + case object of + [_, _, z] -> z + esac +} + -- Compiles an expression into a stack machine code. -- Takes an expression, returns a list of stack machine instructions fun compileExpr (expr) { - failure ("compileExpr not implemented\n") + case expr of + Var (name) -> { LD (name) } + | Const (num) -> { CONST (num) } + | Binop (op, l, r) -> compileExpr (l) +++ compileExpr (r) +++ { BINOP (op) } + esac } -- Compiles a statement into a stack machine code. -- Takes a statement, returns a list of stack machine -- instructions. public fun compileSM (stmt) { - failure ("compileSM not implemented\n") + case stmt of + Assn (name, expr) -> compileExpr (expr) +++ { ST (name) } + | Seq (stmt1, stmt2) -> compileSM (stmt1) +++ compileSM (stmt2) + | Skip -> {} + | Read (name) -> { READ, ST (name) } + | Write (expr) -> compileExpr (expr) +++ { WRITE } + esac } diff --git a/src/Stmt.lama b/src/Stmt.lama index 67ec6db9e..1fee6f1cf 100644 --- a/src/Stmt.lama +++ b/src/Stmt.lama @@ -17,7 +17,28 @@ import World; -- Write (expr) | fun eval (c, stmt) { - failure ("Stmt eval not implemented\n") + case stmt of + Assn (name, expr) -> c . onFst (fun (s) { s <- [name, evalExpr (s, expr) ] }) + | Seq (stmt1, stmt2) -> c . eval (stmt1) . eval (stmt2) + | Skip -> c + | Read (name) -> case readWorld (c.snd) of [z, w_] -> c . onFst (fun (s) { s <- [name, z] }) . onSnd (fun (_) { w_ }) esac + | Write (expr) -> c . onSnd (fun (w) { writeWorld (evalExpr(c.fst, expr), w) }) + esac +} + +-- Functions for work with state of Statement evaluator +fun onFst (pair, f) { + case pair of + [x, y] -> [f (x), y] + | _ -> failure ("object is not a pair\n") + esac +} + +fun onSnd (pair, f) { + case pair of + [x, y] -> [x, f (y)] + | _ -> failure ("object is not a pair\n") + esac } -- Evaluates a program with a given input and returns an output diff --git a/src/X86.lama b/src/X86.lama index f26d83d37..b63fc983f 100644 --- a/src/X86.lama +++ b/src/X86.lama @@ -46,7 +46,7 @@ var wordSize = 4; -- Call (string) -- calls a function by its name -- Ret -- returns from a function -- Meta (string) -- metainformation (declarations, etc.) - + -- Machine instruction printer fun insnString (insn) { @@ -253,25 +253,54 @@ fun memOpnd (opnd) { -- Generates a move between locations, using -- intermediate register if needed fun move (from, to) { - if memOpnd (from) && memOpnd (to) - then singletonBuffer (Mov (from, eax)) <+ Mov (eax, to) - else singletonBuffer (Mov (from, to)) + if from.compare(to) == 0 + then emptyBuffer () + else + if memOpnd (from) && memOpnd (to) + then singletonBuffer (Mov (from, eax)) <+ Mov (eax, to) + else singletonBuffer (Mov (from, to)) + fi fi } --- Gets a suffix for Set instruction from --- source language comparison operator -fun suffix (op) { - case op of - "<" -> "l" - | "<=" -> "le" - | "==" -> "e" - | "!=" -> "ne" - | ">=" -> "ge" - | ">" -> "g" +-- Generates an operation with optional moving of arguments to %eax and %edx +-- (for operation which can't work with two arbitrary memory cells) +fun binop (op, l, r) { + case ( + if memOpnd (l) + then [fun (code) { move (l, edx) <+> code }, edx] + else [id, l] + fi) of [fCode, l2] -> + case ( + if op.compare("*") == 0 && memOpnd (r) + then [fun (code) { fCode (move (r, eax) <+> code <+> move (eax, r)) }, eax] + else [fCode, r] + fi) of [fCode, r2] -> + Binop (op, l2, r2) . singletonBuffer . fCode + esac esac } +-- Gets a one-byte subregister of given four-byte register +fun set (op, R (i)) { + Set ( + case op of + "<" -> "l" + | "<=" -> "le" + | "==" -> "e" + | "!=" -> "ne" + | ">=" -> "ge" + | ">" -> "g" + esac, + case regs[i] of + "%ebx" -> "%bl" + | "%ecx" -> "%cl" + | "%eax" -> "%al" + | "%edx" -> "%dl" + esac + ) . singletonBuffer +} + -- Compiles stack machine code into a list of x86 instructions. Takes an environment -- and stack machine code, returns an updated environment and x86 code. fun compile (env, code) { @@ -287,11 +316,62 @@ fun compile (env, code) { case env.pop of [s, env] -> [env, code <+ Push (s) <+ Call ("Lwrite") <+ Pop (eax)] esac - | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string) + | BINOP (s) -> + case env.pop2 of [y, x, env] -> + case env.allocate of [z, env] -> + [env, code <+> compileOp(s, x, y, z)] + esac + esac + | LD (x) -> + case env.allocate of [s, env] -> + [env, code <+> move (env.loc (x), s)] + esac + | ST (x) -> + case env.addGlobal (x) of env -> + case env.pop of [v, env] -> + [env, code <+> move (v, env.loc (x))] + esac + esac + | CONST (n) -> + case env.allocate of [s, env] -> + [env, code <+> move (L (n), s)] + esac esac }, [env, emptyBuffer ()], code) } +-- Compile operation x (+) y = z +fun compileOp (op, x, y, z) { + case op of + "+" -> + binop ("+", y, x) <+> move (x, z) + | "-" -> + binop ("-", y, x) <+> move (x, z) + | "*" -> + binop ("*", y, x) <+> move (x, z) + | "/" -> + move (x, eax) <+ Cltd <+ IDiv (y) <+> move (eax, z) + | "%" -> + move (x, eax) <+ Cltd <+ IDiv (y) <+> move (edx, z) + | "==" -> + move (L (0), eax) <+> binop ("cmp", y, x) <+> set ("==", eax) <+> move (eax, z) + | "!=" -> + move (L (0), eax) <+> binop ("cmp", y, x) <+> set ("!=", eax) <+> move (eax, z) + | "<" -> + move (L (0), eax) <+> binop ("cmp", y, x) <+> set ("<", eax) <+> move (eax, z) + | "<=" -> + move (L (0), eax) <+> binop ("cmp", y, x) <+> set ("<=", eax) <+> move (eax, z) + | ">" -> + move (L (0), eax) <+> binop ("cmp", y, x) <+> set (">", eax) <+> move (eax, z) + | ">=" -> + move (L (0), eax) <+> binop ("cmp", y, x) <+> set (">=", eax) <+> move (eax, z) + | "&&" -> + move (L (0), eax) <+> binop ("cmp", L (0), x) <+> set ("!=", eax) <+> move (L (0), edx) <+> binop ("cmp", L (0), y) <+> set ("!=", edx) <+> binop ("&&", edx, eax) <+> move (eax, z) + | "!!" -> + move (L (0), eax) <+> binop ("cmp", L (0), x) <+> set ("!=", eax) <+> move (L (0), edx) <+> binop ("cmp", L (0), y) <+> set ("!=", edx) <+> binop ("!!", edx, eax) <+> move (eax, z) + esac +} + -- A top-level codegeneration function. Takes a stack machine program -- and returns x86 listing as a string public fun compileX86 (code) {