Commits

camlspotter committed 590fd7b

enhancements

Comments (0)

Files changed (4)

     ptr <-- malloc ?name ?bzero (size_of lty);
     bitcast ptr (pointer lty)
 
-  let free ptr = Monad.ignore (call Module.External.free (Value.c1 ptr))
+  let free ptr = perform
+    ptr <-- bitcast ptr pointer_void;
+    Monad.ignore (call Module.External.free (Value.c1 ptr))
   ;;
 
   let unsafe_const_load ?name ptr indices = perform
     current_bb <-- Block.insertion;
     return (Block.parent current_bb)
 
-  let append_code_block name (vm : 'a v m) : (Llvm.llbasicblock * 'a v * Llvm.llbasicblock) m = perform
+  let append_code_block name (codegen : 'a m) : (Llvm.llbasicblock * 'a * Llvm.llbasicblock) m = perform
     the_function <-- current_function ();
     let bb = Block.append ~name the_function in
     (* Emit value. *)
     Block.position_at_end bb;
-    v <-- vm;
-    (* Codegen of [v] can change the current block, update bb for the phi. *)
+    res <-- codegen;
+    (* Codegen of [res] can change the current block, update bb for the phi. *)
     new_bb <-- Block.insertion;
-    return (bb, v, new_bb)
+    return (bb, res, new_bb)
 
   let uncond_br from to_ = perform
     Block.position_at_end from;
 
     return phi
 
+  let imp_if_then_else (lv_cond : i1 v m) (lv_then : unit m) (lv_else : unit m) : unit m = perform
+    (* get the current bb *)
+    start_bb <-- Block.insertion;
+
+    lv_cond <-- lv_cond; (* created in [start_bb] *)
+    (* before adding branching, we must create the destinations *)
+
+    (then_bb, (), new_then_bb) <-- append_code_block "then" lv_then;
+    (else_bb, (), new_else_bb) <-- append_code_block "else" lv_else;
+
+    (* merge_bb and new_merge_bb should be the same *)
+    (merge_bb, (), new_merge_bb) <-- append_code_block "ifcont" (return ());
+
+    (* Return to the start block to add the conditional branch. *)
+    Block.position_at_end start_bb;
+    cond_br lv_cond then_bb else_bb;
+
+    (* Set a unconditional branch at the end of the 'then' block and the
+     * 'else' block to the 'merge' block. *)
+    uncond_br new_then_bb merge_bb;
+    uncond_br new_else_bb merge_bb;
+
+    (* Finally, set the G.builder to the end of the merge block. *)
+    Block.position_at_end new_merge_bb;
+
+    return ()
+
   let for_loop 
       (init : 'a v) (* initialization of the loop variable of type 'a v *)
       (cond : 'a v -> i1 v m) (* test on the loop variable *)
 
   val memcpy : dst:void_pointer v -> src:void_pointer v -> size:i32 v -> void_pointer v m
   val bzero : void_pointer v -> size:i32 v -> unit m
-  val free : void_pointer v -> unit m
+  val free : 'a pointer v -> unit m
 
   val unsafe_const_load : ?name:string -> 'a pointer v -> int list -> 'unsafe v m
   val unsafe_const_store : 'a pointer v -> int list -> 'unsafe v -> unit m
       the exiting block. *)
 
   val if_then_else : i1 v m -> 'a v m -> 'a v m -> 'a v m
-  (** Not_found is raised if not defined in a function *)
+  (** Functional condition: Not_found is raised if not defined in a function. *)
+
+  val imp_if_then_else : i1 v m -> unit m -> unit m -> unit m
+  (** Imperative condition: Not_found is raised if not defined in a function. *)
 
   val for_loop : 
     'a v (* the init loop value *) 

llvm-ocamlfind/README.txt

 ocaml-llvm-phantom requires the LLVM OCaml binding is available as an OCamlFind package.
 install-META.sh in this directory creates an META for the binding and install it as 'llvm' automatically.
+
+Usage:
+  ./install-META.sh
     end
   
   let define_type_name n (t : 'a typ) = 
-    if Llvm.define_type_name n !:<t module_ then
-      match Llvm.type_by_name module_ n with
+    let name = A.name ^ "." ^ n in
+    if Llvm.define_type_name name !:<t module_ then
+      match Llvm.type_by_name module_ name with
       | Some t -> 
           let t = (Type.unsafe t : 'a typ) in
           Type.define_name ~modname:A.name n t;