X-Git-Url: http://plrg.eecs.uci.edu/git/?p=oota-llvm.git;a=blobdiff_plain;f=bindings%2Focaml%2Fexecutionengine%2Fexecutionengine_ocaml.c;h=c647d23133c3be504b942163212eba0ed4616a7b;hp=4b44a91066fe68ad7cced3013093e514e83a60f3;hb=b9f3251952c54b56cf9cd8f3dfb2bfbeb035b13d;hpb=aa5b9c0f6f3a99f955fe0ded13d61d7eb4e1a0b5 diff --git a/bindings/ocaml/executionengine/executionengine_ocaml.c b/bindings/ocaml/executionengine/executionengine_ocaml.c index 4b44a91066f..c647d23133c 100644 --- a/bindings/ocaml/executionengine/executionengine_ocaml.c +++ b/bindings/ocaml/executionengine/executionengine_ocaml.c @@ -15,50 +15,17 @@ |* *| \*===----------------------------------------------------------------------===*/ +#include +#include #include "llvm-c/ExecutionEngine.h" #include "llvm-c/Target.h" #include "caml/alloc.h" #include "caml/custom.h" #include "caml/fail.h" #include "caml/memory.h" -#include -#include - -/* Force the LLVM interpreter and JIT to be linked in. */ -void llvm_initialize(void) { - LLVMLinkInInterpreter(); - LLVMLinkInJIT(); -} - -/* unit -> bool */ -CAMLprim value llvm_initialize_native_target(value Unit) { - return Val_bool(LLVMInitializeNativeTarget()); -} - -/* Can't use the recommended caml_named_value mechanism for backwards - compatibility reasons. This is largely equivalent. */ -static value llvm_ee_error_exn; - -CAMLprim value llvm_register_ee_exns(value Error) { - llvm_ee_error_exn = Field(Error, 0); - register_global_root(&llvm_ee_error_exn); - return Val_unit; -} - -static void llvm_raise(value Prototype, char *Message) { - CAMLparam1(Prototype); - CAMLlocal1(CamlMessage); - - CamlMessage = copy_string(Message); - LLVMDisposeMessage(Message); - - raise_with_arg(Prototype, CamlMessage); - abort(); /* NOTREACHED */ -#ifdef CAMLnoreturn - CAMLnoreturn; /* Silences warnings, but is missing in some versions. */ -#endif -} +#include "caml/callback.h" +void llvm_raise(value Prototype, char *Message); /*--... Operations on generic values .......................................--*/ @@ -69,15 +36,13 @@ static void llvm_finalize_generic_value(value GenVal) { } static struct custom_operations generic_value_ops = { - (char *) "LLVMGenericValue", + (char *) "Llvm_executionengine.GenericValue.t", llvm_finalize_generic_value, custom_compare_default, custom_hash_default, custom_serialize_default, - custom_deserialize_default -#ifdef custom_compare_ext_default - , custom_compare_ext_default -#endif + custom_deserialize_default, + custom_compare_ext_default }; static value alloc_generic_value(LLVMGenericValueRef Ref) { @@ -171,12 +136,22 @@ CAMLprim value llvm_genericvalue_as_nativeint(value GenVal) { /*--... Operations on execution engines ....................................--*/ +/* unit -> bool */ +CAMLprim value llvm_initialize_native_target(value Unit) { + LLVMLinkInInterpreter(); + LLVMLinkInMCJIT(); + + return Val_bool(!LLVMInitializeNativeTarget() && + !LLVMInitializeNativeAsmParser() && + !LLVMInitializeNativeAsmPrinter()); +} + /* llmodule -> ExecutionEngine.t */ CAMLprim LLVMExecutionEngineRef llvm_ee_create(LLVMModuleRef M) { LLVMExecutionEngineRef Interp; char *Error; if (LLVMCreateExecutionEngineForModule(&Interp, M, &Error)) - llvm_raise(llvm_ee_error_exn, Error); + llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error); return Interp; } @@ -186,7 +161,7 @@ llvm_ee_create_interpreter(LLVMModuleRef M) { LLVMExecutionEngineRef Interp; char *Error; if (LLVMCreateInterpreterForModule(&Interp, M, &Error)) - llvm_raise(llvm_ee_error_exn, Error); + llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error); return Interp; } @@ -196,10 +171,30 @@ llvm_ee_create_jit(LLVMModuleRef M, value OptLevel) { LLVMExecutionEngineRef JIT; char *Error; if (LLVMCreateJITCompilerForModule(&JIT, M, Int_val(OptLevel), &Error)) - llvm_raise(llvm_ee_error_exn, Error); + llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error); return JIT; } +/* llmodule -> llcompileroption -> ExecutionEngine.t */ +CAMLprim LLVMExecutionEngineRef +llvm_ee_create_mcjit(LLVMModuleRef M, value OptRecord) { + LLVMExecutionEngineRef MCJIT; + char *Error; + struct LLVMMCJITCompilerOptions Options; + + LLVMInitializeMCJITCompilerOptions(&Options, sizeof(Options)); + Options.OptLevel = Int_val(Field(OptRecord, 0)); + Options.CodeModel = Int_val(Field(OptRecord, 1)); + Options.NoFramePointerElim = Int_val(Field(OptRecord, 2)); + Options.EnableFastISel = Int_val(Field(OptRecord, 3)); + Options.MCJMM = NULL; + + if (LLVMCreateMCJITCompilerForModule(&MCJIT, M, &Options, + sizeof(Options), &Error)) + llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error); + return MCJIT; +} + /* ExecutionEngine.t -> unit */ CAMLprim value llvm_ee_dispose(LLVMExecutionEngineRef EE) { LLVMDisposeExecutionEngine(EE); @@ -218,7 +213,7 @@ CAMLprim LLVMModuleRef llvm_ee_remove_module(LLVMModuleRef M, LLVMModuleRef RemovedModule; char *Error; if (LLVMRemoveModule(EE, M, &RemovedModule, &Error)) - llvm_raise(llvm_ee_error_exn, Error); + llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error); return RemovedModule; } @@ -240,14 +235,14 @@ CAMLprim value llvm_ee_run_function(LLVMValueRef F, value Args, unsigned NumArgs; LLVMGenericValueRef Result, *GVArgs; unsigned I; - + NumArgs = Wosize_val(Args); GVArgs = (LLVMGenericValueRef*) malloc(NumArgs * sizeof(LLVMGenericValueRef)); for (I = 0; I != NumArgs; ++I) GVArgs[I] = Genericvalue_val(Field(Args, I)); - + Result = LLVMRunFunction(EE, F, NumArgs, GVArgs); - + free(GVArgs); return alloc_generic_value(Result); } @@ -273,21 +268,21 @@ CAMLprim value llvm_ee_run_function_as_main(LLVMValueRef F, int I, NumArgs, NumEnv, EnvSize, Result; const char **CArgs, **CEnv; char *CEnvBuf, *Pos; - + NumArgs = Wosize_val(Args); NumEnv = Wosize_val(Env); - + /* Build the environment. */ CArgs = (const char **) malloc(NumArgs * sizeof(char*)); for (I = 0; I != NumArgs; ++I) CArgs[I] = String_val(Field(Args, I)); - + /* Compute the size of the environment string buffer. */ for (I = 0, EnvSize = 0; I != NumEnv; ++I) { EnvSize += strlen(String_val(Field(Field(Env, I), 0))) + 1; EnvSize += strlen(String_val(Field(Field(Env, I), 1))) + 1; } - + /* Build the environment. */ CEnv = (const char **) malloc((NumEnv + 1) * sizeof(char*)); CEnvBuf = (char*) malloc(EnvSize); @@ -297,7 +292,7 @@ CAMLprim value llvm_ee_run_function_as_main(LLVMValueRef F, *Value = String_val(Field(Field(Env, I), 1)); int NameLen = strlen(Name), ValueLen = strlen(Value); - + CEnv[I] = Pos; memcpy(Pos, Name, NameLen); Pos += NameLen; @@ -307,13 +302,13 @@ CAMLprim value llvm_ee_run_function_as_main(LLVMValueRef F, *Pos++ = '\0'; } CEnv[NumEnv] = NULL; - + Result = LLVMRunFunctionAsMain(EE, F, NumArgs, CArgs, CEnv); - + free(CArgs); free(CEnv); free(CEnvBuf); - + CAMLreturn(Val_int(Result)); } @@ -330,9 +325,9 @@ extern value llvm_alloc_data_layout(LLVMTargetDataRef TargetData); CAMLprim value llvm_ee_get_data_layout(LLVMExecutionEngineRef EE) { value DataLayout; LLVMTargetDataRef OrigDataLayout; - OrigDataLayout = LLVMGetExecutionEngineTargetData(EE); - char* TargetDataCStr; + + OrigDataLayout = LLVMGetExecutionEngineTargetData(EE); TargetDataCStr = LLVMCopyStringRepOfTargetData(OrigDataLayout); DataLayout = llvm_alloc_data_layout(LLVMCreateTargetData(TargetDataCStr)); LLVMDisposeMessage(TargetDataCStr);