EMISSION

.gitignore

@@ -6,3 +6,6 @@ test/project_root.ml
 gitlog.txt
 docs/html/*
 !docs/html/.gitkeep
+build_dir/
+bin/*
+!bin/.gitkeep

.ocamlinit

@@ -13,4 +13,4 @@ let show_regalloc file =
   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.VarTbl.to_seq |> List.of_seq
+  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-10 22:08:20.895180
+> Last updated: 2024-05-11 01:56:28.147911
 
 ```
 $ ./main -h
@@ -48,9 +48,9 @@ Written by: Utku Melemeti, Ethan Uppal, Jeffrey Huang, Jason Klein, Vijay Shanmu
     - Abstract syntax tree
     - Type checking
 
-With some contributions from
-- Vijay Shanmugam (vrs29)
+With minor contributions from
 - Jason Klein (jak532)
+- Vijay Shanmugam (vrs29)
 
 ## Usage
 

README.md.template

@@ -31,9 +31,9 @@ $ ./main -v
     - Abstract syntax tree
     - Type checking
 
-With some contributions from
-- Vijay Shanmugam (vrs29)
+With minor contributions from
 - Jason Klein (jak532)
+- Vijay Shanmugam (vrs29)
 
 ## Usage
 

lib/backend/asm.ml

@@ -40,17 +40,22 @@ module Register = struct
     | R15 -> "r15"
 
   let compare = Stdlib.compare
+
+  (** Every register but RBX, RSP, RBP, and R12–R15. *)
+  let caller_saved = [ RAX; RCX; RDX; RSI; RDI; R8; R9; R10; R11 ]
 end
 
 module Operand = struct
   type t =
     | Register of Register.t
+    | Deref of Register.t * int
     | Intermediate of int
     | Label of string
     | RelativeLabel of string
 
   let to_nasm = function
     | Register reg -> Register.to_nasm reg
+    | Deref (reg, off) -> Printf.sprintf "[%s + %d]" (Register.to_nasm reg) off
     | Intermediate int -> string_of_int int
     | Label label -> label
     | RelativeLabel rel_label -> "[rel " ^ rel_label ^ "]"
@@ -76,10 +81,9 @@ end = struct
 
   let to_nasm label =
     match (label.is_global, label.is_external) with
-    | false, false -> label.name
-    | true, false -> "global " ^ label.name ^ "\n" ^ display_indent ^ label.name
-    | false, true ->
-        "external " ^ label.name ^ "\n" ^ display_indent ^ label.name
+    | false, false -> label.name ^ ":"
+    | true, false -> "global " ^ label.name ^ "\n" ^ label.name ^ ":"
+    | false, true -> "extern " ^ label.name
     | _ -> failwith "invalid label"
 end
 
@@ -131,6 +135,7 @@ module Section : sig
   (** [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
   type t = {
@@ -141,6 +146,7 @@ end = struct
 
   let make name align = { name; align; contents = BatDynArray.make 16 }
   let add section = BatDynArray.add section.contents
+  let add_all section instrs = List.iter (add section) instrs
 
   let to_nasm section =
     ("section ." ^ section.name)
@@ -157,11 +163,13 @@ end
 module AssemblyFile : sig
   type t
 
+  val make : unit -> t
   val add : t -> Section.t -> unit
   val to_nasm : t -> string
 end = struct
   type t = Section.t BatDynArray.t
 
+  let make () = BatDynArray.make 16
   let add = BatDynArray.add
 
   let to_nasm =

lib/backend/asm_emit.ml

@@ -1,12 +1,88 @@
-let emit_ir section =
-  ignore section;
-  failwith "i hate reg alloc"
-
-let emit_bb section cfg bb =
-  let ir = Basic_block.to_list bb in
-  let jumps = Cfg.out_edges cfg bb in
-  ignore jumps;
-  List.iter (emit_ir section) ir;
-  failwith "emit jumps"
-
-let emit section cfg = Cfg.blocks_of cfg |> List.iter (emit_bb section cfg)
+let debug_print_symbol = "_x86istmb_debug_print"
+
+let emit_var regalloc var =
+  match Ir.VariableMap.find regalloc var with
+  | Regalloc.Register reg -> Asm.Operand.Register reg
+  | Spill i -> Asm.Operand.Deref (RSP, i)
+
+let emit_oper regalloc = function
+  | Operand.Variable var -> emit_var regalloc var
+  | Constant int -> Asm.Operand.Intermediate int
+
+let emit_call text regalloc name args =
+  let to_save = Asm.Register.caller_saved in
+  let to_save =
+    if List.length to_save mod 2 = 0 then to_save
+    else List.hd to_save :: to_save
+  in
+  Asm.Section.add_all text
+    (List.map (fun r -> Asm.Instruction.Push (Register r)) to_save
+    @ [
+        (* double push for 16 byte alignment *)
+        Asm.Instruction.Mov (Register RDI, List.hd args |> emit_oper regalloc);
+        Call (Label name);
+      ]
+    @ (List.map (fun r -> Asm.Instruction.Pop (Register r)) to_save |> List.rev)
+    )
+
+(** *)
+let emit_ir text regalloc = function
+  | Ir.Assign (var, op) ->
+      Asm.Section.add text (Mov (emit_var regalloc var, emit_oper regalloc op))
+  | Add (var, op, op2) ->
+      Asm.Section.add_all text
+        [
+          Mov (emit_var regalloc var, emit_oper regalloc op);
+          Add (emit_var regalloc var, emit_oper regalloc op2);
+        ]
+  | Sub (var, op, op2) | TestEqual (var, op, op2) ->
+      Asm.Section.add_all text
+        [
+          Mov (emit_var regalloc var, emit_oper regalloc op);
+          Sub (emit_var regalloc var, emit_oper regalloc op2);
+        ]
+  | Ref _ -> failwith "ref not impl"
+  | Deref _ -> failwith "deref not impl"
+  | DebugPrint op -> emit_call text regalloc debug_print_symbol [ op ]
+  | Call _ -> failwith "TODO"
+  | Return op ->
+      Asm.Section.add text (Mov (Register RAX, emit_oper regalloc op))
+
+let emit_bb text cfg regalloc bb =
+  Asm.Section.add text
+    (Label
+       (Asm.Label.make ~is_global:false ~is_external:false
+          (Basic_block.label_for bb)));
+  bb |> Basic_block.to_list |> List.iter (emit_ir text regalloc);
+  match Basic_block.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 (Jmp (Label (Basic_block.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
+      match op with
+      | Variable var ->
+          Asm.Section.add text (Cmp (emit_var regalloc var, Intermediate 0));
+          Asm.Section.add text (Je (Label (Basic_block.label_for false_bb)));
+          Asm.Section.add text (Jmp (Label (Basic_block.label_for true_bb)))
+      | Constant _ -> failwith "failure")
+
+let emit_preamble ~text =
+  Asm.Section.add text
+    (Label
+       (Asm.Label.make ~is_global:false ~is_external:true debug_print_symbol))
+
+let emit_cfg ~text cfg regalloc =
+  Asm.Section.add_all text
+    [
+      Label
+        (Asm.Label.make ~is_global:true ~is_external:false
+           ("_x86istmb_" ^ Cfg.name_of cfg));
+      Push (Register RBP);
+      Mov (Register RBP, Register RSP);
+    ];
+  Cfg.blocks_of cfg |> List.iter (emit_bb text cfg regalloc);
+  Asm.Section.add_all text
+    [ Mov (Register RSP, Register RBP); Pop (Register RBP); Ret ]

lib/backend/asm_emit.mli

@@ -1,3 +1,8 @@
-(** [emit section cfg] emits the function [cfg] into the assembly section
-    [section]. *)
-val emit : Asm.Section.t -> Cfg.t -> unit
+(** [emit_preamble ~text:text] emits the x86istmb runtime preamble into the
+    assembly code section [text]. *)
+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

lib/backend/regalloc/regalloc.ml

@@ -1,5 +1,4 @@
 open Util
-module VarTbl = Hashtbl.Make (Variable)
 
 (* TODO: standardize instruction id? *)
 type instr_id = Id.t * int
@@ -16,7 +15,7 @@ type interval = {
 
 type allocation =
   | Register of Asm.Register.t
-  | Spill
+  | Spill of int
 
 module BBAnalysis = Liveliness.BasicBlockAnalysis
 
@@ -26,7 +25,7 @@ let registers =
 
 let live_intervals (cfg : Cfg.t) (liveliness : BBAnalysis.t IdMap.t)
     (ordering : InstrOrdering.t) =
-  let tbl = VarTbl.create 16 in
+  let tbl = Ir.VariableMap.create 16 in
 
   let expand_interval original live_id =
     let cmp = InstrOrdering.compare ordering in
@@ -38,13 +37,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 = VarTbl.find_opt tbl live in
+        let current_opt = Ir.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
-        VarTbl.replace tbl live new_interval)
+        Ir.VariableMap.replace tbl live new_interval)
       used_set
   in
 
@@ -64,7 +63,7 @@ let live_intervals (cfg : Cfg.t) (liveliness : BBAnalysis.t IdMap.t)
       done)
     cfg;
 
-  VarTbl.to_seq tbl |> List.of_seq
+  Ir.VariableMap.to_seq tbl |> List.of_seq
 
 (* Algorithm source:
    https://en.wikipedia.org/wiki/Register_allocation#Pseudocode *)
@@ -75,24 +74,31 @@ let linear_scan (intervals : (Variable.t * interval) list)
   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 VarTbl.t = VarTbl.create 4 in
+  let assigned_alloc : allocation Ir.VariableMap.t = Ir.VariableMap.create 4 in
 
   let module RegSet = Set.Make (Asm.Register) in
   let free_registers : RegSet.t ref = ref (RegSet.of_list registers) in
 
   (* must remain sorted by increasing end point *)
   let active : (Variable.t * interval) BatRefList.t = BatRefList.empty () in
 
+  let cur_loc = ref 0 in
+  let next_spill_loc () =
+    let result = !cur_loc in
+    cur_loc := !cur_loc + 8;
+    result
+  in
+
   let expire_old_intervals (current : interval) =
     (* this is also really annoying because BatRefList has no partition *)
     BatRefList.filter
       (fun (var, interval) ->
         let keep = compare_instr_id interval.stop current.start >= 0 in
         (if not keep then
-           let alloc = VarTbl.find assigned_alloc var in
+           let alloc = Ir.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");
+           | Spill _ -> failwith "Interval in active cannot be spilled");
         keep)
       active
   in
@@ -102,17 +108,23 @@ 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 = VarTbl.find assigned_alloc spill_var in
-      VarTbl.replace assigned_alloc var alloc;
-      VarTbl.replace assigned_alloc spill_var Spill;
+      let alloc = Ir.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 ()));
 
       (* 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 VarTbl.replace assigned_alloc var Spill
+    else Ir.VariableMap.replace assigned_alloc var (Spill (next_spill_loc ()))
   in
 
   List.iter
@@ -121,7 +133,7 @@ let linear_scan (intervals : (Variable.t * interval) list)
       match RegSet.choose_opt !free_registers with
       | Some register ->
           free_registers := RegSet.remove register !free_registers;
-          VarTbl.replace assigned_alloc var (Register register);
+          Ir.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))

lib/backend/regalloc/regalloc.mli

@@ -1,14 +1,13 @@
 open Util
-module VarTbl : Hashtbl.S with type key = Variable.t
 
 type allocation =
   | Register of Asm.Register.t
-  | Spill
+  | Spill of int
 
 val registers : Asm.Register.t list
 
 val allocate_for :
   Cfg.t ->
   Liveliness.BasicBlockAnalysis.t IdMap.t ->
   InstrOrdering.t ->
-  allocation VarTbl.t
+  allocation Ir.VariableMap.t