From 073c8fed861b03a302ac303f496847b37dfd06f3 Mon Sep 17 00:00:00 2001 From: Siddharth Bhat Date: Mon, 24 Jul 2023 17:30:39 -0700 Subject: [PATCH] feat: LLVM backend: support for visibility Style & DLL storage Changes peeled from: https://github.com/leanprover/lean4/pull/2340 to allow a `stage0` bump on master before merging in the changes that allow LLVM to build in stage1+. --- src/Lean/Compiler/IR/EmitLLVM.lean | 58 ++++++++++++++++++-------- src/Lean/Compiler/IR/LLVMBindings.lean | 22 ++++++++++ src/library/compiler/llvm.cpp | 31 ++++++++++++++ 3 files changed, 94 insertions(+), 17 deletions(-) diff --git a/src/Lean/Compiler/IR/EmitLLVM.lean b/src/Lean/Compiler/IR/EmitLLVM.lean index 3d2d65c2b6..51a24d64a0 100644 --- a/src/Lean/Compiler/IR/EmitLLVM.lean +++ b/src/Lean/Compiler/IR/EmitLLVM.lean @@ -415,24 +415,38 @@ def emitFnDeclAux (mod : LLVM.Module llvmctx) let env ← getEnv -- bollu: if we have a declaration with no parameters, then we emit it as a global pointer. -- bollu: Otherwise, we emit it as a function + let global ← + if ps.isEmpty then + let retty ← (toLLVMType decl.resultType) + let global ← LLVM.getOrAddGlobal mod cppBaseName retty + if !isExternal then + LLVM.setInitializer global (← LLVM.getUndef retty) + pure global + else + let retty ← (toLLVMType decl.resultType) + let mut argtys := #[] + for p in ps do + -- if it is extern, then we must not add irrelevant args + if !(isExternC env decl.name) || !p.ty.isIrrelevant then + argtys := argtys.push (← toLLVMType p.ty) + -- TODO (bollu): simplify this API, this code of `closureMaxArgs` is duplicated in multiple places. + if argtys.size > closureMaxArgs && isBoxedName decl.name then + argtys := #[← LLVM.pointerType (← LLVM.voidPtrType llvmctx)] + let fnty ← LLVM.functionType retty argtys (isVarArg := false) + LLVM.getOrAddFunction mod cppBaseName fnty + -- we must now set symbol visibility for global. if ps.isEmpty then - let retty ← (toLLVMType decl.resultType) - let global ← LLVM.getOrAddGlobal mod cppBaseName retty - if !isExternal then - LLVM.setInitializer global (← LLVM.getUndef retty) - return global - else - let retty ← (toLLVMType decl.resultType) - let mut argtys := #[] - for p in ps do - -- if it is extern, then we must not add irrelevant args - if !(isExternC env decl.name) || !p.ty.isIrrelevant then - argtys := argtys.push (← toLLVMType p.ty) - -- TODO (bollu): simplify this API, this code of `closureMaxArgs` is duplicated in multiple places. - if argtys.size > closureMaxArgs && isBoxedName decl.name then - argtys := #[← LLVM.pointerType (← LLVM.voidPtrType llvmctx)] - let fnty ← LLVM.functionType retty argtys (isVarArg := false) - LLVM.getOrAddFunction mod cppBaseName fnty + if isClosedTermName env decl.name then LLVM.setVisibility global LLVM.Visibility.hidden -- static + else if isExternal then pure () -- extern (Recall that C/LLVM funcs are extern linkage by default.) + else LLVM.setDLLStorageClass global LLVM.DLLStorageClass.export -- LEAN_EXPORT + else if !isExternal + -- An extern decl might be linked in from a different translation unit. + -- Thus, we cannot export an external declaration as we do not define it, + -- only declare its presence. + -- So, we only export non-external definitions. + then LLVM.setDLLStorageClass global LLVM.DLLStorageClass.export + return global + def emitFnDecl (decl : Decl) (isExternal : Bool) : M llvmctx Unit := do let cppBaseName ← toCName decl.name @@ -1137,6 +1151,14 @@ def emitDeclAux (mod : LLVM.Module llvmctx) (builder : LLVM.Builder llvmctx) (d argtys := argtys.push (← toLLVMType x.ty) let fnty ← LLVM.functionType retty argtys (isVarArg := false) let llvmfn ← LLVM.getOrAddFunction mod name fnty + -- set linkage and visibility + -- TODO: consider refactoring these into a separate concept (e.g. 'setLinkageAndVisibility') + -- Find the spots where this refactor needs to happen by grepping for 'LEAN_EXPORT' + -- in the C backend + if xs.size == 0 then + LLVM.setVisibility llvmfn LLVM.Visibility.hidden -- "static " + else + LLVM.setDLLStorageClass llvmfn LLVM.DLLStorageClass.export -- LEAN_EXPORT: make symbol visible to the interpreter withReader (fun llvmctx => { llvmctx with mainFn := f, mainParams := xs }) do set { var2val := default, jp2bb := default : EmitLLVM.State llvmctx } -- flush variable map let bb ← LLVM.appendBasicBlockInContext llvmctx llvmfn "entry" @@ -1247,10 +1269,12 @@ def emitInitFn (mod : LLVM.Module llvmctx) (builder : LLVM.Builder llvmctx) : M let initFnTy ← LLVM.functionType (← LLVM.voidPtrType llvmctx) #[ (← LLVM.i8Type llvmctx), (← LLVM.voidPtrType llvmctx)] (isVarArg := false) let initFn ← LLVM.getOrAddFunction mod (mkModuleInitializationFunctionName modName) initFnTy + LLVM.setDLLStorageClass initFn LLVM.DLLStorageClass.export -- LEAN_EXPORT let entryBB ← LLVM.appendBasicBlockInContext llvmctx initFn "entry" LLVM.positionBuilderAtEnd builder entryBB let ginit?ty := ← LLVM.i1Type llvmctx let ginit?slot ← LLVM.getOrAddGlobal mod (modName.mangle ++ "_G_initialized") ginit?ty + LLVM.setVisibility ginit?slot LLVM.Visibility.hidden -- static LLVM.setInitializer ginit?slot (← LLVM.constFalse llvmctx) let ginit?v ← LLVM.buildLoad2 builder ginit?ty ginit?slot "init_v" buildIfThen_ builder "isGInitialized" ginit?v diff --git a/src/Lean/Compiler/IR/LLVMBindings.lean b/src/Lean/Compiler/IR/LLVMBindings.lean index 0d95a5faa7..305236d140 100644 --- a/src/Lean/Compiler/IR/LLVMBindings.lean +++ b/src/Lean/Compiler/IR/LLVMBindings.lean @@ -294,6 +294,28 @@ opaque disposeTargetMachine (tm : TargetMachine ctx) : BaseIO Unit opaque disposeModule (m : Module ctx) : BaseIO Unit +-- https://github.com/llvm/llvm-project/blob/c3e073bcbdc523b0f758d44a89a6333e38bff863/llvm/include/llvm-c/Core.h#L198 +structure Visibility where + private mk :: val : UInt64 + +def Visibility.default : Visibility := { val := 0 } +def Visibility.hidden : Visibility := { val := 1 } +def Visibility.protected : Visibility := { val := 2 } + +@[extern "lean_llvm_set_visibility"] +opaque setVisibility {ctx : Context} (value : Value ctx) (visibility : Visibility) : BaseIO Unit + +-- https://github.com/llvm/llvm-project/blob/c3e073bcbdc523b0f758d44a89a6333e38bff863/llvm/include/llvm-c/Core.h#L210 +structure DLLStorageClass where + private mk :: val : UInt64 + +def DLLStorageClass.default : DLLStorageClass := { val := 0 } +def DLLStorageClass.import : DLLStorageClass := { val := 1 } +def DLLStorageClass.export : DLLStorageClass := { val := 2 } + +@[extern "lean_llvm_set_dll_storage_class"] +opaque setDLLStorageClass {ctx : Context} (value : Value ctx) (dllStorageClass : DLLStorageClass) : BaseIO Unit + -- Helper to add a function if it does not exist, and to return the function handle if it does. def getOrAddFunction(m : Module ctx) (name : String) (type : LLVMType ctx) : BaseIO (Value ctx) := do match (← getNamedFunction m name) with diff --git a/src/library/compiler/llvm.cpp b/src/library/compiler/llvm.cpp index 436def862b..3174a69ec8 100644 --- a/src/library/compiler/llvm.cpp +++ b/src/library/compiler/llvm.cpp @@ -29,6 +29,13 @@ Lean's IR. #include "llvm-c/Transforms/PassManagerBuilder.h" #endif +// This is mostly boilerplate, suppress warnings +#if defined(__clang__) +#pragma clang diagnostic ignored "-Wunused-parameter" +#elif defined(__GNUC__) && !defined(__CLANG__) +#pragma GCC diagnostic ignored "-Wunused-parameter" +#endif + extern "C" LEAN_EXPORT lean_object* lean_llvm_initialize_target_info() { #ifdef LEAN_LLVM @@ -1277,3 +1284,27 @@ extern "C" LEAN_EXPORT lean_object *lean_llvm_dispose_module(size_t ctx, size_t return lean_io_result_mk_ok(lean_box(0)); #endif // LEAN_LLVM } + +extern "C" LEAN_EXPORT lean_object *lean_llvm_set_visibility(size_t ctx, size_t value, uint64_t vis, + lean_object * /* w */) { +#ifndef LEAN_LLVM + lean_always_assert( + false && ("Please build a version of Lean4 with -DLLVM=ON to invoke " + "the LLVM backend function.")); +#else + LLVMSetVisibility(lean_to_Value(value), LLVMVisibility(vis)); + return lean_io_result_mk_ok(lean_box(0)); +#endif // LEAN_LLVM +} + +extern "C" LEAN_EXPORT lean_object *lean_llvm_set_dll_storage_class(size_t ctx, size_t value, uint64_t cls, + lean_object * /* w */) { +#ifndef LEAN_LLVM + lean_always_assert( + false && ("Please build a version of Lean4 with -DLLVM=ON to invoke " + "the LLVM backend function.")); +#else + LLVMSetDLLStorageClass(lean_to_Value(value), LLVMDLLStorageClass(cls)); + return lean_io_result_mk_ok(lean_box(0)); +#endif // LEAN_LLVM +}