From 0bdf7742d4b2a053f19ea696d74c78b9526d1169 Mon Sep 17 00:00:00 2001 From: grigory Date: Sat, 9 Dec 2023 23:59:56 +0300 Subject: [PATCH] Task 7 --- src/Expr.lama | 99 ++++++++++++++- src/Parser.lama | 29 ++++- src/SM.lama | 316 +++++++++++++++++++++++++++++++++++++++++++----- src/X86.lama | 186 +++++++++++++++++++++++++++- 4 files changed, 598 insertions(+), 32 deletions(-) diff --git a/src/Expr.lama b/src/Expr.lama index 6c113aa5f3..bce2b54c19 100644 --- a/src/Expr.lama +++ b/src/Expr.lama @@ -103,7 +103,104 @@ fun evalList (c, exprs) { } fun eval (c@[s, w], expr) { - failure ("evalExpr not implemented\n") + case expr of + Assn (x, e) -> + case evalList (c, {x, e}) of + [[st, w], {Ref (x), n}] -> [[st <- [x, n], w], n] + | [c, {ElemRef (xs, i), n}] -> [c, xs[i] := n] + esac + | Set (n, e) -> eval (c, Assn (Ref (n), e)) + | Seq (l, r) -> + case evalList (c, {l, r}) of + [c, {_, x}] -> [c, x] + esac + | Skip -> [c, Z] + | If (cnd, t, f) -> + case eval (c, cnd) of + [c, cnd] -> if cnd then eval (c, t) else eval (c, f) fi + esac + | While (cnd, b) -> + case eval (c, cnd) of + [c, cnd] -> if cnd then eval (eval (c, b) [0], expr) else [c, Z] fi + esac + + | DoWhile (b, cnd) -> + case eval (eval (c, b) [0], cnd) of + [c, cnd] -> if cnd then eval (c, expr) else [c, Z] fi + esac + + | Var (n) -> [c, lookup (s, n)] + | Ref (n) -> [c, Ref (n)] + | Const (x) -> [c, x] + | Binop (op, le, re) -> + case evalList (c, {le, re}) of + [c, {le, re}] -> [c, evalOp (op, le, re)] + esac + | Ignore (e) -> case eval (c, e) of [c, _] -> [c, Z] esac + | Scope (ds, expr) -> + case eval ( + [ foldl ( + fun (s, d) { + case d of + Var (names) -> addNames (s, names) + | Fun (name, args, body) -> addFunction (s, name, args, body) + esac + }, s.enterScope, ds + ), + w ], expr) of + [ [s, w], n] -> + [ [leaveScope (s), w], n] + esac + | Call (funName, argExprs) -> + case lookup (s, funName) of + Fun (argNames, bodyExpr) -> + case evalList (c, argExprs) + of [[sNew, w], argVals] -> + case bodyExpr of + External -> + case evalBuiltin (funName, argVals, w) of + [res, w] -> [[s, w], res] + esac + | _ -> + case eval ( + [ foldl ( + fun (s, [name, v]) { addName (s, name, v) }, + enterFunction (sNew), + zip (argNames, argVals) + ), + w ], bodyExpr) of + [ [sNew, w], res ] -> + [ [leaveFunction (s, getGlobal (sNew)), w ], res] + esac + esac + esac + esac + | String (s) -> [c, s] + | Array (es) -> + case evalList (c, es) of + [c, vals] -> + [c, listArray (vals)] + esac + | Sexp (s, es) -> + case evalList (c, es) of + [c, vals] -> + [c, Sexp (s, listArray (vals))] + esac + | Elem (e, ie) -> + case evalList (c, {e, ie}) of + [ c, {xs, i} ] -> + case xs of + Sexp (_, xs) -> [ c, xs [i] ] + | _ -> [ c, xs [i] ] + esac + esac + | ElemRef (e, ie) -> + case evalList (c, {e, ie}) of + [c, {xs, i}] -> + [ c, ElemRef (xs, i) ] + esac + + esac } diff --git a/src/Parser.lama b/src/Parser.lama index 0f1d00a6ea..63fa480459 100644 --- a/src/Parser.lama +++ b/src/Parser.lama @@ -147,7 +147,34 @@ var primary = memo $ eta syntax ( None -> {} | Some (args) -> args esac), loc)}} | - $(failure ("the rest of primary parsing in not implemented\n"))), + inbr [ s ("("), scopeExpr, s (")") ] | + loc=pos kSkip { fun (a) { assertVoid (a, Skip, loc) } } | + loc=pos kWhile cnd=scopeExpr kDo wrk=scopeExpr kOd { fun (a) { assertVoid (a, While (cnd (Val), wrk (Void)), loc) } } | + loc=pos kDo wrk=scopeExpr kWhile cnd=scopeExpr kOd { fun (a) { assertVoid ( a, distributeScope (wrk (Void), fun (wrk) { DoWhile (wrk, cnd (Val)) }), loc ) } } | + loc=pos kFor init=scopeExpr s[","] cnd=scopeExpr s[","] inc=scopeExpr kDo wrk=scopeExpr kOd { + fun (a) { + assertVoid ( + a, + distributeScope ( init (Void), fun (init) { Seq (init, While (cnd (Val), Seq (wrk (Void), inc (Void)))) } ), + loc + ) + } } | + + kIf wrk=ifBody {wrk} + ), + ifBody = memo $ eta syntax ( + cnd=exp kThen thn=exp els=ifTail { fun (a) { If (cnd (Val), thn (a), els (a)) } } + ), + ifTail = memo $ eta syntax ( + kElif wrk=ifBody {wrk} + | kElse wrk=exp kFi {wrk} + | kFi { fun (a) { assertVoid (a, Skip, loc) } } + ), + + + + + basic = memo $ eta (expr ({[Right, {[s (":="), fun (l, loc, r) { fun (a) {assertValue (a, Assn (l (Ref), r (Val)), loc)} diff --git a/src/SM.lama b/src/SM.lama index ec4a0fa046..aac68836a6 100644 --- a/src/SM.lama +++ b/src/SM.lama @@ -18,13 +18,17 @@ import Buffer; public fun showSMInsn (i) { -- Shows a location (a reference to function argument, local or global variable) fun showLoc (d) { + fun varity (f) { + if f then "var" else "val" fi + } + case d of Arg (i) -> sprintf ("arg[%d]", i) | Loc (i) -> sprintf ("loc[%d]", i) | Glb (x) -> sprintf ("%s", x) esac } - + case i of BINOP (s) -> sprintf ("BINOP %s", s) | LD (x) -> sprintf ("LD %s", showLoc (x)) @@ -66,7 +70,7 @@ fun initEvalEnv (insns) { esac } }) $ [emptyMap (compare), insns]; - + [fun (l) { case findMap (map, l) of Some (insns) -> insns esac }] @@ -82,7 +86,7 @@ fun fromLabel (env, lab) { fun eval (env, w, insns) { -- Global state maps names of global variables to values var globalState = ref (fun (x) {error (sprintf ("name ""%s"" is undefined", x), getLoc (x))}); - + -- Make a fresh local state: a pair of arrays for arguments and local variables; -- takes the numbers of arguments and local variables respectively fun makeState (a, l) { @@ -96,7 +100,7 @@ fun eval (env, w, insns) { | Loc (i) -> locs[i] | Loc (i) -> locs[i] | Glb (x) -> deref (globalState) (x) - esac + esac } -- Assigns a value to a location @@ -122,13 +126,80 @@ fun eval (env, w, insns) { inner (n, {}, list) } + fun evalInsn (c@[s, cs, st, w], i, is) { + case i of + JMP (l) -> [Some (env.fromLabel (l)), c] + | CJMP (cond, l) -> + case s of x:s -> + var z = case cond of "z" -> 1 | "nz" -> 0 esac; + if x == z + then [None, [s, cs, st, w]] + else [Some (env.fromLabel (l)), [s, cs, st, w]] + fi + esac + | END -> + case cs of + {} -> [Stop, c] + | [st, p] : cs -> [Some (p), [s, cs, st, w]] + esac + | CALL (fLabel, nArgs) -> + [Some (fromLabel (env, fLabel)), [s, [st, is] : cs, st, w]] + | i -> [None, case i of + BINOP (op) -> case s of y:x:s -> [evalOp (op, x, y) : s, cs, st, w] esac + | CONST (n) -> [ n:s, cs, st, w] + | LD (x) -> [ st.lookup (x) : s, cs, st, w] + | LDA (x) -> [Ref (x) : s, cs, st, w] + | STI -> case s of v:Ref (x):s -> [v:s, cs, assign (st, x, v); st, w] esac + | LABEL (l) -> c + | DROP -> case s of {} -> c | _:s -> [s, cs, st, w] esac + | GLOBAL (x) -> assign(st, Glb (x), 0); c + | BEGIN (funName, nArgs, nLocals) -> + st := makeState (nArgs, nLocals); + case take (s, nArgs) of [s, args] -> + foldl (fun (i, arg) {assign (st, Arg (i), arg); i + 1}, 0, args); + [s, cs, st, w] + esac + | BUILTIN (funName, nArgs) -> + case take (s, nArgs) of [s, args] -> + case evalBuiltin (funName, args, w) of [res, w] -> + [res : s, cs, st, w] + esac + esac + | STRING (ss) -> [ss : s, cs, st, w] + | ARRAY (n) -> + case take (s, n) of [_:s, elems] -> + [listArray (elems) : s, cs, st, w] + esac + | ELEM -> + case s of id : arr : s -> + [arr [id] : s, cs, st, w] + esac + | STA -> + case s of value : id : arr : s -> + [(arr [id] := value) : s, cs, st, w] + esac + | SEXP (tag, nValues) -> + case take (s, nValues) of [_:s, values] -> + [listArray (values) : s, cs, st, w] + esac + esac] + esac + } + -- Core interpreter: takes a configuration and a program, returns a configuration - fun eval (c@[st, cst, s, w], insns) { - failure ("SM interpreter is not implemented\n") + fun eval (env, c@[_, ct, st, w], is) { + case is of + {} -> c + | i : is -> + case evalInsn (c, i, is) of + [Some (is), c] -> eval (env, c, is) + | [None, c] -> eval (env, c, is) + | [Stop, c] -> c + esac + esac } - - - eval ([{}, {}, makeState (0, 0), w], insns) [3].getOutput + + eval (env, [{}, {}, makeState (0, 0), w], insns) [3].getOutput } -- Runs a stack machine for a given input and a given program, returns an output @@ -143,7 +214,7 @@ fun makeCompEnv (nLabels, scopeDepth, state, nLocals, nArgs, functions) { [sprintf ("L%d", nLabels), makeCompEnv (nLabels+1, scopeDepth, state, nLocals, nArgs, functions)] } - -- Adds a new function + -- Adds a new function fun rememberFun (fLabel, args, body) { makeCompEnv (nLabels, scopeDepth, @@ -188,7 +259,7 @@ fun makeCompEnv (nLabels, scopeDepth, state, nLocals, nArgs, functions) { fun addFun (name, fLabel, nargs) { makeCompEnv (nLabels, scopeDepth, addName (state, name, Fun (fLabel, nargs)), nLocals, nArgs, functions) } - + -- Enters a function fun beginFun (state) { makeCompEnv (nLabels, 2, enterFunction (state), 0, 0, functions) @@ -217,7 +288,7 @@ fun makeCompEnv (nLabels, scopeDepth, state, nLocals, nArgs, functions) { | _ -> error (sprintf ("the name ""%s"" does not designate a value", name), getLoc (name)) esac } - + -- Lookups a name of a function fun lookupFun (name) { case lookup (state, name) of @@ -236,14 +307,14 @@ fun makeCompEnv (nLabels, scopeDepth, state, nLocals, nArgs, functions) { if isGlobal () then [sprintf ("L%s", name), makeCompEnv (nLabels , scopeDepth, state, nLocals, nArgs, functions)] else [sprintf ("L%s_%d", name, nLabels), makeCompEnv (nLabels+1, scopeDepth, state, nLocals, nArgs, functions)] - fi + fi } -- Checks if the current scope is a global fun isGlobal () { scopeDepth == 2 } - + [genLabel, rememberFun, beginScope, @@ -399,23 +470,212 @@ public fun compileSM (stmt) { else emptyBuffer () fi } - + + -- Compile expression with its own label after. + fun cmpHelper (env, expr) { + case env.genLabel of [lab, env] -> + case compile (lab, env, expr) of [labUsed, env, code] -> + [env, code <+> label (lab, labUsed)] + esac + esac + } + + fun compileMany (env, stmts) { + foldl (fun ([env, code], stmt) { + case cmpHelper (env, stmt) + of [env, newCode] -> + [env, code <+> newCode] + esac + }, [env, emptyBuffer ()], stmts) + } + fun compile (lab, env, stmt) { case stmt of - Skip -> [false, env, emptyBuffer ()] - | 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") + Skip -> [false, env, emptyBuffer ()] + | Var (x) -> [false, env, singletonBuffer (LD (lookupVal (env, x)))] + | Ref (x) -> [false, env, singletonBuffer (LDA (lookupVar (env, x)))] + | Const (n) -> [false, env, singletonBuffer (CONST (n))] + | Ignore (e) -> + case cmpHelper (env, e) of + [env, code] -> [false, env, code <+ DROP] + esac + | Assn (x, e) -> + case cmpHelper (env, x) of [env, code1] -> + case cmpHelper (env, e) of [env, code2] -> + [false, env, code1 <+> code2 <+ case x of ElemRef (_, _) -> STA | _ -> STI esac] + esac + esac + | Set (name, e) -> compile (lab, env, Assn (Ref (name), e)) + | Binop (op, l, r) -> + case cmpHelper (env, l) of + [env, code1] -> + case cmpHelper (env, r) of + [env, code2] -> + [false, env, code1 <+> code2 <+ BINOP (op)] + esac + esac + | Seq (s1, s2) -> + case cmpHelper (env, s1) of [env, code1] -> + case compile (lab, env, s2) of [used, env, code2] -> + [used, env, code1 <+> code2] + esac + esac + | If (c, t, e) -> + case env.genLabel of [elseLabel, env] -> + case cmpHelper (env, c) of [env, codeC] -> + case compile (lab, env, t) of [_, env, codeT] -> + case compile (lab, env, e) of [_, env, codeE] -> + [ true, env, + codeC + <+ CJMP ("z", elseLabel) + <+> codeT + <+ JMP (lab) + <+ LABEL (elseLabel) + <+> codeE] + esac + esac + esac + esac + | While (c, b) -> + case env.genLabels (2) of [condLabel, bodyLabel, env] -> + case cmpHelper (env, c) of [env, codeC] -> + case compile (condLabel, env, b) of [_, env, codeB] -> + [false, env, + singletonBuffer (JMP (condLabel)) + <+ LABEL (bodyLabel) + <+> codeB + <+ LABEL (condLabel) + <+> codeC + <+ CJMP ("nz", bodyLabel)] + esac + esac + esac + | DoWhile (s, c) -> compile (lab, env, Seq (s, While (c, s))) + | Scope (defs, expr) -> + var globalsCode; + env := env.beginScope; + env := foldl (fun (env, def) { + case def of + Var (names) -> env.addVars (names) + | Fun (name, argNames, body) -> + case env.genFunLabel (name) of [label, env] -> + env.addFun (name, label, argNames.size) + esac + esac + }, env, defs); + globalsCode := foldl (fun (code, def) { + case def of + Var (names) -> + if env.isGlobal == 0 then code else + foldl (fun (code, name) {code <+ GLOBAL (name)}, code, names) + fi + | _ -> code + esac + }, emptyBuffer (), defs); + env := foldl(fun (env, def) { + case def of + Fun (name, argNames, body) -> + case env.lookupFun (name) of Fun (label, _) -> + env.rememberFun (label, argNames, body) + esac + | _ -> env + esac + }, env, defs); + case compile (lab, env, expr) of [used, env, code] -> + [used, env.endScope, globalsCode <+> code] + esac + | Call (name, args) -> + case env.lookupFun (name) of Fun (label, nArgs) -> + case compileMany (env, args) of [env, argsCode] -> + if args.size != nArgs + then failure ("Wrong number of arguments: %s expects %d but got %d\n", name, nArgs, args.size) + else [false, env, argsCode + <+ if label [0] == '$' then BUILTIN (name, nArgs) else CALL (label, nArgs) fi] + fi + esac + esac + | String (s) -> [false, env, singletonBuffer (STRING (s))] + | Array (exprs) -> + case compileMany (env, exprs) of [env, elemsCode] -> + [false, env, emptyBuffer() + <+ CONST (size (exprs)) -- to generate runtime Varray call properly in X86 + <+> elemsCode + <+ ARRAY (size (exprs))] + esac + | Elem (arrExpr, indexExpr) -> + case compileMany (env, {arrExpr, indexExpr}) of + [env, code] -> [false, env, code <+ ELEM] + esac + | ElemRef (arrExpr, indexExpr) -> + case compileMany (env, {arrExpr, indexExpr}) of + [env, code] -> [false, env, code] + esac + | Sexp (tag, exprs) -> + case compileMany (env, exprs) of [env, code] -> + [false, env, emptyBuffer () + <+ CONST (size (exprs) + 1) + <+> code + <+ SEXP (tag, size (exprs))] + esac + esac + } + + fun compileFun (env, Fun (fLabel, argNames, body, state)) { + env := beginFun (env, state); + env := foldl (fun (env, name) {addArg (env, name)}, env, argNames); + case cmpHelper (env, body) of [env, code] -> + [env, emptyBuffer () + <+ LABEL (fLabel) + <+ BEGIN (fLabel, argNames.size, env.getLocals) + <+> code + <+ END] esac } - case initCompEnv ().beginScope.addFun ("read" , "$read" , 0) - .addFun ("write" , "$write" , 1) - .addFun ("length", "$length", 1).genLabel of - [endLab, env] -> - case compile (endLab, env, stmt) of - [endLabUsed, _, code] -> getBuffer $ code <+> label (endLab, endLabUsed) - esac + fun compileFuns (env) { + var code = emptyBuffer (); + + var funs; + + do + var envCode; + case env.getFuns of [newFuns, newEnv] -> + funs := newFuns; + env := newEnv + esac; + envCode := foldl (fun ([env, code], f) { + case compileFun (env, f) of [env, newCode] -> + [env, code <+> newCode] + esac + }, [env, emptyBuffer ()], funs); + + case envCode + of [newEnv, newCode] -> + env := newEnv; + code := code <+> newCode + + esac + + while funs.size od; + + code + } + + var env = addFun ( + addFun ( + addFun ( + beginScope ( initCompEnv () ), "read", "$read", 0), + "write", "$write", 1), + "length", "$length", 1); + + case cmpHelper (env, stmt) of + [env, code] -> + code := getBuffer $ emptyBuffer () + <+ LABEL ("main") + <+ BEGIN ("main", 0, getLocals (env)) + <+> code + <+ END + <+> compileFuns (env); + code esac -} +} \ No newline at end of file diff --git a/src/X86.lama b/src/X86.lama index 19e59e9b5a..586a5eac7f 100644 --- a/src/X86.lama +++ b/src/X86.lama @@ -444,6 +444,17 @@ fun suffix (op) { esac } +fun pushNTimes (env, nArgs) { + if nArgs == 0 then [emptyBuffer (), env] else + case env.pop of [s, env] -> + case pushNTimes (env, nArgs - 1) of + [code, env] -> + [singletonBuffer (Push (s)) <+> code, env] + esac + esac + fi +} + -- 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) { @@ -477,8 +488,179 @@ fun compile (env, code) { -- 1. generate proper prologue for BEGIN instruction (use "prologue" helper); use -- env.enterFunction to create a proper environment; -- 2. generate epilogue for END instruction. - - | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string) + + + | BINOP (op) -> + case env.pop2 of [x, y, env] -> + case env.allocate of [r, env] -> + var newCode = case op of + "+" -> code <+> move (y, eax) <+ Binop ("+", x, eax) <+> move (eax, r) + | "-" -> code <+> move (y, eax) <+ Binop ("-", x, eax) <+> move (eax, r) + | "*" -> code <+> move (y, eax) <+ Binop ("*", x, eax) <+> move (eax, r) + | "/" -> code <+> move (y, eax) <+ Cltd <+ IDiv (x) <+> move (eax, r) + | "%" -> code <+> move (y, eax) <+ Cltd <+ IDiv (x) <+> move (edx, r) + | "&&" -> code + <+> move (L (0), eax) <+ Binop ("cmp", L (0), x) <+ Set (suffix ("!="), "%al") + <+> move (L (0), edx) <+ Binop ("cmp", L (0), y) <+ Set (suffix ("!="), "%dl") + <+ Binop("&&", edx, eax) <+> move (eax, r) + | "!!" -> code + <+> move (L (0), eax) <+ Binop ("cmp", L (0), x) <+ Set (suffix ("!="), "%al") + <+> move (L (0), edx) <+ Binop ("cmp", L (0), y) <+ Set (suffix ("!="), "%dl") + <+ Binop("!!", edx, eax) <+> move(eax, r) + | _ -> code <+> move (y, edx) <+ Binop ("^", eax, eax) <+ Binop ("cmp", x, edx) + <+ Set ( op.suffix, "%al" ) <+> move (eax, r) + esac; + [env, newCode] + esac + esac + | CONST (n) -> + case env.allocate of + [s, env] -> [env, code <+> move (L (n), s)] + esac + | JMP (n) -> [setBarrier (env.setStack (n)), code <+ Jmp (n)] + | CJMP (c, n) -> + case env.pop of + [s, env] -> + [ env.setStack (n), code <+ Binop ("^", L (0), s) <+ CJmp (c, n) ] + esac + | LABEL (n) -> [ if env.isBarrier then env.retrieveStack (n) else env fi , code <+ Label (n) ] + | LD (x) -> + case env.allocate of + [s, env] -> [env, code <+> move (loc (env, x), s)] + esac + | LDA (x) -> + case env.allocate of + [s, env] -> [env, code <+ Lea (loc (env, x), eax) <+> move (eax, s)] + esac + | ST (x) -> + case env.pop of + [s, env] -> + case env.allocate of + [r, env] -> + [ env.addGlobal (x), code <+> move (s, env.loc (x)) <+> move (s, r)] + esac + esac + | STI -> + case env.pop2 of + [s, x, env] -> case env.allocate of + [r, env] -> + [ env, code <+> move (s, I (0, x)) <+> move (s, r) ] + esac + esac + | DROP -> + case env.pop of + [_, env] -> [env, code] + esac + | GLOBAL (name) -> [env.addGlobal (name), code] + + | CALL (fLabel, argsNum) -> + var liveRegs = liveRegisters(env, argsNum); + case env . pushNTimes (argsNum) of + [pushArgsCode, env] -> + case env.allocate of [resultLoc, env] -> + [env, code + <+> foldl (fun (code, reg) { code <+ Push (reg) }, emptyBuffer (), liveRegs) + <+> pushArgsCode + <+ Call (fLabel) + <+ Mov (eax, resultLoc) + <+ Binop ("+", L (wordSize * argsNum), esp) + <+> foldl (fun (code, reg) { code <+ Pop (reg) }, emptyBuffer (), liveRegs ) ] + esac + esac + | BEGIN (fLabel, _, lcls) -> [ enterFunction (env, fLabel, lcls), code <+> prologue (fLabel) ] + | END -> + case env.epilogue of [env, eCode] -> + [env, code <+> eCode] + esac + | BUILTIN (name, nArgs) -> + var liveRegs = liveRegisters (env, nArgs); + case pushNTimes (env, nArgs) of [pushArgsCode, env] -> + case env.allocate of [resultLoc, env] -> + [env, code + <+> foldl (fun (code, reg) { code <+ Push (reg) }, emptyBuffer (), liveRegs) + <+> pushArgsCode + <+ Call ( "L" ++ name ) + <+ Mov (eax, resultLoc) + <+ Binop ("+", L (nArgs * wordSize), esp) + <+> foldl (fun (code, reg) { code <+ Pop (reg) }, emptyBuffer (), liveRegs.reverse) ] + esac + esac + | STRING (s) -> + case addString (env, s) of [env, label] -> + case env.allocate of [s, env] -> + var liveRegs = liveRegisters(env, 1); + case pushNTimes (env, 1) of + [pushArgsCode, env] -> + case env.allocate of + [resultLoc, env] -> + [env, code <+ Lea (M (label), s) + <+> foldl (fun (code, reg) { code <+ Push (reg) }, emptyBuffer (), liveRegs) + <+> pushArgsCode + <+ Call ("Bstring") + <+ Mov (eax, resultLoc) + <+ Binop ("+", L (1 * wordSize), esp) + <+> foldl (fun (code, reg) { code <+ Pop (reg) }, emptyBuffer (), liveRegs.reverse) ] + esac + esac + esac + esac + | ARRAY (len) -> + var liveRegs = liveRegisters(env, len + 1); + case pushNTimes (env, len + 1) of + [pushArgsCode, env] -> + case env.allocate of + [resultLoc, env] -> + [env, code + <+> foldl (fun (code, reg) { code <+ Push (reg) }, emptyBuffer (), liveRegs) + <+> pushArgsCode + <+ Call ("Barray") + <+ Mov (eax, resultLoc) + <+ Binop ("+", L ( (len + 1) * wordSize), esp) + <+> foldl (fun (code, reg) { code <+ Pop (reg) }, emptyBuffer (), liveRegs.reverse) ] + esac + esac + | STA -> + var liveRegs = liveRegisters (env, 3); + case pushNTimes (env, 3) of [pushArgsCode, env] -> + case env.allocate of [resultLoc, env] -> + [env, code + <+> foldl (fun (code, reg) { code <+ Push (reg) }, emptyBuffer (), liveRegs) + <+> pushArgsCode + <+ Call ("Bsta") + <+ Mov (eax, resultLoc) + <+ Binop ("+", L (3 * wordSize), esp) + <+> foldl (fun (code, reg) { code <+ Pop (reg) }, emptyBuffer (), liveRegs.reverse) ] + esac + esac + | ELEM -> + var liveRegs = liveRegisters (env, 2); + case pushNTimes (env, 2) of [pushArgsCode, env] -> + case env.allocate of [resultLoc, env] -> + [env, code + <+> foldl (fun (code, reg) { code <+ Push (reg) }, emptyBuffer (), liveRegs) + <+> pushArgsCode + <+ Call ("Belem") + <+ Mov (eax, resultLoc) + <+ Binop ("+", L (2 * wordSize), esp) + <+> foldl (fun (code, reg) { code <+ Pop (reg) }, emptyBuffer (), liveRegs.reverse) ] + esac + esac + | SEXP (tag, nValues) -> + case env.allocate of [loc, env] -> + var liveRegs = liveRegisters(env, nValues + 2); + + case pushNTimes (env, nValues + 2) of [pushArgsCode, env] -> + case env.allocate of [resultLoc, env] -> + [env, code <+> move (L (tagHash (tag)), loc) + <+> foldl (fun (code, reg) { code <+ Push (reg) }, emptyBuffer (), liveRegs) + <+> pushArgsCode + <+ Call ("Bsexp") + <+ Mov (eax, resultLoc) + <+ Binop ("+", L ( (nValues + 2) * wordSize), esp) + <+> foldl (fun (code, reg) { code <+ Pop (reg) }, emptyBuffer (), liveRegs.reverse) ] + esac + esac + esac esac }, [env, emptyBuffer ()], code) }