107 lines · cpp
1//===-- lib/cuda/allocatable.cpp --------------------------------*- C++ -*-===//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-exception6//7//===----------------------------------------------------------------------===//8 9#include "flang/Runtime/CUDA/allocatable.h"10#include "flang-rt/runtime/assign-impl.h"11#include "flang-rt/runtime/descriptor.h"12#include "flang-rt/runtime/stat.h"13#include "flang-rt/runtime/terminator.h"14#include "flang/Runtime/CUDA/common.h"15#include "flang/Runtime/CUDA/descriptor.h"16#include "flang/Runtime/CUDA/memmove-function.h"17#include "flang/Runtime/allocatable.h"18 19#include "cuda_runtime.h"20 21namespace Fortran::runtime::cuda {22 23extern "C" {24RT_EXT_API_GROUP_BEGIN25 26int RTDEF(CUFAllocatableAllocateSync)(Descriptor &desc, int64_t *stream,27 bool *pinned, bool hasStat, const Descriptor *errMsg,28 const char *sourceFile, int sourceLine) {29 int stat{RTNAME(CUFAllocatableAllocate)(30 desc, stream, pinned, hasStat, errMsg, sourceFile, sourceLine)};31#ifndef RT_DEVICE_COMPILATION32 // Descriptor synchronization is only done when the allocation is done33 // from the host.34 if (stat == StatOk) {35 void *deviceAddr{36 RTNAME(CUFGetDeviceAddress)((void *)&desc, sourceFile, sourceLine)};37 RTNAME(CUFDescriptorSync)38 ((Descriptor *)deviceAddr, &desc, sourceFile, sourceLine);39 }40#endif41 return stat;42}43 44int RTDEF(CUFAllocatableAllocate)(Descriptor &desc, int64_t *stream,45 bool *pinned, bool hasStat, const Descriptor *errMsg,46 const char *sourceFile, int sourceLine) {47 // Perform the standard allocation.48 int stat{RTNAME(AllocatableAllocate)(49 desc, stream, hasStat, errMsg, sourceFile, sourceLine)};50 if (pinned) {51 // Set pinned according to stat. More infrastructre is needed to set it52 // closer to the actual allocation call.53 *pinned = (stat == StatOk);54 }55 return stat;56}57 58int RTDEF(CUFAllocatableAllocateSource)(Descriptor &alloc,59 const Descriptor &source, int64_t *stream, bool *pinned, bool hasStat,60 const Descriptor *errMsg, const char *sourceFile, int sourceLine) {61 int stat{RTNAME(CUFAllocatableAllocate)(62 alloc, stream, pinned, hasStat, errMsg, sourceFile, sourceLine)};63 if (stat == StatOk) {64 Terminator terminator{sourceFile, sourceLine};65 Fortran::runtime::DoFromSourceAssign(66 alloc, source, terminator, &MemmoveHostToDevice);67 }68 return stat;69}70 71int RTDEF(CUFAllocatableAllocateSourceSync)(Descriptor &alloc,72 const Descriptor &source, int64_t *stream, bool *pinned, bool hasStat,73 const Descriptor *errMsg, const char *sourceFile, int sourceLine) {74 int stat{RTNAME(CUFAllocatableAllocateSync)(75 alloc, stream, pinned, hasStat, errMsg, sourceFile, sourceLine)};76 if (stat == StatOk) {77 Terminator terminator{sourceFile, sourceLine};78 Fortran::runtime::DoFromSourceAssign(79 alloc, source, terminator, &MemmoveHostToDevice);80 }81 return stat;82}83 84int RTDEF(CUFAllocatableDeallocate)(Descriptor &desc, bool hasStat,85 const Descriptor *errMsg, const char *sourceFile, int sourceLine) {86 // Perform the standard allocation.87 int stat{RTNAME(AllocatableDeallocate)(88 desc, hasStat, errMsg, sourceFile, sourceLine)};89#ifndef RT_DEVICE_COMPILATION90 // Descriptor synchronization is only done when the deallocation is done91 // from the host.92 if (stat == StatOk) {93 void *deviceAddr{94 RTNAME(CUFGetDeviceAddress)((void *)&desc, sourceFile, sourceLine)};95 RTNAME(CUFDescriptorSync)96 ((Descriptor *)deviceAddr, &desc, sourceFile, sourceLine);97 }98#endif99 return stat;100}101 102RT_EXT_API_GROUP_END103 104} // extern "C"105 106} // namespace Fortran::runtime::cuda107