From 8758485b80424507c1bea98f3de461d9268cb824 Mon Sep 17 00:00:00 2001 From: Dmitry Boulytchev Date: Sun, 11 Mar 2018 22:30:01 +0300 Subject: [PATCH] Control statement (interpreter, SM, x86) --- regression/Makefile | 2 +- regression/orig/test009.log | 2 +- regression/orig/test010.log | 2 +- regression/orig/test011.log | 4 +- regression/orig/test014.log | 1 - regression/test009.expr | 8 ++++ regression/test009.input | 0 regression/test010.expr | 18 ++++++++ regression/test010.input | 0 regression/test011.expr | 5 +++ regression/test011.input | 0 src/Driver.ml | 2 +- src/Language.ml | 27 ++++++++---- src/SM.ml | 83 +++++++++++++++++++++++++++---------- src/X86.ml | 33 ++++++++------- 15 files changed, 132 insertions(+), 55 deletions(-) delete mode 100644 regression/orig/test014.log create mode 100644 regression/test009.expr create mode 100644 regression/test009.input create mode 100644 regression/test010.expr create mode 100644 regression/test010.input create mode 100644 regression/test011.expr create mode 100644 regression/test011.input diff --git a/regression/Makefile b/regression/Makefile index 007d15046..c085633f1 100644 --- a/regression/Makefile +++ b/regression/Makefile @@ -1,4 +1,4 @@ -TESTS=test001 test002 test003 test004 test005 test006 test007 test008 +TESTS=test001 test002 test003 test004 test005 test006 test007 test008 test009 test010 test011 RC=../src/rc.opt diff --git a/regression/orig/test009.log b/regression/orig/test009.log index 0cfbf0888..d7b1c440c 100644 --- a/regression/orig/test009.log +++ b/regression/orig/test009.log @@ -1 +1 @@ -2 +1024 diff --git a/regression/orig/test010.log b/regression/orig/test010.log index d7b1c440c..13e085dfa 100644 --- a/regression/orig/test010.log +++ b/regression/orig/test010.log @@ -1 +1 @@ -1024 +499950 diff --git a/regression/orig/test011.log b/regression/orig/test011.log index fbb7b4d07..0cfbf0888 100644 --- a/regression/orig/test011.log +++ b/regression/orig/test011.log @@ -1,3 +1 @@ -5 -5 -3 +2 diff --git a/regression/orig/test014.log b/regression/orig/test014.log deleted file mode 100644 index 13e085dfa..000000000 --- a/regression/orig/test014.log +++ /dev/null @@ -1 +0,0 @@ -499950 diff --git a/regression/test009.expr b/regression/test009.expr new file mode 100644 index 000000000..153699d11 --- /dev/null +++ b/regression/test009.expr @@ -0,0 +1,8 @@ +n := 2; +k := 10; +res := 1; +while k > 0 do + res := res * n; + k := k - 1 +od; +write(res) diff --git a/regression/test009.input b/regression/test009.input new file mode 100644 index 000000000..e69de29bb diff --git a/regression/test010.expr b/regression/test010.expr new file mode 100644 index 000000000..0b6a42527 --- /dev/null +++ b/regression/test010.expr @@ -0,0 +1,18 @@ +i := 0; +s := 0; + +while i < 100 +do + j := 0; + + while j < 100 + do + s := s + j; + j := j + 1 + od; + + s := s + i; + i := i + 1 +od; + +write (s) diff --git a/regression/test010.input b/regression/test010.input new file mode 100644 index 000000000..e69de29bb diff --git a/regression/test011.expr b/regression/test011.expr new file mode 100644 index 000000000..a89428dc7 --- /dev/null +++ b/regression/test011.expr @@ -0,0 +1,5 @@ +x:=0; +if x +then write(1) +else write(2) +fi diff --git a/regression/test011.input b/regression/test011.input new file mode 100644 index 000000000..e69de29bb diff --git a/src/Driver.ml b/src/Driver.ml index f500a3774..da6c5b0ac 100644 --- a/src/Driver.ml +++ b/src/Driver.ml @@ -6,7 +6,7 @@ let parse infile = (object inherit Matcher.t s inherit Util.Lexers.decimal s - inherit Util.Lexers.ident ["read"; "write"] s + inherit Util.Lexers.ident ["read"; "write"; "skip"; "if"; "then"; "else"; "fi"; "while"; "do"; "od"] s inherit Util.Lexers.skip [ Matcher.Skip.whitespaces " \t\n"; Matcher.Skip.lineComment "--"; diff --git a/src/Language.ml b/src/Language.ml index 0fb34aba0..23a945e93 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -110,8 +110,11 @@ module Stmt = (* read into the variable *) | Read of string (* write the value of an expression *) | Write of Expr.t (* assignment *) | Assign of string * Expr.t - (* composition *) | Seq of t * t with show - + (* composition *) | Seq of t * t + (* empty statement *) | Skip + (* conditional *) | If of Expr.t * t * t + (* loop *) | While of Expr.t * t with show + (* The type of configuration: a state, an input stream, an output stream *) type config = Expr.state * int list * int list @@ -123,10 +126,13 @@ module Stmt = *) let rec eval ((st, i, o) as conf) stmt = match stmt with - | Read x -> (match i with z::i' -> (Expr.update x z st, i', o) | _ -> failwith "Unexpected end of input") - | Write e -> (st, i, o @ [Expr.eval st e]) - | Assign (x, e) -> (Expr.update x (Expr.eval st e) st, i, o) - | Seq (s1, s2) -> eval (eval conf s1) s2 + | Read x -> (match i with z::i' -> (Expr.update x z st, i', o) | _ -> failwith "Unexpected end of input") + | Write e -> (st, i, o @ [Expr.eval st e]) + | Assign (x, e) -> (Expr.update x (Expr.eval st e) st, i, o) + | Seq (s1, s2) -> eval (eval conf s1) s2 + | Skip -> conf + | If (e, s1, s2) -> eval conf (if Expr.eval st e <> 0 then s1 else s2) + | While (e, s) -> if Expr.eval st e = 0 then conf else eval (eval conf s) stmt (* Statement parser *) ostap ( @@ -134,9 +140,12 @@ module Stmt = s:stmt ";" ss:parse {Seq (s, ss)} | stmt; stmt: - "read" "(" x:IDENT ")" {Read x} - | "write" "(" e:!(Expr.parse) ")" {Write e} - | x:IDENT ":=" e:!(Expr.parse) {Assign (x, e)} + %"read" "(" x:IDENT ")" {Read x} + | %"write" "(" e:!(Expr.parse) ")" {Write e} + | %"skip" {Skip} + | %"if" e:!(Expr.parse) %"then" s1:parse %"else" s2:parse %"fi" {If (e, s1, s2)} + | %"while" e:!(Expr.parse) %"do" s:parse %"od" {While (e, s)} + | x:IDENT ":=" e:!(Expr.parse) {Assign (x, e)} ) end diff --git a/src/SM.ml b/src/SM.ml index 5521f6ec5..7abeb5199 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -8,8 +8,11 @@ open Language (* read to stack *) | READ (* write from stack *) | WRITE (* load a variable to the stack *) | LD of string -(* store a variable from the stack *) | ST of string with show - +(* store a variable from the stack *) | ST of string +(* a label *) | LABEL of string +(* unconditional jump *) | JMP of string +(* conditional jump *) | CJMP of string * string with show + (* The type for the stack machine program *) type prg = insn list @@ -20,22 +23,25 @@ type config = int list * Stmt.config (* Stack machine interpreter - val eval : config -> prg -> config + val eval : env -> config -> prg -> config - Takes a configuration and a program, and returns a configuration as a result - *) -let rec eval ((stack, ((st, i, o) as c)) as conf) = function + Takes an environment, a configuration and a program, and returns a configuration as a result. The + environment is used to locate a label to jump to (via method env#labeled ) +*) +let rec eval env ((stack, ((st, i, o) as c)) as conf) = function | [] -> conf | insn :: prg' -> - eval - (match insn with - | BINOP op -> let y::x::stack' = stack in (Expr.to_func op x y :: stack', c) - | READ -> let z::i' = i in (z::stack, (st, i', o)) - | WRITE -> let z::stack' = stack in (stack', (st, i, o @ [z])) - | CONST i -> (i::stack, c) - | LD x -> (st x :: stack, c) - | ST x -> let z::stack' = stack in (stack', (Expr.update x z st, i, o)) - ) prg' + (match insn with + | BINOP op -> let y::x::stack' = stack in eval env (Expr.to_func op x y :: stack', c) prg' + | READ -> let z::i' = i in eval env (z::stack, (st, i', o)) prg' + | WRITE -> let z::stack' = stack in eval env (stack', (st, i, o @ [z])) prg' + | CONST i -> eval env (i::stack, c) prg' + | LD x -> eval env (st x :: stack, c) prg' + | ST x -> let z::stack' = stack in eval env (stack', (Expr.update x z st, i, o)) prg' + | LABEL _ -> eval env conf prg' + | JMP l -> eval env conf (env#labeled l) + | CJMP (c, l) -> let x::stack' = stack in eval env conf (if (c = "z" && x = 0) || (c = "nz" && x <> 0) then env#labeled l else prg') + ) (* Top-level evaluation @@ -43,7 +49,15 @@ let rec eval ((stack, ((st, i, o) as c)) as conf) = function Takes a program, an input stream, and returns an output stream this program calculates *) -let run p i = let (_, (_, _, o)) = eval ([], (Expr.empty, i, [])) p in o +let run p i = + let module M = Map.Make (String) in + let rec make_map m = function + | [] -> m + | (LABEL l) :: tl -> make_map (M.add l tl m) tl + | _ :: tl -> make_map m tl + in + let m = make_map M.empty p in + let (_, (_, _, o)) = eval (object method labeled l = M.find l m end) ([], (Expr.empty, i, [])) p in o (* Stack machine compiler @@ -52,14 +66,39 @@ let run p i = let (_, (_, _, o)) = eval ([], (Expr.empty, i, [])) p in o Takes a program in the source language and returns an equivalent program for the stack machine *) -let rec compile = +let compile p = let rec expr = function | Expr.Var x -> [LD x] | Expr.Const n -> [CONST n] | Expr.Binop (op, x, y) -> expr x @ expr y @ [BINOP op] in - function - | Stmt.Seq (s1, s2) -> compile s1 @ compile s2 - | Stmt.Read x -> [READ; ST x] - | Stmt.Write e -> expr e @ [WRITE] - | Stmt.Assign (x, e) -> expr e @ [ST x] + let rec compile' l env = function + | Stmt.Read x -> env, false, [READ; ST x] + | Stmt.Write e -> env, false, expr e @ [WRITE] + | Stmt.Assign (x, e) -> env, false, expr e @ [ST x] + | Stmt.Skip -> env, false, [] + + | Stmt.Seq (s1, s2) -> let l2, env = env#get_label in + let env, flag1, s1 = compile' l2 env s1 in + let env, flag2, s2 = compile' l env s2 in + env, flag2, s1 @ (if flag1 then [LABEL l2] else []) @ s2 + + | Stmt.If (c, s1, s2) -> let l2, env = env#get_label in + let env, flag1, s1 = compile' l env s1 in + let env, flag2, s2 = compile' l env s2 in + env, true, expr c @ [CJMP ("z", l2)] @ s1 @ (if flag1 then [] else [JMP l]) @ [LABEL l2] @ s2 @ (if flag2 then [] else [JMP l]) + + | Stmt.While (c, s) -> let loop, env = env#get_label in + let cond, env = env#get_label in + let env, _, s = compile' cond env s in + env, false, [JMP cond; LABEL loop] @ s @ [LABEL cond] @ expr c @ [CJMP ("nz", loop)] + in + let env = + object + val label = 0 + method get_label = "L_" ^ string_of_int label, {< label = label + 1 >} + end + in + let lend, env = env#get_label in + let _, flag, code = compile' lend env p in + if flag then code @ [LABEL lend] else code diff --git a/src/X86.ml b/src/X86.ml index 28bd1c6e4..bd946ae29 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -40,7 +40,10 @@ type instr = (* pops from the hardware stack to the operand *) | Pop of opnd (* call a function by a name *) | Call of string (* returns from a function *) | Ret - +(* a label in the code *) | Label of string +(* a conditional jump *) | CJmp of string * string +(* a non-conditional jump *) | Jmp of string + (* Instruction printer *) let show instr = let binop = function @@ -69,6 +72,9 @@ let show instr = | Pop s -> Printf.sprintf "\tpopl\t%s" (opnd s) | Ret -> "\tret" | Call p -> Printf.sprintf "\tcall\t%s" p + | Label l -> Printf.sprintf "%s:\n" l + | Jmp l -> Printf.sprintf "\tjmp\t%s" l + | CJmp (s , l) -> Printf.sprintf "\tj%s\t%s" s l (* Opening stack machine to use instructions without fully qualified names *) open SM @@ -104,20 +110,15 @@ let compile env code = let s, env' = env#pop in (env', [Push s; Call "Lwrite"; Pop eax]) | CONST n -> - (*env#push (L n), []*) - let s, env' = env#allocate in - (env', [Mov (L n, s)]) - + let s, env' = env#allocate in + (env', [Mov (L n, s)]) | LD x -> - (* (env#global x)#push (M x), []*) - - let s, env' = (env#global x)#allocate in + let s, env' = (env#global x)#allocate in env', (match s with | S _ | M _ -> [Mov (M (env'#loc x), eax); Mov (eax, s)] | _ -> [Mov (M (env'#loc x), s)] ) - | ST x -> let s, env' = (env#global x)#pop in env', @@ -128,12 +129,7 @@ let compile env code = | BINOP op -> let x, y, env' = env#pop2 in env'#push y, - (* - let y, env', c = match y with L _ -> let z, env' = env'#allocate in z, env', [Mov (y, z)] | _ -> y, env'#push y, [] in - env', - c @ - *) - (match op with + (match op with | "/" | "%" -> [Mov (y, eax); Cltd; @@ -188,6 +184,11 @@ let compile env code = then [Mov (x, eax); Binop (op, eax, y)] else [Binop (op, x, y)] ) + | LABEL s -> env, [Label s] + | JMP l -> env, [Jmp l] + | CJMP (s, l) -> + let x, env = env#pop in + env, [Binop ("cmp", L 0, x); CJmp (s, l)] in let env'', code'' = compile' env' scode' in env'', code' @ code'' @@ -240,7 +241,7 @@ class env = method globals = S.elements globals end -(* compiles a unit: generates x86 machine code for the stack program and surrounds it +(* Compiles a unit: generates x86 machine code for the stack program and surrounds it with function prologue/epilogue *) let compile_unit env scode =