From d9ba8df80a06d04abd97a29e26a4909d70fa02c7 Mon Sep 17 00:00:00 2001 From: dsv Date: Fri, 24 Feb 2017 12:06:13 +0300 Subject: [PATCH 01/33] Add travis ci support --- .travis.yml | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 .travis.yml diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 00000000..2d237e72 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,12 @@ +language: c +sudo: required +install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh +script: + - bash -ex .travis-opam.sh + - opam pin add GT https://github.com/Kakadu/GT.git -n -y + - opam install GT -y + - make all +env: + - OCAML_VERSION=4.04 +os: + - linux From 14efe6c6c2a583202508349c9300365622584067 Mon Sep 17 00:00:00 2001 From: dsv Date: Fri, 24 Feb 2017 12:10:14 +0300 Subject: [PATCH 02/33] Add travis ci support --- .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 2d237e72..632949b2 100644 --- a/.travis.yml +++ b/.travis.yml @@ -6,6 +6,7 @@ script: - opam pin add GT https://github.com/Kakadu/GT.git -n -y - opam install GT -y - make all + - echo done env: - OCAML_VERSION=4.04 os: From 7ffce14e17ae5549932caa5c4ba5bf66f5629c1c Mon Sep 17 00:00:00 2001 From: dsv Date: Fri, 24 Feb 2017 12:37:40 +0300 Subject: [PATCH 03/33] . --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 632949b2..48d89cdd 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,7 +4,7 @@ install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.t script: - bash -ex .travis-opam.sh - opam pin add GT https://github.com/Kakadu/GT.git -n -y - - opam install GT -y + - opam install GT ocamlfind -y - make all - echo done env: From 94f90d7964ca61b192c81a1f9c2f093daa432cd7 Mon Sep 17 00:00:00 2001 From: dsv Date: Fri, 24 Feb 2017 12:55:03 +0300 Subject: [PATCH 04/33] . --- .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 48d89cdd..109b5e82 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,6 +4,7 @@ install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.t script: - bash -ex .travis-opam.sh - opam pin add GT https://github.com/Kakadu/GT.git -n -y + - opam install camlp5 -y - opam install GT ocamlfind -y - make all - echo done From 593e5c199dffd3ade648142cc0139cb9ccd8c8a3 Mon Sep 17 00:00:00 2001 From: dsv Date: Fri, 24 Feb 2017 13:06:31 +0300 Subject: [PATCH 05/33] . --- .travis.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.travis.yml b/.travis.yml index 109b5e82..e13cf1e2 100644 --- a/.travis.yml +++ b/.travis.yml @@ -6,6 +6,8 @@ script: - opam pin add GT https://github.com/Kakadu/GT.git -n -y - opam install camlp5 -y - opam install GT ocamlfind -y + - eval `opam config env` + - ocamlfind - make all - echo done env: From cc5818854054208bc998a0984fe92f6db7f0b75b Mon Sep 17 00:00:00 2001 From: dsv Date: Fri, 24 Feb 2017 13:26:30 +0300 Subject: [PATCH 06/33] . --- .travis-opam.sh | 37 +++++++++++++++++++++++++++++++++++++ .travis.yml | 2 -- 2 files changed, 37 insertions(+), 2 deletions(-) create mode 100644 .travis-opam.sh 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 index e13cf1e2..2145599e 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,13 +1,11 @@ language: c sudo: required -install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh script: - bash -ex .travis-opam.sh - opam pin add GT https://github.com/Kakadu/GT.git -n -y - opam install camlp5 -y - opam install GT ocamlfind -y - eval `opam config env` - - ocamlfind - make all - echo done env: From 9bafe27e1778a72a37664ae2725cc5775b544ee0 Mon Sep 17 00:00:00 2001 From: Semyon Danilov Date: Fri, 24 Feb 2017 13:44:20 +0300 Subject: [PATCH 07/33] Create README.md --- README.md | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 README.md diff --git a/README.md b/README.md new file mode 100644 index 00000000..fdc52211 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# eltech_compilers +Repository for Compilers course assignments +[![Build Status](https://travis-ci.org/SammyVimes/eltech_compilers.svg?branch=master)](https://travis-ci.org/SammyVimes/eltech_compilers) From e58923e4b65b10c0d3a580c9de454b20c46ca873 Mon Sep 17 00:00:00 2001 From: Semyon Danilov Date: Fri, 24 Feb 2017 13:46:05 +0300 Subject: [PATCH 08/33] Update README.md --- README.md | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index fdc52211..53b0f0fa 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,8 @@ +[![Build Status](https://travis-ci.org/SammyVimes/eltech_compilers.svg?branch=master)](https://travis-ci.org/SammyVimes/eltech_compilers) + # eltech_compilers -Repository for Compilers course assignments -[![Build Status](https://travis-ci.org/SammyVimes/eltech_compilers.svg?branch=master)](https://travis-ci.org/SammyVimes/eltech_compilers) +Repository for Compilers course assignments + +###Featuring: ++ x86 compiler ++ Travis CI build From 09ddccf2fe049ffd2ff3f9e4464794523e424a9d Mon Sep 17 00:00:00 2001 From: dsv Date: Fri, 24 Feb 2017 19:37:21 +0300 Subject: [PATCH 09/33] add c++ helpers for reading and writing --- helpers.cpp | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 helpers.cpp diff --git a/helpers.cpp b/helpers.cpp new file mode 100644 index 00000000..a13e84ba --- /dev/null +++ b/helpers.cpp @@ -0,0 +1,13 @@ +# include + +using namespace std; + +extern "C" int read () { + int d = 0; + cin >> d; + return d; +} + +extern "C" void write (int n) { + cout << n << endl; +} From 790c7a651c73304e879187851b0562369bba1ecc Mon Sep 17 00:00:00 2001 From: dsv Date: Sun, 26 Feb 2017 16:37:32 +0300 Subject: [PATCH 10/33] fix asm --- .travis.yml | 12 +++--- Driver.ml | 9 +++-- Expr.ml | 112 +++++++++++++++++++++++++++++++++++++++++++--------- build.sh | 4 ++ helpers.cpp | 17 +++++--- test.sh | 8 ++++ 6 files changed, 131 insertions(+), 31 deletions(-) create mode 100755 build.sh create mode 100755 test.sh diff --git a/.travis.yml b/.travis.yml index 2145599e..33dbca60 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,13 +1,15 @@ -language: c -sudo: required -script: +language: c +sudo: required +script: - bash -ex .travis-opam.sh - opam pin add GT https://github.com/Kakadu/GT.git -n -y - opam install camlp5 -y - opam install GT ocamlfind -y - eval `opam config env` - - make all - - echo done + - sudo apt-get install gcc-multilib g++-multilib -y + - g++ -lstdc++ -c -m32 helpers.cpp + - ./build.sh + - ./test.sh env: - OCAML_VERSION=4.04 os: diff --git a/Driver.ml b/Driver.ml index a6c02f51..50d8044d 100644 --- a/Driver.ml +++ b/Driver.ml @@ -23,18 +23,21 @@ let (|>) l r = Seq (l, r) read (x); read (y); z := x * y; - write (z) + write (x) *) let p = read "x" |> read "y" |> ("z" := !"x" * !"y" + const 1) |> - write !"z" + write (!"z") let _ = Printf.printf "%s\n" (show(list) (show(int)) @@ run p [10; 20]); - Printf.printf "%s\n" (show(list) (show(int)) @@ srun (comp p) [10; 20]) + Printf.printf "%s\n" (show(list) (show(int)) @@ srun (comp p) [10; 20]); + let outf = open_out "asmcode.s" in + Printf.fprintf outf "%s\n" (X86.genasm p); + close_out outf let gen n = let rec gen_read n i = diff --git a/Expr.ml b/Expr.ml index 44aa6810..178af26e 100644 --- a/Expr.ml +++ b/Expr.ml @@ -1,5 +1,6 @@ (* AST for expressions *) open GT +open Printf @type expr = | Var of string @@ -25,6 +26,7 @@ let rec eval expr st = | Mul (x, y) -> eval' x * eval' y (* State update primitive *) +(* возвращается либо текущая функция (если аргумент x = y), либо одна из предыдущих таких же (st в scope'ах). В самом конце будет функция, которая роняет программу *) let update st x v = fun y -> if y = x then v else st y (* Interpreter for statements *) @@ -55,11 +57,12 @@ type instr = | MUL type prg = instr list - + let srun prg input = let rec srun' prg ((stack, st, input, output) as conf) = match prg with | [] -> conf + (* рекурсивное выполнение стейтментов одного за другим, на вход каждой следующей "строке" идёт новая конфигурация *) | i :: prg' -> srun' prg' ( match i with @@ -67,11 +70,11 @@ let srun prg input = (z :: stack, st, input', output) | WRITE -> let z :: stack' = stack in (stack', st, input, output @ [z]) - | PUSH n -> (n :: stack, st, input, output) + | PUSH n -> (n :: stack, st, input, output) | LD x -> (st x :: stack, st, input, output) - | ST x -> let z :: stack' = stack in + | ST x -> let z :: stack' = stack in (stack', update st x z, input, output) - | _ -> let y :: x :: stack' = stack in + | _ -> let y :: x :: stack' = stack in ((match i with ADD -> (+) | _ -> ( * )) x y :: stack', st, input, @@ -104,10 +107,18 @@ let rec comp = function module X86 = struct + module StringSet = Set.Make (String) + type opnd = R of int | S of int | L of int | M of string - let regs = [|"%eax"; "%ebx"; "%ecx"; "%esi"; "%edi"|] + let regs = [|"%eax"; "%ebx"; "%ecx"; "%edx"; "%esi"; "%edi"|] let nregs = Array.length regs + let stack_slots = ref 0 + let variables = ref StringSet.empty + + let word_size = 4 + let eax = R 0 + let edx = R 3 type instr = | Add of opnd * opnd @@ -118,32 +129,97 @@ module X86 = | Call of string | Ret - let allocate = function - | [] -> R 0 - | R i :: _ when i < nregs - 1 -> R (i+1) - | S i :: _ -> S (i+1) - | _ -> S 0 + + let allocate stack = + match stack with + | [] -> R 0 + | (S n)::_ -> stack_slots := max (n+2) !stack_slots; S (n+1) + | (R n)::_ when n < nregs - 3 -> R (n+1) + | _ -> stack_slots := max 1 !stack_slots; S 0 let rec sint prg sstack = match prg with | [] -> [], [] | i :: prg' -> let (code, sstack') = - match i with - | PUSH n -> + match i with + | PUSH n -> let s = allocate sstack in [Mov (L n, s)], s :: sstack | LD x -> + variables := StringSet.add x !variables; let s = allocate sstack in [Mov (M x, s)], s :: sstack - | ST x -> + | ST x -> + variables := StringSet.add x !variables; let s :: sstack' = sstack in - [Mov (s, M x)], sstack' + [Mov (s, M x)], sstack' + | READ -> + (* вызов С++ функции для чтения из stdin *) + [Call "fnread"], [eax] + | WRITE -> + let s :: sstack' = sstack in + (* вызов С++ функции для вывода в stdout *) + [Mov (s, eax);Push eax; Call "fnwrite"; Pop eax], sstack' + | ADD -> + let x::y::sstack'= sstack in + (match x, y with + | S _, S _ -> + (*оба в стеке, достанем x и можно совершать операции, то же самое для mul*) + [Mov (x, eax); Add (eax, y)], y::sstack' + | _ -> [Add (x, y)], y::sstack') + | MUL -> + let x::y::sstack'= sstack in + (match x, y with + | S _, S _ -> + [Mov (x, eax); Mul (eax, y)], y::sstack' + | _ -> [Mul (x, y)], y::sstack') + in let (code', sstack'') = sint prg' sstack' in code @ code', sstack'' -(* - let compile stmt = - sint (comp stmt) -*) + + let printAsmCode instr = + let opnd op = + match op with + | R i -> regs.(i) + | S i -> Printf.sprintf "-%d(%%ebp)" (i * word_size) + | L i -> Printf.sprintf "$%d" i + | M x -> x + in + match instr with + | Add (x, y) -> Printf.sprintf "addl\t%s,\t%s" (opnd x) (opnd y) + | Mul (x, y) -> Printf.sprintf "imull\t%s,\t%s" (opnd x) (opnd y) + | Mov (x, y) -> Printf.sprintf "movl\t%s,\t%s" (opnd x) (opnd y) + | Push x -> Printf.sprintf "pushl\t%s" (opnd x) + | Pop x -> Printf.sprintf "popl\t%s" (opnd x) + | Call f -> Printf.sprintf "call\t%s" f + | Ret -> "ret" + + + let genasm stmt = + let allText = ref "" in + (* добавляет текст к allText *) + let append = fun newText -> allText := Printf.sprintf "%s%s" !allText newText in + + (* что-то вроде T из лиспа *) + let execM = fun _ -> () in + + let code = sint (comp stmt) [] in + append "\t.text\n\t.globl\tmain\n"; + List.iter + (fun x -> append (Printf.sprintf "\t.comm\t%s,\t%d,\t%d\n" x word_size word_size)) + (StringSet.elements !variables); + append "main:\n"; + if !stack_slots != 0 then + execM [append "\tpushl\t%ebp\n"; append "\tmovl\t%esp,\t%ebp\n";append (Printf.sprintf "\tsubl\t$%d,\t%%esp\n" (!stack_slots * word_size))]; + List.iter + (fun i -> append (Printf.sprintf "\t%s\n" (printAsmCode i))) + (fst code); + if !stack_slots != 0 then + execM [append "\tmovl\t%ebp,\t%esp\n";append "\tpopl\t%ebp\n"]; + append "\txorl\t%eax,\t%eax\n"; + append "\tret\n"; + !allText; + end diff --git a/build.sh b/build.sh new file mode 100755 index 00000000..18ff274c --- /dev/null +++ b/build.sh @@ -0,0 +1,4 @@ +g++ -lstdc++ -c -m32 helpers.cpp +make all +./Driver +g++ -lstdc++ -m32 -o compiled helpers.o asmcode.s diff --git a/helpers.cpp b/helpers.cpp index a13e84ba..c7acde9b 100644 --- a/helpers.cpp +++ b/helpers.cpp @@ -2,12 +2,19 @@ using namespace std; -extern "C" int read () { - int d = 0; - cin >> d; - return d; +/** +* Функции помощники для чтения и вывода +* Extern C нужен, иначе не будет нужных символов и код не слинкуется +*/ + +// number будет в eax +extern "C" int fnread () { + int number = 0; + cin >> number; + return number; } -extern "C" void write (int n) { +// в 32-х битном асме аргумент передаётся через eax +extern "C" void fnwrite (int n) { cout << n << endl; } diff --git a/test.sh b/test.sh new file mode 100755 index 00000000..6ad6a8e1 --- /dev/null +++ b/test.sh @@ -0,0 +1,8 @@ +SHOULD_BE=201 +OUTPUT=`echo "20 10" | ./compiled` +if [[ $OUTPUT = $SHOULD_BE ]]; + then + exit 0; + else + echo "wrong value $OUTPUT should be $SHOULD_BE"; exit 1; +fi From 208c0669c502334b7fa9255e841234423fbf9792 Mon Sep 17 00:00:00 2001 From: dsv Date: Sun, 26 Feb 2017 16:40:21 +0300 Subject: [PATCH 11/33] Test now output OK in case of OK, not only code 0 --- Expr.ml | 18 +++++++++--------- test.sh | 1 + 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/Expr.ml b/Expr.ml index 178af26e..ac151532 100644 --- a/Expr.ml +++ b/Expr.ml @@ -113,10 +113,10 @@ module X86 = let regs = [|"%eax"; "%ebx"; "%ecx"; "%edx"; "%esi"; "%edi"|] let nregs = Array.length regs - let stack_slots = ref 0 + let stackSlots = ref 0 let variables = ref StringSet.empty - let word_size = 4 + let wordSize = 4 let eax = R 0 let edx = R 3 @@ -133,9 +133,9 @@ module X86 = let allocate stack = match stack with | [] -> R 0 - | (S n)::_ -> stack_slots := max (n+2) !stack_slots; S (n+1) + | (S n)::_ -> stackSlots := max (n+2) !stackSlots; S (n+1) | (R n)::_ when n < nregs - 3 -> R (n+1) - | _ -> stack_slots := max 1 !stack_slots; S 0 + | _ -> stackSlots := max 1 !stackSlots; S 0 let rec sint prg sstack = match prg with @@ -183,7 +183,7 @@ module X86 = let opnd op = match op with | R i -> regs.(i) - | S i -> Printf.sprintf "-%d(%%ebp)" (i * word_size) + | S i -> Printf.sprintf "-%d(%%ebp)" (i * wordSize) | L i -> Printf.sprintf "$%d" i | M x -> x in @@ -208,15 +208,15 @@ module X86 = let code = sint (comp stmt) [] in append "\t.text\n\t.globl\tmain\n"; List.iter - (fun x -> append (Printf.sprintf "\t.comm\t%s,\t%d,\t%d\n" x word_size word_size)) + (fun x -> append (Printf.sprintf "\t.comm\t%s,\t%d,\t%d\n" x wordSize wordSize)) (StringSet.elements !variables); append "main:\n"; - if !stack_slots != 0 then - execM [append "\tpushl\t%ebp\n"; append "\tmovl\t%esp,\t%ebp\n";append (Printf.sprintf "\tsubl\t$%d,\t%%esp\n" (!stack_slots * word_size))]; + if !stackSlots != 0 then + execM [append "\tpushl\t%ebp\n"; append "\tmovl\t%esp,\t%ebp\n";append (Printf.sprintf "\tsubl\t$%d,\t%%esp\n" (!stackSlots * wordSize))]; List.iter (fun i -> append (Printf.sprintf "\t%s\n" (printAsmCode i))) (fst code); - if !stack_slots != 0 then + if !stackSlots != 0 then execM [append "\tmovl\t%ebp,\t%esp\n";append "\tpopl\t%ebp\n"]; append "\txorl\t%eax,\t%eax\n"; append "\tret\n"; diff --git a/test.sh b/test.sh index 6ad6a8e1..52205d84 100755 --- a/test.sh +++ b/test.sh @@ -2,6 +2,7 @@ SHOULD_BE=201 OUTPUT=`echo "20 10" | ./compiled` if [[ $OUTPUT = $SHOULD_BE ]]; then + echo "OK"; exit 0; else echo "wrong value $OUTPUT should be $SHOULD_BE"; exit 1; From 0ebf988006b27f451a32b9ef20f38a7a73eee41b Mon Sep 17 00:00:00 2001 From: dsv Date: Sun, 26 Feb 2017 16:52:36 +0300 Subject: [PATCH 12/33] better comments --- Driver.ml | 2 +- Expr.ml | 30 ++++++++++++++++-------------- 2 files changed, 17 insertions(+), 15 deletions(-) diff --git a/Driver.ml b/Driver.ml index 50d8044d..ad935da8 100644 --- a/Driver.ml +++ b/Driver.ml @@ -36,7 +36,7 @@ let _ = Printf.printf "%s\n" (show(list) (show(int)) @@ run p [10; 20]); Printf.printf "%s\n" (show(list) (show(int)) @@ srun (comp p) [10; 20]); let outf = open_out "asmcode.s" in - Printf.fprintf outf "%s\n" (X86.genasm p); + Printf.fprintf outf "%s\n" (X86.toAsm p); close_out outf let gen n = diff --git a/Expr.ml b/Expr.ml index ac151532..db78813c 100644 --- a/Expr.ml +++ b/Expr.ml @@ -113,7 +113,7 @@ module X86 = let regs = [|"%eax"; "%ebx"; "%ecx"; "%edx"; "%esi"; "%edi"|] let nregs = Array.length regs - let stackSlots = ref 0 + let stackAddDep = ref 0 let variables = ref StringSet.empty let wordSize = 4 @@ -133,9 +133,10 @@ module X86 = let allocate stack = match stack with | [] -> R 0 - | (S n)::_ -> stackSlots := max (n+2) !stackSlots; S (n+1) + | (S n)::_ -> stackAddDep := max (n+2) !stackAddDep; S (n+1) + (* используем регистры общего назначения [ax-dx] *) | (R n)::_ when n < nregs - 3 -> R (n+1) - | _ -> stackSlots := max 1 !stackSlots; S 0 + | _ -> stackAddDep := max 1 !stackAddDep; S 0 let rec sint prg sstack = match prg with @@ -160,6 +161,7 @@ module X86 = | WRITE -> let s :: sstack' = sstack in (* вызов С++ функции для вывода в stdout *) + (* запишем из S в AX, т.к. нужно передать как параметр в fnwrite *) [Mov (s, eax);Push eax; Call "fnwrite"; Pop eax], sstack' | ADD -> let x::y::sstack'= sstack in @@ -180,7 +182,7 @@ module X86 = code @ code', sstack'' let printAsmCode instr = - let opnd op = + let opStr op = match op with | R i -> regs.(i) | S i -> Printf.sprintf "-%d(%%ebp)" (i * wordSize) @@ -188,16 +190,16 @@ module X86 = | M x -> x in match instr with - | Add (x, y) -> Printf.sprintf "addl\t%s,\t%s" (opnd x) (opnd y) - | Mul (x, y) -> Printf.sprintf "imull\t%s,\t%s" (opnd x) (opnd y) - | Mov (x, y) -> Printf.sprintf "movl\t%s,\t%s" (opnd x) (opnd y) - | Push x -> Printf.sprintf "pushl\t%s" (opnd x) - | Pop x -> Printf.sprintf "popl\t%s" (opnd x) + | Add (x, y) -> Printf.sprintf "addl\t%s,\t%s" (opStr x) (opStr y) + | Mul (x, y) -> Printf.sprintf "imull\t%s,\t%s" (opStr x) (opStr y) + | Mov (x, y) -> Printf.sprintf "movl\t%s,\t%s" (opStr x) (opStr y) + | Push x -> Printf.sprintf "pushl\t%s" (opStr x) + | Pop x -> Printf.sprintf "popl\t%s" (opStr x) | Call f -> Printf.sprintf "call\t%s" f | Ret -> "ret" - let genasm stmt = + let toAsm prog = let allText = ref "" in (* добавляет текст к allText *) let append = fun newText -> allText := Printf.sprintf "%s%s" !allText newText in @@ -205,18 +207,18 @@ module X86 = (* что-то вроде T из лиспа *) let execM = fun _ -> () in - let code = sint (comp stmt) [] in + let code = sint (comp prog) [] in append "\t.text\n\t.globl\tmain\n"; List.iter (fun x -> append (Printf.sprintf "\t.comm\t%s,\t%d,\t%d\n" x wordSize wordSize)) (StringSet.elements !variables); append "main:\n"; - if !stackSlots != 0 then - execM [append "\tpushl\t%ebp\n"; append "\tmovl\t%esp,\t%ebp\n";append (Printf.sprintf "\tsubl\t$%d,\t%%esp\n" (!stackSlots * wordSize))]; + if !stackAddDep != 0 then + execM [append "\tpushl\t%ebp\n"; append "\tmovl\t%esp,\t%ebp\n";append (Printf.sprintf "\tsubl\t$%d,\t%%esp\n" (!stackAddDep * wordSize))]; List.iter (fun i -> append (Printf.sprintf "\t%s\n" (printAsmCode i))) (fst code); - if !stackSlots != 0 then + if !stackAddDep != 0 then execM [append "\tmovl\t%ebp,\t%esp\n";append "\tpopl\t%ebp\n"]; append "\txorl\t%eax,\t%eax\n"; append "\tret\n"; From 843bcd3d9cc4d6ad24024bdb20620b6c9c837f47 Mon Sep 17 00:00:00 2001 From: dsv Date: Sun, 26 Feb 2017 16:57:55 +0300 Subject: [PATCH 13/33] fin --- build.sh | 5 +++++ test.sh | 3 +++ 2 files changed, 8 insertions(+) diff --git a/build.sh b/build.sh index 18ff274c..1311dacb 100755 --- a/build.sh +++ b/build.sh @@ -1,4 +1,9 @@ +# собираем с помощью g++ с флагом -m32 +# (т.к. в 64-битном асме более сложный ABI convention для передачи параметров) g++ -lstdc++ -c -m32 helpers.cpp make all +# запуск Driver'a выведет результат интерпретации программы (и компиляции в stack machine) +# а так же скомпилирует программу для ассемблера и запишет в asmcode.s ./Driver +# скомпилируем asmcode.s слинковав с функциями для ввода/вывода g++ -lstdc++ -m32 -o compiled helpers.o asmcode.s diff --git a/test.sh b/test.sh index 52205d84..fd8ac55a 100755 --- a/test.sh +++ b/test.sh @@ -1,3 +1,6 @@ +# простой тест, те же значения что и в Driver.ml +# данные передаются в программу с помощью echo и пайпы +# то же самое что запустить и ввести два числа через энтер SHOULD_BE=201 OUTPUT=`echo "20 10" | ./compiled` if [[ $OUTPUT = $SHOULD_BE ]]; From a20ee5867551e20d15418cb1de9fe52a6ab0401f Mon Sep 17 00:00:00 2001 From: Semyon Danilov Date: Tue, 28 Feb 2017 23:28:27 +0300 Subject: [PATCH 14/33] Update .travis.yml --- .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 33dbca60..1ac71290 100644 --- a/.travis.yml +++ b/.travis.yml @@ -9,6 +9,7 @@ script: - sudo apt-get install gcc-multilib g++-multilib -y - g++ -lstdc++ -c -m32 helpers.cpp - ./build.sh + - cat -n asmcode.s - ./test.sh env: - OCAML_VERSION=4.04 From 8d06995d02150aac2b0b0d13b1a67700fff283aa Mon Sep 17 00:00:00 2001 From: dsv Date: Wed, 15 Mar 2017 16:08:49 +0300 Subject: [PATCH 15/33] remove redundant code --- Expr.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Expr.ml b/Expr.ml index db78813c..7ddd7f07 100644 --- a/Expr.ml +++ b/Expr.ml @@ -162,7 +162,7 @@ module X86 = let s :: sstack' = sstack in (* вызов С++ функции для вывода в stdout *) (* запишем из S в AX, т.к. нужно передать как параметр в fnwrite *) - [Mov (s, eax);Push eax; Call "fnwrite"; Pop eax], sstack' + [Push eax; Call "fnwrite"; Pop eax], sstack' | ADD -> let x::y::sstack'= sstack in (match x, y with From 96a80ce3db8cc269712e4df3044e54ca3524685a Mon Sep 17 00:00:00 2001 From: dsv Date: Tue, 21 Mar 2017 22:42:39 +0300 Subject: [PATCH 16/33] new proj paths --- DanilovSemyon/.travis-opam.sh | 37 ++++++ DanilovSemyon/Driver.ml | 58 +++++++++ DanilovSemyon/Expr.ml | 227 ++++++++++++++++++++++++++++++++++ DanilovSemyon/Makefile | 11 ++ DanilovSemyon/build.sh | 9 ++ DanilovSemyon/build64.sh | 9 ++ DanilovSemyon/helpers.cpp | 20 +++ DanilovSemyon/test.sh | 12 ++ 8 files changed, 383 insertions(+) create mode 100644 DanilovSemyon/.travis-opam.sh create mode 100644 DanilovSemyon/Driver.ml create mode 100644 DanilovSemyon/Expr.ml create mode 100644 DanilovSemyon/Makefile create mode 100755 DanilovSemyon/build.sh create mode 100755 DanilovSemyon/build64.sh create mode 100644 DanilovSemyon/helpers.cpp create mode 100755 DanilovSemyon/test.sh diff --git a/DanilovSemyon/.travis-opam.sh b/DanilovSemyon/.travis-opam.sh new file mode 100644 index 00000000..c4399c7d --- /dev/null +++ b/DanilovSemyon/.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/DanilovSemyon/Driver.ml b/DanilovSemyon/Driver.ml new file mode 100644 index 00000000..ad935da8 --- /dev/null +++ b/DanilovSemyon/Driver.ml @@ -0,0 +1,58 @@ +open Expr +open GT + +(* EDSL = Embedded Domain-Specific Language + Встроенный предметно-ориентированный язык + Deep Embedding +*) + +let inc x = x+1 + +let ( ! ) x = Var x +let const n = Const n +let ( + ) x y = Add (x, y) +let ( * ) x y = Mul (x, y) + +let read x = Read x +let write e = Write e +let (:=) x e = Assign (x, e) +let skip = Skip +let (|>) l r = Seq (l, r) + +(* + read (x); + read (y); + z := x * y; + write (x) +*) + +let p = + read "x" |> + read "y" |> + ("z" := !"x" * !"y" + const 1) |> + write (!"z") + +let _ = + Printf.printf "%s\n" (show(list) (show(int)) @@ run p [10; 20]); + Printf.printf "%s\n" (show(list) (show(int)) @@ srun (comp p) [10; 20]); + let outf = open_out "asmcode.s" in + Printf.fprintf outf "%s\n" (X86.toAsm p); + close_out outf + +let gen n = + let rec gen_read n i = + if i > n + then skip + else read (Printf.sprintf "x%d" i) |> gen_read n (inc i) + in + let rec gensum n i = + if i > n + then Const 0 + else !(Printf.sprintf "x%d" i) + gensum n (inc i) + in + gen_read n 0 |> + write @@ gensum n 0 + +(*let _ = + Printf.printf "%s" (show(stmt) @@ gen 300) +*) diff --git a/DanilovSemyon/Expr.ml b/DanilovSemyon/Expr.ml new file mode 100644 index 00000000..7ddd7f07 --- /dev/null +++ b/DanilovSemyon/Expr.ml @@ -0,0 +1,227 @@ +(* AST for expressions *) +open GT +open Printf + +@type expr = +| Var of string +| Const of int +| Add of expr * expr +| Mul of expr * expr with show + +(* AST statements/commands *) +@type stmt = +| Skip +| Assign of string * expr +| Read of string +| Write of expr +| Seq of stmt * stmt with show + +(* Interpreter for expressions *) +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 + +(* State update primitive *) +(* возвращается либо текущая функция (если аргумент x = y), либо одна из предыдущих таких же (st в scope'ах). В самом конце будет функция, которая роняет программу *) +let update st x v = fun y -> if y = x then v else st y + +(* Interpreter for statements *) +let run stmt input = + let rec run' stmt ((st, input, output) as conf) = + match stmt with + | Skip -> conf + | Assign (x, e) -> (update st x (eval e st), input, output) + | Read x -> + let z :: input' = input in + (update st x z, input', output) + | Write e -> (st, input, output @ [eval e st]) + | Seq (s1, s2) -> run' s1 conf |> run' s2 + in + let (_, _, output) = + run' stmt ((fun _ -> failwith "undefined variable"), input, []) + in + output + +(* Stack Machine *) +type instr = +| READ +| WRITE +| PUSH of int +| LD of string +| ST of string +| ADD +| MUL + +type prg = instr list + +let srun prg input = + let rec srun' prg ((stack, st, input, output) as conf) = + match prg with + | [] -> conf + (* рекурсивное выполнение стейтментов одного за другим, на вход каждой следующей "строке" идёт новая конфигурация *) + | i :: prg' -> + srun' prg' ( + match i with + | READ -> let z :: input' = input in + (z :: stack, st, input', output) + | WRITE -> let z :: stack' = stack in + (stack', st, input, output @ [z]) + | PUSH n -> (n :: stack, st, input, output) + | 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 + ) + ) + in + let (_, _, _, output) = + srun' prg ([], + (fun _ -> failwith "undefined variable"), + input, + [] + ) + in + output + +let rec comp_expr = function +| Var x -> [LD x] +| Const n -> [PUSH n] +| Add (x, y) -> (comp_expr x) @ (comp_expr y) @ [ADD] +| Mul (x, y) -> (comp_expr x) @ (comp_expr y) @ [MUL] + +let rec comp = function +| Skip -> [] +| Assign (x, e) -> comp_expr e @ [ST x] +| Read x -> [READ; ST x] +| Write e -> comp_expr e @ [WRITE] +| Seq (l, r) -> comp l @ comp r + +module X86 = + struct + + module StringSet = Set.Make (String) + + type opnd = R of int | S of int | L of int | M of string + + let regs = [|"%eax"; "%ebx"; "%ecx"; "%edx"; "%esi"; "%edi"|] + let nregs = Array.length regs + let stackAddDep = ref 0 + let variables = ref StringSet.empty + + let wordSize = 4 + let eax = R 0 + let edx = R 3 + + type instr = + | Add of opnd * opnd + | Mul of opnd * opnd + | Mov of opnd * opnd + | Push of opnd + | Pop of opnd + | Call of string + | Ret + + + let allocate stack = + match stack with + | [] -> R 0 + | (S n)::_ -> stackAddDep := max (n+2) !stackAddDep; S (n+1) + (* используем регистры общего назначения [ax-dx] *) + | (R n)::_ when n < nregs - 3 -> R (n+1) + | _ -> stackAddDep := max 1 !stackAddDep; S 0 + + let rec sint prg sstack = + match prg with + | [] -> [], [] + | i :: prg' -> + let (code, sstack') = + match i with + | PUSH n -> + let s = allocate sstack in + [Mov (L n, s)], s :: sstack + | LD x -> + variables := StringSet.add x !variables; + let s = allocate sstack in + [Mov (M x, s)], s :: sstack + | ST x -> + variables := StringSet.add x !variables; + let s :: sstack' = sstack in + [Mov (s, M x)], sstack' + | READ -> + (* вызов С++ функции для чтения из stdin *) + [Call "fnread"], [eax] + | WRITE -> + let s :: sstack' = sstack in + (* вызов С++ функции для вывода в stdout *) + (* запишем из S в AX, т.к. нужно передать как параметр в fnwrite *) + [Push eax; Call "fnwrite"; Pop eax], sstack' + | ADD -> + let x::y::sstack'= sstack in + (match x, y with + | S _, S _ -> + (*оба в стеке, достанем x и можно совершать операции, то же самое для mul*) + [Mov (x, eax); Add (eax, y)], y::sstack' + | _ -> [Add (x, y)], y::sstack') + | MUL -> + let x::y::sstack'= sstack in + (match x, y with + | S _, S _ -> + [Mov (x, eax); Mul (eax, y)], y::sstack' + | _ -> [Mul (x, y)], y::sstack') + + in + let (code', sstack'') = sint prg' sstack' in + code @ code', sstack'' + + let printAsmCode instr = + let opStr op = + match op with + | R i -> regs.(i) + | S i -> Printf.sprintf "-%d(%%ebp)" (i * wordSize) + | L i -> Printf.sprintf "$%d" i + | M x -> x + in + match instr with + | Add (x, y) -> Printf.sprintf "addl\t%s,\t%s" (opStr x) (opStr y) + | Mul (x, y) -> Printf.sprintf "imull\t%s,\t%s" (opStr x) (opStr y) + | Mov (x, y) -> Printf.sprintf "movl\t%s,\t%s" (opStr x) (opStr y) + | Push x -> Printf.sprintf "pushl\t%s" (opStr x) + | Pop x -> Printf.sprintf "popl\t%s" (opStr x) + | Call f -> Printf.sprintf "call\t%s" f + | Ret -> "ret" + + + let toAsm prog = + let allText = ref "" in + (* добавляет текст к allText *) + let append = fun newText -> allText := Printf.sprintf "%s%s" !allText newText in + + (* что-то вроде T из лиспа *) + let execM = fun _ -> () in + + let code = sint (comp prog) [] in + append "\t.text\n\t.globl\tmain\n"; + List.iter + (fun x -> append (Printf.sprintf "\t.comm\t%s,\t%d,\t%d\n" x wordSize wordSize)) + (StringSet.elements !variables); + append "main:\n"; + if !stackAddDep != 0 then + execM [append "\tpushl\t%ebp\n"; append "\tmovl\t%esp,\t%ebp\n";append (Printf.sprintf "\tsubl\t$%d,\t%%esp\n" (!stackAddDep * wordSize))]; + List.iter + (fun i -> append (Printf.sprintf "\t%s\n" (printAsmCode i))) + (fst code); + if !stackAddDep != 0 then + execM [append "\tmovl\t%ebp,\t%esp\n";append "\tpopl\t%ebp\n"]; + append "\txorl\t%eax,\t%eax\n"; + append "\tret\n"; + !allText; + + end diff --git a/DanilovSemyon/Makefile b/DanilovSemyon/Makefile new file mode 100644 index 00000000..d509e12e --- /dev/null +++ b/DanilovSemyon/Makefile @@ -0,0 +1,11 @@ +all: Driver.cmo + ocamlc -rectypes -o Driver -I `ocamlfind -query GT` GT.cma Expr.cmo Driver.cmo + +Expr.cmo: Expr.ml + ocamlc -rectypes -c -pp "camlp5o -I `ocamlfind -query GT.syntax.all` pa_gt.cmo -L `ocamlfind -query GT.syntax.all`" -I `ocamlfind -query GT` GT.cma $< + +Driver.cmo: Expr.cmo Driver.ml + ocamlc -rectypes -c -pp "camlp5o -I `ocamlfind -query GT.syntax.all` pa_gt.cmo -L `ocamlfind -query GT.syntax.all`" -I `ocamlfind -query GT` GT.cma Driver.ml + +clean: + rm -Rf *~ *.cmo Driver diff --git a/DanilovSemyon/build.sh b/DanilovSemyon/build.sh new file mode 100755 index 00000000..1311dacb --- /dev/null +++ b/DanilovSemyon/build.sh @@ -0,0 +1,9 @@ +# собираем с помощью g++ с флагом -m32 +# (т.к. в 64-битном асме более сложный ABI convention для передачи параметров) +g++ -lstdc++ -c -m32 helpers.cpp +make all +# запуск Driver'a выведет результат интерпретации программы (и компиляции в stack machine) +# а так же скомпилирует программу для ассемблера и запишет в asmcode.s +./Driver +# скомпилируем asmcode.s слинковав с функциями для ввода/вывода +g++ -lstdc++ -m32 -o compiled helpers.o asmcode.s diff --git a/DanilovSemyon/build64.sh b/DanilovSemyon/build64.sh new file mode 100755 index 00000000..98d1eed2 --- /dev/null +++ b/DanilovSemyon/build64.sh @@ -0,0 +1,9 @@ +SHOULD_BE=2010 +OUTPUT=`echo "20 10" | ./sample` +if [[ $OUTPUT = $SHOULD_BE ]] +then + exit 0; +else + echo "wrong value $OUTPUT should be $SHOULD_BE"; exit 1 +fi + diff --git a/DanilovSemyon/helpers.cpp b/DanilovSemyon/helpers.cpp new file mode 100644 index 00000000..c7acde9b --- /dev/null +++ b/DanilovSemyon/helpers.cpp @@ -0,0 +1,20 @@ +# include + +using namespace std; + +/** +* Функции помощники для чтения и вывода +* Extern C нужен, иначе не будет нужных символов и код не слинкуется +*/ + +// number будет в eax +extern "C" int fnread () { + int number = 0; + cin >> number; + return number; +} + +// в 32-х битном асме аргумент передаётся через eax +extern "C" void fnwrite (int n) { + cout << n << endl; +} diff --git a/DanilovSemyon/test.sh b/DanilovSemyon/test.sh new file mode 100755 index 00000000..fd8ac55a --- /dev/null +++ b/DanilovSemyon/test.sh @@ -0,0 +1,12 @@ +# простой тест, те же значения что и в Driver.ml +# данные передаются в программу с помощью echo и пайпы +# то же самое что запустить и ввести два числа через энтер +SHOULD_BE=201 +OUTPUT=`echo "20 10" | ./compiled` +if [[ $OUTPUT = $SHOULD_BE ]]; + then + echo "OK"; + exit 0; + else + echo "wrong value $OUTPUT should be $SHOULD_BE"; exit 1; +fi From a910582b4603f8dbc53dbaf755741c0788d32126 Mon Sep 17 00:00:00 2001 From: dsv Date: Tue, 21 Mar 2017 22:43:26 +0300 Subject: [PATCH 17/33] Fix travis build --- .travis.yml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index 33dbca60..6bc9e622 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,13 +1,14 @@ language: c sudo: required script: - - bash -ex .travis-opam.sh + - bash -ex DanilovSemyon/.travis-opam.sh - opam pin add GT https://github.com/Kakadu/GT.git -n -y - opam install camlp5 -y - opam install GT ocamlfind -y - eval `opam config env` - sudo apt-get install gcc-multilib g++-multilib -y - - g++ -lstdc++ -c -m32 helpers.cpp + - cd DanilovSemyon + - g++ -lstdc++ -c -m32 DanilovSemyon/helpers.cpp - ./build.sh - ./test.sh env: From ed35700d0d0627ef2e3b4ace2725b42ce528e892 Mon Sep 17 00:00:00 2001 From: Semyon Danilov Date: Wed, 22 Mar 2017 02:59:18 +0300 Subject: [PATCH 18/33] Update .travis.yml --- .travis.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index ffd28b38..813a8d6c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -8,7 +8,6 @@ script: - eval `opam config env` - sudo apt-get install gcc-multilib g++-multilib -y - cd DanilovSemyon - - g++ -lstdc++ -c -m32 DanilovSemyon/helpers.cpp - ./build.sh - cat -n asmcode.s - ./test.sh From f226c2c3a599000aba3e7adb6471be9b30431396 Mon Sep 17 00:00:00 2001 From: dsv Date: Mon, 24 Apr 2017 23:59:50 +0300 Subject: [PATCH 19/33] fix language and interpreter --- regression/Makefile | 5 +--- src/Interpret.ml | 4 +-- src/Language.ml | 72 +++++++++++++++++++++++++++++++++++++++------ src/StackMachine.ml | 18 +++++------- 4 files changed, 73 insertions(+), 26 deletions(-) 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/Interpret.ml b/src/Interpret.ml index 12c5dddb..c467a9bd 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 diff --git a/src/Language.ml b/src/Language.ml index 96ac3e01..3e9aed86 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 @@ -43,6 +75,28 @@ module Stmt = 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..e3eb54c9 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 + (state, (apply op x y)::stack', 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 From e91a8f0df3cb137a6f98eb788c1de9c4cf6777f8 Mon Sep 17 00:00:00 2001 From: dsv Date: Tue, 25 Apr 2017 00:04:02 +0300 Subject: [PATCH 20/33] fix stackmachine --- src/StackMachine.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/StackMachine.ml b/src/StackMachine.ml index e3eb54c9..d004853e 100644 --- a/src/StackMachine.ml +++ b/src/StackMachine.ml @@ -43,7 +43,7 @@ module Interpret = (stack', update st x z, input, output) | BINOP op -> let y::x::stack' = stack in - (state, (apply op x y)::stack', input, output) + ((apply op x y)::stack', st, input, output) ) in let (_, _, _, output) = From 99975aa6aeba86c3f24adeeafd5e680d148c517e Mon Sep 17 00:00:00 2001 From: dsv Date: Tue, 25 Apr 2017 01:33:57 +0300 Subject: [PATCH 21/33] semi-working X86 compiler --- src/X86.ml | 133 +++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 109 insertions(+), 24 deletions(-) diff --git a/src/X86.ml b/src/X86.ml index 9f0544af..611a02a5 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -3,19 +3,34 @@ open Instr type opnd = R of int | S of int | L of int | M of string -let regs = [|"%eax"; "%ebx"; "%ecx"; "%esi"; "%edi"; "%edx"; "%esp"; "%ebp"|] +let regs = [|"%eax"; "%ebx"; "%ecx"; "%edx"; "%esi"; "%edi"; "%esp"; "%ebp"|] let nregs = Array.length regs - 3 -let [|eax; ebx; ecx; esi; edi; edx; esp; ebp|] = Array.mapi (fun i _ -> R i) regs +let [|eax; ebx; ecx; edx; esi; edi; 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 +41,32 @@ 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" + + + | Movzbl -> "\tmovzbl\t%al,\t%eax" + | Cdq -> "\tcdq" + | Ret -> "\tret" + | Call p -> Printf.sprintf "\tcall\t%s" p in let out s = Buffer.add_string buf "\t"; @@ -42,14 +76,24 @@ let to_string buf code = List.iter (fun i -> out @@ instr i) code module S = Set.Make (String) - + +let save_regs f = + [Push eax; Push ebx] @ f @ [Pop ebx; Pop eax] + +let to_eax_ebx x y f = + save_regs @@ [Mov (x, eax); Mov (y, ebx)] @ (f eax ebx) @ [Mov (ebx, 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 2 | 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 @@ -72,25 +116,66 @@ let rec sint env prg sstack = let env' = env#local x in let env'', s = env'#allocate sstack in env'', [Mov (M x, s)], s :: sstack - | ST x -> + | 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 2); Call "lwrite"; Pop (R 2)], [] + | 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 + | "+" -> + to_eax_ebx x y @@ fun x y -> [Add (x, y); Mov (y, eax)] + | "-" -> + to_eax_ebx x y @@ fun x y -> [Sub (x, y); Mov (y, eax)] + | "*" -> + save_regs [Mov (y, eax); Mul (x, eax); Mov (eax, y)] + | "/" -> + save_regs [Mov (y, eax); Cdq; Div (x, y); Mov (eax, y)] + | "%" -> + save_regs [Mov (y, eax); Cdq; Div (x, y); Mov (ebx, y)] + | "<" -> + to_eax_ebx x y @@ fun x y -> compare x y Setl + | "<=" -> + to_eax_ebx x y @@ fun x y -> compare x y Setle + | ">" -> + to_eax_ebx x y @@ fun x y -> compare x y Setg + | ">=" -> + to_eax_ebx x y @@ fun x y -> compare x y Setge + | "==" -> + to_eax_ebx x y @@ fun x y -> compare x y Sete + | "!=" -> + to_eax_ebx x y @@ fun x y -> compare x y Setne + | "&&" -> + save_regs [ + (* 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, ebx); + Cmp (ebx, eax); + Setne; + (* Mov y to edx and mul eax and edx (result in edx) + result of && is not null only if eax not null (x != 0) and edx not null (y != 0) *) + Mov (y, ebx); + Mul (eax, ebx); + Xor (eax, eax); + Cmp (ebx, eax); + Setne; + Mov (eax, y)] + | "!!" -> + save_regs [ + (* Set eax value to null, mov x to edx, check that or y, edx not null*) + Xor (eax, eax); + Mov (x, ebx); + Or (y, ebx); + Cmp (ebx, eax); + Setne; + Mov (eax, y)] + ), sstack' in let env, code', sstack'' = sint env prg' sstack' in env, code @ code', sstack'' From 694ed405332d6e63527d696d509999ec69a3c0ef Mon Sep 17 00:00:00 2001 From: dsv Date: Tue, 25 Apr 2017 01:48:43 +0300 Subject: [PATCH 22/33] fix registers variable names --- src/X86.ml | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/X86.ml b/src/X86.ml index 611a02a5..758b4e08 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -3,11 +3,16 @@ open Instr type opnd = R of int | S of int | L of int | M of string -let regs = [|"%eax"; "%ebx"; "%ecx"; "%edx"; "%esi"; "%edi"; "%esp"; "%ebp"|] +let regs = [|"%eax"; "%ebx"; "%ecx"; "%edi"; "%esi"; "%edx"; "%esp"; "%ebp"|] let nregs = Array.length regs - 3 let [|eax; ebx; ecx; edx; esi; edi; esp; ebp|] = Array.mapi (fun i _ -> R i) regs +(*иначе edx будет edi*) +let tmp = edi +let edi = edx +let edx = tmp + type instr = | Add of opnd * opnd | Mul of opnd * opnd @@ -136,7 +141,7 @@ let rec sint env prg sstack = | "/" -> save_regs [Mov (y, eax); Cdq; Div (x, y); Mov (eax, y)] | "%" -> - save_regs [Mov (y, eax); Cdq; Div (x, y); Mov (ebx, y)] + save_regs [Mov (y, eax); Cdq; Div (x, y); Mov (edx, y)] | "<" -> to_eax_ebx x y @@ fun x y -> compare x y Setl | "<=" -> From ee55a18a17d9e1b1df2f95e4d54140de5a2bb147 Mon Sep 17 00:00:00 2001 From: dsv Date: Tue, 25 Apr 2017 01:58:23 +0300 Subject: [PATCH 23/33] x86 fix load op --- src/X86.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/X86.ml b/src/X86.ml index 758b4e08..436a5794 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -120,7 +120,7 @@ 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 + env'', (to_eax_ebx (M x) s @@ fun x y -> [Mov (x, y)]), s :: sstack | ST x -> let env' = env#local x in let s :: sstack' = sstack in From 3294ad563af049e888f4b6ff950e2490a7c67491 Mon Sep 17 00:00:00 2001 From: dsv Date: Tue, 25 Apr 2017 02:42:35 +0300 Subject: [PATCH 24/33] 008 works --- src/X86.ml | 45 +++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/src/X86.ml b/src/X86.ml index 436a5794..842d6274 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -67,8 +67,9 @@ let to_string buf code = | Sete -> "\tsete\t%al" | Setne -> "\tsetne\t%al" - - | Movzbl -> "\tmovzbl\t%al,\t%eax" + + (*в to_eax_edx мы в y кладём edx, соотв. здесь al кладём в edx*) + | Movzbl -> "\tmovzbl\t%al,\t%edx" | Cdq -> "\tcdq" | Ret -> "\tret" | Call p -> Printf.sprintf "\tcall\t%s" p @@ -83,10 +84,10 @@ let to_string buf code = module S = Set.Make (String) let save_regs f = - [Push eax; Push ebx] @ f @ [Pop ebx; Pop eax] + [Push eax; Push edx] @ f @ [Pop edx; Pop eax] -let to_eax_ebx x y f = - save_regs @@ [Mov (x, eax); Mov (y, ebx)] @ (f eax ebx) @ [Mov (ebx, y)] +let to_eax_edx x y f = + save_regs @@ [Mov (x, eax); Mov (y, edx)] @ (f eax edx) @ [Mov (edx, y)] let compare x y cmp = @@ -120,7 +121,7 @@ let rec sint env prg sstack = | LD x -> let env' = env#local x in let env'', s = env'#allocate sstack in - env'', (to_eax_ebx (M x) s @@ fun x y -> [Mov (x, y)]), s :: sstack + env'', (to_eax_edx (M x) s @@ fun x y -> [Mov (x, y)]), s :: sstack | ST x -> let env' = env#local x in let s :: sstack' = sstack in @@ -133,9 +134,9 @@ let rec sint env prg sstack = let x::(y::_ as sstack') = sstack in env, (match op with | "+" -> - to_eax_ebx x y @@ fun x y -> [Add (x, y); Mov (y, eax)] + to_eax_edx x y @@ fun x y -> [Add (x, y); Mov (y, eax)] | "-" -> - to_eax_ebx x y @@ fun x y -> [Sub (x, y); Mov (y, eax)] + to_eax_edx x y @@ fun x y -> [Sub (x, y); Mov (y, eax)] | "*" -> save_regs [Mov (y, eax); Mul (x, eax); Mov (eax, y)] | "/" -> @@ -143,41 +144,41 @@ let rec sint env prg sstack = | "%" -> save_regs [Mov (y, eax); Cdq; Div (x, y); Mov (edx, y)] | "<" -> - to_eax_ebx x y @@ fun x y -> compare x y Setl + to_eax_edx x y @@ fun x y -> compare x y Setl | "<=" -> - to_eax_ebx x y @@ fun x y -> compare x y Setle + to_eax_edx x y @@ fun x y -> compare x y Setle | ">" -> - to_eax_ebx x y @@ fun x y -> compare x y Setg + to_eax_edx x y @@ fun x y -> compare x y Setg | ">=" -> - to_eax_ebx x y @@ fun x y -> compare x y Setge + to_eax_edx x y @@ fun x y -> compare x y Setge | "==" -> - to_eax_ebx x y @@ fun x y -> compare x y Sete + to_eax_edx x y @@ fun x y -> compare x y Sete | "!=" -> - to_eax_ebx x y @@ fun x y -> compare x y Setne + to_eax_edx x y @@ fun x y -> compare x y Setne | "&&" -> save_regs [ (* 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, ebx); - Cmp (ebx, eax); + Mov (x, edx); + Cmp (edx, eax); Setne; (* Mov y to edx and mul eax and edx (result in edx) result of && is not null only if eax not null (x != 0) and edx not null (y != 0) *) - Mov (y, ebx); - Mul (eax, ebx); + Mov (y, edx); + Mul (eax, edx); Xor (eax, eax); - Cmp (ebx, eax); + Cmp (edx, eax); Setne; Mov (eax, y)] | "!!" -> save_regs [ (* Set eax value to null, mov x to edx, check that or y, edx not null*) Xor (eax, eax); - Mov (x, ebx); - Or (y, ebx); - Cmp (ebx, eax); + Mov (x, edx); + Or (y, edx); + Cmp (edx, eax); Setne; Mov (eax, y)] ), sstack' From 94abe92609640bb3456381a50fe383cc96edafc6 Mon Sep 17 00:00:00 2001 From: dsv Date: Tue, 25 Apr 2017 03:04:07 +0300 Subject: [PATCH 25/33] deep and simple test pass --- src/X86.ml | 43 +++++++++++++++++++++---------------------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/src/X86.ml b/src/X86.ml index 842d6274..b9fe8cd0 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -60,6 +60,7 @@ let to_string buf code = | 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" @@ -68,8 +69,10 @@ let to_string buf code = | Setne -> "\tsetne\t%al" - (*в to_eax_edx мы в y кладём edx, соотв. здесь al кладём в edx*) + (*в 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 @@ -83,13 +86,12 @@ let to_string buf code = module S = Set.Make (String) -let save_regs f = +let save_eax_edx f = [Push eax; Push edx] @ f @ [Pop edx; Pop eax] -let to_eax_edx x y f = - save_regs @@ [Mov (x, eax); Mov (y, edx)] @ (f eax edx) @ [Mov (edx, y)] +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] @@ -121,7 +123,7 @@ let rec sint env prg sstack = | LD x -> let env' = env#local x in let env'', s = env'#allocate sstack in - env'', (to_eax_edx (M x) s @@ fun x y -> [Mov (x, y)]), s :: sstack + 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 @@ -134,29 +136,29 @@ let rec sint env prg sstack = let x::(y::_ as sstack') = sstack in env, (match op with | "+" -> - to_eax_edx x y @@ fun x y -> [Add (x, y); Mov (y, eax)] + wrap_mem_access x y @@ fun x y -> [Add (x, y); Mov (y, eax)] | "-" -> - to_eax_edx x y @@ fun x y -> [Sub (x, y); Mov (y, eax)] + wrap_mem_access x y @@ fun x y -> [Sub (x, y); Mov (y, eax)] | "*" -> - save_regs [Mov (y, eax); Mul (x, eax); Mov (eax, y)] + save_eax_edx [Mov (y, eax); Mul (x, eax); Mov (eax, y)] | "/" -> - save_regs [Mov (y, eax); Cdq; Div (x, y); Mov (eax, y)] + save_eax_edx [Mov (y, eax); Cdq; Div (x, y); Mov (eax, y)] | "%" -> - save_regs [Mov (y, eax); Cdq; Div (x, y); Mov (edx, y)] + save_eax_edx [Mov (y, eax); Cdq; Div (x, y); Mov (edx, y)] | "<" -> - to_eax_edx x y @@ fun x y -> compare x y Setl + wrap_mem_access x y @@ fun x y -> compare x y Setl | "<=" -> - to_eax_edx x y @@ fun x y -> compare x y Setle + wrap_mem_access x y @@ fun x y -> compare x y Setle | ">" -> - to_eax_edx x y @@ fun x y -> compare x y Setg + wrap_mem_access x y @@ fun x y -> compare x y Setg | ">=" -> - to_eax_edx x y @@ fun x y -> compare x y Setge + wrap_mem_access x y @@ fun x y -> compare x y Setge | "==" -> - to_eax_edx x y @@ fun x y -> compare x y Sete + wrap_mem_access x y @@ fun x y -> compare x y Sete | "!=" -> - to_eax_edx x y @@ fun x y -> compare x y Setne + wrap_mem_access x y @@ fun x y -> compare x y Setne | "&&" -> - save_regs [ + 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 *) @@ -164,8 +166,6 @@ let rec sint env prg sstack = Mov (x, edx); Cmp (edx, eax); Setne; - (* Mov y to edx and mul eax and edx (result in edx) - result of && is not null only if eax not null (x != 0) and edx not null (y != 0) *) Mov (y, edx); Mul (eax, edx); Xor (eax, eax); @@ -173,8 +173,7 @@ let rec sint env prg sstack = Setne; Mov (eax, y)] | "!!" -> - save_regs [ - (* Set eax value to null, mov x to edx, check that or y, edx not null*) + save_eax_edx [ Xor (eax, eax); Mov (x, edx); Or (y, edx); From 50c4fb66a1508e6bef7fe5e59ff201ad67e09560 Mon Sep 17 00:00:00 2001 From: dsv Date: Tue, 25 Apr 2017 03:19:14 +0300 Subject: [PATCH 26/33] use ebx too --- src/X86.ml | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/src/X86.ml b/src/X86.ml index b9fe8cd0..a51dcee9 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -3,15 +3,11 @@ open Instr type opnd = R of int | S of int | L of int | M of string -let regs = [|"%eax"; "%ebx"; "%ecx"; "%edi"; "%esi"; "%edx"; "%esp"; "%ebp"|] +let regs = [|"%eax"; "%ebx"; "%ecx"; "%esi"; "%edi"; "%edx"; "%esp"; "%ebp"|] let nregs = Array.length regs - 3 -let [|eax; ebx; ecx; edx; esi; edi; esp; ebp|] = Array.mapi (fun i _ -> R i) regs +let [|eax; ebx; ecx; esi; edi; edx; esp; ebp|] = Array.mapi (fun i _ -> R i) regs -(*иначе edx будет edi*) -let tmp = edi -let edi = edx -let edx = tmp type instr = | Add of opnd * opnd @@ -101,7 +97,7 @@ class env = val depth = 0 method allocate = function - | [] -> this, R 2 + | [] -> 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 @@ -131,7 +127,7 @@ let rec sint env prg sstack = | READ -> env, [Call "lread"], [eax] | WRITE -> - env, [Push (R 2); Call "lwrite"; Pop (R 2)], [] + env, [Push (R 1); Call "lwrite"; Pop (R 1)], [] | BINOP op -> let x::(y::_ as sstack') = sstack in env, (match op with From f75e0c8749a289fe71658c6370a3d5af98716a58 Mon Sep 17 00:00:00 2001 From: dsv Date: Tue, 25 Apr 2017 22:53:12 +0300 Subject: [PATCH 27/33] add travis ci build --- .travis-opam.sh | 37 +++++++++++++++++++++++++++++++++++++ .travis.yml | 9 +++++++++ installBuildRun.sh | 14 ++++++++++++++ 3 files changed, 60 insertions(+) create mode 100644 .travis-opam.sh create mode 100644 .travis.yml create mode 100644 installBuildRun.sh 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 100644 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 From 8f3ff712fab6e14175d278dbc0cebc8ae08fd51c Mon Sep 17 00:00:00 2001 From: dsv Date: Tue, 25 Apr 2017 23:06:32 +0300 Subject: [PATCH 28/33] make script executable --- installBuildRun.sh | 0 1 file changed, 0 insertions(+), 0 deletions(-) mode change 100644 => 100755 installBuildRun.sh diff --git a/installBuildRun.sh b/installBuildRun.sh old mode 100644 new mode 100755 From 2ed0d3ad153638df042ddaccb821a65166e04397 Mon Sep 17 00:00:00 2001 From: dsv Date: Tue, 9 May 2017 10:42:16 +0300 Subject: [PATCH 29/33] tokenize new operators --- src/Driver.ml | 2 +- src/Language.ml | 21 +++++++++++++++++++-- 2 files changed, 20 insertions(+), 3 deletions(-) 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/Language.ml b/src/Language.ml index 3e9aed86..93bfdae1 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -61,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 @@ -68,8 +71,22 @@ 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 ) From bc049b460a2bbbc1867fd40feab35e4d7174ef25 Mon Sep 17 00:00:00 2001 From: dsv Date: Tue, 9 May 2017 11:02:06 +0300 Subject: [PATCH 30/33] if\while in Interpreter --- src/Interpret.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Interpret.ml b/src/Interpret.ml index c467a9bd..73a65a90 100644 --- a/src/Interpret.ml +++ b/src/Interpret.ml @@ -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 From f2dc85f761826596d9beb064372fc10184a05e2c Mon Sep 17 00:00:00 2001 From: dsv Date: Tue, 9 May 2017 15:04:06 +0300 Subject: [PATCH 31/33] x86 if and while --- regression/Makefile | 4 +-- src/Driver.ml | 2 +- src/Interpret.ml | 8 ++--- src/Language.ml | 7 +--- src/StackMachine.ml | 79 +++++++++++++++++++++++++++++++++------------ src/X86.ml | 15 +++++++++ 6 files changed, 82 insertions(+), 33 deletions(-) diff --git a/regression/Makefile b/regression/Makefile index baca8ca3..c5f19fe5 100644 --- a/regression/Makefile +++ b/regression/Makefile @@ -1,7 +1,7 @@ -TESTS=test001 test002 test012 test013 test003 test004 test005 test006 test007 test008 +TESTS=test001 test002 test012 test013 test003 test004 test005 test006 test007 test008 test009 test010 # Later: -# test009 test010 test 11 +# test 11 # test014 test015 test016 test017 test018 test019 test020 test021 test022 test023 test024 test025 test026 # test027 test028 test029 test030 diff --git a/src/Driver.ml b/src/Driver.ml index 912cb75d..73822d93 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"; "if"; "fi"; "then"; "else"; "while"; "do"; "od"; "repeat"; "until"; "for"] s + inherit Util.Lexers.ident ["read"; "write"; "skip"; "if"; "fi"; "then"; "else"; "while"; "do"; "od";] 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 73a65a90..a8a6d571 100644 --- a/src/Interpret.ml +++ b/src/Interpret.ml @@ -29,14 +29,14 @@ module Stmt = match stmt with | Skip -> conf | Assign (x, e) -> (update st x (Expr.eval e st), input, output) + | Write e -> (st, input, output @ [Expr.eval e st]) + | Seq (s1, s2) -> eval s1 conf |> eval s2 | Read x -> let z :: input' = input in (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) + | If (e, s1, s2) -> if (Expr.eval e st) <> 0 then (eval s1 conf) else (eval s2 conf) (*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 + | While (e, s) -> if (Expr.eval e st) <> 0 then eval stmt (eval s conf) else conf end diff --git a/src/Language.ml b/src/Language.ml index 93bfdae1..811efa95 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -81,12 +81,7 @@ module Stmt = %"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))))}; + %"od" {While (e, s)}; parse: s:simp ";" d:parse {Seq (s,d)} | simp ) diff --git a/src/StackMachine.ml b/src/StackMachine.ml index d004853e..aa0b0744 100644 --- a/src/StackMachine.ml +++ b/src/StackMachine.ml @@ -9,6 +9,9 @@ module Instr = | LD of string | ST of string | BINOP of string + | GOTO of string + | IFGOTO of string * string + | LABEL of string end @@ -26,32 +29,46 @@ module Interpret = open Interpret.Stmt open Language.BinOp + let e_to_op = function + | "z" -> (==) + | "nz" -> (!=) + | _ -> failwith "Stack machine.e_to_op: Unknown parameter" + + (* Get instruction pointer for label lbl in the code*) + let rec find_ip lbl code = + match code with + | [] -> failwith "Stack machine.Find ip: Unknown label" + | i::code' -> if i = LABEL lbl then 0 else 1 + find_ip lbl code' + let run prg input = - let rec run' prg ((stack, st, input, output) as conf) = - match prg with - | [] -> conf - | i :: prg' -> - run' prg' ( + let rec run' prg ((stack, st, input, output, ip) as conf) = + if ip >= (List.length prg) + then conf + else let i = (List.nth prg ip) in + run' prg ( match i with | READ -> let z :: input' = input in - (z :: stack, st, input', output) + (z :: stack, st, input', output, ip + 1) | WRITE -> let z :: stack' = stack in - (stack', st, input, output @ [z]) - | PUSH n -> (n :: stack, st, input, output) - | LD x -> (st x :: stack, st, input, output) - | ST x -> let z :: stack' = stack in - (stack', update st x z, input, output) - | BINOP op -> - let y::x::stack' = stack in - ((apply op x y)::stack', st, input, output) + (stack', st, input, output @ [z], ip + 1) + | PUSH n -> (n :: stack, st, input, output, ip + 1) + | LD x -> (st x :: stack, st, input, output, ip + 1) + | ST x -> let z :: stack' = stack in + (stack', update st x z, input, output, ip + 1) + | BINOP op -> + let y::x::stack' = stack in + ((apply op x y)::stack', st, input, output, ip + 1) + | LABEL lbl -> + (stack, st, input, output, ip + 1) + | GOTO lbl -> + (stack, st, input, output, (find_ip lbl prg)) + | IFGOTO (e, lbl) -> + let y::stack' = stack in + (stack', st, input, output, if ((e_to_op e) y 0) then (find_ip lbl prg) else ip + 1) ) in - let (_, _, _, output) = - run' prg ([], - (fun _ -> failwith "undefined variable"), - input, - [] - ) + let (_, _, _, output, _) = + run' prg ([], (fun _ -> failwith "undefined variable"), input, [], 0) in output end @@ -78,12 +95,34 @@ module Compile = open Language.Stmt + let i = ref (-1) + let create_new_lbl () = + i:= !i + 1; + string_of_int !i + let rec compile = function | Skip -> [] | Assign (x, e) -> Expr.compile e @ [ST x] | Read x -> [READ; ST x] | Write e -> Expr.compile e @ [WRITE] | Seq (l, r) -> compile l @ compile r + | If (e, s1, s2) -> + let lbl1 = create_new_lbl () in + let lbl2 = create_new_lbl () in + Expr.compile e + @ [IFGOTO ("z", lbl1)] + @ compile s1 + @ [GOTO lbl2; LABEL lbl1] + @ compile s2 + @ [LABEL lbl2] + | While (e, s) -> + let lbl1 = create_new_lbl () in + let lbl2 = create_new_lbl () in + [GOTO lbl2; LABEL lbl1] + @ compile s + @ [LABEL lbl2] + @ Expr.compile e + @ [IFGOTO ("nz", lbl1)] end diff --git a/src/X86.ml b/src/X86.ml index a51dcee9..cc5f8333 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -6,6 +6,7 @@ type opnd = R of int | S of int | L of int | M of string let regs = [|"%eax"; "%ebx"; "%ecx"; "%esi"; "%edi"; "%edx"; "%esp"; "%ebp"|] let nregs = Array.length regs - 3 + let [|eax; ebx; ecx; esi; edi; edx; esp; ebp|] = Array.mapi (fun i _ -> R i) regs @@ -32,6 +33,9 @@ type instr = | Movzbl | Ret | Call of string +| Lbl of string +| Goto of string +| Ifgoto of string * string let to_string buf code = let instr = @@ -72,6 +76,10 @@ let to_string buf code = | Cdq -> "\tcdq" | Ret -> "\tret" | Call p -> Printf.sprintf "\tcall\t%s" p + + | Lbl s -> Printf.sprintf "label%s:" s + | Goto s -> Printf.sprintf "\tjmp\tlabel%s" s + | Ifgoto (e, s) -> Printf.sprintf "\tj%s\tlabel%s" e s in let out s = Buffer.add_string buf "\t"; @@ -128,6 +136,13 @@ let rec sint env prg sstack = env, [Call "lread"], [eax] | WRITE -> env, [Push (R 1); Call "lwrite"; Pop (R 1)], [] + | LABEL lbl -> + (env, [Lbl lbl], sstack) + | GOTO lbl -> + (env, [Goto lbl], sstack) + | IFGOTO (e, lbl) -> + let y::stack' = sstack in + (env, [Cmp (L 0, y); Ifgoto (e, lbl)], stack') | BINOP op -> let x::(y::_ as sstack') = sstack in env, (match op with From e1ec561f09a6e0ab2c8e40f5c14ac75298f96e01 Mon Sep 17 00:00:00 2001 From: dsv Date: Wed, 17 May 2017 14:23:27 +0300 Subject: [PATCH 32/33] add repeat until --- src/Driver.ml | 2 +- src/Language.ml | 7 ++++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Driver.ml b/src/Driver.ml index 73822d93..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"; "if"; "fi"; "then"; "else"; "while"; "do"; "od";] 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/Language.ml b/src/Language.ml index 811efa95..93bfdae1 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -81,7 +81,12 @@ module Stmt = %"fi" {If (e, s1, Skip)} | %"while" e:!(Expr.parse) %"do" s:!(parse) - %"od" {While (e, s)}; + %"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 ) From 055c83bcea9e399bafc112d8176442960df3cb42 Mon Sep 17 00:00:00 2001 From: dsv Date: Wed, 17 May 2017 14:29:02 +0300 Subject: [PATCH 33/33] add tests with repeat --- regression/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/regression/Makefile b/regression/Makefile index 86250bcf..27a27d10 100644 --- a/regression/Makefile +++ b/regression/Makefile @@ -1,6 +1,6 @@ -TESTS=test001 test002 test012 test013 test003 test004 test005 test006 test007 test008 test009 test010 test014 test015 test016 test017 test018 +TESTS=test001 test002 test012 test013 test003 test004 test005 test006 test007 test008 test009 test010 test014 test015 test016 test017 test018 test019 test020 test021 test022 test023 -# test011 test019 test020 test021 test022 test023 test024 test025 test026 +# test011 test024 test025 test026 # test027 test028 test029 test030 .PHONY: check $(TESTS)