Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 17 additions & 1 deletion src/Expr.lama
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,23 @@ fun evalList (c, exprs) {
}

fun eval (c@[s, w], expr) {
failure ("evalExpr not implemented\n")
case expr of
Const (n) -> [c, n]
| Var (x) -> [c, s(x)]
| Ref (x) -> [c, Ref (x)]
| Binop (op, e1, e2) -> let [c, {l, r}] = evalList(c, {e1, e2}) in [c, evalOp(op, l, r)]
| Skip -> [c, 0]
| Assn (e1, e2) -> let [c@[s, w], {Ref (x), v}] = evalList(c, {e1, e2}) in [[s <- [x, v], w], v]
| Read (x) -> let [z, w1] = readWorld(w) in [[s <- [x, z], w1], 0]
| Write (e) -> let [c@[s1, w1], v] = eval(c, e) in [[s1, writeWorld(v, w1)], v]
| Seq (e1, e2) -> let [c1, v] = eval(c, e1) in eval(c1, e2)
| If (e, s1, s2) -> let [c1, n] = eval(c, e) in if (n != 0) then eval(c1, s1) else eval(c1, s2) fi
| While (e, s) -> let [c1, n] = eval(c, e) in if (n == 0) then [c1, 0] else
let [c2, v] = eval(c1, s) in eval(c2, While (e, s))
fi
| DoWhile (s, e) -> evalList(c, {s, While (e, s)})
| Ignore (e) -> let [c, v] = eval(c, e) in [c, 0]
esac
}


Expand Down
27 changes: 25 additions & 2 deletions src/Parser.lama
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,6 @@ fun binop (op) {
var primary = memo $ eta syntax (
-- decimal constant
loc=pos x=decimal {fun (a) {assertValue (a, Const (stringInt (x)), loc)}} |

-- identifier
x=lident {fun (a) {
case a of
Expand All @@ -64,7 +63,31 @@ var primary = memo $ eta syntax (
| _ -> Var (x)
esac
}} |
$(failure ("the rest of primary parsing in not implemented\n"))),
inbr[s("("), exp, s(")")] |
loc=pos kRead x=inbr[s("("), lident, s(")")] {fun(a) { assertVoid(a, Read(x), loc) }} |
loc=pos kWrite e=inbr[s("("), exp, s(")")] {fun(a) { assertVoid(a, Write(e(Val)), loc)}} |
loc=pos kSkip {fun(a) { assertVoid(a, Skip, loc) }} |
kIf e=exp kThen s1=exp elf=(-kElif exp -kThen exp)* s2=(-kElse exp)? kFi {
fun helper (final, elf, type) {
case elf of
{} -> final
| [e, s]:elf -> If (e(Val), s(type), helper(final, elf, type))
esac
}
fun(a) {
If(e(Val), s1(a), helper (
case s2 of
None -> Skip
| Some (s) -> s(a)
esac,
elf, a))
}
} |
loc=pos kWhile e=exp kDo s=exp kOd {fun(a) { assertVoid(a, While(e(Val), s(Void)), loc) }} |
loc=pos kDo s=exp kWhile e=exp kOd {fun(a) { assertVoid(a, DoWhile(s(Void), e(Val)), loc) }} |
kFor s1=exp s[","] cond=exp s[","] s2=exp kDo s=exp kOd {
fun(a) {Seq(s1(Void), While (cond(Val), Seq(s(Void), s2(Void))))}
}),
basic = memo $ eta (expr ({[Right, {[s (":="),
fun (l, loc, r) {
fun (a) {assertValue (a, Assn (l (Ref), r (Val)), loc)}
Expand Down
141 changes: 138 additions & 3 deletions src/SM.lama
Original file line number Diff line number Diff line change
Expand Up @@ -59,8 +59,41 @@ fun fromLabel (env, lab) {

-- Stack machine interpreter. Takes an environment, an SM-configuration and a program,
-- returns a final configuration
fun eval (env, c, insns) {
failure ("SM eval not implemented\n")
fun eval (env, [s, st, w], insns) {
case insns of
{} -> [s, st, w]
| i:insns -> case i of
BINOP(op) -> let y:x:s = s in case op of
"+" -> eval(env, [(x + y):s, st, w], insns)
| "-" -> eval(env, [(x - y):s, st, w], insns)
| "*" -> eval(env, [(x * y):s, st, w], insns)
| "/" -> eval(env, [(x / y):s, st, w], insns)
| "%" -> eval(env, [(x % y):s, st, w], insns)
| "<" -> eval(env, [(x < y):s, st, w], insns)
| ">" -> eval(env, [(x > y):s, st, w], insns)
| "<=" -> eval(env, [(x <= y):s, st, w], insns)
| ">=" -> eval(env, [(x >= y):s, st, w], insns)
| "==" -> eval(env, [(x == y):s, st, w], insns)
| "!=" -> eval(env, [(x != y):s, st, w], insns)
| "&&" -> eval(env, [(x && y):s, st, w], insns)
| "!!" -> eval(env, [(x !! y):s, st, w], insns)
esac
| CONST(n) -> eval(env, [n:s, st, w], insns)
| READ -> let [z, w] = readWorld(w) in eval(env, [z:s, st, w], insns)
| WRITE -> let z:s = s in eval(env, [s, st, writeWorld(z, w)], insns)
| LD(x) -> eval(env, [st(x):s, st, w], insns)
| ST(x) -> let z:s = s in eval(env, [z:s, st <- [x, z], w], insns)
| LABEL(lab) -> eval(env, [s, st, w], insns)
| JMP(lab) -> eval(env, [s, st, w], env.fromLabel(lab))
| CJMP(c, lab) -> let x:s = s in case c of
"z" -> if x == 0 then eval(env, [s, st, w], env.fromLabel(lab)) else eval(env, [s, st, w], insns) fi
| "nz" -> if x != 0 then eval(env, [s, st, w], env.fromLabel(lab)) else eval(env, [s, st, w], insns) fi
esac
| LDA(x) -> eval(env, [Ref(x):s, st, w], insns)
| STI -> let v:Ref(x):s = s in eval(env, [v:s, st <- [x, v], w], insns)
| DROP -> let x:s = s in eval(env, [s, st, w], insns)
esac
esac
}

-- Runs a stack machine for a given input and a given program, returns an output
Expand Down Expand Up @@ -115,7 +148,109 @@ public fun compileSM (stmt) {
| Var (x) -> [false, env, singletonBuffer (LD (x))]
| Ref (x) -> [false, env, singletonBuffer (LDA (x))]
| Const (n) -> [false, env, singletonBuffer (CONST (n))]
| _ -> failure ("compileSM not implemented\n")
| Ignore (e) ->
let [eLab, env] = env.genLabel in
let [eLabUsed, env, eCode] = compile (eLab, env, e) in
[false, env,

eCode <+>
label (eLab, eLabUsed) <+
DROP]

| Binop (op, e1, e2)->
let [e1Lab, env] = env.genLabel in
let [e2Lab, env] = env.genLabel in
let [e1LabUsed, env, e1Code] = compile(e1Lab, env, e1) in
let [e2LabUsed, env, e2Code] = compile(e2Lab, env, e2) in
[false, env,

e1Code <+>
label(e1Lab, e1LabUsed) <+>
e2Code <+>
label(e2Lab, e2LabUsed) <+
BINOP(op)]

| Read (x) -> [false, env, singletonBuffer (READ) <+ ST (x) <+ DROP]
| Write (e) ->
let [eLab, env] = env.genLabel in
let [eLabUsed, env, eCode] = compile(eLab, env, e) in
[false, env,

eCode <+>
label(eLab, eLabUsed) <+
WRITE]

| Assn (x, e) ->
let [xLab, env] = env.genLabel in
let [eLab, env] = env.genLabel in
let [xLabUsed, env, xCode] = compile(xLab, env, x) in
let [eLabUsed, env, eCode] = compile(eLab, env, e) in
[false, env,

xCode <+>
label(xLab, xLabUsed) <+>
eCode <+>
label(eLab, eLabUsed) <+
STI]

| Seq (s1, s2) -> case env.genLabel of
[s2Lab, env] -> case compile (s2Lab, env, s1) of
[s2LabUsed, env, s1Code] -> case compile (lab, env, s2) of
[labUsed, env, s2Code] ->
[labUsed, env,

s1Code <+>
label (s2Lab, s2LabUsed) <+>
s2Code]

esac esac esac
| If (e, s1, s2) ->
let [eLab, env] = env.genLabel in
let [s2Lab, env] = env.genLabel in
let [eLabUsed, env, eCode] = compile (eLab, env, e) in
let [_, env, s1Code] = compile (lab, env, s1) in
let [_, env, s2Code] = compile (lab, env, s2) in
[true, env,

eCode <+>
label (eLab, eLabUsed) <+
CJMP ("z", s2Lab) <+>
s1Code <+
JMP (lab) <+
LABEL (s2Lab) <+>
s2Code]

| While (e, s) ->
let [eLab, env] = env.genLabel in
let [codeLab, env] = env.genLabel in
let [condLab, env] = env.genLabel in
let [eLabUsed, env, eCode] = compile (eLab, env, e) in
let [_, env, code] = compile (condLab, env, s) in
[false, env,

singletonBuffer(JMP (condLab)) <+>
label (codeLab, true) <+>
code <+>
label (condLab, true) <+>
eCode <+>
label (eLab, eLabUsed) <+
CJMP("nz", codeLab)]

| DoWhile (s, e) ->
let [eLab, env] = env.genLabel in
let [codeLab, env] = env.genLabel in
let [condLab, env] = env.genLabel in
let [eLabUsed, env, eCode] = compile (eLab, env, e) in
let [condLabUsed, env, code] = compile (condLab, env, s) in
[false, env,

label (codeLab, true) <+>
code <+>
label (condLab, condLabUsed) <+>
eCode <+>
label (eLab, eLabUsed) <+
CJMP("nz", codeLab)]

esac
}

Expand Down
29 changes: 0 additions & 29 deletions src/Stmt.lama

This file was deleted.

127 changes: 125 additions & 2 deletions src/X86_64.lama
Original file line number Diff line number Diff line change
Expand Up @@ -52,7 +52,7 @@ var wordSize = 8;
-- Binop (string, opnd, opnd) -- makes a binary operation; note, the first operand
-- designates x86 operator, not the source language one
-- IDiv (opnd) -- x86 integer division, see instruction set reference
-- Cltd -- see instruction set reference
-- Cqto -- see instruction set reference
-- Set (string, string) -- sets a value from flags; the first operand is the
-- suffix, which determines the value being set, the
-- the second --- (sub)register name
Expand Down Expand Up @@ -92,7 +92,7 @@ fun insnString (insn) {
}

case insn of
Cltd -> "\tcqo\n"
Cqto -> "\tcqto\n"
| Set (suf, s) -> sprintf ("\tset%s\t%s\n", suf, s)
| Sal (s) -> sprintf ("\tsalq\t%s\n", s)
| IDiv (s1) -> sprintf ("\tidivq\t%s\n", opndString (s1))
Expand Down Expand Up @@ -377,6 +377,129 @@ fun compile (env, code) {
case env.pop of
[s, env] -> [env, code <+ Mov (s, rdi) <+ Call ("Lwrite")]
esac
| LD (x) ->
case env.addGlobal (x).allocate of
[s, env] -> [env, code <+> move (env.loc (x), s)]
esac
| ST (x) ->
case env.addGlobal (x).pop of
[s, env] -> [env.push(env.loc(x)), code <+> move (s, env.loc (x))]
esac
| CONST (n) ->
case env.allocate of
[s, env] -> [env, code <+> move (L (n), s)]
esac
| BINOP (op) ->
case op of
"&&" ->
case env.pop2 of
[s1, s2, env] -> case env.allocate of
[s, env] -> [env, code <+> move (L (0), rax)
<+ Binop ("cmp", rax, s1)
<+ Set ("ne", "%al")
<+> move (rax, s1)
<+> move (L (0), rax)
<+ Binop ("cmp", rax, s2)
<+ Set ("ne", "%al")
<+> move (rax, s2)
<+ Binop ("&&", s1, s2) <+> move (s2, s)]
esac
esac
| "!!" ->
case env.pop2 of
[s1, s2, env] -> case env.allocate of
[s, env] -> [env, code <+> move (L (0), rax)
<+ Binop ("cmp", rax, s1)
<+ Set ("ne", "%al")
<+> move (rax, s1)
<+> move (L (0), rax)
<+ Binop ("cmp", rax, s2)
<+ Set ("ne", "%al")
<+> move (rax, s2)
<+ Binop ("!!", s1, s2) <+> move (s2, s)]
esac
esac
| "/" ->
case env.pop2 of
[s1, s2, env] -> case env.allocate of
[s, env] -> [env, code <+> move (s2, rax)
<+ Push (rdx)
<+ Cqto
<+ IDiv (s1)
<+> move (rax, s)
<+ Pop (rdx)]
esac
esac
| "%" ->
case env.pop2 of
[s1, s2, env] -> case env.allocate of
[s, env] -> [env, code <+> move (s2, rax)
<+ Push (rdx)
<+ Cqto
<+ IDiv (s1)
<+> move (rdx, s)
<+ Pop (rdx)]
esac
esac
| "==" ->
case env.pop2 of
[s1, s2, env] -> case env.allocate of
[s, env] -> [env, code <+ Binop("cmp", s1, s2) <+ Set ("e", "%al") <+ Binop ("&&", L (1), rax) <+> move (rax, s)]
esac
esac
| "!=" ->
case env.pop2 of
[s1, s2, env] -> case env.allocate of
[s, env] -> [env, code <+ Binop("cmp", s1, s2) <+ Set ("ne", "%al") <+ Binop ("&&", L (1), rax) <+> move (rax, s)]
esac
esac
| "<" ->
case env.pop2 of
[s1, s2, env] -> case env.allocate of
[s, env] -> [env, code <+ Binop("cmp", s1, s2) <+ Set ("l", "%al") <+ Binop ("&&", L (1), rax) <+> move (rax, s)]
esac
esac
| "<=" ->
case env.pop2 of
[s1, s2, env] -> case env.allocate of
[s, env] -> [env, code <+ Binop("cmp", s1, s2) <+ Set ("le", "%al") <+ Binop ("&&", L (1), rax) <+> move (rax, s)]
esac
esac
| ">" ->
case env.pop2 of
[s1, s2, env] -> case env.allocate of
[s, env] -> [env, code <+ Binop("cmp", s1, s2) <+ Set ("g", "%al") <+ Binop ("&&", L (1), rax) <+> move (rax, s)]
esac
esac
| ">=" ->
case env.pop2 of
[s1, s2, env] -> case env.allocate of
[s, env] -> [env, code <+ Binop("cmp", s1, s2) <+ Set ("ge", "%al") <+ Binop ("&&", L (1), rax) <+> move (rax, s)]
esac
esac
| _ ->
case env.pop2 of
[s1, s2, env] -> case env.allocate of
[s, env] -> [env, code <+ Binop (op, s1, s2) <+> move (s2, s)]
esac
esac
esac
| LABEL(l) -> if isBarrier(env) then [retrieveStack(env, l), code <+ Label(l)]
else [env, code <+ Label(l)]
fi
| JMP(l) -> [setBarrier(setStack(env, l)), code <+ Jmp(l)]
| CJMP(c, l) -> case env.pop of
[s, env] -> [setBarrier(setStack(env, l)), code <+ Binop("cmp", L(0), s) <+ CJmp(c, l)]
esac
| DROP -> case env.pop of
[_, env] -> [env, code]
esac
| LDA(x) -> case env.addGlobal(x).allocate of
[s, env] -> [env, code <+ Lea(env.loc(x), s)]
esac
| STI -> case env.pop2 of
[s, ref, env] -> [env.push(s), code <+> move(s, I(0, ref))]
esac
| _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string)
esac
}, [env, emptyBuffer ()], code)
Expand Down