C and Objective Caml bindings for getFunction and getNamedGlobal. Also enhanced
authorGordon Henriksen <gordonhenriksen@mac.com>
Mon, 8 Oct 2007 03:45:09 +0000 (03:45 +0000)
committerGordon Henriksen <gordonhenriksen@mac.com>
Mon, 8 Oct 2007 03:45:09 +0000 (03:45 +0000)
the Objective Caml 'declare_*' functions to behave more or less like
getOrInsertFunction.

git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@42740 91177308-0d34-0410-b5e6-96231b3b80d8

bindings/ocaml/llvm/llvm.ml
bindings/ocaml/llvm/llvm.mli
bindings/ocaml/llvm/llvm_ocaml.c
include/llvm-c/Core.h
lib/VMCore/Core.cpp
test/Bindings/Ocaml/vmcore.ml

index 9766d83..779066b 100644 (file)
@@ -277,6 +277,8 @@ external declare_global : lltype -> string -> llmodule -> llvalue
                         = "llvm_declare_global"
 external define_global : string -> llvalue -> llmodule -> llvalue
                        = "llvm_define_global"
+external lookup_global : string -> llmodule -> llvalue option
+                       = "llvm_lookup_global"
 external delete_global : llvalue -> unit = "llvm_delete_global"
 external global_initializer : llvalue -> llvalue = "LLVMGetInitializer"
 external set_initializer : llvalue -> llvalue -> unit = "llvm_set_initializer"
@@ -289,6 +291,8 @@ external declare_function : string -> lltype -> llmodule -> llvalue
                           = "llvm_declare_function"
 external define_function : string -> lltype -> llmodule -> llvalue
                          = "llvm_define_function"
+external lookup_function : string -> llmodule -> llvalue option
+                         = "llvm_lookup_function"
 external delete_function : llvalue -> unit = "llvm_delete_function"
 external params : llvalue -> llvalue array = "llvm_params"
 external param : llvalue -> int -> llvalue = "llvm_param"
index ae37e9d..5e55b20 100644 (file)
@@ -260,6 +260,8 @@ external declare_global : lltype -> string -> llmodule -> llvalue
                         = "llvm_declare_global"
 external define_global : string -> llvalue -> llmodule -> llvalue
                        = "llvm_define_global"
+external lookup_global : string -> llmodule -> llvalue option
+                       = "llvm_lookup_global"
 external delete_global : llvalue -> unit = "llvm_delete_global"
 external global_initializer : llvalue -> llvalue = "LLVMGetInitializer"
 external set_initializer : llvalue -> llvalue -> unit = "llvm_set_initializer"
@@ -272,6 +274,8 @@ external declare_function : string -> lltype -> llmodule -> llvalue
                           = "llvm_declare_function"
 external define_function : string -> lltype -> llmodule -> llvalue
                          = "llvm_define_function"
+external lookup_function : string -> llmodule -> llvalue option
+                         = "llvm_lookup_function"
 external delete_function : llvalue -> unit = "llvm_delete_function"
 external params : llvalue -> llvalue array = "llvm_params"
 external param : llvalue -> int -> llvalue = "llvm_param"
index 61115f2..3eae5d9 100644 (file)
@@ -20,7 +20,7 @@
 #include "caml/custom.h"
 #include "caml/mlvalues.h"
 #include "caml/memory.h"
-#include "llvm/Config/config.h" 
+#include "llvm/Config/config.h"
 
 
 /*===-- Modules -----------------------------------------------------------===*/
@@ -402,9 +402,27 @@ CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) {
 /* lltype -> string -> llmodule -> llvalue */
 CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name,
                                           LLVMModuleRef M) {
+  LLVMValueRef GlobalVar;
+  if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
+    if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
+      return LLVMConstBitCast(GlobalVar, LLVMPointerType(Ty));
+    return GlobalVar;
+  }
   return LLVMAddGlobal(M, Ty, String_val(Name));
 }
 
+/* string -> llmodule -> llvalue option */
+CAMLprim value llvm_lookup_global(value Name, LLVMModuleRef M) {
+  CAMLparam1(Name);
+  LLVMValueRef GlobalVar;
+  if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
+    value Option = caml_alloc(1, 1);
+    Field(Option, 0) = (value) GlobalVar;
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
 /* string -> llvalue -> llmodule -> llvalue */
 CAMLprim LLVMValueRef llvm_define_global(value Name, LLVMValueRef Initializer,
                                          LLVMModuleRef M) {
@@ -461,9 +479,27 @@ CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) {
 /* string -> lltype -> llmodule -> llvalue */
 CAMLprim LLVMValueRef llvm_declare_function(value Name, LLVMTypeRef Ty,
                                             LLVMModuleRef M) {
+  LLVMValueRef Fn;
+  if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
+    if (LLVMGetElementType(LLVMTypeOf(Fn)) != Ty)
+      return LLVMConstBitCast(Fn, LLVMPointerType(Ty));
+    return Fn;
+  }
   return LLVMAddFunction(M, String_val(Name), Ty);
 }
 
+/* string -> llmodule -> llvalue option */
+CAMLprim value llvm_lookup_function(value Name, LLVMModuleRef M) {
+  CAMLparam1(Name);
+  LLVMValueRef Fn;
+  if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
+    value Option = caml_alloc(1, 1);
+    Field(Option, 0) = (value) Fn;
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
 /* string -> lltype -> llmodule -> llvalue */
 CAMLprim LLVMValueRef llvm_define_function(value Name, LLVMTypeRef Ty,
                                            LLVMModuleRef M) {
index 3f8961b..d8bff32 100644 (file)
@@ -318,6 +318,7 @@ void LLVMSetAlignment(LLVMValueRef Global, unsigned Bytes);
 
 /* Operations on global variables */
 LLVMValueRef LLVMAddGlobal(LLVMModuleRef M, LLVMTypeRef Ty, const char *Name);
+LLVMValueRef LLVMGetNamedGlobal(LLVMModuleRef M, const char *Name);
 void LLVMDeleteGlobal(LLVMValueRef GlobalVar);
 int LLVMHasInitializer(LLVMValueRef GlobalVar);
 LLVMValueRef LLVMGetInitializer(LLVMValueRef GlobalVar);
@@ -330,6 +331,7 @@ void LLVMSetGlobalConstant(LLVMValueRef GlobalVar, int IsConstant);
 /* Operations on functions */
 LLVMValueRef LLVMAddFunction(LLVMModuleRef M, const char *Name,
                              LLVMTypeRef FunctionTy);
+LLVMValueRef LLVMGetNamedFunction(LLVMModuleRef M, const char *Name);
 void LLVMDeleteFunction(LLVMValueRef Fn);
 unsigned LLVMCountParams(LLVMValueRef Fn);
 void LLVMGetParams(LLVMValueRef Fn, LLVMValueRef *Params);
index 66ab03c..bb55d4e 100644 (file)
@@ -532,6 +532,10 @@ LLVMValueRef LLVMAddGlobal(LLVMModuleRef M, LLVMTypeRef Ty, const char *Name) {
               GlobalValue::ExternalLinkage, 0, Name, unwrap(M)));
 }
 
+LLVMValueRef LLVMGetNamedGlobal(LLVMModuleRef M, const char *Name) {
+  return wrap(unwrap(M)->getNamedGlobal(Name));
+}
+
 void LLVMDeleteGlobal(LLVMValueRef GlobalVar) {
   unwrap<GlobalVariable>(GlobalVar)->eraseFromParent();
 }
@@ -576,6 +580,10 @@ LLVMValueRef LLVMAddFunction(LLVMModuleRef M, const char *Name,
                            GlobalValue::ExternalLinkage, Name, unwrap(M)));
 }
 
+LLVMValueRef LLVMGetNamedFunction(LLVMModuleRef M, const char *Name) {
+  return wrap(unwrap(M)->getFunction(Name));
+}
+
 void LLVMDeleteFunction(LLVMValueRef Fn) {
   unwrap<Function>(Fn)->eraseFromParent();
 }
index 8aa6e43..4280b1c 100644 (file)
@@ -393,8 +393,14 @@ let test_global_variables () =
   (* RUN: grep {GVar01.*external} < %t.ll
    *)
   group "declarations";
+  insist (None == lookup_global "GVar01" m);
   let g = declare_global i32_type "GVar01" m in
   insist (is_declaration g);
+  insist (pointer_type float_type ==
+            type_of (declare_global float_type "GVar01" m));
+  insist (g == declare_global i32_type "GVar01" m);
+  insist (match lookup_global "GVar01" m with Some x -> x = g
+                                            | None -> false);
   
   (* RUN: grep {GVar02.*42} < %t.ll
    * RUN: grep {GVar03.*42} < %t.ll
@@ -433,15 +439,21 @@ let test_global_variables () =
 
 let test_functions () =
   let ty = function_type i32_type [| i32_type; i64_type |] in
-  let pty = pointer_type ty in
+  let ty2 = function_type i8_type [| i8_type; i64_type |] in
   
   (* RUN: grep {declare i32 @Fn1\(i32, i64\)} < %t.ll
    *)
   group "declare";
+  insist (None = lookup_function "Fn1" m);
   let fn = declare_function "Fn1" ty m in
-  insist (pty = type_of fn);
+  insist (pointer_type ty = type_of fn);
   insist (is_declaration fn);
   insist (0 = Array.length (basic_blocks fn));
+  insist (pointer_type ty2 == type_of (declare_function "Fn1" ty2 m));
+  insist (fn == declare_function "Fn1" ty m);
+  insist (None <> lookup_function "Fn1" m);
+  insist (match lookup_function "Fn1" m with Some x -> x = fn
+                                           | None -> false);
   
   (* RUN: grep -v {Fn2} < %t.ll
    *)