1 /*===-- analysis_ocaml.c - LLVM OCaml Glue ----------------------*- C++ -*-===*\ 2 |* *| 3 |* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| 4 |* Exceptions. *| 5 |* See https://llvm.org/LICENSE.txt for license information. *| 6 |* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| 7 |* *| 8 |*===----------------------------------------------------------------------===*| 9 |* *| 10 |* This file glues LLVM's OCaml interface to its C interface. These functions *| 11 |* are by and large transparent wrappers to the corresponding C functions. *| 12 |* *| 13 |* Note that these functions intentionally take liberties with the CAMLparamX *| 14 |* macros, since most of the parameters are not GC heap objects. *| 15 |* *| 16 \*===----------------------------------------------------------------------===*/ 17 18 #include "llvm-c/Analysis.h" 19 #include "llvm-c/Core.h" 20 #include "caml/alloc.h" 21 #include "caml/mlvalues.h" 22 #include "caml/memory.h" 23 #include "llvm_ocaml.h" 24 25 /* Llvm.llmodule -> string option */ llvm_verify_module(value M)26value llvm_verify_module(value M) { 27 CAMLparam0(); 28 CAMLlocal2(String, Option); 29 30 char *Message; 31 int Result = 32 LLVMVerifyModule(Module_val(M), LLVMReturnStatusAction, &Message); 33 34 if (0 == Result) { 35 Option = Val_none; 36 } else { 37 String = caml_copy_string(Message); 38 Option = caml_alloc_some(String); 39 } 40 41 LLVMDisposeMessage(Message); 42 43 CAMLreturn(Option); 44 } 45 46 /* Llvm.llvalue -> bool */ llvm_verify_function(value Fn)47value llvm_verify_function(value Fn) { 48 return Val_bool(LLVMVerifyFunction(Value_val(Fn), LLVMReturnStatusAction) == 49 0); 50 } 51 52 /* Llvm.llmodule -> unit */ llvm_assert_valid_module(value M)53value llvm_assert_valid_module(value M) { 54 LLVMVerifyModule(Module_val(M), LLVMAbortProcessAction, 0); 55 return Val_unit; 56 } 57 58 /* Llvm.llvalue -> unit */ llvm_assert_valid_function(value Fn)59value llvm_assert_valid_function(value Fn) { 60 LLVMVerifyFunction(Value_val(Fn), LLVMAbortProcessAction); 61 return Val_unit; 62 } 63 64 /* Llvm.llvalue -> unit */ llvm_view_function_cfg(value Fn)65value llvm_view_function_cfg(value Fn) { 66 LLVMViewFunctionCFG(Value_val(Fn)); 67 return Val_unit; 68 } 69 70 /* Llvm.llvalue -> unit */ llvm_view_function_cfg_only(value Fn)71value llvm_view_function_cfg_only(value Fn) { 72 LLVMViewFunctionCFGOnly(Value_val(Fn)); 73 return Val_unit; 74 } 75