[flang] Handle BINC(C) variables and add TODO for corner cases

[clementval]

Summary

• BIND(C) was ignored in lowering for objects (it can be used on

module and common blocks): use the bind name as the fir.global name.

• When an procedure is declared BIND(C) indirectly via an interface, it should have a BIND(C) name. This was not the case because GetBindName()/bindingName() return nothing in this case: detect this case in mangler.cpp and use the symbol name.

Add TODOs for corner cases:

• BIND(C) module variables may be initialized on the C side. This does not fit well with the current linkage strategy. Add a TODO until this is revisited.

• BIND(C) internal procedures should not have a binding label (see Fortran 2018 section 18.10.2 point 2), yet we currently lower them as if they were BIND(C) external procedure. I think this and the indirect interface case should really be handled by symbol.GetBindName instead of adding more logic in lowering to deal with this case: add a TODO.

This patch is part of the upstreaming effort from fir-dev branch.

Co-authored-by: Jean Perier <[e-mail]>

[clementval]

Emit fatal error

[peixin]

@clementval Is there any BIND(C) related patch not upstreamed? I am tring to use LLVM Flang to build openmpi. The fir-dev fails due to the incorrect external procedure name. So, now I use llvm main. It still fails and I am analyzing. Just want to confirm no BIND(C) related patch left in fir-dev.

BIND(C) internal procedures should not have a binding label (see Fortran 2018 section 18.10.2 point 2), yet we currently lower them as if they were BIND(C) external procedure. I think this and the indirect interface case should really be handled by symbol.GetBindName instead of adding more logic in lowering to deal with this case: add a TODO.

I took a look at gfortran and ifort. If with NAME= specified for the following case, both gfortran and ifort report error.

program main
contains
  subroutine sub() bind(c)
    integer :: i = 1
    print *, i
  end
end

For gfortran, the sub is optimized out when compiling to executable file. For ifort:

$ ifort test.f90 && nm a.out | grep sub
0000000000477080 T __subq
0000000000477020 t subq_abs
0000000000477ef0 t subq_abs.A
0000000000476760 t subq_abs.L

Then I tried the following case:

$ cat internal.f90 
program main
  integer :: i = 1
  call sub()
  call c_func()
  print *, i
contains
  subroutine sub() bind(c)
    i = i + 1
  end
end
$ cat c_code.c 
void __subq();
void c_func_() {
  __subq();
}

$ gfortran internal.f90 -c
$ gcc c_code.c -c
$ gfortran internal.o c_code.o 
/usr/bin/ld: c_code.o: in function `c_func_':
c_code.c:(.text+0x8): undefined reference to `__subq'
collect2: error: ld returned 1 exit status
$ nm internal.o 
                 U c_func_
                 U _gfortran_set_args
                 U _gfortran_set_options
                 U _gfortran_st_write
                 U _gfortran_st_write_done
                 U _gfortran_transfer_integer_write
0000000000000000 d i.2774
00000000000000ac T main
0000000000000030 t MAIN__
0000000000000010 r options.1.2781
0000000000000000 t sub.2772

$ ifort internal.f90 -c
$ icc c_code.c -c
$ ifort internal.o c_code.o 
$ ./a.out
forrtl: severe (174): SIGSEGV, segmentation fault occurred

So, I think it's safe to reject internal procedure with BIND(C) attribute and need not to worry that GCC and ICC can support this, which should be done in https://github.com/llvm/llvm-project/blob/1dd2c93a660cd5de0769ff88634fe149904caa17/flang/lib/Semantics/check-declarations.cpp#L1883.

[clementval]

In D128340#3603711, @peixin wrote:

@clementval Is there any BIND(C) related patch not upstreamed? I am tring to use LLVM Flang to build openmpi. The fir-dev fails due to the incorrect external procedure name. So, now I use llvm main. It still fails and I am analyzing. Just want to confirm no BIND(C) related patch left in fir-dev.

There might be some more patches to be upstream. I do not have a clear view of what exact features/bug fixes are left to be upstreamed. I'm going by diffs and I'll have a better view early next week.

[peixin]

In D128340#3604843, @clementval wrote:

In D128340#3603711, @peixin wrote:

@clementval Is there any BIND(C) related patch not upstreamed? I am tring to use LLVM Flang to build openmpi. The fir-dev fails due to the incorrect external procedure name. So, now I use llvm main. It still fails and I am analyzing. Just want to confirm no BIND(C) related patch left in fir-dev.

There might be some more patches to be upstream. I do not have a clear view of what exact features/bug fixes are left to be upstreamed. I'm going by diffs and I'll have a better view early next week.

Great. Thanks a lot.

flang/lib/Lower/CallInterface.cpp

 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
 
 //===----------------------------------------------------------------------===//
 // BIND(C) mangling helpers
 //===----------------------------------------------------------------------===//
 
 // Return the binding label (from BIND(C...)) or the mangled name of a symbol.
-static std::string getMangledName(const Fortran::semantics::Symbol &symbol) {
+static std::string getMangledName(mlir::Location loc,
+                                  const Fortran::semantics::Symbol &symbol) {
   const std::string *bindName = symbol.GetBindName();
+  // TODO: update GetBindName so that it does not return a label for internal
+  // procedures.
+  if (bindName && Fortran::semantics::ClassifyProcedure(symbol) ==
+                      Fortran::semantics::ProcedureDefinitionClass::Internal)
+    TODO(loc, "BIND(C) internal procedures");
   return bindName ? *bindName : Fortran::lower::mangle::mangleName(symbol);
 }
 
 /// Return the type of a dummy procedure given its characteristic (if it has
 /// one).
 mlir::Type getProcedureDesignatorType(
     const Fortran::evaluate::characteristics::Procedure *,
     Fortran::lower::AbstractConverter &converter) {

 
 bool Fortran::lower::CallerInterface::hasAlternateReturns() const {
   return procRef.hasAlternateReturns();
 }
 
 std::string Fortran::lower::CallerInterface::getMangledName() const {
   const Fortran::evaluate::ProcedureDesignator &proc = procRef.proc();
   if (const Fortran::semantics::Symbol *symbol = proc.GetSymbol())
-    return ::getMangledName(symbol->GetUltimate());
+    return ::getMangledName(converter.getCurrentLocation(),
+                            symbol->GetUltimate());
   assert(proc.GetSpecificIntrinsic() &&
          "expected intrinsic procedure in designator");
   return proc.GetName();
 }
 
 const Fortran::semantics::Symbol *
 Fortran::lower::CallerInterface::getProcedureSymbol() const {
   return procRef.proc().GetSymbol();

 bool Fortran::lower::CalleeInterface::hasAlternateReturns() const {
   return !funit.isMainProgram() &&
          Fortran::semantics::HasAlternateReturns(funit.getSubprogramSymbol());
 }
 
 std::string Fortran::lower::CalleeInterface::getMangledName() const {
   if (funit.isMainProgram())
     return fir::NameUniquer::doProgramEntry().str();
-  return ::getMangledName(funit.getSubprogramSymbol());
+  return ::getMangledName(converter.getCurrentLocation(),
+                          funit.getSubprogramSymbol());
 }
 
 const Fortran::semantics::Symbol *
 Fortran::lower::CalleeInterface::getProcedureSymbol() const {
   if (funit.isMainProgram())
     return nullptr;
   return &funit.getSubprogramSymbol();
 }

 }
 
 bool Fortran::lower::CalleeInterface::isMainProgram() const {
   return funit.isMainProgram();
 }
 
 mlir::func::FuncOp
 Fortran::lower::CalleeInterface::addEntryBlockAndMapArguments() {
-  // On the callee side, directly map the mlir::value argument of
-  // the function block to the Fortran symbols.
+  // Check for bugs in the front end. The front end must not present multiple
+  // definitions of the same procedure.
+  if (!func.getBlocks().empty())
+    fir::emitFatalError(func.getLoc(),
+                        "cannot process subprogram that was already processed");
+
+  // On the callee side, directly map the mlir::value argument of the function
+  // block to the Fortran symbols.
   func.addEntryBlock();
   mapPassedEntities();
   return func;
 }
 
 bool Fortran::lower::CalleeInterface::hasHostAssociated() const {
   return funit.parentHasHostAssoc();
 }

flang/lib/Lower/ConvertVariable.cpp

if (details->init()) {
           });
     }
   } else if (sym.has<Fortran::semantics::CommonBlockDetails>()) {
     mlir::emitError(loc, "COMMON symbol processed elsewhere");
   } else {
     TODO(loc, "global"); // Procedure pointer or something else
   }
   // Creates undefined initializer for globals without initializers
-  if (!globalIsInitialized(global))
+  if (!globalIsInitialized(global)) {
+    // TODO: Is it really required to add the undef init if the Public
+    // visibility is set ? We need to make sure the global is not optimized out
+    // by LLVM if unused in the current compilation unit, but at least for
+    // BIND(C) variables, an initial value may be given in another compilation
+    // unit (on the C side), and setting an undef init here creates linkage
+    // conflicts.
+    if (sym.attrs().test(Fortran::semantics::Attr::BIND_C))
+      TODO(loc, "BIND(C) module variable linkage");
     createGlobalInitialization(
         builder, global, [&](fir::FirOpBuilder &builder) {
           builder.create<fir::HasValueOp>(
               loc, builder.create<fir::UndefOp>(loc, symTy));
         });
+  }
   // Set public visibility to prevent global definition to be optimized out
   // even if they have no initializer and are unused in this compilation unit.
   global.setVisibility(mlir::SymbolTable::Visibility::Public);
   return global;
 }
 
 /// Return linkage attribute for \p var.
 static mlir::StringAttr

flang/lib/Lower/Mangler.cpp

 // the FIR name mangler, `mangler`
 std::string
 Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
                                    bool keepExternalInScope) {
   // Resolve host and module association before mangling
   const auto &ultimateSymbol = symbol.GetUltimate();
   auto symbolName = toStringRef(ultimateSymbol.name());
 
+  // The Fortran and BIND(C) namespaces are counterintuitive. A
+  // BIND(C) name is substituted early having precedence over the
+  // Fortran name of the subprogram. By side-effect, this allows
+  // multiple subprocedures with identical Fortran names to be legally
+  // present in the program. Assume the BIND(C) name is unique.
+  if (auto *overrideName = ultimateSymbol.GetBindName())
+    return *overrideName;
+  // TODO: the case of procedure that inherits the BIND(C) through another
+  // interface (procedure(iface)), should be dealt within GetBindName()
+  // directly, or some semantics wrapper.
+  if (!Fortran::semantics::IsPointer(ultimateSymbol) &&
+      Fortran::semantics::IsBindCProcedure(ultimateSymbol) &&
+      Fortran::semantics::ClassifyProcedure(symbol) !=
+          Fortran::semantics::ProcedureDefinitionClass::Internal)
+    return ultimateSymbol.name().ToString();
+
   return std::visit(
       Fortran::common::visitors{
           [&](const Fortran::semantics::MainProgramDetails &) {
             return fir::NameUniquer::doProgramEntry().str();
           },
           [&](const Fortran::semantics::SubprogramDetails &) {
             // Mangle external procedure without any scope prefix.
             if (!keepExternalInScope &&

flang/test/Lower/c-interoperability-bindc-variables.f90

+! Test lowering of BIND(C) variables
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+block data
+   integer :: x, y
+   common /fortran_name/ x, y
+   ! CHECK-LABEL: fir.global common @c_name
+   bind(c, name="c_name") /fortran_name/
+end block data
+
+module some_module
+   ! CHECK-LABEL: fir.global @tomato
+  integer, bind(c, name="tomato") :: apple = 42
+end module

flang/test/Lower/call-site-mangling.f90

subroutine test_bindmodule_call
   ! CHECK: fir.call @bind_modulecproc()
   ! CHECK: fir.call @somecproc()
   ! CHECK: fir.call @bind_somecproc()
   call modulecproc()
   call modulecproc_1()
   call somecproc()
   call somecproc_1()
 end subroutine
+
+! CHECK-LABEL: func @_QPtest_bind_interface() {
+subroutine test_bind_interface()
+  interface
+    subroutine some_bindc_iface() bind(C, name="some_name_some_foo_does_not_inherit")
+    end subroutine
+  end interface
+ procedure(some_bindc_iface) :: foo5
+ external :: foo5
+ ! CHECK: fir.call @foo5
+ call foo5()
+end

flang/test/Lower/program-units-fir-mangling.f90

 ! CHECK: }
 contains
 ! CHECK-LABEL: func @_QFPshould_not_collide() {
 subroutine should_not_collide()
 ! CHECK: }
 end subroutine
 end program
 
-! CHECK-LABEL: func @omp_get_num_threads() -> f32 attributes {fir.sym_name = "_QPomp_get_num_threads"} {
+! CHECK-LABEL: func @omp_get_num_threads() -> f32 attributes {fir.sym_name = "omp_get_num_threads"} {
 function omp_get_num_threads() bind(c)
 ! CHECK: }
 end function
 
-! CHECK-LABEL: func @get_threads() -> f32 attributes {fir.sym_name = "_QPomp_get_num_threads_1"} {
+! CHECK-LABEL: func @get_threads() -> f32 attributes {fir.sym_name = "get_threads"} {
 function omp_get_num_threads_1() bind(c, name ="get_threads")
 ! CHECK: }
 end function
 
-! CHECK-LABEL: func @bEtA() -> f32 attributes {fir.sym_name = "_QPalpha"} {
+! CHECK-LABEL: func @bEtA() -> f32 attributes {fir.sym_name = "bEtA"} {
 function alpha() bind(c, name =" bEtA ")
 ! CHECK: }
 end function
 
-! CHECK-LABEL: func @bc1() attributes {fir.sym_name = "_QPbind_c_s"} {
+! CHECK-LABEL: func @bc1() attributes {fir.sym_name = "bc1"} {
 subroutine bind_c_s() Bind(C,Name='bc1')
   ! CHECK: return
 end subroutine bind_c_s
 
 ! CHECK-LABEL: func @_QPbind_c_s() {
 subroutine bind_c_s()
   ! CHECK: fir.call @_QPbind_c_q() : () -> ()
   ! CHECK: return
subroutine bind_c_q()
   ! CHECK: fir.call @bc1() : () -> ()
   ! CHECK: return
   call bind_c_s
 end
 
 ! Test that BIND(C) label is taken into account for ENTRY symbols.
 ! CHECK-LABEL: func @_QPsub_with_entries() {
 subroutine sub_with_entries
-! CHECK-LABEL: func @bar() attributes {fir.sym_name = "_QPsome_entry"} {
+! CHECK-LABEL: func @bar() attributes {fir.sym_name = "bar"} {
  entry some_entry() bind(c, name="bar")
 ! CHECK-LABEL: func @_QPnormal_entry() {
  entry normal_entry()
-! CHECK-LABEL: func @some_other_entry() attributes {fir.sym_name = "_QPsome_other_entry"} {
+! CHECK-LABEL: func @some_other_entry() attributes {fir.sym_name = "some_other_entry"} {
  entry some_other_entry() bind(c)
 end subroutine
 
 ! Test that semantics constructs binding labels with local name resolution
 module testMod3
   character*(*), parameter :: foo = "bad!!"
   character*(*), parameter :: ok = "ok"
   interface
     real function f1() bind(c,name=ok//'1')
       import ok
     end function
     subroutine s1() bind(c,name=ok//'2')
       import ok
     end subroutine
   end interface
  contains
-! CHECK-LABEL: func @ok3() -> f32 attributes {fir.sym_name = "_QMtestmod3Pf2"} {
+! CHECK-LABEL: func @ok3() -> f32 attributes {fir.sym_name = "ok3"} {
   real function f2() bind(c,name=foo//'3')
     character*(*), parameter :: foo = ok
 ! CHECK: fir.call @ok1() : () -> f32
-! CHECK-LABEL: func @ok4() -> f32 attributes {fir.sym_name = "_QMtestmod3Pf3"} {
+! CHECK-LABEL: func @ok4() -> f32 attributes {fir.sym_name = "ok4"} {
     entry f3() bind(c,name=foo//'4')
 ! CHECK: fir.call @ok1() : () -> f32
     f2 = f1()
   end function
-! CHECK-LABEL: func @ok5() attributes {fir.sym_name = "_QMtestmod3Ps2"} {
+! CHECK-LABEL: func @ok5() attributes {fir.sym_name = "ok5"} {
   subroutine s2() bind(c,name=foo//'5')
     character*(*), parameter :: foo = ok
 ! CHECK: fir.call @ok2() : () -> ()
-! CHECK-LABEL: func @ok6() attributes {fir.sym_name = "_QMtestmod3Ps3"} {
+! CHECK-LABEL: func @ok6() attributes {fir.sym_name = "ok6"} {
     entry s3() bind(c,name=foo//'6')
 ! CHECK: fir.call @ok2() : () -> ()
     continue ! force end of specification part
-! CHECK-LABEL: func @ok7() attributes {fir.sym_name = "_QMtestmod3Ps4"} {
+! CHECK-LABEL: func @ok7() attributes {fir.sym_name = "ok7"} {
     entry s4() bind(c,name=foo//'7')
 ! CHECK: fir.call @ok2() : () -> ()
     call s1
   end subroutine
 end module
 
 ! CHECK-LABEL: fir.global internal @_QFfooEpi : f32 {