From patchwork Mon Feb 19 21:36:51 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1901142 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=fail reason="signature verification failed" (2048-bit key; unprotected) header.d=baylibre-com.20230601.gappssmtp.com header.i=@baylibre-com.20230601.gappssmtp.com header.a=rsa-sha256 header.s=20230601 header.b=MSoo6SNe; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4TdwqQ2DGSz23cw for ; Tue, 20 Feb 2024 08:37:22 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 4725D3858D33 for ; Mon, 19 Feb 2024 21:37:20 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-ej1-x62b.google.com (mail-ej1-x62b.google.com [IPv6:2a00:1450:4864:20::62b]) by sourceware.org (Postfix) with ESMTPS id C77493858D20 for ; Mon, 19 Feb 2024 21:36:54 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org C77493858D20 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=baylibre.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=baylibre.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org C77493858D20 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::62b ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1708378619; cv=none; b=hd/TQIO6n295U6Ur/c4XzMNpfhNxkD1/yctHX1qSem0xQubU3+GDZadoRwCYietdlYPPuS8aoqGn2iV/lNFPZEzTRGFLqJ6HkyZ3Ci6duPVcthKzY+p8LHKBwcvX4tAf72DJRjf7t/ggCdWczDWrl55++B3/zgpUu5tJ/nOyjj8= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1708378619; c=relaxed/simple; bh=foMp0n06VLlsSHrpeivQoievvBCzTPs9JKAtGeq1+NA=; h=DKIM-Signature:Message-ID:Date:MIME-Version:To:From:Subject; b=q8OPy+ZfCK0sxaX7Mb3PfnV84PWQxQ5HfbQ+PS9R7xmXZnvmia7YBaE+qypeCQLAkYTMPlP60McKNUcwjtgwOc/k49bGy/1u6teU0bKM9GRmSEkKDdVH5r6CuQz1cEesYRHJ24DmaaKpjI6Jd262OZbpLMWKyGq+Y71AgyZbnrk= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-ej1-x62b.google.com with SMTP id a640c23a62f3a-a3122b70439so580196766b.3 for ; Mon, 19 Feb 2024 13:36:54 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=baylibre-com.20230601.gappssmtp.com; s=20230601; t=1708378613; x=1708983413; darn=gcc.gnu.org; h=subject:from:to:content-language:user-agent:mime-version:date :message-id:from:to:cc:subject:date:message-id:reply-to; bh=RLlreKtTJB8kBtAWQPYgSvly26waACWLA1kyydIYj70=; b=MSoo6SNe9UoMfULqs9gb/P4FWhoa7678I1l/0epCgy4bgp054nTWaeiaJs/1O5WHWI XUwamu0Q6ktKjmMHfyxm9mtynCltLGEOW8mUHPvDB3t2INUnuUmi4W45BGxKdKollvDt nLVepJEZFN19nJEPjFbzHx/O29LcttNcLsTbzjkXdD68oq0qgld5U+PMVha3TASCkSvb cfgsxfLz/FlSW9C8f5MAL+oZpPJZUVcuT/yFYB7ApSGxdWKyzpCb0Hub/x2rCxT7b9Qu yPc7wA/Y+1pjbK+VHkD1WlTlesWWyPitBr5SwSxZ/ZSNEJUvtw4PAydPX6WwjWMrdACb fvlA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1708378613; x=1708983413; h=subject:from:to:content-language:user-agent:mime-version:date :message-id:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=RLlreKtTJB8kBtAWQPYgSvly26waACWLA1kyydIYj70=; b=crRoTXOvyiEVRKP1hb6zJkQkMB1rdh3qifx4Exbpwh+lspKxBK91bkZHU4mGHcuQFx TIkPF5eggUISfFeHC+5r7fx0tr/DxauoMzXxm1NFtf9lSeukZM8N+hhyiADJeYAumY4k 6HS9PYcZSMezIt5Rh505D7ipCQy1sIJTNKxzw4uVfWdWTo3idH+bfcfYs231rq1L8AOk 5lpsnyJHYhTqISId5f0v/Ilt64b5rC/D0ZWsXKRktiptMHRdcSxSyuaAHUlk6TZXuu/9 uyaJzI9d8RacTiSNXxVE5i5xqnkcJ7xc8g6Iu/1ONJ/lpDqm2FuhftIvlicbvpxLrZQU Svig== X-Gm-Message-State: AOJu0Yx4xGItZVYtTIubRCLEWI4ru8orOf2ducp02i0dxmZ+tuI+vyf5 mhaA400JwRimXTxGPHvFiuhfNCpjpo6ut1hKsaiJMokR2awUJgV7YHEEXZwCWLtPqG8lpP1X0QK p X-Google-Smtp-Source: AGHT+IHXpw3W4musTwwOQSmnqduGBcyAENBkvtodrim1rBESJkKW3FuCEAThvxBHb4Zb8BmKhoAK+A== X-Received: by 2002:a17:906:4e8a:b0:a3e:973a:3d34 with SMTP id v10-20020a1709064e8a00b00a3e973a3d34mr2144764eju.10.1708378613152; Mon, 19 Feb 2024 13:36:53 -0800 (PST) Received: from ?IPV6:2001:16b8:2a3e:a000:b4dd:aa50:647b:4436? (200116b82a3ea000b4ddaa50647b4436.dip.versatel-1u1.de. [2001:16b8:2a3e:a000:b4dd:aa50:647b:4436]) by smtp.gmail.com with ESMTPSA id lu15-20020a170906facf00b00a3d1c0a3d5dsm3317443ejb.63.2024.02.19.13.36.52 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Mon, 19 Feb 2024 13:36:52 -0800 (PST) Message-ID: <3ef24b00-7ce1-43df-a62e-2817b2700fb9@baylibre.com> Date: Mon, 19 Feb 2024 22:36:51 +0100 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird Content-Language: en-US To: gcc-patches , Thomas Schwinge From: Tobias Burnus Subject: [patch] OpenACC: Add Fortran routines acc_{alloc,free,hostptr,deviceptr,memcpy_{to,from}_device*} X-Spam-Status: No, score=-12.0 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, GIT_PATCH_0, HTML_MESSAGE, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org While waiting for some testing to finish, I got distracted and added the very low hanging OpenACC 3.3 fruits, i.e. those Fortran routines that directly map to their C counter part. Comments, remarks? Tobias OpenACC: Add Fortran routines acc_{alloc,free,hostptr,deviceptr,memcpy_{to,from}_device*} These routines map simply to the C counterpart and are meanwhile defined in OpenACC 3.3. (There are additional routine changes, including the Fortran addition of acc_attach/acc_detach, that require more work than a simple addition of an interface and are therefore excluded.) libgomp/ChangeLog: * libgomp.texi (OpenACC Runtime Library Routines): Document new 3.3 routines that simply map to their C counterpart. * openacc.f90 (openacc_internal, openacc): Add them. * openacc_lib.h: Likewise. * testsuite/libgomp.fortran/acc_host_device_ptr.f90: New test. * testsuite/libgomp.oacc-fortran/acc-memcpy.f90: New test. libgomp/libgomp.texi | 171 ++++++++++++++++----- libgomp/openacc.f90 | 101 ++++++++++-- libgomp/openacc_lib.h | 94 ++++++++++- .../libgomp.fortran/acc_host_device_ptr.f90 | 43 ++++++ .../testsuite/libgomp.oacc-fortran/acc-memcpy.f90 | 47 ++++++ 5 files changed, 399 insertions(+), 57 deletions(-) diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi index f57190f203c..d7da799a922 100644 --- a/libgomp/libgomp.texi +++ b/libgomp/libgomp.texi @@ -2157,8 +2157,6 @@ dimensions. Running this routine in a @code{target} region is not supported except on the initial device. - - @item @emph{C/C++} @multitable @columnfractions .20 .80 @item @emph{Prototype}: @tab @code{int omp_target_memcpy_rect_async(void *dst,} @@ -4684,7 +4682,6 @@ returns @code{false}. @item @tab @code{logical acc_on_device} @end multitable - @item @emph{Reference}: @uref{https://www.openacc.org, OpenACC specification v2.6}, section 3.2.17. @@ -4696,17 +4693,24 @@ returns @code{false}. @section @code{acc_malloc} -- Allocate device memory. @table @asis @item @emph{Description} -This function allocates @var{len} bytes of device memory. It returns +This function allocates @var{bytes} of device memory. It returns the device address of the allocated memory. @item @emph{C/C++}: @multitable @columnfractions .20 .80 -@item @emph{Prototype}: @tab @code{d_void* acc_malloc(size_t len);} +@item @emph{Prototype}: @tab @code{d_void* acc_malloc(size_t bytes);} +@end multitable + +@item @emph{Fortran}: +@multitable @columnfractions .20 .80 +@item @emph{Interface}: @tab @code{type(c_ptr) function acc_malloc(bytes)} +@item @tab @code{integer(c_size_t), value :: bytes} @end multitable @item @emph{Reference}: @uref{https://www.openacc.org, OpenACC specification v2.6}, section -3.2.18. +3.2.18. @uref{https://www.openacc.org, openacc specification v3.3}, section +3.2.16. @end table @@ -4715,16 +4719,23 @@ the device address of the allocated memory. @section @code{acc_free} -- Free device memory. @table @asis @item @emph{Description} -Free previously allocated device memory at the device address @code{a}. +Free previously allocated device memory at the device address @code{data_dev}. @item @emph{C/C++}: @multitable @columnfractions .20 .80 -@item @emph{Prototype}: @tab @code{acc_free(d_void *a);} +@item @emph{Prototype}: @tab @code{void acc_free(d_void *data_dev);} +@end multitable + +@item @emph{Fortran}: +@multitable @columnfractions .20 .80 +@item @emph{Interface}: @tab @code{subroutine acc_free(data_dev)} +@item @tab @code{type(c_ptr), value :: data_dev} @end multitable @item @emph{Reference}: @uref{https://www.openacc.org, OpenACC specification v2.6}, section -3.2.19. +3.2.19. @uref{https://www.openacc.org, openacc specification v3.3}, section +3.2.17. @end table @@ -5092,17 +5103,26 @@ array element and @var{len} specifies the length in bytes. @table @asis @item @emph{Description} This function maps previously allocated device and host memory. The device -memory is specified with the device address @var{d}. The host memory is -specified with the host address @var{h} and a length of @var{len}. +memory is specified with the device address @var{data_dev}. The host memory is +specified with the host address @var{data_arg} and a length of @var{bytes}. @item @emph{C/C++}: @multitable @columnfractions .20 .80 -@item @emph{Prototype}: @tab @code{acc_map_data(h_void *h, d_void *d, size_t len);} +@item @emph{Prototype}: @tab @code{void acc_map_data(h_void *data_arg, d_void *data_dev, size_t bytes);} +@end multitable + +@item @emph{Fortran}: +@multitable @columnfractions .20 .80 +@item @emph{Interface}: @tab @code{subroutine acc_map_data(data_arg, data_dev, bytes)} +@item @tab @code{type(*), dimension(*) :: data_arg} +@item @tab @code{type(c_ptr), value :: data_dev} +@item @tab @code{integer(c_size_t), value :: bytes} @end multitable @item @emph{Reference}: @uref{https://www.openacc.org, OpenACC specification v2.6}, section -3.2.26. +3.2.26. @uref{https://www.openacc.org, OpenACC specification v3.3}, section +3.2.21. @end table @@ -5112,16 +5132,23 @@ specified with the host address @var{h} and a length of @var{len}. @table @asis @item @emph{Description} This function unmaps previously mapped device and host memory. The latter -specified by @var{h}. +specified by @var{data_arg}. @item @emph{C/C++}: @multitable @columnfractions .20 .80 -@item @emph{Prototype}: @tab @code{acc_unmap_data(h_void *h);} +@item @emph{Prototype}: @tab @code{void acc_unmap_data(h_void *data_arg);} +@end multitable + +@item @emph{Fortran}: +@multitable @columnfractions .20 .80 +@item @emph{Interface}: @tab @code{subroutine acc_unmap_data(data_arg)} +@item @tab @code{type(*), dimension(*) :: data_arg} @end multitable @item @emph{Reference}: @uref{https://www.openacc.org, OpenACC specification v2.6}, section -3.2.27. +3.2.27. @uref{https://www.openacc.org, OpenACC specification v3.3}, section +3.2.22. @end table @@ -5131,16 +5158,23 @@ specified by @var{h}. @table @asis @item @emph{Description} This function returns the device address that has been mapped to the -host address specified by @var{h}. +host address specified by @var{data_arg}. @item @emph{C/C++}: @multitable @columnfractions .20 .80 -@item @emph{Prototype}: @tab @code{void *acc_deviceptr(h_void *h);} +@item @emph{Prototype}: @tab @code{void *acc_deviceptr(h_void *data_arg);} +@end multitable + +@item @emph{Fortran}: +@multitable @columnfractions .20 .80 +@item @emph{Interface}: @tab @code{type(c_ptr) function acc_deviceptr(data_arg)} +@item @tab @code{type(*), dimension(*) :: data_arg} @end multitable @item @emph{Reference}: @uref{https://www.openacc.org, OpenACC specification v2.6}, section -3.2.28. +3.2.28. @uref{https://www.openacc.org, OpenACC specification v3.3}, section +3.2.23. @end table @@ -5150,16 +5184,23 @@ host address specified by @var{h}. @table @asis @item @emph{Description} This function returns the host address that has been mapped to the -device address specified by @var{d}. +device address specified by @var{data_dev}. @item @emph{C/C++}: @multitable @columnfractions .20 .80 -@item @emph{Prototype}: @tab @code{void *acc_hostptr(d_void *d);} +@item @emph{Prototype}: @tab @code{void *acc_hostptr(d_void *data_dev);} +@end multitable + +@item @emph{Fortran}: +@multitable @columnfractions .20 .80 +@item @emph{Interface}: @tab @code{type(c_ptr) function acc_hostptr(data_dev)} +@item @tab @code{type(c_ptr), value :: data_dev} @end multitable @item @emph{Reference}: @uref{https://www.openacc.org, OpenACC specification v2.6}, section -3.2.29. +3.2.29. @uref{https://www.openacc.org, OpenACC specification v3.3}, section +3.2.24. @end table @@ -5207,18 +5248,34 @@ a @code{false} is return to indicate the mapped memory is not present. @section @code{acc_memcpy_to_device} -- Copy host memory to device memory. @table @asis @item @emph{Description} -This function copies host memory specified by host address of @var{src} to -device memory specified by the device address @var{dest} for a length of -@var{bytes} bytes. +This function copies host memory specified by host address of +@var{data_host_src} to device memory specified by the device address +@var{data_dev_dest} for a length of @var{bytes} bytes. @item @emph{C/C++}: @multitable @columnfractions .20 .80 -@item @emph{Prototype}: @tab @code{acc_memcpy_to_device(d_void *dest, h_void *src, size_t bytes);} +@item @emph{Prototype}: @tab @code{void acc_memcpy_to_device(d_void* data_dev_dest,} +@item @tab @code{h_void* data_host_src, size_t bytes);} +@item @emph{Prototype}: @tab @code{void acc_memcpy_to_device_async(d_void* data_dev_dest,} +@item @tab @code{h_void* data_host_src, size_t bytes, int async_arg);} +@end multitable + +@item @emph{Fortran}: +@multitable @columnfractions .20 .80 +@item @emph{Interface}: @tab @code{subroutine acc_memcpy_to_device(data_dev_dest, &} +@item @tab @code{data_host_src, bytes)} +@item @emph{Interface}: @tab @code{subroutine acc_memcpy_to_device_async(data_dev_dest, &} +@item @tab @code{data_host_src, bytes, async_arg)} +@item @tab @code{type(c_ptr), value :: data_dev_dest} +@item @tab @code{type(*), dimension(*) :: data_host_src} +@item @tab @code{integer(c_size_t), value :: bytes} +@item @tab @code{integer(acc_handle_kind), value :: async_arg} @end multitable @item @emph{Reference}: @uref{https://www.openacc.org, OpenACC specification v2.6}, section -3.2.31. +3.2.31 @uref{https://www.openacc.org, OpenACC specification v3.3}, section +3.2.26.. @end table @@ -5227,18 +5284,34 @@ device memory specified by the device address @var{dest} for a length of @section @code{acc_memcpy_from_device} -- Copy device memory to host memory. @table @asis @item @emph{Description} -This function copies host memory specified by host address of @var{src} from -device memory specified by the device address @var{dest} for a length of -@var{bytes} bytes. +This function copies device memory specified by device address of +@var{data_dev_src} to host memory specified by the host address +@var{data_host_dest} for a length of @var{bytes} bytes. @item @emph{C/C++}: @multitable @columnfractions .20 .80 -@item @emph{Prototype}: @tab @code{acc_memcpy_from_device(d_void *dest, h_void *src, size_t bytes);} +@item @emph{Prototype}: @tab @code{void acc_memcpy_from_device(h_void* data_host_dest,} +@item @tab @code{d_void* data_dev_src, size_t bytes);} +@item @emph{Prototype}: @tab @code{void acc_memcpy_from_device_async(h_void* data_host_dest,} +@item @tab @code{d_void* data_dev_src, size_t bytes, int async_arg);} +@end multitable + +@item @emph{Fortran}: +@multitable @columnfractions .20 .80 +@item @emph{Interface}: @tab @code{subroutine acc_memcpy_from_device(data_host_dest, &} +@item @tab @code{data_dev_src, bytes)} +@item @emph{Interface}: @tab @code{subroutine acc_memcpy_from_device_async(data_host_dest, &} +@item @tab @code{data_dev_src, bytes, async_arg)} +@item @tab @code{type(*), dimension(*) :: data_host_dest} +@item @tab @code{type(c_ptr), value :: data_dev_src} +@item @tab @code{integer(c_size_t), value :: bytes} +@item @tab @code{integer(acc_handle_kind), value :: async_arg} @end multitable @item @emph{Reference}: @uref{https://www.openacc.org, OpenACC specification v2.6}, section -3.2.32. +3.2.32. @uref{https://www.openacc.org, OpenACC specification v3.3}, section +3.2.27. @end table @@ -5252,13 +5325,23 @@ address to pointing to the corresponding device data. @item @emph{C/C++}: @multitable @columnfractions .20 .80 -@item @emph{Prototype}: @tab @code{acc_attach(h_void **ptr);} -@item @emph{Prototype}: @tab @code{acc_attach_async(h_void **ptr, int async);} +@item @emph{Prototype}: @tab @code{void acc_attach(h_void **ptr_addr);} +@item @emph{Prototype}: @tab @code{void acc_attach_async(h_void **ptr_addr, int async);} @end multitable +@c @item @emph{Fortran}: +@c @multitable @columnfractions .20 .80 +@c @item @emph{Interface}: @tab @code{subroutine acc_attach(ptr_addr)} +@c @item @emph{Interface}: @tab @code{subroutine acc_attach_async(ptr_addr, async_arg)} +@c @item @tab @code{type(*), dimension(..) :: ptr_addr} +@c @item @tab @code{integer(acc_handle_kind), value :: async_arg} +@c @end multitable + @item @emph{Reference}: @uref{https://www.openacc.org, OpenACC specification v2.6}, section 3.2.34. +@c @uref{https://www.openacc.org, OpenACC specification v3.3}, section +@c 3.2.29. @end table @@ -5272,15 +5355,27 @@ address to pointing to the corresponding host data. @item @emph{C/C++}: @multitable @columnfractions .20 .80 -@item @emph{Prototype}: @tab @code{acc_detach(h_void **ptr);} -@item @emph{Prototype}: @tab @code{acc_detach_async(h_void **ptr, int async);} -@item @emph{Prototype}: @tab @code{acc_detach_finalize(h_void **ptr);} -@item @emph{Prototype}: @tab @code{acc_detach_finalize_async(h_void **ptr, int async);} +@item @emph{Prototype}: @tab @code{void acc_detach(h_void **ptr_addr);} +@item @emph{Prototype}: @tab @code{void acc_detach_async(h_void **ptr_addr, int async);} +@item @emph{Prototype}: @tab @code{void acc_detach_finalize(h_void **ptr_addr);} +@item @emph{Prototype}: @tab @code{void acc_detach_finalize_async(h_void **ptr_addr, int async);} @end multitable +@c @item @emph{Fortran}: +@c @multitable @columnfractions .20 .80 +@c @item @emph{Interface}: @tab @code{subroutine acc_detach(ptr_addr)} +@c @item @emph{Interface}: @tab @code{subroutine acc_detach_async(ptr_addr, async_arg)} +@c @item @emph{Interface}: @tab @code{subroutine acc_detach_finalize(ptr_addr)} +@c @item @emph{Interface}: @tab @code{subroutine acc_detach_finalize_async(ptr_addr, async_arg)} +@c @item @tab @code{type(*), dimension(..) :: ptr_addr} +@c @item @tab @code{integer(acc_handle_kind), value :: async_arg} +@c @end multitable + @item @emph{Reference}: @uref{https://www.openacc.org, OpenACC specification v2.6}, section 3.2.35. +@c @uref{https://www.openacc.org, OpenACC specification v3.3}, section +@c 3.2.29. @end table diff --git a/libgomp/openacc.f90 b/libgomp/openacc.f90 index 7270653a98a..42db07a757d 100644 --- a/libgomp/openacc.f90 +++ b/libgomp/openacc.f90 @@ -758,6 +758,93 @@ module openacc_internal integer (c_int), value :: async end subroutine end interface + + interface + type(c_ptr) function acc_malloc (bytes) bind(C) + use iso_c_binding, only: c_ptr, c_size_t + integer(c_size_t), value :: bytes + end function + end interface + + interface + subroutine acc_free (data_dev) bind(C) + use iso_c_binding, only: c_ptr + type(c_ptr), value :: data_dev + end subroutine + end interface + + interface + subroutine acc_map_data (data_arg, data_dev, bytes) bind(C) + use iso_c_binding, only: c_ptr, c_size_t + type(*), dimension(*) :: data_arg + type(c_ptr), value :: data_dev + integer(c_size_t), value :: bytes + end subroutine + end interface + + interface + subroutine acc_unmap_data (data_arg) bind(C) + type(*), dimension(*) :: data_arg + end subroutine + end interface + + interface + type(c_ptr) function acc_deviceptr (data_arg) bind(C) + use iso_c_binding, only: c_ptr + type(*), dimension(*) :: data_arg + end function + end interface + + interface + type(c_ptr) function acc_hostptr (data_dev) bind(C) + use iso_c_binding, only: c_ptr + type(c_ptr), value :: data_dev + end function + end interface + + interface + subroutine acc_memcpy_to_device (data_dev_dest, data_host_src, & + bytes) bind(C) + use iso_c_binding, only: c_ptr, c_size_t + type(c_ptr), value :: data_dev_dest + type(*),dimension(*) :: data_host_src + integer(c_size_t), value :: bytes + end subroutine + end interface + + interface + subroutine acc_memcpy_to_device_async (data_dev_dest, data_host_src, & + bytes, async_arg) bind(C) + use iso_c_binding, only: c_ptr, c_size_t + import :: acc_handle_kind + type(c_ptr), value :: data_dev_dest + type(*),dimension(*) :: data_host_src + integer(c_size_t), value :: bytes + integer(acc_handle_kind), value :: async_arg + end subroutine + end interface + + interface + subroutine acc_memcpy_from_device (data_host_dest, data_dev_src, & + bytes) bind(C) + use iso_c_binding, only: c_ptr, c_size_t + type(*),dimension(*) :: data_host_dest + type(c_ptr), value :: data_dev_src + integer(c_size_t), value :: bytes + end subroutine + end interface + + interface + subroutine acc_memcpy_from_device_async (data_host_dest, data_dev_src, & + bytes, async_arg) bind(C) + use iso_c_binding, only: c_ptr, c_size_t + import :: acc_handle_kind + type(*),dimension(*) :: data_host_dest + type(c_ptr), value :: data_dev_src + integer(c_size_t), value :: bytes + integer(acc_handle_kind), value :: async_arg + end subroutine + end interface end module openacc_internal module openacc @@ -794,6 +881,9 @@ module openacc public :: acc_copyin_async, acc_create_async, acc_copyout_async public :: acc_delete_async, acc_update_device_async, acc_update_self_async public :: acc_copyout_finalize, acc_delete_finalize + public :: acc_malloc, acc_free, acc_map_data, acc_unmap_data, acc_deviceptr + public :: acc_hostptr, acc_memcpy_to_device, acc_memcpy_to_device_async + public :: acc_memcpy_from_device, acc_memcpy_from_device_async integer, parameter :: openacc_version = 201711 @@ -871,9 +961,6 @@ module openacc procedure :: acc_on_device_h end interface - ! acc_malloc: Only available in C/C++ - ! acc_free: Only available in C/C++ - ! As vendor extension, the following code supports both 32bit and 64bit ! arguments for "size"; the OpenACC standard only permits default-kind ! integers, which are of kind 4 (i.e. 32 bits). @@ -953,20 +1040,12 @@ module openacc procedure :: acc_update_self_array_h end interface - ! acc_map_data: Only available in C/C++ - ! acc_unmap_data: Only available in C/C++ - ! acc_deviceptr: Only available in C/C++ - ! acc_hostptr: Only available in C/C++ - interface acc_is_present procedure :: acc_is_present_32_h procedure :: acc_is_present_64_h procedure :: acc_is_present_array_h end interface - ! acc_memcpy_to_device: Only available in C/C++ - ! acc_memcpy_from_device: Only available in C/C++ - interface acc_copyin_async procedure :: acc_copyin_async_32_h procedure :: acc_copyin_async_64_h diff --git a/libgomp/openacc_lib.h b/libgomp/openacc_lib.h index dfbf0a75a8f..913c3f1aa3d 100644 --- a/libgomp/openacc_lib.h +++ b/libgomp/openacc_lib.h @@ -204,8 +204,19 @@ end function end interface - ! acc_malloc: Only available in C/C++ - ! acc_free: Only available in C/C++ + interface + type(c_ptr) function acc_malloc(bytes) bind(C) + use iso_c_binding, only: c_ptr, c_size_t + integer(c_size_t), value :: bytes + end function + end interface + + interface + subroutine acc_free(data_dev) bind(C) + use iso_c_binding, only: c_ptr + type(c_ptr), value :: data_dev + end subroutine + end interface interface acc_copyin subroutine acc_copyin_32_h (a, len) @@ -419,10 +430,34 @@ end subroutine end interface - ! acc_map_data: Only available in C/C++ - ! acc_unmap_data: Only available in C/C++ - ! acc_deviceptr: Only available in C/C++ - ! acc_hostptr: Only available in C/C++ + interface + subroutine acc_map_data(data_arg, data_dev, bytes) bind(C) + use iso_c_binding, only: c_ptr, c_size_t + type(*), dimension(*) :: data_arg + type(c_ptr), value :: data_dev + integer(c_size_t), value :: bytes + end subroutine + end interface + + interface + subroutine acc_unmap_data(data_arg) bind(C) + type(*), dimension(*) :: data_arg + end subroutine + end interface + + interface + type(c_ptr) function acc_deviceptr(data_arg) bind(C) + use iso_c_binding, only: c_ptr + type(*), dimension(*) :: data_arg + end function + end interface + + interface + type(c_ptr) function acc_hostptr(data_dev) bind(C) + use iso_c_binding, only: c_ptr + type(c_ptr), value :: data_dev + end function + end interface interface acc_is_present function acc_is_present_32_h (a, len) @@ -447,8 +482,51 @@ end function end interface - ! acc_memcpy_to_device: Only available in C/C++ - ! acc_memcpy_from_device: Only available in C/C++ + interface + subroutine acc_memcpy_to_device(data_dev_dest, data_host_src, & + & bytes) bind(C) + use iso_c_binding, only: c_ptr, c_size_t + type(c_ptr), value :: data_dev_dest + type(*),dimension(*) :: data_host_src + integer(c_size_t), value :: bytes + end subroutine + end interface + + interface + subroutine acc_memcpy_to_device_async(data_dev_dest, & + & data_host_src, bytes, & + & async_arg) bind(C) + use iso_c_binding, only: c_ptr, c_size_t + import :: acc_handle_kind + type(c_ptr), value :: data_dev_dest + type(*),dimension(*) :: data_host_src + integer(c_size_t), value :: bytes + integer(acc_handle_kind), value :: async_arg + end subroutine + end interface + + interface + subroutine acc_memcpy_from_device(data_host_dest, & + & data_dev_src, bytes) bind(C) + use iso_c_binding, only: c_ptr, c_size_t + type(*),dimension(*) :: data_host_dest + type(c_ptr), value :: data_dev_src + integer(c_size_t), value :: bytes + end subroutine + end interface + + interface + subroutine acc_memcpy_from_device_async(data_host_dest, & + & data_dev_src, bytes, & + & async_arg) bind(C) + use iso_c_binding, only: c_ptr, c_size_t + import :: acc_handle_kind + type(*),dimension(*) :: data_host_dest + type(c_ptr), value :: data_dev_src + integer(c_size_t), value :: bytes + integer(acc_handle_kind), value :: async_arg + end subroutine + end interface interface acc_copyin_async subroutine acc_copyin_async_32_h (a, len, async) diff --git a/libgomp/testsuite/libgomp.fortran/acc_host_device_ptr.f90 b/libgomp/testsuite/libgomp.fortran/acc_host_device_ptr.f90 new file mode 100644 index 00000000000..56b9597dadf --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/acc_host_device_ptr.f90 @@ -0,0 +1,43 @@ +! { dg-do run } +! { dg-skip-if "" { *-*-* } { "*" } { "-DACC_MEM_SHARED=0" } } + +! Fortran version of libgomp.oacc-c-c++-common/lib-59.c + +program main + use iso_c_binding + use openacc + implicit none (type, external) + + integer(c_size_t), parameter :: N = 256 + character(c_char), allocatable, target :: h_data(:) + type(c_ptr) :: dptr, dptr_t + integer(c_intptr_t) :: iptr, i + + allocate(h_data(0:N)) + dptr = acc_malloc (N+1) + + call acc_map_data (h_data, dptr, N+1) + + ! The following assumes sizeof(void*) being the same on host and device: + do i = 0, N + dptr_t = transfer (transfer(dptr, iptr) + i, dptr_t) + if (.not. c_associated (acc_hostptr (dptr_t), c_loc (h_data(i)))) & + stop 1 + if (.not. c_associated (dptr_t, acc_deviceptr (h_data(i)))) & + stop 2 + end do + + call acc_unmap_data (h_data) + + do i = 0, N + dptr_t = transfer (transfer(dptr, iptr) + i, dptr_t) + if (c_associated (acc_hostptr (dptr_t))) & + stop 3 + if (c_associated (acc_deviceptr (h_data(i)))) & + stop 4 + end do + + call acc_free (dptr) + + deallocate (h_data) +end diff --git a/libgomp/testsuite/libgomp.oacc-fortran/acc-memcpy.f90 b/libgomp/testsuite/libgomp.oacc-fortran/acc-memcpy.f90 new file mode 100644 index 00000000000..670dc50ff07 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/acc-memcpy.f90 @@ -0,0 +1,47 @@ +! { dg-do run } +! { dg-skip-if "" { *-*-* } { "*" } { "-DACC_MEM_SHARED=0" } } + +! based on libgomp.oacc-c-c++-common/lib-60.c + +program main + use openacc + use iso_fortran_env + use iso_c_binding + implicit none (type, external) + integer(int8), allocatable :: char(:) + type(c_ptr) :: dptr + integer(c_intptr_t) :: i + integer(int8) :: j + + allocate(char(-128:127)) + do i = -128, 127 + char(j) = int (j, int8) + end do + + dptr = acc_malloc (256_c_size_t) + call acc_memcpy_to_device (dptr, char, 255_c_size_t) + + do i = 0, 255 + if (acc_is_present (transfer (transfer(char, i) + i, dptr), 1)) & + stop 1 + end do + + char = 0_int8 + + call acc_memcpy_from_device (char, dptr, 256_c_size_t) + + do i = -128, 127 + char(i) = int (j, int8) + if (char(i) /= j) & + stop 2 + end do + + do i = 0, 255 + if (acc_is_present (transfer (transfer(char, i) + i, dptr), 1)) & + stop 3 + end do + + call acc_free (dptr) + + deallocate (char) +end