st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-05 22:38:44 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Control statement (interpreter, SM, x86)

Browse source
This commit is contained in:
Dmitry Boulytchev 2018-03-11 22:30:01 +03:00
parent 42d94672bc
commit 8758485b80
15 changed files with 132 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

2
regression/Makefile
View file

@ -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

2
regression/orig/test009.log
View file

@ -1 +1 @@
2
1024

2
regression/orig/test010.log
View file

@ -1 +1 @@
1024
499950

4
regression/orig/test011.log
View file

@ -1,3 +1 @@
5
5
3
2

1
regression/orig/test014.log
View file

@ -1 +0,0 @@
499950

8
regression/test009.expr Normal file
View file

@ -0,0 +1,8 @@
n := 2;
k := 10;
res := 1;
while k > 0 do
res := res * n;
k := k - 1
od;
write(res)

0
regression/test009.input Normal file
View file

18
regression/test010.expr Normal file
View file

@ -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)

0
regression/test010.input Normal file
View file

5
regression/test011.expr Normal file
View file

@ -0,0 +1,5 @@
x:=0;
if x
then write(1)
else write(2)
fi

0
regression/test011.input Normal file
View file

2
src/Driver.ml
View file

@ -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 "--";

27
src/Language.ml
View file

@ -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

83
src/SM.ml
View file

@ -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 <label_name>)
*)
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

33
src/X86.ml
View file

@ -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 =