flang/runtime/CUDA/allocatable.cpp

   1 //===-- runtime/CUDA/allocatable.cpp --------------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 #include "flang/Runtime/CUDA/allocatable.h"
  10 #include "../stat.h"
  11 #include "../terminator.h"
  12 #include "flang/Runtime/CUDA/common.h"
  13 #include "flang/Runtime/CUDA/descriptor.h"
  14 #include "flang/Runtime/allocatable.h"
  15
  16 #include "cuda_runtime.h"
  17
  18 namespace Fortran::runtime::cuda {
  19
  20 extern "C" {
  21 RT_EXT_API_GROUP_BEGIN
  22
  23 int RTDEF(CUFAllocatableAllocate)(Descriptor &desc, bool hasStat,
  24     const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
  25   if (desc.HasAddendum()) {
  26     Terminator terminator{sourceFile, sourceLine};
  27     // TODO: This require a bit more work to set the correct type descriptor
  28     // address
  29     terminator.Crash(
  30         "not yet implemented: CUDA descriptor allocation with addendum");
  31   }
  32   // Perform the standard allocation.
  33   int stat{RTNAME(AllocatableAllocate)(
  34       desc, hasStat, errMsg, sourceFile, sourceLine)};
  35 #ifndef RT_DEVICE_COMPILATION
  36   // Descriptor synchronization is only done when the allocation is done
  37   // from the host.
  38   if (stat == StatOk) {
  39     void *deviceAddr{
  40         RTNAME(CUFGetDeviceAddress)((void *)&desc, sourceFile, sourceLine)};
  41     RTNAME(CUFDescriptorSync)
  42     ((Descriptor *)deviceAddr, &desc, sourceFile, sourceLine);
  43   }
  44 #endif
  45   return stat;
  46 }
  47
  48 int RTDEF(CUFAllocatableDeallocate)(Descriptor &desc, bool hasStat,
  49     const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
  50   // Perform the standard allocation.
  51   int stat{RTNAME(AllocatableDeallocate)(
  52       desc, hasStat, errMsg, sourceFile, sourceLine)};
  53 #ifndef RT_DEVICE_COMPILATION
  54   // Descriptor synchronization is only done when the deallocation is done
  55   // from the host.
  56   if (stat == StatOk) {
  57     void *deviceAddr{
  58         RTNAME(CUFGetDeviceAddress)((void *)&desc, sourceFile, sourceLine)};
  59     RTNAME(CUFDescriptorSync)
  60     ((Descriptor *)deviceAddr, &desc, sourceFile, sourceLine);
  61   }
  62 #endif
  63   return stat;
  64 }
  65
  66 RT_EXT_API_GROUP_END
  67
  68 } // extern "C"
  69
  70 } // namespace Fortran::runtime::cuda