Add OpenACC 2.6 `acc_get_property' support

Add generic support for the OpenACC 2.6 `acc_get_property' and
`acc_get_property_string' routines, as well as full handlers for the
host and the NVPTX offload targets and minimal handlers for the HSA,
Intel MIC, and AMD GCN offload targets.

Included are C/C++ and Fortran tests that, in particular, print
the property values for acc_property_vendor, acc_property_memory,
acc_property_free_memory, acc_property_name, and acc_property_driver.
The output looks as follows:

Vendor: GNU
Name: GOMP
Total memory: 0
Free memory: 0
Driver: 1.0

with the host driver (where the memory related properties are not
supported for the host device and yield 0, conforming to the standard)
and output like:

Vendor: Nvidia
Total memory: 12651462656
Free memory: 12202737664
Name: TITAN V
Driver: CUDA Driver 9.1

with the NVPTX driver.

2019-12-22  Maciej W. Rozycki  <macro@codesourcery.com>
	    Frederik Harwath  <frederik@codesourcery.com>
	    Thomas Schwinge  <tschwinge@codesourcery.com>

	include/
	* gomp-constants.h (gomp_device_property): New enum.

	libgomp/
	* libgomp.h (gomp_device_descr): Add `get_property_func' member.
	* libgomp-plugin.h (gomp_device_property_value): New union.
	(gomp_device_property_value): New prototype.
	* openacc.h (acc_device_t): Add `acc_device_current' enumeration
	constant.
	(acc_device_property_t): New enum.
	(acc_get_property, acc_get_property_string): New prototypes.
	* oacc-init.c (acc_get_device_type): Also assert that result
	is not `acc_device_current'.
	(get_property_any, acc_get_property, acc_get_property_string):
	New functions.
	* openacc.f90 (openacc_kinds): Add `acc_device_current' and
	`acc_property_memory', `acc_property_free_memory',
	`acc_property_name', `acc_property_vendor' and
	`acc_property_driver' constants.  Add `acc_device_property' data
	type.
	(openacc_internal): Add `acc_get_property' and
	`acc_get_property_string' interfaces.  Add `acc_get_property_h',
	`acc_get_property_string_h', `acc_get_property_l' and
	`acc_get_property_string_l'.
	* oacc-host.c (host_get_property): New function.
	(host_dispatch): Wire it.
	* target.c (gomp_load_plugin_for_device): Handle `get_property'.
	* libgomp.map (OACC_2.6): Add `acc_get_property', `acc_get_property_h_',
	`acc_get_property_string' and `acc_get_property_string_h_' symbols.
	* libgomp.texi (OpenACC Runtime Library Routines): Add
	`acc_get_property'.
	(acc_get_property): New node.
	* plugin/plugin-gcn.c (GOMP_OFFLOAD_get_property): New
	function (stub).
	* plugin/plugin-hsa.c (GOMP_OFFLOAD_get_property): New function.
	* plugin/plugin-nvptx.c (CUDA_CALLS): Add `cuDeviceGetName',
	`cuDeviceTotalMem', `cuDriverGetVersion' and `cuMemGetInfo'
	calls.
	(GOMP_OFFLOAD_get_property): New function.
	(struct ptx_device): Add new field "name".
	(cuda_driver_version_s): Add new static variable ...
	(nvptx_init): ... and init from here.

	* testsuite/libgomp.oacc-c-c++-common/acc_get_property.c: New test.
	* testsuite/libgomp.oacc-c-c++-common/acc_get_property-2.c: New test.
	* testsuite/libgomp.oacc-c-c++-common/acc_get_property-3.c: New test.
	* testsuite/libgomp.oacc-c-c++-common/acc_get_property-aux.c: New file
	with test helper functions.

	* testsuite/libgomp.oacc-fortran/acc_get_property.f90: New test.

	liboffloadmic/
	* plugin/libgomp-plugin-intelmic.cpp (GOMP_OFFLOAD_get_property):
	New function.

Reviewed-by: Thomas Schwinge <thomas@codesourcery.com>


Co-Authored-By: Frederik Harwath <frederik@codesourcery.com>
Co-Authored-By: Thomas Schwinge <tschwinge@codesourcery.com>

From-SVN: r279710

1 files changed, 125 insertions, 4 deletions

diff --git a/libgomp/openacc.f90 b/libgomp/openacc.f90
index fb7fc6e6d77..e5b4b40c3cc 100644
--- a/libgomp/openacc.f90
+++ b/libgomp/openacc.f90
@@ -31,16 +31,18 @@
 
 module openacc_kinds
   use iso_fortran_env, only: int32
+  use iso_c_binding, only: c_size_t
   implicit none
 
   public
-  private :: int32
+  private :: int32, c_size_t
 
   ! When adding items, also update 'public' setting in 'module openacc' below.
 
   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
@@ -49,6 +51,15 @@ module openacc_kinds
   integer (acc_device_kind), parameter :: acc_device_nvidia = 5
   integer (acc_device_kind), parameter :: acc_device_gcn = 8
 
+  integer, parameter :: acc_device_property = c_size_t
+
+  ! Keep in sync with include/gomp-constants.h.
+  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, parameter :: acc_handle_kind = int32
 
   ! Keep in sync with include/gomp-constants.h.
@@ -89,6 +100,24 @@ module openacc_internal
       integer (acc_device_kind) d
     end function
 
+    function acc_get_property_h (n, d, p)
+      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
+    end function
+
+    subroutine acc_get_property_string_h (n, d, p, s)
+      import
+      implicit none (type, external)
+      integer, value :: n
+      integer (acc_device_kind), value :: d
+      integer (acc_device_property), value :: p
+      character (*) :: s
+    end subroutine
+
     function acc_async_test_h (a)
       logical acc_async_test_h
       integer a
@@ -508,6 +537,26 @@ module openacc_internal
       integer (c_int), value :: d
     end function
 
+    function acc_get_property_l (n, d, p) &
+        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
+    end function
+
+    function acc_get_property_string_l (n, d, p) &
+        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
+    end function
+
     function acc_async_test_l (a) &
         bind (C, name = "acc_async_test")
       use iso_c_binding, only: c_int
@@ -716,16 +765,23 @@ module openacc
   private
 
   ! From openacc_kinds
-  public :: acc_device_kind, acc_handle_kind
+  public :: acc_device_kind
   public :: acc_device_none, acc_device_default, acc_device_host
   public :: acc_device_not_host, acc_device_nvidia, acc_device_gcn
+
+  public :: acc_device_property
+  public :: acc_property_memory, acc_property_free_memory
+  public :: acc_property_name, acc_property_vendor, acc_property_driver
+
+  public :: acc_handle_kind
   public :: acc_async_noval, acc_async_sync
 
   public :: openacc_version
 
   public :: acc_get_num_devices, acc_set_device_type, acc_get_device_type
-  public :: acc_set_device_num, acc_get_device_num, acc_async_test
-  public :: acc_async_test_all
+  public :: acc_set_device_num, acc_get_device_num
+  public :: acc_get_property, acc_get_property_string
+  public :: acc_async_test, acc_async_test_all
   public :: acc_wait, acc_async_wait, acc_wait_async
   public :: acc_wait_all, acc_async_wait_all, acc_wait_all_async
   public :: acc_init, acc_shutdown, acc_on_device
@@ -758,6 +814,14 @@ module openacc
     procedure :: acc_get_device_num_h
   end interface
 
+  interface acc_get_property
+    procedure :: acc_get_property_h
+  end interface
+
+  interface acc_get_property_string
+    procedure :: acc_get_property_string_h
+  end interface
+
   interface acc_async_test
     procedure :: acc_async_test_h
   end interface
@@ -976,6 +1040,63 @@ function acc_get_device_num_h (d)
   acc_get_device_num_h = acc_get_device_num_l (d)
 end function
 
+function acc_get_property_h (n, d, p)
+  use iso_c_binding, only: c_int, 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)
+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
+  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 (c_int) :: pint
+  type (c_ptr) :: cptr
+  integer :: clen
+  character (kind=c_char, len=1), pointer, contiguous :: sptr (:)
+  integer :: slen
+  integer :: i
+
+  interface
+     function strlen (s) bind (C, name = "strlen")
+       use iso_c_binding, only: c_ptr, c_size_t
+       type (c_ptr), intent(in), value :: s
+       integer (c_size_t) :: strlen
+     end function strlen
+  end interface
+
+  pint = int (p, c_int)
+  cptr = acc_get_property_string_l (n, d, pint)
+  s = ""
+  if (.not. c_associated (cptr)) then
+     return
+  end if
+
+  clen = int (strlen (cptr))
+  call c_f_pointer (cptr, sptr, [clen])
+
+  slen = min (clen, len (s))
+  do i = 1, slen
+    s (i:i) = sptr (i)
+  end do
+end subroutine
+
 function acc_async_test_h (a)
   use openacc_internal, only: acc_async_test_l
   logical acc_async_test_h