From 5badddeceea3436bd0a8f0b1b17c61c3a7ef7acf Mon Sep 17 00:00:00 2001 From: Mikhail Rodionychev Date: Mon, 8 Apr 2024 14:04:13 +0200 Subject: [PATCH 1/8] A07 solution --- src/Expr.lama | 103 ++++++++++++++++- src/Parser.lama | 14 ++- src/SM.lama | 289 ++++++++++++++++++++++++++++++++++++++++++++++-- src/X86.lama | 175 ++++++++++++++++++++++++++--- 4 files changed, 553 insertions(+), 28 deletions(-) diff --git a/src/Expr.lama b/src/Expr.lama index 381ebe47a5..2ab4497093 100644 --- a/src/Expr.lama +++ b/src/Expr.lama @@ -55,6 +55,7 @@ public fun evalOp (op, l, r) { -- Ignore (expr) | -- String (string) | -- Array (expr list) | +-- Sexp (string, expr list) | -- Elem (expr, expr) | -- ElemRef (expr, expr) | -- Builtin (string, expr list) @@ -86,6 +87,19 @@ fun addNames (state, names) { fun addFunction (state, name, args, body) { state.addName (name, Fun (args, body)) } + +fun addNamesVals(state, names, vals) { + foldl (fun (s, [name, value]) {s.addName(name, value)}, state, zip(names, vals)) +} + +fun addDefs(state, defs) { + foldl(fun (st, def) { + case def of + Fun(name, args, body) -> addFunction(st, name, args, body) + | Var (v) -> addNames(st, v) + esac + }, state, defs) +} -- Evaluates a list of expressions, properly threading a configurations. -- Returns the final configuration and the list of values @@ -102,7 +116,94 @@ fun evalList (c, exprs) { } fun eval (c@[s, w], expr) { - failure ("evalExpr not implemented\n") + fun set(c@[s, w], name, value) { + [[s <- [name, value], w], value] + } + + case expr of + Assn (l, r) -> + case evalList(c, {l, r}) of + [c, {l, r}] -> case l of + ElemRef (arr, ind) -> [c, arr[ind] := r] + | _ -> set(c, l, r) + esac + esac + | Set (name, expr) -> + case eval(c, expr) of + [c, value] -> set(c, name, value) + esac + | Seq (e1, e2) -> eval(eval(c, e1)[0], e2) + | Skip -> [c, T] + | If (cond, thn, els) -> + case eval(c, cond) of + [c, v] -> if v + then eval(c, thn) + else eval(c, els) + fi + esac + | While (cond, body) -> + case eval(c, cond) of + [c, v] -> if v != 0 + then eval(c, Seq(body, expr)) + else [c, T] + fi + esac + | DoWhile (body, cond) -> eval(eval(c, body)[0], While(cond, body)) + | Var (vr) -> [c, lookup(s, vr)] + | Ref (vr) -> [c, vr] + | Const (int) -> [c, int] + | Binop (op, l, r) -> + case evalList(c, {l, r}) of + [c, w : v : _] -> [c, evalOp(op, w, v)] + esac + | Ignore (exp) -> [eval(c, exp)[0], T] + | Call (f, args) -> + case lookup(s, f) of + Fun (_, External) -> eval(c, Builtin(f, args)) + | Fun(locs, body) -> + case evalList(c, args) of + [[st, w], vals] -> + case eval([addNamesVals(enterFunction(st), locs, vals), w], body) of + [[ss, w], v] -> [[leaveFunction(s, getGlobal(ss)), w], v] + esac + esac + esac + | Scope (d, e) -> + case enterScope(s) of + st -> case eval([addDefs(st, d), w], e) of + [[st, w], v] -> [[leaveScope(st), w], v] + esac + esac + | Array (elems) -> + case evalList(c, elems) of + [c, vals] -> [c, listArray(vals)] + esac + | Sexp (tag, elems) -> + case evalList(c, elems) of + [c, vals] -> [c, Sexp(tag, listArray(vals))] + esac + | Elem (arrExpr, indExpr) -> + case evalList(c, {arrExpr, indExpr}) of + [c, {arr, ind}] -> case arr of + Sexp (_, args) -> [c, args[ind]] + | _ -> [c, arr[ind]] + esac + esac + | ElemRef (arrExpr, indExpr) -> + case evalList(c, {arrExpr, indExpr}) of + [c, {arr, ind}] -> case arr of + Sexp (_, args) -> [c, ElemRef(args, ind)] + | _ -> [c, ElemRef(arr, ind)] + esac + esac + | Builtin (name, args) -> + case evalList(c, args) of + [[s, w], vals] -> case evalBuiltin(name, vals, w) of + [res, w] -> [[s, w], res] + esac + esac + | String (strng) -> [c, strng] + esac } diff --git a/src/Parser.lama b/src/Parser.lama index 0f1d00a6ea..8f1293c7f0 100644 --- a/src/Parser.lama +++ b/src/Parser.lama @@ -116,6 +116,12 @@ fun distributeScope (expr, exprConstructor) { | _ -> exprConstructor (expr) esac } + +var ifExpr = memo $ eta syntax ( + cE=exp kThen tE=scopeExpr { fun(a) { If(cE (Val), tE (a), assertVoid(a, Skip, loc))} } | + cE=exp kThen tE=scopeExpr kElse eE=scopeExpr { fun(a) { If(cE (Val), tE (a), eE (a))} } | + cE=exp kThen tE=scopeExpr kElif eE=ifExpr { fun(a) { If(cE (Val), tE (a), eE (a))} } +); var primary = memo $ eta syntax ( -- array constant @@ -147,7 +153,13 @@ 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 kIf ifE=ifExpr kFi {fun (a) {ifE (a)}} | + loc=pos kWhile cE=exp kDo bE=scopeExpr kOd {fun (a) {assertVoid(a, While(cE(Val), bE(Void)), loc)}} | + loc=pos kDo bE=scopeExpr kWhile cE=exp kOd {fun (a) {assertVoid(a, distributeScope(bE(Void), fun (expr) {DoWhile(expr, cE(Val)) }), loc)}} | + loc=pos kFor iE=scopeExpr s[","] cE=exp s[","] eE=exp kDo bE=scopeExpr kOd {fun (a) {assertVoid(a, distributeScope(iE(Void), fun (expr) {Seq(expr, While(cE(Val), Seq(bE(Void), eE(Void))))}), 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 2cc870d744..13e2f19cd8 100644 --- a/src/SM.lama +++ b/src/SM.lama @@ -18,10 +18,6 @@ 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) @@ -110,7 +106,8 @@ fun eval (env, w, insns) { | Loc (i) -> locs[i] := vl | Glb (x) -> var g = deref (globalState); globalState ::= fun (y) {if compare (x, y) == 0 then vl else g (y) fi} - esac + esac; + [args, locs] } -- Takes n positions from the list, retursn a pair: the remaining list and the taken @@ -127,8 +124,116 @@ fun eval (env, w, insns) { } -- 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 (c@[stack, cstack, st, w], insns) { + fun createLocal(stack, nargs, nlocals) { + case take(stack, nargs) of + [stack, vals] -> case foldl(fun([state, n], value) { [assign(state, Arg(n), value), n + 1] }, [makeState(nargs, nlocals), 0], vals) of + [state, _] -> [stack, state] + esac + esac + } + + fun getArr(arr) { + case arr of + Sexp (_, elems) -> elems + | _ -> arr + esac + } + + case insns of + ins:insns -> -- printf("%s\n%s\n", ins.string, stack.string); + case ins of + READ -> + case readWorld(w) of + [v, nw] -> eval([v:stack, cstack, st, nw], insns) + esac + | WRITE -> + case stack of + z:rst -> eval([rst, cstack, st, writeWorld(z, w)], insns) + esac + | BINOP (s) -> + case stack of + y:x:rst -> eval([evalOp(s, x, y):rst, cstack, st, w], insns) + esac + | LD (x) -> eval([lookup(st, x):stack, cstack, st, w], insns) + | ST (x) -> + case stack of + z:rst -> eval([rst, cstack, assign(st, x, z), w], insns) + esac + | CONST (n) -> eval([n:stack, cstack, st, w], insns) + | LABEL (l) -> eval(c, insns) + | JMP (l) -> eval(c, fromLabel(env, l)) + | CJMP (cn, l) -> + case stack of + h:stack -> + case h of + 0 -> case cn of + "nz" -> eval([stack, cstack, st, w], insns) + | "z" -> eval([stack, cstack, st, w], fromLabel(env, l)) + esac + | _ -> case cn of + "nz" -> eval([stack, cstack, st, w], fromLabel(env, l)) + | "z" -> eval([stack, cstack, st, w], insns) + esac + esac + esac + | LDA (x) -> eval([Ref(x):stack, cstack, st, w], insns) + | STI -> + case stack of + v:Ref(x):stack -> eval([v:stack, cstack, assign(st, x, v), w], insns) + esac + | DROP -> + case stack of + _:stack -> eval([stack, cstack, st, w], insns) + | _ -> eval([[], cstack, st, w], insns) + esac + | DUP -> + case stack of + x:stack -> eval([x:x:stack, cstack, st, w], insns) + esac + | CALL (fLabel, _) -> eval([stack, [st, insns]:cstack, st, w], fromLabel(env, fLabel)) + | BEGIN (_, nargs, nlocals) -> + case createLocal(stack, nargs, nlocals) of + [stack, st] -> eval([stack, cstack, st, w], insns) + esac + | END -> + case cstack of + [st, p]:cstack -> eval([stack, cstack, st, w], p) + | {} -> c + esac + | GLOBAL (x) -> eval([stack, cstack, assign(st, Glb(x), 0), w], insns) + | STRING (s) -> eval([s:stack, cstack, st, w], insns) + | ARRAY (len) -> + case take(stack, len) of + [rst, elems] -> eval([listArray(elems) : rst, cstack, st, w], insns) + esac + | SEXP (name, len) -> + case take(tl(stack), len) of + [rst, elems] -> eval([Sexp(name, listArray(elems)) : rst, cstack, st, w], insns) + esac + | STA -> + case stack of + value : idx : arr : rst -> + var a = getArr(arr); + a[idx] := value; + eval([a[idx]:rst, cstack, st, w], insns) + esac + | ELEM -> + case stack of + idx : arr : rst -> + var a = getArr(arr); + eval([a[idx]:rst, cstack, st, w], insns) + esac + | BUILTIN (func, nargs) -> + case take(stack, nargs) of + [rst, args] -> + case evalBuiltin(func, args, w) of + [res, w] -> eval([res:rst, cstack, st, w], insns) + esac + esac + esac + | _ -> c + esac } @@ -403,23 +508,187 @@ public fun compileSM (stmt) { else emptyBuffer () fi } + + fun compileWLabel(env, expr) { + case env.genLabel of + [lbl, env] -> + case compile(lbl, env, expr) of + [labelUsed, env, code] -> [env, code <+> label(lbl, labelUsed)] + esac + esac + } + + fun compileMany(env, exprs) { + foldl(fun ([env, code], expr) { + case compileWLabel(env, expr) of + [env, exprCode] -> [env, code <+> exprCode] + esac + }, [env, emptyBuffer()], exprs) + } fun compile (lab, env, stmt) { + -- printf("%s\n", stmt.string); case stmt of Skip -> [false, env, emptyBuffer ()] - | Var (x) -> [false, env, singletonBuffer (LD (x))] - | Ref (x) -> [false, env, singletonBuffer (LDA (x))] + | Var (x) -> [false, env, singletonBuffer (LD (lookupVal(env, x)))] + | Ref (x) -> [false, env, singletonBuffer (LDA (lookupVal(env, x)))] | Const (n) -> [false, env, singletonBuffer (CONST (n))] + | Ignore (x) -> + case compileWLabel(env, x) of + [env, eCode] -> [false, env, eCode <+ DROP] + esac + + | Binop (op, l, r) -> + case compileWLabel(env, l) of + [env, lCode] -> + case compileWLabel(env, r) of + [env, rCode] -> [false, env, lCode <+> rCode <+ BINOP(op)] + esac + esac + + | Assn (x, e) -> + case compileWLabel(env, e) of + [env, eCode] -> + case compileWLabel(env, x) of + [env, xCode] -> + case x of + ElemRef (_, _) -> [false, env, xCode <+> eCode <+ STA] + | _ -> [false, env, xCode <+> eCode <+ STI] + esac + esac + esac + + | 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) -> + case compileWLabel(env, e) of + [env, eCode] -> + case env.genLabel of + [s2Lab, env] -> + case compile(lab, env, s1) of + [_, env, s1Code] -> + case compile(lab, env, s2) of + [_, env, s2Code] -> [true, env, eCode <+ CJMP("z", s2Lab) <+> s1Code <+ JMP(lab) <+> label(s2Lab, true) <+> s2Code] + esac + esac + esac + esac + + | While (e, s) -> + case compileWLabel(env, e) of + [env, eCode] -> + case env.genLabels(2) of + [le, ls, env] -> + case compile(le, env, s) of + [_, env, sCode] -> [false, env, singletonBuffer(JMP(le)) <+> label(ls, true) <+> sCode <+> label(le, true) <+> eCode <+ CJMP("nz", ls)] + esac + esac + esac + + | DoWhile (s, e) -> + case compileWLabel(env, e) of + [env, eCode] -> + case env.genLabels(2) of + [ls, lbe, env] -> + case compile(lbe, env, s) of + [lbeUsed, env, sCode] -> [false, env, label(ls, true) <+> sCode <+> label(lbe, true) <+> eCode <+ CJMP("nz", ls)] + esac + esac + esac + + | Call (func, args) -> + case lookupFun(env, func) of + Fun (fLabel, nargs) -> + case foldl(fun ([env, code], expr) { case compileWLabel(env, expr) of + [env, eCode] -> [env, code <+> eCode] + esac + }, [env, emptyBuffer()], args) of + [env, code] -> if (fLabel[0] != '$') + then [false, env, code <+ CALL(fLabel, nargs)] + else [false, env, code <+ BUILTIN(func, nargs)] + fi + esac + esac + + | Scope (defs, body) -> + case foldl(fun ([env, funcs, globalDefs], def) { + case def of + Var (ds) -> [addVars(env, ds), funcs, if env.isGlobal + then foldl (fun (globalDefs, name) { globalDefs <+ GLOBAL(name) }, globalDefs, ds) + else globalDefs + fi] + | Fun (name, args, body) -> + case genFunLabel(env, name) of + [fLabel, env] -> [addFun(env, name, fLabel, args.size), [fLabel, args, body] : funcs, globalDefs] + esac + esac + }, [beginScope (env), {}, emptyBuffer()], defs) of + [env, funcs, globalDefs] -> + case compile(lab, foldl(fun(env, [fLabel, args, body]) {rememberFun(env, fLabel, args, body)}, env, funcs), body) of + [flag, env, code] -> [flag, endScope(env), globalDefs <+> code] + esac + esac + + | Array (elems) -> + case compileMany(env, elems) of + [env, arrCode] -> [false, env, arrCode <+ ARRAY(size (elems))] + esac + + | Sexp (tag, elems) -> + case compileMany(env, elems) of + [env, arrCode] -> [false, env, arrCode <+ CONST(tagHash(tag)) <+ SEXP(tag, size(elems))] + esac + + | Elem (arrExpr, indExpr) -> + case compileMany(env, {arrExpr, indExpr}) of + [env, code] -> [false, env, code <+ ELEM] + esac + + | ElemRef (arrExpr, indExpr) -> + case compileMany(env, {arrExpr, indExpr}) of + [env, code] -> [false, env, code] + esac + + | String (strng) -> [false, env, singletonBuffer(STRING(strng))] + | Set (l, r) -> compile(lab, env, Assn(Ref(l), r)) | _ -> failure ("compileSM not implemented\n") esac } + fun compileFunc(env, Fun (fLabel, args, body, state)) { + case compileWLabel(addArgs(beginFun(env, state), args), body) of + [env, code] -> [env, singletonBuffer(LABEL(fLabel)) <+ BEGIN(fLabel, args.size, getLocals(env)) <+> code <+ END] + esac + } + + fun compileFuncs(env) { + case getFuns(env) of + [{}, _] -> emptyBuffer() + | [funcs, env] -> case foldl(fun ([env, code], func) { + case compileFunc(env, func) of + [env, funcCode] -> [env, code <+> funcCode] + esac + }, [env, emptyBuffer()], funcs) of + [env, funcsCode] -> funcsCode <+> compileFuncs(env) + esac + 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) + [endLabUsed, env, code] -> getBuffer $ singletonBuffer(LABEL("main")) <+ BEGIN("main", 0, getLocals(env)) <+> code <+> label (endLab, endLabUsed) <+ END <+> compileFuncs(env) esac esac } diff --git a/src/X86.lama b/src/X86.lama index c24b7b5125..69c86a07f2 100644 --- a/src/X86.lama +++ b/src/X86.lama @@ -24,6 +24,8 @@ var ebx = R (0), ebp = R (6), esp = R (7); +var dl = "%dl"; + -- We need to know the word size to calculate offsets correctly var wordSize = 4; @@ -52,11 +54,6 @@ var wordSize = 4; -- Call (string) -- calls a function by its name -- Ret -- returns from a function -- Meta (string) -- metainformation (declarations, etc.) --- --- Dec (opnd) -- arithmetic correction: decrement --- Or1 (opnd) -- arithmetic correction: or 0x0001 --- Sal1 (opnd) -- arithmetic correction: shl 1 --- Sar1 (opnd) -- arithmetic correction: shr 1 -- Machine instruction printer fun insnString (insn) { @@ -103,10 +100,6 @@ fun insnString (insn) { | Jmp (l) -> sprintf ("\tjmp\t%s\n", l) | CJmp (c, l) -> sprintf ("\tj%s\t%s\n", c, l) | Meta (m) -> m - | Dec (s) -> sprintf ("\tdecl\t%s\n", opndString (s)) - | Or1 (s) -> sprintf ("\torl\t$0x0001,\t%s\n", opndString (s)) - | Sal1 (s) -> sprintf ("\tsall\t%s\n", opndString (s)) - | Sar1 (s) -> sprintf ("\tsarl\t%s\n", opndString (s)) esac } @@ -427,6 +420,7 @@ fun memOpnd (opnd) { case opnd of S (_) -> true | M (_) -> true + | I (_, _) -> true | _ -> false esac } @@ -453,20 +447,114 @@ fun suffix (op) { esac } --- Boxes an immediate value -fun makeBox (n) { - n * 2 + 1 +fun compileArithOp([op, x, y, env, code]) { + if (stackOpnd(x)) then + [env.push(x), code <+ Mov (x, eax) <+ Binop (op, y, eax) <+ Mov(eax, x)] + else + [env.push(x), code <+ Binop (op, y, x)] + fi +} + + +fun compileDivOp([op, x, y, env, code]) { + var rreg = case op of + "/" -> eax + | "%" -> edx + esac; + [env.push(y), code <+ Mov(x, eax) <+ Cltd <+ IDiv(y) <+ Mov(rreg, y)] +} + + +fun compileCmpOp([op, x, y, env, code]) { + if (stackOpnd(x) && stackOpnd(y)) then + [env.push(y), code <+ Binop("^", edx, edx) <+ Mov(x, eax) <+ Binop("cmp", y, eax) <+ Set(suffix(op), dl) <+ Mov(edx, y)] + else + [env.push(y), code <+ Binop("^", edx, edx) <+ Binop("cmp", y, x) <+ Set(suffix(op), dl) <+ Mov(edx, y)] + fi +} + + +fun compileLogicalOp([op, x, y, env, code]) { + case compileIntToBool(x, env, code) of + [env, code] -> case compileIntToBool(y, env, code) of + [env, code] -> case env.pop2 of + [by, bx, env] -> compileArithOp([op, bx, by, env, code]) + esac + esac + esac +} + + +fun compileIntToBool(int, env, code) { + [env.push(int), code <+ Binop("^", edx, edx) <+ Binop("cmp", L(0), int) <+ Set(suffix("!="), dl) <+ Mov(edx, int)] +} + + +fun compileBinop(args) { + case args[0] of + "+" -> compileArithOp(args) + | "-" -> compileArithOp(args) + | "*" -> compileArithOp(args) + | "!!" -> compileLogicalOp(args) + | "&&" -> compileLogicalOp(args) + | "/" -> compileDivOp(args) + | "%" -> compileDivOp(args) + | "<" -> compileCmpOp(args) + | "<=" -> compileCmpOp(args) + | "==" -> compileCmpOp(args) + | "!=" -> compileCmpOp(args) + | ">=" -> compileCmpOp(args) + | ">" -> compileCmpOp(args) + esac } --- Generates a fixednum representation --- conversion -fun toFixedNum (r) { - singletonBuffer (Sal1 (r)) <+ Or1 (r) +fun pushArgs(env, code, nargs) { + case nargs of + 0 -> [env, code] + | _ -> case pop(env) of + [v, env] -> pushArgs(env, code <+ Push(v), nargs - 1) + esac + esac +} + +fun popArgs(code, nargs) { + case nargs of + 0 -> code + | _ -> popArgs(code <+ Pop(edx), nargs - 1) + esac } -- 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) { + + fun compileCall(env, code, fLabel, nargs, extraArgs) { + case liveRegisters(env, nargs) of + regs -> + case foldl (fun (code, reg) {code <+ Push(reg)}, code, regs) of -- push registers + code -> + case pushArgs(env, code, nargs) of -- push args + [env, code] -> + case foldl(fun (code, arg) {code <+ Push(arg)}, code, extraArgs) of -- push extra args + code -> + case foldl(fun (code, _) {code <+ Pop(ebx)}, code <+ Call(fLabel), extraArgs) of -- pop extra args + code -> + case popArgs(code, nargs) of -- pop args + code -> + case allocate(env) of + [s, env] -> + case foldr(fun(code, reg) {code <+ Pop(reg)}, code, regs) of -- pop registers + code -> [env, code <+ Mov(eax, s)] + esac + esac + esac + esac + esac + esac + esac + esac + } + fun compile (env, code) { foldl ( fun ([env, scode], i) { @@ -481,6 +569,61 @@ fun compile (env, code) { case env.pop of [s, env] -> [env, code <+ Push (s) <+ Call ("Lwrite") <+ Pop (eax)] esac + | LD (x) -> + case allocate(env) of + [s, env] -> [env, code <+> move (loc (env, x), s)] + esac + | ST (x) -> + case pop(env) of + [s, env] -> [env, code <+> move (s, loc (env, x))] + esac + | BINOP (op) -> + case pop2(env) of + [y, x, env] -> compileBinop([op, x, y, env, code]) + esac + | CONST (x) -> + case allocate(env) of + [s, env] -> [env, code <+> move(L(x), s)] + esac + | LABEL (l) -> [if isBarrier(env) then retrieveStack(env, l) else env fi, code <+ Label(l)] + | JMP (l) -> [setBarrier(setStack(env, l)), code <+ Jmp(l)] + | CJMP (c, l) -> + case pop(env) of + [s, env] -> [setStack(env, l), code <+ Binop("cmp", L(0), s) <+ CJmp(c, l)] + esac + | LDA (x) -> + case allocate(env) of + [s, env] -> [env, code <+ Lea (loc(env, x), eax) <+ Mov(eax, s)] + esac + | STI -> + case pop2(env) of + [v, x, env] -> [push(env, v), code <+> move(v, I(0, x))] + esac + | DROP -> [pop(env)[1], code] + | DUP -> + case peek(env) of + v -> + case allocate(env) of + [s, env] -> [env, code <+> move(v, s)] + esac + esac + | CALL (fLabel, nargs) -> compileCall(env, code, fLabel, nargs, {}) + | BEGIN (fLabel, nargs, nlocals) -> [enterFunction(env, fLabel, nlocals), code <+> prologue(fLabel)] + | END -> + case epilogue(env) of + [env, eCode] -> [env, code <+> eCode] + esac + | GLOBAL (x) -> [addGlobal(env, x), code] + | STRING (strng) -> + case addString(env, strng) of + [env, name] -> compileCall(env, code, "Bstring", 0, {M("$"++name)}) + esac + | SEXP (tag, nargs) -> compileCall(env, code, "Bsexp", nargs + 1, {L(nargs + 1)}) + | ARRAY (len) -> compileCall(env, code, "Barray", len, {L(len)}) + | STA -> compileCall(env, code, "Bsta", 3, {}) + | ELEM -> compileCall(env, code, "Belem", 2, {}) + | BUILTIN (func, nargs) -> compileCall(env, code, "L" ++ func, nargs, {}) + | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string) -- Some guidelines for generating function calls: -- From 2390e0b3497bcae17d3ded5da4087a63e063b7a7 Mon Sep 17 00:00:00 2001 From: Mikhail Rodionychev Date: Mon, 8 Apr 2024 14:40:46 +0200 Subject: [PATCH 2/8] Revert "A07 solution" This reverts commit 5badddeceea3436bd0a8f0b1b17c61c3a7ef7acf. --- src/Expr.lama | 103 +---------------- src/Parser.lama | 14 +-- src/SM.lama | 289 ++---------------------------------------------- src/X86.lama | 175 +++-------------------------- 4 files changed, 28 insertions(+), 553 deletions(-) diff --git a/src/Expr.lama b/src/Expr.lama index 2ab4497093..381ebe47a5 100644 --- a/src/Expr.lama +++ b/src/Expr.lama @@ -55,7 +55,6 @@ public fun evalOp (op, l, r) { -- Ignore (expr) | -- String (string) | -- Array (expr list) | --- Sexp (string, expr list) | -- Elem (expr, expr) | -- ElemRef (expr, expr) | -- Builtin (string, expr list) @@ -87,19 +86,6 @@ fun addNames (state, names) { fun addFunction (state, name, args, body) { state.addName (name, Fun (args, body)) } - -fun addNamesVals(state, names, vals) { - foldl (fun (s, [name, value]) {s.addName(name, value)}, state, zip(names, vals)) -} - -fun addDefs(state, defs) { - foldl(fun (st, def) { - case def of - Fun(name, args, body) -> addFunction(st, name, args, body) - | Var (v) -> addNames(st, v) - esac - }, state, defs) -} -- Evaluates a list of expressions, properly threading a configurations. -- Returns the final configuration and the list of values @@ -116,94 +102,7 @@ fun evalList (c, exprs) { } fun eval (c@[s, w], expr) { - fun set(c@[s, w], name, value) { - [[s <- [name, value], w], value] - } - - case expr of - Assn (l, r) -> - case evalList(c, {l, r}) of - [c, {l, r}] -> case l of - ElemRef (arr, ind) -> [c, arr[ind] := r] - | _ -> set(c, l, r) - esac - esac - | Set (name, expr) -> - case eval(c, expr) of - [c, value] -> set(c, name, value) - esac - | Seq (e1, e2) -> eval(eval(c, e1)[0], e2) - | Skip -> [c, T] - | If (cond, thn, els) -> - case eval(c, cond) of - [c, v] -> if v - then eval(c, thn) - else eval(c, els) - fi - esac - | While (cond, body) -> - case eval(c, cond) of - [c, v] -> if v != 0 - then eval(c, Seq(body, expr)) - else [c, T] - fi - esac - | DoWhile (body, cond) -> eval(eval(c, body)[0], While(cond, body)) - | Var (vr) -> [c, lookup(s, vr)] - | Ref (vr) -> [c, vr] - | Const (int) -> [c, int] - | Binop (op, l, r) -> - case evalList(c, {l, r}) of - [c, w : v : _] -> [c, evalOp(op, w, v)] - esac - | Ignore (exp) -> [eval(c, exp)[0], T] - | Call (f, args) -> - case lookup(s, f) of - Fun (_, External) -> eval(c, Builtin(f, args)) - | Fun(locs, body) -> - case evalList(c, args) of - [[st, w], vals] -> - case eval([addNamesVals(enterFunction(st), locs, vals), w], body) of - [[ss, w], v] -> [[leaveFunction(s, getGlobal(ss)), w], v] - esac - esac - esac - | Scope (d, e) -> - case enterScope(s) of - st -> case eval([addDefs(st, d), w], e) of - [[st, w], v] -> [[leaveScope(st), w], v] - esac - esac - | Array (elems) -> - case evalList(c, elems) of - [c, vals] -> [c, listArray(vals)] - esac - | Sexp (tag, elems) -> - case evalList(c, elems) of - [c, vals] -> [c, Sexp(tag, listArray(vals))] - esac - | Elem (arrExpr, indExpr) -> - case evalList(c, {arrExpr, indExpr}) of - [c, {arr, ind}] -> case arr of - Sexp (_, args) -> [c, args[ind]] - | _ -> [c, arr[ind]] - esac - esac - | ElemRef (arrExpr, indExpr) -> - case evalList(c, {arrExpr, indExpr}) of - [c, {arr, ind}] -> case arr of - Sexp (_, args) -> [c, ElemRef(args, ind)] - | _ -> [c, ElemRef(arr, ind)] - esac - esac - | Builtin (name, args) -> - case evalList(c, args) of - [[s, w], vals] -> case evalBuiltin(name, vals, w) of - [res, w] -> [[s, w], res] - esac - esac - | String (strng) -> [c, strng] - esac + failure ("evalExpr not implemented\n") } diff --git a/src/Parser.lama b/src/Parser.lama index 8f1293c7f0..0f1d00a6ea 100644 --- a/src/Parser.lama +++ b/src/Parser.lama @@ -116,12 +116,6 @@ fun distributeScope (expr, exprConstructor) { | _ -> exprConstructor (expr) esac } - -var ifExpr = memo $ eta syntax ( - cE=exp kThen tE=scopeExpr { fun(a) { If(cE (Val), tE (a), assertVoid(a, Skip, loc))} } | - cE=exp kThen tE=scopeExpr kElse eE=scopeExpr { fun(a) { If(cE (Val), tE (a), eE (a))} } | - cE=exp kThen tE=scopeExpr kElif eE=ifExpr { fun(a) { If(cE (Val), tE (a), eE (a))} } -); var primary = memo $ eta syntax ( -- array constant @@ -153,13 +147,7 @@ var primary = memo $ eta syntax ( None -> {} | Some (args) -> args esac), loc)}} | - inbr[s("("), scopeExpr, s(")")] | - loc=pos kSkip {fun (a) {assertVoid(a, Skip, loc)}} | - loc=pos kIf ifE=ifExpr kFi {fun (a) {ifE (a)}} | - loc=pos kWhile cE=exp kDo bE=scopeExpr kOd {fun (a) {assertVoid(a, While(cE(Val), bE(Void)), loc)}} | - loc=pos kDo bE=scopeExpr kWhile cE=exp kOd {fun (a) {assertVoid(a, distributeScope(bE(Void), fun (expr) {DoWhile(expr, cE(Val)) }), loc)}} | - loc=pos kFor iE=scopeExpr s[","] cE=exp s[","] eE=exp kDo bE=scopeExpr kOd {fun (a) {assertVoid(a, distributeScope(iE(Void), fun (expr) {Seq(expr, While(cE(Val), Seq(bE(Void), eE(Void))))}), loc)}} - ), + $(failure ("the rest of primary parsing in not implemented\n"))), 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 13e2f19cd8..2cc870d744 100644 --- a/src/SM.lama +++ b/src/SM.lama @@ -18,6 +18,10 @@ 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) @@ -106,8 +110,7 @@ fun eval (env, w, insns) { | Loc (i) -> locs[i] := vl | Glb (x) -> var g = deref (globalState); globalState ::= fun (y) {if compare (x, y) == 0 then vl else g (y) fi} - esac; - [args, locs] + esac } -- Takes n positions from the list, retursn a pair: the remaining list and the taken @@ -124,116 +127,8 @@ fun eval (env, w, insns) { } -- Core interpreter: takes a configuration and a program, returns a configuration - fun eval (c@[stack, cstack, st, w], insns) { - fun createLocal(stack, nargs, nlocals) { - case take(stack, nargs) of - [stack, vals] -> case foldl(fun([state, n], value) { [assign(state, Arg(n), value), n + 1] }, [makeState(nargs, nlocals), 0], vals) of - [state, _] -> [stack, state] - esac - esac - } - - fun getArr(arr) { - case arr of - Sexp (_, elems) -> elems - | _ -> arr - esac - } - - case insns of - ins:insns -> -- printf("%s\n%s\n", ins.string, stack.string); - case ins of - READ -> - case readWorld(w) of - [v, nw] -> eval([v:stack, cstack, st, nw], insns) - esac - | WRITE -> - case stack of - z:rst -> eval([rst, cstack, st, writeWorld(z, w)], insns) - esac - | BINOP (s) -> - case stack of - y:x:rst -> eval([evalOp(s, x, y):rst, cstack, st, w], insns) - esac - | LD (x) -> eval([lookup(st, x):stack, cstack, st, w], insns) - | ST (x) -> - case stack of - z:rst -> eval([rst, cstack, assign(st, x, z), w], insns) - esac - | CONST (n) -> eval([n:stack, cstack, st, w], insns) - | LABEL (l) -> eval(c, insns) - | JMP (l) -> eval(c, fromLabel(env, l)) - | CJMP (cn, l) -> - case stack of - h:stack -> - case h of - 0 -> case cn of - "nz" -> eval([stack, cstack, st, w], insns) - | "z" -> eval([stack, cstack, st, w], fromLabel(env, l)) - esac - | _ -> case cn of - "nz" -> eval([stack, cstack, st, w], fromLabel(env, l)) - | "z" -> eval([stack, cstack, st, w], insns) - esac - esac - esac - | LDA (x) -> eval([Ref(x):stack, cstack, st, w], insns) - | STI -> - case stack of - v:Ref(x):stack -> eval([v:stack, cstack, assign(st, x, v), w], insns) - esac - | DROP -> - case stack of - _:stack -> eval([stack, cstack, st, w], insns) - | _ -> eval([[], cstack, st, w], insns) - esac - | DUP -> - case stack of - x:stack -> eval([x:x:stack, cstack, st, w], insns) - esac - | CALL (fLabel, _) -> eval([stack, [st, insns]:cstack, st, w], fromLabel(env, fLabel)) - | BEGIN (_, nargs, nlocals) -> - case createLocal(stack, nargs, nlocals) of - [stack, st] -> eval([stack, cstack, st, w], insns) - esac - | END -> - case cstack of - [st, p]:cstack -> eval([stack, cstack, st, w], p) - | {} -> c - esac - | GLOBAL (x) -> eval([stack, cstack, assign(st, Glb(x), 0), w], insns) - | STRING (s) -> eval([s:stack, cstack, st, w], insns) - | ARRAY (len) -> - case take(stack, len) of - [rst, elems] -> eval([listArray(elems) : rst, cstack, st, w], insns) - esac - | SEXP (name, len) -> - case take(tl(stack), len) of - [rst, elems] -> eval([Sexp(name, listArray(elems)) : rst, cstack, st, w], insns) - esac - | STA -> - case stack of - value : idx : arr : rst -> - var a = getArr(arr); - a[idx] := value; - eval([a[idx]:rst, cstack, st, w], insns) - esac - | ELEM -> - case stack of - idx : arr : rst -> - var a = getArr(arr); - eval([a[idx]:rst, cstack, st, w], insns) - esac - | BUILTIN (func, nargs) -> - case take(stack, nargs) of - [rst, args] -> - case evalBuiltin(func, args, w) of - [res, w] -> eval([res:rst, cstack, st, w], insns) - esac - esac - esac - | _ -> c - esac + fun eval (c@[st, cst, s, w], insns) { + failure ("SM interpreter is not implemented\n") } @@ -508,187 +403,23 @@ public fun compileSM (stmt) { else emptyBuffer () fi } - - fun compileWLabel(env, expr) { - case env.genLabel of - [lbl, env] -> - case compile(lbl, env, expr) of - [labelUsed, env, code] -> [env, code <+> label(lbl, labelUsed)] - esac - esac - } - - fun compileMany(env, exprs) { - foldl(fun ([env, code], expr) { - case compileWLabel(env, expr) of - [env, exprCode] -> [env, code <+> exprCode] - esac - }, [env, emptyBuffer()], exprs) - } fun compile (lab, env, stmt) { - -- printf("%s\n", stmt.string); case stmt of Skip -> [false, env, emptyBuffer ()] - | Var (x) -> [false, env, singletonBuffer (LD (lookupVal(env, x)))] - | Ref (x) -> [false, env, singletonBuffer (LDA (lookupVal(env, x)))] + | Var (x) -> [false, env, singletonBuffer (LD (x))] + | Ref (x) -> [false, env, singletonBuffer (LDA (x))] | Const (n) -> [false, env, singletonBuffer (CONST (n))] - | Ignore (x) -> - case compileWLabel(env, x) of - [env, eCode] -> [false, env, eCode <+ DROP] - esac - - | Binop (op, l, r) -> - case compileWLabel(env, l) of - [env, lCode] -> - case compileWLabel(env, r) of - [env, rCode] -> [false, env, lCode <+> rCode <+ BINOP(op)] - esac - esac - - | Assn (x, e) -> - case compileWLabel(env, e) of - [env, eCode] -> - case compileWLabel(env, x) of - [env, xCode] -> - case x of - ElemRef (_, _) -> [false, env, xCode <+> eCode <+ STA] - | _ -> [false, env, xCode <+> eCode <+ STI] - esac - esac - esac - - | 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) -> - case compileWLabel(env, e) of - [env, eCode] -> - case env.genLabel of - [s2Lab, env] -> - case compile(lab, env, s1) of - [_, env, s1Code] -> - case compile(lab, env, s2) of - [_, env, s2Code] -> [true, env, eCode <+ CJMP("z", s2Lab) <+> s1Code <+ JMP(lab) <+> label(s2Lab, true) <+> s2Code] - esac - esac - esac - esac - - | While (e, s) -> - case compileWLabel(env, e) of - [env, eCode] -> - case env.genLabels(2) of - [le, ls, env] -> - case compile(le, env, s) of - [_, env, sCode] -> [false, env, singletonBuffer(JMP(le)) <+> label(ls, true) <+> sCode <+> label(le, true) <+> eCode <+ CJMP("nz", ls)] - esac - esac - esac - - | DoWhile (s, e) -> - case compileWLabel(env, e) of - [env, eCode] -> - case env.genLabels(2) of - [ls, lbe, env] -> - case compile(lbe, env, s) of - [lbeUsed, env, sCode] -> [false, env, label(ls, true) <+> sCode <+> label(lbe, true) <+> eCode <+ CJMP("nz", ls)] - esac - esac - esac - - | Call (func, args) -> - case lookupFun(env, func) of - Fun (fLabel, nargs) -> - case foldl(fun ([env, code], expr) { case compileWLabel(env, expr) of - [env, eCode] -> [env, code <+> eCode] - esac - }, [env, emptyBuffer()], args) of - [env, code] -> if (fLabel[0] != '$') - then [false, env, code <+ CALL(fLabel, nargs)] - else [false, env, code <+ BUILTIN(func, nargs)] - fi - esac - esac - - | Scope (defs, body) -> - case foldl(fun ([env, funcs, globalDefs], def) { - case def of - Var (ds) -> [addVars(env, ds), funcs, if env.isGlobal - then foldl (fun (globalDefs, name) { globalDefs <+ GLOBAL(name) }, globalDefs, ds) - else globalDefs - fi] - | Fun (name, args, body) -> - case genFunLabel(env, name) of - [fLabel, env] -> [addFun(env, name, fLabel, args.size), [fLabel, args, body] : funcs, globalDefs] - esac - esac - }, [beginScope (env), {}, emptyBuffer()], defs) of - [env, funcs, globalDefs] -> - case compile(lab, foldl(fun(env, [fLabel, args, body]) {rememberFun(env, fLabel, args, body)}, env, funcs), body) of - [flag, env, code] -> [flag, endScope(env), globalDefs <+> code] - esac - esac - - | Array (elems) -> - case compileMany(env, elems) of - [env, arrCode] -> [false, env, arrCode <+ ARRAY(size (elems))] - esac - - | Sexp (tag, elems) -> - case compileMany(env, elems) of - [env, arrCode] -> [false, env, arrCode <+ CONST(tagHash(tag)) <+ SEXP(tag, size(elems))] - esac - - | Elem (arrExpr, indExpr) -> - case compileMany(env, {arrExpr, indExpr}) of - [env, code] -> [false, env, code <+ ELEM] - esac - - | ElemRef (arrExpr, indExpr) -> - case compileMany(env, {arrExpr, indExpr}) of - [env, code] -> [false, env, code] - esac - - | String (strng) -> [false, env, singletonBuffer(STRING(strng))] - | Set (l, r) -> compile(lab, env, Assn(Ref(l), r)) | _ -> failure ("compileSM not implemented\n") esac } - fun compileFunc(env, Fun (fLabel, args, body, state)) { - case compileWLabel(addArgs(beginFun(env, state), args), body) of - [env, code] -> [env, singletonBuffer(LABEL(fLabel)) <+ BEGIN(fLabel, args.size, getLocals(env)) <+> code <+ END] - esac - } - - fun compileFuncs(env) { - case getFuns(env) of - [{}, _] -> emptyBuffer() - | [funcs, env] -> case foldl(fun ([env, code], func) { - case compileFunc(env, func) of - [env, funcCode] -> [env, code <+> funcCode] - esac - }, [env, emptyBuffer()], funcs) of - [env, funcsCode] -> funcsCode <+> compileFuncs(env) - esac - 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, env, code] -> getBuffer $ singletonBuffer(LABEL("main")) <+ BEGIN("main", 0, getLocals(env)) <+> code <+> label (endLab, endLabUsed) <+ END <+> compileFuncs(env) + [endLabUsed, _, code] -> getBuffer $ code <+> label (endLab, endLabUsed) esac esac } diff --git a/src/X86.lama b/src/X86.lama index 69c86a07f2..c24b7b5125 100644 --- a/src/X86.lama +++ b/src/X86.lama @@ -24,8 +24,6 @@ var ebx = R (0), ebp = R (6), esp = R (7); -var dl = "%dl"; - -- We need to know the word size to calculate offsets correctly var wordSize = 4; @@ -54,6 +52,11 @@ var wordSize = 4; -- Call (string) -- calls a function by its name -- Ret -- returns from a function -- Meta (string) -- metainformation (declarations, etc.) +-- +-- Dec (opnd) -- arithmetic correction: decrement +-- Or1 (opnd) -- arithmetic correction: or 0x0001 +-- Sal1 (opnd) -- arithmetic correction: shl 1 +-- Sar1 (opnd) -- arithmetic correction: shr 1 -- Machine instruction printer fun insnString (insn) { @@ -100,6 +103,10 @@ fun insnString (insn) { | Jmp (l) -> sprintf ("\tjmp\t%s\n", l) | CJmp (c, l) -> sprintf ("\tj%s\t%s\n", c, l) | Meta (m) -> m + | Dec (s) -> sprintf ("\tdecl\t%s\n", opndString (s)) + | Or1 (s) -> sprintf ("\torl\t$0x0001,\t%s\n", opndString (s)) + | Sal1 (s) -> sprintf ("\tsall\t%s\n", opndString (s)) + | Sar1 (s) -> sprintf ("\tsarl\t%s\n", opndString (s)) esac } @@ -420,7 +427,6 @@ fun memOpnd (opnd) { case opnd of S (_) -> true | M (_) -> true - | I (_, _) -> true | _ -> false esac } @@ -447,114 +453,20 @@ fun suffix (op) { esac } -fun compileArithOp([op, x, y, env, code]) { - if (stackOpnd(x)) then - [env.push(x), code <+ Mov (x, eax) <+ Binop (op, y, eax) <+ Mov(eax, x)] - else - [env.push(x), code <+ Binop (op, y, x)] - fi -} - - -fun compileDivOp([op, x, y, env, code]) { - var rreg = case op of - "/" -> eax - | "%" -> edx - esac; - [env.push(y), code <+ Mov(x, eax) <+ Cltd <+ IDiv(y) <+ Mov(rreg, y)] -} - - -fun compileCmpOp([op, x, y, env, code]) { - if (stackOpnd(x) && stackOpnd(y)) then - [env.push(y), code <+ Binop("^", edx, edx) <+ Mov(x, eax) <+ Binop("cmp", y, eax) <+ Set(suffix(op), dl) <+ Mov(edx, y)] - else - [env.push(y), code <+ Binop("^", edx, edx) <+ Binop("cmp", y, x) <+ Set(suffix(op), dl) <+ Mov(edx, y)] - fi -} - - -fun compileLogicalOp([op, x, y, env, code]) { - case compileIntToBool(x, env, code) of - [env, code] -> case compileIntToBool(y, env, code) of - [env, code] -> case env.pop2 of - [by, bx, env] -> compileArithOp([op, bx, by, env, code]) - esac - esac - esac -} - - -fun compileIntToBool(int, env, code) { - [env.push(int), code <+ Binop("^", edx, edx) <+ Binop("cmp", L(0), int) <+ Set(suffix("!="), dl) <+ Mov(edx, int)] -} - - -fun compileBinop(args) { - case args[0] of - "+" -> compileArithOp(args) - | "-" -> compileArithOp(args) - | "*" -> compileArithOp(args) - | "!!" -> compileLogicalOp(args) - | "&&" -> compileLogicalOp(args) - | "/" -> compileDivOp(args) - | "%" -> compileDivOp(args) - | "<" -> compileCmpOp(args) - | "<=" -> compileCmpOp(args) - | "==" -> compileCmpOp(args) - | "!=" -> compileCmpOp(args) - | ">=" -> compileCmpOp(args) - | ">" -> compileCmpOp(args) - esac +-- Boxes an immediate value +fun makeBox (n) { + n * 2 + 1 } -fun pushArgs(env, code, nargs) { - case nargs of - 0 -> [env, code] - | _ -> case pop(env) of - [v, env] -> pushArgs(env, code <+ Push(v), nargs - 1) - esac - esac -} - -fun popArgs(code, nargs) { - case nargs of - 0 -> code - | _ -> popArgs(code <+ Pop(edx), nargs - 1) - esac +-- Generates a fixednum representation +-- conversion +fun toFixedNum (r) { + singletonBuffer (Sal1 (r)) <+ Or1 (r) } -- 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) { - - fun compileCall(env, code, fLabel, nargs, extraArgs) { - case liveRegisters(env, nargs) of - regs -> - case foldl (fun (code, reg) {code <+ Push(reg)}, code, regs) of -- push registers - code -> - case pushArgs(env, code, nargs) of -- push args - [env, code] -> - case foldl(fun (code, arg) {code <+ Push(arg)}, code, extraArgs) of -- push extra args - code -> - case foldl(fun (code, _) {code <+ Pop(ebx)}, code <+ Call(fLabel), extraArgs) of -- pop extra args - code -> - case popArgs(code, nargs) of -- pop args - code -> - case allocate(env) of - [s, env] -> - case foldr(fun(code, reg) {code <+ Pop(reg)}, code, regs) of -- pop registers - code -> [env, code <+ Mov(eax, s)] - esac - esac - esac - esac - esac - esac - esac - esac - } - fun compile (env, code) { foldl ( fun ([env, scode], i) { @@ -569,61 +481,6 @@ fun compile (env, code) { case env.pop of [s, env] -> [env, code <+ Push (s) <+ Call ("Lwrite") <+ Pop (eax)] esac - | LD (x) -> - case allocate(env) of - [s, env] -> [env, code <+> move (loc (env, x), s)] - esac - | ST (x) -> - case pop(env) of - [s, env] -> [env, code <+> move (s, loc (env, x))] - esac - | BINOP (op) -> - case pop2(env) of - [y, x, env] -> compileBinop([op, x, y, env, code]) - esac - | CONST (x) -> - case allocate(env) of - [s, env] -> [env, code <+> move(L(x), s)] - esac - | LABEL (l) -> [if isBarrier(env) then retrieveStack(env, l) else env fi, code <+ Label(l)] - | JMP (l) -> [setBarrier(setStack(env, l)), code <+ Jmp(l)] - | CJMP (c, l) -> - case pop(env) of - [s, env] -> [setStack(env, l), code <+ Binop("cmp", L(0), s) <+ CJmp(c, l)] - esac - | LDA (x) -> - case allocate(env) of - [s, env] -> [env, code <+ Lea (loc(env, x), eax) <+ Mov(eax, s)] - esac - | STI -> - case pop2(env) of - [v, x, env] -> [push(env, v), code <+> move(v, I(0, x))] - esac - | DROP -> [pop(env)[1], code] - | DUP -> - case peek(env) of - v -> - case allocate(env) of - [s, env] -> [env, code <+> move(v, s)] - esac - esac - | CALL (fLabel, nargs) -> compileCall(env, code, fLabel, nargs, {}) - | BEGIN (fLabel, nargs, nlocals) -> [enterFunction(env, fLabel, nlocals), code <+> prologue(fLabel)] - | END -> - case epilogue(env) of - [env, eCode] -> [env, code <+> eCode] - esac - | GLOBAL (x) -> [addGlobal(env, x), code] - | STRING (strng) -> - case addString(env, strng) of - [env, name] -> compileCall(env, code, "Bstring", 0, {M("$"++name)}) - esac - | SEXP (tag, nargs) -> compileCall(env, code, "Bsexp", nargs + 1, {L(nargs + 1)}) - | ARRAY (len) -> compileCall(env, code, "Barray", len, {L(len)}) - | STA -> compileCall(env, code, "Bsta", 3, {}) - | ELEM -> compileCall(env, code, "Belem", 2, {}) - | BUILTIN (func, nargs) -> compileCall(env, code, "L" ++ func, nargs, {}) - | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string) -- Some guidelines for generating function calls: -- From 1399480e1dda1794e3ba725919b750508d5a4e5f Mon Sep 17 00:00:00 2001 From: Mikhail Rodionychev Date: Mon, 8 Apr 2024 15:39:25 +0200 Subject: [PATCH 3/8] A07 solution (carefully) --- src/Expr.lama | 103 ++++++++++++++++- src/Parser.lama | 15 ++- src/SM.lama | 286 ++++++++++++++++++++++++++++++++++++++++++++++-- src/X86.lama | 181 +++++++++++++++++++++++++++--- 4 files changed, 559 insertions(+), 26 deletions(-) diff --git a/src/Expr.lama b/src/Expr.lama index 381ebe47a5..bb0bd4150d 100644 --- a/src/Expr.lama +++ b/src/Expr.lama @@ -101,8 +101,109 @@ fun evalList (c, exprs) { esac } + +fun addNamesVals(state, names, vals) { + foldl (fun (s, [name, value]) {s.addName(name, value)}, state, zip(names, vals)) +} + +fun addDefs(state, defs) { + foldl(fun (st, def) { + case def of + Fun(name, args, body) -> addFunction(st, name, args, body) + | Var (v) -> addNames(st, v) + esac + }, state, defs) +} + fun eval (c@[s, w], expr) { - failure ("evalExpr not implemented\n") + fun set(c@[s, w], name, value) { + [[s <- [name, value], w], value] + } + + case expr of + Assn (l, r) -> + case evalList(c, {l, r}) of + [c, {l, r}] -> case l of + ElemRef (arr, ind) -> [c, arr[ind] := r] + | _ -> set(c, l, r) + esac + esac + | Set (name, expr) -> + case eval(c, expr) of + [c, value] -> set(c, name, value) + esac + | Seq (e1, e2) -> eval(eval(c, e1)[0], e2) + | Skip -> [c, T] + | If (cond, thn, els) -> + case eval(c, cond) of + [c, v] -> if v + then eval(c, thn) + else eval(c, els) + fi + esac + | While (cond, body) -> + case eval(c, cond) of + [c, v] -> if v != 0 + then eval(c, Seq(body, expr)) + else [c, T] + fi + esac + | DoWhile (body, cond) -> eval(eval(c, body)[0], While(cond, body)) + | Var (vr) -> [c, lookup(s, vr)] + | Ref (vr) -> [c, vr] + | Const (int) -> [c, int] + | Binop (op, l, r) -> + case evalList(c, {l, r}) of + [c, w : v : _] -> [c, evalOp(op, w, v)] + esac + | Ignore (exp) -> [eval(c, exp)[0], T] + | Call (f, args) -> + case lookup(s, f) of + Fun (_, External) -> eval(c, Builtin(f, args)) + | Fun(locs, body) -> + case evalList(c, args) of + [[st, w], vals] -> + case eval([addNamesVals(enterFunction(st), locs, vals), w], body) of + [[ss, w], v] -> [[leaveFunction(s, getGlobal(ss)), w], v] + esac + esac + esac + | Scope (d, e) -> + case enterScope(s) of + st -> case eval([addDefs(st, d), w], e) of + [[st, w], v] -> [[leaveScope(st), w], v] + esac + esac + | Array (elems) -> + case evalList(c, elems) of + [c, vals] -> [c, listArray(vals)] + esac + | Sexp (tag, elems) -> + case evalList(c, elems) of + [c, vals] -> [c, Sexp(tag, listArray(vals))] + esac + | Elem (arrExpr, indExpr) -> + case evalList(c, {arrExpr, indExpr}) of + [c, {arr, ind}] -> case arr of + Sexp (_, args) -> [c, args[ind]] + | _ -> [c, arr[ind]] + esac + esac + | ElemRef (arrExpr, indExpr) -> + case evalList(c, {arrExpr, indExpr}) of + [c, {arr, ind}] -> case arr of + Sexp (_, args) -> [c, ElemRef(args, ind)] + | _ -> [c, ElemRef(arr, ind)] + esac + esac + | Builtin (name, args) -> + case evalList(c, args) of + [[s, w], vals] -> case evalBuiltin(name, vals, w) of + [res, w] -> [[s, w], res] + esac + esac + | String (strng) -> [c, strng] + esac } diff --git a/src/Parser.lama b/src/Parser.lama index 0f1d00a6ea..5db39e7922 100644 --- a/src/Parser.lama +++ b/src/Parser.lama @@ -116,6 +116,13 @@ fun distributeScope (expr, exprConstructor) { | _ -> exprConstructor (expr) esac } + + +var ifExpr = memo $ eta syntax ( + cE=exp kThen tE=scopeExpr { fun(a) { If(cE (Val), tE (a), assertVoid(a, Skip, loc))} } | + cE=exp kThen tE=scopeExpr kElse eE=scopeExpr { fun(a) { If(cE (Val), tE (a), eE (a))} } | + cE=exp kThen tE=scopeExpr kElif eE=ifExpr { fun(a) { If(cE (Val), tE (a), eE (a))} } +); var primary = memo $ eta syntax ( -- array constant @@ -147,7 +154,13 @@ 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 kIf ifE=ifExpr kFi {fun (a) {ifE (a)}} | + loc=pos kWhile cE=exp kDo bE=scopeExpr kOd {fun (a) {assertVoid(a, While(cE(Val), bE(Void)), loc)}} | + loc=pos kDo bE=scopeExpr kWhile cE=exp kOd {fun (a) {assertVoid(a, distributeScope(bE(Void), fun (expr) {DoWhile(expr, cE(Val)) }), loc)}} | + loc=pos kFor iE=scopeExpr s[","] cE=exp s[","] eE=exp kDo bE=scopeExpr kOd {fun (a) {assertVoid(a, distributeScope(iE(Void), fun (expr) {Seq(expr, While(cE(Val), Seq(bE(Void), eE(Void))))}), 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 2cc870d744..ff87e520a5 100644 --- a/src/SM.lama +++ b/src/SM.lama @@ -110,7 +110,8 @@ fun eval (env, w, insns) { | Loc (i) -> locs[i] := vl | Glb (x) -> var g = deref (globalState); globalState ::= fun (y) {if compare (x, y) == 0 then vl else g (y) fi} - esac + esac; + [args, locs] } -- Takes n positions from the list, retursn a pair: the remaining list and the taken @@ -127,8 +128,116 @@ fun eval (env, w, insns) { } -- 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 (c@[stack, cstack, st, w], insns) { + fun createLocal(stack, nargs, nlocals) { + case take(stack, nargs) of + [stack, vals] -> case foldl(fun([state, n], value) { [assign(state, Arg(n), value), n + 1] }, [makeState(nargs, nlocals), 0], vals) of + [state, _] -> [stack, state] + esac + esac + } + + fun getArr(arr) { + case arr of + Sexp (_, elems) -> elems + | _ -> arr + esac + } + + case insns of + ins:insns -> -- printf("%s\n%s\n", ins.string, stack.string); + case ins of + READ -> + case readWorld(w) of + [v, nw] -> eval([v:stack, cstack, st, nw], insns) + esac + | WRITE -> + case stack of + z:rst -> eval([rst, cstack, st, writeWorld(z, w)], insns) + esac + | BINOP (s) -> + case stack of + y:x:rst -> eval([evalOp(s, x, y):rst, cstack, st, w], insns) + esac + | LD (x) -> eval([lookup(st, x):stack, cstack, st, w], insns) + | ST (x) -> + case stack of + z:rst -> eval([rst, cstack, assign(st, x, z), w], insns) + esac + | CONST (n) -> eval([n:stack, cstack, st, w], insns) + | LABEL (l) -> eval(c, insns) + | JMP (l) -> eval(c, fromLabel(env, l)) + | CJMP (cn, l) -> + case stack of + h:stack -> + case h of + 0 -> case cn of + "nz" -> eval([stack, cstack, st, w], insns) + | "z" -> eval([stack, cstack, st, w], fromLabel(env, l)) + esac + | _ -> case cn of + "nz" -> eval([stack, cstack, st, w], fromLabel(env, l)) + | "z" -> eval([stack, cstack, st, w], insns) + esac + esac + esac + | LDA (x) -> eval([Ref(x):stack, cstack, st, w], insns) + | STI -> + case stack of + v:Ref(x):stack -> eval([v:stack, cstack, assign(st, x, v), w], insns) + esac + | DROP -> + case stack of + _:stack -> eval([stack, cstack, st, w], insns) + | _ -> eval([[], cstack, st, w], insns) + esac + | DUP -> + case stack of + x:stack -> eval([x:x:stack, cstack, st, w], insns) + esac + | CALL (fLabel, _) -> eval([stack, [st, insns]:cstack, st, w], fromLabel(env, fLabel)) + | BEGIN (_, nargs, nlocals) -> + case createLocal(stack, nargs, nlocals) of + [stack, st] -> eval([stack, cstack, st, w], insns) + esac + | END -> + case cstack of + [st, p]:cstack -> eval([stack, cstack, st, w], p) + | {} -> c + esac + | GLOBAL (x) -> eval([stack, cstack, assign(st, Glb(x), 0), w], insns) + | STRING (s) -> eval([s:stack, cstack, st, w], insns) + | ARRAY (len) -> + case take(stack, len) of + [rst, elems] -> eval([listArray(elems) : rst, cstack, st, w], insns) + esac + | SEXP (name, len) -> + case take(tl(stack), len) of + [rst, elems] -> eval([Sexp(name, listArray(elems)) : rst, cstack, st, w], insns) + esac + | STA -> + case stack of + value : idx : arr : rst -> + var a = getArr(arr); + a[idx] := value; + eval([a[idx]:rst, cstack, st, w], insns) + esac + | ELEM -> + case stack of + idx : arr : rst -> + var a = getArr(arr); + eval([a[idx]:rst, cstack, st, w], insns) + esac + | BUILTIN (func, nargs) -> + case take(stack, nargs) of + [rst, args] -> + case evalBuiltin(func, args, w) of + [res, w] -> eval([res:rst, cstack, st, w], insns) + esac + esac + esac + | _ -> c + esac } @@ -403,23 +512,186 @@ public fun compileSM (stmt) { else emptyBuffer () fi } + + + fun compileWLabel(env, expr) { + case env.genLabel of + [lbl, env] -> + case compile(lbl, env, expr) of + [labelUsed, env, code] -> [env, code <+> label(lbl, labelUsed)] + esac + esac + } + + fun compileMany(env, exprs) { + foldl(fun ([env, code], expr) { + case compileWLabel(env, expr) of + [env, exprCode] -> [env, code <+> exprCode] + esac + }, [env, emptyBuffer()], exprs) + } 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))] + | Var (x) -> [false, env, singletonBuffer (LD (lookupVal(env, x)))] + | Ref (x) -> [false, env, singletonBuffer (LDA (lookupVal(env, x)))] | Const (n) -> [false, env, singletonBuffer (CONST (n))] + | Ignore (x) -> + case compileWLabel(env, x) of + [env, eCode] -> [false, env, eCode <+ DROP] + esac + + | Binop (op, l, r) -> + case compileWLabel(env, l) of + [env, lCode] -> + case compileWLabel(env, r) of + [env, rCode] -> [false, env, lCode <+> rCode <+ BINOP(op)] + esac + esac + + | Assn (x, e) -> + case compileWLabel(env, e) of + [env, eCode] -> + case compileWLabel(env, x) of + [env, xCode] -> + case x of + ElemRef (_, _) -> [false, env, xCode <+> eCode <+ STA] + | _ -> [false, env, xCode <+> eCode <+ STI] + esac + esac + esac + + | 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) -> + case compileWLabel(env, e) of + [env, eCode] -> + case env.genLabel of + [s2Lab, env] -> + case compile(lab, env, s1) of + [_, env, s1Code] -> + case compile(lab, env, s2) of + [_, env, s2Code] -> [true, env, eCode <+ CJMP("z", s2Lab) <+> s1Code <+ JMP(lab) <+> label(s2Lab, true) <+> s2Code] + esac + esac + esac + esac + + | While (e, s) -> + case compileWLabel(env, e) of + [env, eCode] -> + case env.genLabels(2) of + [le, ls, env] -> + case compile(le, env, s) of + [_, env, sCode] -> [false, env, singletonBuffer(JMP(le)) <+> label(ls, true) <+> sCode <+> label(le, true) <+> eCode <+ CJMP("nz", ls)] + esac + esac + esac + + | DoWhile (s, e) -> + case compileWLabel(env, e) of + [env, eCode] -> + case env.genLabels(2) of + [ls, lbe, env] -> + case compile(lbe, env, s) of + [lbeUsed, env, sCode] -> [false, env, label(ls, true) <+> sCode <+> label(lbe, true) <+> eCode <+ CJMP("nz", ls)] + esac + esac + esac + + | Call (func, args) -> + case lookupFun(env, func) of + Fun (fLabel, nargs) -> + case foldl(fun ([env, code], expr) { case compileWLabel(env, expr) of + [env, eCode] -> [env, code <+> eCode] + esac + }, [env, emptyBuffer()], args) of + [env, code] -> if (fLabel[0] != '$') + then [false, env, code <+ CALL(fLabel, nargs)] + else [false, env, code <+ BUILTIN(func, nargs)] + fi + esac + esac + + | Scope (defs, body) -> + case foldl(fun ([env, funcs, globalDefs], def) { + case def of + Var (ds) -> [addVars(env, ds), funcs, if env.isGlobal + then foldl (fun (globalDefs, name) { globalDefs <+ GLOBAL(name) }, globalDefs, ds) + else globalDefs + fi] + | Fun (name, args, body) -> + case genFunLabel(env, name) of + [fLabel, env] -> [addFun(env, name, fLabel, args.size), [fLabel, args, body] : funcs, globalDefs] + esac + esac + }, [beginScope (env), {}, emptyBuffer()], defs) of + [env, funcs, globalDefs] -> + case compile(lab, foldl(fun(env, [fLabel, args, body]) {rememberFun(env, fLabel, args, body)}, env, funcs), body) of + [flag, env, code] -> [flag, endScope(env), globalDefs <+> code] + esac + esac + + | Array (elems) -> + case compileMany(env, elems) of + [env, arrCode] -> [false, env, arrCode <+ ARRAY(size (elems))] + esac + + | Sexp (tag, elems) -> + case compileMany(env, elems) of + [env, arrCode] -> [false, env, arrCode <+ CONST(tagHash(tag)) <+ SEXP(tag, size(elems))] + esac + + | Elem (arrExpr, indExpr) -> + case compileMany(env, {arrExpr, indExpr}) of + [env, code] -> [false, env, code <+ ELEM] + esac + + | ElemRef (arrExpr, indExpr) -> + case compileMany(env, {arrExpr, indExpr}) of + [env, code] -> [false, env, code] + esac + + | String (strng) -> [false, env, singletonBuffer(STRING(strng))] + | Set (l, r) -> compile(lab, env, Assn(Ref(l), r)) | _ -> failure ("compileSM not implemented\n") esac } + fun compileFunc(env, Fun (fLabel, args, body, state)) { + case compileWLabel(addArgs(beginFun(env, state), args), body) of + [env, code] -> [env, singletonBuffer(LABEL(fLabel)) <+ BEGIN(fLabel, args.size, getLocals(env)) <+> code <+ END] + esac + } + + fun compileFuncs(env) { + case getFuns(env) of + [{}, _] -> emptyBuffer() + | [funcs, env] -> case foldl(fun ([env, code], func) { + case compileFunc(env, func) of + [env, funcCode] -> [env, code <+> funcCode] + esac + }, [env, emptyBuffer()], funcs) of + [env, funcsCode] -> funcsCode <+> compileFuncs(env) + esac + 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 + [endLabUsed, env, code] -> getBuffer $ singletonBuffer(LABEL("main")) <+ BEGIN("main", 0, getLocals(env)) <+> code <+> label (endLab, endLabUsed) <+ END <+> compileFuncs(env) esac esac } diff --git a/src/X86.lama b/src/X86.lama index c24b7b5125..b26ec9f05e 100644 --- a/src/X86.lama +++ b/src/X86.lama @@ -23,6 +23,7 @@ var ebx = R (0), edx = R (5), ebp = R (6), esp = R (7); +var dl = "%dl"; -- We need to know the word size to calculate offsets correctly var wordSize = 4; @@ -427,6 +428,7 @@ fun memOpnd (opnd) { case opnd of S (_) -> true | M (_) -> true + | I (_, _) -> true | _ -> false esac } @@ -464,9 +466,115 @@ fun toFixedNum (r) { singletonBuffer (Sal1 (r)) <+ Or1 (r) } +fun compileArithOp([op, x, y, env, code]) { + if (stackOpnd(x)) then + [env.push(x), code <+ Mov (x, eax) <+ Binop (op, y, eax) <+ Mov(eax, x)] + else + [env.push(x), code <+ Binop (op, y, x)] + fi +} + + +fun compileDivOp([op, x, y, env, code]) { + var rreg = case op of + "/" -> eax + | "%" -> edx + esac; + [env.push(y), code <+ Mov(x, eax) <+ Cltd <+ IDiv(y) <+ Mov(rreg, y)] +} + + +fun compileCmpOp([op, x, y, env, code]) { + if (stackOpnd(x) && stackOpnd(y)) then + [env.push(y), code <+ Binop("^", edx, edx) <+ Mov(x, eax) <+ Binop("cmp", y, eax) <+ Set(suffix(op), dl) <+ Mov(edx, y)] + else + [env.push(y), code <+ Binop("^", edx, edx) <+ Binop("cmp", y, x) <+ Set(suffix(op), dl) <+ Mov(edx, y)] + fi +} + + +fun compileLogicalOp([op, x, y, env, code]) { + case compileIntToBool(x, env, code) of + [env, code] -> case compileIntToBool(y, env, code) of + [env, code] -> case env.pop2 of + [by, bx, env] -> compileArithOp([op, bx, by, env, code]) + esac + esac + esac +} + + +fun compileIntToBool(int, env, code) { + [env.push(int), code <+ Binop("^", edx, edx) <+ Binop("cmp", L(0), int) <+ Set(suffix("!="), dl) <+ Mov(edx, int)] +} + + +fun compileBinop(args) { + case args[0] of + "+" -> compileArithOp(args) + | "-" -> compileArithOp(args) + | "*" -> compileArithOp(args) + | "!!" -> compileLogicalOp(args) + | "&&" -> compileLogicalOp(args) + | "/" -> compileDivOp(args) + | "%" -> compileDivOp(args) + | "<" -> compileCmpOp(args) + | "<=" -> compileCmpOp(args) + | "==" -> compileCmpOp(args) + | "!=" -> compileCmpOp(args) + | ">=" -> compileCmpOp(args) + | ">" -> compileCmpOp(args) + esac +} + +fun pushArgs(env, code, nargs) { + case nargs of + 0 -> [env, code] + | _ -> case pop(env) of + [v, env] -> pushArgs(env, code <+ Push(v), nargs - 1) + esac + esac +} + +fun popArgs(code, nargs) { + case nargs of + 0 -> code + | _ -> popArgs(code <+ Pop(edx), nargs - 1) + esac +} + + -- 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) { + + fun compileCall(env, code, fLabel, nargs, extraArgs) { + case liveRegisters(env, nargs) of + regs -> + case foldl (fun (code, reg) {code <+ Push(reg)}, code, regs) of -- push registers + code -> + case pushArgs(env, code, nargs) of -- push args + [env, code] -> + case foldl(fun (code, arg) {code <+ Push(arg)}, code, extraArgs) of -- push extra args + code -> + case foldl(fun (code, _) {code <+ Pop(ebx)}, code <+ Call(fLabel), extraArgs) of -- pop extra args + code -> + case popArgs(code, nargs) of -- pop args + code -> + case allocate(env) of + [s, env] -> + case foldr(fun(code, reg) {code <+ Pop(reg)}, code, regs) of -- pop registers + code -> [env, code <+ Mov(eax, s)] + esac + esac + esac + esac + esac + esac + esac + esac + } + fun compile (env, code) { foldl ( fun ([env, scode], i) { @@ -481,23 +589,62 @@ fun compile (env, code) { case env.pop of [s, env] -> [env, code <+ Push (s) <+ Call ("Lwrite") <+ Pop (eax)] esac - - -- Some guidelines for generating function calls: - -- - -- 1. generate instructions to save live registers on the X86 stack (use - -- env.liveRegisters (number of arguments); - -- 2. generate instructions to move actual parameters from the symbolic - -- stack to the hardware one; - -- 3. generate the call itself; - -- 4. discard the actual parameters from the stack; - -- 5. restore saved live registers. - -- - -- Some guidelines for generating functions: - -- - -- 1. generate proper prologue for BEGIN instruction (use "prologue" helper); use - -- env.enterFunction to create a proper environment; - -- 2. generate epilogue for END instruction. - + | LD (x) -> + case allocate(env) of + [s, env] -> [env, code <+> move (loc (env, x), s)] + esac + | ST (x) -> + case pop(env) of + [s, env] -> [env, code <+> move (s, loc (env, x))] + esac + | BINOP (op) -> + case pop2(env) of + [y, x, env] -> compileBinop([op, x, y, env, code]) + esac + | CONST (x) -> + case allocate(env) of + [s, env] -> [env, code <+> move(L(x), s)] + esac + | LABEL (l) -> [if isBarrier(env) then retrieveStack(env, l) else env fi, code <+ Label(l)] + | JMP (l) -> [setBarrier(setStack(env, l)), code <+ Jmp(l)] + | CJMP (c, l) -> + case pop(env) of + [s, env] -> [setStack(env, l), code <+ Binop("cmp", L(0), s) <+ CJmp(c, l)] + esac + | LDA (x) -> + case allocate(env) of + [s, env] -> [env, code <+ Lea (loc(env, x), eax) <+ Mov(eax, s)] + esac + | STI -> + case pop2(env) of + [v, x, env] -> [push(env, v), code <+> move(v, I(0, x))] + esac + | DROP -> [pop(env)[1], code] + | DUP -> + case peek(env) of + v -> + case allocate(env) of + [s, env] -> [env, code <+> move(v, s)] + esac + esac + | CALL (fLabel, nargs) -> compileCall(env, code, fLabel, nargs, {}) + | BEGIN (fLabel, nargs, nlocals) -> [enterFunction(env, fLabel, nlocals), code <+> prologue(fLabel)] + | END -> + case epilogue(env) of + [env, eCode] -> [env, code <+> eCode] + esac + | GLOBAL (x) -> [addGlobal(env, x), code] + | STRING (strng) -> + case addString(env, strng) of + [env, name] -> compileCall(env, code, "Bstring", 0, {M("$"++name)}) + esac + | SEXP (tag, nargs) -> compileCall(env, code, "Bsexp", nargs + 1, {L(nargs + 1)}) + | ARRAY (len) -> compileCall(env, code, "Barray", len, {L(len)}) + | STA -> compileCall(env, code, "Bsta", 3, {}) + | ELEM -> compileCall(env, code, "Belem", 2, {}) + | BUILTIN (func, nargs) -> compileCall(env, code, "L" ++ func, nargs, {}) + | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string) + | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string) esac }, [env, emptyBuffer ()], code) From ed619b545561590198d680ce7be88362f398524f Mon Sep 17 00:00:00 2001 From: Mikhail Rodionychev Date: Mon, 8 Apr 2024 17:28:33 +0200 Subject: [PATCH 4/8] idk what I did but it works --- src/SM.lama | 17 +++++++--------- src/X86.lama | 56 ++++++++++++++++++++++++++++++---------------------- 2 files changed, 39 insertions(+), 34 deletions(-) diff --git a/src/SM.lama b/src/SM.lama index ff87e520a5..d83d536bd9 100644 --- a/src/SM.lama +++ b/src/SM.lama @@ -184,7 +184,7 @@ fun eval (c@[stack, cstack, st, w], insns) { | LDA (x) -> eval([Ref(x):stack, cstack, st, w], insns) | STI -> case stack of - v:Ref(x):stack -> eval([v:stack, cstack, assign(st, x, v), w], insns) + v:x:stack -> eval([v:stack, cstack, assign(st, x, v), w], insns) esac | DROP -> case stack of @@ -217,10 +217,11 @@ fun eval (c@[stack, cstack, st, w], insns) { esac | STA -> case stack of - value : idx : arr : rst -> - var a = getArr(arr); - a[idx] := value; - eval([a[idx]:rst, cstack, st, w], insns) + value : Ref(x) : rst -> eval([value:rst, cstack, assign(st, x, value), w], insns) + | value : idx : arr : rst -> + var a = getArr(arr); + a[idx] := value; + eval([a[idx]:rst, cstack, st, w], insns) esac | ELEM -> case stack of @@ -554,11 +555,7 @@ public fun compileSM (stmt) { case compileWLabel(env, e) of [env, eCode] -> case compileWLabel(env, x) of - [env, xCode] -> - case x of - ElemRef (_, _) -> [false, env, xCode <+> eCode <+ STA] - | _ -> [false, env, xCode <+> eCode <+ STI] - esac + [env, xCode] -> [false, env, xCode <+> eCode <+ STA] esac esac diff --git a/src/X86.lama b/src/X86.lama index b26ec9f05e..2246a310af 100644 --- a/src/X86.lama +++ b/src/X86.lama @@ -466,38 +466,42 @@ fun toFixedNum (r) { singletonBuffer (Sal1 (r)) <+ Or1 (r) } -fun compileArithOp([op, x, y, env, code]) { - if (stackOpnd(x)) then - [env.push(x), code <+ Mov (x, eax) <+ Binop (op, y, eax) <+ Mov(eax, x)] +fun fromFixNum (x) { + singletonBuffer(Sar1(x)) +} + +fun compileArithOp([op, r, l, env, code]) { + if (stackOpnd(l)) then + [env.push(l), code <+ Mov (l, eax) <+ Binop (op, r, eax) <+ Mov(eax, l)] else - [env.push(x), code <+ Binop (op, y, x)] + [env.push(l), code <+ Binop (op, r, l)] fi } -fun compileDivOp([op, x, y, env, code]) { +fun compileDivOp([op, r, l, env, code]) { var rreg = case op of "/" -> eax | "%" -> edx esac; - [env.push(y), code <+ Mov(x, eax) <+ Cltd <+ IDiv(y) <+ Mov(rreg, y)] + [env.push(l), code <+ Mov(l, eax) <+ Cltd <+ IDiv(r) <+ Mov(rreg, l)] } -fun compileCmpOp([op, x, y, env, code]) { - if (stackOpnd(x) && stackOpnd(y)) then - [env.push(y), code <+ Binop("^", edx, edx) <+ Mov(x, eax) <+ Binop("cmp", y, eax) <+ Set(suffix(op), dl) <+ Mov(edx, y)] +fun compileCmpOp([op, r, l, env, code]) { + if (stackOpnd(r) && stackOpnd(l)) then + [env.push(l), code <+ Binop("^", edx, edx) <+ Mov(l, eax) <+ Binop("cmp", r, eax) <+ Set(suffix(op), dl) <+ Mov(edx, l)] else - [env.push(y), code <+ Binop("^", edx, edx) <+ Binop("cmp", y, x) <+ Set(suffix(op), dl) <+ Mov(edx, y)] + [env.push(l), code <+ Binop("^", edx, edx) <+ Binop("cmp", r, l) <+ Set(suffix(op), dl) <+ Mov(edx, l)] fi } -fun compileLogicalOp([op, x, y, env, code]) { - case compileIntToBool(x, env, code) of - [env, code] -> case compileIntToBool(y, env, code) of +fun compileLogicalOp([op, r, l, env, code]) { + case compileIntToBool(r, env, code) of + [env, code] -> case compileIntToBool(l, env, code) of [env, code] -> case env.pop2 of - [by, bx, env] -> compileArithOp([op, bx, by, env, code]) + [bl, br, env] -> compileArithOp([op, br, bl, env, code]) esac esac esac @@ -594,26 +598,32 @@ fun compile (env, code) { [s, env] -> [env, code <+> move (loc (env, x), s)] esac | ST (x) -> - case pop(env) of - [s, env] -> [env, code <+> move (s, loc (env, x))] + case peek(env) of + s -> [env, code <+> move (s, loc (env, x))] esac | BINOP (op) -> case pop2(env) of - [y, x, env] -> compileBinop([op, x, y, env, code]) + [r, l, env] -> + case compileBinop([op, r, l, env, code <+> fromFixNum(r) <+> fromFixNum(l)]) of + [env, binopCode] -> [env, binopCode <+> toFixedNum(l)] + esac esac | CONST (x) -> case allocate(env) of - [s, env] -> [env, code <+> move(L(x), s)] + [s, env] -> [env, code <+> move(L(makeBox(x)), s)] esac | LABEL (l) -> [if isBarrier(env) then retrieveStack(env, l) else env fi, code <+ Label(l)] | JMP (l) -> [setBarrier(setStack(env, l)), code <+ Jmp(l)] | CJMP (c, l) -> case pop(env) of - [s, env] -> [setStack(env, l), code <+ Binop("cmp", L(0), s) <+ CJmp(c, l)] + [s, env] -> [setStack(env, l), code <+ Binop("cmp", L(makeBox(0)), s) <+ CJmp(c, l)] esac | LDA (x) -> case allocate(env) of - [s, env] -> [env, code <+ Lea (loc(env, x), eax) <+ Mov(eax, s)] + [s, env] -> + case allocate(env) of + [s2, env] -> [env, code <+ Lea (loc(env, x), eax) <+ Mov(eax, s) <+ Mov(eax, s2)] + esac esac | STI -> case pop2(env) of @@ -638,13 +648,11 @@ fun compile (env, code) { case addString(env, strng) of [env, name] -> compileCall(env, code, "Bstring", 0, {M("$"++name)}) esac - | SEXP (tag, nargs) -> compileCall(env, code, "Bsexp", nargs + 1, {L(nargs + 1)}) - | ARRAY (len) -> compileCall(env, code, "Barray", len, {L(len)}) + | SEXP (tag, nargs) -> compileCall(env, code, "Bsexp", nargs + 1, {L(makeBox(nargs + 1))}) + | ARRAY (len) -> compileCall(env, code, "Barray", len, {L(makeBox(len))}) | STA -> compileCall(env, code, "Bsta", 3, {}) | ELEM -> compileCall(env, code, "Belem", 2, {}) | BUILTIN (func, nargs) -> compileCall(env, code, "L" ++ func, nargs, {}) - | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string) - | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string) esac }, [env, emptyBuffer ()], code) From 2474bf4972feab8da8b4227df476e1931f7ed792 Mon Sep 17 00:00:00 2001 From: Mikhail Rodionychev Date: Mon, 8 Apr 2024 17:29:37 +0200 Subject: [PATCH 5/8] github workflow --- .github/workflows/check.yml | 84 +++++++++++++++++++++++++------------ 1 file changed, 57 insertions(+), 27 deletions(-) diff --git a/.github/workflows/check.yml b/.github/workflows/check.yml index 0296f118ad..f4c1c0f9f7 100644 --- a/.github/workflows/check.yml +++ b/.github/workflows/check.yml @@ -1,37 +1,74 @@ name: Regression -on: # [push] +on: pull_request: - # pull_request_target: types: [synchronize, opened, reopened, edited] jobs: job1: runs-on: ubuntu-latest - # Map a step output to a job output steps: - - name: Extract branch name - shell: bash - run: echo "##[set-output name=branch;]$(echo ${GITHUB_REF#refs/heads/})" - id: extract_branch - uses: actions/checkout@v2 with: ref: refs/pull/${{ github.event.pull_request.number }}/head - - id: step1 + - name: Check pull request's name + run: | + prName="${{ github.event.pull_request.title }}" + university=`echo $prName | awk '{ sub(/.*\[/, ""); sub(/\].*/, ""); print }'` + universities=("SPBGU" "NUP" "CUB") + if [[ ! $(echo ${universities[@]} | grep -F -w $university) ]]; + then + echo "FIASCO: Wrong university name or format in pull request title: $university " + exit 1 + fi + echo "your university $university " + echo $university > university.txt + - name: Check branches compatibility run: | - login=${{ github.event.pull_request.user.login }} - echo "$login" if [ "${{ github.base_ref }}" != "${{ github.head_ref }}" ]; then echo "FIASCO: base and head branches differs" exit 1 fi - wget -c --retry-connrefused --tries=0 -q --load-cookies /tmp/cookies.txt "https://docs.google.com/uc?export=download&confirm=$(wget --quiet -c --retry-connrefused --tries=0 --save-cookies /tmp/cookies.txt --keep-session-cookies --no-check-certificate 'https://docs.google.com/uc?export=download&id=1grnb60AaZBCwhBqETeKOGh3tW7ggEWDJ' -O- | sed -rn 's/.*confirm=([0-9A-Za-z_]+).*/\1\n/p')&id=1grnb60AaZBCwhBqETeKOGh3tW7ggEWDJ" -O cw-20201.tar.gz && rm -rf /tmp/cookies.txt - rm -rf /tmp/cookies.txt - docker load < cw-20201.tar.gz - docker run -d -it --name cw-2021 -v $(pwd):/usr/share/compiler-workout berezun/cw-2021 - docker exec -t cw-2021 sh test.sh - echo "All checks have successfully passed" - + - name: Set up Docker Buildx + uses: docker/setup-buildx-action@v3 + - name: Set up Docker cache + uses: actions/cache@v4 + with: + path: /tmp/.buildx-cache + key: ${{ runner.os }}-buildx-${{ github.sha }} + restore-keys: | + ${{ runner.os }}-buildx- + - name: Build Docker image + uses: docker/build-push-action@v5 + with: + context: . + file: ./.github/workflows/Dockerfile + tags: berezun/lama-image:latest + load: true + cache-from: type=local,src=/tmp/.buildx-cache + cache-to: type=local,dest=/tmp/.buildx-cache-new + - name: Store Docker cache + run: | + rm -rf /tmp/.buildx-cache + mv /tmp/.buildx-cache-new /tmp/.buildx-cache + - name: Run tests + run: | + docker run -d -it --name lama-testing-image berezun/lama-image + docker cp . lama-testing-image:/home/opam/lama + docker exec -u root -t lama-testing-image chown -R opam:opam /home/opam/lama + docker exec -u opam -w /home/opam/lama -t lama-testing-image sh -c 'eval $(opam config env) && make' + echo "Regression: All checks have successfully passed" + # - name: Check Deadline + # run: | + # deadline=2025-03-04T23:59 + # if [[ $(date +'%Y-%m-%d') > $deadline ]]; + # then + # echo "FIASCO: The deadline has expired" + # exit 1 + # fi + - name: Prepare results + run: | + login=${{ github.event.pull_request.user.login }} echo "$login" > gitid.txt echo ${{ github.base_ref }} > base.txt branch=${{ github.base_ref }} @@ -41,19 +78,12 @@ jobs: else echo ${branch:1:2} > assignment_number.txt fi - - name: Check Deadline - run: | - deadline=2023-12-30T23:59 - if [[ $(date +'%Y-%m-%dT%H:%M') > $deadline ]]; - then - echo "FIASCO: The deadline has expired" - echo $(date +'%Y-%m-%dT%H:%M') - exit 1 - fi - - uses: actions/upload-artifact@v2 + - name: Upload results + uses: actions/upload-artifact@v2 with: name: share_info path: | gitid.txt base.txt assignment_number.txt + university.txt From 83fe567ccda62ae72c80d94d0a301978a5ed84d9 Mon Sep 17 00:00:00 2001 From: Mikhail Rodionychev Date: Mon, 8 Apr 2024 17:35:36 +0200 Subject: [PATCH 6/8] add Dockerfile --- .github/workflows/Dockerfile | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 .github/workflows/Dockerfile diff --git a/.github/workflows/Dockerfile b/.github/workflows/Dockerfile new file mode 100644 index 0000000000..c0eccce9b7 --- /dev/null +++ b/.github/workflows/Dockerfile @@ -0,0 +1,12 @@ +FROM ocaml/opam:ubuntu-lts-ocaml-4.14 + +USER root +RUN dpkg --add-architecture i386 && \ + apt-get update --fix-missing -y && \ + apt-get install -y software-properties-common gcc-multilib make m4 && \ + rm -rf /var/lib/apt/lists/* + +USER opam +RUN opam init --disable-sandboxing -y && \ + opam pin add -y ostap 0.5 && \ + opam pin add -y Lama https://github.com/JetBrains-Research/Lama.git\#1.20 From 10b79fbb9f0cc52c2c70801ee1689913cf499e3a Mon Sep 17 00:00:00 2001 From: Mikhail Rodionychev Date: Fri, 24 May 2024 17:06:53 +0200 Subject: [PATCH 7/8] more optimal fixnum binops --- src/X86.lama | 48 ++++++++++++++++++++++++------------------------ 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/src/X86.lama b/src/X86.lama index 2246a310af..fa878a0b0f 100644 --- a/src/X86.lama +++ b/src/X86.lama @@ -105,6 +105,7 @@ fun insnString (insn) { | CJmp (c, l) -> sprintf ("\tj%s\t%s\n", c, l) | Meta (m) -> m | Dec (s) -> sprintf ("\tdecl\t%s\n", opndString (s)) + | Inc (s) -> sprintf ("\tincl\t%s\n", opndString (s)) | Or1 (s) -> sprintf ("\torl\t$0x0001,\t%s\n", opndString (s)) | Sal1 (s) -> sprintf ("\tsall\t%s\n", opndString (s)) | Sar1 (s) -> sprintf ("\tsarl\t%s\n", opndString (s)) @@ -472,51 +473,53 @@ fun fromFixNum (x) { fun compileArithOp([op, r, l, env, code]) { if (stackOpnd(l)) then - [env.push(l), code <+ Mov (l, eax) <+ Binop (op, r, eax) <+ Mov(eax, l)] + [env.push(l), code <+ Mov (l, eax) <+ Sar1(eax) <+ Sar1(l) <+ Binop (op, r, eax) <+> toFixedNum(eax) <+ Mov(eax, l)] else - [env.push(l), code <+ Binop (op, r, l)] + [env.push(l), code <+ Sar1(r) <+ Sar1(l) <+ Binop (op, r, l) <+> toFixedNum(l)] fi } +fun compilePlusMinus([op, r, l, env, code]) { + fun eop (x) { + case op of + "+" -> Dec(x) + | "-" -> Inc(x) + esac + } + if stackOpnd(l) then + [env.push(l), code <+ Mov(l, eax) <+ Binop(op, r, eax) <+ eop(eax) <+ Mov(eax, l)] + else + [env.push(l), code <+ Binop(op, r, l) <+ eop(l)] + fi +} + fun compileDivOp([op, r, l, env, code]) { var rreg = case op of "/" -> eax | "%" -> edx esac; - [env.push(l), code <+ Mov(l, eax) <+ Cltd <+ IDiv(r) <+ Mov(rreg, l)] + [env.push(l), code <+ Sar1(r) <+ Sar1(l) <+ Mov(l, eax) <+ Cltd <+ IDiv(r) <+> toFixedNum(rreg) <+ Mov(rreg, l)] } fun compileCmpOp([op, r, l, env, code]) { if (stackOpnd(r) && stackOpnd(l)) then - [env.push(l), code <+ Binop("^", edx, edx) <+ Mov(l, eax) <+ Binop("cmp", r, eax) <+ Set(suffix(op), dl) <+ Mov(edx, l)] + [env.push(l), code <+ Binop("^", edx, edx) <+ Mov(l, eax) <+ Binop("cmp", r, eax) <+ Set(suffix(op), dl) <+> toFixedNum(edx) <+ Mov(edx, l)] else - [env.push(l), code <+ Binop("^", edx, edx) <+ Binop("cmp", r, l) <+ Set(suffix(op), dl) <+ Mov(edx, l)] + [env.push(l), code <+ Binop("^", edx, edx) <+ Binop("cmp", r, l) <+ Set(suffix(op), dl) <+> toFixedNum(edx) <+ Mov(edx, l)] fi } fun compileLogicalOp([op, r, l, env, code]) { - case compileIntToBool(r, env, code) of - [env, code] -> case compileIntToBool(l, env, code) of - [env, code] -> case env.pop2 of - [bl, br, env] -> compileArithOp([op, br, bl, env, code]) - esac - esac - esac + [env.push(l), code <+ Binop("^", edx, edx) <+ Binop("^", eax, eax) <+ Binop("cmp", L(makeBox(0)), r) <+ Set(suffix("!="), "%al") <+ Binop("cmp", L(makeBox(0)), l) <+ Set(suffix("!="), "%dl") <+ Binop(op, edx, eax) <+> toFixedNum(eax) <+ Mov(eax, l)] } - -fun compileIntToBool(int, env, code) { - [env.push(int), code <+ Binop("^", edx, edx) <+ Binop("cmp", L(0), int) <+ Set(suffix("!="), dl) <+ Mov(edx, int)] -} - - fun compileBinop(args) { case args[0] of - "+" -> compileArithOp(args) - | "-" -> compileArithOp(args) + "+" -> compilePlusMinus(args) + | "-" -> compilePlusMinus(args) | "*" -> compileArithOp(args) | "!!" -> compileLogicalOp(args) | "&&" -> compileLogicalOp(args) @@ -603,10 +606,7 @@ fun compile (env, code) { esac | BINOP (op) -> case pop2(env) of - [r, l, env] -> - case compileBinop([op, r, l, env, code <+> fromFixNum(r) <+> fromFixNum(l)]) of - [env, binopCode] -> [env, binopCode <+> toFixedNum(l)] - esac + [r, l, env] -> compileBinop([op, r, l, env, code]) esac | CONST (x) -> case allocate(env) of From f2d642516af509c34e1438f530edbdb0f3ed3dac Mon Sep 17 00:00:00 2001 From: Mikhail Rodionychev Date: Fri, 24 May 2024 17:43:05 +0200 Subject: [PATCH 8/8] really fix --- src/X86.lama | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/X86.lama b/src/X86.lama index fa878a0b0f..d4b7b5d015 100644 --- a/src/X86.lama +++ b/src/X86.lama @@ -473,7 +473,7 @@ fun fromFixNum (x) { fun compileArithOp([op, r, l, env, code]) { if (stackOpnd(l)) then - [env.push(l), code <+ Mov (l, eax) <+ Sar1(eax) <+ Sar1(l) <+ Binop (op, r, eax) <+> toFixedNum(eax) <+ Mov(eax, l)] + [env.push(l), code <+ Mov (l, eax) <+ Sar1(eax) <+ Sar1(r) <+ Binop (op, r, eax) <+> toFixedNum(eax) <+ Mov(eax, l)] else [env.push(l), code <+ Sar1(r) <+ Sar1(l) <+ Binop (op, r, l) <+> toFixedNum(l)] fi