diff --git a/.gitignore b/.gitignore deleted file mode 100644 index a28eac24..00000000 --- a/.gitignore +++ /dev/null @@ -1,5 +0,0 @@ -/Driver -/Driver.cmi -/Driver.cmo -/Expr.cmi -/Expr.cmo diff --git a/.travis-opam.sh b/.travis-opam.sh new file mode 100644 index 00000000..c4399c7d --- /dev/null +++ b/.travis-opam.sh @@ -0,0 +1,37 @@ +echo -en "travis_fold:start:prepare.ci\r" +# If a fork of these scripts is specified, use that GitHub user instead +fork_user=${FORK_USER:-ocaml} + +# If a branch of these scripts is specified, use that branch instead of 'master' +fork_branch=${FORK_BRANCH:-master} + +### Bootstrap + +set -uex + +get() { + wget https://raw.githubusercontent.com/${fork_user}/ocaml-ci-scripts/${fork_branch}/$@ +} + +TMP_BUILD=$(mktemp -d 2>/dev/null || mktemp -d -t 'citmpdir') +cd ${TMP_BUILD} + +get .travis-ocaml.sh +get yorick.mli +get yorick.ml +get ci_opam.ml + +sh .travis-ocaml.sh +export OPAMYES=1 +eval $(opam config env) + +# This could be removed with some OPAM variable plumbing into build commands +opam install ocamlfind + +ocamlc.opt yorick.mli +ocamlfind ocamlc -c yorick.ml + +ocamlfind ocamlc -o ci-opam -package unix -linkpkg yorick.cmo ci_opam.ml +cd - + +echo -en "travis_fold:end:prepare.ci\r" diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 00000000..b8a584d9 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,9 @@ +language: c +sudo: required +script: + - bash -ex .travis-opam.sh + - ./installBuildRun.sh +env: + - OCAML_VERSION=4.04 +os: + - linux diff --git a/installBuildRun.sh b/installBuildRun.sh new file mode 100755 index 00000000..70dfbfb8 --- /dev/null +++ b/installBuildRun.sh @@ -0,0 +1,14 @@ +opam pin add GT https://github.com/Kakadu/GT.git -n -y +opam pin add ostap https://github.com/dboulytchev/ostap.git -n -y +opam install camlp5 -y +opam install GT ostap ocamlfind -y +eval `opam config env` +sudo apt-get install gcc-multilib -y + +make + +cd regression +make + +cd deep-expressions +make diff --git a/regression/Makefile b/regression/Makefile index 72dbc45f..baca8ca3 100644 --- a/regression/Makefile +++ b/regression/Makefile @@ -1,7 +1,4 @@ -TESTS=test001 test002 test012 test013 - -# More expressions: -# test003 test004 test005 test006 test007 test008 +TESTS=test001 test002 test012 test013 test003 test004 test005 test006 test007 test008 # Later: # test009 test010 test 11 diff --git a/src/Driver.ml b/src/Driver.ml index 5c8e0b34..912cb75d 100644 --- a/src/Driver.ml +++ b/src/Driver.ml @@ -8,7 +8,7 @@ let parse filename = Util.parse (object inherit Matcher.t s - inherit Util.Lexers.ident ["read"; "write"; "skip"] s + inherit Util.Lexers.ident ["read"; "write"; "skip"; "if"; "fi"; "then"; "else"; "while"; "do"; "od"; "repeat"; "until"; "for"] s inherit Util.Lexers.decimal s inherit Util.Lexers.skip [ Matcher.Skip.whitespaces " \t\n"; diff --git a/src/Interpret.ml b/src/Interpret.ml index 12c5dddb..73a65a90 100644 --- a/src/Interpret.ml +++ b/src/Interpret.ml @@ -5,14 +5,14 @@ module Expr = struct open Expr + open Language.BinOp let rec eval expr st = let eval' e = eval e st in match expr with | Var x -> st x | Const z -> z - | Add (x, y) -> eval' x + eval' y - | Mul (x, y) -> eval' x * eval' y + | Binop (op, x, y) -> (apply op) (eval' x) (eval' y) end @@ -34,6 +34,9 @@ module Stmt = (update st x z, input', output) | Write e -> (st, input, output @ [Expr.eval e st]) | Seq (s1, s2) -> eval s1 conf |> eval s2 + | If (e, s1, s2) -> if (Expr.eval state' e) <> 0 then (eval conf s1) else (eval conf s2) + (*eval self again but with new conf (which is eval'ed body of while')*) + | While (e, s) -> if (Expr.eval state' e) <> 0 then eval (eval conf s) stmt else conf end diff --git a/src/Language.ml b/src/Language.ml index 96ac3e01..93bfdae1 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -1,20 +1,52 @@ -(* AST for expressions *) +open Ostap +open Matcher + module Expr = struct type t = | Var of string | Const of int - | Add of t * t - | Mul of t * t + | Binop of string * t * t ostap ( - parse: x:mull "+" y:parse {Add (x,y)} | mull; - mull : x:prim "*" y:mull {Mul (x,y)} | prim; - prim : - n:DECIMAL {Const n} - | e:IDENT {Var e} - | -"(" parse -")" + parse: + orins; + + orins: + l:andins suf:(("!!") andins)* { + List.fold_left (fun l (op, r) -> Binop (Token.repr op, l, r)) l suf + } + | andins; + + andins: + l:cmp suf:(("&&") cmp)* { + List.fold_left (fun l (op, r) -> Binop (Token.repr op, l, r)) l suf + } + | cmp; + + cmp: + l:add suf:(("<=" | "<" | ">=" | ">" | "==" | "!=") add)* { + List.fold_left (fun l (op, r) -> Binop (Token.repr op, l, r)) l suf + } + | add; + + add: + l:mull suf:(("+" | "-") mull)* { + List.fold_left (fun l (op, r) -> Binop (Token.repr op, l, r)) l suf + } + | mull; + + mull: + l:prim suf:(("*" | "/" | "%") prim)* { + List.fold_left (fun l (op, r) -> Binop (Token.repr op, l, r)) l suf + } + | prim; + + prim: + n:DECIMAL {Const n} + | x:IDENT {Var x} + | -"(" parse -")" ) end @@ -29,6 +61,9 @@ module Stmt = | Read of string | Write of Expr.t | Seq of t * t + | If of Expr.t * t * t + | While of Expr.t * t + | Repeat of t * Expr.t let expr = Expr.parse @@ -36,13 +71,49 @@ module Stmt = simp: x:IDENT ":=" e:expr {Assign (x, e)} | %"read" "(" x:IDENT ")" {Read x} | %"write" "(" e:expr ")" {Write e} - | %"skip" {Skip}; - + | %"skip" {Skip} + | %"if" e:!(Expr.parse) + %"then" s1:!(parse) + %"else" s2:!(parse) + %"fi" {If (e, s1, s2)} + | %"if" e:!(Expr.parse) + %"then" s1:!(parse) + %"fi" {If (e, s1, Skip)} + | %"while" e:!(Expr.parse) + %"do" s:!(parse) + %"od" {While (e, s)} + | %"repeat" s:!(parse) + %"until" e:!(Expr.parse) {Seq (s, While (Binop ("==", e, Const 0), s))} + | %"for" i:!(parse) "," n:!(Expr.parse) "," b:!(parse) + %"do" a:!(parse) + %"od" {Seq (i, (While (n, Seq (a, b))))}; parse: s:simp ";" d:parse {Seq (s,d)} | simp ) end + +module BinOp = + struct + + let apply op = + match op with + | "+" -> fun x y -> x + y + | "*" -> fun x y -> x * y + | "-" -> fun x y -> x - y + | "/" -> fun x y -> x / y + | "%" -> fun x y -> x mod y + | "<" -> fun x y -> if x < y then 1 else 0 + | "<=" -> fun x y -> if x <= y then 1 else 0 + | ">" -> fun x y -> if x > y then 1 else 0 + | ">=" -> fun x y -> if x >= y then 1 else 0 + | "==" -> fun x y -> if x = y then 1 else 0 + | "!=" -> fun x y -> if x <> y then 1 else 0 + | "&&" -> fun x y -> if (x <> 0) && (y <> 0) then 1 else 0 + | "!!" -> fun x y -> if (x <> 0) || (y <> 0) then 1 else 0 + + end + module Program = struct diff --git a/src/StackMachine.ml b/src/StackMachine.ml index 870537a4..d004853e 100644 --- a/src/StackMachine.ml +++ b/src/StackMachine.ml @@ -8,8 +8,7 @@ module Instr = | PUSH of int | LD of string | ST of string - | ADD - | MUL + | BINOP of string end @@ -25,6 +24,7 @@ module Interpret = open Instr open Interpret.Stmt + open Language.BinOp let run prg input = let rec run' prg ((stack, st, input, output) as conf) = @@ -41,13 +41,10 @@ module Interpret = | LD x -> (st x :: stack, st, input, output) | ST x -> let z :: stack' = stack in (stack', update st x z, input, output) - | _ -> let y :: x :: stack' = stack in - ((match i with ADD -> (+) | _ -> ( * )) x y :: stack', - st, - input, - output - ) - ) + | BINOP op -> + let y::x::stack' = stack in + ((apply op x y)::stack', st, input, output) + ) in let (_, _, _, output) = run' prg ([], @@ -72,8 +69,7 @@ module Compile = let rec compile = function | Var x -> [LD x] | Const n -> [PUSH n] - | Add (x, y) -> (compile x) @ (compile y) @ [ADD] - | Mul (x, y) -> (compile x) @ (compile y) @ [MUL] + | Binop (op, x, y) -> (compile x) @ (compile y) @ [BINOP op] end diff --git a/src/X86.ml b/src/X86.ml index 9f0544af..a51dcee9 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -8,14 +8,30 @@ let nregs = Array.length regs - 3 let [|eax; ebx; ecx; esi; edi; edx; esp; ebp|] = Array.mapi (fun i _ -> R i) regs + type instr = | Add of opnd * opnd | Mul of opnd * opnd +| Sub of opnd * opnd +| Div of opnd * opnd +| Mod of opnd * opnd | Mov of opnd * opnd +| Cmp of opnd * opnd +| Xor of opnd * opnd +| Or of opnd * opnd +| And of opnd * opnd | Push of opnd | Pop of opnd -| Call of string +| Cdq +| Setl +| Setle +| Setg +| Setge +| Sete +| Setne +| Movzbl | Ret +| Call of string let to_string buf code = let instr = @@ -26,13 +42,36 @@ let to_string buf code = | M s -> s in function - | Add (x, y) -> Printf.sprintf "addl\t%s,%s" (opnd x) (opnd y) - | Mul (x, y) -> Printf.sprintf "imull\t%s,%s" (opnd x) (opnd y) - | Mov (x, y) -> Printf.sprintf "movl\t%s,%s" (opnd x) (opnd y) - | Push x -> Printf.sprintf "pushl\t%s" (opnd x) - | Pop x -> Printf.sprintf "popl\t%s" (opnd x) - | Call x -> Printf.sprintf "call\t%s" x - | Ret -> "ret" + | Add (s1, s2) -> Printf.sprintf "\taddl\t%s,\t%s" (opnd s1) (opnd s2) + | Mul (s1, s2) -> Printf.sprintf "\timull\t%s,\t%s" (opnd s1) (opnd s2) + | Sub (s1, s2) -> Printf.sprintf "\tsubl\t%s,\t%s" (opnd s1) (opnd s2) + | Div (s1, s2) -> Printf.sprintf "\tidivl\t%s" (opnd s1) + + | Mov (s1, s2) -> Printf.sprintf "\tmovl\t%s,\t%s" (opnd s1) (opnd s2) + | Cmp (s1, s2) -> Printf.sprintf "\tcmp\t%s,\t%s" (opnd s1) (opnd s2) + | Push s -> Printf.sprintf "\tpushl\t%s" (opnd s ) + | Pop s -> Printf.sprintf "\tpopl\t%s" (opnd s ) + + | Xor (s1, s2) -> Printf.sprintf "\txorl\t%s,\t%s" (opnd s1) (opnd s2) + | Or (s1, s2) -> Printf.sprintf "\torl\t%s,\t%s" (opnd s1) (opnd s2) + | And (s1, s2) -> Printf.sprintf "\tandl\t%s,\t%s" (opnd s1) (opnd s2) + + (*выставляем байты если выполняются условия*) + | Setl -> "\tsetl\t%al" + | Setle -> "\tsetle\t%al" + | Setg -> "\tsetg\t%al" + | Setge -> "\tsetge\t%al" + | Sete -> "\tsete\t%al" + | Setne -> "\tsetne\t%al" + + + (*в wrap_mem_access мы в y кладём edx, соотв. здесь al кладём в edx*) + | Movzbl -> "\tmovzbl\t%al,\t%edx" + + (*делаем знаковое деление*) + | Cdq -> "\tcdq" + | Ret -> "\tret" + | Call p -> Printf.sprintf "\tcall\t%s" p in let out s = Buffer.add_string buf "\t"; @@ -42,14 +81,23 @@ let to_string buf code = List.iter (fun i -> out @@ instr i) code module S = Set.Make (String) - + +let save_eax_edx f = + [Push eax; Push edx] @ f @ [Pop edx; Pop eax] + +let wrap_mem_access x y f = + save_eax_edx @@ [Mov (x, eax); Mov (y, edx)] @ (f eax edx) @ [Mov (edx, y)] + +let compare x y cmp = + [Cmp (x, y); cmp; Movzbl] + class env = object (this) val locals = S.empty val depth = 0 method allocate = function - | [] -> this, R 0 + | [] -> this, R 1 | R i :: _ when i < nregs - 1 -> this, R (i+1) | S i :: _ -> {< depth = max depth (i+1) >}, S (i+1) | _ -> {< depth = max depth 1 >}, S 1 @@ -71,26 +119,64 @@ let rec sint env prg sstack = | LD x -> let env' = env#local x in let env'', s = env'#allocate sstack in - env'', [Mov (M x, s)], s :: sstack - | ST x -> + env'', (wrap_mem_access (M x) s @@ fun x y -> [Mov (x, y)]), s :: sstack + | ST x -> let env' = env#local x in let s :: sstack' = sstack in env', [Mov (s, M x)], sstack' | READ -> env, [Call "lread"], [eax] | WRITE -> - env, [Push eax; Call "lwrite"; Pop edx], [] - | _ -> + env, [Push (R 1); Call "lwrite"; Pop (R 1)], [] + | BINOP op -> let x::(y::_ as sstack') = sstack in - (fun op -> - match x, y with - | S _, S _ -> env, [Mov (y, edx); op x edx; Mov (edx, y)], sstack' - | _ -> env, [op x y], sstack' - ) - (match i with - | MUL -> fun x y -> Mul (x, y) - | ADD -> fun x y -> Add (x, y) - ) + env, (match op with + | "+" -> + wrap_mem_access x y @@ fun x y -> [Add (x, y); Mov (y, eax)] + | "-" -> + wrap_mem_access x y @@ fun x y -> [Sub (x, y); Mov (y, eax)] + | "*" -> + save_eax_edx [Mov (y, eax); Mul (x, eax); Mov (eax, y)] + | "/" -> + save_eax_edx [Mov (y, eax); Cdq; Div (x, y); Mov (eax, y)] + | "%" -> + save_eax_edx [Mov (y, eax); Cdq; Div (x, y); Mov (edx, y)] + | "<" -> + wrap_mem_access x y @@ fun x y -> compare x y Setl + | "<=" -> + wrap_mem_access x y @@ fun x y -> compare x y Setle + | ">" -> + wrap_mem_access x y @@ fun x y -> compare x y Setg + | ">=" -> + wrap_mem_access x y @@ fun x y -> compare x y Setge + | "==" -> + wrap_mem_access x y @@ fun x y -> compare x y Sete + | "!=" -> + wrap_mem_access x y @@ fun x y -> compare x y Setne + | "&&" -> + save_eax_edx [ + (* Set eax value to null, mov x to edx, check that edx is not null + if it is true - in eax we now have not null + *) + Xor (eax, eax); + Mov (x, edx); + Cmp (edx, eax); + Setne; + Mov (y, edx); + Mul (eax, edx); + Xor (eax, eax); + Cmp (edx, eax); + Setne; + Mov (eax, y)] + | "!!" -> + save_eax_edx [ + Xor (eax, eax); + Mov (x, edx); + Or (y, edx); + Cmp (edx, eax); + Setne; + Mov (eax, y)] + ), sstack' in let env, code', sstack'' = sint env prg' sstack' in env, code @ code', sstack''