diff --git a/.gitignore b/.gitignore index 387afa6..c3643a8 100644 --- a/.gitignore +++ b/.gitignore @@ -54,3 +54,25 @@ ps1/.paths ps0/test.asm ps1/.settings/org.eclipse.core.resources.prefs + +ps2/word32.cmo + +ps2/ps2 + +ps2/parse.mli + +ps2/parse.cmi + +ps2/compiled_tests + +ps2/*.cmo + +ps2/*.cmi + +ps2/tests + +ps2/parse.output + +ps2/parse.ml + +ps2/lex.ml diff --git a/ps2/Makefile b/ps2/Makefile index d0d0c17..d0e7b72 100644 --- a/ps2/Makefile +++ b/ps2/Makefile @@ -4,11 +4,20 @@ # change to a different ocamlc if you prefer (e.g., ocamlopt) COMPILER=ocamlc -all: clean compile +all: clean compile test run_tests -test: mips +test: compile ./tests +compile_tests: compile + ./compile_canned.sh + +run_tests: compile_tests + ./run_tests.sh + +benchmark: compile_tests + ./benchmark.sh + compile: $(COMPILER) -c ast.ml ocamlyacc -v parse.mly @@ -19,13 +28,14 @@ compile: $(COMPILER) -c eval.ml $(COMPILER) -c word32.ml $(COMPILER) -c mips.ml + $(COMPILER) -c optimize.ml $(COMPILER) -c compile.ml $(COMPILER) -c fish.ml $(COMPILER) -c pretty_print.ml $(COMPILER) -c test_framework.ml $(COMPILER) -c compile_tests.ml - $(COMPILER) -o ps2 ast.cmo parse.cmo lex.cmo eval.cmo word32.cmo mips.cmo compile.cmo fish.cmo - $(COMPILER) -o tests ast.cmo parse.cmo lex.cmo eval.cmo word32.cmo mips.cmo compile.cmo pretty_print.cmo test_framework.cmo compile_tests.cmo + $(COMPILER) -o ps2 ast.cmo parse.cmo lex.cmo eval.cmo word32.cmo mips.cmo optimize.cmo compile.cmo fish.cmo + $(COMPILER) -o tests ast.cmo parse.cmo lex.cmo eval.cmo word32.cmo mips.cmo optimize.cmo compile.cmo pretty_print.cmo test_framework.cmo compile_tests.cmo clean: - -rm *.cmo *.cmi ps2 parse.ml parse.mli lex.ml tests parse.output + rm -rf *.cmo *.cmi ps2 parse.ml parse.mli lex.ml tests parse.output compiled_tests diff --git a/ps2/benchmark.sh b/ps2/benchmark.sh new file mode 100755 index 0000000..af6aee0 --- /dev/null +++ b/ps2/benchmark.sh @@ -0,0 +1,22 @@ +#!/bin/sh + +echo "[==========] Benchmarking Canned Tests" + +if [[ -e compiled_tests ]]; then + for test_file in `ls compiled_tests/*_test.asm`; do + echo "\x1b\x5b1;36m[ RUNNING ]\x1b\x5b0m ${test_file:15}" + log_file=${test_file%.asm}.log + (time ./spim_run.sh $test_file > $log_file) 2>> $log_file + count=`wc -l $log_file | awk '{print $1}'` + if (($count > 6)); then + # Something has failed, we'll log out and return a nice fail message + echo "\x1b\x5b1;31m[ FAILED ]\x1b\x5b0m See $log_file for error message" + else + echo "\x1b\x5b1;32m[ COMPLETE ]\x1b\x5b0m Time:" `tail -n 2 $log_file | head -n 1` + fi + done +else + echo "\x1b\x5b1;31m[ ERROR ]\x1b\x5b0m: Compiled Tests not found" +fi + +echo "[==========] Completed" \ No newline at end of file diff --git a/ps2/compile.ml b/ps2/compile.ml index 4494366..d32d564 100644 --- a/ps2/compile.ml +++ b/ps2/compile.ml @@ -1,6 +1,7 @@ (* Compile Fish AST to MIPS AST *) open Mips open Ast +open Optimize exception IMPLEMENT_ME @@ -9,7 +10,7 @@ type result = { code : Mips.inst list; (* generate fresh labels *) let label_counter = ref 0 -let new_int() = (label_counter := (!label_counter) + 1; !label_counter) +let new_int() = (label_counter := (!label_counter) + 1; !label_counter) let new_label() = "L" ^ (string_of_int (new_int())) (* sets of variables -- Ocaml Set and Set.S *) @@ -24,6 +25,9 @@ let variables : VarSet.t ref = ref (VarSet.empty) let add_var (v: string) : unit = variables := VarSet.add v (!variables); () +let find_var (v: string) : bool = + VarSet.exists (fun x -> x = v) !variables + (* generate a fresh temporary variable and store it in the variables set. *) let rec new_temp() : string= let t = "T" ^ (string_of_int (new_int())) in @@ -37,12 +41,12 @@ let reset() = (label_counter := 0; variables := VarSet.empty) (* find all of the variables in a program and add them to * the set variables *) let rec collect_vars (p : Ast.program) : unit = - (*************************************************************) let stip_pos r = let(v,_) = r in v in let rec collect_vars_e (e: Ast.exp) : unit = match (stip_pos e) with - | Var v -> add_var v - | Assign (v, e1) -> add_var v + | Var v -> add_var ("V"^v) + | Assign (v, e1) -> + let _ = add_var ("V"^v) in collect_vars_e e1 | Int _ -> () | Binop(e1, _, e2) -> collect_vars_e e1; collect_vars_e e2 @@ -50,7 +54,8 @@ let rec collect_vars (p : Ast.program) : unit = | And (e1, e2) -> collect_vars_e e1; collect_vars_e e2 | Or (e1, e2) -> collect_vars_e e1; - collect_vars_e e2 in + collect_vars_e e2 + in match (stip_pos p) with | Exp e -> collect_vars_e e | Seq (s1, s2) -> collect_vars s1; @@ -65,29 +70,123 @@ let rec collect_vars (p : Ast.program) : unit = collect_vars_e e3; collect_vars s | Return e -> collect_vars_e e - (*************************************************************) +(* Prepends reversed x onto accum. Order of parameters for + * readability of code *) +let rec revapp (accum: 'a list) (x: 'a list) : 'a list= + match x with + | [] -> accum + | head::tail -> revapp (head::accum) tail + +let rev x = revapp [] x + +(* Factors out common code for compiling two nested expressions and + * carrying out some instruction. The result of e1 is stored in R3, + * the result of e2 in R2. in is the instruction to carry out on these + * results *) +let rec compile_exp_r (is: inst list) ((e,_): Ast.exp): inst list = + let dual_op (e1: Ast.exp) (e2: Ast.exp) (instruction: inst) : inst list = + let t = new_temp() in + (* Load result of first expression and carry out instruction *) + revapp (compile_exp_r + (revapp (compile_exp_r is e1) [La(R3, t); Sw(R2, R3, Int32.zero)]) + e2) + [La(R3, t); Lw(R3, R3, Int32.zero); instruction] in + match e with + | Var v -> revapp is [La(R2, "V"^v); Lw(R2,R2, Int32.zero)] + | Int i -> Li(R2, Word32.fromInt i)::is + | Binop(e1,op,e2) -> + let oper = (match op with + | Plus -> Mips.Add(R2, R3, Reg(R2)) + | Minus -> Mips.Sub(R2, R3, R2) + | Times -> Mips.Mul(R2, R3, R2) + | Div -> Mips.Div(R2, R3, R2) + | Eq -> Mips.Seq(R2, R3, R2) + | Neq -> Mips.Sne(R2, R3, R2) + | Lt -> Mips.Slt(R2, R3, R2) + | Lte -> Mips.Sle(R2, R3, R2) + | Gt -> Mips.Sgt(R2, R3, R2) + | Gte -> Mips.Sge(R2, R3, R2)) in + dual_op e1 e2 oper + (* If R3 = 0, then set R2 = 1, else R2 = 0 *) + | Not(e) -> revapp (compile_exp_r is e) [Mips.Seq(R2, R3, R0)] + | And(e1, e2) -> + dual_op e1 e2 (Mips.And(R2, R2, Reg R3)) + | Or(e1, e2) -> + dual_op e1 e2 (Mips.Or(R2, R2, Reg R3)) + | Assign(v, e) -> revapp (compile_exp_r is e) [La(R3, "V"^v); Sw(R2,R3, Int32.zero)] + +(* Compiles a statement in reverse order *) +let rec compile_stmt_r (is: inst list) ((s,pos): Ast.stmt) : inst list = + match s with + (* Using compile_exp_r directly eliminates redundant reversing the list *) + | Exp e -> compile_exp_r is e + | Seq (s1, s2) -> + compile_stmt_r (compile_stmt_r is s1) s2 + | If(e, then_s, else_s) -> + (* Test e, branch to else_s if not equal *) + let else_l = new_label () in + let end_l = new_label () in + revapp (compile_exp_r is e) + (rev (revapp + (compile_stmt_r + (revapp + (compile_stmt_r [Beq(R2,R0,else_l)] then_s) + [J(end_l); Label(else_l)] + ) + else_s) + [Label(end_l)])) + | While(e, s) -> + let test_l = new_label () in + let top_l = new_label () in + revapp + (compile_exp_r ( + revapp + (compile_stmt_r + (revapp is [J(test_l); Label(top_l)]) + s) + [Label(test_l)]) + e) + [Bne(R2,R0,top_l)] + (* Transform for loops into while loops *) + | For(e1, e2, e3, s) -> + (* Helper to get position out of statement *) + let get_pos s = let (_,p) = s in p in + (* Nastiness due to necesity of having position informaiton *) + compile_stmt_r is ((Ast.Seq( + (Ast.Exp e1, (get_pos e1)), + (While( + e2, + (Ast.Seq(s, (Ast.Exp e3, (get_pos e3))), get_pos s)), + pos))), + pos) + | Return (e) -> + revapp (compile_exp_r is e) [Jr(R31)] + (* compiles a Fish statement down to a list of MIPS instructions. * Note that a "Return" is accomplished by placing the resulting * value in R2 and then doing a Jr R31. *) -let rec compile_stmt ((s,_):Ast.stmt) : inst list = - (*************************************************************) - raise IMPLEMENT_ME - (*************************************************************) +let compile_stmt (s :Ast.stmt) : inst list = + rev (compile_stmt_r [] s) (* compiles Fish AST down to MIPS instructions and a list of global vars *) let compile (p : Ast.program) : result = + let preoptimized = (constant_fold p) in let _ = reset() in - let _ = collect_vars(p) in - let insts = (Label "main") :: (compile_stmt p) in - { code = insts; data = VarSet.elements (!variables) } + let _ = collect_vars(preoptimized) in + let insts = (Label "main") :: (compile_stmt preoptimized) in + let optimized = (thread_jumps insts) in + { code = optimized; data = VarSet.elements (!variables) } + +let code_to_string code = + List.map (fun x -> (Mips.inst2string x) ^ "\n") code (* converts the output of the compiler to a big string which can be * dumped into a file, assembled, and run within the SPIM simulator * (hopefully). *) let result2string ({code;data}:result) : string = - let strs = List.map (fun x -> (Mips.inst2string x) ^ "\n") code in + let strs = code_to_string code in let var2decl x = x ^ ":\t.word 0\n" in "\t.text\n" ^ "\t.align\t2\n" ^ diff --git a/ps2/compile_canned.sh b/ps2/compile_canned.sh new file mode 100755 index 0000000..9080b86 --- /dev/null +++ b/ps2/compile_canned.sh @@ -0,0 +1,31 @@ +#!/bin/sh + +echo "[==========] Compiling Canned Fish Tests" + +rm -rf compiled_tests + +mkdir compiled_tests + +if [[ -e ps2 ]]; then + for filename in `ls test/*.fish`; do + target=${filename%.fish} + output_file="compiled_tests/${target:5}.asm" + + echo "\x1b\x5b1;36m[ COMPILE ]\x1b\x5b0m ${filename:5}" + # Tags on the debug print stuff at the header of the program so we can actually test + cat print.asm > $output_file + echo "\n" >> $output_file + # Compile + ./ps2 $filename >> $output_file + + # Tag on little bits to print out the results of the program + awk -v modified="${output_file%.asm}_test.asm" '{sub(/jr\t\$31/,"move $a0, $2\n\tj printInt");print > modified}' $output_file + + # We don't need to keep the leftovers + rm $output_file + done +else + echo "\x1b\x5b1;31m[ ERROR ]\x1b\x5b0m: Compiler not found" +fi + +echo "[==========] Complete" \ No newline at end of file diff --git a/ps2/compile_tests.ml b/ps2/compile_tests.ml index b7c0095..30954ad 100644 --- a/ps2/compile_tests.ml +++ b/ps2/compile_tests.ml @@ -1,7 +1,206 @@ open Test_framework open Pretty_print open Compile +open Optimize +open Ast +open Mips -let test_collect_vars p = - let vars = collect_vars(p); !variables in - () +(* Utility function tests *) +let revapp_test = + let test = fun () -> + let init_list = [3; 2; 1] in + let target_list = [4; 5] in + let result = revapp init_list target_list in + result = [5;4;3;2;1] + in + Test("Revapp Test", test) +;; + +let rev_test = + let test = fun () -> + let init_list = [3; 2; 1] in + let result = rev init_list in + result = [1; 2; 3] + in + Test("Rev Test", test) +;; + +(* Tests for collecting variables *) +let collect_assign_test = + let test = fun () -> + let prog = (Ast.Exp( + (Ast.Assign("y", + (Int(1), 0) + ), 0) + ), 0) + in + let _ = reset () in + let _ = (collect_vars prog) in + (find_var "Vy") + in + Test("Assignment Var Collect", test) +;; + +let collect_rec_assign_test = + let test = fun () -> + let prog = (Ast.Exp( + (Ast.Assign("y", + ((Ast.Assign("x", + (Ast.Int(2), 0))), 0) + ), 0) + ), 0) + in + let _ = reset () in + let _ = (collect_vars prog) in + find_var "Vx" + in + Test("Nested Assign Var Collect", test) +;; + +let collect_exp_assign_test = + let test = fun () -> + let prog = (Ast.Exp( + (Ast.Binop((Int(5), 0), Ast.Plus, + ((Ast.Assign("x", + (Ast.Int(2), 0))), 0) + ), 0) + ), 0) + in + let _ = reset () in + let _ = (collect_vars prog) in + find_var "Vx" + in + Test("Expression Assign Var Collect", test) +;; + +(* Tests for compiling expressions *) + +let compile_assign_test = + let test = fun () -> + let prog = (Ast.Exp( + (Ast.Assign("y", + (Int(1), 0) + ), 0) + ), 0) + in + let _ = reset () in + let result = (compile_stmt prog) in + let success = + (result = + [ Li(R2, 1l); La(R3, "Vy"); Sw(R2,R3, Int32.zero) ]) + in + success(*, (String.concat "" (code_to_string result)))*) + in + Test("Compile Var Assign", test) +;; + +(* Tests for compiling specific statements *) +let compile_if_assign_test = + let if_cond = (Int(0), 0) in + let then_assign = (Ast.Exp( + (Ast.Assign("y", + (Int(1), 0) + ), 0) + ), 0) + in + let else_c = (skip, 0) in + let if_stmt = (Ast.If( + if_cond, + then_assign, + else_c), 0) + in + let test = fun () -> + let compiled = (compile_stmt if_stmt) in + let success = + (compiled = + [ Li(R2, 0l); + Beq(R2, R0, "L1"); + Li(R2, 1l); + La(R3, "Vy"); + Sw(R2,R3, 0l); + J("L2"); + Label("L1"); + Li(R2, 0l); + Label("L2"); ] + ) + in success + in + Test("Compile If-Assign hybrid", test) +;; + +let jump_thread_test = + let code = + [ + Li(R2, 0l); + J("L2"); + Label("L1"); + J("L3"); + Li(R2, 2l); + Label("L2"); + J("L1"); + Li(R2, 4l); + Label("L3"); + Li(R2, 8l); + ] + in + let test = fun () -> + let thin_code = thread_jumps code in + let success = + (thin_code = + [ + Li(R2, 0l); + J("L3"); + Label("L1"); + J("L3"); + Li(R2, 2l); + Label("L2"); + J("L3"); + Li(R2, 4l); + Label("L3"); + Li(R2, 8l); + ]) + in + success + in + Test("Thread Jumps Test", test) +;; + +let constant_folding_test = + let program = (Ast.Exp( + (Ast.Binop( + (Int(1), 0), + Ast.Plus, + (Int(1), 0) + ), 0) + ), 0) + + in + let test = fun () -> + let folded = (constant_fold program) in + let success = + (folded = + (Ast.Exp( + (Ast.Int(2), 0) + ), 0) + ) + in + success + in + Test("Constant Folding Test", test) +;; + + +run_test_set [ revapp_test; + rev_test ] "Utility Tests";; + +run_test_set [ collect_assign_test; + collect_rec_assign_test; + collect_exp_assign_test; ] + "Collect Var Tests";; + +run_test_set [ compile_assign_test ] "Compile Expression Tests";; + +run_test_set [ compile_if_assign_test ] "Compile Statment Tests";; + +run_test_set [ jump_thread_test; + constant_folding_test; ] "Optimization Tests";; diff --git a/ps2/optimize.ml b/ps2/optimize.ml new file mode 100644 index 0000000..0707ec7 --- /dev/null +++ b/ps2/optimize.ml @@ -0,0 +1,116 @@ +open Mips +open Ast +open Eval + +(* Code Crawling Utilities *) + +exception LabelNotFound + +(* Finds a label, returning all the instructions that follow it *) +let rec find_label (target : string) (insts : inst list) : inst list = + match insts with + | [] -> [] + | Label(name)::rest -> if (name = target) then rest else (find_label target rest) + | _::rest -> (find_label target rest) +;; + +(* Functions that optimize *) + +(* Jump threading: eliminating jump->jump behavior *) +let thread_jumps (insts : inst list) : inst list = + + (* Follows jumps until the end, returning the last one *) + let rec inspect_jump (last_label : string) : string = + (* Find the target in all code *) + let target_inst = (find_label last_label insts) in + match target_inst with + | J(label_name)::_ -> (inspect_jump label_name) + | _ -> last_label + in + (List.fold_left + (fun accum t_inst -> + match t_inst with + | J(label_name) -> accum @ [J(inspect_jump label_name)] + | _ -> accum @ [t_inst] + ) + [] + insts + ) +;; + +(* Conditional optimization: compressing slt + beq -> blt *) + + +(* Constant folding: cutting constant-constant ops out of the AST *) +let rec constant_fold (statement : Ast.stmt) : Ast.stmt = + + let simple_not t_exp = + match t_exp with + | (Int(i), pos) -> Int(bool2int (i != 0)) + | _ -> Not(t_exp) + in + (* Combine and *) + let combine_and exp1 exp2 = + let (rexp1, _) = exp1 in + let (rexp2, _) = exp2 in + match (rexp1, rexp2) with + | (Int(i1), Int(i2)) -> Int(bool2int ((i1 = 0) && (i2 = 0))) + | _ -> And(exp1, exp2) + in + (* Combine or *) + let combine_or exp1 exp2 = + let (rexp1, _) = exp1 in + let (rexp2, _) = exp2 in + match (rexp1, rexp2) with + | (Int(i1), Int(i2)) -> Int(bool2int ((i1 = 0) || (i2 = 0))) + | _ -> Or(exp1, exp2) + in + (* Combine binary operations if possible *) + let combine_binop exp1 (op : binop) exp2 = + let (rexp1, _) = exp1 in + let (rexp2, _) = exp2 in + match (rexp1, rexp2) with + | (Int(i1), Int(i2)) -> + (match op with + | Plus -> Int(i1 + i2) + | Minus -> Int(i1 - i2) + | Times -> Int(i1 * i2) + | Div -> Int(i1 / i2) + | Eq -> Int(bool2int(i1 = i2)) + | Neq -> Int(bool2int(i1 != i2)) + | Lt -> Int(bool2int(i1 < i2)) + | Lte -> Int(bool2int(i1 <= i2)) + | Gt -> Int(bool2int(i1 > i2)) + | Gte -> Int(bool2int(i1 >= i2))) + | (_, _) -> Binop(exp1, op, exp2) + in + (* Handle expressions *) + let rec constant_fold_e (expression : Ast.exp) : Ast.exp = + let (rexpr, position) = expression in + let folded_expr = + match rexpr with + | Int(_) -> rexpr + | Var(_) -> rexpr + | Binop(exp1, op, exp2) -> (combine_binop (constant_fold_e exp1) op (constant_fold_e exp2)) + | Not(t_exp) -> simple_not (constant_fold_e t_exp) + | And(exp1, exp2) -> (combine_and (constant_fold_e exp1) (constant_fold_e exp2)) + | Or(exp1, exp2) -> (combine_or (constant_fold_e exp1) (constant_fold_e exp2)) + | Assign(v, t_exp) -> Assign(v, (constant_fold_e t_exp)) + in + (folded_expr, position) + in + + (* Break statements down *) + let (rstatement, position) = statement in + let folded_statement = + match rstatement with + | Seq(s1, s2) -> Seq((constant_fold s1), (constant_fold s2)) + | Exp(expr) -> Exp(constant_fold_e expr) + | Return(expr) -> Return(constant_fold_e expr) + | If(expr, then_s, else_s) -> If((constant_fold_e expr), (constant_fold then_s), (constant_fold else_s)) + | While(expr, do_s) -> While((constant_fold_e expr), (constant_fold do_s)) + | For(expr1, expr2, expr3, do_s) -> For((constant_fold_e expr1), (constant_fold_e expr2), (constant_fold_e expr3), (constant_fold do_s)) + in + (folded_statement, position) +;; + diff --git a/ps2/run_tests.sh b/ps2/run_tests.sh new file mode 100755 index 0000000..1eab3ad --- /dev/null +++ b/ps2/run_tests.sh @@ -0,0 +1,22 @@ +#!/bin/sh + +echo "[==========] Running Canned Tests" + +if [[ -e compiled_tests ]]; then + for test_file in `ls compiled_tests/*_test.asm`; do + echo "\x1b\x5b1;36m[ RUNNING ]\x1b\x5b0m ${test_file:15}" + log_file=${test_file%.asm}.log + ./spim_run.sh $test_file > $log_file 2>&1 + count=`wc -l $log_file | awk '{print $1}'` + if (($count > 2)); then + # Something has failed, we'll log out and return a nice fail message + echo "\x1b\x5b1;31m[ FAILED ]\x1b\x5b0m See $log_file for error message" + else + echo "\x1b\x5b1;32m[ COMPLETE ]\x1b\x5b0m Returned:" `tail -n 1 $log_file` + fi + done +else + echo "\x1b\x5b1;31m[ ERROR ]\x1b\x5b0m: Compiled Tests not found" +fi + +echo "[==========] Completed" \ No newline at end of file diff --git a/ps2/spim_run.sh b/ps2/spim_run.sh new file mode 100755 index 0000000..55153b4 --- /dev/null +++ b/ps2/spim_run.sh @@ -0,0 +1,3 @@ +#!/bin/sh + + spim load $1 | tail -n 1 diff --git a/ps2/test/03stmt_03while.fish b/ps2/test/03stmt_03while.fish index 9af25e8..79aab53 100644 --- a/ps2/test/03stmt_03while.fish +++ b/ps2/test/03stmt_03while.fish @@ -1,3 +1,5 @@ +/* Answer: 45 */ + { i = 0; x = 0; diff --git a/ps2/test/03stmt_04for.fish b/ps2/test/03stmt_04for.fish index eaeac9f..d251491 100644 --- a/ps2/test/03stmt_04for.fish +++ b/ps2/test/03stmt_04for.fish @@ -1,3 +1,5 @@ +/* Answer: 55 */ + { x = 0; for (i = 10; i > 0; i = i - 1) { diff --git a/ps2/test/constant_fold.fish b/ps2/test/constant_fold.fish new file mode 100644 index 0000000..cbf8e38 --- /dev/null +++ b/ps2/test/constant_fold.fish @@ -0,0 +1 @@ +return (1 + 2); \ No newline at end of file diff --git a/ps2/test_framework.ml b/ps2/test_framework.ml index f7b5d6f..1525344 100644 --- a/ps2/test_framework.ml +++ b/ps2/test_framework.ml @@ -66,3 +66,6 @@ let run_expect_test (f : unit -> 'a) (expected : 'a) (name : string) = (* Makes and runs a single verbose expect test *) let run_verbose_expect_test (f : unit -> 'a) (expected : 'a) (to_string : 'a -> string) (name : string) = run_test ( mk_verbose_expect_test f expected to_string name ) + +let test_stub = Test("Implemented", (fun () -> false) ) +;; \ No newline at end of file