[llvm-commits] [llvm] r42740 - in /llvm/trunk: 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
Gordon Henriksen
gordonhenriksen at mac.com
Sun Oct 7 20:45:09 PDT 2007
Author: gordon
Date: Sun Oct 7 22:45:09 2007
New Revision: 42740
URL: http://llvm.org/viewvc/llvm-project?rev=42740&view=rev
Log:
C and Objective Caml bindings for getFunction and getNamedGlobal. Also enhanced
the Objective Caml 'declare_*' functions to behave more or less like
getOrInsertFunction.
Modified:
llvm/trunk/bindings/ocaml/llvm/llvm.ml
llvm/trunk/bindings/ocaml/llvm/llvm.mli
llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c
llvm/trunk/include/llvm-c/Core.h
llvm/trunk/lib/VMCore/Core.cpp
llvm/trunk/test/Bindings/Ocaml/vmcore.ml
Modified: llvm/trunk/bindings/ocaml/llvm/llvm.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.ml?rev=42740&r1=42739&r2=42740&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.ml (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.ml Sun Oct 7 22:45:09 2007
@@ -277,6 +277,8 @@
= "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 @@
= "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"
Modified: llvm/trunk/bindings/ocaml/llvm/llvm.mli
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.mli?rev=42740&r1=42739&r2=42740&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.mli (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.mli Sun Oct 7 22:45:09 2007
@@ -260,6 +260,8 @@
= "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 @@
= "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"
Modified: llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c?rev=42740&r1=42739&r2=42740&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c Sun Oct 7 22:45:09 2007
@@ -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 @@
/* 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 @@
/* 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) {
Modified: llvm/trunk/include/llvm-c/Core.h
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/include/llvm-c/Core.h?rev=42740&r1=42739&r2=42740&view=diff
==============================================================================
--- llvm/trunk/include/llvm-c/Core.h (original)
+++ llvm/trunk/include/llvm-c/Core.h Sun Oct 7 22:45:09 2007
@@ -318,6 +318,7 @@
/* 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 @@
/* 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);
Modified: llvm/trunk/lib/VMCore/Core.cpp
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/lib/VMCore/Core.cpp?rev=42740&r1=42739&r2=42740&view=diff
==============================================================================
--- llvm/trunk/lib/VMCore/Core.cpp (original)
+++ llvm/trunk/lib/VMCore/Core.cpp Sun Oct 7 22:45:09 2007
@@ -532,6 +532,10 @@
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 @@
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();
}
Modified: llvm/trunk/test/Bindings/Ocaml/vmcore.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/vmcore.ml?rev=42740&r1=42739&r2=42740&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/vmcore.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/vmcore.ml Sun Oct 7 22:45:09 2007
@@ -393,8 +393,14 @@
(* 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_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
*)
More information about the llvm-commits
mailing list