Home | History | Annotate | Download | only in Chapter4 
      1 (*===----------------------------------------------------------------------===
      2  * Code Generation
      3  *===----------------------------------------------------------------------===*)
      4 
      5 open Llvm
      6 
      7 exception Error of string
      8 
      9 let context = global_context ()
     10 let the_module = create_module context "my cool jit"
     11 let builder = builder context
     12 let named_values:(string, llvalue) Hashtbl.t = Hashtbl.create 10
     13 let double_type = double_type context
     14 
     15 let rec codegen_expr = function
     16   | Ast.Number n -> const_float double_type n
     17   | Ast.Variable name ->
     18       (try Hashtbl.find named_values name with
     19         | Not_found -> raise (Error "unknown variable name"))
     20   | Ast.Binary (op, lhs, rhs) ->
     21       let lhs_val = codegen_expr lhs in
     22       let rhs_val = codegen_expr rhs in
     23       begin
     24         match op with
     25         | '+' -> build_fadd lhs_val rhs_val "addtmp" builder
     26         | '-' -> build_fsub lhs_val rhs_val "subtmp" builder
     27         | '*' -> build_fmul lhs_val rhs_val "multmp" builder
     28         | '<' ->
     29             (* Convert bool 0/1 to double 0.0 or 1.0 *)
     30             let i = build_fcmp Fcmp.Ult lhs_val rhs_val "cmptmp" builder in
     31             build_uitofp i double_type "booltmp" builder
     32         | _ -> raise (Error "invalid binary operator")
     33       end
     34   | Ast.Call (callee, args) ->
     35       (* Look up the name in the module table. *)
     36       let callee =
     37         match lookup_function callee the_module with
     38         | Some callee -> callee
     39         | None -> raise (Error "unknown function referenced")
     40       in
     41       let params = params callee in
     42 
     43       (* If argument mismatch error. *)
     44       if Array.length params == Array.length args then () else
     45         raise (Error "incorrect # arguments passed");
     46       let args = Array.map codegen_expr args in
     47       build_call callee args "calltmp" builder
     48 
     49 let codegen_proto = function
     50   | Ast.Prototype (name, args) ->
     51       (* Make the function type: double(double,double) etc. *)
     52       let doubles = Array.make (Array.length args) double_type in
     53       let ft = function_type double_type doubles in
     54       let f =
     55         match lookup_function name the_module with
     56         | None -> declare_function name ft the_module
     57 
     58         (* If 'f' conflicted, there was already something named 'name'. If it
     59          * has a body, don't allow redefinition or reextern. *)
     60         | Some f ->
     61             (* If 'f' already has a body, reject this. *)
     62             if block_begin f <> At_end f then
     63               raise (Error "redefinition of function");
     64 
     65             (* If 'f' took a different number of arguments, reject. *)
     66             if element_type (type_of f) <> ft then
     67               raise (Error "redefinition of function with different # args");
     68             f
     69       in
     70 
     71       (* Set names for all arguments. *)
     72       Array.iteri (fun i a ->
     73         let n = args.(i) in
     74         set_value_name n a;
     75         Hashtbl.add named_values n a;
     76       ) (params f);
     77       f
     78 
     79 let codegen_func the_fpm = function
     80   | Ast.Function (proto, body) ->
     81       Hashtbl.clear named_values;
     82       let the_function = codegen_proto proto in
     83 
     84       (* Create a new basic block to start insertion into. *)
     85       let bb = append_block context "entry" the_function in
     86       position_at_end bb builder;
     87 
     88       try
     89         let ret_val = codegen_expr body in
     90 
     91         (* Finish off the function. *)
     92         let _ = build_ret ret_val builder in
     93 
     94         (* Validate the generated code, checking for consistency. *)
     95         Llvm_analysis.assert_valid_function the_function;
     96 
     97         (* Optimize the function. *)
     98         let _ = PassManager.run_function the_function the_fpm in
     99 
    100         the_function
    101       with e ->
    102         delete_function the_function;
    103         raise e
    104