diff --git a/.gitignore b/.gitignore index 430d646..91fe520 100644 --- a/.gitignore +++ b/.gitignore @@ -7,6 +7,5 @@ gitlog.txt docs/html/* !docs/html/.gitkeep build_dir/ -bin/* !bin/.gitkeep demo/* diff --git a/INSTALL.md b/INSTALL.md index 3e2f04b..628174e 100644 --- a/INSTALL.md +++ b/INSTALL.md @@ -1,12 +1,20 @@ # Installation Instructions > [!NOTE] -> This document is not a user manual. -> It simply explains how to get the project onto your computer. -> To see how to get it up and running, read the [user manual](docs/user_manual.md). +> This document is not a user manual. +> It simply explains how to get the project onto your computer and running. +> To see how to use the compiler, check out the [user manual](docs/user_manual.md). -These instructions assume you already have OCaml installed. +## Install System Dependencies +These instructions assume you already have OCaml and `make` installed. + +You'll need `nasm` for compiling assembly and `clang` for compiling and linking the runtime. The recommended way to install these on Linux and Max is through [Homebrew](https://brew.sh/). + +Once you have Homebrew, run `brew install llvm nasm`. If you don't want to use Homebrew, +you're welcome to install the dependencies on your own, but they must be in `PATH`. + +## Build and Run 1. Create a new `opam` switch by running `opam switch create cs3110-compiler ocaml-base-compiler.5.1.1` -2. Install the required libraries: `opam install menhir batteries ounit2` -3. Build the project by running `dune build` -4. Use `dune exec bin/main.exe -- -h` to see usage instructions. Replace `-h` in the previous command with the flags you want to use. +2. Install the required libraries: `make deps` +3. Build the project by running `make`. A main executable will be copied into your directory. +4. Use `./main -h` to see usage instructions. Replace `-h` in the previous command with the flags you want to use. \ No newline at end of file diff --git a/README.md b/README.md index 1ccf8a8..b89e462 100644 --- a/README.md +++ b/README.md @@ -7,7 +7,7 @@ ![CI Status](https://github.com/ethanuppal/cs3110_compiler/actions/workflows/ci.yaml/badge.svg) > "x86 is simple trust me bro" -> Last updated: 2024-05-16 13:25:30.792439 +> Last updated: 2024-05-16 13:46:39.281139 ``` $ ./main -h @@ -20,7 +20,6 @@ Usage: ./main [-h|-v] -v,--version prints version info -g,--gen only produces IR -O,--optimize runs optimizations --c,--compile only produces object files ``` ``` $ ./main -v diff --git a/lib/user/cli.ml b/bin/cli.ml similarity index 71% rename from lib/user/cli.ml rename to bin/cli.ml index 8928f03..4239cf6 100644 --- a/lib/user/cli.ml +++ b/bin/cli.ml @@ -1,7 +1,4 @@ -type flag = - | OnlyIR - | OnlyObject - | Optimize +open X86ISTMB type action = | Error of { msg : string } @@ -9,7 +6,7 @@ type action = | Version | Compile of { paths : string list; - flags : flag list; + flags : Driver.flag list; } type parse_result = { @@ -27,9 +24,8 @@ let parse args = List.iter (fun s -> match s with - | "-g" | "--gen" -> flags := OnlyIR :: !flags - | "-O" | "--optimize" -> flags := Optimize :: !flags - | "-c" | "--compile" -> flags := OnlyObject :: !flags + | "-g" | "--gen" -> flags := Driver.OnlyIR :: !flags + | "-O" | "--optimize" -> flags := Driver.Optimize :: !flags | _ -> paths := s :: !paths) args; Compile { paths = !paths; flags = !flags } diff --git a/lib/user/cli.mli b/bin/cli.mli similarity index 82% rename from lib/user/cli.mli rename to bin/cli.mli index 4a7c6a7..a5a24c5 100644 --- a/lib/user/cli.mli +++ b/bin/cli.mli @@ -1,8 +1,4 @@ -(** Compiler flags *) -type flag = - | OnlyIR - | OnlyObject - | Optimize +open X86ISTMB (** The various actions the program can take. *) type action = @@ -11,7 +7,7 @@ type action = | Version | Compile of { paths : string list; - flags : flag list; + flags : Driver.flag list; } (** The result of parsing CLI arguments. [prog] is the name/path of the running diff --git a/bin/main.ml b/bin/main.ml index ddc2623..40e3d1f 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1,3 +1,40 @@ open X86ISTMB -let () = Driver.main Sys.argv +let print_error = Printf.eprintf "error: %s" + +let print_help prog = + let open Printf in + printf "%s\n" Meta.get.description; + printf "\n"; + printf "Usage: %s [-h|-v]\n" prog; + printf " or: %s FILE [-g][-O]\n" prog; + printf "\n"; + printf "-h,--help prints this info\n"; + printf "-v,--version prints version info\n"; + printf "-g,--gen only produces IR\n"; + printf "-O,--optimize runs optimizations\n"; + ignore () + +let print_version () = + let open Printf in + printf "%s %s\n" Meta.get.name (Meta.Version.to_string Meta.get.version); + printf "\n"; + printf "Written by: %s\n" (String.concat ", " Meta.get.authors) + +let rec dispatch action prog = + match action with + | Cli.Help -> print_help prog + | Version -> print_version () + | Compile { paths; flags } -> ( + if List.is_empty paths then + dispatch (Error { msg = "expected at least one file name" }) prog + else + try Driver.compile paths flags None + with exn -> print_error (Printexc.to_string exn)) + | Error { msg } -> Printf.sprintf "%s\nuse %s -h\n" msg prog |> print_error + +let main args = + let parse = Cli.parse args in + dispatch parse.action parse.prog + +let () = main Sys.argv diff --git a/lib/user/meta.ml b/bin/meta.ml similarity index 100% rename from lib/user/meta.ml rename to bin/meta.ml diff --git a/lib/user/meta.mli b/bin/meta.mli similarity index 100% rename from lib/user/meta.mli rename to bin/meta.mli diff --git a/lib/backend/asm_clean.ml b/lib/backend/asmClean.ml similarity index 100% rename from lib/backend/asm_clean.ml rename to lib/backend/asmClean.ml diff --git a/lib/backend/asm_clean.mli b/lib/backend/asmClean.mli similarity index 100% rename from lib/backend/asm_clean.mli rename to lib/backend/asmClean.mli diff --git a/lib/backend/asm_emit.ml b/lib/backend/asmEmit.ml similarity index 96% rename from lib/backend/asm_emit.ml rename to lib/backend/asmEmit.ml index 2ea616f..f5da252 100644 --- a/lib/backend/asm_emit.ml +++ b/lib/backend/asmEmit.ml @@ -242,14 +242,14 @@ let emit_bb text_section data_section cfg regalloc param_ctx bb = Asm.Section.add text_section (Label (Asm.Label.make ~is_global:false ~is_external:false - (Basic_block.label_for bb))); - bb |> Basic_block.to_list + (BasicBlock.label_for bb))); + bb |> BasicBlock.to_list |> List.iter (emit_ir text_section data_section regalloc param_ctx); - match Basic_block.condition_of bb with + match BasicBlock.condition_of bb with | Never | Conditional (Constant 0) -> () | Always | Conditional (Constant _) -> let dest_bb = Cfg.take_branch cfg bb true |> Option.get in - Asm.Section.add text_section (Jmp (Label (Basic_block.label_for dest_bb))) + Asm.Section.add text_section (Jmp (Label (BasicBlock.label_for dest_bb))) | Conditional op -> ( let true_bb = Cfg.take_branch cfg bb true |> Option.get in let false_bb = Cfg.take_branch cfg bb false |> Option.get in @@ -258,9 +258,9 @@ let emit_bb text_section data_section cfg regalloc param_ctx bb = Asm.Section.add text_section (Cmp (emit_var regalloc var, Intermediate 0)); Asm.Section.add text_section - (Je (Label (Basic_block.label_for true_bb))); + (Je (Label (BasicBlock.label_for true_bb))); Asm.Section.add text_section - (Jmp (Label (Basic_block.label_for false_bb))) + (Jmp (Label (BasicBlock.label_for false_bb))) | Constant _ | StringLiteral _ -> failwith "failure") let emit_preamble ~text_section ~data_section:_ ffi_names decl_names = @@ -315,7 +315,7 @@ let emit_cfg ~text_section ~data_section cfg regalloc = (* now that we've set up the stack and saved callee-save registers, we can jump to the entrypoint. *) - Asm.Section.add text_section (Jmp (Label (Basic_block.label_for entry))); + Asm.Section.add text_section (Jmp (Label (BasicBlock.label_for entry))); (* we'll need a parameter passing context so that the GetParam IR can work *) let param_ctx = ParameterPassingContext.make () in diff --git a/lib/backend/asm_emit.mli b/lib/backend/asmEmit.mli similarity index 100% rename from lib/backend/asm_emit.mli rename to lib/backend/asmEmit.mli diff --git a/lib/backend/liveliness.ml b/lib/backend/liveliness.ml index 908696e..98f8a7c 100644 --- a/lib/backend/liveliness.ml +++ b/lib/backend/liveliness.ml @@ -39,7 +39,7 @@ module BasicBlockAnalysis = struct analysis let make bb = - Array.init (Basic_block.length_of bb) (fun _ -> + Array.init (BasicBlock.length_of bb) (fun _ -> { live_in = VariableSet.empty; live_out = None }) |> rep_ok @@ -81,7 +81,7 @@ end (** [apply_rules liveliness analysis cfg bb ir ir_index ~is_final] applies liveliness rules for instruction [ir] at index [ir_index] in basic block [bb], where [bb] is in [cfg] and has associated liveliness analysis - [analysis = IdMap.find liveliness (Basic_block.id_of bb)], and where + [analysis = IdMap.find liveliness (BasicBlock.id_of bb)], and where [is_final] if and only if [ir] is the final instruction in [bb], updating partial results in [liveliness] and returning whether any updates were made to liveliness information. *) @@ -108,7 +108,7 @@ let apply_rules liveliness analysis cfg bb ir ir_idx ~is_final = |> List.fold_left (fun acc (bb_succ, _) -> let incoming_live_partial = - IdMap.find liveliness (Basic_block.id_of bb_succ) + IdMap.find liveliness (BasicBlock.id_of bb_succ) |> BasicBlockAnalysis.live_in in VariableSet.union acc incoming_live_partial) @@ -136,12 +136,12 @@ let apply_rules liveliness analysis cfg bb ir ir_idx ~is_final = returning whether any updates were made to liveliness information. *) let pass work_list liveliness cfg bb = let result = ref false in - let analysis = IdMap.find liveliness (Basic_block.id_of bb) in - let ir_count = Basic_block.length_of bb in + let analysis = IdMap.find liveliness (BasicBlock.id_of bb) in + let ir_count = BasicBlock.length_of bb in for rev_i = 1 to ir_count do let i = ir_count - rev_i in result := - apply_rules liveliness analysis cfg bb (Basic_block.get_ir bb i) i + apply_rules liveliness analysis cfg bb (BasicBlock.get_ir bb i) i ~is_final:(rev_i = 1) || !result done; @@ -166,7 +166,7 @@ let analysis_of cfg = let liveliness = IdMap.create 16 in Cfg.iter (fun bb -> - IdMap.add liveliness (Basic_block.id_of bb) (BasicBlockAnalysis.make bb)) + IdMap.add liveliness (BasicBlock.id_of bb) (BasicBlockAnalysis.make bb)) cfg; let rec converge () = if iterate liveliness cfg then converge () in converge (); diff --git a/lib/backend/liveliness.mli b/lib/backend/liveliness.mli index 1c5a4fa..582378b 100644 --- a/lib/backend/liveliness.mli +++ b/lib/backend/liveliness.mli @@ -13,8 +13,8 @@ module BasicBlockAnalysis : sig (** [make bb] is an empty liveliness analysis for the basic block [bb]. It is guaranteed to never mutate or copy [bb] internally. - Requires: [Basic_block.length_of bb > 0]. *) - val make : Basic_block.t -> t + Requires: [BasicBlock.length_of bb > 0]. *) + val make : BasicBlock.t -> t (** [live_in analysis] is the set of variables live at the start of the the analyzed basic block. @@ -47,7 +47,7 @@ end (** [analysis_of cfg] is an association between the basic blocks in [cfg] and their liveliness analyses. In particular, let [a] be the result of this function and let [bb] be a basic block in [cfg] Then, - [Util.IdMap.find a (Basic_block.id_of bb)] is the liveliness analysis of + [Util.IdMap.find a (BasicBlock.id_of bb)] is the liveliness analysis of [bb]. Requires: every basic block in [cfg] has at least one IR instruction. *) diff --git a/lib/backend/regalloc/instrOrdering.ml b/lib/backend/regalloc/instrOrdering.ml index 2bbd8ea..1e5fca7 100644 --- a/lib/backend/regalloc/instrOrdering.ml +++ b/lib/backend/regalloc/instrOrdering.ml @@ -10,7 +10,7 @@ let make cfg = let n = ref 0 in Cfg.iter (fun bb -> - OrderMap.add map (Basic_block.id_of bb) !n; + OrderMap.add map (BasicBlock.id_of bb) !n; n := !n + 1) cfg; map diff --git a/lib/backend/regalloc/regalloc.ml b/lib/backend/regalloc/regalloc.ml index 65598f4..f1d6ff8 100644 --- a/lib/backend/regalloc/regalloc.ml +++ b/lib/backend/regalloc/regalloc.ml @@ -43,11 +43,11 @@ let live_intervals (cfg : Cfg.t) (liveliness : BBAnalysis.t IdMap.t) Cfg.iter (fun bb -> - let bb_id = Basic_block.id_of bb in + let bb_id = BasicBlock.id_of bb in let analysis = IdMap.find liveliness bb_id in - for instr_idx = 0 to Basic_block.length_of bb - 1 do + for instr_idx = 0 to BasicBlock.length_of bb - 1 do let live_set = BBAnalysis.live_before_instr analysis instr_idx in - let kill_var = Basic_block.get_ir bb instr_idx |> Ir.kill_of in + let kill_var = BasicBlock.get_ir bb instr_idx |> Ir.kill_of in let used_set = match kill_var with | Some var -> Liveliness.VariableSet.add var live_set diff --git a/lib/frontend/ir_gen.ml b/lib/frontend/irGen.ml similarity index 92% rename from lib/frontend/ir_gen.ml rename to lib/frontend/irGen.ml index 7d5ea31..a4af647 100644 --- a/lib/frontend/ir_gen.ml +++ b/lib/frontend/irGen.ml @@ -31,7 +31,7 @@ let rec generate_expr ctx cfg block expr = | Equals -> Ir.TestEqual (result, lhs_result, rhs_result) | _ -> failwith "not implemented" in - Basic_block.add_ir block ir_instr; + BasicBlock.add_ir block ir_instr; Operand.make_var result | Prefix { op; rhs; _ } -> let result = Variable.make () in @@ -44,12 +44,12 @@ let rec generate_expr ctx cfg block expr = | BitAnd -> Ir.Ref (result, rhs_result) | _ -> failwith "not implemented" in - Basic_block.add_ir block ir_instr; + BasicBlock.add_ir block ir_instr; Operand.make_var result | Call { name; args; _ } -> let call_result = Variable.make () in let arg_results = List.map (generate_expr ctx cfg block) args in - Basic_block.add_ir block (Ir.Call (call_result, name, arg_results)); + BasicBlock.add_ir block (Ir.Call (call_result, name, arg_results)); Operand.make_var call_result (** [generate_stmt ctx cfg block stmt] adds IR for [stmt] (and potentially more @@ -61,7 +61,7 @@ let rec generate_stmt ctx cfg block = function let result = generate_expr ctx cfg block expr in let result_var = Variable.make () in let assign = Ir.Assign (result_var, result) in - Basic_block.add_ir block assign; + BasicBlock.add_ir block assign; Context.insert ctx name result_var; block | Assignment (name, expr) -> @@ -70,7 +70,7 @@ let rec generate_stmt ctx cfg block = function Context.get ctx name |> get_or_else (UnboundVariable { name }) in let assign = Ir.Assign (result_var, result) in - Basic_block.add_ir block assign; + BasicBlock.add_ir block assign; block | If { cond; body } -> let cond_result = generate_expr ctx cfg block cond in @@ -90,7 +90,7 @@ let rec generate_stmt ctx cfg block = function failwith "not allowed" | Print expr -> let to_print = generate_expr ctx cfg block expr in - Basic_block.add_ir block (Ir.DebugPrint to_print); + BasicBlock.add_ir block (Ir.DebugPrint to_print); block | ExprStatement expr -> ignore (generate_expr ctx cfg block expr); @@ -99,8 +99,8 @@ let rec generate_stmt ctx cfg block = function (match expr_opt with | Some expr -> let to_return = generate_expr ctx cfg block expr in - Basic_block.add_ir block (Ir.Return (Some to_return)) - | None -> Basic_block.add_ir block (Ir.Return None)); + BasicBlock.add_ir block (Ir.Return (Some to_return)) + | None -> BasicBlock.add_ir block (Ir.Return None)); block | Namespace { name; contents } -> Context.push ctx; @@ -127,7 +127,7 @@ let rec generate_top_level ctx ffi_names_ref decl_names_ref stmt = let param_var = Variable.make () in Context.insert ctx param param_var; let entry = Cfg.entry_to cfg in - Basic_block.add_ir entry (Ir.GetParam param_var)) + BasicBlock.add_ir entry (Ir.GetParam param_var)) params; ignore (generate_stmt_lst ctx cfg (Cfg.entry_to cfg) body); [ cfg ] diff --git a/lib/frontend/ir_gen.mli b/lib/frontend/irGen.mli similarity index 100% rename from lib/frontend/ir_gen.mli rename to lib/frontend/irGen.mli diff --git a/lib/frontend/parse_lex.ml b/lib/frontend/parseLex.ml similarity index 100% rename from lib/frontend/parse_lex.ml rename to lib/frontend/parseLex.ml diff --git a/lib/frontend/parse_lex.mli b/lib/frontend/parseLex.mli similarity index 100% rename from lib/frontend/parse_lex.mli rename to lib/frontend/parseLex.mli diff --git a/lib/ir/basic_block.ml b/lib/ir/basicBlock.ml similarity index 97% rename from lib/ir/basic_block.ml rename to lib/ir/basicBlock.ml index 6a773d8..cdeef3e 100644 --- a/lib/ir/basic_block.ml +++ b/lib/ir/basicBlock.ml @@ -1,5 +1,3 @@ -(** TODO: needs tests *) - let bb_gen = Id.Gen.make () type t = { diff --git a/lib/ir/basic_block.mli b/lib/ir/basicBlock.mli similarity index 88% rename from lib/ir/basic_block.mli rename to lib/ir/basicBlock.mli index 8df7094..19c1ea6 100644 --- a/lib/ir/basic_block.mli +++ b/lib/ir/basicBlock.mli @@ -22,25 +22,25 @@ val add_ir : t -> Ir.t -> unit (** [get_ir bb idx] is the IR instruction at index [idx] in [bb]. - Requires: [Basic_block.length_of bb > idx]. *) + Requires: [BasicBlock.length_of bb > idx]. *) val get_ir : t -> int -> Ir.t (** [get_orig_idx bb idx] is the original index of the IR instruction at index [idx] in [bb]; this original index will never changed. - Requires: [Basic_block.length_of bb > idx]. *) + Requires: [BasicBlock.length_of bb > idx]. *) val get_orig_idx : t -> int -> int (** [set_ir bb idx ir] replaces the IR instruction at index [idx] in [bb] with [ir]. - Requires: [Basic_block.length_of bb > idx]. *) + Requires: [BasicBlock.length_of bb > idx]. *) val set_ir : t -> int -> Ir.t -> unit (** [rem_ir bb idx] removes the IR instruction at index [idx] in [bb], shifting all the subsequent indices/IR instructions backward. - Requires: [Basic_block.length_of bb > idx]. *) + Requires: [BasicBlock.length_of bb > idx]. *) val rem_ir : t -> int -> unit (** [to_list bb] are the IR operations in [bb] in order as a list. *) diff --git a/lib/ir/cfg/cfg.ml b/lib/ir/cfg/cfg.ml index 2220d97..28ace81 100644 --- a/lib/ir/cfg/cfg.ml +++ b/lib/ir/cfg/cfg.ml @@ -1,11 +1,11 @@ -module Graph = Digraph.Make (Basic_block) +module Graph = Digraph.Make (BasicBlock) (** RI: [entry] is in [graph] and has no in neighbors. A block in [graph] must have zero out neighbors if its condition is [Never], one if its condition is [Always], and two if its condition is [Conditional]. *) type t = { name : string list; - entry : Basic_block.t; + entry : BasicBlock.t; graph : bool Graph.t; } @@ -14,14 +14,14 @@ let rep_ok cfg = let vertices = Graph.vertices_of cfg.graph in if List.find_opt - (fun bb -> Basic_block.id_of bb = Basic_block.id_of cfg.entry) + (fun bb -> BasicBlock.id_of bb = BasicBlock.id_of cfg.entry) vertices = None then failwith "rep_ok"; List.iter (fun bb -> let out_degree = Graph.out_neighbors cfg.graph bb |> List.length in - match Basic_block.condition_of bb with + match BasicBlock.condition_of bb with | Never -> if out_degree <> 0 then failwith "rep_ok" | Always -> if out_degree <> 1 then failwith "rep_ok" | Conditional _ -> if out_degree <> 2 then failwith "rep_ok") @@ -30,7 +30,7 @@ let rep_ok cfg = let make name = let graph = Graph.empty () in - let entry = Basic_block.make () in + let entry = BasicBlock.make () in Graph.add_vertex graph entry; { name; entry; graph } |> rep_ok @@ -39,22 +39,22 @@ let entry_to { entry; _ } = entry let create_block cfg = let cfg = rep_ok cfg in - let block = Basic_block.make () in + let block = BasicBlock.make () in Graph.add_vertex cfg.graph block; block let insert_branch cfg block cond bt bf = let cfg = rep_ok cfg in - assert (Basic_block.condition_of block = Never); + assert (BasicBlock.condition_of block = Never); Graph.add_edge cfg.graph block true bt; Graph.add_edge cfg.graph block false bf; - Basic_block.set_condition block cond + BasicBlock.set_condition block cond let insert_unconditional cfg pred succ = let cfg = rep_ok cfg in - assert (Basic_block.condition_of pred = Never); + assert (BasicBlock.condition_of pred = Never); Graph.add_edge cfg.graph pred true succ; - Basic_block.set_condition pred Branch_condition.Always + BasicBlock.set_condition pred Branch_condition.Always let take_branch cfg bb cond = let cfg = rep_ok cfg in @@ -83,13 +83,13 @@ let to_string cfg = ^ ":\n" ^ (blocks_of cfg |> List.map (fun bb -> - let bb_string = Basic_block.to_string bb in + let bb_string = BasicBlock.to_string bb in let dest_strings = out_edges cfg bb |> List.map (fun (dest, cond) -> "\n " ^ (if cond then "true" else "false") - ^ " -> " ^ Basic_block.label_for dest) + ^ " -> " ^ BasicBlock.label_for dest) in bb_string ^ String.concat "" dest_strings) |> String.concat "\n") diff --git a/lib/ir/cfg/cfg.mli b/lib/ir/cfg/cfg.mli index 79895d5..94af65c 100644 --- a/lib/ir/cfg/cfg.mli +++ b/lib/ir/cfg/cfg.mli @@ -1,7 +1,7 @@ (** [t] is a control flow graph. Every basic block yielded through this API must only be modified with - through this API. In particular, all accessor functions in the [Basic_block] + through this API. In particular, all accessor functions in the [BasicBlock] module are permitted. Once the control flow graph generation is complete for a set of basic blocks, then it is permitted to modify the contents (but not the condition) of the basic blocks. *) @@ -18,14 +18,14 @@ val name_of : t -> string list Review the specification for [t] on the basic blocks yielded through this API. *) -val entry_to : t -> Basic_block.t +val entry_to : t -> BasicBlock.t (** [create_block cfg] is a new block added to [cfg] with no inputs and no outputs. Review the specification for [t] on the basic blocks yielded through this API. *) -val create_block : t -> Basic_block.t +val create_block : t -> BasicBlock.t (* TODO: can any of this be simplified by taking advantage of the type system? Especially the requirement on [cond]. *) @@ -41,10 +41,10 @@ val create_block : t -> Basic_block.t [block] must not already be followed by another block. *) val insert_branch : t -> - Basic_block.t -> + BasicBlock.t -> Branch_condition.t -> - Basic_block.t -> - Basic_block.t -> + BasicBlock.t -> + BasicBlock.t -> unit (** [insert_unconditional cfg pred succ] makes [succ] unconditionally follow @@ -55,7 +55,7 @@ val insert_branch : Requires: [pred] and [succ] must already be in the graph, and [pred] must not already be followed by another block. *) -val insert_unconditional : t -> Basic_block.t -> Basic_block.t -> unit +val insert_unconditional : t -> BasicBlock.t -> BasicBlock.t -> unit (** [take_branch cfg bb cond] is [Some bb2], where [bb2] is basic block branching from [bb] in [cfg] with branch condition [cond], or [None] if no @@ -63,27 +63,27 @@ val insert_unconditional : t -> Basic_block.t -> Basic_block.t -> unit Review the specification for [t] on the basic blocks yielded through this API. *) -val take_branch : t -> Basic_block.t -> bool -> Basic_block.t option +val take_branch : t -> BasicBlock.t -> bool -> BasicBlock.t option (** [blocks_of cfg] is a list of all blocks in [cfg]. *) -val blocks_of : t -> Basic_block.t list +val blocks_of : t -> BasicBlock.t list (** [edges_of cfg] is a list of all edges [(v1, b, v2)] in [cfg] where [v1] is the start block, [v2] is the destination block, and [b] indicates wheter [v2] follows [v1] when the condition of [v1] is true or false. *) -val edges_of : t -> (Basic_block.t * bool * Basic_block.t) list +val edges_of : t -> (BasicBlock.t * bool * BasicBlock.t) list (** [out_edges cfg block] is a list of edges from [block]. *) -val out_edges : t -> Basic_block.t -> (Basic_block.t * bool) list +val out_edges : t -> BasicBlock.t -> (BasicBlock.t * bool) list (** [in_edges cfg block] is a list of edges into [block]. *) -val in_edges : t -> Basic_block.t -> (Basic_block.t * bool) list +val in_edges : t -> BasicBlock.t -> (BasicBlock.t * bool) list (** [iter f cfg] calls [f] on every basic block in [cfg]. *) -val iter : (Basic_block.t -> unit) -> t -> unit +val iter : (BasicBlock.t -> unit) -> t -> unit (** [exit_points cfg] is a list of all blocks that exit the program in [cfg]. *) -val exit_points : t -> Basic_block.t list +val exit_points : t -> BasicBlock.t list (* TODO: pretty print *) diff --git a/lib/ir/ir_sim.ml b/lib/ir/irSim.ml similarity index 96% rename from lib/ir/ir_sim.ml rename to lib/ir/irSim.ml index 74e35c3..30c7fe3 100644 --- a/lib/ir/ir_sim.ml +++ b/lib/ir/irSim.ml @@ -37,7 +37,7 @@ let rec run_cfg simulator cfgs cfg = to access int as string" | Right str -> str in *) let rec run_aux bb = let should_exit = - Basic_block.to_list bb + BasicBlock.to_list bb |> List.fold_left (fun acc ir -> acc @@ -64,7 +64,7 @@ let rec run_cfg simulator cfgs cfg = (if eval oper1 = eval oper2 then Left 1 else Left 0); false | Ir.Ref _ | Ir.Deref _ -> - failwith "Ir_sim does not support pointers" + failwith "IrSim does not support pointers" | Ir.DebugPrint oper -> simulator.output <- simulator.output @@ -96,7 +96,7 @@ let rec run_cfg simulator cfgs cfg = in if not should_exit then let cond_opt = - match Basic_block.condition_of bb with + match BasicBlock.condition_of bb with | Always -> Some true | Never -> None | Conditional oper -> Some (eval_int oper <> 0) diff --git a/lib/ir/ir_sim.mli b/lib/ir/irSim.mli similarity index 100% rename from lib/ir/ir_sim.mli rename to lib/ir/irSim.mli diff --git a/lib/ir/pass.ml b/lib/ir/pass.ml index 6b3d0cf..6eb7131 100644 --- a/lib/ir/pass.ml +++ b/lib/ir/pass.ml @@ -1,5 +1,5 @@ type t = - | Basic of (Basic_block.t * Liveliness.BasicBlockAnalysis.t -> unit) + | Basic of (BasicBlock.t * Liveliness.BasicBlockAnalysis.t -> unit) | Combine of t list | Repeat of t * int diff --git a/lib/ir/pass.mli b/lib/ir/pass.mli index 81eb8c7..941ed25 100644 --- a/lib/ir/pass.mli +++ b/lib/ir/pass.mli @@ -3,7 +3,7 @@ type t (** [make f] is a basic pass that runs a basic block and its liveliness analysis through [f]. *) -val make : (Basic_block.t * Liveliness.BasicBlockAnalysis.t -> unit) -> t +val make : (BasicBlock.t * Liveliness.BasicBlockAnalysis.t -> unit) -> t (** [sequence p1 p2] is a pass that first runs [p1] then [p2]. *) val sequence : t -> t -> t @@ -17,7 +17,7 @@ val repeat : int -> t -> t (** [execute pass block liveliness] runs [block] and its analysis [liveliness] through [pass]. [block] may be mutated. [liveliness] must correspond to the analysis of [block] in its current state. *) -val execute : t -> Basic_block.t -> Liveliness.BasicBlockAnalysis.t -> unit +val execute : t -> BasicBlock.t -> Liveliness.BasicBlockAnalysis.t -> unit (** A signature for modules that implement optimization passes. *) module type Sig = sig diff --git a/lib/ir/passes.ml b/lib/ir/passes.ml index c3246ec..ebbff89 100644 --- a/lib/ir/passes.ml +++ b/lib/ir/passes.ml @@ -1,12 +1,12 @@ module ConstFold : Pass.Sig = struct let const_fold (bb, _) = - for i = 0 to Basic_block.length_of bb - 1 do - match Basic_block.get_ir bb i with + for i = 0 to BasicBlock.length_of bb - 1 do + match BasicBlock.get_ir bb i with | Add (var, Operand.Constant lhs, Operand.Constant rhs) -> - Basic_block.set_ir bb i + BasicBlock.set_ir bb i (Ir.Assign (var, Operand.make_const (lhs + rhs))) | Sub (var, Operand.Constant lhs, Operand.Constant rhs) -> - Basic_block.set_ir bb i + BasicBlock.set_ir bb i (Ir.Assign (var, Operand.make_const (lhs - rhs))) | _ -> () done @@ -24,46 +24,27 @@ module CopyProp : Pass.Sig = struct | None -> Operand.make_var var) | oper -> oper in - for i = 0 to Basic_block.length_of bb - 1 do - match Basic_block.get_ir bb i with + for i = 0 to BasicBlock.length_of bb - 1 do + match BasicBlock.get_ir bb i with | Assign (var, oper) -> VariableMap.replace vals var oper; - Basic_block.set_ir bb i (Assign (var, subs oper)) + BasicBlock.set_ir bb i (Assign (var, subs oper)) | Add (var, oper1, oper2) -> - Basic_block.set_ir bb i (Add (var, subs oper1, subs oper2)) + BasicBlock.set_ir bb i (Add (var, subs oper1, subs oper2)) | Sub (var, oper1, oper2) -> - Basic_block.set_ir bb i (Sub (var, subs oper1, subs oper2)) + BasicBlock.set_ir bb i (Sub (var, subs oper1, subs oper2)) | TestEqual (var, oper1, oper2) -> - Basic_block.set_ir bb i (TestEqual (var, subs oper1, subs oper2)) - | Ref (var, oper) -> Basic_block.set_ir bb i (Ref (var, subs oper)) - | Deref (var, oper) -> Basic_block.set_ir bb i (Deref (var, subs oper)) + BasicBlock.set_ir bb i (TestEqual (var, subs oper1, subs oper2)) + | Ref (var, oper) -> BasicBlock.set_ir bb i (Ref (var, subs oper)) + | Deref (var, oper) -> BasicBlock.set_ir bb i (Deref (var, subs oper)) | _ -> () done let pass = Pass.make copy_prop end -module DeadCode : Pass.Sig = struct - let dead_code (bb, analysis) = - let length = Basic_block.length_of bb in - for rev_i = 0 to Basic_block.length_of bb - 1 do - let i = length - rev_i - 1 in - let live_out = - Liveliness.BasicBlockAnalysis.live_after_instr analysis - (Basic_block.get_orig_idx bb i) - in - match Basic_block.get_ir bb i |> Ir.kill_of with - | Some var -> - if not (Liveliness.VariableSet.mem var live_out) then - Basic_block.rem_ir bb i - | None -> () - done - - let pass = Pass.make dead_code -end - let apply passes cfg liveliness = let apply_pass pass bb = - Pass.execute pass bb (IdMap.find liveliness (Basic_block.id_of bb)) + Pass.execute pass bb (IdMap.find liveliness (BasicBlock.id_of bb)) in passes |> List.iter (fun pass -> Cfg.iter (apply_pass pass) cfg) diff --git a/lib/ir/passes.mli b/lib/ir/passes.mli index ce80db3..3b43611 100644 --- a/lib/ir/passes.mli +++ b/lib/ir/passes.mli @@ -4,9 +4,6 @@ module ConstFold : Pass.Sig (** Copy propagation optimization pass. *) module CopyProp : Pass.Sig -(** Dead code elimination optimization pass. *) -module DeadCode : Pass.Sig - (** [apply passes cfg liveliness] applies each pass in [passes] to [cfg] in order, using the liveliness information for [cfg] ([liveliness]). diff --git a/lib/user/driver.ml b/lib/user/driver.ml index ff6f437..87ebaa1 100644 --- a/lib/user/driver.ml +++ b/lib/user/driver.ml @@ -1,24 +1,6 @@ -let print_error = Printf.eprintf "error: %s" - -let print_help prog = - let open Printf in - printf "%s\n" Meta.get.description; - printf "\n"; - printf "Usage: %s [-h|-v]\n" prog; - printf " or: %s FILE [-g][-O]\n" prog; - printf "\n"; - printf "-h,--help prints this info\n"; - printf "-v,--version prints version info\n"; - printf "-g,--gen only produces IR\n"; - printf "-O,--optimize runs optimizations\n"; - printf "-c,--compile only produces object files\n"; - ignore () - -let print_version () = - let open Printf in - printf "%s %s\n" Meta.get.name (Meta.Version.to_string Meta.get.version); - printf "\n"; - printf "Written by: %s\n" (String.concat ", " Meta.get.authors) +type flag = + | OnlyIR + | Optimize let compile paths flags build_dir_loc = List.iter @@ -28,32 +10,31 @@ let compile paths flags build_dir_loc = && not (String.ends_with path ~suffix:".x") then failwith "please use .x or .x86istmb file extensions") paths; - let do_opts = List.mem Cli.Optimize flags in + let do_opts = List.mem Optimize flags in let preamble_source = Util.read_file (Util.merge_paths [ Project_root.path; "lib/runtime/preamble.x" ]) in let preamble_statements = - Parse_lex.lex_and_parse ~filename:"preamble.x" preamble_source + ParseLex.lex_and_parse ~filename:"preamble.x" preamble_source in let compile_one preamble_statements source_path = Printf.printf "==> \x1B[32mCompiling \x1B[4m%s\x1B[m\n" source_path; let source = Util.read_file source_path in let statements = - preamble_statements @ Parse_lex.lex_and_parse ~filename:source_path source + preamble_statements @ ParseLex.lex_and_parse ~filename:source_path source in Analysis.infer statements; - let cfgs, ffi_names, decl_names = Ir_gen.generate statements in + let cfgs, ffi_names, decl_names = IrGen.generate statements in let text_section = Asm.Section.make "text" 16 in let data_section = Asm.Section.make "data" 16 in - Asm_emit.emit_preamble ~text_section ~data_section ffi_names decl_names; + AsmEmit.emit_preamble ~text_section ~data_section ffi_names decl_names; List.iter (fun cfg -> let liveliness_analysis = Liveliness.analysis_of cfg in if do_opts then Passes.apply [ - Passes.DeadCode.pass; Pass.sequence Passes.CopyProp.pass Passes.ConstFold.pass |> Pass.repeat 10; ] @@ -70,9 +51,9 @@ let compile paths flags build_dir_loc = let regalloc = Regalloc.allocate_for cfg registers liveliness_analysis instr_ordering in - Asm_emit.emit_cfg ~text_section ~data_section cfg regalloc) + AsmEmit.emit_cfg ~text_section ~data_section cfg regalloc) cfgs; - Asm_clean.clean text_section; + if do_opts then AsmClean.clean text_section; let asm_file = Asm.AssemblyFile.make () in Asm.AssemblyFile.add asm_file text_section; Asm.AssemblyFile.add asm_file data_section; @@ -86,36 +67,41 @@ let compile paths flags build_dir_loc = Printf.printf "\x1B[2m[DEBUG] ignores some flags but -O works\x1B[m\n"; - try - let compiled_files = - compile_one [] - (Util.merge_paths [ Project_root.path; "lib/runtime/linkonce.x" ]) - :: List.map (compile_one preamble_statements) paths - in + let compiled_files = + compile_one [] + (Util.merge_paths [ Project_root.path; "lib/runtime/linkonce.x" ]) + :: List.map (compile_one preamble_statements) paths + in - (* Set up build directory *) - let build_dir = - Util.merge_paths - [ - (match build_dir_loc with - | Some loc -> loc - | None -> "."); - "build_dir"; - ] - in - if Sys.command (Printf.sprintf "mkdir -p %s" build_dir) <> 0 then - failwith "Could not create folder build_dir/ in current directory."; - if Sys.command (Printf.sprintf "rm -f %s/*" build_dir) <> 0 then - failwith "Could not remove old build_dir/ contents."; - Sys.chdir build_dir; + (* Set up build directory *) + let build_dir = + Util.merge_paths + [ + (match build_dir_loc with + | Some loc -> loc + | None -> "."); + "build_dir"; + ] + in + if Sys.command (Printf.sprintf "mkdir -p %s" build_dir) <> 0 then + failwith "Could not create folder build_dir/ in current directory."; + if Sys.command (Printf.sprintf "rm -f %s/*" build_dir) <> 0 then + failwith "Could not remove old build_dir/ contents."; + Sys.chdir build_dir; - let platform = Platform.get_platform () in + let platform = Platform.get_platform () in + (* Write IR *) + List.iter + (fun (ir_file_name, cfgs, _, _) -> + Util.write_file ir_file_name + (cfgs |> List.map Cfg.to_string |> String.concat "\n\n")) + compiled_files; + + if not (List.mem OnlyIR flags) then ( (* Write NASM *) List.iter - (fun (ir_file_name, cfgs, asm_file_name, asm_file) -> - Util.write_file ir_file_name - (cfgs |> List.map Cfg.to_string |> String.concat "\n\n"); + (fun (_, _, asm_file_name, asm_file) -> Util.write_file asm_file_name (Asm.AssemblyFile.to_nasm asm_file)) compiled_files; @@ -168,26 +154,12 @@ let compile paths flags build_dir_loc = Printf.sprintf "clang -D%s -target %s *.o %s/* -o a.out" define clang_target runtime_lib_loc in - print_endline clang_command; - if Sys.command clang_command <> 0 then failwith "Failed to run clang."; + if Sys.command clang_command <> 0 then failwith "Failed to run clang."); + + Printf.printf "==> \x1B[32mWrote build files to \x1B[4m%s\x1B[m\n" build_dir; - Printf.printf "==> \x1B[32mWrote build files to \x1B[4m%s\x1B[m\n" build_dir; + if not (List.mem OnlyIR flags) then Printf.printf "==> \x1B[33mYou can run the executable with \x1B[3m%s%s\x1B[m\n" (Platform.command_prefix platform) (Util.merge_paths [ build_dir; "a.out" ]) - with Parse_lex.ParserError msg -> print_error (msg ^ "\n") - -let rec dispatch action prog = - match action with - | Cli.Help -> print_help prog - | Version -> print_version () - | Compile { paths; flags } -> - if List.is_empty paths then - dispatch (Error { msg = "expected at least one file name" }) prog - else compile paths flags None - | Error { msg } -> Printf.sprintf "%s\nuse %s -h\n" msg prog |> print_error - -let main args = - let parse = Cli.parse args in - dispatch parse.action parse.prog diff --git a/lib/user/driver.mli b/lib/user/driver.mli index e1180aa..d33fe94 100644 --- a/lib/user/driver.mli +++ b/lib/user/driver.mli @@ -1,5 +1,6 @@ -(** [main argv] *) -val main : string array -> unit +type flag = + | OnlyIR + | Optimize (** [compile paths flags build_dir_loc] *) -val compile : string list -> Cli.flag list -> string option -> unit +val compile : string list -> flag list -> string option -> unit diff --git a/readme.py b/readme.py index e1006c1..d3fcfa3 100644 --- a/readme.py +++ b/readme.py @@ -1,7 +1,7 @@ if __name__ == "__main__": import subprocess, os from datetime import datetime as dt - + def find_file_in_directory(filename, directory): for root, _, files in os.walk(directory): if filename in files: @@ -21,7 +21,7 @@ def put(var, text): put( "VERSION_NUM", subprocess.check_output( - f"opam exec -- ocaml -e '#use \"{find_file_in_directory('meta.ml', './lib')}\";; print_endline (Version.to_string get.version)'", + f"opam exec -- ocaml -e '#use \"{find_file_in_directory('meta.ml', './bin')}\";; print_endline (Version.to_string get.version)'", shell=True, text=True, ), diff --git a/test/printing_progs/0.x86istmb b/test/opt_tests/0.x86istmb similarity index 100% rename from test/printing_progs/0.x86istmb rename to test/opt_tests/0.x86istmb diff --git a/test/snapshot/snapshot.ml b/test/snapshot/snapshot.ml index 01e694d..a706eb3 100644 --- a/test/snapshot/snapshot.ml +++ b/test/snapshot/snapshot.ml @@ -38,7 +38,7 @@ let make_test_suite root suite (transform_f, speed) = "Using the given input transformer should yield matching output to the \ expected." expected actual - with Parse_lex.ParserError msg -> fail msg + with ParseLex.ParserError msg -> fail msg in let suite_name = Util.merge_paths [ root; suite ] in let snapshot_tests = diff --git a/test/snapshots/basic/IGNORE b/test/snapshots/basic/IGNORE deleted file mode 100644 index 882d8aa..0000000 --- a/test/snapshots/basic/IGNORE +++ /dev/null @@ -1 +0,0 @@ -shadow0 diff --git a/test/snapshots/basic/comment0.in b/test/snapshots/basic/comment0.in deleted file mode 100644 index e5894f1..0000000 --- a/test/snapshots/basic/comment0.in +++ /dev/null @@ -1,9 +0,0 @@ -func main() { - print 1 // this is a comment - - // this is a comment x2 - print 2 - - // this is another comment - print 3 -} diff --git a/test/snapshots/basic/comment0.out b/test/snapshots/basic/comment0.out deleted file mode 100644 index 01e79c3..0000000 --- a/test/snapshots/basic/comment0.out +++ /dev/null @@ -1,3 +0,0 @@ -1 -2 -3 diff --git a/test/snapshots/basic/shadow0.in b/test/snapshots/basic/shadow0.in deleted file mode 100644 index c4f504f..0000000 --- a/test/snapshots/basic/shadow0.in +++ /dev/null @@ -1,23 +0,0 @@ -func main() { - let x = 1 - let y = 2 - - - print x // 1 - print y // 2 - - // foo() - - print x // 1 - print y // 2 -} - - -func foo() { - print x // 1 - print y // 2 - let x = 3 - let y = 4 - print x // 3 - print y // 4 -} diff --git a/test/snapshots/basic/shadow0.out b/test/snapshots/basic/shadow0.out deleted file mode 100644 index d9ada9a..0000000 --- a/test/snapshots/basic/shadow0.out +++ /dev/null @@ -1,9 +0,0 @@ -1 -2 -1 -2 -3 -4 -1 -2 -this is all wrong diff --git a/test/test_e2e.ml b/test/test_e2e.ml index 39c4e35..50d8795 100644 --- a/test/test_e2e.ml +++ b/test/test_e2e.ml @@ -4,14 +4,9 @@ open Platform let e2e_root = Util.merge_paths [ Project_root.path; "test/e2e" ] -let command_prefix platform = - match (platform.os, platform.cpu_arch) with - | MacOS _, Arm -> "arch -x86_64" - | _ -> "" - -let make_e2e_test filename source () = +let e2e_test filename source flags () = let expected = Test_snapshots.ir_transform filename source in - Driver.compile [ filename ] [] (Some Test_bin.path); + Driver.compile [ filename ] flags (Some Test_bin.path); let actual = Util.get_command_output ((Platform.get_platform () |> command_prefix) @@ -20,10 +15,23 @@ let make_e2e_test filename source () = in (check string) "Compiled output should match IR simulator" expected actual -let test_suite = - ( "lib/backend/asm_emit.ml", - Sys.readdir e2e_root |> Array.to_list - |> List.map (fun filename -> - let path = Util.merge_paths [ e2e_root; filename ] in - test_case filename `Quick (make_e2e_test path (Util.read_file path))) - ) +let files = Sys.readdir e2e_root |> Array.to_list + +let unoptimized = + List.map + (fun filename -> + let path = Util.merge_paths [ e2e_root; filename ] in + let test_name = Printf.sprintf "%s (unoptimized)" filename in + test_case test_name `Quick (e2e_test path (Util.read_file path) [])) + files + +let optimized = + List.map + (fun filename -> + let path = Util.merge_paths [ e2e_root; filename ] in + let test_name = Printf.sprintf "%s (optimized)" filename in + test_case test_name `Quick + (e2e_test path (Util.read_file path) [ Driver.Optimize ])) + files + +let test_suite = ("lib/user/driver.ml", unoptimized @ optimized) diff --git a/test/test_liveliness.ml b/test/test_liveliness.ml index 2c422ce..fbe5edf 100644 --- a/test/test_liveliness.ml +++ b/test/test_liveliness.ml @@ -16,7 +16,7 @@ let one_instruction_test () = let i0 = Variable.make () in let i1 = Variable.make () in let i2 = Variable.make () in - Basic_block.add_ir bb (Ir.Add (i0, Operand.make_var i1, Operand.make_var i2)); + BasicBlock.add_ir bb (Ir.Add (i0, Operand.make_var i1, Operand.make_var i2)); let _, analysis = Liveliness.analysis_of cfg |> IdMap.to_seq |> List.of_seq |> List.hd in @@ -42,8 +42,8 @@ let two_instruction_test () = let i2 = Variable.make () in let i3 = Variable.make () in let i4 = Variable.make () in - Basic_block.add_ir bb (Ir.Add (i0, Operand.make_var i1, Operand.make_var i2)); - Basic_block.add_ir bb (Ir.Add (i4, Operand.make_var i1, Operand.make_var i3)); + BasicBlock.add_ir bb (Ir.Add (i0, Operand.make_var i1, Operand.make_var i2)); + BasicBlock.add_ir bb (Ir.Add (i4, Operand.make_var i1, Operand.make_var i3)); let _, analysis = Liveliness.analysis_of cfg |> IdMap.to_seq |> List.of_seq |> List.hd in @@ -81,8 +81,8 @@ let two_basic_block_test () = let i2 = Variable.make () in let i3 = Variable.make () in let i4 = Variable.make () in - Basic_block.add_ir bb (Ir.Add (i0, Operand.make_var i1, Operand.make_var i2)); - Basic_block.add_ir bb2 (Ir.Add (i0, Operand.make_var i3, Operand.make_var i4)); + BasicBlock.add_ir bb (Ir.Add (i0, Operand.make_var i1, Operand.make_var i2)); + BasicBlock.add_ir bb2 (Ir.Add (i0, Operand.make_var i3, Operand.make_var i4)); let analyses = Liveliness.analysis_of cfg |> IdMap.to_seq |> List.of_seq in (check int) "the liveliness analysis should have returned analyses for both basic \ @@ -96,7 +96,7 @@ let two_basic_block_test () = analyses; List.iter (fun (id, analysis) -> - if id = Basic_block.id_of bb then ( + if id = BasicBlock.id_of bb then ( (check bool) "variables are live if they are read from in this instruction and if \ they are live in the next instruction and not modified in this \ diff --git a/test/test_passes.ml b/test/test_passes.ml index ddc605f..bfd184a 100644 --- a/test/test_passes.ml +++ b/test/test_passes.ml @@ -4,20 +4,20 @@ open Alcotest let make_opts_test passes = let ir0_source = Util.read_file - (Util.merge_paths [ Project_root.path; "test/printing_progs/0.x86istmb" ]) + (Util.merge_paths [ Project_root.path; "test/opt_tests/0.x86istmb" ]) in - let statements = Parse_lex.lex_and_parse ir0_source in + let statements = ParseLex.lex_and_parse ir0_source in Analysis.infer statements; - let cfgs, _, _ = Ir_gen.generate statements in + let cfgs, _, _ = IrGen.generate statements in let main_cfg = List.hd cfgs in let liveliness_analysis = Liveliness.analysis_of main_cfg in - let simulator = Ir_sim.make () in - Ir_sim.run simulator [ main_cfg ]; - let unopt_output = Ir_sim.output_of simulator in + let simulator = IrSim.make () in + IrSim.run simulator [ main_cfg ]; + let unopt_output = IrSim.output_of simulator in Passes.apply passes main_cfg liveliness_analysis; - Ir_sim.clear_output simulator; - Ir_sim.run simulator [ main_cfg ]; - let opt_output = Ir_sim.output_of simulator in + IrSim.clear_output simulator; + IrSim.run simulator [ main_cfg ]; + let opt_output = IrSim.output_of simulator in (check string) "optimization should not change program behavior" unopt_output opt_output @@ -25,32 +25,15 @@ let fixed_ir_opts_tests = [ ([ Passes.ConstFold.pass ], "const fold ir opt"); ([ Passes.CopyProp.pass ], "copy prop ir opt"); - ([ Passes.DeadCode.pass ], "dead code ir opt"); - ( [ - Pass.combine - [ Passes.ConstFold.pass; Passes.CopyProp.pass; Passes.DeadCode.pass ]; - ], + ( [ Pass.combine [ Passes.ConstFold.pass; Passes.CopyProp.pass ] ], "combined ir opt" ); ( [ Pass.sequence Passes.ConstFold.pass Passes.CopyProp.pass |> Pass.repeat 10; - Passes.DeadCode.pass; ], "complex ir opt" ); ] |> List.map (fun (passes, name) -> test_case name `Quick (fun () -> make_opts_test passes)) -(* let qcheck_ir_opts () = let open QCheck in let test = let open QCheck.Gen in - let pass_options = [| Passes.ConstFold.pass; Passes.CopyProp.pass; - Passes.DeadCode.pass |] in let get_pass () = let* idx = int_bound - (Array.length pass_options) in pass_options.(idx) in let gen_pass () = let - rec gen_pass_aux temp pass = let* prob = float 1.0 in if prob < exp (-.temp) - then pass else let* mutation = int_bound 3 in (match mutation with | 0 -> - let* n = int_bound 10 in Pass.repeat n pass | 1 -> Pass.compose pass - (get_pass ()) | 2 -> Pass.combine pass :: Seq.unfold () | _ -> pass) |> - gen_pass_aux (temp +. 1.0) in gen_pass_aux 1.0 (get_pass ()) in let pass = - gen_pass () in make_opts_test [ pass ] in QCheck_alcotest.to_alcotest - ~long:true (Test.make ~name:"random ir opt passes" ~count:100 test) *) - let test_suite = ("lib/ir/passes.ml", fixed_ir_opts_tests) diff --git a/test/test_regalloc.ml b/test/test_regalloc.ml index e1367ff..9b80100 100644 --- a/test/test_regalloc.ml +++ b/test/test_regalloc.ml @@ -7,7 +7,7 @@ let allocations_same alloc1 alloc2 = | Regalloc.Spill loc1, Regalloc.Spill loc2 -> loc1 = loc2 | reg1, reg2 -> reg1 = reg2 -let add_ir_list bb lst = List.iter (Basic_block.add_ir bb) lst +let add_ir_list bb lst = List.iter (BasicBlock.add_ir bb) lst let basic_vars = let test () = @@ -112,11 +112,10 @@ let spill_special_case = (List.map (fun var -> Ir.Assign (var, Operand.make_const 0)) vars); (* switch last two vars to trigger optimized spill behavior *) - let bb_len = Basic_block.length_of entry in - let last_ir = Basic_block.get_ir entry (bb_len - 1) in - Basic_block.set_ir entry (bb_len - 1) - (Basic_block.get_ir entry (bb_len - 2)); - Basic_block.set_ir entry (bb_len - 2) last_ir; + let bb_len = BasicBlock.length_of entry in + let last_ir = BasicBlock.get_ir entry (bb_len - 1) in + BasicBlock.set_ir entry (bb_len - 1) (BasicBlock.get_ir entry (bb_len - 2)); + BasicBlock.set_ir entry (bb_len - 2) last_ir; add_ir_list entry (List.map (fun var -> Ir.DebugPrint (Operand.make_var var)) vars); diff --git a/test/test_snapshots.ml b/test/test_snapshots.ml index 7a2b535..82b6367 100644 --- a/test/test_snapshots.ml +++ b/test/test_snapshots.ml @@ -4,7 +4,7 @@ let type_suite = let transform filename input = let open X86ISTMB in try - let statements = Parse_lex.lex_and_parse ~filename input in + let statements = ParseLex.lex_and_parse ~filename input in Analysis.infer statements; statements |> List.map Ast.stmt_to_string |> String.concat "" with @@ -19,27 +19,23 @@ let type_suite = let ir_transform filename input = let open X86ISTMB in let open Util in - let statements = Parse_lex.lex_and_parse ~filename input in + let statements = ParseLex.lex_and_parse ~filename input in Analysis.infer statements; - let cfgs, _, _ = Ir_gen.generate statements in + let cfgs, _, _ = IrGen.generate statements in List.iter (Liveliness.analysis_of >> ignore) cfgs; - let simulator = Ir_sim.make () in - Ir_sim.run simulator cfgs; - Ir_sim.output_of simulator + let simulator = IrSim.make () in + IrSim.run simulator cfgs; + IrSim.output_of simulator let ir_suite = Snapshot.make_test_suite snapshots_root "ir" (ir_transform, `Quick) -(** not sure why this is separate from [ir_suite]. *) -let basic_suite = - Snapshot.make_test_suite snapshots_root "basic" (ir_transform, `Quick) - let parse_transform filename input = let open X86ISTMB in try - Parse_lex.lex_and_parse ~filename input |> ignore; + ParseLex.lex_and_parse ~filename input |> ignore; "" - with Parse_lex.ParserError err -> err ^ "\n" + with ParseLex.ParserError err -> err ^ "\n" let parse_suite = Snapshot.make_test_suite snapshots_root "parse" (parse_transform, `Quick) diff --git a/test/test_x86ISTMB.ml b/test/test_x86ISTMB.ml index 7f8092f..8430d35 100644 --- a/test/test_x86ISTMB.ml +++ b/test/test_x86ISTMB.ml @@ -4,7 +4,6 @@ let () = Test_id.test_suite; Test_snapshots.ir_suite; Test_snapshots.type_suite; - Test_snapshots.basic_suite; Test_snapshots.parse_suite; Test_liveliness.test_suite; Test_e2e.test_suite;