From: Gordon Henriksen Date: Mon, 8 Oct 2007 03:45:09 +0000 (+0000) Subject: C and Objective Caml bindings for getFunction and getNamedGlobal. Also enhanced X-Git-Url: http://plrg.eecs.uci.edu/git/?a=commitdiff_plain;h=6d6203dff3560a2cc3ac8ec620ac3b105b0c7cc7;p=oota-llvm.git C and Objective Caml bindings for getFunction and getNamedGlobal. Also enhanced 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 --- diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index 9766d83810e..779066bddc1 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -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" diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli index ae37e9d02d7..5e55b200b17 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -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" diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index 61115f2c19a..3eae5d9f0ab 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -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) { diff --git a/include/llvm-c/Core.h b/include/llvm-c/Core.h index 3f8961b7651..d8bff3211a3 100644 --- a/include/llvm-c/Core.h +++ b/include/llvm-c/Core.h @@ -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); diff --git a/lib/VMCore/Core.cpp b/lib/VMCore/Core.cpp index 66ab03cb5e0..bb55d4e62b7 100644 --- a/lib/VMCore/Core.cpp +++ b/lib/VMCore/Core.cpp @@ -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(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(Fn)->eraseFromParent(); } diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml index 8aa6e43603e..4280b1c9f37 100644 --- a/test/Bindings/Ocaml/vmcore.ml +++ b/test/Bindings/Ocaml/vmcore.ml @@ -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 *)