@@ -21,8 +21,9 @@ namespace Fortran::runtime::cuda {
2121extern " C" {
2222RT_EXT_API_GROUP_BEGIN
2323
24- int RTDEF (CUFPointerAllocate)(Descriptor &desc, int64_t stream, bool hasStat,
25- const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
24+ int RTDEF (CUFPointerAllocate)(Descriptor &desc, int64_t stream, bool *pinned,
25+ bool hasStat, const Descriptor *errMsg, const char *sourceFile,
26+ int sourceLine) {
2627 if (desc.HasAddendum ()) {
2728 Terminator terminator{sourceFile, sourceLine};
2829 // TODO: This require a bit more work to set the correct type descriptor
@@ -33,14 +34,19 @@ int RTDEF(CUFPointerAllocate)(Descriptor &desc, int64_t stream, bool hasStat,
3334 // Perform the standard allocation.
3435 int stat{
3536 RTNAME (PointerAllocate)(desc, hasStat, errMsg, sourceFile, sourceLine)};
37+ if (pinned) {
38+ // Set pinned according to stat. More infrastructre is needed to set it
39+ // closer to the actual allocation call.
40+ *pinned = (stat == StatOk);
41+ }
3642 return stat;
3743}
3844
3945int RTDEF (CUFPointerAllocateSync)(Descriptor &desc, int64_t stream,
40- bool hasStat, const Descriptor *errMsg , const char *sourceFile ,
41- int sourceLine) {
46+ bool *pinned, bool hasStat , const Descriptor *errMsg ,
47+ const char *sourceFile, int sourceLine) {
4248 int stat{RTNAME (CUFPointerAllocate)(
43- desc, stream, hasStat, errMsg, sourceFile, sourceLine)};
49+ desc, stream, pinned, hasStat, errMsg, sourceFile, sourceLine)};
4450#ifndef RT_DEVICE_COMPILATION
4551 // Descriptor synchronization is only done when the allocation is done
4652 // from the host.
@@ -55,10 +61,10 @@ int RTDEF(CUFPointerAllocateSync)(Descriptor &desc, int64_t stream,
5561}
5662
5763int RTDEF (CUFPointerAllocateSource)(Descriptor &pointer,
58- const Descriptor &source, int64_t stream, bool hasStat,
64+ const Descriptor &source, int64_t stream, bool *pinned, bool hasStat,
5965 const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
6066 int stat{RTNAME (CUFPointerAllocate)(
61- pointer, stream, hasStat, errMsg, sourceFile, sourceLine)};
67+ pointer, stream, pinned, hasStat, errMsg, sourceFile, sourceLine)};
6268 if (stat == StatOk) {
6369 Terminator terminator{sourceFile, sourceLine};
6470 Fortran::runtime::DoFromSourceAssign (
@@ -68,10 +74,10 @@ int RTDEF(CUFPointerAllocateSource)(Descriptor &pointer,
6874}
6975
7076int RTDEF (CUFPointerAllocateSourceSync)(Descriptor &pointer,
71- const Descriptor &source, int64_t stream, bool hasStat,
77+ const Descriptor &source, int64_t stream, bool *pinned, bool hasStat,
7278 const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
7379 int stat{RTNAME (CUFPointerAllocateSync)(
74- pointer, stream, hasStat, errMsg, sourceFile, sourceLine)};
80+ pointer, stream, pinned, hasStat, errMsg, sourceFile, sourceLine)};
7581 if (stat == StatOk) {
7682 Terminator terminator{sourceFile, sourceLine};
7783 Fortran::runtime::DoFromSourceAssign (
0 commit comments