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 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 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..d83d536bd9 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,117 @@ 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: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 : 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 + 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 +513,182 @@ 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] -> [false, env, xCode <+> eCode <+ STA] + 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..d4b7b5d015 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; @@ -104,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)) @@ -427,6 +429,7 @@ fun memOpnd (opnd) { case opnd of S (_) -> true | M (_) -> true + | I (_, _) -> true | _ -> false esac } @@ -464,9 +467,121 @@ fun toFixedNum (r) { singletonBuffer (Sal1 (r)) <+ Or1 (r) } +fun fromFixNum (x) { + singletonBuffer(Sar1(x)) +} + +fun compileArithOp([op, r, l, env, code]) { + if (stackOpnd(l)) then + [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 +} + +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 <+ 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) <+> toFixedNum(edx) <+ Mov(edx, l)] + else + [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]) { + [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 compileBinop(args) { + case args[0] of + "+" -> compilePlusMinus(args) + | "-" -> compilePlusMinus(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 +596,63 @@ 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 peek(env) of + s -> [env, code <+> move (s, loc (env, x))] + esac + | BINOP (op) -> + case pop2(env) of + [r, l, env] -> compileBinop([op, r, l, env, code]) + esac + | CONST (x) -> + case allocate(env) of + [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(makeBox(0)), s) <+ CJmp(c, l)] + esac + | LDA (x) -> + case allocate(env) of + [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 + [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(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) esac }, [env, emptyBuffer ()], code)