From 8d1a1cb1b816381bf60cb1211c93b8eba1fe1472 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 19 Feb 2020 09:13:44 +0100 Subject: [PATCH] libgomp: Fixes + cleanup for OpenACC's Fortran module + openacc_lib.h MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 2020-02-19 Tobias Burnus * .gitattributes: New; whitespace handling for Fortran's openacc_lib.h. * config/accel/openacc.f90 (openacc_kinds): Add acc_device_current. (openacc_internal, acc_on_device_h): Fix argument name; minor cleanup. * libgomp.texi (Enabling OpenACC): No longer mark as experimental. (acc_set_device_num): Fix Fortran argument name, use same name for C. (acc_get_property): Update Fortran interface to post-OpenACC 3.0 corrections; add note about the previous interface and named constant. (OpenACC library and environment variables): Fix two typos. * openacc.f90: Use for all procedures the argument names from the spec as for …_h they are user visible. (openacc_kinds): Rename acc_device_property to acc_device_property_kinds and change value to int32 ; and update users. Re-add acc_device_property for for backward compatibility. (acc_get_property_string_h): Clean up as acc_device_property_kind changed. (acc_get_property_h): Likewise and return c_size_t instead of acc_device_property. (openacc): Also export acc_device_property_kinds. (acc_async_test_h, acc_async_test_all_h, acc_on_device_h, acc_is_present_32_h, acc_is_present_64_h): Simplify logical-return-value handling; check against /= 0 instead of == 1 to match C. * openacc_lib.h: Use for all procedures the argument names from the spec as for …_h they are user visible. Place !GCC$ into the first column to be active also for fixed-form souce form. (acc_device_current, acc_device_property_kind, acc_device_property, acc_property_memory, acc_property_free_memory, acc_property_name, acc_property_vendor, acc_property_driver): New named constants. (acc_get_property, acc_get_property_string): New generic interface. --- libgomp/.gitattributes | 2 + libgomp/ChangeLog | 31 ++++ libgomp/config/accel/openacc.f90 | 19 +-- libgomp/libgomp.texi | 27 +-- libgomp/openacc.f90 | 281 ++++++++++++++----------------- libgomp/openacc_lib.h | 145 ++++++++++------ 6 files changed, 280 insertions(+), 225 deletions(-) create mode 100644 libgomp/.gitattributes diff --git a/libgomp/.gitattributes b/libgomp/.gitattributes new file mode 100644 index 00000000000..47e74eb6acd --- /dev/null +++ b/libgomp/.gitattributes @@ -0,0 +1,2 @@ +# For the Fortran file, complain about tabs +openacc_lib.h whitespace=tab-in-indent,space-before-tab,trailing-space diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index ef1c5dae66c..3c640c7350b 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,34 @@ +2020-02-19 Tobias Burnus + + * .gitattributes: New; whitespace handling for Fortran's openacc_lib.h. + * config/accel/openacc.f90 (openacc_kinds): Add acc_device_current. + (openacc_internal, acc_on_device_h): Fix argument name; minor cleanup. + * libgomp.texi (Enabling OpenACC): No longer mark as experimental. + (acc_set_device_num): Fix Fortran argument name, use same name for C. + (acc_get_property): Update Fortran interface to post-OpenACC 3.0 + corrections; add note about the previous interface and named constant. + (OpenACC library and environment variables): Fix two typos. + * openacc.f90: Use for all procedures the argument names from the spec + as for …_h they are user visible. + (openacc_kinds): Rename acc_device_property to + acc_device_property_kinds and change value to int32 ; and update users. + Re-add acc_device_property for for backward compatibility. + (acc_get_property_string_h): Clean up as acc_device_property_kind + changed. + (acc_get_property_h): Likewise and return c_size_t instead of + acc_device_property. + (openacc): Also export acc_device_property_kinds. + (acc_async_test_h, acc_async_test_all_h, acc_on_device_h, + acc_is_present_32_h, acc_is_present_64_h): Simplify logical-return-value + handling; check against /= 0 instead of == 1 to match C. + * openacc_lib.h: Use for all procedures the argument names from the spec + as for …_h they are user visible. Place !GCC$ into the first column to + be active also for fixed-form souce form. + (acc_device_current, acc_device_property_kind, acc_device_property, + acc_property_memory, acc_property_free_memory, acc_property_name, + acc_property_vendor, acc_property_driver): New named constants. + (acc_get_property, acc_get_property_string): New generic interface. + 2020-02-13 Frederik Harwath PR libgomp/93481 diff --git a/libgomp/config/accel/openacc.f90 b/libgomp/config/accel/openacc.f90 index a8e5144349e..275afe43475 100644 --- a/libgomp/config/accel/openacc.f90 +++ b/libgomp/config/accel/openacc.f90 @@ -44,6 +44,7 @@ module openacc_kinds integer, parameter :: acc_device_kind = int32 ! Keep in sync with include/gomp-constants.h. + integer (acc_device_kind), parameter :: acc_device_current = -3 integer (acc_device_kind), parameter :: acc_device_none = 0 integer (acc_device_kind), parameter :: acc_device_default = 1 integer (acc_device_kind), parameter :: acc_device_host = 2 @@ -59,19 +60,19 @@ module openacc_internal implicit none interface - function acc_on_device_h (d) + function acc_on_device_h (devicetype) import - integer (acc_device_kind) d + integer (acc_device_kind) devicetype logical acc_on_device_h end function end interface interface - function acc_on_device_l (d) & + function acc_on_device_l (devicetype) & bind (C, name = "acc_on_device") use iso_c_binding, only: c_int integer (c_int) :: acc_on_device_l - integer (c_int), value :: d + integer (c_int), value :: devicetype end function end interface end module openacc_internal @@ -96,14 +97,10 @@ module openacc end module openacc -function acc_on_device_h (d) +function acc_on_device_h (devicetype) use openacc_internal, only: acc_on_device_l use openacc_kinds - integer (acc_device_kind) d + integer (acc_device_kind) devicetype logical acc_on_device_h - if (acc_on_device_l (d) .eq. 1) then - acc_on_device_h = .TRUE. - else - acc_on_device_h = .FALSE. - end if + acc_on_device_h = acc_on_device_l (devicetype) /= 0 end function diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi index e0c7e01ba41..b946743f9b1 100644 --- a/libgomp/libgomp.texi +++ b/libgomp/libgomp.texi @@ -1818,14 +1818,12 @@ flag @option{-fopenacc} must be specified. This enables the OpenACC directive arranges for automatic linking of the OpenACC runtime library (@ref{OpenACC Runtime Library Routines}). +See @uref{https://gcc.gnu.org/wiki/OpenACC} for more information. + A complete description of all OpenACC directives accepted may be found in the @uref{https://www.openacc.org, OpenACC} Application Programming Interface manual, version 2.6. -Note that this is an experimental feature and subject to -change in future versions of GCC. See -@uref{https://gcc.gnu.org/wiki/OpenACC} for more information. - @c --------------------------------------------------------------------- @@ -1992,12 +1990,12 @@ parallel or kernels region. @table @asis @item @emph{Description} This function will indicate to the runtime which device number, -specified by @var{num}, associated with the specified device +specified by @var{devicenum}, associated with the specified device type @var{devicetype}. @item @emph{C/C++}: @multitable @columnfractions .20 .80 -@item @emph{Prototype}: @tab @code{acc_set_device_num(int num, acc_device_t devicetype);} +@item @emph{Prototype}: @tab @code{acc_set_device_num(int devicenum, acc_device_t devicetype);} @end multitable @item @emph{Fortran}: @@ -2055,6 +2053,14 @@ The Fortran @code{acc_get_property_string} subroutine returns the string retrieved in its fourth argument while the remaining entry points are functions, which pass the return value as their result. +Note for Fortran, only: the OpenACC technical committee corrected and, hence, +modified the interface introduced in OpenACC 2.6. The kind-value parameter +@code{acc_device_property} has been renamed to @code{acc_device_property_kind} +for consistency and the return type of the @code{acc_get_property} function is +now a @code{c_size_t} integer instead of a @code{acc_device_property} integer. +The parameter @code{acc_device_property} will continue to be provided, +but might be removed in a future version of GCC. + @item @emph{C/C++}: @multitable @columnfractions .20 .80 @item @emph{Prototype}: @tab @code{size_t acc_get_property(int devicenum, acc_device_t devicetype, acc_device_property_t property);} @@ -2065,10 +2071,11 @@ functions, which pass the return value as their result. @multitable @columnfractions .20 .80 @item @emph{Interface}: @tab @code{function acc_get_property(devicenum, devicetype, property)} @item @emph{Interface}: @tab @code{subroutine acc_get_property_string(devicenum, devicetype, property, string)} +@item @tab @code{use ISO_C_Binding, only: c_size_t} @item @tab @code{integer devicenum} @item @tab @code{integer(kind=acc_device_kind) devicetype} -@item @tab @code{integer(kind=acc_device_property) property} -@item @tab @code{integer(kind=acc_device_property) acc_get_property} +@item @tab @code{integer(kind=acc_device_property_kind) property} +@item @tab @code{integer(kind=c_size_t) acc_get_property} @item @tab @code{character(*) string} @end multitable @@ -3331,8 +3338,8 @@ similarly to the first use case. There are two environment variables associated with the OpenACC library that may be used to control the device type and device number: -@env{ACC_DEVICE_TYPE} and @env{ACC_DEVICE_NUM}, respecively. These two -environement variables can be used as an alternative to calling +@env{ACC_DEVICE_TYPE} and @env{ACC_DEVICE_NUM}, respectively. These two +environment variables can be used as an alternative to calling @code{acc_set_device_num()}. As seen in the second use case, the device type and device number were specified using @code{acc_set_device_num()}. If however, the aforementioned environment variables were set, then the diff --git a/libgomp/openacc.f90 b/libgomp/openacc.f90 index db39421bf07..467fb612c54 100644 --- a/libgomp/openacc.f90 +++ b/libgomp/openacc.f90 @@ -31,11 +31,10 @@ module openacc_kinds use iso_fortran_env, only: int32 - use iso_c_binding, only: c_size_t implicit none public - private :: int32, c_size_t + private :: int32 ! When adding items, also update 'public' setting in 'module openacc' below. @@ -51,14 +50,17 @@ module openacc_kinds integer (acc_device_kind), parameter :: acc_device_nvidia = 5 integer (acc_device_kind), parameter :: acc_device_radeon = 8 - integer, parameter :: acc_device_property = c_size_t + integer, parameter :: acc_device_property_kind = int32 + ! OpenACC 2.6/2.7/3.0 used acc_device_property; in a spec update the + ! missing '_kind' was added for consistency. For backward compatibility, keep: + integer, parameter :: acc_device_property = acc_device_property_kind ! Keep in sync with 'libgomp/libgomp-plugin.h:goacc_property'. - integer (acc_device_property), parameter :: acc_property_memory = 1 - integer (acc_device_property), parameter :: acc_property_free_memory = 2 - integer (acc_device_property), parameter :: acc_property_name = int(Z'10001') - integer (acc_device_property), parameter :: acc_property_vendor = int(Z'10002') - integer (acc_device_property), parameter :: acc_property_driver = int(Z'10003') + integer (acc_device_property_kind), parameter :: acc_property_memory = 1 + integer (acc_device_property_kind), parameter :: acc_property_free_memory = 2 + integer (acc_device_property_kind), parameter :: acc_property_name = int(Z'10001') + integer (acc_device_property_kind), parameter :: acc_property_vendor = int(Z'10002') + integer (acc_device_property_kind), parameter :: acc_property_driver = int(Z'10003') integer, parameter :: acc_handle_kind = int32 @@ -72,15 +74,15 @@ module openacc_internal implicit none interface - function acc_get_num_devices_h (d) + function acc_get_num_devices_h (devicetype) import integer acc_get_num_devices_h - integer (acc_device_kind) d + integer (acc_device_kind) devicetype end function - subroutine acc_set_device_type_h (d) + subroutine acc_set_device_type_h (devicetype) import - integer (acc_device_kind) d + integer (acc_device_kind) devicetype end subroutine function acc_get_device_type_h () @@ -88,73 +90,74 @@ module openacc_internal integer (acc_device_kind) acc_get_device_type_h end function - subroutine acc_set_device_num_h (n, d) + subroutine acc_set_device_num_h (devicenum, devicetype) import - integer n - integer (acc_device_kind) d + integer devicenum + integer (acc_device_kind) devicetype end subroutine - function acc_get_device_num_h (d) + function acc_get_device_num_h (devicetype) import integer acc_get_device_num_h - integer (acc_device_kind) d + integer (acc_device_kind) devicetype end function - function acc_get_property_h (n, d, p) + function acc_get_property_h (devicenum, devicetype, property) + use iso_c_binding, only: c_size_t import implicit none (type, external) - integer (acc_device_property) :: acc_get_property_h - integer, value :: n - integer (acc_device_kind), value :: d - integer (acc_device_property), value :: p + integer (c_size_t) :: acc_get_property_h + integer, value :: devicenum + integer (acc_device_kind), value :: devicetype + integer (acc_device_property_kind), value :: property end function - subroutine acc_get_property_string_h (n, d, p, s) + subroutine acc_get_property_string_h (devicenum, devicetype, property, string) import implicit none (type, external) - integer, value :: n - integer (acc_device_kind), value :: d - integer (acc_device_property), value :: p - character (*) :: s + integer, value :: devicenum + integer (acc_device_kind), value :: devicetype + integer (acc_device_property_kind), value :: property + character (*) :: string end subroutine - function acc_async_test_h (a) + function acc_async_test_h (arg) logical acc_async_test_h - integer a + integer arg end function function acc_async_test_all_h () logical acc_async_test_all_h end function - subroutine acc_wait_h (a) - integer a + subroutine acc_wait_h (arg) + integer arg end subroutine - subroutine acc_wait_async_h (a1, a2) - integer a1, a2 + subroutine acc_wait_async_h (arg, async) + integer arg, async end subroutine subroutine acc_wait_all_h () end subroutine - subroutine acc_wait_all_async_h (a) - integer a + subroutine acc_wait_all_async_h (async) + integer async end subroutine - subroutine acc_init_h (d) + subroutine acc_init_h (devicetype) import - integer (acc_device_kind) d + integer (acc_device_kind) devicetype end subroutine - subroutine acc_shutdown_h (d) + subroutine acc_shutdown_h (devicetype) import - integer (acc_device_kind) d + integer (acc_device_kind) devicetype end subroutine - function acc_on_device_h (d) + function acc_on_device_h (devicetype) import - integer (acc_device_kind) d + integer (acc_device_kind) devicetype logical acc_on_device_h end function @@ -505,17 +508,17 @@ module openacc_internal end interface interface - function acc_get_num_devices_l (d) & + function acc_get_num_devices_l (devicetype) & bind (C, name = "acc_get_num_devices") use iso_c_binding, only: c_int integer (c_int) :: acc_get_num_devices_l - integer (c_int), value :: d + integer (c_int), value :: devicetype end function - subroutine acc_set_device_type_l (d) & + subroutine acc_set_device_type_l (devicetype) & bind (C, name = "acc_set_device_type") use iso_c_binding, only: c_int - integer (c_int), value :: d + integer (c_int), value :: devicetype end subroutine function acc_get_device_type_l () & @@ -524,37 +527,37 @@ module openacc_internal integer (c_int) :: acc_get_device_type_l end function - subroutine acc_set_device_num_l (n, d) & + subroutine acc_set_device_num_l (devicenum, devicetype) & bind (C, name = "acc_set_device_num") use iso_c_binding, only: c_int - integer (c_int), value :: n, d + integer (c_int), value :: devicenum, devicetype end subroutine - function acc_get_device_num_l (d) & + function acc_get_device_num_l (devicetype) & bind (C, name = "acc_get_device_num") use iso_c_binding, only: c_int integer (c_int) :: acc_get_device_num_l - integer (c_int), value :: d + integer (c_int), value :: devicetype end function - function acc_get_property_l (n, d, p) & + function acc_get_property_l (devicenum, devicetype, property) & bind (C, name = "acc_get_property") use iso_c_binding, only: c_int, c_size_t implicit none (type, external) integer (c_size_t) :: acc_get_property_l - integer (c_int), value :: n - integer (c_int), value :: d - integer (c_int), value :: p + integer (c_int), value :: devicenum + integer (c_int), value :: devicetype + integer (c_int), value :: property end function - function acc_get_property_string_l (n, d, p) & + function acc_get_property_string_l (devicenum, devicetype, property) & bind (C, name = "acc_get_property_string") use iso_c_binding, only: c_int, c_ptr implicit none (type, external) type (c_ptr) :: acc_get_property_string_l - integer (c_int), value :: n - integer (c_int), value :: d - integer (c_int), value :: p + integer (c_int), value :: devicenum + integer (c_int), value :: devicetype + integer (c_int), value :: property end function function acc_async_test_l (a) & @@ -576,10 +579,10 @@ module openacc_internal integer (c_int), value :: a end subroutine - subroutine acc_wait_async_l (a1, a2) & + subroutine acc_wait_async_l (arg, async) & bind (C, name = "acc_wait_async") use iso_c_binding, only: c_int - integer (c_int), value :: a1, a2 + integer (c_int), value :: arg, async end subroutine subroutine acc_wait_all_l () & @@ -587,29 +590,29 @@ module openacc_internal use iso_c_binding, only: c_int end subroutine - subroutine acc_wait_all_async_l (a) & + subroutine acc_wait_all_async_l (async) & bind (C, name = "acc_wait_all_async") use iso_c_binding, only: c_int - integer (c_int), value :: a + integer (c_int), value :: async end subroutine - subroutine acc_init_l (d) & + subroutine acc_init_l (devicetype) & bind (C, name = "acc_init") use iso_c_binding, only: c_int - integer (c_int), value :: d + integer (c_int), value :: devicetype end subroutine - subroutine acc_shutdown_l (d) & + subroutine acc_shutdown_l (devicetype) & bind (C, name = "acc_shutdown") use iso_c_binding, only: c_int - integer (c_int), value :: d + integer (c_int), value :: devicetype end subroutine - function acc_on_device_l (d) & + function acc_on_device_l (devicetype) & bind (C, name = "acc_on_device") use iso_c_binding, only: c_int integer (c_int) :: acc_on_device_l - integer (c_int), value :: d + integer (c_int), value :: devicetype end function subroutine acc_copyin_l (a, len) & @@ -769,7 +772,7 @@ module openacc public :: acc_device_none, acc_device_default, acc_device_host public :: acc_device_not_host, acc_device_nvidia, acc_device_radeon - public :: acc_device_property + public :: acc_device_property_kind, acc_device_property public :: acc_property_memory, acc_property_free_memory public :: acc_property_name, acc_property_vendor, acc_property_driver @@ -1002,19 +1005,19 @@ module openacc end module openacc -function acc_get_num_devices_h (d) +function acc_get_num_devices_h (devicetype) use openacc_internal, only: acc_get_num_devices_l use openacc_kinds integer acc_get_num_devices_h - integer (acc_device_kind) d - acc_get_num_devices_h = acc_get_num_devices_l (d) + integer (acc_device_kind) devicetype + acc_get_num_devices_h = acc_get_num_devices_l (devicetype) end function -subroutine acc_set_device_type_h (d) +subroutine acc_set_device_type_h (devicetype) use openacc_internal, only: acc_set_device_type_l use openacc_kinds - integer (acc_device_kind) d - call acc_set_device_type_l (d) + integer (acc_device_kind) devicetype + call acc_set_device_type_l (devicetype) end subroutine function acc_get_device_type_h () @@ -1024,54 +1027,47 @@ function acc_get_device_type_h () acc_get_device_type_h = acc_get_device_type_l () end function -subroutine acc_set_device_num_h (n, d) +subroutine acc_set_device_num_h (devicenum, devicetype) use openacc_internal, only: acc_set_device_num_l use openacc_kinds - integer n - integer (acc_device_kind) d - call acc_set_device_num_l (n, d) + integer devicenum + integer (acc_device_kind) devicetype + call acc_set_device_num_l (devicenum, devicetype) end subroutine -function acc_get_device_num_h (d) +function acc_get_device_num_h (devicetype) use openacc_internal, only: acc_get_device_num_l use openacc_kinds integer acc_get_device_num_h - integer (acc_device_kind) d - acc_get_device_num_h = acc_get_device_num_l (d) + integer (acc_device_kind) devicetype + acc_get_device_num_h = acc_get_device_num_l (devicetype) end function -function acc_get_property_h (n, d, p) - use iso_c_binding, only: c_int, c_size_t +function acc_get_property_h (devicenum, devicetype, property) + use iso_c_binding, only: c_size_t use openacc_internal, only: acc_get_property_l use openacc_kinds implicit none (type, external) - integer (acc_device_property) :: acc_get_property_h - integer, value :: n - integer (acc_device_kind), value :: d - integer (acc_device_property), value :: p - - integer (c_int) :: pint - - pint = int (p, c_int) - acc_get_property_h = acc_get_property_l (n, d, pint) + integer (c_size_t) :: acc_get_property_h + integer, value :: devicenum + integer (acc_device_kind), value :: devicetype + integer (acc_device_property_kind), value :: property + acc_get_property_h = acc_get_property_l (devicenum, devicetype, property) end function -subroutine acc_get_property_string_h (n, d, p, s) - use iso_c_binding, only: c_char, c_int, c_ptr, c_f_pointer, c_associated +subroutine acc_get_property_string_h (devicenum, devicetype, property, string) + use iso_c_binding, only: c_char, c_size_t, c_ptr, c_f_pointer, c_associated use openacc_internal, only: acc_get_property_string_l use openacc_kinds implicit none (type, external) - integer, value :: n - integer (acc_device_kind), value :: d - integer (acc_device_property), value :: p - character (*) :: s + integer, value :: devicenum + integer (acc_device_kind), value :: devicetype + integer (acc_device_property_kind), value :: property + character (*) :: string - integer (c_int) :: pint type (c_ptr) :: cptr - integer :: clen + integer(c_size_t) :: clen, slen, i character (kind=c_char, len=1), pointer, contiguous :: sptr (:) - integer :: slen - integer :: i interface function strlen (s) bind (C, name = "strlen") @@ -1081,53 +1077,44 @@ subroutine acc_get_property_string_h (n, d, p, s) end function strlen end interface - pint = int (p, c_int) - cptr = acc_get_property_string_l (n, d, pint) - s = "" + cptr = acc_get_property_string_l (devicenum, devicetype, property) + string = "" if (.not. c_associated (cptr)) then return end if - clen = int (strlen (cptr)) + clen = strlen (cptr) call c_f_pointer (cptr, sptr, [clen]) - slen = min (clen, len (s)) + slen = min (clen, len (string, kind=c_size_t)) do i = 1, slen - s (i:i) = sptr (i) + string (i:i) = sptr (i) end do end subroutine -function acc_async_test_h (a) +function acc_async_test_h (arg) use openacc_internal, only: acc_async_test_l logical acc_async_test_h - integer a - if (acc_async_test_l (a) .eq. 1) then - acc_async_test_h = .TRUE. - else - acc_async_test_h = .FALSE. - end if + integer arg + acc_async_test_h = acc_async_test_l (arg) /= 0 end function function acc_async_test_all_h () use openacc_internal, only: acc_async_test_all_l logical acc_async_test_all_h - if (acc_async_test_all_l () .eq. 1) then - acc_async_test_all_h = .TRUE. - else - acc_async_test_all_h = .FALSE. - end if + acc_async_test_all_h = acc_async_test_all_l () /= 0 end function -subroutine acc_wait_h (a) +subroutine acc_wait_h (arg) use openacc_internal, only: acc_wait_l - integer a - call acc_wait_l (a) + integer arg + call acc_wait_l (arg) end subroutine -subroutine acc_wait_async_h (a1, a2) +subroutine acc_wait_async_h (arg, async) use openacc_internal, only: acc_wait_async_l - integer a1, a2 - call acc_wait_async_l (a1, a2) + integer arg, async + call acc_wait_async_l (arg, async) end subroutine subroutine acc_wait_all_h () @@ -1135,36 +1122,32 @@ subroutine acc_wait_all_h () call acc_wait_all_l () end subroutine -subroutine acc_wait_all_async_h (a) +subroutine acc_wait_all_async_h (async) use openacc_internal, only: acc_wait_all_async_l - integer a - call acc_wait_all_async_l (a) + integer async + call acc_wait_all_async_l (async) end subroutine -subroutine acc_init_h (d) +subroutine acc_init_h (devicetype) use openacc_internal, only: acc_init_l use openacc_kinds - integer (acc_device_kind) d - call acc_init_l (d) + integer (acc_device_kind) devicetype + call acc_init_l (devicetype) end subroutine -subroutine acc_shutdown_h (d) +subroutine acc_shutdown_h (devicetype) use openacc_internal, only: acc_shutdown_l use openacc_kinds - integer (acc_device_kind) d - call acc_shutdown_l (d) + integer (acc_device_kind) devicetype + call acc_shutdown_l (devicetype) end subroutine -function acc_on_device_h (d) +function acc_on_device_h (devicetype) use openacc_internal, only: acc_on_device_l use openacc_kinds - integer (acc_device_kind) d + integer (acc_device_kind) devicetype logical acc_on_device_h - if (acc_on_device_l (d) .eq. 1) then - acc_on_device_h = .TRUE. - else - acc_on_device_h = .FALSE. - end if + acc_on_device_h = acc_on_device_l (devicetype) /= 0 end function subroutine acc_copyin_32_h (a, len) @@ -1414,11 +1397,7 @@ function acc_is_present_32_h (a, len) !GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len - if (acc_is_present_l (a, int (len, kind = c_size_t)) .eq. 1) then - acc_is_present_32_h = .TRUE. - else - acc_is_present_32_h = .FALSE. - end if + acc_is_present_32_h = acc_is_present_l (a, int (len, kind = c_size_t)) /= 0 end function function acc_is_present_64_h (a, len) @@ -1428,18 +1407,14 @@ function acc_is_present_64_h (a, len) !GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len - if (acc_is_present_l (a, int (len, kind = c_size_t)) .eq. 1) then - acc_is_present_64_h = .TRUE. - else - acc_is_present_64_h = .FALSE. - end if + acc_is_present_64_h = acc_is_present_l (a, int (len, kind = c_size_t)) /= 0 end function function acc_is_present_array_h (a) use openacc_internal, only: acc_is_present_l logical acc_is_present_array_h type (*), dimension (..), contiguous :: a - acc_is_present_array_h = acc_is_present_l (a, sizeof (a)) == 1 + acc_is_present_array_h = acc_is_present_l (a, sizeof (a)) /= 0 end function subroutine acc_copyin_async_32_h (a, len, async) diff --git a/libgomp/openacc_lib.h b/libgomp/openacc_lib.h index 92e1dd967af..ee08e9787cc 100644 --- a/libgomp/openacc_lib.h +++ b/libgomp/openacc_lib.h @@ -37,6 +37,7 @@ integer, parameter :: acc_device_kind = 4 ! Keep in sync with include/gomp-constants.h. + integer (acc_device_kind), parameter :: acc_device_current = -3 integer (acc_device_kind), parameter :: acc_device_none = 0 integer (acc_device_kind), parameter :: acc_device_default = 1 integer (acc_device_kind), parameter :: acc_device_host = 2 @@ -46,6 +47,23 @@ integer (acc_device_kind), parameter :: acc_device_nvidia = 5 integer (acc_device_kind), parameter :: acc_device_radeon = 8 + integer, parameter :: acc_device_property_kind = 4 +! OpenACC 2.6/2.7/3.0 used acc_device_property; in a spec update the +! missing '_kind' was added for consistency. For backward compatibility, keep: + integer, parameter :: acc_device_property & + & = acc_device_property_kind + + integer (acc_device_property_kind), parameter :: & + & acc_property_memory = 1 + integer (acc_device_property_kind), parameter :: & + & acc_property_free_memory = 2 + integer (acc_device_property_kind), parameter :: & + & acc_property_name = int(Z'10001') + integer (acc_device_property_kind), parameter :: & + & acc_property_vendor = int(Z'10002') + integer (acc_device_property_kind), parameter :: & + & acc_property_driver = int(Z'10003') + integer, parameter :: acc_handle_kind = 4 ! Keep in sync with include/gomp-constants.h. @@ -55,17 +73,17 @@ integer, parameter :: openacc_version = 201711 interface acc_get_num_devices - function acc_get_num_devices_h (d) + function acc_get_num_devices_h (devicetype) import acc_device_kind integer acc_get_num_devices_h - integer (acc_device_kind) d + integer (acc_device_kind) devicetype end function end interface interface acc_set_device_type - subroutine acc_set_device_type_h (d) + subroutine acc_set_device_type_h (devicetype) import acc_device_kind - integer (acc_device_kind) d + integer (acc_device_kind) devicetype end subroutine end interface @@ -77,25 +95,50 @@ end interface interface acc_set_device_num - subroutine acc_set_device_num_h (n, d) + subroutine acc_set_device_num_h (devicenum, devicetype) import acc_device_kind - integer n - integer (acc_device_kind) d + integer devicenum + integer (acc_device_kind) devicetype end subroutine end interface interface acc_get_device_num - function acc_get_device_num_h (d) + function acc_get_device_num_h (devicetype) import acc_device_kind integer acc_get_device_num_h - integer (acc_device_kind) d + integer (acc_device_kind) devicetype end function end interface + interface acc_get_property + function acc_get_property_h (devicenum, devicetype, & + & property) + use iso_c_binding, only: c_size_t + import acc_device_kind, acc_device_property_kind + implicit none (type, external) + integer (c_size_t) :: acc_get_property_h + integer, value :: devicenum + integer (acc_device_kind), value :: devicetype + integer (acc_device_property_kind), value :: property + end function + end interface + + interface acc_get_property_string + subroutine acc_get_property_string_h (devicenum, devicetype, & + & property, string) + import acc_device_kind, acc_device_property_kind + implicit none (type, external) + integer, value :: devicenum + integer (acc_device_kind), value :: devicetype + integer (acc_device_property_kind), value :: property + character (*) :: string + end subroutine + end interface + interface acc_async_test - function acc_async_test_h (a) + function acc_async_test_h (arg) logical acc_async_test_h - integer a + integer arg end function end interface @@ -106,8 +149,8 @@ end interface interface acc_wait - subroutine acc_wait_h (a) - integer a + subroutine acc_wait_h (arg) + integer arg end subroutine end interface @@ -117,8 +160,8 @@ end interface interface acc_wait_async - subroutine acc_wait_async_h (a1, a2) - integer a1, a2 + subroutine acc_wait_async_h (arg, async) + integer arg, async end subroutine end interface @@ -134,8 +177,8 @@ end interface interface acc_wait_all_async - subroutine acc_wait_all_async_h (a) - integer a + subroutine acc_wait_all_async_h (async) + integer async end subroutine end interface @@ -167,14 +210,14 @@ interface acc_copyin subroutine acc_copyin_32_h (a, len) use iso_c_binding, only: c_int32_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len end subroutine subroutine acc_copyin_64_h (a, len) use iso_c_binding, only: c_int64_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len end subroutine @@ -187,14 +230,14 @@ interface acc_present_or_copyin subroutine acc_present_or_copyin_32_h (a, len) use iso_c_binding, only: c_int32_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len end subroutine subroutine acc_present_or_copyin_64_h (a, len) use iso_c_binding, only: c_int64_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len end subroutine @@ -213,14 +256,14 @@ interface acc_create subroutine acc_create_32_h (a, len) use iso_c_binding, only: c_int32_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len end subroutine subroutine acc_create_64_h (a, len) use iso_c_binding, only: c_int64_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len end subroutine @@ -233,14 +276,14 @@ interface acc_present_or_create subroutine acc_present_or_create_32_h (a, len) use iso_c_binding, only: c_int32_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len end subroutine subroutine acc_present_or_create_64_h (a, len) use iso_c_binding, only: c_int64_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len end subroutine @@ -259,14 +302,14 @@ interface acc_copyout subroutine acc_copyout_32_h (a, len) use iso_c_binding, only: c_int32_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len end subroutine subroutine acc_copyout_64_h (a, len) use iso_c_binding, only: c_int64_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len end subroutine @@ -279,14 +322,14 @@ interface acc_copyout_finalize subroutine acc_copyout_finalize_32_h (a, len) use iso_c_binding, only: c_int32_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len end subroutine subroutine acc_copyout_finalize_64_h (a, len) use iso_c_binding, only: c_int64_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len end subroutine @@ -299,14 +342,14 @@ interface acc_delete subroutine acc_delete_32_h (a, len) use iso_c_binding, only: c_int32_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len end subroutine subroutine acc_delete_64_h (a, len) use iso_c_binding, only: c_int64_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len end subroutine @@ -319,14 +362,14 @@ interface acc_delete_finalize subroutine acc_delete_finalize_32_h (a, len) use iso_c_binding, only: c_int32_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len end subroutine subroutine acc_delete_finalize_64_h (a, len) use iso_c_binding, only: c_int64_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len end subroutine @@ -339,14 +382,14 @@ interface acc_update_device subroutine acc_update_device_32_h (a, len) use iso_c_binding, only: c_int32_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len end subroutine subroutine acc_update_device_64_h (a, len) use iso_c_binding, only: c_int64_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len end subroutine @@ -359,14 +402,14 @@ interface acc_update_self subroutine acc_update_self_32_h (a, len) use iso_c_binding, only: c_int32_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len end subroutine subroutine acc_update_self_64_h (a, len) use iso_c_binding, only: c_int64_t - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len end subroutine @@ -385,7 +428,7 @@ function acc_is_present_32_h (a, len) use iso_c_binding, only: c_int32_t logical acc_is_present_32_h - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len end function @@ -393,7 +436,7 @@ function acc_is_present_64_h (a, len) use iso_c_binding, only: c_int64_t logical acc_is_present_64_h - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len end function @@ -411,7 +454,7 @@ subroutine acc_copyin_async_32_h (a, len, async) use iso_c_binding, only: c_int32_t import acc_handle_kind - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len integer (acc_handle_kind) async @@ -420,7 +463,7 @@ subroutine acc_copyin_async_64_h (a, len, async) use iso_c_binding, only: c_int64_t import acc_handle_kind - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len integer (acc_handle_kind) async @@ -437,7 +480,7 @@ subroutine acc_create_async_32_h (a, len, async) use iso_c_binding, only: c_int32_t import acc_handle_kind - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len integer (acc_handle_kind) async @@ -446,7 +489,7 @@ subroutine acc_create_async_64_h (a, len, async) use iso_c_binding, only: c_int64_t import acc_handle_kind - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len integer (acc_handle_kind) async @@ -463,7 +506,7 @@ subroutine acc_copyout_async_32_h (a, len, async) use iso_c_binding, only: c_int32_t import acc_handle_kind - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len integer (acc_handle_kind) async @@ -472,7 +515,7 @@ subroutine acc_copyout_async_64_h (a, len, async) use iso_c_binding, only: c_int64_t import acc_handle_kind - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len integer (acc_handle_kind) async @@ -489,7 +532,7 @@ subroutine acc_delete_async_32_h (a, len, async) use iso_c_binding, only: c_int32_t import acc_handle_kind - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len integer (acc_handle_kind) async @@ -498,7 +541,7 @@ subroutine acc_delete_async_64_h (a, len, async) use iso_c_binding, only: c_int64_t import acc_handle_kind - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len integer (acc_handle_kind) async @@ -515,7 +558,7 @@ subroutine acc_update_device_async_32_h (a, len, async) use iso_c_binding, only: c_int32_t import acc_handle_kind - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len integer (acc_handle_kind) async @@ -524,7 +567,7 @@ subroutine acc_update_device_async_64_h (a, len, async) use iso_c_binding, only: c_int64_t import acc_handle_kind - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len integer (acc_handle_kind) async @@ -541,7 +584,7 @@ subroutine acc_update_self_async_32_h (a, len, async) use iso_c_binding, only: c_int32_t import acc_handle_kind - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int32_t) len integer (acc_handle_kind) async @@ -550,7 +593,7 @@ subroutine acc_update_self_async_64_h (a, len, async) use iso_c_binding, only: c_int64_t import acc_handle_kind - !GCC$ ATTRIBUTES NO_ARG_CHECK :: a +!GCC$ ATTRIBUTES NO_ARG_CHECK :: a type (*), dimension (*) :: a integer (c_int64_t) len integer (acc_handle_kind) async -- 2.30.2