diff --git a/src/Expr.lama b/src/Expr.lama index b7580356..57282303 100644 --- a/src/Expr.lama +++ b/src/Expr.lama @@ -1,18 +1,41 @@ --- Expression evaluator - -import List; -import State; - - --- The evaluator itself: takes a state and an expression, --- returns integer value --- --- An expression is represented by a data structure of the following shape: --- --- expr = Var (string) | --- Const (int) | --- Binop (string, expr, expr) - -public fun evalExpr (st, expr) { - failure ("evalExpr not implemented\n") -} +-- Expression evaluator + +import List; +import State; + + +-- The evaluator itself: takes a state and an expression, +-- returns integer value +-- +-- An expression is represented by a data structure of the following shape: +-- +-- expr = Var (string) | +-- Const (int) | +-- Binop (string, expr, expr) + +public fun ebinop(op, l, r) { + case op of + "+" -> l + r + | "-" -> l - r + | "*" -> l * r + | "/" -> l / r + | "%" -> l % r + | "==" -> l == r + | "!=" -> l != r + | "<" -> l < r + | ">" -> l > r + | "<=" -> l <= r + | ">=" -> l >= r + | "&&" -> l && r + | "!!" -> l !! r + esac +} + +public fun evalExpr (st, expr) { + case expr of + Var (x) -> st(x) + | Binop (op, l, r) -> ebinop(op, evalExpr(st, l), evalExpr(st, r)) + | Const (n) -> n + + esac +} diff --git a/src/Parser.lama b/src/Parser.lama index 4796fec6..76593b77 100644 --- a/src/Parser.lama +++ b/src/Parser.lama @@ -1,25 +1,54 @@ --- Parser - -import Ostap; -import Lexer; -import List; -import Fun; -import Matcher; - --- A parser of "something" in brackets; l, r are left and right --- brackets as parsers, p --- a parser of "something" -fun inbr (l, p, r) { - syntax (-l p -r) -} - --- Primary expression -local primary = memo $ eta (decimal @ fun (x) {Const (stringInt (x))} | - lident @ fun (x) {Var (x)} | - inbr (s ("("), exp, s (")"))), - exp = memo $ eta (failure ("expression parsing not implemented\n")); - -local stmt = memo $ eta (failure ("statement parsing not implemented\n")); - - --- Public top-level parser -public parse = stmt; +-- Parser + +import Ostap; +import Lexer; +import List; +import Fun; + +-- A parser of "something" in brackets; l, r are left and right +-- brackets as parsers, p --- a parser of "something" +fun inbr (l, p, r) { + syntax (-l p -r) +} + +fun binOpop(l, op, r) { + Binop (op, l, r) +} + +local oper = {[Left, [s("!!"), binOpop] : {}], + [Left, [s("&&"), binOpop]: {}], + [Nona, [s("==") | s("!=") | s("<") | s(">") | s(">=") | s("<="), binOpop] : {}], + [Left, [s("+") | s("-"), binOpop] : {}], + [Left, [s("*") | s("/") | s("%"), binOpop] : {}] +}; + +local primary = memo $ eta syntax (x=decimal {Const (stringInt (x))} | + x=lident {Var (x)} | + inbr[s("("), exp, s(")")]), + exp = memo $ eta expr(oper, primary); + +local stmt = memo $ eta syntax ( + kWrite x = inbr[s("("), exp, s(")")] {Write(x)} | + kRead x = inbr[s("("), lident, s(")")] {Read(x)} | + x = lident s[":="] y = exp {Assn(x, y)} | + x1 = stmt s[";"] y1 = stmt end {Seq(x1, y1)} | + kSkip {Skip} | + kIf cond=exp kThen st1=stmts st2=ifTailParser {If(cond, st1, st2)} | + kWhile cond=exp kDo st=stmts kOd {While (cond, st)} | + kRepeat s=stmts kUntil cond=exp {Repeat (s, cond)} | + kFor st1=stmts s[","] cond=exp s[","] st2=stmts kDo st=stmts kOd {Seq (st1, While(cond, Seq(st, st2)))} +); + +local ifTailParser = memo $ eta syntax( + -kFi {Skip} | + -kElse stmts -kFi | + -kElif e=exp kThen s1=stmts s2=ifTailParser {If (e, s1, s2)} +); + +local stmts = memo $ eta syntax ( + stmt | + s1=stmt s[";"] s2=stmts {Seq(s1, s2)}); + + +-- Public top-level parser +public parse = stmt; diff --git a/src/SM.lama b/src/SM.lama index 8aaa7943..c641c51d 100644 --- a/src/SM.lama +++ b/src/SM.lama @@ -1,108 +1,167 @@ --- Stack machine. - -import Array; -import List; -import Fun; -import Collection; -import World; -import State; -import Expr; -import Buffer; - --- Stack code printer. Takes a list of SM instructions, return its --- string representation. -public fun showSMInsn (i) { - case i of - READ -> sprintf ("READ") - | WRITE -> sprintf ("WRITE") - | BINOP (s) -> sprintf ("BINOP %s", s) - | LD (x) -> sprintf ("LD %s", x) - | ST (x) -> sprintf ("ST %s", x) - | CONST (n) -> sprintf ("CONST %d", n) - | LABEL (s) -> sprintf ("LABEL %s", s) - | JMP (l) -> sprintf ("JMP %s", l) - | CJMP (c, l) -> sprintf ("CJMP %s, %s", c, l) - esac -} - -public fun showSM (prg) { - map (fun (i) {showSMInsn (i) ++ "\n"}, prg).stringcat -} - --- Evaluation environment: keeps a mapping between labels and (sub)programs -fun initEvalEnv (insns) { - local map = - fix (fun (rec) { - fun ([m, insns]) { - case insns of - {} -> m - | LABEL (lab) : tl -> rec ([addMap (m, lab, insns), tl]) - | _ : tl -> rec ([m, tl]) - esac - } - }) $ [emptyMap (compare), insns]; - - [fun (l) { - case findMap (map, l) of Some (insns) -> insns esac - }] -} - --- Accessor function -fun fromLabel (env, lab) { - env [0] (lab) -} - --- Stack machine interpreter. Takes an environment, an SM-configuration and a program, --- returns a final configuration -fun eval (env, c, insns) { - failure ("SM eval not implemented\n") -} - --- Runs a stack machine for a given input and a given program, returns an output -public fun evalSM (input, insns) { - eval (initEvalEnv (insns), [{}, emptyState, createWorld (input)], insns)[2].getOutput -} - --- Compilation environment: generates labels -fun makeCompEnv (n) { - [fun () { - [sprintf ("L%d", n), makeCompEnv (n+1)] - }] -} - -fun initCompEnv () { - makeCompEnv (0) -} - --- Accessor function: generates one label -fun genLabel (env) { - env [0] () -} - --- Utility function: generates n labels -fun genLabels (env, n) { - fun inner (env, n) { - if n == 0 - then singleton (env) - else case env.genLabel of - [lab, env] -> lab : inner (env, n-1) - esac - fi - } - - listArray (inner (env, n)) -} - --- Compiles an expression into a stack machine code. --- Takes an expression, returns a list (of, possibly, lists) --- of stack machine instructions -fun compileExpr (expr) { - failure ("compileExpr not implemented\n") -} - --- Compiles a statement into a stack machine code. --- Takes a statement, returns a list of stack machine --- instructions. -public fun compileSM (stmt) { - failure ("compileSM not implemented\n") -} +-- Stack machine. + +import Array; +import List; +import Fun; +import Collection; +import World; +import State; +import Expr; +import Buffer; + +-- Stack code printer. Takes a list of SM instructions, return its +-- string representation. +public fun showSMInsn (i) { + case i of + READ -> sprintf ("READ") + | WRITE -> sprintf ("WRITE") + | BINOP (s) -> sprintf ("BINOP %s", s) + | LD (x) -> sprintf ("LD %s", x) + | ST (x) -> sprintf ("ST %s", x) + | CONST (n) -> sprintf ("CONST %d", n) + | LABEL (s) -> sprintf ("LABEL %s", s) + | JMP (l) -> sprintf ("JMP %s", l) + | CJMP (c, l) -> sprintf ("CJMP %s, %s", c, l) + esac +} + +public fun showSM (prg) { + map (fun (i) {showSMInsn (i) ++ "\n"}, prg).stringcat +} + +-- Evaluation environment: keeps a mapping between labels and (sub)programs +fun initEvalEnv (insns) { + local map = + fix (fun (rec) { + fun ([m, insns]) { + case insns of + {} -> m + | LABEL (lab) : tl -> rec ([addMap (m, lab, insns), tl]) + | _ : tl -> rec ([m, tl]) + esac + } + }) $ [emptyMap (compare), insns]; + + [fun (l) { + case findMap (map, l) of Some (insns) -> insns esac + }] +} + +-- Accessor function +fun fromLabel (env, lab) { + env [0] (lab) +} + +-- Stack machine interpreter. Takes an environment, an SM-configuration and a program, +-- returns a final configuration +fun eval (env, c, insns) { + case c of + [s, st, w@[i,o]] -> case insns of + {} -> c + | BINOP(b): p -> case s of x : y: ss -> eval(env, [ebinop(b, y, x): ss, st, w], p) esac + | CONST(n): p -> eval(env, [n : s, st, w], p) + | READ: p -> case i of x : it -> eval(env, [x : s, st, [it, o]], p) esac + | WRITE: p -> case s of x : ss -> eval(env, [ss, st, [i, x : o]], p) esac + | LD(x): p -> eval(env, [st(x) : s, st, w], p) + | ST(x): p -> case s of y : ss -> eval(env, [ss, (st <- [x,y]), w], p) esac + | LABEL(s): p -> eval(env, c, p) + | JMP(l): p -> eval(env, c, fromLabel(env, l)) + | CJMP(cond, l): p -> case s of cmp : ss -> case cond of + "z" -> case cmp of + 0 -> eval (env, c, fromLabel (env, l)) + |_ -> eval (env, c, p) + esac + |"nz" -> case cmp of + 0 -> eval (env, c, p) + |_ -> eval (env, c, fromLabel (env, l)) + esac + esac + esac + esac + esac +} + +-- Runs a stack machine for a given input and a given program, returns an output +public fun evalSM (input, insns) { + eval (initEvalEnv (insns), [{}, emptyState, createWorld (input)], insns)[2].getOutput +} + +-- Compilation environment: generates labels +fun makeCompEnv (n) { + [fun () { + [sprintf ("L%d", n), makeCompEnv (n+1)] + }] +} + +fun initCompEnv () { + makeCompEnv (0) +} + +-- Accessor function: generates one label +fun genLabel (env) { + env [0] () +} + +-- Utility function: generates n labels +fun genLabels (env, n) { + fun inner (env, n) { + if n == 0 + then singleton (env) + else case env.genLabel of + [lab, env] -> lab : inner (env, n-1) + esac + fi + } + + listArray (inner (env, n)) +} + +-- Compiles an expression into a stack machine code. +-- Takes an expression, returns a list (of, possibly, lists) +-- of stack machine instructions +fun compileExpr (expr) { + case expr of + Const (n) -> singleton(CONST(n)) + | Var (x) -> singleton(LD(x)) + | Binop(op, l, r) -> compileExpr(l) +++ compileExpr(r) +++ singleton(BINOP(op)) + | _ -> failure("Expression %s not found. \n", expr) + esac +} + +-- Compiles a statement into a stack machine code. +-- Takes a statement, returns a list of stack machine +-- instructions. +public fun compileSM (stmt) { + fun compileEnv(env, stmt) { + case stmt of + Assn(x, e) -> [env, compileExpr(e) +++ singleton(ST(x))] + | Write(e) -> [env, compileExpr(e) +++ singleton(WRITE)] + | Read(x) -> [env, {READ, ST(x)}] + | Seq(s1,s2) -> case compileEnv(env, s1) of + [env, s1] -> case compileEnv(env, s2) of + [env, s2]-> [env, s1 +++ s2] + esac + esac + | Skip -> [env, {}] + | While(expr, s) -> case genLabels(env, 2) of [label1, label2, env1] -> + case compileEnv(env1, s) of [env2, insts] -> + [env2, {JMP(label2), LABEL(label1)} +++ insts +++ singleton(LABEL(label2)) +++ compileExpr(expr) +++ singleton(CJMP("nz", label1))] + esac + esac + | Repeat(s, expr) -> case genLabels(env, 1) of [label, env1] -> + case compileEnv(env1, s) of [env2, insts] -> + [env2, singleton(LABEL(label)) +++ insts +++ compileExpr(expr) +++ singleton(CJMP("z", label))] + esac + esac + | If(expr, s1, s2) -> case genLabels(env, 2) of [lb_else, lb_fi, env1] -> + case compileEnv(env1, s1) of [env2, stmt1] -> + case compileEnv(env2, s2) of [env3, stmt2] -> + [env3, compileExpr(expr) +++ singleton(CJMP("z", lb_else )) +++ stmt1 +++ singleton(JMP(lb_fi)) +++ singleton(LABEL (lb_else)) +++ stmt2 +++ singleton(LABEL (lb_fi))] + esac + esac + esac + | _ -> failure("Statement %s not found. \n", stmt) + esac + } + compileEnv (initCompEnv(), stmt)[1] +} diff --git a/src/Stmt.lama b/src/Stmt.lama index 90e59fe9..c283c407 100644 --- a/src/Stmt.lama +++ b/src/Stmt.lama @@ -1,29 +1,41 @@ --- Statement evaluator. - -import State; -import Expr; -import World; - --- Evaluates a statement "stmt" in a configuration "c". --- A configuration is a pair of a state "s" and a world "w". --- Returns a final configuration (if any) --- --- A statement is represented by a data structure of the following shape: --- --- stmt = Assn (string, expr) | --- Seq (stmt, stmt) | --- Skip | --- Read (string) | --- Write (expr) | --- if (expr, stmt, stmt) | --- While (expr, stmt) | --- Repeat (stmt, expr) - -fun eval (c, stmt) { - failure ("Stmt eval not implemented\n") -} - --- Evaluates a program with a given input and returns an output -public fun evalStmt (input, stmt) { - eval ([emptyState, createWorld (input)], stmt).snd.getOutput -} +-- Statement evaluator. + +import State; +import Expr; +import World; +import List; + +-- Evaluates a statement "stmt" in a configuration "c". +-- A configuration is a pair of a state "s" and a world "w". +-- Returns a final configuration (if any) +-- +-- A statement is represented by a data structure of the following shape: +-- +-- stmt = Assn (string, expr) | +-- Seq (stmt, stmt) | +-- Skip | +-- Read (string) | +-- Write (expr) | +-- if (expr, stmt, stmt) | +-- While (expr, stmt) | +-- Repeat (stmt, expr) + +fun eval (c, stmt) { + case stmt of + Skip -> c + | Assn(x, e) -> [c[0] <- [x, evalExpr(c[0], e)], c[1]] + | Seq(s1, s2) -> eval(eval(c, s1), s2) + | Read(x) -> local res = readWorld(c[1]); + [c[0] <- [x, res[0]], res[1]] + | Write(x) -> [c[0], writeWorld(evalExpr(c[0], x), c[1])] + | If (expr, s1, s2) -> if (evalExpr(c[0], expr)) then eval (c, s1) else eval (c, s2) fi + | Repeat (s, expr) -> local c1 = eval (c, s); + if (evalExpr(c1[0], expr)) then eval (c1, Skip) else eval (c1, Repeat(s, expr)) fi + | While (expr, s) -> if (evalExpr(c[0], expr)) then eval (c, Seq(s, stmt)) else eval (c, Skip) fi + esac +} + +-- Evaluates a program with a given input and returns an output +public fun evalStmt (input, stmt) { + eval ([emptyState, createWorld (input)], stmt).snd.getOutput +} diff --git a/src/X86.lama b/src/X86.lama index 0fdf1130..fa852d34 100644 --- a/src/X86.lama +++ b/src/X86.lama @@ -1,332 +1,377 @@ --- X86 codegeneration interface --- We use stack machine programs as intermediate representation -import SM; -import Collection; -import List; -import Buffer; -import Fun; -import Manifest; - --- Assembler language interface --- The registers: -local regs = ["%ebx", "%ecx", "%esi", "%edi", "%eax", "%edx", "%ebp", "%esp"]; - --- We can not freely operate with all register; only with 4 by now -local nRegs = regs.length - 5; - --- For convenience we define the following synonyms for the registers: -local ebx = R (0), - ecx = R (1), - esi = R (2), - edi = R (3), - eax = R (4), - edx = R (5), - ebp = R (6), - esp = R (7); - --- We need to know the word size to calculate offsets correctly -local wordSize = 4; - --- We need to distinguish the following operand types: --- R (int) -- hard register --- S (int) -- a position on the hardware stack --- M (string) -- a named memory location --- L (int) -- an immediate operand - --- Some x86 instruction (we do not need all of them): --- Mov (opnd, opnd) -- copies a value from the first to the second operand --- Binop (string, opnd, opnd) -- makes a binary operation; note, the first operand --- designates x86 operator, not the source language one --- IDiv (opnd) -- x86 integer division, see instruction set reference --- Cltd -- see instruction set reference --- Set (string, string) -- sets a value from flags; the first operand is the --- suffix, which determines the value being set, the --- the second --- (sub)register name --- Jmp (string) -- unconditional jump to a label --- CJmp (string, string) -- conditional jump to a label --- Label (string) -- a label --- Push (opnd) -- pushes the operand on the hardware stack --- Pop (opnd) -- pops from the hardware stack to the operand --- Call (string) -- calls a function by its name --- Ret -- returns from a function --- Meta (string) -- metainformation (declarations, etc.) - --- Machine instruction printer -fun insnString (insn) { - - fun binopString (op) { - case op of - "+" -> "addl" - | "-" -> "subl" - | "*" -> "imull" - | "&&" -> "andl" - | "!!" -> "orl" - | "^" -> "xorl" - | "cmp" -> "cmpl" - esac - } - - fun opndString (opnd) { - case opnd of - R (i) -> regs [i] - | S (i) -> sprintf ("-%d(%%ebp)", (i+1) * wordSize) - | M (x) -> x - | L (i) -> sprintf ("$%d", i) - esac - } - - case insn of - Cltd -> "\tcltd\n" - | Set (suf, s) -> sprintf ("\tset%s\t%s\n", suf, s) - | IDiv (s1) -> sprintf ("\tidivl\t%s\n", opndString (s1)) - | Binop (op, s1, s2) -> sprintf ("\t%s\t%s,\t%s\n", binopString (op), opndString (s1), opndString (s2)) - | Mov (s1, s2) -> sprintf ("\tmovl\t%s,\t%s\n", opndString (s1), opndString (s2)) - | Push (s) -> sprintf ("\tpushl\t%s\n", opndString (s)) - | Pop (s) -> sprintf ("\tpopl\t%s\n", opndString (s)) - | Ret -> "\tret\n" - | Call (p) -> sprintf ("\tcall\t%s\n", p) - | Label (l) -> sprintf ("%s:\n", l) - | Jmp (l) -> sprintf ("\tjmp\t%s\n", l) - | CJmp (c, l) -> sprintf ("\tj%s\t%s\n", c, l) - | Meta (m) -> m - esac -} - --- Environment for symbolic interpreter --- An environment holds --- a symbolic stack --- a maximal stack depth reached so far --- a set of global variable names - -fun makeEnv (stack, stackSlots, globals) { - -- Returns an internal name for a global variable - fun globalName (name) { - "global_" ++ name - } - - -- Returns a string representation of the environment - fun envString () { - sprintf ("Stack : %s\nStackSlots: %d\nGlobals : %s\n", stack.string, stackSlots, elements (globals).string) - } - - -- Allocates a new position on the symbolic stack; - -- returns a pair: a location for allocated item and - -- an updated environment - fun allocate () { - case - case stack of - {} -> [ebx, 0] - | S (n) : _ -> [S (n+1), n+2] - | R (n) : _ -> if n < nRegs then [R (n+1), stackSlots] else [S (0), 1] fi - | _ -> [S (0), 1] - esac - of [x, n] -> [x, makeEnv (x : stack, if n > stackSlots then n else stackSlots fi, globals)]esac - } - - -- Pushes an item on the symbolic state; returns an updated envirtonment - fun push (y) { - makeEnv (y : stack, stackSlots, globals) - } - - -- Pops one item from the symbolic stack; returns a pair: a popped - -- item and an updated environment - fun pop () { - case stack of - x : stack -> [x, makeEnv (stack, stackSlots, globals)] - esac - } - - -- Pops two items from the symbolic stack; returns a triple: - -- popped items and an undated environment - fun pop2 () { - case stack of - x : y : stack -> [x, y, makeEnv (stack, stackSlots, globals)] - esac - } - - -- Adds a global variable; returns an updated environment - fun addGlobal (name) { - makeEnv (stack, stackSlots, addSet (globals, globalName (name))) - } - - -- References a global variable - fun loc (name) { - M (globalName (name)) - } - - -- Gets a list of global variables from the environment - fun getGlobals () { - globals.elements - } - - -- Gets a maximal stack size from the environment - fun getStackSize () { - stackSlots - } - - [envString, allocate, push, pop, pop2, addGlobal, loc, getGlobals, getStackSize] -} - --- Exported accessors -fun envString (env) { - env [0] () -} - -fun allocate (env) { - env [1] () -} - -fun push (env, x) { - env [2] (x) -} - -fun pop (env) { - env [3] () -} - -fun pop2 (env) { - env [4] () -} - -fun addGlobal (env, name) { - env [5] (name) -} - -fun loc (env, name) { - env [6] (name) -} - -fun getGlobals (env) { - env [7] () -} - -fun getStackSize (env) { - env [8] () -} - --- Creates an initial environment -fun initEnv () { - makeEnv (0, emptySet (compare), emptySet (compare)) -} - --- Codegeneration helper functions --- Generates code section -fun codeSection (text) { - singletonBuffer (Meta ("\t.text\n")) <+> text -} - --- Generates data section -fun dataSection (text) { - singletonBuffer (Meta ("\t.data\n")) <+> text -} - --- Generates data definition -fun dataDef (name) { - Meta (sprintf ("%s:\t.int\t0\n", name)) -} - --- Generates function prologue -fun prologue (size) { - singletonBuffer (Push (ebp)) <+ - Mov (esp, ebp) <+ - Binop ("-", L (wordSize*size), esp) -} - --- Generates function epilogue -fun epilogue () { - singletonBuffer (Mov (ebp, esp)) <+ - Pop (ebp) <+ - Binop ("^", eax, eax) <+ - Ret -} - --- Checks if an operand resides on a stack -fun stackOpnd (opnd) { - case opnd of - S (_) -> true - | _ -> false - esac -} - --- Checks if an operand resides in memory -fun memOpnd (opnd) { - case opnd of - S (_) -> true - | M (_) -> true - | _ -> false - esac -} - --- Generates a move between locations, using --- intermediate register if needed -fun move (from, to) { - if memOpnd (from) && memOpnd (to) - then singletonBuffer (Mov (from, eax)) <+ Mov (eax, to) - else singletonBuffer (Mov (from, to)) - fi -} - --- Gets a suffix for Set instruction from --- source language comparison operator -fun suffix (op) { - case op of - "<" -> "l" - | "<=" -> "le" - | "==" -> "e" - | "!=" -> "ne" - | ">=" -> "ge" - | ">" -> "g" - 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 compile (env, code) { - foldl ( - fun ([env, scode], i) { - local code = scode <+ Meta ("# " ++ showSMInsn (i) ++ "\n"); - case i of - READ -> - case env.allocate of - [s, env] -> [env, code <+ Call ("Lread") <+ Mov (eax, s)] - esac - | WRITE -> - case env.pop of - [s, env] -> [env, code <+ Push (s) <+ Call ("Lwrite") <+ Pop (eax)] - esac - | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string) - esac - }, [env, emptyBuffer ()], code) - } - - compile (env, code) -} - --- A top-level codegeneration function. Takes a driver's environment and a stack machine program, --- compiles the program into machine code, and compiles the machine code into an executable -public fun compileX86 (args, code) { - case compile (initEnv (), code) of - [env, code] -> - local asmFile = args.getBaseName ++ ".s", - runtime = case getEnv ("LAMA_RUNTIME") of - #unboxed -> "../runtime/" - | path -> path - esac ++ "/runtime.o"; - - fwrite (asmFile, - map (insnString, - getBuffer $ - singletonBuffer (Meta ("\t.global\tmain\n")) <+> - dataSection (listBuffer $ map (dataDef, getGlobals (env))) <+> - codeSection ( - singletonBuffer (Meta ("main:\n")) <+> - prologue (getStackSize (env)) <+> - code <+> - epilogue () - ) - ).stringcat); - - system ({"gcc -g -m32 -o ", args.getBaseName, " ", runtime, " ", asmFile}.stringcat) - esac -} +-- X86 codegeneration interface +-- We use stack machine programs as intermediate representation +import SM; +import Collection; +import List; +import Buffer; +import Fun; +import Manifest; + +-- Assembler language interface +-- The registers: +local regs = ["%ebx", "%ecx", "%esi", "%edi", "%eax", "%edx", "%ebp", "%esp"]; + +-- We can not freely operate with all register; only with 4 by now +local nRegs = regs.length - 5; + +-- For convenience we define the following synonyms for the registers: +local ebx = R (0), + ecx = R (1), + esi = R (2), + edi = R (3), + eax = R (4), + edx = R (5), + ebp = R (6), + esp = R (7); + +-- We need to know the word size to calculate offsets correctly +local wordSize = 4; + +-- We need to distinguish the following operand types: +-- R (int) -- hard register +-- S (int) -- a position on the hardware stack +-- M (string) -- a named memory location +-- L (int) -- an immediate operand + +-- Some x86 instruction (we do not need all of them): +-- Mov (opnd, opnd) -- copies a value from the first to the second operand +-- Binop (string, opnd, opnd) -- makes a binary operation; note, the first operand +-- designates x86 operator, not the source language one +-- IDiv (opnd) -- x86 integer division, see instruction set reference +-- Cltd -- see instruction set reference +-- Set (string, string) -- sets a value from flags; the first operand is the +-- suffix, which determines the value being set, the +-- the second --- (sub)register name +-- Jmp (string) -- unconditional jump to a label +-- CJmp (string, string) -- conditional jump to a label +-- Label (string) -- a label +-- Push (opnd) -- pushes the operand on the hardware stack +-- Pop (opnd) -- pops from the hardware stack to the operand +-- Call (string) -- calls a function by its name +-- Ret -- returns from a function +-- Meta (string) -- metainformation (declarations, etc.) + +-- Machine instruction printer +fun insnString (insn) { + + fun binopString (op) { + case op of + "+" -> "addl" + | "-" -> "subl" + | "*" -> "imull" + | "&&" -> "andl" + | "!!" -> "orl" + | "^" -> "xorl" + | "cmp" -> "cmpl" + esac + } + + fun opndString (opnd) { + case opnd of + R (i) -> regs [i] + | S (i) -> sprintf ("-%d(%%ebp)", (i+1) * wordSize) + | M (x) -> x + | L (i) -> sprintf ("$%d", i) + esac + } + + case insn of + Cltd -> "\tcltd\n" + | Set (suf, s) -> sprintf ("\tset%s\t%s\n", suf, s) + | IDiv (s1) -> sprintf ("\tidivl\t%s\n", opndString (s1)) + | Binop (op, s1, s2) -> sprintf ("\t%s\t%s,\t%s\n", binopString (op), opndString (s1), opndString (s2)) + | Mov (s1, s2) -> sprintf ("\tmovl\t%s,\t%s\n", opndString (s1), opndString (s2)) + | Push (s) -> sprintf ("\tpushl\t%s\n", opndString (s)) + | Pop (s) -> sprintf ("\tpopl\t%s\n", opndString (s)) + | Ret -> "\tret\n" + | Call (p) -> sprintf ("\tcall\t%s\n", p) + | Label (l) -> sprintf ("%s:\n", l) + | Jmp (l) -> sprintf ("\tjmp\t%s\n", l) + | CJmp (c, l) -> sprintf ("\tj%s\t%s\n", c, l) + | Meta (m) -> m + esac +} + +-- Environment for symbolic interpreter +-- An environment holds +-- a symbolic stack +-- a maximal stack depth reached so far +-- a set of global variable names + +fun makeEnv (stack, stackSlots, globals) { + -- Returns an internal name for a global variable + fun globalName (name) { + "global_" ++ name + } + + -- Returns a string representation of the environment + fun envString () { + sprintf ("Stack : %s\nStackSlots: %d\nGlobals : %s\n", stack.string, stackSlots, elements (globals).string) + } + + -- Allocates a new position on the symbolic stack; + -- returns a pair: a location for allocated item and + -- an updated environment + fun allocate () { + case + case stack of + {} -> [ebx, 0] + | S (n) : _ -> [S (n+1), n+2] + | R (n) : _ -> if n < nRegs then [R (n+1), stackSlots] else [S (0), 1] fi + | _ -> [S (0), 1] + esac + of [x, n] -> [x, makeEnv (x : stack, if n > stackSlots then n else stackSlots fi, globals)]esac + } + + -- Pushes an item on the symbolic state; returns an updated envirtonment + fun push (y) { + makeEnv (y : stack, stackSlots, globals) + } + + -- Pops one item from the symbolic stack; returns a pair: a popped + -- item and an updated environment + fun pop () { + case stack of + x : stack -> [x, makeEnv (stack, stackSlots, globals)] + esac + } + + -- Pops two items from the symbolic stack; returns a triple: + -- popped items and an undated environment + fun pop2 () { + case stack of + x : y : stack -> [x, y, makeEnv (stack, stackSlots, globals)] + esac + } + + -- Adds a global variable; returns an updated environment + fun addGlobal (name) { + makeEnv (stack, stackSlots, addSet (globals, globalName (name))) + } + + -- References a global variable + fun loc (name) { + M (globalName (name)) + } + + -- Gets a list of global variables from the environment + fun getGlobals () { + globals.elements + } + + -- Gets a maximal stack size from the environment + fun getStackSize () { + stackSlots + } + + [envString, allocate, push, pop, pop2, addGlobal, loc, getGlobals, getStackSize] +} + +-- Exported accessors +fun envString (env) { + env [0] () +} + +fun allocate (env) { + env [1] () +} + +fun push (env, x) { + env [2] (x) +} + +fun pop (env) { + env [3] () +} + +fun pop2 (env) { + env [4] () +} + +fun addGlobal (env, name) { + env [5] (name) +} + +fun loc (env, name) { + env [6] (name) +} + +fun getGlobals (env) { + env [7] () +} + +fun getStackSize (env) { + env [8] () +} + +-- Creates an initial environment +fun initEnv () { + makeEnv (0, emptySet (compare), emptySet (compare)) +} + +-- Codegeneration helper functions +-- Generates code section +fun codeSection (text) { + singletonBuffer (Meta ("\t.text\n")) <+> text +} + +-- Generates data section +fun dataSection (text) { + singletonBuffer (Meta ("\t.data\n")) <+> text +} + +-- Generates data definition +fun dataDef (name) { + Meta (sprintf ("%s:\t.int\t0\n", name)) +} + +-- Generates function prologue +fun prologue (size) { + singletonBuffer (Push (ebp)) <+ + Mov (esp, ebp) <+ + Binop ("-", L (wordSize*size), esp) +} + +-- Generates function epilogue +fun epilogue () { + singletonBuffer (Mov (ebp, esp)) <+ + Pop (ebp) <+ + Binop ("^", eax, eax) <+ + Ret +} + +-- Checks if an operand resides on a stack +fun stackOpnd (opnd) { + case opnd of + S (_) -> true + | _ -> false + esac +} + +-- Checks if an operand resides in memory +fun memOpnd (opnd) { + case opnd of + S (_) -> true + | M (_) -> true + | _ -> false + esac +} + +-- Generates a move between locations, using +-- intermediate register if needed +fun move (from, to) { + if memOpnd (from) && memOpnd (to) + then singletonBuffer (Mov (from, eax)) <+ Mov (eax, to) + else singletonBuffer (Mov (from, to)) + fi +} + +-- Gets a suffix for Set instruction from +-- source language comparison operator +fun suffix (op) { + case op of + "<" -> "l" + | "<=" -> "le" + | "==" -> "e" + | "!=" -> "ne" + | ">=" -> "ge" + | ">" -> "g" + 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 compile (env, code) { + foldl ( + fun ([env, scode], i) { + local code = scode <+ Meta ("# " ++ showSMInsn (i) ++ "\n"); + case i of + READ -> + case env.allocate of + [s, env] -> [env, code <+ Call ("Lread") <+ Mov (eax, s)] + esac + | WRITE -> + case env.pop of + [s, env] -> [env, code <+ Push (s) <+ Call ("Lwrite") <+ Pop (eax)] + esac + | CONST (n) -> + case env.allocate of + [s, env] -> [env, code <+ Mov (L (n), s)] + esac + | ST (x) -> + case env.addGlobal (x).pop of + [s, env] -> [env, code <+> move (s, env.loc (x))] + esac + | LD (x) -> + case env.allocate of + [s, env] -> [env, code <+> move (env.loc (x), s)] + esac + | BINOP (op) -> + case env.pop2 of + [x, y, env] -> + case env.allocate of + [s, env] -> case op of + "+" -> [env, code <+ Mov (y, eax) <+ Binop("+", x, eax) <+ Mov (eax, s)] + + | "-" -> [env, code <+ Mov (y, eax) <+ Binop("-", x, eax) <+ Mov (eax, s)] + + | "*" -> if stackOpnd(y) + then [env, code <+ Mov(y, eax) <+ Binop("*", x, eax) <+ Mov(eax, s)] + else [env, code <+ Binop("*", x, y) <+ Mov(y, s)] + fi + + | "&&" -> if stackOpnd(y) + then [env, code <+ Mov (y, edx) <+ Binop ("*", x, edx) <+ Binop ("cmp", L (0), edx) <+ Mov (L (0), edx) <+ Set (suffix("!="), "%dl") <+ Mov (edx, s)] + else [env, code <+ Binop("*", x, y) <+ Binop ("cmp", L (0), y) <+ Mov (L (0), edx) <+ Set (suffix("!="), "%dl") <+ Mov (edx, s)] + fi + + | "!!" -> [env, code <+ Mov (y, edx) <+ Binop ("cmp", L (0), edx) <+ Mov (L(0), edx) <+ Set (suffix("!="), "%dl") <+ Mov (x, eax) <+ Binop ("cmp", L (0), eax) <+ Mov (L(0), eax) <+ Set (suffix("!="), "%al") <+ Binop ("!!", eax, edx) <+ Mov (edx, s)] + + | "/" -> [env, code <+ Mov (y, eax) <+ Cltd <+ IDiv (x) <+ Mov (eax, s)] + + | "%" -> [env, code <+ Mov (y, eax) <+ Cltd <+ IDiv (x) <+ Mov (edx, s)] + + | _ -> [env, code <+ Mov (x, eax) <+ Binop ("cmp", eax, y)<+ Mov(L(0), eax) <+ Set (suffix (op), "%al") <+ Mov (eax, s)] + esac + esac + esac + | LABEL(label) -> [env, code <+ Label(label)] + | JMP(label) -> [env, code <+ Jmp(label)] + | CJMP(cond, label) -> case env.pop of [s, env] -> + [env, code <+ Mov(L(0), eax) <+ Binop("cmp", s, eax) <+ CJmp(cond, label)] + esac + esac + }, [env, emptyBuffer ()], code) + } + + compile (env, code) +} + +-- A top-level codegeneration function. Takes a driver's environment and a stack machine program, +-- compiles the program into machine code, and compiles the machine code into an executable +public fun compileX86 (args, code) { + case compile (initEnv (), code) of + [env, code] -> + local asmFile = args.getBaseName ++ ".s", + runtime = case getEnv ("LAMA_RUNTIME") of + #unboxed -> "../runtime/" + | path -> path + esac ++ "/runtime.o"; + + fwrite (asmFile, + map (insnString, + getBuffer $ + singletonBuffer (Meta ("\t.global\tmain\n")) <+> + dataSection (listBuffer $ map (dataDef, getGlobals (env))) <+> + codeSection ( + singletonBuffer (Meta ("main:\n")) <+> + prologue (getStackSize (env)) <+> + code <+> + epilogue () + ) + ).stringcat); + + system ({"gcc -g -m32 -o ", args.getBaseName, " ", runtime, " ", asmFile}.stringcat) + esac +}