Chapter 4: Optimizer Support

Note: http://old.nabble.com/Linking-with-C-Library-td28133460.html explains how to get extern functions to actually link

Author: danluu

_tags

@@ -1,3 +1,4 @@
-"+llvm-2.8": include
 <{lexer,parser}.ml>: use_camlp4, pp(camlp4of)
 <*.{byte,native}>: g++, use_llvm, use_llvm_analysis
+<*.{byte,native}>: use_llvm_executionengine, use_llvm_target
+<*.{byte,native}>: use_llvm_scalar_opts, use_bindings

bindings.c

@@ -0,0 +1,7 @@
+#include <stdio.h>
+
+/* putchard - putchar that takes a double and returns 0. */
+extern double putchard(double X) {
+  putchar((char)X);
+  return 0;
+}

codegen.ml

@@ -24,7 +24,7 @@ let rec codegen_expr = function
       match op with
 				| '+' -> build_fadd lhs_val rhs_val "addtmp" builder
 				| '-' -> build_fsub lhs_val rhs_val "subtmp" builder
-				| '/' -> build_fsub lhs_val rhs_val "divtmp" builder
+				| '/' -> build_fdiv lhs_val rhs_val "divtmp" builder
 				| '*' -> build_fmul lhs_val rhs_val "multmp" builder
 				| '<' ->
             (* Convert bool 0/1 to double 0.0 or 1.0 *)
@@ -77,7 +77,7 @@ let codegen_proto = function
     ) (params f);
     f
 
-let codegen_func = function
+let codegen_func the_fpm = function
   | Ast.Function (proto, body) ->
     Hashtbl.clear named_values;
     let the_function = codegen_proto proto in
@@ -95,6 +95,9 @@ let codegen_func = function
         (* Validate the generated code, checking for consistency. *)
       Llvm_analysis.assert_valid_function the_function;
 
+        (* Optimize the function. *)
+      let _ = PassManager.run_function the_function the_fpm in
+
       the_function
     with e ->
       delete_function the_function;

myocamlbuild.ml

@@ -0,0 +1,10 @@
+open Ocamlbuild_plugin;;
+
+ocaml_lib ~extern:true "llvm";;
+ocaml_lib ~extern:true "llvm_analysis";;
+ocaml_lib ~extern:true "llvm_executionengine";;
+ocaml_lib ~extern:true "llvm_target";;
+ocaml_lib ~extern:true "llvm_scalar_opts";;
+
+flag ["link"; "ocaml"; "g++"] (S[A"-cc"; A"g++"; A"-cclib"; A"-rdynamic"]);
+dep ["link"; "ocaml"; "use_bindings"] ["bindings.o"];;

toplevel.ml

@@ -3,24 +3,25 @@
  *===----------------------------------------------------------------------===*)
 
 open Llvm
+open Llvm_executionengine
 
 (* top ::= definition | external | expression | ';' *)
-let rec main_loop stream =
+let rec main_loop the_fpm the_execution_engine stream =
   match Stream.peek stream with
 		| None -> ()
 
 		(* ignore top-level semicolons. *)
 		| Some (Token.Kwd ';') ->
       Stream.junk stream;
-      main_loop stream
+      main_loop the_fpm the_execution_engine stream
 
 		| Some token ->
       begin
         try match token with
 					| Token.Def ->
             let e = Parser.parse_definition stream in
             print_endline "parsed a function definition.";
-            dump_value (Codegen.codegen_func e);
+            dump_value (Codegen.codegen_func the_fpm e);
 					| Token.Extern ->
             let e = Parser.parse_extern stream in
             print_endline "parsed an extern.";
@@ -29,11 +30,20 @@ let rec main_loop stream =
             (* Evaluate a top-level expression into an anonymous function. *)
             let e = Parser.parse_toplevel stream in
             print_endline "parsed a top-level expr";
-            dump_value (Codegen.codegen_func e);
+            let the_function = Codegen.codegen_func the_fpm e in
+            dump_value the_function;
+
+            (* JIT the function, returning a function pointer. *)
+            let result = ExecutionEngine.run_function the_function [||]
+              the_execution_engine in
+
+            print_string "Evaluated to ";
+            print_float (GenericValue.as_float Codegen.double_type result);
+            print_newline ();
         with Stream.Error s | Codegen.Error s ->
           (* Skip token for error recovery. *)
           Stream.junk stream;
           print_endline s;
       end;
       print_string "ready> "; flush stdout;
-      main_loop stream
+      main_loop the_fpm the_execution_engine stream

toy.ml

@@ -4,6 +4,9 @@
  *===----------------------------------------------------------------------===*)
 
 open Llvm
+open Llvm_executionengine
+open Llvm_target
+open Llvm_scalar_opts
 
 let main () =
   (* Install standard binary operators.
@@ -18,8 +21,30 @@ let main () =
   print_string "ready> "; flush stdout;
   let stream = Lexer.lex (Stream.of_channel stdin) in
 
+  (* Create the JIT. *)
+  let the_execution_engine = ExecutionEngine.create Codegen.the_module in
+  let the_fpm = PassManager.create_function Codegen.the_module in
+
+  (* Set up the optimizer pipeline.  Start with registering info about how the
+   * target lays out data structures. *)
+  TargetData.add (ExecutionEngine.target_data the_execution_engine) the_fpm;
+
+  (* Do simple "peephole" optimizations and bit-twiddling optzn. *)
+  add_instruction_combination the_fpm;
+
+  (* reassociate expressions. *)
+  add_reassociation the_fpm;
+
+  (* Eliminate Common SubExpressions. *)
+  add_gvn the_fpm;
+
+  (* Simplify the control flow graph (deleting unreachable blocks, etc). *)
+  add_cfg_simplification the_fpm;
+
+  ignore (PassManager.initialize the_fpm);
+
   (* Run the main "interpreter loop" now. *)
-  Toplevel.main_loop stream;
+  Toplevel.main_loop the_fpm the_execution_engine stream;
 
   (* Print out all the generated code. *)
   dump_module Codegen.the_module