1 /*
2 * Copyright (c) 2017, NVIDIA CORPORATION. All rights reserved.
3 *
4 * Licensed under the Apache License, Version 2.0 (the "License");
5 * you may not use this file except in compliance with the License.
6 * You may obtain a copy of the License at
7 *
8 * http://www.apache.org/licenses/LICENSE-2.0
9 *
10 * Unless required by applicable law or agreed to in writing, software
11 * distributed under the License is distributed on an "AS IS" BASIS,
12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 * See the License for the specific language governing permissions and
14 * limitations under the License.
15 *
16 */
17
18 /* clang-format off */
19
20 /* comm.c -- compiler interfaces to communication routines */
21
22 #include "stdioInterf.h"
23 #include "fioMacros.h"
24
25 #include "fort_vars.h"
26
27 /* simple communication schedule structure */
28
29 typedef struct {
30 sked sked;
31 chdr *channel;
32 } comm_sked;
33
34 /* ENTFTN(comm_start) function: adjust base addresses and call doit */
35
I8(comm_sked_start)36 static void I8(comm_sked_start)(comm_sked *sk, char *rb, char *sb, F90_Desc *rd,
37 F90_Desc *sd)
38 {
39 #if defined(DEBUG)
40 if (F90_KIND_G(rd) != F90_KIND_G(sd) || F90_LEN_G(rd) != F90_LEN_G(sd))
41 __fort_abort("COMM_START: mismatched array types");
42 #endif
43 rb += DIST_SCOFF_G(rd) * F90_LEN_G(rd);
44 sb += DIST_SCOFF_G(sd) * F90_LEN_G(sd);
45 __fort_adjbase(sk->channel, sb, rb, F90_KIND_G(rd), F90_LEN_G(rd));
46 __fort_doit(sk->channel);
47 }
48
49 /* comm_free function: free channel and schedule structures */
50
51 static void
comm_sked_free(comm_sked * sk)52 comm_sked_free(comm_sked *sk)
53 {
54 __fort_frechn(sk->channel);
55 __fort_free(sk);
56 }
57
58 /* create a simple communication schedule */
59
I8(__fort_comm_sked)60 sked *I8(__fort_comm_sked)(chdr *ch, char *rb, char *sb, dtype kind, int len)
61 {
62 comm_sked *sk;
63
64 __fort_setbase(ch, sb, rb, kind, len);
65 sk = (comm_sked *)__fort_malloc(sizeof(comm_sked));
66 sk->sked.tag = __SKED;
67 sk->sked.start = I8(comm_sked_start);
68 sk->sked.free = comm_sked_free;
69 sk->sked.arg = sk;
70 sk->channel = ch;
71 return &sk->sked;
72 }
73
ENTFTN(COMM_START,comm_start)74 void *ENTFTN(COMM_START, comm_start)(sked **skp, void *rb, F90_Desc *rd,
75 void *sb, F90_Desc *sd)
76 {
77 sked *sk;
78
79 sk = *skp;
80 if (sk != NULL) {
81 #if defined(DEBUG)
82 if (sk->tag != __SKED)
83 __fort_abort("COMM_START: invalid schedule");
84 #endif
85 sk->start(sk->arg, rb, sb, rd, sd);
86 }
87 return NULL;
88 }
89
ENTFTN(COMM_FINISH,comm_finish)90 void ENTFTN(COMM_FINISH, comm_finish)(void *xp) {}
91
92 /* user-callable schedule executor; combines comm_start and comm_finish */
93
ENTFTN(COMM_EXECUTE,comm_execute)94 void ENTFTN(COMM_EXECUTE, comm_execute)(sked **skp, void *rb, void *sb,
95 F90_Desc *skpd, F90_Desc *rd,
96 F90_Desc *sd)
97 {
98 sked *sk;
99
100 if (!ISSCALAR(skpd) ||
101 GET_DIST_SIZE_OF(F90_TAG_G(skpd)) != sizeof(__POINT_T))
102 __fort_abort("COMM_EXECUTE: invalid schedule pointer");
103 sk = *skp;
104 if (sk != NULL) {
105 if (sk->tag != __SKED)
106 __fort_abort("COMM_EXECUTE: invalid schedule");
107 sk->start(sk->arg, rb, sb, rd, sd);
108 }
109 /* call comm_finish here if it isn't a no-op. */
110 }
111
ENTFTN(COMM_FREE,comm_free)112 void ENTFTN(COMM_FREE, comm_free)(__INT_T *ns, ...)
113 {
114 sked *sk;
115 va_list va;
116 int n;
117
118 va_start(va, ns);
119 for (n = *ns; n > 0; --n) {
120 sk = *va_arg(va, sked **);
121 if (sk == NULL)
122 continue;
123 #if defined(DEBUG)
124 if (sk->tag != __SKED)
125 __fort_abort("COMM_FREE: invalid schedule");
126 #endif
127 sk->free(sk->arg);
128 }
129 va_end(va);
130 }
131