libgomp: Fixes + cleanup for OpenACC's Fortran module + openacc_lib.h
authorTobias Burnus <tobias@codesourcery.com>
Wed, 19 Feb 2020 08:13:44 +0000 (09:13 +0100)
committerTobias Burnus <tobias@codesourcery.com>
Wed, 19 Feb 2020 08:13:44 +0000 (09:13 +0100)
2020-02-19  Tobias Burnus  <tobias@codesourcery.com>

* .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 [new file with mode: 0644]
libgomp/ChangeLog
libgomp/config/accel/openacc.f90
libgomp/libgomp.texi
libgomp/openacc.f90
libgomp/openacc_lib.h

diff --git a/libgomp/.gitattributes b/libgomp/.gitattributes
new file mode 100644 (file)
index 0000000..47e74eb
--- /dev/null
@@ -0,0 +1,2 @@
+# For the Fortran file, complain about tabs
+openacc_lib.h whitespace=tab-in-indent,space-before-tab,trailing-space
index ef1c5dae66c4d694882f7d29f1d5552eeffe6a47..3c640c7350ba0bd4e20ee7db7808b2dbd8cbf769 100644 (file)
@@ -1,3 +1,34 @@
+2020-02-19  Tobias Burnus  <tobias@codesourcery.com>
+
+       * .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  <frederik@codesourcery.com>
 
        PR libgomp/93481
index a8e5144349e132453ac954d7c611a2097099e608..275afe43475c475e15a1d03cda47b489ac52335c 100644 (file)
@@ -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
index e0c7e01ba418c5f8644d88becadaa285fa0909fa..b946743f9b1abcdbfd1add5d8ce406c9acee6dd8 100644 (file)
@@ -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
index db39421bf07212af873b127178f5a41237296ec2..467fb612c548948f561d842cacfc94e05d3910ca 100644 (file)
 
 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)
index 92e1dd967af0273b089eeaa6f961b2300ba185e8..ee08e9787cc91829d5fb450cab8d7f5b064539e6 100644 (file)
@@ -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
       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.
       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
 
       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
 
       end interface
 
       interface acc_wait
-        subroutine acc_wait_h (a)
-          integer a
+        subroutine acc_wait_h (arg)
+          integer arg
         end subroutine
       end interface
 
       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
 
       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
 
       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
       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
       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
       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
       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
       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
       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
       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
       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
       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
         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
         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
         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
         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
         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
         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
         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
         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
         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
         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
         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
         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
         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
         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