Add MLI Files (#43)

* Centralize IR maps

* Clean up and document regalloc

* Move register module to its own file

* Put things back in asm.ml and document

* Add mli for ast

* Add mli for parse_lex

* Add mli for type

* Add mli for branch_condition

* Add mli for IR

* Add mli for operand

* Add mli for passes

* Document variable

* Add mli for cli

* Add mli for meta

* Add mli for utilities

.ocamlinit

@@ -5,12 +5,3 @@ open X86ISTMB
 #install_printer Ast.pp_prog
 #install_printer Variable.pp
 #install_printer Id.pp
-
-let show_regalloc file =
-  let source = Util.read_file file in
-  let prog = Parse_lex.lex_and_parse source in
-  let cfg = Ir_gen.generate prog |> List.hd in
-  let liveliness = Liveliness.analysis_of cfg in
-  let ordering = InstrOrdering.make cfg in
-  print_endline (Cfg.to_string cfg);
-  Regalloc.allocate_for cfg liveliness ordering |> Regalloc.Ir.VariableMap.to_seq |> List.of_seq

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-15 13:54:50.602606
+> Last updated: 2024-05-15 16:42:39.370097
 
 ```
 $ ./main -h

lib/backend/asm.ml

@@ -50,7 +50,8 @@ module Register = struct
       stack and usually needs special care. *)
   let callee_saved_data_registers = [ RBX; R12; R13; R14; R15 ]
 
-  let parameter_passing_registers = [ RDI; RSI; RDX; RCX; R8; R9 ]
+  let data_registers = callee_saved_data_registers @ callee_saved_data_registers
+  let parameter_registers = [ RDI; RSI; RDX; RCX; R8; R9 ]
 end
 
 module Operand = struct
@@ -69,16 +70,7 @@ module Operand = struct
     | RelativeLabel rel_label -> "[rel " ^ rel_label ^ "]"
 end
 
-module Label : sig
-  type t
-
-  (** [make ~is_global:is_global, ~is_external:is_external name] is a label
-      named [name], global if and only if [is_global], and external if and only
-      if [is_external], but not both. *)
-  val make : is_global:bool -> is_external:bool -> string -> t
-
-  val to_nasm : t -> string
-end = struct
+module Label = struct
   type t = {
     is_global : bool;
     is_external : bool;
@@ -133,19 +125,7 @@ module Instruction = struct
     | Label label -> Label.to_nasm label
 end
 
-module Section : sig
-  (** Values of type [t] are assembly sections. *)
-  type t
-
-  (** `make name align` is new section with name [name] and alignment [align]. *)
-  val make : string -> int -> t
-
-  (** [add section instr] adds [instr] to the end of [section]. *)
-  val add : t -> Instruction.t -> unit
-
-  val add_all : t -> Instruction.t list -> unit
-  val to_nasm : t -> string
-end = struct
+module Section = struct
   type t = {
     name : string;
     align : int;
@@ -168,13 +148,7 @@ end = struct
     |> String.concat "\n"
 end
 
-module AssemblyFile : sig
-  type t
-
-  val make : unit -> t
-  val add : t -> Section.t -> unit
-  val to_nasm : t -> string
-end = struct
+module AssemblyFile = struct
   type t = Section.t BatDynArray.t
 
   let make () = BatDynArray.make 16

lib/backend/asm.mli

@@ -0,0 +1,127 @@
+(** Contains functionality for dealing with x86-64 registers. *)
+module Register : sig
+  (** Represents an x86-64 register. *)
+  type t =
+    | RAX
+    | RBX
+    | RCX
+    | RDX
+    | RBP
+    | RSP
+    | RSI
+    | RDI
+    | R8
+    | R9
+    | R10
+    | R11
+    | R12
+    | R13
+    | R14
+    | R15
+
+  (** [to_nasm reg] is the NASM representation of [reg]. *)
+  val to_nasm : t -> string
+
+  (** Provides an arbitrary ordering of registers. *)
+  val compare : t -> t -> int
+
+  (** Caller saved registers. rsp is excluded because it is used to manage the
+      stack and usually needs special care. *)
+  val caller_saved_data_registers : t list
+
+  (** Caller saved registers. rbp is excluded because it is used to manage the
+      stack and usually needs special care. *)
+  val callee_saved_data_registers : t list
+
+  (** All register that can be used to store general data. *)
+  val data_registers : t list
+
+  (** Register that can be used to pass parameters, in order of first parameter
+      to last parameter according to the System V ABI. *)
+  val parameter_registers : t list
+end
+
+(** Contains functionality for dealing with x86-64 operands. *)
+module Operand : sig
+  (** Represents an operand to an instruction. *)
+  type t =
+    | Register of Register.t
+    | Deref of Register.t * int
+    | Intermediate of int
+    | Label of string
+    | RelativeLabel of string
+
+  (** [to_nasm op] is the NASM representation of [op]. *)
+  val to_nasm : t -> string
+end
+
+(** Contains functionality for dealing with NASM block labels. *)
+module Label : sig
+  type t
+
+  (** [make ~is_global:is_global, ~is_external:is_external name] is a label
+      named [name], global if and only if [is_global], and external if and only
+      if [is_external], but not both. *)
+  val make : is_global:bool -> is_external:bool -> string -> t
+
+  (** [to_nasm label] is the NASM representation of [label]. *)
+  val to_nasm : t -> string
+end
+
+(** Contains functionality for dealing with x86-64 instructions. *)
+module Instruction : sig
+  (** Represents and x86-64 instruction. *)
+  type t =
+    | Mov of Operand.t * Operand.t
+    | Add of Operand.t * Operand.t
+    | Sub of Operand.t * Operand.t
+    | IMul of Operand.t
+    | Push of Operand.t
+    | Pop of Operand.t
+    | Call of Operand.t
+    | Cmp of Operand.t * Operand.t
+    | Jmp of Operand.t
+    | Je of Operand.t
+    | Jne of Operand.t
+    | Ret
+    | Syscall
+    | Label of Label.t
+
+  (** [to_nasm instr] is the NASM representation of [instr]. *)
+  val to_nasm : t -> string
+end
+
+(** Contains functionality for creating assembly sections. *)
+module Section : sig
+  (** Values of type [t] are assembly sections. *)
+  type t
+
+  (** `make name align` is new section with name [name] and alignment [align]. *)
+  val make : string -> int -> t
+
+  (** [add section instr] adds [instr] to the end of [section]. *)
+  val add : t -> Instruction.t -> unit
+
+  (** [add_all section instructions] adds all instructions in [instructions] to
+      [section] in order. It is equivalent to calling
+      [List.iter (Section.add section) instructions]*)
+  val add_all : t -> Instruction.t list -> unit
+
+  (** [to_nasm section] is the NASM representation of [section]. *)
+  val to_nasm : t -> string
+end
+
+(** Contains functionality for creating assembly files. *)
+module AssemblyFile : sig
+  (** Represents an assembly file containing many assembly sections. *)
+  type t
+
+  (** [make ()] is an empty assembly file with no sections. *)
+  val make : unit -> t
+
+  (** [add file section] adds [section] to [file]. *)
+  val add : t -> Section.t -> unit
+
+  (** [to_nasm file] is the NASM code for [file]. *)
+  val to_nasm : t -> string
+end

lib/backend/asm_emit.ml

@@ -4,7 +4,7 @@ module ParameterPassingContext = struct
     mutable regs : Asm.Register.t list;
   }
 
-  let make () = { pos = 0; regs = Asm.Register.parameter_passing_registers }
+  let make () = { pos = 0; regs = Asm.Register.parameter_registers }
 
   let get_next ctx =
     if List.is_empty ctx.regs then (
@@ -35,7 +35,7 @@ let align_offset bytes =
   if amount_over = 0 then 0 else stack_alignment - amount_over
 
 let emit_var regalloc var =
-  match Ir.VariableMap.find regalloc var with
+  match VariableMap.find regalloc var with
   | Regalloc.Register reg -> Asm.Operand.Register reg
   | Spill i -> Asm.Operand.Deref (RBP, (-var_size * i) - var_size)
 
@@ -70,7 +70,7 @@ let emit_restore_registers text registers =
 let emit_call text regalloc name args =
   emit_save_registers text Asm.Register.caller_saved_data_registers;
   let param_moves =
-    Util.zip_shortest args Asm.Register.parameter_passing_registers
+    Util.zip_shortest args Asm.Register.parameter_registers
     |> List.map (fun (arg, reg) ->
            Asm.Instruction.Mov (Register reg, emit_oper regalloc arg))
   in
@@ -143,7 +143,7 @@ let emit_preamble ~text =
 
 let emit_cfg ~text cfg regalloc =
   let max_spill =
-    Ir.VariableMap.fold
+    VariableMap.fold
       (fun _var alloc acc ->
         match alloc with
         | Regalloc.Spill count -> max count acc

lib/backend/asm_emit.mli

@@ -5,4 +5,4 @@ val emit_preamble : text:Asm.Section.t -> unit
 (** [emit ~text:text cfg regalloc] emits the function [cfg] with register
     allocation [regalloc] into the assembly code section [text]. *)
 val emit_cfg :
-  text:Asm.Section.t -> Cfg.t -> Regalloc.allocation Ir.VariableMap.t -> unit
+  text:Asm.Section.t -> Cfg.t -> Regalloc.allocation VariableMap.t -> unit

lib/backend/liveliness.ml

@@ -67,7 +67,7 @@ module BasicBlockAnalysis = struct
   let to_string analysis =
     let analysis = rep_ok analysis in
     "BasicBlockAnalysis {"
-    ^ (Seq.init (Array.length analysis) id
+    ^ (Seq.init (Array.length analysis) Fun.id
       |> List.of_seq
       |> List.map (fun i ->
              "\n  ir[" ^ string_of_int i ^ "] <=> {live_in = "

lib/backend/liveliness.mli

@@ -1,5 +1,3 @@
-open Util
-
 (** A value of type [VariableSet.t] is a set of IR variables. *)
 module VariableSet : sig
   include Set.S with type elt = Variable.t

lib/backend/regalloc/regalloc.ml

@@ -1,5 +1,3 @@
-open Util
-
 (* TODO: standardize instruction id? *)
 type instr_id = Id.t * int
 
@@ -19,15 +17,9 @@ type allocation =
 
 module BBAnalysis = Liveliness.BasicBlockAnalysis
 
-(* todo make this less awkward why are registers just listed here maybe pass em
-   in or smth *)
-let registers =
-  let open Asm.Register in
-  [ RAX; RBX; RCX; RDX; RSI; RDI; R8; R9; R10; R11; R12; R13; R14; R15 ]
-
 let live_intervals (cfg : Cfg.t) (liveliness : BBAnalysis.t IdMap.t)
     (ordering : InstrOrdering.t) =
-  let tbl = Ir.VariableMap.create 16 in
+  let tbl = VariableMap.create 16 in
 
   let expand_interval original live_id =
     let cmp = InstrOrdering.compare ordering in
@@ -39,13 +31,13 @@ let live_intervals (cfg : Cfg.t) (liveliness : BBAnalysis.t IdMap.t)
   let update_table instr_id used_set =
     Liveliness.VariableSet.iter
       (fun live ->
-        let current_opt = Ir.VariableMap.find_opt tbl live in
+        let current_opt = VariableMap.find_opt tbl live in
         let new_interval =
           match current_opt with
           | None -> { start = instr_id; stop = instr_id }
           | Some current -> expand_interval current instr_id
         in
-        Ir.VariableMap.replace tbl live new_interval)
+        VariableMap.replace tbl live new_interval)
       used_set
   in
 
@@ -65,18 +57,17 @@ let live_intervals (cfg : Cfg.t) (liveliness : BBAnalysis.t IdMap.t)
       done)
     cfg;
 
-  Ir.VariableMap.to_seq tbl |> List.of_seq
+  VariableMap.to_seq tbl |> List.of_seq
 
 (* Algorithm source:
    https://en.wikipedia.org/wiki/Register_allocation#Pseudocode *)
-let linear_scan (intervals : (Variable.t * interval) list)
-    (ordering : InstrOrdering.t) =
+let linear_scan intervals ordering registers =
   let compare_instr_id = InstrOrdering.compare ordering in
   let compare_pair_start (_, i1) (_, i2) = compare_instr_id i1.start i2.start in
   let compare_pair_end (_, i1) (_, i2) = compare_instr_id i1.stop i2.stop in
   let sorted_intervals = List.sort compare_pair_start intervals in
 
-  let assigned_alloc : allocation Ir.VariableMap.t = Ir.VariableMap.create 4 in
+  let assigned_alloc : allocation VariableMap.t = VariableMap.create 4 in
 
   let module RegSet = Set.Make (Asm.Register) in
   let free_registers : RegSet.t ref = ref (RegSet.of_list registers) in
@@ -97,7 +88,7 @@ let linear_scan (intervals : (Variable.t * interval) list)
       (fun (var, interval) ->
         let keep = compare_instr_id interval.stop current.start >= 0 in
         (if not keep then
-           let alloc = Ir.VariableMap.find assigned_alloc var in
+           let alloc = VariableMap.find assigned_alloc var in
            match alloc with
            | Register r -> free_registers := RegSet.add r !free_registers
            | Spill _ -> failwith "Interval in active cannot be spilled");
@@ -110,23 +101,22 @@ let linear_scan (intervals : (Variable.t * interval) list)
 
     if compare_instr_id spill_interval.stop interval.stop > 0 then (
       (* spill guaranteed to be assigned an actual register *)
-      let alloc = Ir.VariableMap.find assigned_alloc spill_var in
+      let alloc = VariableMap.find assigned_alloc spill_var in
       assert (
         match alloc with
         | Spill _ -> false
         | _ -> true);
 
-      Ir.VariableMap.replace assigned_alloc var alloc;
-      Ir.VariableMap.replace assigned_alloc spill_var
-        (Spill (next_spill_loc ()));
+      VariableMap.replace assigned_alloc var alloc;
+      VariableMap.replace assigned_alloc spill_var (Spill (next_spill_loc ()));
 
       (* this sucks. can we maybe keep active in reverse order? *)
       BatRefList.Index.remove_at active (BatRefList.length active - 1);
 
       (* add_sort is buggy... TODO: new impl *)
       BatRefList.push active (var, interval);
       BatRefList.sort ~cmp:compare_pair_end active)
-    else Ir.VariableMap.replace assigned_alloc var (Spill (next_spill_loc ()))
+    else VariableMap.replace assigned_alloc var (Spill (next_spill_loc ()))
   in
 
   List.iter
@@ -135,14 +125,14 @@ let linear_scan (intervals : (Variable.t * interval) list)
       match RegSet.choose_opt !free_registers with
       | Some register ->
           free_registers := RegSet.remove register !free_registers;
-          Ir.VariableMap.replace assigned_alloc var (Register register);
+          VariableMap.replace assigned_alloc var (Register register);
           BatRefList.push active (var, interval);
           BatRefList.sort ~cmp:compare_pair_end active
       | None -> spill_at_interval (var, interval))
     sorted_intervals;
 
   assigned_alloc
 
-let allocate_for cfg liveliness ordering =
+let allocate_for cfg registers liveliness ordering =
   let vars_with_intervals = live_intervals cfg liveliness ordering in
-  linear_scan vars_with_intervals ordering
+  linear_scan vars_with_intervals ordering registers