Add parameters (not returns), only up to reg limit

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

lib/backend/asm_emit.ml

@@ -1,3 +1,23 @@
+module ParameterPassingContext = struct
+  type t = {
+    mutable pos : int;
+    mutable regs : Asm.Register.t list;
+  }
+
+  let make () = { pos = 0; regs = Asm.Register.parameter_passing_registers }
+
+  let get_next ctx =
+    if List.is_empty ctx.regs then (
+      let pos = ctx.pos in
+      ctx.pos <- ctx.pos + 1;
+      ignore pos;
+      failwith "i think should return spill with negative index")
+    else
+      let result = List.hd ctx.regs in
+      ctx.regs <- List.tl ctx.regs;
+      Regalloc.Register result
+end
+
 let mangle name =
   let rec mangle_helper = function
     | [ last ] -> "_S" ^ last
@@ -79,6 +99,12 @@ let emit_ir text regalloc = function
   | Call (var, name, args) ->
       emit_call text regalloc (mangle name) args;
       Asm.Section.add text (Mov (emit_var regalloc var, Register RAX))
+  | GetParam var -> (
+      let param_passing = ParameterPassingContext.make () in
+      match ParameterPassingContext.get_next param_passing with
+      | Register dest ->
+          Asm.Section.add text (Mov (emit_var regalloc var, Register dest))
+      | Spill _ -> failwith "todo")
   | Return op_opt ->
       Option.map
         (fun op ->

lib/backend/liveliness.ml

@@ -140,6 +140,7 @@ let apply_rules liveliness analysis cfg bb ir ir_idx ~is_final =
   | Call (var, _, args) ->
       write_var var;
       List.iter read_op args
+  | GetParam var -> write_var var
   | Return opt_op -> Option.map read_op opt_op |> ignore);
   check_for_changes ()
 

lib/dune

@@ -3,7 +3,7 @@
 (library
  (public_name x86ISTMB)
  (name x86ISTMB)
- (libraries batteries menhirLib)
+ (libraries batteries menhirLib ANSITerminal)
  (preprocess
   (pps ppx_inline_test))
  (instrumentation

lib/frontend/analysis.ml

@@ -163,18 +163,18 @@ let rec infer_expr (ctx : Type.t Context.t) expr =
             prefix.ty <- Some (Type.Pointer rhs_ty)
         | _ -> raise_error ())
     | Call call ->
+        let name = call.name |> String.concat "::" in
         let arg_tys = List.map (infer_expr ctx) call.args in
-        let exp_ty = get_type_of_name ctx call.name (Left expr) in
+        let exp_ty = get_type_of_name ctx name (Left expr) in
         let exp_params, exp_return =
           match exp_ty with
           | FunctionType { params; return } -> (params, return)
           | _ ->
               raise
-                (name_error call.name ~msg:"only functions can be called"
-                   (Left expr))
+                (name_error name ~msg:"only functions can be called" (Left expr))
         in
         if exp_params <> arg_tys then
-          raise (type_sig_error call.name arg_tys (Left expr));
+          raise (type_sig_error name arg_tys (Left expr));
         call.ty <- Some exp_return
   in
   infer_expr_aux expr;
@@ -251,14 +251,14 @@ and infer_body ctx return_ctx stmts =
 let rec infer_top_level ctx stmt =
   match stmt with
   | Namespace { name; contents } ->
-      Context.push ctx;
       Context.add_namespace ctx name;
       List.iter (infer_top_level ctx) contents;
-      Context.pop_namespace ctx;
-      Context.pop ctx
+      Context.pop_namespace ctx
   | Function { name; params; return; body } ->
       let fun_ty = Type.FunctionType { params = List.map snd params; return } in
-      bind_name_to_type ctx name fun_ty (Right stmt);
+      bind_name_to_type ctx
+        (Context.in_namespace ctx name |> String.concat "::")
+        fun_ty (Right stmt);
       Context.push ctx;
       List.iter
         (fun (name, ty) -> bind_name_to_type ctx name ty (Right stmt))

lib/frontend/ast.ml

@@ -31,7 +31,7 @@ type expr =
       mutable ty : Type.t option;
     }
   | Call of {
-      name : string;
+      name : string list;
       args : expr list;
       mutable ty : Type.t option;
     }
@@ -101,7 +101,10 @@ let rec expr_to_string = function
   | Prefix { op; rhs; ty = _ } ->
       "(" ^ op_to_string op ^ expr_to_string rhs ^ ")"
   | Call { name; args; ty = _ } ->
-      name ^ "(" ^ (args |> List.map expr_to_string |> String.concat ", ") ^ ")"
+      (name |> String.concat "::")
+      ^ "("
+      ^ (args |> List.map expr_to_string |> String.concat ", ")
+      ^ ")"
 
 let stmt_to_string =
   let add_indent = String.make 4 ' ' in

lib/frontend/ir_gen.ml

@@ -48,8 +48,7 @@ let rec generate_expr ctx cfg block expr =
   | 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, Context.in_namespace ctx name, arg_results));
+      Basic_block.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
@@ -116,11 +115,18 @@ and generate_stmt_lst ctx cfg block lst =
 
 let rec generate_top_level ctx stmt =
   match stmt with
-  | Function { name; params; return; body } ->
-      if not (List.is_empty params) then failwith "fix params in ir gen";
-      if return <> Type.unit_prim_type then failwith "fix return in ir gen";
+  | Function { name; params; return = _; body } ->
+      (* if not (List.is_empty params) then failwith "fix params in ir gen"; if
+         return <> Type.unit_prim_type then failwith "fix return in ir gen"; *)
       Context.push ctx;
       let cfg = Cfg.make (Context.in_namespace ctx name) in
+      List.iter
+        (fun (param, _) ->
+          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))
+        params;
       ignore (generate_stmt_lst ctx cfg (Cfg.entry_to cfg) body);
       [ cfg ]
   | Namespace { name; contents } ->

lib/frontend/lexer.mll

@@ -21,6 +21,7 @@ rule read = parse
 | ')' { RPAR }
 | '{' { LBRACE }
 | '}' { RBRACE }
+| "::" { SCOPE }
 | ':' { COLON }
 | ',' { COMMA }
 | "->" { ARROW }

lib/frontend/parse_lex.ml

@@ -1,5 +1,26 @@
 exception ParserError of string
 
+let function_auto_unit_return = function
+  | Ast.Function { name; params; return; body } ->
+      let last_stmt_is_return =
+        if List.is_empty body then false
+        else
+          match List.rev body |> List.hd with
+          | Ast.Return _ -> true
+          | _ -> false
+      in
+      Ast.Function
+        {
+          name;
+          params;
+          return;
+          body =
+            (if return = Type.unit_prim_type && not last_stmt_is_return then
+               body @ [ Return None ]
+             else body);
+        }
+  | other -> other
+
 (** [lex_and_parse ~filename:filename input] is the list of statements
     represented by the source code string [input]. Optionally,
     [~filename:filename] can be passed to indicate that the path of the source
@@ -23,23 +44,9 @@ let lex_and_parse ?(filename = "<stdin>") input =
   List.map
     (fun stmt ->
       match stmt with
-      | Ast.Function { name; params; return; body } ->
-          let last_stmt_is_return =
-            if List.is_empty body then false
-            else
-              match List.rev body |> List.hd with
-              | Ast.Return _ -> true
-              | _ -> false
-          in
-          Ast.Function
-            {
-              name;
-              params;
-              return;
-              body =
-                (if return = Type.unit_prim_type && not last_stmt_is_return then
-                   body @ [ Return None ]
-                 else body);
-            }
+      | Ast.Namespace { name; contents } ->
+          Ast.Namespace
+            { name; contents = List.map function_auto_unit_return contents }
+      | Ast.Function func -> function_auto_unit_return (Ast.Function func)
       | other -> other)
     prog

lib/frontend/parser.mly

@@ -6,7 +6,7 @@
 %token CONST_TRUE CONST_FALSE
 %token <string> IDEN
 %token PLUS MINUS TIMES DIVIDE MOD EQUALS BITAND
-%token LPAR RPAR LBRACE RBRACE COLON ARROW COMMA
+%token LPAR RPAR LBRACE RBRACE COLON ARROW COMMA SCOPE
 %token PRINT ASSIGN LET FUNC IF ELSE WHILE RETURN NAMESPACE
 %token NEWLINE EOF
 %token INT_TYPE BOOL_TYPE
@@ -49,7 +49,8 @@ expr:
   | PLUS expr { Prefix {op = Plus; rhs = $2; ty = None} }
   | MINUS expr { Prefix {op = Minus; rhs = $2; ty = None} }
   | TIMES expr { Prefix {op = Times; rhs = $2; ty = None} }
-  | name = IDEN; LPAR; args = separated_list(COMMA, expr); RPAR { Call { name; args; ty = None }}
+  | name = IDEN; LPAR; args = separated_list(COMMA, expr); RPAR { Call { name = [name]; args; ty = None }}
+  | name = IDEN; SCOPE; rest = separated_list(SCOPE, IDEN); LPAR; args = separated_list(COMMA, expr); RPAR { Call { name = name :: rest; args; ty = None } }
 
 body_till_rbrace:
   | NEWLINE body_till_rbrace { $2 } 

lib/ir/basic_block.ml

@@ -38,5 +38,7 @@ let to_string bb =
   ^ BatDynArray.fold_left
       (fun acc (ir, _) -> acc ^ "\n  " ^ Ir.to_string ir)
       "" bb.contents
-  ^ "\n  branch if "
-  ^ Branch_condition.to_string bb.condition
+  ^
+  if bb.condition <> Never then
+    "\n  branch if " ^ Branch_condition.to_string bb.condition
+  else ""

lib/ir/cfg/cfg.ml

@@ -78,7 +78,7 @@ let exit_points cfg =
   List.filter (fun v -> Graph.out_neighbors cfg.graph v = []) vertices
 
 let to_string cfg =
-  "_"
+  "func "
   ^ (cfg.name |> String.concat "::")
   ^ ":\n"
   ^ (blocks_of cfg

lib/ir/ir.ml

@@ -12,6 +12,7 @@ type t =
   | TestEqual of Variable.t * Operand.t * Operand.t
   | DebugPrint of Operand.t
   | Call of Variable.t * string list * Operand.t list
+  | GetParam of Variable.t
   | Return of Operand.t option
 
 (** [kill_of ir] is [Some var] if [var] is assigned to in [ir] and [None]
@@ -22,7 +23,8 @@ let kill_of = function
   | Sub (var, _, _)
   | Ref (var, _)
   | Deref (var, _)
-  | TestEqual (var, _, _) -> Some var
+  | TestEqual (var, _, _)
+  | GetParam var
   | Call (var, _, _) -> Some var
   | DebugPrint _ | Return _ -> None
 
@@ -44,11 +46,12 @@ let to_string =
   | TestEqual (r, o1, o2) ->
       sprintf "%s = %s == %s" (Variable.to_string r) (Operand.to_string o1)
         (Operand.to_string o2)
-  | DebugPrint op -> sprintf "debug_print %s" (Operand.to_string op)
+  | DebugPrint op -> sprintf "debug_print(%s)" (Operand.to_string op)
   | Call (r, name, args) ->
       sprintf "%s = %s(%s)" (Variable.to_string r)
         (name |> String.concat "::")
         (args |> List.map Operand.to_string |> String.concat ",")
+  | GetParam var -> sprintf "%s = <next parameter>" (Variable.to_string var)
   | Return op ->
       sprintf "return%s"
         (match op with

lib/ir/ir_sim.ml

@@ -1,16 +1,24 @@
 type t = {
   context : int Context.t;
   mutable current : Cfg.t option;
+  mutable args : int list list;
+  mutable return_value : int;
   mutable output : string;
 }
 
-let make () = { context = Context.make (); current = None; output = "" }
+let make () =
+  {
+    context = Context.make ();
+    current = None;
+    args = [];
+    return_value = 0;
+    output = "";
+  }
 
 let find_cfg_by_name cfgs name =
   List.find (fun cfg -> Cfg.name_of cfg = name) cfgs
 
 let rec run_cfg simulator cfgs cfg =
-  Context.push simulator.context;
   let entry = Cfg.entry_to cfg in
   let eval = function
     | Operand.Variable var ->
@@ -47,30 +55,49 @@ let rec run_cfg simulator cfgs cfg =
                  simulator.output <-
                    simulator.output ^ Printf.sprintf "%d\n" (eval oper);
                  false
-             | Ir.Call (_, name, _) ->
+             | Ir.Call (result, name, args) ->
                  let called_cfg = find_cfg_by_name cfgs name in
+                 simulator.args <- List.rev_map eval args :: simulator.args;
                  run_cfg simulator cfgs called_cfg;
+                 simulator.args <- List.tl simulator.args;
+                 Context.insert simulator.context
+                   (Variable.to_string result)
+                   simulator.return_value;
+                 false
+             | Ir.GetParam var ->
+                 let args = List.hd simulator.args in
+                 Context.insert simulator.context (Variable.to_string var)
+                   (List.hd args);
+                 simulator.args <- List.tl args :: List.tl simulator.args;
                  false
-             | Ir.Return _ -> true)
+             | Ir.Return oper_opt ->
+                 (match oper_opt with
+                 | Some oper -> simulator.return_value <- eval oper
+                 | None -> ());
+                 true)
            false
     in
     if not should_exit then
-      let cond =
+      let cond_opt =
         match Basic_block.condition_of bb with
-        | Always -> true
-        | Never -> false
-        | Conditional oper -> eval oper <> 0
+        | Always -> Some true
+        | Never -> None
+        | Conditional oper -> Some (eval oper <> 0)
       in
-      match Cfg.take_branch cfg bb cond with
-      | Some bb2 -> run_aux bb2
+      match cond_opt with
+      | Some cond -> (
+          match Cfg.take_branch cfg bb cond with
+          | Some bb2 -> run_aux bb2
+          | None -> ())
       | None -> ()
   in
-  run_aux entry;
-  Context.pop simulator.context
+  run_aux entry
 
 let run simulator cfgs =
+  Context.push simulator.context;
   let main_cfg = find_cfg_by_name cfgs [ "main" ] in
-  run_cfg simulator cfgs main_cfg
+  run_cfg simulator cfgs main_cfg;
+  Context.pop simulator.context
 
 let output_of simulator = simulator.output
 let clear_output simulator = simulator.output <- ""