[OpenMP] Add Fortran support for omp_* functions needing adapters

Taking omp_get_uid_from_device and omp_get_device_from_uid as examples.

OpenMP 6.0 defines these functions as follows:
```
const char *omp_get_uid_from_device(int device_num);

character(:) function omp_get_uid_from_device(device_num)
  pointer :: omp_get_uid_from_device
  integer, intent(in) :: device_num
```
and
```
int omp_get_device_from_uid(const char *uid);

integer function omp_get_device_from_uid(uid)
  character(len=*), intent(in) :: uid
```

As a result, we cannot directly map the Fortran API declarations to the
C API declarations. We need some adapter code to do the conversion.

However, this means that we cannot just define the two functions as
omp_* in kmp_ftn_entry.h without clashing with the adapter code.

The current situation is less than ideal, as demonstrated by this draft
PR, which shall serve as a base for discussing different solution
approaches.

Author: ro-i

openmp/runtime/CMakeLists.txt

@@ -273,7 +273,7 @@ set(LIBOMP_INC_DIR ${LIBOMP_SRC_DIR}/include)
 set(LIBOMP_BINARY_DIR ${CMAKE_CURRENT_BINARY_DIR})
 
 # Enabling Fortran if it is needed
-if(${LIBOMP_FORTRAN_MODULES})
+if(${LIBOMP_FORTRAN_MODULES} OR NOT "${LIBOMP_FORTRAN_MODULES_COMPILER}" STREQUAL "")
   enable_language(Fortran)
 endif()
 # Enable MASM Compiler if it is needed (Windows only)

openmp/runtime/src/CMakeLists.txt

@@ -422,6 +422,48 @@ elseif(${LIBOMP_FORTRAN_MODULES})
   set(BUILD_FORTRAN_MODULES True)
 endif()
 
+if(BUILD_FORTRAN_MODULES)
+  if(NOT LIBOMP_FORTRAN_MODULES AND ${LIBOMP_FORTRAN_MODULES_COMPILER} STREQUAL "")
+    message(FATAL_ERROR
+      "Generating OpenMP Fortran modules now requires LIBOMP_FORTRAN_MODULES=ON "
+      "or LIBOMP_FORTRAN_MODULES_COMPILER to be set so the adaptor implementations "
+      "can be compiled and linked into libomp.")
+  endif()
+  target_sources(omp PRIVATE kmp_ftn_support.f90)
+  set_source_files_properties(kmp_ftn_support.f90
+                              PROPERTIES COMPILE_FLAGS "${LIBOMP_CONFIGURED_FFLAGS}")
+  add_dependencies(omp libomp-mod)
+  # Determine Fortran runtime libraries to link
+  # For LLVM flang, we need flang_rt.runtime (newer)
+  set(_LIBOMP_FORTRAN_LIBS "")
+  if(CMAKE_Fortran_COMPILER_ID MATCHES "LLVMFlang" OR CMAKE_Fortran_COMPILER_ID MATCHES "Flang")
+    # Derive paths from Fortran compiler location
+    get_filename_component(_FC_DIR "${CMAKE_Fortran_COMPILER}" DIRECTORY)
+    get_filename_component(_FC_PREFIX "${_FC_DIR}" DIRECTORY)
+
+    # Try to find the flang runtime in clang resource directory
+    # Path: <prefix>/lib/clang/<version>/lib/<target>/libflang_rt.runtime.a
+    file(GLOB _FLANG_RT_CANDIDATES
+      "${_FC_PREFIX}/lib/clang/*/lib/*/libflang_rt.runtime.a"
+    )
+    if(_FLANG_RT_CANDIDATES)
+      list(GET _FLANG_RT_CANDIDATES 0 _FLANG_RT_LIB)
+      list(APPEND _LIBOMP_FORTRAN_LIBS "${_FLANG_RT_LIB}")
+    else()
+      message(WARNING "Could not find LLVM Flang runtime libraries. "
+                      "libomp may fail to link.")
+    endif()
+  elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
+    set(_LIBOMP_FORTRAN_LIBS gfortran)
+  else()
+    # Fallback to CMake's auto-detected libs
+    set(_LIBOMP_FORTRAN_LIBS ${CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES})
+  endif()
+  if(_LIBOMP_FORTRAN_LIBS)
+    target_link_libraries(omp ${_LIBOMP_FORTRAN_LIBS})
+  endif()
+endif()
+
 # Move files to exports/ directory if requested
 if(${LIBOMP_COPY_EXPORTS})
   include(LibompExports)

openmp/runtime/src/exports_so.txt

@@ -29,6 +29,7 @@ VERSION {
         ompt_libomp_connect; # OMPT libomptarget interface
 
         ompc_*;    # omp.h renames some standard functions to ompc_*.
+        _QMomp_*;  # Fortran module procedures (flang name mangling).
         kmp_*;     # Intel extensions.
         kmpc_*;    # Intel extensions.
         __kmpc_*;  # Functions called by compiler-generated code.

openmp/runtime/src/include/omp_lib.F90.var

@@ -904,6 +904,18 @@
             integer, intent(in) :: resources(*)
           end function omp_get_submemspace
 
+          function omp_get_uid_from_device(device_num) result(uid)
+            use omp_lib_kinds
+            integer (kind=omp_integer_kind), intent(in) :: device_num
+            character (:), pointer :: uid
+          end function omp_get_uid_from_device
+
+          function omp_get_device_from_uid(uid) result(device_num)
+            use omp_lib_kinds
+            character (len=*), intent(in) :: uid
+            integer (kind=omp_integer_kind) :: device_num
+          end function omp_get_device_from_uid
+
 !         ***
 !         *** kmp_* entry points
 !         ***
@@ -1150,6 +1162,8 @@
         public :: omp_realloc
         public :: omp_free
         public :: omp_in_explicit_task
+        public :: omp_get_uid_from_device
+        public :: omp_get_device_from_uid
         public :: kmp_set_stacksize
         public :: kmp_set_stacksize_s
         public :: kmp_set_blocktime

openmp/runtime/src/include/omp_lib.h.var

@@ -976,6 +976,17 @@
           integer, intent(in) :: resources(*)
         end function omp_get_submemspace
 
+        function omp_get_uid_from_device(device_num) result(uid)
+          import
+          integer (kind=omp_integer_kind), intent(in) :: device_num
+          character (:), pointer :: uid
+        end function omp_get_uid_from_device
+
+        function omp_get_device_from_uid(uid) result(device_num)
+          import
+          character (len=*), intent(in) :: uid
+          integer (kind=omp_integer_kind) :: device_num
+        end function omp_get_device_from_uid
 
 !       ***
 !       *** kmp_* entry points

openmp/runtime/src/kmp_ftn_cdecl.cpp

@@ -29,6 +29,56 @@ char const __kmp_version_ftncdecl[] =
 #define FTN_STDCALL /* no stdcall */
 #include "kmp_ftn_os.h"
 #include "kmp_ftn_entry.h"
+
+#if KMP_FTN_ENTRIES == KMP_FTN_PLAIN
+#define FTN_GET_UID_FROM_DEVICE omp_get_uid_from_device
+#define FTN_GET_DEVICE_FROM_UID omp_get_device_from_uid
+#endif
+#if KMP_FTN_ENTRIES == KMP_FTN_APPEND
+#define FTN_GET_UID_FROM_DEVICE omp_get_uid_from_device_
+#define FTN_GET_DEVICE_FROM_UID omp_get_device_from_uid_
+#endif
+#if KMP_FTN_ENTRIES == KMP_FTN_UPPER
+#define FTN_GET_UID_FROM_DEVICE OMP_GET_UID_FROM_DEVICE
+#define FTN_GET_DEVICE_FROM_UID OMP_GET_DEVICE_FROM_UID
+#endif
+#if KMP_FTN_ENTRIES == KMP_FTN_UAPPEND
+#define FTN_GET_UID_FROM_DEVICE OMP_GET_UID_FROM_DEVICE_
+#define FTN_GET_DEVICE_FROM_UID OMP_GET_DEVICE_FROM_UID_
+#endif
+
+extern "C" {
+const char *FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_UID_FROM_DEVICE)(int device_num)
+    KMP_WEAK_ATTRIBUTE_EXTERNAL;
+const char *FTN_STDCALL
+KMP_EXPAND_NAME(FTN_GET_UID_FROM_DEVICE)(int device_num) {
+#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
+  return nullptr;
+#else
+  const char *(*fptr)(int);
+  if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_uid_from_device")))
+    return (*fptr)(device_num);
+  // Returns the same string as used by libomptarget
+  return "HOST";
+#endif
+}
+int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DEVICE_FROM_UID)(const char *device_uid)
+    KMP_WEAK_ATTRIBUTE_EXTERNAL;
+int FTN_STDCALL
+KMP_EXPAND_NAME(FTN_GET_DEVICE_FROM_UID)(const char *device_uid) {
+#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
+  return omp_invalid_device;
+#else
+  int (*fptr)(const char *);
+  if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_device_from_uid")))
+    return (*fptr)(device_uid);
+  return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
+#endif
+}
+
+KMP_VERSION_SYMBOL(FTN_GET_UID_FROM_DEVICE, 60, "OMP_6.0");
+KMP_VERSION_SYMBOL(FTN_GET_DEVICE_FROM_UID, 60, "OMP_6.0");
+} // extern "C"
 #else
                        "no";
 #endif /* KMP_FTN_ENTRIES */

openmp/runtime/src/kmp_ftn_entry.h

@@ -1550,33 +1550,6 @@ int FTN_STDCALL FTN_GET_DEVICE_NUM(void) KMP_WEAK_ATTRIBUTE_EXTERNAL;
 int FTN_STDCALL FTN_GET_DEVICE_NUM(void) {
   return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
 }
-const char *FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_UID_FROM_DEVICE)(int device_num)
-    KMP_WEAK_ATTRIBUTE_EXTERNAL;
-const char *FTN_STDCALL
-KMP_EXPAND_NAME(FTN_GET_UID_FROM_DEVICE)(int device_num) {
-#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
-  return nullptr;
-#else
-  const char *(*fptr)(int);
-  if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_uid_from_device")))
-    return (*fptr)(device_num);
-  // Returns the same string as used by libomptarget
-  return "HOST";
-#endif
-}
-int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DEVICE_FROM_UID)(const char *device_uid)
-    KMP_WEAK_ATTRIBUTE_EXTERNAL;
-int FTN_STDCALL
-KMP_EXPAND_NAME(FTN_GET_DEVICE_FROM_UID)(const char *device_uid) {
-#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
-  return omp_invalid_device;
-#else
-  int (*fptr)(const char *);
-  if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_device_from_uid")))
-    return (*fptr)(device_uid);
-  return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
-#endif
-}
 
 // Compiler will ensure that this is only called from host in sequential region
 int FTN_STDCALL KMP_EXPAND_NAME(FTN_PAUSE_RESOURCE)(kmp_pause_status_t kind,
@@ -1933,10 +1906,6 @@ KMP_VERSION_SYMBOL(FTN_SET_AFFINITY_FORMAT, 50, "OMP_5.0");
 // KMP_VERSION_SYMBOL(FTN_GET_SUPPORTED_ACTIVE_LEVELS, 50, "OMP_5.0");
 // KMP_VERSION_SYMBOL(FTN_FULFILL_EVENT, 50, "OMP_5.0");
 
-// OMP_6.0 versioned symbols
-KMP_VERSION_SYMBOL(FTN_GET_UID_FROM_DEVICE, 60, "OMP_6.0");
-KMP_VERSION_SYMBOL(FTN_GET_DEVICE_FROM_UID, 60, "OMP_6.0");
-
 #endif // KMP_USE_VERSION_SYMBOLS
 
 #ifdef __cplusplus

openmp/runtime/src/kmp_ftn_extra.cpp

@@ -27,6 +27,56 @@ char const __kmp_version_ftnextra[] =
 #define FTN_STDCALL /* nothing to do */
 #include "kmp_ftn_os.h"
 #include "kmp_ftn_entry.h"
+
+#if KMP_FTN_ENTRIES == KMP_FTN_PLAIN
+#define FTN_KMP_GET_UID_FROM_DEVICE __kmp_get_uid_from_device
+#define FTN_KMP_GET_DEVICE_FROM_UID __kmp_get_device_from_uid
+#endif
+#if KMP_FTN_ENTRIES == KMP_FTN_APPEND
+#define FTN_KMP_GET_UID_FROM_DEVICE __kmp_get_uid_from_device_
+#define FTN_KMP_GET_DEVICE_FROM_UID __kmp_get_device_from_uid_
+#endif
+#if KMP_FTN_ENTRIES == KMP_FTN_UPPER
+#define FTN_KMP_GET_UID_FROM_DEVICE __KMP_GET_UID_FROM_DEVICE
+#define FTN_KMP_GET_DEVICE_FROM_UID __KMP_GET_DEVICE_FROM_UID
+#endif
+#if KMP_FTN_ENTRIES == KMP_FTN_UAPPEND
+#define FTN_KMP_GET_UID_FROM_DEVICE __KMP_GET_UID_FROM_DEVICE_
+#define FTN_KMP_GET_DEVICE_FROM_UID __KMP_GET_DEVICE_FROM_UID_
+#endif
+
+extern "C" {
+const char *FTN_STDCALL KMP_EXPAND_NAME(FTN_KMP_GET_UID_FROM_DEVICE)(
+    int device_num) KMP_WEAK_ATTRIBUTE_EXTERNAL;
+const char *FTN_STDCALL
+KMP_EXPAND_NAME(FTN_KMP_GET_UID_FROM_DEVICE)(int device_num) {
+#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
+  return nullptr;
+#else
+  const char *(*fptr)(int);
+  if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_uid_from_device")))
+    return (*fptr)(device_num);
+  // Returns the same string as used by libomptarget
+  return "HOST";
+#endif
+}
+int FTN_STDCALL KMP_EXPAND_NAME(FTN_KMP_GET_DEVICE_FROM_UID)(
+    const char *device_uid) KMP_WEAK_ATTRIBUTE_EXTERNAL;
+int FTN_STDCALL
+KMP_EXPAND_NAME(FTN_KMP_GET_DEVICE_FROM_UID)(const char *device_uid) {
+#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
+  return omp_invalid_device;
+#else
+  int (*fptr)(const char *);
+  if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_device_from_uid")))
+    return (*fptr)(device_uid);
+  return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
+#endif
+}
+
+KMP_VERSION_SYMBOL(FTN_KMP_GET_UID_FROM_DEVICE, 60, "OMP_6.0");
+KMP_VERSION_SYMBOL(FTN_KMP_GET_DEVICE_FROM_UID, 60, "OMP_6.0");
+} // extern "C"
 #else
                        "no";
 #endif /* KMP_FTN_ENTRIES */