Skip to content

Commit 4eaf6fc

Browse files
committed
Revert "remove Fortran support for this patch"
This reverts commit bde0665.
1 parent c25ad27 commit 4eaf6fc

File tree

6 files changed

+139
-32
lines changed

6 files changed

+139
-32
lines changed

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

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -215,6 +215,8 @@
215215

216216
integer (kind=omp_interop_kind), parameter, public :: omp_interop_none = 0
217217

218+
integer (kind=omp_integer_kind), parameter, public :: omp_invalid_device = -2
219+
218220
interface
219221

220222
! ***
@@ -417,6 +419,20 @@
417419
integer (kind=omp_integer_kind) omp_get_device_num
418420
end function omp_get_device_num
419421

422+
function omp_get_uid_from_device(device_num) bind(c)
423+
use, intrinsic :: iso_c_binding, only: c_ptr
424+
use omp_lib_kinds
425+
integer (kind=omp_integer_kind), value :: device_num
426+
type(c_ptr) omp_get_uid_from_device
427+
end function omp_get_uid_from_device
428+
429+
function omp_get_device_from_uid(device_uid) bind(c)
430+
use, intrinsic :: iso_c_binding, only: c_ptr
431+
use omp_lib_kinds
432+
type(c_ptr), value :: device_uid
433+
integer (kind=omp_integer_kind) omp_get_device_from_uid
434+
end function omp_get_device_from_uid
435+
420436
function omp_pause_resource(kind, device_num) bind(c)
421437
use omp_lib_kinds
422438
integer (kind=omp_pause_resource_kind), value :: kind
@@ -1099,6 +1115,8 @@
10991115
public :: omp_is_initial_device
11001116
public :: omp_get_initial_device
11011117
public :: omp_get_device_num
1118+
public :: omp_get_uid_from_device
1119+
public :: omp_get_device_from_uid
11021120
public :: omp_pause_resource
11031121
public :: omp_pause_resource_all
11041122
public :: omp_get_supported_active_levels

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

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -291,6 +291,9 @@
291291
integer(kind=omp_interop_kind)omp_interop_none
292292
parameter(omp_interop_none=0)
293293

294+
integer(kind=omp_integer_kind)omp_invalid_device
295+
parameter(omp_invalid_device=-2)
296+
294297
interface
295298

296299
! ***
@@ -486,6 +489,20 @@
486489
integer (kind=omp_integer_kind) omp_get_device_num
487490
end function omp_get_device_num
488491

492+
function omp_get_uid_from_device(device_num) bind(c)
493+
import
494+
use, intrinsic :: iso_c_binding, only : c_ptr
495+
integer (kind=omp_integer_kind), value :: device_num
496+
type(c_ptr) omp_get_uid_from_device
497+
end function omp_get_uid_from_device
498+
499+
function omp_get_device_from_uid(device_uid) bind(c)
500+
import
501+
use, intrinsic :: iso_c_binding, only : c_ptr
502+
type(c_ptr), value :: device_uid
503+
integer (kind=omp_integer_kind) omp_get_device_from_uid
504+
end function omp_get_device_from_uid
505+
489506
function omp_pause_resource(kind, device_num) bind(c)
490507
import
491508
integer (kind=omp_pause_resource_kind), value :: kind
@@ -1159,6 +1176,8 @@
11591176
!DIR$ ATTRIBUTES OFFLOAD:MIC :: omp_get_initial_device
11601177
!DIR$ ATTRIBUTES OFFLOAD:MIC :: omp_get_num_devices
11611178
!DIR$ ATTRIBUTES OFFLOAD:MIC :: omp_get_device_num
1179+
!DIR$ ATTRIBUTES OFFLOAD:MIC :: omp_get_uid_from_device
1180+
!DIR$ ATTRIBUTES OFFLOAD:MIC :: omp_get_device_from_uid
11621181
!DIR$ ATTRIBUTES OFFLOAD:MIC :: omp_pause_resource
11631182
!DIR$ ATTRIBUTES OFFLOAD:MIC :: omp_pause_resource_all
11641183
!DIR$ ATTRIBUTES OFFLOAD:MIC :: omp_get_supported_active_levels
@@ -1242,6 +1261,8 @@
12421261
!$omp declare target(omp_get_initial_device )
12431262
!$omp declare target(omp_get_num_devices )
12441263
!$omp declare target(omp_get_device_num )
1264+
!$omp declare target(omp_get_uid_from_device )
1265+
!$omp declare target(omp_get_device_from_uid )
12451266
!$omp declare target(omp_pause_resource )
12461267
!$omp declare target(omp_pause_resource_all )
12471268
!$omp declare target(omp_get_supported_active_levels )

openmp/runtime/src/kmp_ftn_cdecl.cpp

Lines changed: 0 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -29,36 +29,6 @@ char const __kmp_version_ftncdecl[] =
2929
#define FTN_STDCALL /* no stdcall */
3030
#include "kmp_ftn_os.h"
3131
#include "kmp_ftn_entry.h"
32-
33-
// FIXME: this is a hack to get the UID functions working for C.
34-
// It will be moved and also made available for Fortran in a follow-up patch.
35-
extern "C" {
36-
const char *FTN_STDCALL omp_get_uid_from_device(int device_num)
37-
KMP_WEAK_ATTRIBUTE_EXTERNAL;
38-
const char *FTN_STDCALL omp_get_uid_from_device(int device_num) {
39-
#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
40-
return nullptr;
41-
#else
42-
const char *(*fptr)(int);
43-
if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_uid_from_device")))
44-
return (*fptr)(device_num);
45-
// Returns the same string as used by libomptarget
46-
return "HOST";
47-
#endif
48-
}
49-
int FTN_STDCALL omp_get_device_from_uid(const char *device_uid)
50-
KMP_WEAK_ATTRIBUTE_EXTERNAL;
51-
int FTN_STDCALL omp_get_device_from_uid(const char *device_uid) {
52-
#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
53-
return omp_invalid_device;
54-
#else
55-
int (*fptr)(const char *);
56-
if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_device_from_uid")))
57-
return (*fptr)(device_uid);
58-
return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
59-
#endif
60-
}
61-
}
6232
#else
6333
"no";
6434
#endif /* KMP_FTN_ENTRIES */

openmp/runtime/src/kmp_ftn_entry.h

Lines changed: 27 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1543,13 +1543,38 @@ int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_TASK_PRIORITY)(void) {
15431543
#endif
15441544
}
15451545

1546-
// This function will be defined in libomptarget. When libomptarget is not
1547-
// loaded, we assume we are on the host and return KMP_HOST_DEVICE.
1546+
// These functions will be defined in libomptarget. When libomptarget is not
1547+
// loaded, we assume we are on the host.
15481548
// Compiler/libomptarget will handle this if called inside target.
15491549
int FTN_STDCALL FTN_GET_DEVICE_NUM(void) KMP_WEAK_ATTRIBUTE_EXTERNAL;
15501550
int FTN_STDCALL FTN_GET_DEVICE_NUM(void) {
15511551
return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
15521552
}
1553+
const char *FTN_STDCALL FTN_GET_UID_FROM_DEVICE(int device_num)
1554+
KMP_WEAK_ATTRIBUTE_EXTERNAL;
1555+
const char *FTN_STDCALL FTN_GET_UID_FROM_DEVICE(int device_num) {
1556+
#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1557+
return nullptr;
1558+
#else
1559+
const char *(*fptr)(int);
1560+
if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_uid_from_device")))
1561+
return (*fptr)(device_num);
1562+
// Returns the same string as used by libomptarget
1563+
return "HOST";
1564+
#endif
1565+
}
1566+
int FTN_STDCALL FTN_GET_DEVICE_FROM_UID(const char *device_uid)
1567+
KMP_WEAK_ATTRIBUTE_EXTERNAL;
1568+
int FTN_STDCALL FTN_GET_DEVICE_FROM_UID(const char *device_uid) {
1569+
#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1570+
return omp_invalid_device;
1571+
#else
1572+
int (*fptr)(const char *);
1573+
if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_device_from_uid")))
1574+
return (*fptr)(device_uid);
1575+
return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
1576+
#endif
1577+
}
15531578

15541579
// Compiler will ensure that this is only called from host in sequential region
15551580
int FTN_STDCALL KMP_EXPAND_NAME(FTN_PAUSE_RESOURCE)(kmp_pause_status_t kind,

openmp/runtime/src/kmp_ftn_os.h

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -140,6 +140,8 @@
140140
#define FTN_GET_MEMSPACE_NUM_RESOURCES omp_get_memspace_num_resources
141141
#define FTN_GET_SUBMEMSPACE omp_get_submemspace
142142
#define FTN_GET_DEVICE_NUM omp_get_device_num
143+
#define FTN_GET_UID_FROM_DEVICE omp_get_uid_from_device
144+
#define FTN_GET_DEVICE_FROM_UID omp_get_device_from_uid
143145
#define FTN_SET_AFFINITY_FORMAT omp_set_affinity_format
144146
#define FTN_GET_AFFINITY_FORMAT omp_get_affinity_format
145147
#define FTN_DISPLAY_AFFINITY omp_display_affinity
@@ -289,6 +291,8 @@
289291
#define FTN_ALLOC omp_alloc_
290292
#define FTN_FREE omp_free_
291293
#define FTN_GET_DEVICE_NUM omp_get_device_num_
294+
#define FTN_GET_UID_FROM_DEVICE omp_get_uid_from_device_
295+
#define FTN_GET_DEVICE_FROM_UID omp_get_device_from_uid_
292296
#define FTN_SET_AFFINITY_FORMAT omp_set_affinity_format_
293297
#define FTN_GET_AFFINITY_FORMAT omp_get_affinity_format_
294298
#define FTN_DISPLAY_AFFINITY omp_display_affinity_
@@ -436,6 +440,8 @@
436440
#define FTN_GET_MEMSPACE_NUM_RESOURCES OMP_GET_MEMSPACE_NUM_RESOURCES
437441
#define FTN_GET_SUBMEMSPACE OMP_GET_SUBMEMSPACE
438442
#define FTN_GET_DEVICE_NUM OMP_GET_DEVICE_NUM
443+
#define FTN_GET_UID_FROM_DEVICE OMP_GET_UID_FROM_DEVICE
444+
#define FTN_GET_DEVICE_FROM_UID OMP_GET_DEVICE_FROM_UID
439445
#define FTN_SET_AFFINITY_FORMAT OMP_SET_AFFINITY_FORMAT
440446
#define FTN_GET_AFFINITY_FORMAT OMP_GET_AFFINITY_FORMAT
441447
#define FTN_DISPLAY_AFFINITY OMP_DISPLAY_AFFINITY
@@ -585,6 +591,8 @@
585591
#define FTN_ALLOC OMP_ALLOC_
586592
#define FTN_FREE OMP_FREE_
587593
#define FTN_GET_DEVICE_NUM OMP_GET_DEVICE_NUM_
594+
#define FTN_GET_UID_FROM_DEVICE OMP_GET_UID_FROM_DEVICE_
595+
#define FTN_GET_DEVICE_FROM_UID OMP_GET_DEVICE_FROM_UID_
588596
#define FTN_SET_AFFINITY_FORMAT OMP_SET_AFFINITY_FORMAT_
589597
#define FTN_GET_AFFINITY_FORMAT OMP_GET_AFFINITY_FORMAT_
590598
#define FTN_DISPLAY_AFFINITY OMP_DISPLAY_AFFINITY_
Lines changed: 65 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,65 @@
1+
! RUN: %flang %flags %openmp_flags -fopenmp-version=60 %s -o %t
2+
! RUN: %t | FileCheck %s
3+
4+
program test_omp_device_uid_main
5+
use omp_lib
6+
use, intrinsic :: iso_c_binding
7+
implicit none
8+
9+
integer(kind=omp_integer_kind) :: num_devices, i, num_failed
10+
logical :: success
11+
12+
num_devices = omp_get_num_devices()
13+
num_failed = 0
14+
15+
! Test all devices plus the initial device (num_devices)
16+
do i = 0, num_devices
17+
success = test_omp_device_uid(i)
18+
if (.not. success) then
19+
print '("FAIL for device ", I0)', i
20+
num_failed = num_failed + 1
21+
end if
22+
end do
23+
24+
if (num_failed /= 0) then
25+
print *, "FAIL"
26+
stop 1
27+
end if
28+
29+
print *, "PASS"
30+
stop 0
31+
32+
contains
33+
34+
logical function test_omp_device_uid(device_num)
35+
use omp_lib
36+
use, intrinsic :: iso_c_binding
37+
implicit none
38+
integer(kind=omp_integer_kind), intent(in) :: device_num
39+
type(c_ptr) :: device_uid
40+
integer(kind=omp_integer_kind) :: device_num_from_uid
41+
42+
device_uid = omp_get_uid_from_device(device_num)
43+
44+
! Check if device_uid is NULL
45+
if (.not. c_associated(device_uid)) then
46+
print '("FAIL for device ", I0, ": omp_get_uid_from_device returned NULL")', device_num
47+
test_omp_device_uid = .false.
48+
return
49+
end if
50+
51+
device_num_from_uid = omp_get_device_from_uid(device_uid)
52+
if (device_num_from_uid /= device_num) then
53+
print '("FAIL for device ", I0, ": omp_get_device_from_uid returned ", I0)', &
54+
device_num, device_num_from_uid
55+
test_omp_device_uid = .false.
56+
return
57+
end if
58+
59+
test_omp_device_uid = .true.
60+
end function test_omp_device_uid
61+
62+
end program test_omp_device_uid_main
63+
64+
! CHECK: PASS
65+

0 commit comments

Comments
 (0)