1 /*
2 * Copyright (c) 1998-2019, 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 /** \file
19 \brief semantic analyzer routines which process SMP statements.
20 */
21
22 #include "gbldefs.h"
23 #include "global.h"
24 #include "gramsm.h"
25 #include "gramtk.h"
26 #include "error.h"
27 #include "symtab.h"
28 #include "symutl.h"
29 #include "dtypeutl.h"
30 #include "semant.h"
31 #include "scan.h"
32 #include "semstk.h"
33 #include "ast.h"
34 #include "direct.h"
35 #include "pragma.h"
36 #include "x86.h"
37
38 #include "llmputil.h"
39 #include "mp.h"
40 #include "atomic_common.h"
41
42 /* contents of this file: */
43
44 static void add_clause(int, LOGICAL);
45 static bool clause_errchk(BIGINT64, char *);
46 static void accel_sched_errchk();
47 static void accel_nosched_errchk();
48 static void accel_pragmagen(int, int, int);
49
50 static int sched_type(char *);
51 static void set_iftype(int, char *, char *, char *);
52 static void validate_if(int, char *);
53 static int cancel_type(char *);
54 static int emit_bpar(void);
55 static int emit_btarget(int);
56 static void do_schedule(int);
57 static void do_private(void);
58 static void do_firstprivate(int);
59 static void do_lastprivate(void);
60 static void do_reduction(void);
61 static void do_copyin(void);
62 static void do_copyprivate(void);
63 static int size_of_allocatable(int);
64 static void do_default_clause(int);
65 static void begin_parallel_clause(int);
66 static void end_reduction(REDUC *, int);
67 static void end_lastprivate(int);
68 static void end_workshare(int s_std, int e_std);
69 static void deallocate_privates(int);
70 static void add_assignment(int, SST *);
71 static void add_assignment_before(int, SST *, int);
72 static void add_ptr_assignment(int, SST *);
73 static void assign_cval(int, int, int);
74 static int enter_dir(int, LOGICAL, LOGICAL, BITMASK64);
75 static int leave_dir(int, LOGICAL, LOGICAL);
76 static char *name_of_dir(int);
77 static int find_reduc_intrinsic(int);
78 static int get_csect_sym(char *);
79 static int get_csect_pfxlen(void);
80 static void check_barrier(void);
81 static void check_crit(char *);
82 static int check_cancel(int);
83 static void check_targetdata(int, char *);
84 static void check_valid_data_sharing(int);
85 static LOGICAL check_map_data_sharing(int);
86 static void cray_pointer_check(ITEM *, int);
87 static void other_firstlast_check(ITEM *, int);
88 static void copyprivate_check(ITEM *, int);
89 static int sym_in_clause(int sptr, int clause);
90 static void non_private_check(int, char *);
91 static void private_check();
92 static void deallocate_no_scope_sptr();
93 static int get_stblk_uplevel_sptr();
94 static int add_firstprivate_assn(int, int, int);
95 static void begin_combine_constructs(BIGINT64);
96 static void end_targteams();
97 static LOGICAL is_last_private(int);
98 static void mp_add_shared_var(int, int);
99 static void mk_reduction_list(void);
100 static void mk_private_list(void);
101 static void mk_shared_list(void);
102 static void mk_lastprivate_list(void);
103 static void save_private_list(void);
104 static void save_firstprivate_list(void);
105 static void save_shared_list(void);
106 static void restore_clauses(void);
107 static void do_bdistribute(int, LOGICAL);
108 static void do_bteams(int);
109 static int get_mp_bind_type(char *);
110 static LOGICAL is_valid_atomic_read(int, int);
111 static LOGICAL is_valid_atomic_write(int, int);
112 static LOGICAL is_valid_atomic_capture(int, int);
113 static LOGICAL is_valid_atomic_update(int, int);
114 static int mk_atomic_update_binop(int, int);
115 static int mk_atomic_update_intr(int, int);
116 static void do_map();
117 static LOGICAL use_atomic_for_reduction(int);
118
119 #if defined(OMP_OFFLOAD_LLVM) || defined(OMP_OFFLOAD_PGI)
120 static char *map_type;
121 bool isalways = false;
122 static int get_omp_combined_mode(BIGINT64 type);
123 static void mp_handle_map_clause(SST *, int, char *, int, int, bool);
124 static void mp_check_maptype(const char *maptype);
125 static LOGICAL is_in_omptarget(int d);
126 static LOGICAL is_in_omptarget_data(int d);
127 #endif
128 #ifdef OMP_OFFLOAD_LLVM
129 static void gen_reduction_ompaccel(REDUC *reducp, REDUC_SYM *reduc_symp,
130 LOGICAL rmme, LOGICAL in_parallel);
131 #endif
132
133 /*-------- define data structures and macros local to this file: --------*/
134
135 /* define macros used to access table the clause table, "ct".
136 * Their values range from 0 .. CL_MAXV.
137 *
138 * N O T E: The static array of struct, cl, is initialized the names of
139 * these clauses. If changes are made to the CL_ macros,
140 * R E M E M B E R to change clname.
141 */
142 #define CL_DEFAULT 0
143 #define CL_PRIVATE 1
144 #define CL_SHARED 2
145 #define CL_FIRSTPRIVATE 3
146 #define CL_LASTPRIVATE 4
147 #define CL_SCHEDULE 5
148 #define CL_ORDERED 6
149 #define CL_REDUCTION 7
150 #define CL_IF 8
151 #define CL_COPYIN 9
152 #define CL_COPYPRIVATE 10
153 #define CL_MP_SCHEDTYPE 11
154 #define CL_CHUNK 12
155 #define CL_NOWAIT 13
156 #define CL_NUM_THREADS 14
157 #define CL_COLLAPSE 15
158 #define CL_UNTIED 16
159 #define CL_COPYOUT 17
160 #define CL_LOCAL 18
161 #define CL_CACHE 19
162 #define CL_SHORTLOOP 20
163 #define CL_VECTOR 21
164 #define CL_PARALLEL 22
165 #define CL_SEQ 23
166 #define CL_HOST 24
167 #define CL_UNROLL 25
168 #define CL_KERNEL 26
169 #define CL_COPY 27
170 #define CL_MIRROR 28
171 #define CL_REFLECTED 29
172 #define CL_UPDATEHOST 30
173 #define CL_UPDATESELF 31
174 #define CL_UPDATEDEV 32
175 #define CL_INDEPENDENT 33
176 #define CL_WAIT 34
177 #define CL_CUFTILE 35
178 #define CL_KERNEL_GRID 36
179 #define CL_KERNEL_BLOCK 37
180 #define CL_SEQUNROLL 38
181 #define CL_PARUNROLL 39
182 #define CL_VECUNROLL 40
183 #define CL_CREATE 41
184 #define CL_ACCPRESENT 42
185 #define CL_ACCPCOPY 43
186 #define CL_ACCPCOPYIN 44
187 #define CL_ACCPCOPYOUT 45
188 #define CL_ACCPCREATE 46
189 #define CL_ACCPNOT 47
190 #define CL_ASYNC 48
191 #define CL_STREAM 49
192 #define CL_DEVICE 50
193 #define CL_WORKER 51
194 #define CL_GANG 52
195 #define CL_NUM_WORKERS 53
196 #define CL_NUM_GANGS 54
197 #define CL_VECTOR_LENGTH 55
198 #define CL_USE_DEVICE 56
199 #define CL_DEVICEPTR 57
200 #define CL_DEVICE_RESIDENT 58
201 #define CL_FINAL 59
202 #define CL_MERGEABLE 60
203 #define CL_DEVICEID 61
204 #define CL_ACCDELETE 62
205 #define CL_ACCPDELETE 63
206 #define CL_ACCLINK 64
207 #define CL_DEVICE_TYPE 65
208 #define CL_AUTO 66
209 #define CL_TILE 67
210 #define CL_GANGCHUNK 68
211 #define CL_DEFNONE 69
212 #define CL_NUM_GANGS2 70
213 #define CL_NUM_GANGS3 71
214 #define CL_GANGDIM 72
215 #define CL_DEFPRESENT 73
216 #define CL_FORCECOLLAPSE 74
217 #define CL_FINALIZE 75
218 #define CL_IFPRESENT 76
219 #define CL_SAFELEN 77
220 #define CL_SIMDLEN 78
221 #define CL_LINEAR 79
222 #define CL_ALIGNED 80
223 #define CL_USE_DEVICE_PTR 81
224 #define CL_DEPEND 82
225 #define CL_INBRANCH 83
226 #define CL_NOTINBRANCH 84
227 #define CL_UNIFORM 85
228 #define CL_GRAINSIZE 86
229 #define CL_NUM_TASKS 87
230 #define CL_NOGROUP 88
231 #define CL_OMPDEVICE 89
232 #define CL_MAP 90
233 #define CL_DEFAULTMAP 91
234 #define CL_TO 92
235 #define CL_LINK 93
236 #define CL_FROM 94
237 #define CL_NUM_TEAMS 95
238 #define CL_THREAD_LIMIT 96
239 #define CL_DIST_SCHEDULE 97
240 #define CL_PRIORITY 98
241 #define CL_IS_DEVICE_PTR 99
242 #define CL_SIMD 100
243 #define CL_THREADS 101
244 #define CL_DEVICE_NUM 102
245 #define CL_DEFAULT_ASYNC 103
246 #define CL_ACCDECL 104
247 #define CL_PROC_BIND 105
248 #define CL_ACCNO_CREATE 106
249 #define CL_ACCATTACH 107
250 #define CL_ACCDETACH 108
251 #define CL_ACCCOMPARE 109
252 #define CL_PGICOMPARE 110
253 #define CL_MAXV 111 /* This must be the last clause */
254 /*
255 * define bit flag for each statement which may have clauses. Used for
256 * checking for illegal clauses.
257 */
258 #define BT_PAR 0x001
259 #define BT_SINGLE 0x002
260 #define BT_PDO 0x004
261 #define BT_PARDO 0x008
262 #define BT_DOACROSS 0x010
263 #define BT_SECTS 0x020
264 #define BT_PARSECTS 0x040
265 #define BT_PARWORKS 0x080
266 #define BT_TASK 0x100
267 #define BT_ACCREG 0x200
268 #define BT_ACCKERNELS 0x400
269 #define BT_ACCPARALLEL 0x800
270 #define BT_ACCKDO 0x1000
271 #define BT_ACCPDO 0x2000
272 #define BT_ACCKLOOP 0x4000
273 #define BT_ACCPLOOP 0x8000
274 #define BT_ACCDATAREG 0x10000
275 #define BT_ACCDECL 0x20000
276 #define BT_ACCUPDATE 0x40000
277 #define BT_ACCENDREG 0x80000
278 #define BT_ACCSCALARREG 0x100000
279 #define BT_CUFKERNEL 0x200000
280 #define BT_ACCHOSTDATA 0x400000
281 #define BT_ACCENTERDATA 0x800000
282 #define BT_ACCEXITDATA 0x1000000
283 #define BT_SIMD 0x2000000
284 #define BT_TASKGROUP 0x4000000
285 #define BT_TASKLOOP 0x8000000
286 #define BT_TARGET 0x10000000
287 #define BT_DISTRIBUTE 0x20000000
288 #define BT_TEAMS 0x400000000
289 #define BT_DECLTARGET 0x800000000
290 #define BT_DECLSIMD 0x1000000000
291 #define BT_ACCINITSHUTDOWN 0x2000000000
292 #define BT_ACCSET 0x4000000000
293 #define BT_ACCSERIAL 0x8000000000
294 #define BT_ACCSLOOP 0x10000000000
295
296 static struct cl_tag { /* clause table */
297 int present;
298 BIGINT64 val;
299 void *first;
300 void *last;
301 char *name;
302 BIGINT64 stmt; /* stmts which may use the clause */
303 } cl[CL_MAXV] = {
304 {0, 0, NULL, NULL, "DEFAULT",
305 BT_PAR | BT_PARDO | BT_PARSECTS | BT_PARWORKS | BT_TASK | BT_TEAMS |
306 BT_TASKLOOP},
307 {0, 0, NULL, NULL, "PRIVATE",
308 BT_PAR | BT_PDO | BT_PARDO | BT_DOACROSS | BT_SECTS | BT_PARSECTS |
309 BT_SINGLE | BT_PARWORKS | BT_TASK | BT_ACCPARALLEL | BT_ACCKDO |
310 BT_ACCPDO | BT_ACCKLOOP | BT_ACCPLOOP | BT_SIMD | BT_TARGET |
311 BT_TASKLOOP | BT_TEAMS | BT_DISTRIBUTE | BT_ACCSERIAL | BT_ACCSLOOP},
312 {0, 0, NULL, NULL, "SHARED",
313 BT_PAR | BT_PARDO | BT_DOACROSS | BT_PARSECTS | BT_PARWORKS | BT_TASK |
314 BT_TASKLOOP | BT_TEAMS},
315 {0, 0, NULL, NULL, "FIRSTPRIVATE",
316 BT_PAR | BT_PDO | BT_PARDO | BT_SECTS | BT_PARSECTS | BT_SINGLE |
317 BT_PARWORKS | BT_TASK | BT_ACCPARALLEL | BT_TARGET | BT_TEAMS |
318 BT_TASKLOOP | BT_DISTRIBUTE | BT_ACCSERIAL},
319 {0, 0, NULL, NULL, "LASTPRIVATE",
320 BT_PDO | BT_PARDO | BT_DOACROSS | BT_SECTS | BT_PARSECTS | BT_SIMD |
321 BT_TASKLOOP | BT_DISTRIBUTE},
322 {0, 0, NULL, NULL, "SCHEDULE", BT_PDO | BT_PARDO},
323 {0, 0, NULL, NULL, "ORDERED", BT_PDO | BT_PARDO},
324 {0, 0, NULL, NULL, "REDUCTION",
325 BT_PAR | BT_PDO | BT_PARDO | BT_DOACROSS | BT_SECTS | BT_PARSECTS |
326 BT_PARWORKS | BT_ACCPARALLEL | BT_ACCKDO | BT_ACCPDO | BT_ACCKLOOP |
327 BT_ACCPLOOP | BT_SIMD | BT_TEAMS | BT_ACCSERIAL | BT_ACCSLOOP},
328 {0, 0, NULL, NULL, "IF",
329 BT_PAR | BT_PARDO | BT_PARSECTS | BT_PARWORKS | BT_TASK | BT_ACCREG |
330 BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG | BT_ACCSCALARREG |
331 BT_ACCUPDATE | BT_ACCENTERDATA | BT_ACCEXITDATA | BT_TARGET |
332 BT_TASKLOOP | BT_ACCSERIAL | BT_ACCHOSTDATA},
333 {0, 0, NULL, NULL, "COPYIN",
334 BT_PAR | BT_PARDO | BT_PARSECTS | BT_PARWORKS | BT_ACCREG | BT_ACCKERNELS |
335 BT_ACCPARALLEL | BT_ACCDATAREG | BT_ACCSCALARREG | BT_ACCDECL |
336 BT_ACCENTERDATA | BT_ACCSERIAL},
337 {0, 0, NULL, NULL, "COPYPRIVATE", BT_SINGLE},
338 {0, 0, NULL, NULL, "MP_SCHEDTYPE", BT_DOACROSS},
339 {0, 0, NULL, NULL, "CHUNK", BT_DOACROSS},
340 {0, 0, NULL, NULL, "NOWAIT",
341 BT_SINGLE | BT_SECTS | BT_PDO | BT_ACCREG | BT_ACCKERNELS |
342 BT_ACCPARALLEL | BT_ACCSCALARREG | BT_ACCENDREG | BT_CUFKERNEL |
343 BT_TARGET},
344 {0, 0, NULL, NULL, "NUM_THREADS",
345 BT_PAR | BT_PARDO | BT_PARSECTS | BT_PARWORKS},
346 {0, 0, NULL, NULL, "COLLAPSE",
347 BT_PDO | BT_PARDO | BT_ACCKDO | BT_ACCPDO | BT_ACCKLOOP | BT_ACCPLOOP |
348 BT_SIMD | BT_TASKLOOP | BT_DISTRIBUTE | BT_ACCSLOOP},
349 {0, 0, NULL, NULL, "UNTIED", BT_TASK | BT_TASKLOOP},
350 {0, 0, NULL, NULL, "COPYOUT",
351 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
352 BT_ACCSCALARREG | BT_ACCDECL | BT_ACCEXITDATA | BT_ACCSERIAL},
353 {0, 0, NULL, NULL, "LOCAL",
354 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
355 BT_ACCSCALARREG | BT_ACCDECL | BT_ACCENTERDATA | BT_ACCSERIAL},
356 {0, 0, NULL, NULL, "CACHE", BT_ACCKDO},
357 {0, 0, NULL, NULL, "SHORTLOOP",
358 BT_ACCKDO | BT_ACCKLOOP | BT_ACCPDO | BT_ACCPLOOP | BT_ACCSLOOP},
359 {0, 0, NULL, NULL, "VECTOR",
360 BT_ACCKDO | BT_ACCKLOOP | BT_ACCPDO | BT_ACCPLOOP | BT_ACCSLOOP},
361 {0, 0, NULL, NULL, "PARALLEL",
362 BT_ACCKDO | BT_ACCKLOOP | BT_ACCPDO | BT_ACCPLOOP},
363 {0, 0, NULL, NULL, "SEQ",
364 BT_ACCKDO | BT_ACCKLOOP | BT_ACCPDO | BT_ACCPLOOP | BT_ACCSLOOP},
365 {0, 0, NULL, NULL, "HOST", BT_ACCKDO | BT_ACCKLOOP},
366 {0, 0, NULL, NULL, "UNROLL",
367 BT_ACCKDO | BT_ACCKLOOP | BT_ACCPDO | BT_ACCPLOOP | BT_ACCSLOOP},
368 {0, 0, NULL, NULL, "KERNEL", BT_ACCKDO | BT_ACCKLOOP},
369 {0, 0, NULL, NULL, "COPY",
370 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
371 BT_ACCSCALARREG | BT_ACCDECL | BT_ACCSERIAL},
372 {0, 0, NULL, NULL, "MIRROR", BT_ACCDATAREG | BT_ACCDECL},
373 {0, 0, NULL, NULL, "REFLECTED", BT_ACCDECL},
374 {0, 0, NULL, NULL, "UPDATE HOST",
375 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
376 BT_ACCSCALARREG | BT_ACCSERIAL},
377 {0, 0, NULL, NULL, "UPDATE SELF",
378 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
379 BT_ACCSCALARREG | BT_ACCSERIAL},
380 {0, 0, NULL, NULL, "UPDATE DEVICE",
381 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
382 BT_ACCSCALARREG | BT_ACCSERIAL},
383 {0, 0, NULL, NULL, "INDEPENDENT",
384 BT_ACCKDO | BT_ACCPDO | BT_ACCKLOOP | BT_ACCPLOOP | BT_ACCSLOOP},
385 {0, 0, NULL, NULL, "WAIT",
386 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCSCALARREG |
387 BT_ACCENDREG | BT_CUFKERNEL | BT_ACCDATAREG | BT_ACCUPDATE |
388 BT_ACCENTERDATA | BT_ACCEXITDATA | BT_ACCSERIAL},
389 {0, 0, NULL, NULL, "TILE", BT_CUFKERNEL},
390 {0, 0, NULL, NULL, "KERNEL_GRID", BT_CUFKERNEL},
391 {0, 0, NULL, NULL, "KERNEL_BLOCK", BT_CUFKERNEL},
392 {0, 0, NULL, NULL, "UNROLL", /* for sequential loops */
393 BT_ACCKDO | BT_ACCKLOOP | BT_ACCPDO | BT_ACCPLOOP | BT_ACCSLOOP},
394 {0, 0, NULL, NULL, "UNROLL", /* for parallel loops */
395 BT_ACCKDO | BT_ACCKLOOP | BT_ACCPDO | BT_ACCPLOOP},
396 {0, 0, NULL, NULL, "UNROLL", /* for vector loops */
397 BT_ACCKDO | BT_ACCKLOOP | BT_ACCPDO | BT_ACCPLOOP | BT_ACCSLOOP},
398 {0, 0, NULL, NULL, "CREATE",
399 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
400 BT_ACCSCALARREG | BT_ACCDECL | BT_ACCENTERDATA | BT_ACCSERIAL},
401 {0, 0, NULL, NULL, "PRESENT",
402 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
403 BT_ACCSCALARREG | BT_ACCDECL | BT_ACCSERIAL},
404 {0, 0, NULL, NULL, "PRESENT_OR_COPY",
405 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
406 BT_ACCSCALARREG | BT_ACCDECL | BT_ACCSERIAL},
407 {0, 0, NULL, NULL, "PRESENT_OR_COPYIN",
408 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
409 BT_ACCSCALARREG | BT_ACCDECL | BT_ACCENTERDATA | BT_ACCSERIAL},
410 {0, 0, NULL, NULL, "PRESENT_OR_COPYOUT",
411 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
412 BT_ACCSCALARREG | BT_ACCDECL | BT_ACCEXITDATA | BT_ACCSERIAL},
413 {0, 0, NULL, NULL, "PRESENT_OR_CREATE",
414 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
415 BT_ACCSCALARREG | BT_ACCDECL | BT_ACCENTERDATA | BT_ACCSERIAL},
416 {0, 0, NULL, NULL, "PRESENT_OR_NOT",
417 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
418 BT_ACCSCALARREG | BT_ACCDECL | BT_ACCENTERDATA | BT_ACCSERIAL},
419 {0, 0, NULL, NULL, "ASYNC",
420 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
421 BT_ACCSCALARREG | BT_ACCUPDATE | BT_ACCENTERDATA | BT_ACCEXITDATA |
422 BT_ACCSERIAL},
423 {0, 0, NULL, NULL, "STREAM", BT_CUFKERNEL},
424 {0, 0, NULL, NULL, "DEVICE", BT_CUFKERNEL},
425 {0, 0, NULL, NULL, "WORKER",
426 BT_ACCKDO | BT_ACCKLOOP | BT_ACCPDO | BT_ACCPLOOP | BT_ACCSLOOP},
427 {0, 0, NULL, NULL, "GANG",
428 BT_ACCKDO | BT_ACCKLOOP | BT_ACCPDO | BT_ACCPLOOP | BT_ACCSLOOP},
429 {0, 0, NULL, NULL, "NUM_WORKERS",
430 BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCSERIAL},
431 {0, 0, NULL, NULL, "NUM_GANGS",
432 BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCSERIAL},
433 {0, 0, NULL, NULL, "VECTOR_LENGTH",
434 BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCSERIAL},
435 {0, 0, NULL, NULL, "USE_DEVICE", BT_ACCHOSTDATA},
436 {0, 0, NULL, NULL, "DEVICEPTR",
437 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG | BT_ACCSERIAL | BT_ACCDECL},
438 {0, 0, NULL, NULL, "DEVICE_RESIDENT", BT_ACCDECL},
439 {0, 0, NULL, NULL, "FINAL", BT_TASK | BT_TASKLOOP},
440 {0, 0, NULL, NULL, "MERGEABLE", BT_TASK | BT_TASKLOOP},
441 {0, 0, NULL, NULL, "DEVICEID",
442 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
443 BT_ACCSCALARREG | BT_ACCUPDATE | BT_ACCHOSTDATA | BT_ACCENTERDATA |
444 BT_ACCEXITDATA | BT_ACCSERIAL},
445 {0, 0, NULL, NULL, "DELETE", BT_ACCEXITDATA},
446 {0, 0, NULL, NULL, "PDELETE", BT_ACCEXITDATA},
447 {0, 0, NULL, NULL, "LINK", BT_ACCDECL},
448 {0, 0, NULL, NULL, "DEVICE_TYPE",
449 BT_ACCKLOOP | BT_ACCPLOOP | BT_ACCKDO | BT_ACCPDO | BT_ACCKERNELS |
450 BT_ACCPARALLEL | BT_ACCINITSHUTDOWN | BT_ACCSET | BT_ACCSERIAL},
451 {0, 0, NULL, NULL, "AUTO",
452 BT_ACCKLOOP | BT_ACCPLOOP | BT_ACCKDO | BT_ACCPDO | BT_ACCSLOOP},
453 {0, 0, NULL, NULL, "TILE",
454 BT_ACCKLOOP | BT_ACCPLOOP | BT_ACCKDO | BT_ACCPDO | BT_ACCSLOOP},
455 {0, 0, NULL, NULL, "GANG(STATIC:)",
456 BT_ACCKLOOP | BT_ACCPLOOP | BT_ACCKDO | BT_ACCPDO | BT_ACCSLOOP},
457 {0, 0, NULL, NULL, "DEFAULT(NONE)",
458 BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCREG | BT_ACCSERIAL},
459 {0, 0, NULL, NULL, "NUM_GANGS(dim:2)",
460 BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCSERIAL},
461 {0, 0, NULL, NULL, "NUM_GANGS(dim:3)",
462 BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCSERIAL},
463 {0, 0, NULL, NULL, "GANG(DIM:)", BT_ACCPLOOP | BT_ACCPDO | BT_ACCSLOOP},
464 {0, 0, NULL, NULL, "DEFAULT(PRESENT)",
465 BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCREG | BT_ACCSERIAL},
466 {0, 0, NULL, NULL, "COLLAPSE(FORCE)",
467 BT_ACCKLOOP | BT_ACCPLOOP | BT_ACCKDO | BT_ACCPDO | BT_ACCSLOOP},
468 {0, 0, NULL, NULL, "FINALIZE", BT_ACCEXITDATA},
469 {0, 0, NULL, NULL, "IF_PRESENT", BT_ACCUPDATE | BT_ACCHOSTDATA},
470 {0, 0, NULL, NULL, "SAFELEN", BT_SIMD | BT_PDO | BT_PARDO},
471 {0, 0, NULL, NULL, "SIMDLEN", BT_SIMD | BT_PDO | BT_PARDO | BT_DECLSIMD},
472 {0, 0, NULL, NULL, "LINEAR", BT_SIMD | BT_PDO | BT_PARDO | BT_DECLSIMD},
473 {0, 0, NULL, NULL, "ALIGNED", BT_SIMD | BT_PDO | BT_PARDO | BT_DECLSIMD},
474 {0, 0, NULL, NULL, "USE_DEVICE_PTR", BT_TARGET},
475 {0, 0, NULL, NULL, "DEPEND", BT_TASK | BT_TARGET},
476 {0, 0, NULL, NULL, "INBRANCH", BT_DECLSIMD},
477 {0, 0, NULL, NULL, "NOTINBRANCH", BT_DECLSIMD},
478 {0, 0, NULL, NULL, "UNIFORM", BT_DECLSIMD},
479 {0, 0, NULL, NULL, "GRAINSIZE", BT_TASKLOOP},
480 {0, 0, NULL, NULL, "NUM_TASKS", BT_TASKLOOP},
481 {0, 0, NULL, NULL, "NOGROUP", BT_TASKLOOP},
482 {0, 0, NULL, NULL, "OMPDEVICE", BT_TARGET},
483 {0, 0, NULL, NULL, "MAP", BT_TARGET},
484 {0, 0, NULL, NULL, "DEFAULTMAP", BT_TARGET},
485 {0, 0, NULL, NULL, "TO", BT_TARGET},
486 {0, 0, NULL, NULL, "LINK", BT_TARGET},
487 {0, 0, NULL, NULL, "FROM", BT_TARGET},
488 {0, 0, NULL, NULL, "NUM_TEAMS", BT_TEAMS},
489 {0, 0, NULL, NULL, "THREAD_LIMIT", BT_TEAMS},
490 {0, 0, NULL, NULL, "DIST_SCHEDULE", BT_DISTRIBUTE},
491 {0, 0, NULL, NULL, "PRIORITY", BT_TASKLOOP},
492 {0, 0, NULL, NULL, "IS_DEVICE_PTR", BT_TARGET},
493 {0, 0, NULL, NULL, "SIMD", BT_PDO | BT_PARDO | BT_SIMD},
494 {0, 0, NULL, NULL, "THREADS", BT_TARGET},
495 {0, 0, NULL, NULL, "DEVICE_NUM", BT_ACCINITSHUTDOWN | BT_ACCSET},
496 {0, 0, NULL, NULL, "DEFAULT_ASYNC", BT_ACCSET},
497 {0, 0, NULL, NULL, "DECLARE", BT_ACCDECL},
498 {0, 0, NULL, NULL, "PROC_BIND", BT_PAR | BT_PARDO},
499 {0, 0, NULL, NULL, "NO_CREATE",
500 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
501 BT_ACCSCALARREG | BT_ACCDECL | BT_ACCENTERDATA | BT_ACCSERIAL},
502 {0, 0, NULL, NULL, "ATTACH",
503 BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG | BT_ACCENTERDATA |
504 BT_ACCSERIAL},
505 {0, 0, NULL, NULL, "DETACH", BT_ACCEXITDATA},
506 {0, 0, NULL, NULL, "COMPARE",
507 BT_ACCREG | BT_ACCKERNELS | BT_ACCPARALLEL | BT_ACCDATAREG |
508 BT_ACCSCALARREG | BT_ACCSERIAL},
509 };
510
511 #define CL_PRESENT(d) cl[d].present
512 #define CL_VAL(d) cl[d].val
513 #define CL_NAME(d) cl[d].name
514 #define CL_STMT(d) cl[d].stmt
515 #define CL_FIRST(d) cl[d].first
516 #define CL_LAST(d) cl[d].last
517
518 struct savcl_tag { /* save clause table for combined construct */
519 int present;
520 BIGINT64 val;
521 void *first;
522 void *last;
523 };
524
525 static struct savcl_tag sav_cl[CL_MAXV];
526
527 /* used for combined constructs of:
528 * target teams distribute parallel for simd where clauses
529 * can be applied to applicable construct.
530 */
531 #define SAVCL_PRESENT(d) sav_cl[d].present
532 #define SAVCL_VAL(d) sav_cl[d].val /* sptr in some cases */
533 #define SAVCL_FIRST(d) sav_cl[d].first
534 #define SAVCL_LAST(d) sav_cl[d].last
535
536 /* combined target/data constructs and also use fo if(xxx:) clause */
537 #define OMP_DEFAULT 0x0
538 #define OMP_TARGET 0x1
539 #define OMP_TARGETDATA 0x2
540 #define OMP_TARGETENTERDATA 0x4
541 #define OMP_TARGETEXITDATA 0x8
542 #define OMP_TARGETUPDATE 0x10
543 #define OMP_PARALLEL 0x20
544 #define OMP_TASK 0x40
545 #define OMP_TASKLOOP 0x80
546
547 static int recent_loop_clause = 0;
548
549 static int chunk;
550 static int distchunk;
551 static int mp_iftype;
552 static ISZ_T kernel_do_nest;
553 static LOGICAL has_team = FALSE;
554
555
556 static LOGICAL any_pflsr_private = FALSE;
557
558 static void add_pragmasyms(int pragmatype, int pragmascope, ITEM *itemp, int);
559 static void add_pragma(int pragmatype, int pragmascope, int pragmaarg);
560
561 #define OPT_OMP_ATOMIC !XBIT(69,0x1000)
562
563 static int kernel_argnum;
564
565 /**
566 \brief Semantic analysis for SMP statements.
567 \param rednum reduction number
568 \param top top of stack after reduction
569 */
570 void
semsmp(int rednum,SST * top)571 semsmp(int rednum, SST *top)
572 {
573 int sptr, sptr1, sptr2, ilmptr;
574 int dtype;
575 ITEM *itemp; /* Pointers to items */
576 int doif;
577 int prev_doif;
578 int ast, arg, std;
579 int opc;
580 int clause;
581 INT val[2];
582 INT rhstop;
583 int op, i, d, ctype, bind_type;
584 int ditype, ditype2, ditype3, pr1, pr2;
585 BIGINT64 bttype;
586 BITMASK64 dimask, dinestmask;
587 LOGICAL dignorenested;
588 char *dirname;
589 char *nmptr;
590 REDUC *reducp;
591 REDUC_SYM *reduc_symp;
592 REDUC_SYM *reduc_symp_last;
593 REDUC_SYM *reduc_symp_curr;
594 SST *e1;
595
596 switch (rednum) {
597 /* ------------------------------------------------------------------ */
598 /*
599 * <declare simd> ::= <declare simd begin> <opt par list>
600 */
601 case DECLARE_SIMD1:
602 apply_nodepchk(gbl.lineno, 2);
603 break;
604
605 /* ------------------------------------------------------------------ */
606 /*
607 * <declare simd name> ::= |
608 */
609 case DECLARE_SIMD_NAME1:
610 break;
611 /*
612 * <declare simd name> ::= ( <id> )
613 */
614 case DECLARE_SIMD_NAME2:
615 break;
616
617 /* ------------------------------------------------------------------ */
618 /*
619 * <declare target> ::= ( <ident list> ) |
620 */
621 case DECLARE_TARGET1:
622 break;
623 /*
624 * <declare target> ::= <par list>
625 */
626 case DECLARE_TARGET2:
627 break;
628
629 /* ------------------------------------------------------------------ */
630 /*
631 * <smp stmt> ::= <mp begin> <mp stmt>
632 */
633 case SMP_STMT1:
634 SST_ASTP(LHS, SST_ASTG(RHS(2)));
635 break;
636
637 /* ------------------------------------------------------------------ */
638 /*
639 * <mp begin> ::=
640 */
641 case MP_BEGIN1:
642 parstuff_init();
643 break;
644
645 /* ------------------------------------------------------------------ */
646 /*
647 * <mp stmt> ::= <par begin> <opt par list> |
648 */
649 case MP_STMT1:
650 clause_errchk(BT_PAR, "OMP PARALLEL");
651 mp_create_bscope(0);
652 DI_BPAR(sem.doif_depth) = emit_bpar();
653 par_push_scope(FALSE);
654 begin_parallel_clause(sem.doif_depth);
655 SST_ASTP(LHS, 0);
656 break;
657 /*
658 * <mp stmt> ::= <mp endparallel> |
659 */
660 case MP_STMT2:
661 end_parallel_clause(doif = sem.doif_depth);
662 (void)leave_dir(DI_PAR, TRUE, 0);
663 --sem.parallel;
664 par_pop_scope();
665 ast = emit_epar();
666 mp_create_escope();
667 if (doif) {
668 A_LOPP(DI_BPAR(doif), ast);
669 A_LOPP(ast, DI_BPAR(doif));
670 }
671 SST_ASTP(LHS, 0);
672 break;
673 /*
674 * <mp stmt> ::= <mp critical> <opt csident> |
675 */
676 case MP_STMT3:
677 ast = 0;
678 doif = enter_dir(DI_CRITICAL, FALSE, 0, DI_B(DI_ATOMIC_CAPTURE));
679 sptr = 0;
680 if (SST_IDG(RHS(2))) {
681 check_crit(scn.id.name + SST_SYMG(RHS(2)));
682 sptr = get_csect_sym(scn.id.name + SST_SYMG(RHS(2)));
683 DI_CRITSYM(sem.doif_depth) = sptr;
684 } else {
685 check_crit(NULL);
686 DI_CRITSYM(sem.doif_depth) = 0;
687 sptr = get_csect_sym("unspc");
688 }
689 if (doif && sptr) {
690 /*can't call emit_bcs_ecs - it checks for nested critical sections*/
691 ast = mk_stmt(A_MP_CRITICAL, 0);
692 DI_BEGINP(doif) = ast;
693 if (!XBIT(69, 0x100))
694 A_MEMP(ast, CMEMFG(sptr));
695 else if (CMEMFG(sptr) != CMEMLG(sptr))
696 A_MEMP(ast, SYMLKG(CMEMFG(sptr)));
697 else
698 A_MEMP(ast, CMEMFG(sptr));
699 }
700 SST_ASTP(LHS, ast);
701 break;
702 /*
703 * <mp stmt> ::= <mp endcritical> <opt csident> |
704 */
705 case MP_STMT4:
706 ast = 0;
707 prev_doif = sem.doif_depth;
708 doif = leave_dir(DI_CRITICAL, FALSE, 0);
709 if (SST_IDG(RHS(2)))
710 nmptr = scn.id.name + SST_SYMG(RHS(2));
711 else
712 nmptr = NULL;
713 sptr = 0;
714 if (DI_ID(prev_doif) == DI_CRITICAL) {
715 sptr = DI_CRITSYM(prev_doif);
716 if (sptr) {
717 if (nmptr == NULL)
718 error(155, 3, gbl.lineno,
719 "CRITICAL is named, matching ENDCRITICAL is not -",
720 SYMNAME(sptr) + get_csect_pfxlen());
721 else if (strcmp(nmptr, SYMNAME(sptr) + get_csect_pfxlen()) != 0)
722 error(155, 3, gbl.lineno,
723 "CRITICAL and ENDCRITICAL names must be the same -", nmptr);
724 } else if (nmptr != NULL)
725 error(155, 3, gbl.lineno,
726 "ENDCRITICAL is named, matching CRITICAL is not -", nmptr);
727 else
728 sptr = get_csect_sym("unspc");
729 }
730 if (doif && sptr) {
731 ast = mk_stmt(A_MP_ENDCRITICAL, 0);
732 A_LOPP(DI_BEGINP(doif), ast);
733 A_LOPP(ast, DI_BEGINP(doif));
734 if (!XBIT(69, 0x100))
735 A_MEMP(ast, CMEMFG(sptr));
736 else if (CMEMFG(sptr) != CMEMLG(sptr))
737 A_MEMP(ast, SYMLKG(CMEMFG(sptr)));
738 else
739 A_MEMP(ast, CMEMFG(sptr));
740 }
741 SST_ASTP(LHS, ast);
742 break;
743 /*
744 * <mp stmt> ::= <single begin> <opt par list> |
745 */
746 case MP_STMT5:
747 ast = 0;
748 clause_errchk(BT_SINGLE, "OMP SINGLE");
749 doif = SST_CVALG(RHS(1));
750 if (doif) {
751 ast = mk_stmt(A_MP_SINGLE, 0);
752 DI_BEGINP(doif) = ast;
753 (void)add_stmt(ast);
754 ast = 0;
755 }
756 par_push_scope(TRUE);
757 begin_parallel_clause(sem.doif_depth);
758 SST_ASTP(LHS, ast);
759 break;
760 /*
761 * <mp stmt> ::= <mp endsingle> <opt endsingle list> |
762 */
763 case MP_STMT6:
764 ast = 0;
765 end_parallel_clause(sem.doif_depth);
766 doif = leave_dir(DI_SINGLE, TRUE, 2);
767 if (doif) {
768 ast = mk_stmt(A_MP_ENDSINGLE, 0);
769 A_LOPP(DI_BEGINP(doif), ast);
770 A_LOPP(ast, DI_BEGINP(doif));
771 if (CL_PRESENT(CL_NOWAIT) && CL_PRESENT(CL_COPYPRIVATE)) {
772 error(155, 3, gbl.lineno,
773 "NOWAIT and COPYPRIVATE are mutually exclusive", NULL);
774 }
775
776 if (CL_PRESENT(CL_COPYPRIVATE)) {
777 for (itemp = (ITEM *)CL_FIRST(CL_COPYPRIVATE); itemp != ITEM_END;
778 itemp = itemp->next) {
779 sptr = itemp->t.sptr;
780 if (sptr == 0)
781 continue;
782 if (STYPEG(sptr) == ST_CMBLK) {
783 if (CMEMFG(sptr) == 0) {
784 error(38, 3, gbl.lineno, SYMNAME(sptr), NULL);
785 }
786 } else if (!DCLDG(sptr)) {
787 error(38, 3, gbl.lineno, SYMNAME(sptr), NULL);
788 }
789
790 }
791 }
792
793 /* Handle if no wait is not set, which means we wait... barrier */
794 if (!CL_PRESENT(CL_NOWAIT)) {
795 (void)add_stmt(ast);
796 if (CL_PRESENT(CL_COPYPRIVATE)) /* kmpc copypriv will barrier for us */
797 ast = 0;
798 else
799 ast = mk_stmt(A_MP_BARRIER, 0);
800 }
801
802 do_copyprivate();
803 }
804 par_pop_scope();
805 SST_ASTP(LHS, ast);
806 break;
807 /*
808 * <mp stmt> ::= <pdo begin> <opt par list> |
809 */
810 case MP_STMT7:
811 clause_errchk(BT_PDO, "OMP DO");
812 do_schedule(SST_CVALG(RHS(1)));
813 sem.expect_do = TRUE;
814 get_stblk_uplevel_sptr();
815 par_push_scope(TRUE);
816 get_stblk_uplevel_sptr();
817 begin_parallel_clause(sem.doif_depth);
818 SST_ASTP(LHS, 0);
819 break;
820 /*
821 * <mp stmt> ::= <mp endpdo> <opt nowait> |
822 */
823 case MP_STMT8:
824 ast = 0;
825 doif = leave_dir(DI_PDO, FALSE, 0);
826 if (doif) {
827 if (!CL_PRESENT(CL_NOWAIT)) {
828 ast = mk_stmt(A_MP_BARRIER, 0);
829 } else {
830 /* check if cancel construct is present */
831 ast = DI_BEGINP(doif);
832 if (A_ENDLABG(ast)) {
833 error(155, 3, gbl.lineno,
834 "OMP DO that is canceled must not have an nowait clause", NULL);
835 }
836 }
837 }
838 SST_ASTP(LHS, ast);
839 break;
840 /*
841 * <mp stmt> ::= <mp barrier> |
842 */
843 case MP_STMT9:
844 ast = 0;
845 check_barrier();
846 ast = mk_stmt(A_MP_BARRIER, 0);
847 SST_ASTP(LHS, ast);
848 break;
849 /*
850 * <mp stmt> ::= <mp master> |
851 */
852 case MP_STMT10:
853 ast = 0;
854 doif = enter_dir(DI_MASTER, TRUE, 1,
855 DI_B(DI_PDO) | DI_B(DI_PARDO) | DI_B(DI_DOACROSS) |
856 DI_B(DI_PARSECTS) | DI_B(DI_SECTS) | DI_B(DI_SINGLE) |
857 DI_B(DI_TASK) | DI_B(DI_ATOMIC_CAPTURE) |
858 DI_B((DI_SIMD | DI_PDO)) | DI_B((DI_PARDO | DI_SIMD)));
859 if (doif) {
860 ast = mk_stmt(A_MP_MASTER, 0);
861 DI_BEGINP(doif) = ast;
862 }
863 SST_ASTP(LHS, ast);
864 break;
865 /*
866 * <mp stmt> ::= <mp endmaster> |
867 */
868 case MP_STMT11:
869 ast = 0;
870 doif = leave_dir(DI_MASTER, TRUE, 1);
871 if (doif) {
872 ast = mk_stmt(A_MP_ENDMASTER, 0);
873 A_LOPP(DI_BEGINP(doif), ast);
874 A_LOPP(ast, DI_BEGINP(doif));
875 }
876 SST_ASTP(LHS, ast);
877 break;
878 /*
879 * <mp stmt> ::= <mp atomic begin> <opt atomic type>
880 */
881 case MP_STMT12:
882 SST_ASTP(LHS, 0);
883 break;
884 /*
885 * <mp stmt> ::= <doacross begin> <opt par list> |
886 */
887 case MP_STMT13:
888 clause_errchk(BT_DOACROSS, "SMP DOACROSS");
889 do_schedule(SST_CVALG(RHS(1)));
890 sem.expect_do = TRUE;
891 mp_create_bscope(0);
892 DI_BPAR(sem.doif_depth) = emit_bpar();
893 par_push_scope(FALSE);
894 begin_parallel_clause(sem.doif_depth);
895 SST_ASTP(LHS, 0);
896 break;
897 /*
898 * <mp stmt> ::= <paralleldo begin> <opt par list> |
899 */
900 case MP_STMT14:
901 clause_errchk(BT_PARDO, "OMP PARALLEL DO");
902 do_schedule(SST_CVALG(RHS(1)));
903 sem.expect_do = TRUE;
904 mp_create_bscope(0);
905 DI_BPAR(sem.doif_depth) = emit_bpar();
906 par_push_scope(FALSE);
907 begin_parallel_clause(sem.doif_depth);
908 SST_ASTP(LHS, 0);
909 break;
910 /*
911 * <mp stmt> ::= <mp endpardo> |
912 */
913 case MP_STMT15:
914 (void)leave_dir(DI_PARDO, FALSE, 0);
915 SST_ASTP(LHS, 0);
916 break;
917 /*
918 * <mp stmt> ::= <parallelsections begin> <opt par list> |
919 */
920 case MP_STMT16:
921 ast = 0;
922 clause_errchk(BT_PARSECTS, "OMP PARALLEL SECTIONS");
923 doif = SST_CVALG(RHS(1));
924 mp_create_bscope(0);
925 DI_BPAR(sem.doif_depth) = emit_bpar();
926 par_push_scope(FALSE);
927 if (doif && sem.parallel <= 1) {
928 /* only distribute the work if in the outermost
929 * parallel region or not in a parallel region.
930 */
931 DI_SECT_CNT(doif) = 0;
932 ast = mk_stmt(A_MP_SECTIONS, 0);
933 A_ENDLABP(ast, 0);
934 DI_BEGINP(doif) = ast;
935 (void)add_stmt(ast);
936 begin_parallel_clause(sem.doif_depth);
937 if (DI_LASTPRIVATE(doif)) {
938 sptr = get_itemp(DT_INT4);
939 ENCLFUNCP(sptr, BLK_SYM(sem.scope_level));
940 DI_SECT_VAR(doif) = sptr;
941 assign_cval(sptr, -1, DT_INT4);
942 }
943
944 /* implied section - empty if there is no code */
945 ast = mk_stmt(A_MP_SECTION, 0);
946 (void)add_stmt(ast);
947 if (DI_LASTPRIVATE(doif)) {
948 sptr = get_itemp(DT_INT4);
949 ENCLFUNCP(sptr, BLK_SYM(sem.scope_level));
950 DI_SECT_VAR(doif) = sptr;
951 assign_cval(sptr, DI_SECT_CNT(doif), DT_INT4);
952 }
953
954 ast = 0;
955 }
956 SST_ASTP(LHS, ast);
957 break;
958 /*
959 * <mp stmt> ::= <mp endparsections> |
960 */
961 case MP_STMT17:
962 prev_doif = sem.doif_depth;
963 doif = leave_dir(DI_PARSECTS, TRUE, 0);
964 if (doif && sem.parallel <= 1) {
965 /* create fake section */
966 ast = mk_stmt(A_MP_LSECTION, 0);
967 (void)add_stmt(ast);
968 end_parallel_clause(prev_doif);
969 /* only distribute the work if in the outermost
970 * parallel region or not in a parallel region.
971 */
972
973 ast = mk_stmt(A_MP_ENDSECTIONS, 0);
974 A_LOPP(DI_BEGINP(doif), ast);
975 A_LOPP(ast, DI_BEGINP(doif));
976 (void)add_stmt(ast);
977 }
978 --sem.parallel;
979 par_pop_scope();
980 ast = emit_epar();
981 mp_create_escope();
982 A_LOPP(DI_BPAR(prev_doif), ast);
983 A_LOPP(ast, DI_BPAR(prev_doif));
984 SST_ASTP(LHS, 0);
985 break;
986 /*
987 * <mp stmt> ::= <sections begin> <opt par list> |
988 */
989 case MP_STMT18:
990 ast = 0;
991 clause_errchk(BT_SECTS, "OMP SECTION");
992 doif = SST_CVALG(RHS(1));
993 par_push_scope(TRUE);
994 if (doif && sem.parallel <= 1) {
995 /* only distribute the work if in the outermost
996 * parallel region or not in a parallel region.
997 */
998 DI_SECT_CNT(doif) = 0;
999 ast = mk_stmt(A_MP_SECTIONS, 0);
1000 A_ENDLABP(ast, 0);
1001 DI_BEGINP(doif) = ast;
1002 (void)add_stmt(ast);
1003 begin_parallel_clause(sem.doif_depth);
1004 ast = 0;
1005
1006 if (DI_LASTPRIVATE(doif)) {
1007 sptr = get_itemp(DT_INT4);
1008 ENCLFUNCP(sptr, BLK_SYM(sem.scope_level));
1009 DI_SECT_VAR(doif) = sptr;
1010 assign_cval(sptr, -1, DT_INT4);
1011 }
1012 DI_SECT_CNT(sem.doif_depth)++;
1013 ast = mk_stmt(A_MP_SECTION, 0);
1014 (void)add_stmt(ast);
1015 if (DI_LASTPRIVATE(doif)) {
1016 assign_cval(sptr, DI_SECT_CNT(doif), DT_INT4);
1017 }
1018 }
1019 SST_ASTP(LHS, ast);
1020 break;
1021 /*
1022 * <mp stmt> ::= <mp section> |
1023 */
1024 case MP_STMT19:
1025 ast = 0;
1026 if (DI_ID(sem.doif_depth) != DI_SECTS &&
1027 DI_ID(sem.doif_depth) != DI_PARSECTS) {
1028 error(155, 3, gbl.lineno, "Illegal context for SECTION", NULL);
1029 SST_ASTP(LHS, 0);
1030 break;
1031 }
1032 if (sem.parallel <= 1) {
1033 /* only distribute the work if in the outermost
1034 * parallel region or not in a parallel region.
1035 */
1036 DI_SECT_CNT(sem.doif_depth)++;
1037 ast = mk_stmt(A_MP_SECTION, 0);
1038 (void)add_stmt(ast);
1039 if (DI_LASTPRIVATE(sem.doif_depth)) {
1040 assign_cval(DI_SECT_VAR(sem.doif_depth), DI_SECT_CNT(sem.doif_depth),
1041 DT_INT);
1042 }
1043 }
1044 SST_ASTP(LHS, 0);
1045 break;
1046 /*
1047 * <mp stmt> ::= <mp endsections> <opt nowait> |
1048 */
1049 case MP_STMT20:
1050 ast = 0;
1051 prev_doif = sem.doif_depth;
1052 doif = leave_dir(DI_SECTS, FALSE, 0);
1053 if (doif && sem.parallel <= 1) {
1054 /* create fake section */
1055 ast = mk_stmt(A_MP_LSECTION, 0);
1056 (void)add_stmt(ast);
1057 end_parallel_clause(prev_doif);
1058 /* only distribute the work if in the outermost
1059 * parallel region or not in a parallel region.
1060 */
1061 ast = mk_stmt(A_MP_ENDSECTIONS, 0);
1062 A_LOPP(DI_BEGINP(doif), ast);
1063 A_LOPP(ast, DI_BEGINP(doif));
1064 (void)add_stmt(ast);
1065 }
1066 if (doif && sem.parallel <= 1) {
1067 /* only distribute the work if in the outermost
1068 * parallel region or not in a parallel region.
1069 */
1070 if (!CL_PRESENT(CL_NOWAIT)) {
1071 ast = mk_stmt(A_MP_BARRIER, 0);
1072 (void)add_stmt(ast);
1073 } else {
1074 /* check if cancel construct is present */
1075 ast = DI_BEGINP(doif);
1076 if (A_ENDLABG(ast)) {
1077 error(155, 3, gbl.lineno,
1078 "SECTIONS construct that is canceled must "
1079 "not have an nowait clause",
1080 NULL);
1081 }
1082 }
1083 }
1084 par_pop_scope();
1085 SST_ASTP(LHS, 0);
1086 break;
1087 /*
1088 * <mp stmt> ::= <mp flush> |
1089 */
1090 case MP_STMT21:
1091 ast = mk_stmt(A_MP_FLUSH, 0);
1092 (void)add_stmt(ast);
1093 SST_ASTP(LHS, 0);
1094 break;
1095 /*
1096 * <mp stmt> ::= <mp flush> ( <ident list> ) |
1097 */
1098 case MP_STMT22:
1099 for (itemp = SST_BEGG(RHS(3)); itemp != ITEM_END; itemp = itemp->next) {
1100 sptr = refsym(itemp->t.sptr, OC_OTHER);
1101 VOLP(sptr, 1);
1102 }
1103 ast = mk_stmt(A_MP_FLUSH, 0);
1104 (void)add_stmt(ast);
1105 SST_ASTP(LHS, 0);
1106 break;
1107 /*
1108 * <mp stmt> ::= <mp ordered> <opt ordered list> |
1109 */
1110 case MP_STMT23:
1111 ast = 0;
1112 doif = enter_dir(DI_ORDERED, TRUE, 3,
1113 DI_B(DI_DOACROSS) | DI_B(DI_PARSECTS) | DI_B(DI_SECTS) |
1114 DI_B(DI_SINGLE) | DI_B(DI_CRITICAL) | DI_B(DI_MASTER) |
1115 DI_B(DI_TASK) | DI_B(DI_ATOMIC_CAPTURE));
1116 if (doif) {
1117 nmptr = "_mp_orders_begx";
1118 while (--doif) {
1119 if (DI_ID(doif) == DI_PDO || DI_ID(doif) == DI_PARDO) {
1120 if (DI_IS_ORDERED(doif)) {
1121 sptr = DI_DOINFO(doif + 1)->index_var;
1122 if (size_of(DTYPEG(sptr)) < 8)
1123 nmptr = "_mp_orders_beg";
1124 else
1125 nmptr = "_mp_orders_beg8";
1126 } else
1127 error(155, 3, DI_LINENO(doif),
1128 "DO must have the ORDERED clause specified", NULL);
1129 break;
1130 }
1131 }
1132 ast = mk_stmt(A_MP_BORDERED, 0);
1133 (void)add_stmt(ast);
1134 ast = 0;
1135
1136 if (sem.parallel && doif == 0) {
1137 /* DO directive not present */
1138 error(155, 3, gbl.lineno, "Illegal context for", "ORDERED");
1139 }
1140 }
1141 SST_ASTP(LHS, ast);
1142 break;
1143 /*
1144 * <mp stmt> ::= <mp endordered>
1145 */
1146 case MP_STMT24:
1147 ast = 0;
1148 doif = leave_dir(DI_ORDERED, TRUE, 3);
1149 if (doif) {
1150 nmptr = "_mp_orders_endx";
1151 while (--doif) {
1152 if (DI_ID(doif) == DI_PDO || DI_ID(doif) == DI_PARDO) {
1153 if (DI_IS_ORDERED(doif)) {
1154 sptr = DI_DOINFO(doif + 1)->index_var;
1155 if (size_of(DTYPEG(sptr)) < 8)
1156 nmptr = "_mp_orders_end";
1157 else
1158 nmptr = "_mp_orders_end8";
1159 }
1160 break;
1161 }
1162 }
1163 ast = mk_stmt(A_MP_EORDERED, 0);
1164 (void)add_stmt(ast);
1165 ast = 0;
1166 }
1167 SST_ASTP(LHS, ast);
1168 break;
1169
1170 /*
1171 * <mp stmt> ::= <mp workshare> |
1172 */
1173 case MP_STMT25:
1174 ast = 0;
1175 mp_create_bscope(0);
1176 doif = enter_dir(DI_WORKSHARE, FALSE, 1,
1177 DI_B(DI_PDO) | DI_B(DI_PARDO) | DI_B(DI_DOACROSS) |
1178 DI_B(DI_SECTS) | DI_B(DI_SINGLE) | DI_B(DI_MASTER) |
1179 DI_B(DI_ORDERED) | DI_B(DI_ATOMIC_CAPTURE) |
1180 DI_B((DI_SIMD | DI_PDO)));
1181 SST_CVALP(LHS, doif);
1182 par_push_scope(TRUE);
1183 if (doif) {
1184 DI_SECT_CNT(doif) = 0;
1185 }
1186 ast = mk_stmt(A_MP_WORKSHARE, 0);
1187 DI_BEGINP(doif) = ast;
1188 SST_ASTP(LHS, ast);
1189
1190 break;
1191 /*
1192 * <mp stmt> ::= <mp endworkshare> <opt nowait> |
1193 */
1194 case MP_STMT26:
1195 ast = 0;
1196 prev_doif = sem.doif_depth;
1197 doif = leave_dir(DI_WORKSHARE, FALSE, 1);
1198 if (doif) {
1199 ast = mk_stmt(A_MP_ENDWORKSHARE, 0);
1200 A_LOPP(DI_BEGINP(doif), ast);
1201 A_LOPP(ast, DI_BEGINP(doif));
1202 (void)add_stmt(ast);
1203 end_workshare(A_STDG(DI_BEGINP(doif)), A_STDG(ast));
1204 }
1205 if (doif && sem.parallel <= 1) {
1206 /* only distribute the work if in the outermost
1207 * parallel region or not in a parallel region.
1208 */
1209 if (CL_PRESENT(CL_NOWAIT)) {
1210 ast = mk_stmt(A_MP_BARRIER, 0);
1211 (void)add_stmt(ast);
1212 }
1213 }
1214 par_pop_scope();
1215 mp_create_escope();
1216 SST_ASTP(LHS, 0);
1217 break;
1218 /*
1219 * <mp stmt> ::= <parworkshare begin> <opt par list> |
1220 */
1221 case MP_STMT27:
1222 ast = 0;
1223 clause_errchk(BT_PARWORKS, "OMP WORKSHARE");
1224 mp_create_bscope(0);
1225 DI_BPAR(sem.doif_depth) = emit_bpar();
1226 par_push_scope(FALSE);
1227 begin_parallel_clause(doif = sem.doif_depth);
1228 if (doif) {
1229 DI_SECT_CNT(doif) = 0;
1230 }
1231 ast = mk_stmt(A_MP_WORKSHARE, 0);
1232 DI_BEGINP(doif) = ast;
1233 SST_ASTP(LHS, ast);
1234 break;
1235 /*
1236 * <mp stmt> ::= <mp endparworkshare> |
1237 */
1238 case MP_STMT28:
1239 doif = sem.doif_depth;
1240 if (doif) {
1241 ast = mk_stmt(A_MP_ENDWORKSHARE, 0);
1242 A_LOPP(DI_BEGINP(doif), ast);
1243 A_LOPP(ast, DI_BEGINP(doif));
1244 (void)add_stmt(ast);
1245 end_workshare(A_STDG(DI_BEGINP(doif)), A_STDG(ast));
1246 }
1247 end_parallel_clause(doif);
1248 (void)leave_dir(DI_PARWORKS, TRUE, 0);
1249 --sem.parallel;
1250 par_pop_scope();
1251 ast = emit_epar();
1252 mp_create_escope();
1253 A_LOPP(DI_BPAR(doif), ast);
1254 A_LOPP(ast, DI_BPAR(doif));
1255 SST_ASTP(LHS, 0);
1256 break;
1257 /*
1258 * <mp stmt> ::= <task begin> <opt par list> |
1259 */
1260 case MP_STMT29:
1261 ast = 0;
1262 clause_errchk(BT_TASK, "OMP TASK");
1263 doif = SST_CVALG(RHS(1));
1264 mp_create_bscope(0);
1265 if (doif) {
1266 ast = mk_stmt(A_MP_TASK, 0);
1267 A_ENDLABP(ast, 0);
1268 DI_BEGINP(doif) = ast;
1269 if (CL_PRESENT(CL_UNTIED)) {
1270 A_UNTIEDP(ast, 1);
1271 }
1272 if (CL_PRESENT(CL_IF)) {
1273 if (mp_iftype != IF_DEFAULT && mp_iftype != IF_TASK)
1274 error(155, 3, gbl.lineno,
1275 "IF (task:) or IF is expected in TASK construct ", NULL);
1276 else
1277 A_IFPARP(ast, CL_VAL(CL_IF));
1278 }
1279 if (CL_PRESENT(CL_FINAL)) {
1280 A_FINALPARP(ast, CL_VAL(CL_FINAL));
1281 }
1282 if (CL_PRESENT(CL_MERGEABLE)) {
1283 A_MERGEABLEP(ast, 1);
1284 }
1285 if (sem.parallel) {
1286 /*
1287 * Task is within a parallel region.
1288 */
1289 if (CL_PRESENT(CL_DEFAULT) && CL_VAL(CL_DEFAULT) == PAR_SCOPE_SHARED) {
1290 A_EXEIMMP(ast, 1);
1291 } else if (CL_PRESENT(CL_SHARED)) {
1292 /*
1293 if (any_pflsr_private)
1294 A_EXEIMMP(ast, 1);
1295 */
1296 /* Any SHARED privates?? */
1297 for (itemp = CL_FIRST(CL_SHARED); itemp != ITEM_END;
1298 itemp = itemp->next) {
1299 sptr = itemp->t.sptr;
1300 if (STYPEG(sptr) != SC_CMBLK && SCG(sptr) == SC_PRIVATE) {
1301 A_EXEIMMP(ast, 1);
1302 break;
1303 }
1304 }
1305 }
1306 }
1307 (void)add_stmt(ast);
1308 sem.task++;
1309 }
1310 par_push_scope(FALSE);
1311 begin_parallel_clause(sem.doif_depth);
1312 if (doif) {
1313 ast = mk_stmt(A_MP_TASKREG, 0);
1314 (void)add_stmt(ast);
1315 }
1316 SST_ASTP(LHS, 0);
1317 break;
1318 /*
1319 * <mp stmt> ::= <mp endtask> |
1320 */
1321 case MP_STMT30:
1322 end_parallel_clause(sem.doif_depth);
1323 doif = leave_dir(DI_TASK, FALSE, 1);
1324 if (doif) {
1325 sem.task--;
1326 par_pop_scope();
1327 ast = mk_stmt(A_MP_ENDTASK, 0);
1328 A_LOPP(DI_BEGINP(doif), ast);
1329 A_LOPP(ast, DI_BEGINP(doif));
1330 (void)add_stmt(ast);
1331 mp_create_escope();
1332 }
1333 SST_ASTP(LHS, 0);
1334 break;
1335 /*
1336 * <mp stmt> ::= <mp taskwait>
1337 */
1338 case MP_STMT31:
1339 ast = mk_stmt(A_MP_TASKWAIT, 0);
1340 SST_ASTP(LHS, ast);
1341 break;
1342 /*
1343 * <mp stmt> ::= <mp taskyield>
1344 */
1345 case MP_STMT32:
1346 ast = mk_stmt(A_MP_TASKYIELD, 0);
1347 SST_ASTP(LHS, ast);
1348 break;
1349 /*
1350 * <mp stmt> ::= <mp endatomic> |
1351 */
1352 case MP_STMT33:
1353 if (sem.mpaccatomic.action_type == ATOMIC_CAPTURE) {
1354 int ecs;
1355 if (use_opt_atomic(sem.doif_depth)) {
1356 ecs = mk_stmt(A_MP_ENDATOMIC, 0);
1357 std = add_stmt(ecs);
1358 } else {
1359 ecs = emit_bcs_ecs(A_MP_ENDCRITICAL);
1360 A_LOPP(ecs, sem.mpaccatomic.ast);
1361 A_LOPP(sem.mpaccatomic.ast, ecs);
1362 }
1363 sem.mpaccatomic.ast = 0;
1364 leave_dir(DI_ATOMIC_CAPTURE, FALSE, 1);
1365 } else if (sem.mpaccatomic.accassignc > 1) {
1366 error(155, 3, gbl.lineno, "Too many statements in ATOMIC CONSTRUCT",
1367 NULL);
1368 }
1369 sem.mpaccatomic.accassignc = 0;
1370 sem.mpaccatomic.seen = FALSE;
1371 sem.mpaccatomic.apply = FALSE;
1372 sem.mpaccatomic.pending = FALSE;
1373 sem.mpaccatomic.action_type = ATOMIC_UNDEF;
1374 SST_ASTP(LHS, 0);
1375 break;
1376 /*
1377 * <mp stmt> ::= <taskloop begin> <opt par list> |
1378 */
1379 case MP_STMT34:
1380 share_taskloop:
1381 ast = 0;
1382 clause_errchk(BT_TASKLOOP, "OMP TASKLOOP");
1383 doif = SST_CVALG(RHS(1));
1384 mp_create_bscope(0);
1385 if (doif) {
1386 do_schedule(doif);
1387 ast = mk_stmt(A_MP_TASKLOOP, 0);
1388 A_ENDLABP(ast, 0);
1389 DI_BEGINP(doif) = ast;
1390 if (CL_PRESENT(CL_UNTIED)) {
1391 A_UNTIEDP(ast, 1);
1392 }
1393 if (CL_PRESENT(CL_IF)) {
1394 if (mp_iftype != IF_DEFAULT && mp_iftype != IF_TASK)
1395 error(155, 3, gbl.lineno,
1396 "IF (task:) or IF is expected in TASKLOOP construct ", NULL);
1397 else
1398 A_IFPARP(ast, CL_VAL(CL_IF));
1399 }
1400 if (CL_PRESENT(CL_FINAL)) {
1401 A_FINALPARP(ast, CL_VAL(CL_FINAL));
1402 }
1403 if (CL_PRESENT(CL_MERGEABLE)) {
1404 A_MERGEABLEP(ast, 1);
1405 }
1406 if (CL_PRESENT(CL_NOGROUP)) {
1407 A_NOGROUPP(ast, 1);
1408 }
1409 if (CL_PRESENT(CL_NUM_TASKS)) {
1410 A_NUM_TASKSP(ast, CL_VAL(CL_NUM_TASKS));
1411 } else if (CL_PRESENT(CL_GRAINSIZE)) {
1412 A_GRAINSIZEP(ast, CL_VAL(CL_GRAINSIZE));
1413 }
1414 if (CL_PRESENT(CL_PRIORITY)) {
1415 A_PRIORITYP(ast, CL_VAL(CL_PRIORITY));
1416 }
1417 if (sem.parallel) {
1418 /*
1419 * Task is within a parallel region.
1420 */
1421 if (CL_PRESENT(CL_DEFAULT) && CL_VAL(CL_DEFAULT) == PAR_SCOPE_SHARED) {
1422 ;
1423 } else if (CL_PRESENT(CL_SHARED)) {
1424 /* Any SHARED privates?? */
1425 for (itemp = CL_FIRST(CL_SHARED); itemp != ITEM_END;
1426 itemp = itemp->next) {
1427 sptr = itemp->t.sptr;
1428 if (STYPEG(sptr) != SC_CMBLK && SCG(sptr) == SC_PRIVATE) {
1429 A_EXEIMMP(ast, 1);
1430 break;
1431 }
1432 }
1433 }
1434 }
1435 (void)add_stmt(ast);
1436 sem.task++;
1437 }
1438 par_push_scope(FALSE);
1439 begin_parallel_clause(sem.doif_depth);
1440 SST_ASTP(LHS, 0);
1441 sem.expect_do = TRUE;
1442 break;
1443 /*
1444 * <mp stmt> ::= <mp endtaskloop> |
1445 */
1446 case MP_STMT35:
1447 doif = leave_dir(DI_TASKLOOP, FALSE, 1);
1448 SST_ASTP(LHS, 0);
1449 break;
1450 /*
1451 * <mp stmt> ::= <taskloopsimd begin> <opt par list> |
1452 */
1453 case MP_STMT36:
1454 apply_nodepchk(gbl.lineno, 1);
1455 goto share_taskloop;
1456 break;
1457 /*
1458 * <mp stmt> ::= <mp endtaskloopsimd> |
1459 */
1460 case MP_STMT37:
1461 doif = leave_dir(DI_TASKLOOP, FALSE, 1);
1462 SST_ASTP(LHS, 0);
1463 break;
1464 /*
1465 * <mp stmt> ::= <mp cancel> <id name> <opt par ifclause> |
1466 */
1467 case MP_STMT38:
1468 ctype = (cancel_type(scn.id.name + SST_CVALG(RHS(2))));
1469 d = check_cancel(ctype);
1470 if (d > 0) {
1471 ast = mk_stmt(A_MP_CANCEL, 0);
1472 add_stmt(ast);
1473 if (CL_PRESENT(CL_IF))
1474 A_IFPARP(ast, CL_VAL(CL_IF));
1475 A_LOPP(ast, d);
1476 if (A_ENDLABG(d)) {
1477 A_ENDLABP(ast, A_ENDLABG(d));
1478 } else {
1479 int lab = getlab();
1480 int astlab = mk_label(lab);
1481 A_ENDLABP(d, astlab);
1482 A_ENDLABP(ast, astlab);
1483 }
1484 A_CANCELKINDP(ast, ctype);
1485 }
1486 SST_ASTP(LHS, 0);
1487 break;
1488 /*
1489 * <mp stmt> ::= <dosimd begin> <opt par list> |
1490 */
1491 case MP_STMT39:
1492 clause_errchk((BT_SIMD | BT_PDO), "OMP DOSIMD");
1493 do_schedule(SST_CVALG(RHS(1)));
1494 sem.expect_do = TRUE;
1495 get_stblk_uplevel_sptr();
1496 par_push_scope(TRUE);
1497 get_stblk_uplevel_sptr();
1498 begin_parallel_clause(sem.doif_depth);
1499 DI_ISSIMD(sem.doif_depth) = TRUE;
1500 apply_nodepchk(gbl.lineno, 1);
1501
1502 SST_ASTP(LHS, 0);
1503 break;
1504 /*
1505 * <mp stmt> ::= <mp enddosimd> <opt nowait> |
1506 */
1507 case MP_STMT40:
1508 ast = 0;
1509 doif = leave_dir(DI_PDO, FALSE, 0);
1510 if (doif) {
1511 if (!CL_PRESENT(CL_NOWAIT)) {
1512 ast = mk_stmt(A_MP_BARRIER, 0);
1513 }
1514 }
1515 SST_ASTP(LHS, ast);
1516 break;
1517 /*
1518 * <mp stmt> ::= <simd begin> <opt par list> |
1519 */
1520 case MP_STMT41:
1521 clause_errchk(BT_SIMD, "OMP SIMD");
1522 sem.collapse = 0;
1523 if (CL_PRESENT(CL_COLLAPSE)) {
1524 sem.collapse = CL_VAL(CL_COLLAPSE);
1525 }
1526 sem.expect_simd_do = TRUE;
1527 par_push_scope(TRUE);
1528 begin_parallel_clause(sem.doif_depth);
1529 SST_ASTP(LHS, 0);
1530 apply_nodepchk(gbl.lineno, 1);
1531 break;
1532 /*
1533 * <mp stmt> ::= <mp endsimd> |
1534 */
1535 case MP_STMT42:
1536 ast = 0;
1537 end_parallel_clause(doif = sem.doif_depth);
1538 doif = leave_dir(DI_SIMD, FALSE, 0);
1539 SST_ASTP(LHS, ast);
1540 break;
1541 /*
1542 * <mp stmt> ::= <targetdata begin> <opt par list> |
1543 */
1544 case MP_STMT43: {
1545 check_targetdata(OMP_TARGETDATA, "OMP TARGET DATA");
1546 doif = SST_CVALG(RHS(1));
1547 ast = mk_stmt(A_MP_TARGETDATA, 0);
1548 if (CL_PRESENT(CL_IF)) {
1549 if (mp_iftype != OMP_DEFAULT && mp_iftype != OMP_TARGETDATA)
1550 error(155, 3, gbl.lineno,
1551 "IF (target data:) or IF is expected in TARGET DATA construct ",
1552 NULL);
1553 else
1554 A_IFPARP(ast, CL_VAL(CL_IF));
1555 mp_iftype = IF_DEFAULT;
1556 }
1557 if (doif) {
1558 DI_BTARGET(doif) = ast;
1559 }
1560 add_stmt(ast);
1561 }
1562 SST_ASTP(LHS, 0);
1563 do_map();
1564 break;
1565 /*
1566 * <mp stmt> ::= <mp endtargetdata> |
1567 */
1568 case MP_STMT44: {
1569 doif = leave_dir(DI_TARGETDATA, TRUE, 0);
1570 ast = mk_stmt(A_MP_ENDTARGETDATA, 0);
1571 if (CL_PRESENT(CL_IF)) {
1572 A_IFEXPRP(ast, CL_VAL(CL_IF));
1573 }
1574 if (doif) {
1575 A_LOPP(DI_BTARGET(doif), ast);
1576 A_LOPP(ast, DI_BTARGET(doif));
1577 }
1578 add_stmt(ast);
1579 }
1580 SST_ASTP(LHS, 0);
1581 break;
1582 /*
1583 * <mp stmt> ::= <targetenterdata begin> <opt par list> |
1584 */
1585 case MP_STMT45: {
1586 check_targetdata(OMP_TARGETENTERDATA, "OMP TARGET ENTER DATA");
1587 ast = mk_stmt(A_MP_TARGETENTERDATA, 0);
1588 if (CL_PRESENT(CL_IF)) {
1589 if (mp_iftype != OMP_DEFAULT && mp_iftype != OMP_TARGETENTERDATA)
1590 error(155, 3, gbl.lineno,
1591 "IF (target enter data:) or IF is expected "
1592 "in TARGET ENTER DATA construct ",
1593 NULL);
1594 else
1595 A_IFPARP(ast, CL_VAL(CL_IF));
1596 mp_iftype = IF_DEFAULT;
1597 }
1598 if (CL_PRESENT(CL_DEPEND)) {
1599 }
1600 if (CL_PRESENT(CL_NOWAIT)) {
1601 }
1602 add_stmt(ast);
1603 (void)leave_dir(DI_TARGETENTERDATA, TRUE, 0);
1604 }
1605 SST_ASTP(LHS, 0);
1606 do_map();
1607 break;
1608 /*
1609 * <mp stmt> ::= <targetexitdata begin> <opt par list> |
1610 */
1611 case MP_STMT46: {
1612 check_targetdata(OMP_TARGETEXITDATA, "OMP TARGET EXIT DATA");
1613 ast = mk_stmt(A_MP_TARGETEXITDATA, 0);
1614 if (CL_PRESENT(CL_IF)) {
1615 if (mp_iftype != IF_DEFAULT && mp_iftype != IF_TARGETEXITDATA)
1616 error(155, 3, gbl.lineno,
1617 "IF (target exit data:) or IF is expected in "
1618 "TARGET EXIT DATA construct ",
1619 NULL);
1620 else
1621 A_IFPARP(ast, CL_VAL(CL_IF));
1622 mp_iftype = IF_DEFAULT;
1623 }
1624 if (CL_PRESENT(CL_DEPEND)) {
1625 }
1626 if (CL_PRESENT(CL_NOWAIT)) {
1627 }
1628 add_stmt(ast);
1629 (void)leave_dir(DI_TARGETEXITDATA, TRUE, 0);
1630 }
1631 SST_ASTP(LHS, 0);
1632 do_map();
1633 break;
1634 /*
1635 * <mp stmt> ::= <targetupdate begin> <opt par list> |
1636 */
1637 case MP_STMT47: {
1638 check_targetdata(OMP_TARGETUPDATE, "OMP TARGET UPDATE");
1639 ast = mk_stmt(A_MP_TARGETUPDATE, 0);
1640 if (CL_PRESENT(CL_IF)) {
1641 if (mp_iftype != IF_DEFAULT && mp_iftype != IF_TARGETUPDATE)
1642 error(
1643 155, 3, gbl.lineno,
1644 "IF (target update:) or IF is expected in TARGET UPDATE construct ",
1645 NULL);
1646 else
1647 A_IFPARP(ast, CL_VAL(CL_IF));
1648 mp_iftype = IF_DEFAULT;
1649 }
1650 if (CL_PRESENT(CL_DEPEND)) {
1651 }
1652 if (CL_PRESENT(CL_NOWAIT)) {
1653 }
1654 add_stmt(ast);
1655 (void)leave_dir(DI_TARGETUPDATE, TRUE, 0);
1656 }
1657 SST_ASTP(LHS, 0);
1658 break;
1659 /*
1660 * <mp stmt> ::= <target begin> <opt par list> |
1661 */
1662 case MP_STMT48:
1663 clause_errchk(BT_TARGET, "OMP TARGET");
1664 mp_create_bscope(0);
1665 DI_BTARGET(sem.doif_depth) = emit_btarget(A_MP_TARGET);
1666 #if defined(OMP_OFFLOAD_LLVM) || defined(OMP_OFFLOAD_PGI)
1667 if(flg.omptarget)
1668 A_COMBINEDTYPEP(DI_BTARGET(sem.doif_depth),
1669 get_omp_combined_mode(BT_TARGET));
1670 #endif
1671 par_push_scope(TRUE);
1672 begin_parallel_clause(sem.doif_depth);
1673 SST_ASTP(LHS, 0);
1674 break;
1675 /*
1676 * <mp stmt> ::= <mp endtarget> |
1677 */
1678 case MP_STMT49:
1679 end_parallel_clause(doif = sem.doif_depth);
1680 (void)leave_dir(DI_TARGET, TRUE, 0);
1681 sem.target--;
1682 par_pop_scope();
1683 ast = emit_etarget();
1684 mp_create_escope();
1685 if (doif) {
1686 A_LOPP(DI_BTARGET(doif), ast);
1687 A_LOPP(ast, DI_BTARGET(doif));
1688 }
1689 SST_ASTP(LHS, 0);
1690 break;
1691 /*
1692 * <mp stmt> ::= <teams begin> <opt par list> |
1693 */
1694 case MP_STMT50:
1695 ast = 0;
1696 clause_errchk(BT_TEAMS, "OMP_TEAMS");
1697 doif = SST_CVALG(RHS(1));
1698 do_bteams(doif);
1699 SST_ASTP(LHS, 0);
1700 break;
1701 /*
1702 * <mp stmt> ::= <mp endteams> |
1703 */
1704 case MP_STMT51:
1705 ast = 0;
1706 end_parallel_clause(doif = sem.doif_depth);
1707 (void)leave_dir(DI_TEAMS, TRUE, 0);
1708 --sem.teams;
1709 par_pop_scope();
1710 mp_create_escope();
1711 if (doif) {
1712 ast = mk_stmt(A_MP_ENDTEAMS, 0);
1713 A_LOPP(DI_BTEAMS(doif), ast);
1714 A_LOPP(ast, DI_BTEAMS(doif));
1715 add_stmt(ast);
1716 ast = 0;
1717 }
1718 SST_ASTP(LHS, ast);
1719 break;
1720 /*
1721 * <mp stmt> ::= <distribute begin> <opt par list> |
1722 */
1723 case MP_STMT52:
1724 clause_errchk(BT_DISTRIBUTE, "OMP DISTRIBUTE");
1725 doif = SST_CVALG(RHS(1));
1726 sem.expect_do = TRUE;
1727 do_bdistribute(doif, TRUE);
1728 SST_ASTP(LHS, 0);
1729 break;
1730 /*
1731 * <mp stmt> ::= <mp enddistribute> |
1732 */
1733 case MP_STMT53:
1734 doif = leave_dir(DI_DISTRIBUTE, TRUE, 1);
1735 SST_ASTP(LHS, 0);
1736 break;
1737 /*
1738 * <mp stmt> ::= <distsimd begin> <opt par list> |
1739 */
1740 case MP_STMT54:
1741 clause_errchk((BT_DISTRIBUTE | BT_SIMD), "OMP DISTRIBUTE SIMD");
1742 doif = SST_CVALG(RHS(1));
1743 sem.expect_do = TRUE;
1744 do_bdistribute(doif, TRUE);
1745 apply_nodepchk(gbl.lineno, 1);
1746 SST_ASTP(LHS, 0);
1747 break;
1748 /*
1749 * <mp stmt> ::= <mp enddistsimd> |
1750 */
1751 case MP_STMT55:
1752 SST_ASTP(LHS, 0);
1753 break;
1754 /*
1755 * <mp stmt> ::= <distpardo begin> <opt par list> |
1756 */
1757 case MP_STMT56:
1758 ast = 0;
1759 clause_errchk((BT_DISTRIBUTE | BT_PARDO), "OMP DISTRIBUTE PARALLE DO");
1760 begin_combine_constructs((BT_DISTRIBUTE | BT_PARDO));
1761 SST_ASTP(LHS, ast);
1762 break;
1763 /*
1764 * <mp stmt> ::= <mp enddistpardo> |
1765 */
1766 case MP_STMT57:
1767 doif = leave_dir(DI_DISTPARDO, TRUE, 1);
1768 SST_ASTP(LHS, 0);
1769 break;
1770 /*
1771 * <mp stmt> ::= <distpardosimd begin> <opt par list> |
1772 */
1773 case MP_STMT58:
1774 ast = 0;
1775 clause_errchk((BT_DISTRIBUTE | BT_PARDO | BT_SIMD),
1776 "OMP DISTRIBUTE PARALLE DO SIMD");
1777 begin_combine_constructs((BT_DISTRIBUTE | BT_PARDO | BT_SIMD));
1778 DI_ISSIMD(sem.doif_depth) = TRUE;
1779 SST_ASTP(LHS, ast);
1780 break;
1781 /*
1782 * <mp stmt> ::= <mp enddistpardosimd> |
1783 */
1784 case MP_STMT59:
1785 doif = leave_dir(DI_DISTPARDO, TRUE, 1);
1786 SST_ASTP(LHS, 0);
1787 break;
1788 /*
1789 * <mp stmt> ::= <pardosimd begin> <opt par list> |
1790 */
1791 case MP_STMT60:
1792 clause_errchk((BT_PARDO | BT_SIMD), "OMP PARALLEL DO SIMD");
1793 do_schedule(SST_CVALG(RHS(1)));
1794 sem.expect_do = TRUE;
1795 mp_create_bscope(0);
1796 DI_BPAR(sem.doif_depth) = emit_bpar();
1797 par_push_scope(FALSE);
1798 begin_parallel_clause(sem.doif_depth);
1799 DI_ISSIMD(sem.doif_depth) = TRUE;
1800 SST_ASTP(LHS, 0);
1801 apply_nodepchk(gbl.lineno, 1);
1802 break;
1803 /*
1804 * <mp stmt> ::= <mp endpardosimd> |
1805 */
1806 case MP_STMT61:
1807 SST_ASTP(LHS, 0);
1808 break;
1809 /*
1810 * <mp stmt> ::= <targpar begin> <opt par list> |
1811 */
1812 case MP_STMT62:
1813 ast = 0;
1814 clause_errchk((BT_TARGET | BT_PAR), "OMP TARGET PARALLEL");
1815 begin_combine_constructs((BT_TARGET | BT_PAR));
1816 SST_ASTP(LHS, ast);
1817 break;
1818 /*
1819 * <mp stmt> ::= <mp endtargpar> |
1820 */
1821 case MP_STMT63:
1822 end_parallel_clause(doif = sem.doif_depth);
1823 (void)leave_dir(DI_PAR, TRUE, 0);
1824 --sem.parallel;
1825 par_pop_scope();
1826 ast = emit_epar();
1827 mp_create_escope();
1828 if (doif) {
1829 A_LOPP(DI_BPAR(doif), ast);
1830 A_LOPP(ast, DI_BPAR(doif));
1831 }
1832
1833 end_parallel_clause(doif = sem.doif_depth);
1834 (void)leave_dir(DI_TARGET, TRUE, 0);
1835 sem.target--;
1836 par_pop_scope();
1837 if (doif) {
1838 ast = emit_etarget();
1839 mp_create_escope();
1840 A_LOPP(DI_BTARGET(doif), ast);
1841 A_LOPP(ast, DI_BTARGET(doif));
1842 }
1843
1844 SST_ASTP(LHS, 0);
1845 break;
1846 /*
1847 * <mp stmt> ::= <targpardo begin> <opt par list> |
1848 */
1849 case MP_STMT64:
1850 SST_ASTP(LHS, 0);
1851 clause_errchk((BT_TARGET | BT_PARDO), "OMP TARGET PARALLEL DO");
1852 begin_combine_constructs((BT_TARGET | BT_PARDO));
1853 sem.expect_do = TRUE;
1854 break;
1855 /*
1856 * <mp stmt> ::= <mp endtargpardo> |
1857 */
1858 case MP_STMT65:
1859 /* end target, parallel do is handled in do_end */
1860 end_parallel_clause(doif = sem.doif_depth);
1861 (void)leave_dir(DI_TARGET, TRUE, 0);
1862 sem.target--;
1863 par_pop_scope();
1864 if (doif) {
1865 ast = emit_etarget();
1866 mp_create_escope();
1867 A_LOPP(DI_BTARGET(doif), ast);
1868 A_LOPP(ast, DI_BTARGET(doif));
1869 }
1870 SST_ASTP(LHS, 0);
1871 break;
1872 /*
1873 * <mp stmt> ::= <targparsimd begin> <opt par list> |
1874 */
1875 case MP_STMT66:
1876 SST_ASTP(LHS, 0);
1877 /* Don't think this construct exists */
1878 clause_errchk((BT_TARGET | BT_PAR | BT_SIMD), "OMP TARGET PARALLEL SIMD");
1879 break;
1880 /*
1881 * <mp stmt> ::= <mp endtargparsimd> |
1882 */
1883 case MP_STMT67:
1884 /* this construct does not exist - remove it */
1885 SST_ASTP(LHS, 0);
1886 break;
1887 /*
1888 * <mp stmt> ::= <targpardosimd begin> <opt par list> |
1889 */
1890 case MP_STMT68:
1891 SST_ASTP(LHS, 0);
1892 clause_errchk((BT_TARGET | BT_PARDO | BT_SIMD),
1893 "OMP TARGET PARALLEL DO SIMD");
1894 begin_combine_constructs((BT_TARGET | BT_PARDO | BT_SIMD));
1895 sem.expect_do = TRUE;
1896 DI_ISSIMD(sem.doif_depth) = TRUE;
1897 break;
1898 /*
1899 * <mp stmt> ::= <mp endtargpardosimd> |
1900 */
1901 case MP_STMT69:
1902 /* end target, parallel do is handled in do_end */
1903 end_parallel_clause(doif = sem.doif_depth);
1904 (void)leave_dir(DI_TARGET, TRUE, 0);
1905 sem.target--;
1906 par_pop_scope();
1907 if (doif) {
1908 ast = emit_etarget();
1909 mp_create_escope();
1910 A_LOPP(DI_BTARGET(doif), ast);
1911 A_LOPP(ast, DI_BTARGET(doif));
1912 }
1913 SST_ASTP(LHS, 0);
1914 SST_ASTP(LHS, 0);
1915 break;
1916 /*
1917 * <mp stmt> ::= <targsimd begin> <opt par list> |
1918 */
1919 case MP_STMT70:
1920 SST_ASTP(LHS, 0);
1921 clause_errchk((BT_TARGET | BT_SIMD), "OMP TARGET SIMD");
1922 mp_create_bscope(0);
1923 DI_BTARGET(sem.doif_depth) = emit_btarget(A_MP_TARGET);
1924 par_push_scope(TRUE);
1925 begin_parallel_clause(sem.doif_depth);
1926 SST_ASTP(LHS, 0);
1927
1928 if (CL_PRESENT(CL_COLLAPSE)) {
1929 sem.collapse = CL_VAL(CL_COLLAPSE);
1930 }
1931 sem.expect_simd_do = TRUE;
1932 par_push_scope(TRUE);
1933 begin_parallel_clause(sem.doif_depth);
1934 apply_nodepchk(gbl.lineno, 1);
1935 SST_ASTP(LHS, 0);
1936
1937 break;
1938 /*
1939 * <mp stmt> ::= <mp endtargsimd> |
1940 */
1941 case MP_STMT71:
1942 end_parallel_clause(doif = sem.doif_depth);
1943 (void)leave_dir(DI_TARGET, TRUE, 0);
1944 sem.target--;
1945 par_pop_scope();
1946 if (doif) {
1947 ast = emit_etarget();
1948 mp_create_escope();
1949 A_LOPP(DI_BTARGET(doif), ast);
1950 A_LOPP(ast, DI_BTARGET(doif));
1951 }
1952 SST_ASTP(LHS, 0);
1953 break;
1954 /*
1955 * <mp stmt> ::= <targteams begin> <opt par list> |
1956 */
1957 case MP_STMT72:
1958 clause_errchk((BT_TARGET | BT_TEAMS), "OMP TARGET TEAMS");
1959 begin_combine_constructs((BT_TARGET | BT_TEAMS));
1960 SST_ASTP(LHS, 0);
1961 break;
1962 /*
1963 * <mp stmt> ::= <mp endtargteams> |
1964 */
1965 case MP_STMT73:
1966 end_targteams();
1967 SST_ASTP(LHS, 0);
1968 break;
1969 /*
1970 * <mp stmt> ::= <teamsdist begin> <opt par list> |
1971 */
1972 case MP_STMT74:
1973 SST_ASTP(LHS, 0);
1974 clause_errchk((BT_TEAMS | BT_DISTRIBUTE), "OMP TEAMS DISTRIBUTE");
1975 begin_combine_constructs((BT_TEAMS | BT_DISTRIBUTE));
1976 sem.expect_do = TRUE;
1977 break;
1978 /*
1979 * <mp stmt> ::= <mp endteamsdist> |
1980 */
1981 case MP_STMT75:
1982 doif = leave_dir(DI_TEAMSDIST, TRUE, 1);
1983 end_teams();
1984 SST_ASTP(LHS, 0);
1985 break;
1986 /*
1987 * <mp stmt> ::= <teamsdistsimd begin> <opt par list> |
1988 */
1989 case MP_STMT76:
1990 SST_ASTP(LHS, 0);
1991 clause_errchk((BT_TEAMS | BT_DISTRIBUTE | BT_SIMD),
1992 "OMP TEAMS DISTRIBUTE SIMD");
1993 begin_combine_constructs((BT_TEAMS | BT_DISTRIBUTE | BT_SIMD));
1994 sem.expect_do = TRUE;
1995 break;
1996 /*
1997 * <mp stmt> ::= <mp endteamsdistsimd> |
1998 */
1999 case MP_STMT77:
2000 doif = leave_dir(DI_TEAMSDIST, TRUE, 1);
2001 end_teams();
2002 SST_ASTP(LHS, 0);
2003 break;
2004 /*
2005 * <mp stmt> ::= <targteamsdist begin> <opt par list> |
2006 */
2007 case MP_STMT78:
2008 SST_ASTP(LHS, 0);
2009 clause_errchk((BT_TARGET | BT_TEAMS | BT_DISTRIBUTE),
2010 "OMP TARGET TEAMS DISTRIBUTE");
2011 begin_combine_constructs((BT_TARGET | BT_TEAMS | BT_DISTRIBUTE));
2012 sem.expect_do = TRUE;
2013 break;
2014 /*
2015 * <mp stmt> ::= <mp endtargteamsdist> |
2016 */
2017 case MP_STMT79:
2018 doif = leave_dir(DI_TARGTEAMSDIST, TRUE, 1);
2019 end_targteams();
2020 SST_ASTP(LHS, 0);
2021 break;
2022 /*
2023 * <mp stmt> ::= <targteamsdistsimd begin> <opt par list> |
2024 */
2025 case MP_STMT80:
2026 SST_ASTP(LHS, 0);
2027 clause_errchk((BT_TARGET | BT_TEAMS | BT_DISTRIBUTE | BT_SIMD),
2028 "OMP TARGET TEAMS DISTRIBUTE SIMD");
2029 begin_combine_constructs((BT_TARGET | BT_TEAMS | BT_DISTRIBUTE | BT_SIMD));
2030 sem.expect_do = TRUE;
2031 break;
2032 /*
2033 * <mp stmt> ::= <mp endtargteamsdistsimd> |
2034 */
2035 case MP_STMT81:
2036 doif = leave_dir(DI_TARGTEAMSDIST, TRUE, 1);
2037 end_targteams();
2038 SST_ASTP(LHS, 0);
2039 break;
2040 /*
2041 * <mp stmt> ::= <teamsdistpardo begin> <opt par list> |
2042 */
2043 case MP_STMT82:
2044 SST_ASTP(LHS, 0);
2045 clause_errchk((BT_TEAMS | BT_DISTRIBUTE | BT_PARDO),
2046 "OMP TEAMS DISTRIBUTE PARALLEL Do");
2047 begin_combine_constructs((BT_TEAMS | BT_DISTRIBUTE | BT_PARDO));
2048 break;
2049 /*
2050 * <mp stmt> ::= <mp endteamsdistpardo> |
2051 */
2052 case MP_STMT83:
2053 doif = leave_dir(DI_TEAMSDISTPARDO, TRUE, 1);
2054 end_teams();
2055 SST_ASTP(LHS, 0);
2056 break;
2057 /*
2058 * <mp stmt> ::= <targteamsdistpardo begin> <opt par list> |
2059 */
2060 case MP_STMT84:
2061 SST_ASTP(LHS, 0);
2062 clause_errchk((BT_TARGET | BT_TEAMS | BT_DISTRIBUTE | BT_PARDO),
2063 "OMP TARGET TEAMS DISTRIBUTE PARDO");
2064 begin_combine_constructs((BT_TARGET | BT_TEAMS | BT_DISTRIBUTE | BT_PARDO));
2065 break;
2066 /*
2067 * <mp stmt> ::= <mp endtargteamsdistpardo> |
2068 */
2069 case MP_STMT85:
2070 doif = leave_dir(DI_TARGTEAMSDISTPARDO, TRUE, 1);
2071 end_targteams();
2072 SST_ASTP(LHS, 0);
2073 break;
2074 /*
2075 * <mp stmt> ::= <teamsdistpardosimd begin> <opt par list> |
2076 */
2077 case MP_STMT86:
2078 SST_ASTP(LHS, 0);
2079 clause_errchk((BT_TEAMS | BT_DISTRIBUTE | BT_PARDO | BT_SIMD),
2080 "OMP TEAMS DISTRIBUTE PARALLEL DO SIMD");
2081 begin_combine_constructs((BT_TEAMS | BT_DISTRIBUTE | BT_PARDO | BT_SIMD));
2082 DI_ISSIMD(sem.doif_depth) = TRUE;
2083 break;
2084 /*
2085 * <mp stmt> ::= <mp endteamsdistpardosimd> |
2086 */
2087 case MP_STMT87:
2088 doif = leave_dir(DI_TEAMSDISTPARDO, TRUE, 1);
2089 end_teams();
2090 SST_ASTP(LHS, 0);
2091 break;
2092 /*
2093 * <mp stmt> ::= <targteamsdistpardosimd begin> <opt par list> |
2094 */
2095 case MP_STMT88:
2096 SST_ASTP(LHS, 0);
2097 clause_errchk((BT_TARGET | BT_TEAMS | BT_DISTRIBUTE | BT_PARDO | BT_SIMD),
2098 "OMP TARGET TEAMS DISTRIBUTE PARDO SIMD");
2099 begin_combine_constructs(
2100 (BT_TARGET | BT_TEAMS | BT_DISTRIBUTE | BT_PARDO | BT_SIMD));
2101 doif = SST_CVALG(RHS(1));
2102 DI_ISSIMD(doif) = TRUE;
2103 break;
2104 /*
2105 * <mp stmt> ::= <mp endtargteamsdistpardosimd> |
2106 */
2107 case MP_STMT89:
2108 doif = leave_dir(DI_TARGTEAMSDISTPARDO, TRUE, 1);
2109 end_targteams();
2110 SST_ASTP(LHS, 0);
2111 break;
2112 /*
2113 * <mp stmt> ::= <mp taskgroup> |
2114 */
2115 case MP_STMT90:
2116 ast = mk_stmt(A_MP_TASKGROUP, 0);
2117 SST_ASTP(LHS, ast);
2118 break;
2119 /*
2120 * <mp stmt> ::= <mp endtaskgroup> |
2121 */
2122 case MP_STMT91:
2123 ast = mk_stmt(A_MP_ETASKGROUP, 0);
2124 SST_ASTP(LHS, ast);
2125 break;
2126 /*
2127 * <mp stmt> ::= <mp cancellationpoint> <id name>
2128 */
2129 case MP_STMT92:
2130 ctype = cancel_type(scn.id.name + SST_CVALG(RHS(2)));
2131 d = check_cancel(ctype);
2132 if (d > 0) {
2133 ast = mk_stmt(A_MP_CANCELLATIONPOINT, 0);
2134 add_stmt(ast);
2135 A_LOPP(ast, d);
2136 if (A_ENDLABG(d)) {
2137 A_ENDLABP(ast, A_ENDLABG(d));
2138 } else {
2139 int lab = getlab();
2140 int astlab = mk_label(lab);
2141 A_ENDLABP(d, astlab);
2142 A_ENDLABP(ast, astlab);
2143 }
2144 A_CANCELKINDP(ast, ctype);
2145 }
2146 SST_ASTP(LHS, 0);
2147 break;
2148
2149 /* ------------------------------------------------------------------ */
2150 /*
2151 * <opt csident> ::= |
2152 */
2153 case OPT_CSIDENT1:
2154 SST_IDP(LHS, 0);
2155 break;
2156 /*
2157 * <opt csident> ::= ( <id name> )
2158 */
2159 case OPT_CSIDENT2:
2160 SST_IDP(LHS, 1);
2161 SST_SYMP(LHS, SST_SYMG(RHS(2)));
2162 break;
2163
2164 /* ------------------------------------------------------------------ */
2165 /*
2166 * <opt nowait> ::= |
2167 */
2168 case OPT_NOWAIT1:
2169 break;
2170 /*
2171 * <opt nowait> ::= <opt comma> <nowait>
2172 */
2173 case OPT_NOWAIT2:
2174 break;
2175
2176 /*
2177 * <nowait> ::= NOWAIT
2178 */
2179 case NOWAIT1:
2180 add_clause(CL_NOWAIT, TRUE);
2181 break;
2182
2183 /*
2184 * <opt endsingle list> ::= |
2185 */
2186 case OPT_ENDSINGLE_LIST1:
2187 break;
2188 /*
2189 * <opt endsingle list> ::= <opt comma> <endsingle list>
2190 */
2191 case OPT_ENDSINGLE_LIST2:
2192 break;
2193
2194 /* ------------------------------------------------------------------ */
2195 /*
2196 * <endsingle list> ::= <endsingle list> <opt comma> <endsingle item> |
2197 */
2198 case ENDSINGLE_LIST1:
2199 break;
2200 /*
2201 * <endsingle list> ::= <endsingle item>
2202 */
2203 case ENDSINGLE_LIST2:
2204 break;
2205
2206 /* ------------------------------------------------------------------ */
2207 /*
2208 * <endsingle item> ::= <nowait> |
2209 */
2210 case ENDSINGLE_ITEM1:
2211 break;
2212
2213 /*
2214 * <endsingle item> ::= COPYPRIVATE ( <tp list> )
2215 */
2216 case ENDSINGLE_ITEM2:
2217 add_clause(CL_COPYPRIVATE, FALSE);
2218 if (CL_FIRST(CL_COPYPRIVATE) == NULL)
2219 CL_FIRST(CL_COPYPRIVATE) = SST_BEGG(RHS(3));
2220 else
2221 ((ITEM *)CL_LAST(CL_COPYPRIVATE))->next = SST_BEGG(RHS(3));
2222 CL_LAST(CL_COPYPRIVATE) = SST_ENDG(RHS(3));
2223
2224 break;
2225
2226 /* ------------------------------------------------------------------ */
2227 /*
2228 * <par begin> ::= <mp parallel>
2229 */
2230 case PAR_BEGIN1:
2231 doif = enter_dir(DI_PAR, FALSE, 0, DI_B(DI_ATOMIC_CAPTURE));
2232 SST_CVALP(LHS, doif);
2233 break;
2234
2235 /* ------------------------------------------------------------------ */
2236 /*
2237 * <opt par list> ::= |
2238 */
2239 case OPT_PAR_LIST1:
2240 break;
2241 /*
2242 * <opt par list> ::= <opt comma> <par list>
2243 */
2244 case OPT_PAR_LIST2:
2245 break;
2246
2247 /* ------------------------------------------------------------------ */
2248 /*
2249 * <par list> ::= <par list> <opt comma> <par attr> |
2250 */
2251 case PAR_LIST1:
2252 break;
2253 /*
2254 * <par list> ::= <par attr>
2255 */
2256 case PAR_LIST2:
2257 break;
2258
2259 /* ------------------------------------------------------------------ */
2260 /*
2261 * <par attr> ::= DEFAULT ( <id name> ) |
2262 */
2263 case PAR_ATTR1:
2264 add_clause(CL_DEFAULT, TRUE);
2265 nmptr = scn.id.name + SST_SYMG(RHS(3));
2266 if (strcmp(nmptr, "none") == 0)
2267 CL_VAL(CL_DEFAULT) = PAR_SCOPE_NONE;
2268 else if (strcmp(nmptr, "private") == 0)
2269 CL_VAL(CL_DEFAULT) = PAR_SCOPE_PRIVATE;
2270 else if (strcmp(nmptr, "shared") == 0)
2271 CL_VAL(CL_DEFAULT) = PAR_SCOPE_SHARED;
2272 else if (strcmp(nmptr, "firstprivate") == 0)
2273 CL_VAL(CL_DEFAULT) = PAR_SCOPE_FIRSTPRIVATE;
2274 else {
2275 error(34, 3, gbl.lineno, nmptr, CNULL);
2276 CL_VAL(CL_DEFAULT) = PAR_SCOPE_SHARED;
2277 }
2278 break;
2279 /*
2280 * <par attr> ::= <private list> |
2281 */
2282 case PAR_ATTR2:
2283 break;
2284 /*
2285 * <par attr> ::= SHARED ( <pflsr list> ) |
2286 */
2287 case PAR_ATTR3:
2288 add_clause(CL_SHARED, FALSE);
2289 cray_pointer_check(SST_BEGG(RHS(3)), CL_SHARED);
2290 if (CL_FIRST(CL_SHARED) == NULL)
2291 CL_FIRST(CL_SHARED) = SST_BEGG(RHS(3));
2292 else
2293 ((ITEM *)CL_LAST(CL_SHARED))->next = SST_BEGG(RHS(3));
2294 CL_LAST(CL_SHARED) = SST_ENDG(RHS(3));
2295
2296 /* Check data sharing sanity */
2297 for (itemp = CL_FIRST(CL_SHARED); itemp != ITEM_END; itemp = itemp->next) {
2298 check_valid_data_sharing(itemp->t.sptr);
2299 }
2300 break;
2301 /*
2302 * <par attr> ::= <firstprivate> |
2303 */
2304 case PAR_ATTR4:
2305 break;
2306 /*
2307 * <par attr> ::= <lastprivate> |
2308 */
2309 case PAR_ATTR5:
2310 break;
2311 /*
2312 * <par attr> ::= <schedule> |
2313 */
2314 case PAR_ATTR6:
2315 break;
2316 /*
2317 * <par attr> ::= ORDERED <opt expression> |
2318 */
2319 case PAR_ATTR7:
2320 break;
2321 /*
2322 * <par attr> ::= REDUCTION ( <reduction> ) |
2323 */
2324 case PAR_ATTR8:
2325 break;
2326 /*
2327 * <par attr> ::= <par ifclause> |
2328 */
2329 case PAR_ATTR9:
2330 break;
2331 /*
2332 * <par attr> ::= COPYIN ( <cmn ident list> ) |
2333 */
2334 case PAR_ATTR10:
2335 add_clause(CL_COPYIN, FALSE);
2336 if (CL_FIRST(CL_COPYIN) == NULL)
2337 CL_FIRST(CL_COPYIN) = SST_BEGG(RHS(3));
2338 else
2339 ((ITEM *)CL_LAST(CL_COPYIN))->next = SST_BEGG(RHS(3));
2340 CL_LAST(CL_COPYIN) = SST_ENDG(RHS(3));
2341 break;
2342 /*
2343 * <par attr> ::= NUM_THREADS ( <expression> ) |
2344 */
2345 case PAR_ATTR11:
2346 add_clause(CL_NUM_THREADS, TRUE);
2347 chk_scalartyp(RHS((3)), DT_INT4, FALSE);
2348 CL_VAL(CL_NUM_THREADS) = SST_ASTG(RHS(3));
2349 break;
2350 /*
2351 * <par attr> ::= COLLAPSE ( <expression> ) |
2352 */
2353 case PAR_ATTR12:
2354 if (SST_IDG(RHS(3)) == S_CONST) {
2355 add_clause(CL_COLLAPSE, TRUE);
2356 CL_VAL(CL_COLLAPSE) = chkcon_to_isz(RHS(3), TRUE);
2357 if (CL_VAL(CL_COLLAPSE) < 0) {
2358 CL_VAL(CL_COLLAPSE) = 0;
2359 error(155, 3, gbl.lineno,
2360 "The COLLAPSE expression must be a positive integer constant",
2361 CNULL);
2362 }
2363 } else {
2364 CL_VAL(CL_COLLAPSE) = 0;
2365 error(155, 3, gbl.lineno,
2366 "The COLLAPSE expression must be a positive integer constant",
2367 CNULL);
2368 }
2369 break;
2370 /*
2371 * <par attr> ::= UNTIED |
2372 */
2373 case PAR_ATTR13:
2374 add_clause(CL_UNTIED, TRUE);
2375 break;
2376
2377 /*
2378 * <par attr> ::= FINAL
2379 */
2380 case PAR_ATTR14:
2381 add_clause(CL_FINAL, TRUE);
2382 chk_scalartyp(RHS((3)), DT_LOG4, FALSE);
2383 CL_VAL(CL_FINAL) = SST_ASTG(RHS(3));
2384 break;
2385
2386 /*
2387 * <par attr> ::= MERGEABLE |
2388 */
2389 case PAR_ATTR15:
2390 add_clause(CL_MERGEABLE, TRUE);
2391 break;
2392 /*
2393 * <par attr> ::= PROC_BIND ( <id name> ) |
2394 */
2395 case PAR_ATTR16:
2396 bind_type = get_mp_bind_type(scn.id.name + SST_CVALG(RHS(3)));
2397 if (bind_type) {
2398 add_clause(CL_PROC_BIND, TRUE);
2399 CL_VAL(CL_PROC_BIND) = bind_type;
2400 }
2401 break;
2402 /*
2403 * <par attr> ::= SAFELEN ( <expression> ) |
2404 */
2405 case PAR_ATTR17:
2406 error(547, ERR_Warning, gbl.lineno, "SAFELEN", CNULL);
2407 break;
2408 /*
2409 * <par attr> ::= <linear clause> |
2410 */
2411 case PAR_ATTR18:
2412 error(547, ERR_Warning, gbl.lineno, "LINEAR", CNULL);
2413 break;
2414 /*
2415 * <par attr> ::= <aligned clause> |
2416 */
2417 case PAR_ATTR19:
2418 error(547, ERR_Warning, gbl.lineno, "ALIGNED", CNULL);
2419 break;
2420 /*
2421 * <par attr> ::= SIMDLEN ( <expression> ) |
2422 */
2423 case PAR_ATTR20:
2424 error(547, ERR_Warning, gbl.lineno, "SIMDLEN", CNULL);
2425 break;
2426 /*
2427 * <par attr> ::= <uniform clause> |
2428 */
2429 case PAR_ATTR21:
2430 error(547, ERR_Warning, gbl.lineno, "UNIFORM", CNULL);
2431 break;
2432 /*
2433 * <par attr> ::= INBRANCH |
2434 */
2435 case PAR_ATTR22:
2436 error(547, ERR_Warning, gbl.lineno, "INBRANCH", CNULL);
2437 break;
2438 /*
2439 * <par attr> ::= NOTINBRANCH |
2440 */
2441 case PAR_ATTR23:
2442 error(547, ERR_Warning, gbl.lineno, "NOINBRANCH", CNULL);
2443 break;
2444 /*
2445 * <par attr> ::= LINK ( <ident list> ) |
2446 */
2447 case PAR_ATTR24:
2448 error(547, ERR_Warning, gbl.lineno, "LINK", CNULL);
2449 break;
2450 /*
2451 * <par attr> ::= DEVICE ( <expression> ) |
2452 */
2453 case PAR_ATTR25:
2454 error(547, ERR_Warning, gbl.lineno, "DEVICE", CNULL);
2455 break;
2456 /*
2457 * <par attr> ::= <map clause> |
2458 */
2459 case PAR_ATTR26:
2460 break;
2461 /*
2462 * <par attr> ::= <depend clause> |
2463 */
2464 case PAR_ATTR27:
2465 error(547, ERR_Warning, gbl.lineno, "DEPEND", CNULL);
2466 break;
2467 /*
2468 * <par attr> ::= IS_DEVICE_PTR ( <ident list> ) |
2469 */
2470 case PAR_ATTR28:
2471 error(547, ERR_Warning, gbl.lineno, "IS_DEVICE_PTR", CNULL);
2472 break;
2473 /*
2474 * <par attr> ::= DEFAULTMAP ( <id name> : <id name> ) |
2475 */
2476 case PAR_ATTR29:
2477 error(547, ERR_Warning, gbl.lineno, "DEFAULTMAP", CNULL);
2478 break;
2479 /*
2480 * <par attr> ::= <motion clause> |
2481 */
2482 case PAR_ATTR30:
2483 break;
2484 /*
2485 * <par attr> ::= DIST_SCHEDULE ( <id name> <opt distchunk> ) |
2486 */
2487 case PAR_ATTR31:
2488 if (sched_type(scn.id.name + SST_CVALG(RHS(3))) != DI_SCH_STATIC) {
2489 error(155, 3, gbl.lineno,
2490 "Static scheduling is expected in dist_schedule", NULL);
2491 }
2492 add_clause(CL_DIST_SCHEDULE, TRUE);
2493 break;
2494 /*
2495 * <par attr> ::= GRAINSIZE ( <expression> ) |
2496 */
2497 case PAR_ATTR32:
2498 if (CL_PRESENT(CL_NUM_TASKS)) {
2499 error(155, 3, gbl.lineno,
2500 "Grainsize and num_tasks cannot be present in same taskloop", NULL);
2501 break;
2502 } else if (CL_PRESENT(CL_GRAINSIZE)) {
2503 error(155, 3, gbl.lineno,
2504 "At most one grainsize can be present in taskloop", NULL);
2505 break;
2506 }
2507 add_clause(CL_GRAINSIZE, TRUE);
2508 chk_scalartyp(RHS((3)), DT_INT4, FALSE);
2509 CL_VAL(CL_GRAINSIZE) = SST_ASTG(RHS(3));
2510 break;
2511 /*
2512 * <par attr> ::= NUM_TASKS ( <expression> ) |
2513 */
2514 case PAR_ATTR33:
2515 if (CL_PRESENT(CL_NUM_TASKS)) {
2516 error(155, 3, gbl.lineno,
2517 "At most one grainsize can be present in taskloop", NULL);
2518 break;
2519 } else if (CL_PRESENT(CL_GRAINSIZE)) {
2520 error(155, 3, gbl.lineno,
2521 "Grainsize and num_tasks cannot be present in same taskloop", NULL);
2522 break;
2523 }
2524 add_clause(CL_NUM_TASKS, TRUE);
2525 chk_scalartyp(RHS((3)), DT_INT4, FALSE);
2526 CL_VAL(CL_NUM_TASKS) = SST_ASTG(RHS(3));
2527 break;
2528 /*
2529 * <par attr> ::= PRIORITY ( <expression> ) |
2530 */
2531 case PAR_ATTR34:
2532 if (CL_PRESENT(CL_PRIORITY)) {
2533 error(155, 3, gbl.lineno,
2534 "At most one priority can be present in taskloop", NULL);
2535 }
2536 add_clause(CL_PRIORITY, TRUE);
2537 chk_scalartyp(RHS((3)), DT_INT4, FALSE);
2538 CL_VAL(CL_PRIORITY) = SST_ASTG(RHS(3));
2539 break;
2540 /*
2541 * <par attr> ::= NUM_TEAMS ( <expression> ) |
2542 */
2543 case PAR_ATTR35:
2544 add_clause(CL_NUM_TEAMS, TRUE);
2545 chk_scalartyp(RHS((3)), DT_INT4, FALSE);
2546 CL_VAL(CL_NUM_TEAMS) = SST_ASTG(RHS(3));
2547 break;
2548 /*
2549 * <par attr> ::= THREAD_LIMIT( <expression> ) |
2550 */
2551 case PAR_ATTR36:
2552 add_clause(CL_THREAD_LIMIT, TRUE);
2553 chk_scalartyp(RHS((3)), DT_INT4, FALSE);
2554 CL_VAL(CL_THREAD_LIMIT) = SST_ASTG(RHS(3));
2555 break;
2556 /*
2557 * <par attr> ::= NOGROUP
2558 */
2559 case PAR_ATTR37:
2560 add_clause(CL_NOGROUP, TRUE);
2561 break;
2562 /* ------------------------------------------------------------------ */
2563 /*
2564 * <opt expression> ::= |
2565 */
2566 case OPT_EXPRESSION1:
2567 add_clause(CL_ORDERED, TRUE);
2568 break;
2569 /*
2570 * <opt expression> ::= ( <expression> )
2571 */
2572 case OPT_EXPRESSION2:
2573 add_clause(CL_ORDERED, TRUE);
2574 error(547, ERR_Warning, gbl.lineno, "ORDERED(n)", CNULL);
2575 break;
2576 /* ------------------------------------------------------------------ */
2577 /*
2578 * <opt ordered list> ::= |
2579 */
2580 case OPT_ORDERED_LIST1:
2581 break;
2582 /*
2583 * <opt ordered list> ::= <ordered list>
2584 */
2585 case OPT_ORDERED_LIST2:
2586 break;
2587 /* ------------------------------------------------------------------ */
2588 /*
2589 * <ordered list> ::= <ordered list> <opt comma> <ordered attr> |
2590 */
2591 case ORDERED_LIST1:
2592 break;
2593 /*
2594 * <ordered list> ::= <ordered attr>
2595 */
2596 case ORDERED_LIST2:
2597 break;
2598
2599 /* ------------------------------------------------------------------ */
2600 /*
2601 * <ordered attr> ::= SIMD |
2602 */
2603 case ORDERED_ATTR1:
2604 error(547, ERR_Warning, gbl.lineno, "SIMD", CNULL);
2605 break;
2606 /*
2607 * <ordered attr> ::= THREADS |
2608 */
2609 case ORDERED_ATTR2:
2610 error(547, ERR_Warning, gbl.lineno, "THREAD", CNULL);
2611 break;
2612 /*
2613 * <ordered attr> ::= DEPEND <depend attr>
2614 */
2615 case ORDERED_ATTR3:
2616 error(547, ERR_Warning, gbl.lineno, "DEPEND", CNULL);
2617 break;
2618
2619 /* ------------------------------------------------------------------ */
2620 /*
2621 * <pflsr list> ::= <pflsr list> , <cmn ident> |
2622 */
2623 case PFLSR_LIST1:
2624 rhstop = 3;
2625 goto add_pflsr_to_list;
2626 /*
2627 * <pflsr list> ::= <cmn ident>
2628 */
2629 case PFLSR_LIST2:
2630 rhstop = 1;
2631 add_pflsr_to_list:
2632 sptr = SST_SYMG(RHS(rhstop));
2633 if (STYPEG(sptr) != ST_CMBLK) {
2634 sptr = find_outer_sym(sptr);
2635 if (SCG(sptr) == SC_CMBLK && THREADG(CMBLKG(sptr)))
2636 error(155, 3, gbl.lineno,
2637 "A THREADPRIVATE common block member may "
2638 "only appear in the COPYIN clause -",
2639 SYMNAME(sptr));
2640 itemp = (ITEM *)getitem(0, sizeof(ITEM));
2641 itemp->next = ITEM_END;
2642 itemp->t.sptr = sptr;
2643 if (rhstop == 1)
2644 /* adding first item to list */
2645 SST_BEGP(LHS, itemp);
2646 else
2647 /* adding subsequent items to list */
2648 (SST_ENDG(RHS(1)))->next = itemp;
2649 SST_ENDP(LHS, itemp);
2650 if (SCG(sptr) == SC_PRIVATE)
2651 any_pflsr_private = TRUE;
2652 } else {
2653 ITEM *fitemp, *litemp;
2654 if (THREADG(sptr))
2655 error(155, 3, gbl.lineno,
2656 "A THREADPRIVATE common block may only "
2657 "appear in the COPYIN clause -",
2658 SYMNAME(sptr));
2659 fitemp = NULL;
2660 /*
2661 * Add all of the common block members to the 'item' list.
2662 * TBD - need to add any variables which are equivalenced
2663 * to the members!!!
2664 */
2665 for (sptr1 = CMEMFG(sptr); sptr1 > NOSYM; sptr1 = SYMLKG(sptr1)) {
2666 itemp = (ITEM *)getitem(0, sizeof(ITEM));
2667 itemp->next = ITEM_END;
2668 itemp->t.sptr = find_outer_sym(sptr1);
2669 if (fitemp == NULL)
2670 fitemp = itemp;
2671 else
2672 litemp->next = itemp;
2673 litemp = itemp;
2674 }
2675 if (fitemp == NULL) {
2676 /* The common block is empty (error was reported by <cmn ident>.
2677 * If this is the first in the list, need to recover by creating
2678 * a symbol.
2679 */
2680 if (rhstop != 1)
2681 break;
2682 itemp = (ITEM *)getitem(0, sizeof(ITEM));
2683 itemp->next = ITEM_END;
2684 itemp->t.sptr = find_outer_sym(ref_ident(sptr));
2685 fitemp = itemp;
2686 litemp = itemp;
2687 }
2688 if (rhstop == 1)
2689 /* adding first item to list */
2690 SST_BEGP(LHS, fitemp);
2691 else
2692 /* adding subsequent items to list */
2693 (SST_ENDG(RHS(1)))->next = fitemp;
2694 SST_ENDP(LHS, litemp);
2695 }
2696 break;
2697
2698 /* ------------------------------------------------------------------ */
2699 /*
2700 * <private list> ::= PRIVATE ( <pflsr list> )
2701 */
2702 case PRIVATE_LIST1:
2703 clause = CL_PRIVATE;
2704 goto prepare_private_shared;
2705
2706 /* ------------------------------------------------------------------ */
2707 /*
2708 * <firstprivate> ::= FIRSTPRIVATE ( <pflsr list> )
2709 */
2710 case FIRSTPRIVATE1:
2711 clause = CL_FIRSTPRIVATE;
2712 other_firstlast_check(SST_BEGG(RHS(3)), clause);
2713 prepare_private_shared:
2714 add_clause(clause, FALSE);
2715 cray_pointer_check(SST_BEGG(RHS(3)), clause);
2716 if (CL_FIRST(clause) == NULL)
2717 CL_FIRST(clause) = SST_BEGG(RHS(3));
2718 else
2719 ((ITEM *)CL_LAST(clause))->next = SST_BEGG(RHS(3));
2720 CL_LAST(clause) = SST_ENDG(RHS(3));
2721
2722 /* Check data sharing sanity */
2723 for (itemp = SST_BEGG(RHS(3)); itemp != ITEM_END; itemp = itemp->next) {
2724 check_valid_data_sharing(itemp->t.sptr);
2725 }
2726 break;
2727
2728 /* ------------------------------------------------------------------ */
2729 /*
2730 * <lastprivate> ::= LASTPRIVATE ( <pflsr list> )
2731 */
2732 case LASTPRIVATE1:
2733 add_clause(CL_LASTPRIVATE, FALSE);
2734 other_firstlast_check(SST_BEGG(RHS(3)), CL_LASTPRIVATE);
2735 cray_pointer_check(SST_BEGG(RHS(3)), CL_LASTPRIVATE);
2736 /*
2737 * create a fake REDUC_SYM item (from area 0 freed during the end of
2738 * statement processing.
2739 */
2740 reduc_symp = reduc_symp_last = (REDUC_SYM *)getitem(0, sizeof(REDUC_SYM));
2741 for (itemp = SST_BEGG(RHS(3)); itemp != ITEM_END; itemp = itemp->next) {
2742 REDUC_SYM *rsp;
2743 /*
2744 * Need to keep the REDUC_SYM items around until the end of the
2745 * parallel do, so allocate them in area 1.
2746 */
2747 rsp = (REDUC_SYM *)getitem(1, sizeof(REDUC_SYM));
2748 rsp->Private = 0;
2749 rsp->shared = itemp->t.sptr;
2750 rsp->next = NULL;
2751 reduc_symp_last->next = rsp;
2752 reduc_symp_last = rsp;
2753 }
2754 /* skip past the fake REDUC_SYM item */
2755 reduc_symp = reduc_symp->next;
2756 if (CL_FIRST(CL_LASTPRIVATE) == NULL)
2757 CL_FIRST(CL_LASTPRIVATE) = reduc_symp;
2758 else
2759 ((REDUC_SYM *)CL_LAST(CL_LASTPRIVATE))->next = reduc_symp;
2760 CL_LAST(CL_LASTPRIVATE) = reduc_symp;
2761
2762 /* Check data sharing sanity */
2763 for (itemp = SST_BEGG(RHS(3)); itemp != ITEM_END; itemp = itemp->next) {
2764 check_valid_data_sharing(itemp->t.sptr);
2765 }
2766 break;
2767
2768 /* ------------------------------------------------------------------ */
2769 /*
2770 * <schedule> ::= SCHEDULE <sched type> |
2771 */
2772 case SCHEDULE1:
2773 add_clause(CL_SCHEDULE, TRUE);
2774 CL_VAL(CL_SCHEDULE) = SST_IDG(RHS(2));
2775 break;
2776 /*
2777 * <schedule> ::= MP_SCHEDTYPE = <id name> |
2778 */
2779 case SCHEDULE2:
2780 add_clause(CL_MP_SCHEDTYPE, TRUE);
2781 CL_VAL(CL_SCHEDULE) = sched_type(scn.id.name + SST_CVALG(RHS(3)));
2782 break;
2783 /*
2784 * <schedule> ::= CHUNK = <expression>
2785 */
2786 case SCHEDULE3:
2787 add_clause(CL_CHUNK, TRUE);
2788 chk_scalartyp(RHS(3), DT_INT, FALSE);
2789 chunk = SST_ASTG(RHS(3));
2790 break;
2791
2792 /* ------------------------------------------------------------------ */
2793 /*
2794 * <sched type> ::= |
2795 */
2796 case SCHED_TYPE1:
2797 SST_IDP(LHS, DI_SCH_STATIC);
2798 break;
2799 /*
2800 * <sched type> ::= ( <id name> <opt chunk> )
2801 */
2802 case SCHED_TYPE2:
2803 SST_IDP(LHS, sched_type(scn.id.name + SST_CVALG(RHS(2))));
2804 break;
2805
2806 /* ------------------------------------------------------------------ */
2807 /*
2808 * <opt chunk> ::= |
2809 */
2810 case OPT_CHUNK1:
2811 break;
2812 /*
2813 * <opt chunk> ::= , <expression>
2814 */
2815 case OPT_CHUNK2:
2816 chk_scalartyp(RHS(2), DT_INT, FALSE);
2817 chunk = SST_ASTG(RHS(2));
2818 break;
2819
2820 /* ------------------------------------------------------------------ */
2821 /*
2822 * <opt distchunk> ::= |
2823 */
2824 case OPT_DISTCHUNK1:
2825 break;
2826 /*
2827 * <opt distchunk> ::= , <expression>
2828 */
2829 case OPT_DISTCHUNK2:
2830 chk_scalartyp(RHS(2), DT_INT, FALSE);
2831 distchunk = SST_ASTG(RHS(2));
2832 break;
2833
2834 /* ------------------------------------------------------------------ */
2835 /*
2836 * <reduction> ::= <reduc op> : <pflsr list> |
2837 */
2838 case REDUCTION1:
2839 if (SST_IDG(RHS(1)) == 1 && SST_SYMG(RHS(1)) == 0)
2840 /* error occurred, so just ignore it */
2841 break;
2842 add_clause(CL_REDUCTION, FALSE);
2843 /*
2844 * Need to keep the REDUC items around until the end of the
2845 * parallel do, so allocate them in area 1.
2846 */
2847 reducp = (REDUC *)getitem(1, sizeof(REDUC));
2848 reducp->next = NULL;
2849 if (SST_IDG(RHS(1)) == 0) {
2850 reducp->opr = SST_OPTYPEG(RHS(1));
2851 if (reducp->opr == OP_LOG)
2852 reducp->intrin = SST_OPCG(RHS(1));
2853 } else {
2854 reducp->opr = 0;
2855 reducp->intrin = SST_SYMG(RHS(1));
2856 }
2857 rhstop = 3;
2858 goto reduction_shared;
2859 /*
2860 * <reduction> ::= <pflsr list>
2861 */
2862 case REDUCTION2:
2863 add_clause(CL_REDUCTION, FALSE);
2864 /*
2865 * Need to keep the REDUC items around until the end of the
2866 * parallel do, so allocate them in area 1.
2867 */
2868 reducp = (REDUC *)getitem(1, sizeof(REDUC));
2869 reducp->next = NULL;
2870 reducp->opr = OP_ADD;
2871 rhstop = 1;
2872 reduction_shared:
2873 if (CL_FIRST(CL_REDUCTION) == NULL)
2874 CL_FIRST(CL_REDUCTION) = reducp;
2875 else
2876 ((REDUC *)CL_LAST(CL_REDUCTION))->next = reducp;
2877 CL_LAST(CL_REDUCTION) = reducp;
2878 /*
2879 * create a fake REDUC_SYM item (from area 0 freed during the end of
2880 * statement processing.
2881 */
2882 reducp->list = reduc_symp_last = (REDUC_SYM *)getitem(0, sizeof(REDUC_SYM));
2883 reducp->list->next = NULL;
2884 for (itemp = SST_BEGG(RHS(rhstop)); itemp != ITEM_END;
2885 itemp = itemp->next) {
2886 /*
2887 * Need to keep the REDUC_SYM items around until the end of the
2888 * parallel do, so allocate them in area 1.
2889 */
2890 reduc_symp = (REDUC_SYM *)getitem(1, sizeof(REDUC_SYM));
2891 reduc_symp->Private = 0;
2892 reduc_symp->shared = itemp->t.sptr;
2893 reduc_symp->next = NULL;
2894 for (reduc_symp_curr = reducp->list->next; reduc_symp_curr;
2895 reduc_symp_curr = reduc_symp_curr->next) {
2896 if (reduc_symp_curr->shared == reduc_symp->shared) {
2897 error(155, 2, gbl.lineno, "Duplicate name in reduction clause -",
2898 SYMNAME(reduc_symp->shared));
2899 break;
2900 }
2901 }
2902
2903 reduc_symp_last->next = reduc_symp;
2904 reduc_symp_last = reduc_symp;
2905 if (STYPEG(reduc_symp->shared) != ST_VAR &&
2906 STYPEG(reduc_symp->shared) != ST_ARRAY) {
2907 error(155, 3, gbl.lineno,
2908 "Reduction variable must be a scalar or array variable -",
2909 SYMNAME(reduc_symp->shared));
2910 /*
2911 * pass up 0 so that do_reduction() & end_reduction()
2912 * will ignore this item.
2913 */
2914 reduc_symp->shared = 0;
2915 } else {
2916 dtype = DTYPEG(reduc_symp->shared);
2917 dtype = DDTG(dtype);
2918 if (!DT_ISBASIC(dtype)) {
2919 error(155, 3, gbl.lineno,
2920 "Reduction variable must be of intrinsic type -",
2921 SYMNAME(reduc_symp->shared));
2922 reduc_symp->shared = 0;
2923 }
2924 }
2925 }
2926 /* skip past the fake REDUC_SYM item */
2927 reducp->list = reducp->list->next;
2928 break;
2929
2930 /* ------------------------------------------------------------------ */
2931 /*
2932 * <reduc op> ::= <addop> |
2933 */
2934 case REDUC_OP1:
2935 SST_IDP(LHS, 0);
2936 break;
2937 /*
2938 * <reduc op> ::= * |
2939 */
2940 case REDUC_OP2:
2941 SST_IDP(LHS, 0);
2942 SST_OPTYPEP(LHS, OP_MUL);
2943 break;
2944 /*
2945 * <reduc op> ::= .AND. |
2946 */
2947 case REDUC_OP3:
2948 opc = OP_LAND;
2949 goto reduc_logop;
2950 /*
2951 * <reduc op> ::= .OR. |
2952 */
2953 case REDUC_OP4:
2954 opc = OP_LOR;
2955 goto reduc_logop;
2956 /*
2957 * <reduc op> ::= .EQV. |
2958 */
2959 case REDUC_OP5:
2960 opc = OP_LEQV;
2961 goto reduc_logop;
2962 /*
2963 * <reduc op> ::= .NEQV. |
2964 */
2965 case REDUC_OP6:
2966 opc = OP_LNEQV;
2967 reduc_logop:
2968 SST_IDP(LHS, 0);
2969 SST_OPTYPEP(LHS, OP_LOG);
2970 SST_OPCP(LHS, opc);
2971 break;
2972 /*
2973 * <reduc op> ::= <ident>
2974 */
2975 case REDUC_OP7:
2976 sptr = find_reduc_intrinsic(SST_SYMG(RHS(1)));
2977 SST_SYMP(LHS, sptr);
2978 SST_IDP(LHS, 1);
2979 break;
2980 /* ------------------------------------------------------------------ */
2981 /*
2982 * <par ifclause> ::= IF ( <expression> ) |
2983 */
2984 case PAR_IFCLAUSE1:
2985 rhstop = 3;
2986 if (CL_PRESENT(CL_IF)) {
2987 if (mp_iftype != IF_DEFAULT)
2988 error(155, ERR_Severe, gbl.lineno,
2989 "All IF must have directive-name-modifier", NULL);
2990 }
2991 goto share_if_expr;
2992 break;
2993 /*
2994 * <par ifclause> ::= IF ( <id name> : <expression> ) |
2995 */
2996 case PAR_IFCLAUSE2:
2997 set_iftype(1, scn.id.name + SST_CVALG(RHS(3)), NULL, NULL);
2998 rhstop = 5;
2999 goto share_if_expr;
3000 break;
3001 /*
3002 * <par ifclause> ::= IF ( <id name> <id name> : <expression> ) |
3003 */
3004 case PAR_IFCLAUSE3:
3005 set_iftype(2, scn.id.name + SST_CVALG(RHS(3)),
3006 scn.id.name + SST_CVALG(RHS(4)), NULL);
3007 rhstop = 6;
3008 goto share_if_expr;
3009 break;
3010 /*
3011 * <par ifclause> ::= IF ( <id name> <id name> <id name> : <expression> )
3012 */
3013 case PAR_IFCLAUSE4:
3014 set_iftype(3, scn.id.name + SST_CVALG(RHS(3)),
3015 scn.id.name + SST_CVALG(RHS(4)),
3016 scn.id.name + SST_CVALG(RHS(5)));
3017 rhstop = 7;
3018 goto share_if_expr;
3019 break;
3020
3021 share_if_expr:
3022 add_clause(CL_IF, TRUE);
3023 chk_scalartyp(RHS((rhstop)), DT_LOG4, FALSE);
3024 CL_VAL(CL_IF) = SST_ASTG(RHS(rhstop));
3025 break;
3026 /* ------------------------------------------------------------------ */
3027 /*
3028 * <opt par ifclause> ::= |
3029 */
3030 case OPT_PAR_IFCLAUSE1:
3031 break;
3032 /*
3033 * <opt par ifclause> ::= , <par ifclause>
3034 */
3035 case OPT_PAR_IFCLAUSE2:
3036 break;
3037
3038 /* ------------------------------------------------------------------ */
3039 /*
3040 * <linear clause> ::= LINEAR ( <linear expr> )
3041 */
3042 case LINEAR_CLAUSE1:
3043 error(547, ERR_Warning, gbl.lineno, "LINEAR", CNULL);
3044 break;
3045
3046 /* ------------------------------------------------------------------ */
3047 /*
3048 * <linear expr> ::= <linear modifier> <linear opt step>
3049 */
3050 case LINEAR_EXPR1:
3051 break;
3052
3053 /* ------------------------------------------------------------------ */
3054 /*
3055 * <linear modifier> ::= <pflsr list> |
3056 */
3057 case LINEAR_MODIFIER1:
3058 break;
3059 /*
3060 * <linear modifier> ::= <id name> ( <pflsr list> )
3061 */
3062 case LINEAR_MODIFIER2:
3063 break;
3064
3065 /* ------------------------------------------------------------------ */
3066 /*
3067 * <linear opt step> ::= |
3068 */
3069 case LINEAR_OPT_STEP1:
3070 break;
3071 /*
3072 * <linear opt step> ::= : <expression>
3073 */
3074 case LINEAR_OPT_STEP2:
3075 break;
3076
3077 /* ------------------------------------------------------------------ */
3078 /*
3079 * <aligned clause> ::= ALIGNED ( <aligned> )
3080 */
3081 case ALIGNED_CLAUSE1:
3082 error(547, ERR_Warning, gbl.lineno, "ALIGNED", CNULL);
3083 break;
3084
3085 /* ------------------------------------------------------------------ */
3086 /*
3087 * <aligned> ::= <pflsr list> |
3088 */
3089 case ALIGNED1:
3090 break;
3091 /*
3092 * <aligned> ::= <pflsr list> : <expression>
3093 */
3094 case ALIGNED2:
3095 break;
3096
3097 /* ------------------------------------------------------------------ */
3098 /*
3099 * <uniform clause> ::= UNIFORM ( <pflsr list> )
3100 */
3101 case UNIFORM_CLAUSE1:
3102 error(547, ERR_Warning, gbl.lineno, "UNIFORM", CNULL);
3103 break;
3104
3105 /* ------------------------------------------------------------------ */
3106 /*
3107 * <map clause> ::= MAP ( <map item> )
3108 */
3109 case MAP_CLAUSE1:
3110 break;
3111
3112 /* ------------------------------------------------------------------ */
3113 /*
3114 * <map item> ::= <accel data list> |
3115 */
3116 case MAP_ITEM1:
3117 #if defined(OMP_OFFLOAD_LLVM) || defined(OMP_OFFLOAD_PGI)
3118 if (flg.omptarget) {
3119 mp_handle_map_clause(top, CL_MAP, "tofrom", 1, DI_ID(sem.doif_depth),
3120 isalways);
3121 }
3122 #endif
3123 break;
3124 /*
3125 * <map item> ::= <map type> : <accel data list>
3126 */
3127 case MAP_ITEM2:
3128 #if defined(OMP_OFFLOAD_LLVM) || defined(OMP_OFFLOAD_PGI)
3129 if (flg.omptarget) {
3130 if (strlen(map_type) == 0)
3131 error(1205, ERR_Severe, gbl.lineno, scn.id.name + SST_CVALG(RHS(1)), 0);
3132
3133 nmptr = SYMNAME(SST_SYMG(RHS(1)));
3134 mp_handle_map_clause(top, CL_MAP, map_type, 3, DI_ID(sem.doif_depth),
3135 isalways);
3136 }
3137 #endif
3138 break;
3139
3140 /* ------------------------------------------------------------------ */
3141 /*
3142 * <map type> ::= <id name> |
3143 */
3144 case MAP_TYPE1:
3145 #if defined(OMP_OFFLOAD_LLVM) || defined(OMP_OFFLOAD_PGI)
3146 if (flg.omptarget) {
3147 mp_check_maptype(scn.id.name + SST_CVALG(RHS(1)));
3148 map_type = scn.id.name + SST_CVALG(RHS(1));
3149 }
3150 #endif
3151 break;
3152 /*
3153 * <map type> ::= ALWAYS <opt comma> <id name>
3154 */
3155 case MAP_TYPE2:
3156 #if defined(OMP_OFFLOAD_LLVM) || defined(OMP_OFFLOAD_PGI)
3157 if (flg.omptarget) {
3158 mp_check_maptype(scn.id.name + SST_CVALG(RHS(1)));
3159 map_type = scn.id.name + SST_CVALG(RHS(1));
3160 isalways = true;
3161 break;
3162 }
3163 #endif
3164 break;
3165
3166 /* ------------------------------------------------------------------ */
3167 /*
3168 * <depend clause> ::= DEPEND ( <depend attr> )
3169 */
3170 case DEPEND_CLAUSE1:
3171 break;
3172
3173 /* ------------------------------------------------------------------ */
3174 /*
3175 * <depend attr> ::= <id name> |
3176 */
3177 case DEPEND_ATTR1:
3178 /* expect SOURCE keyword */
3179 break;
3180 /*
3181 * <depend attr> ::= <id name> : <depend data list>
3182 */
3183 case DEPEND_ATTR2:
3184 /* expect sink or in/out/inout here in id name */
3185 break;
3186
3187 /* ------------------------------------------------------------------ */
3188 /*
3189 * <motion clause> ::= TO ( <var ref list> ) |
3190 */
3191 case MOTION_CLAUSE1:
3192 break;
3193 /*
3194 * <motion clause> ::= FROM ( <var ref list> )
3195 */
3196 case MOTION_CLAUSE2:
3197 break;
3198
3199 /* ------------------------------------------------------------------ */
3200 /*
3201 * <depend data list> ::= <var ref list> |
3202 */
3203 case DEPEND_DATA_LIST1:
3204 break;
3205 /*
3206 * <depend data list> ::= <depend data>
3207 */
3208 case DEPEND_DATA_LIST2:
3209 break;
3210
3211 /* ------------------------------------------------------------------ */
3212 /*
3213 * <depend data> ::= <ident> <addop> <constant>
3214 */
3215 case DEPEND_DATA1:
3216 break;
3217
3218 /* ------------------------------------------------------------------ */
3219 /*
3220 * <single begin> ::= <mp single>
3221 */
3222 case SINGLE_BEGIN1:
3223 parstuff_init();
3224 doif =
3225 enter_dir(DI_SINGLE, TRUE, 2,
3226 DI_B(DI_PDO) | DI_B(DI_PARDO) | DI_B(DI_DOACROSS) |
3227 DI_B(DI_PARSECTS) | DI_B(DI_SECTS) | DI_B(DI_SINGLE) |
3228 DI_B(DI_CRITICAL) | DI_B(DI_MASTER) | DI_B(DI_ORDERED) |
3229 DI_B(DI_TASK) | DI_B(DI_ATOMIC_CAPTURE) |
3230 DI_B((DI_PDO | DI_SIMD)) | DI_B((DI_PARDO | DI_SIMD)));
3231 SST_CVALP(LHS, doif);
3232 break;
3233
3234 /* ------------------------------------------------------------------ */
3235 /*
3236 * <pdo begin> ::= <mp pdo>
3237 */
3238 case PDO_BEGIN1:
3239 parstuff_init();
3240 doif =
3241 enter_dir(DI_PDO, FALSE, 0,
3242 DI_B(DI_PDO) | DI_B(DI_PARDO) | DI_B(DI_DOACROSS) |
3243 DI_B(DI_PARSECTS) | DI_B(DI_SECTS) | DI_B(DI_SINGLE) |
3244 DI_B(DI_CRITICAL) | DI_B(DI_MASTER) | DI_B(DI_ORDERED) |
3245 DI_B(DI_TASK) | DI_B(DI_ATOMIC_CAPTURE) |
3246 DI_B((DI_PDO | DI_SIMD)) | DI_B((DI_PARDO | DI_SIMD)));
3247 SST_CVALP(LHS, sem.doif_depth); /* always pass up do's DOIF index */
3248 break;
3249
3250 /* ------------------------------------------------------------------ */
3251 /*
3252 * <mp atomic begin> ::= <mp atomic>
3253 */
3254 case MP_ATOMIC_BEGIN1:
3255 sem.mpaccatomic.is_acc = FALSE;
3256 sem.mpaccatomic.accassignc = 0;
3257 sem.mpaccatomic.is_acc = 0;
3258 sem.mpaccatomic.pending = FALSE;
3259 sem.mpaccatomic.apply = FALSE;
3260 sem.mpaccatomic.action_type = ATOMIC_UNDEF;
3261 sem.mpaccatomic.mem_order = MO_UNDEF;
3262 sem.mpaccatomic.ast = 0;
3263 sem.mpaccatomic.seen = TRUE;
3264
3265 if (use_opt_atomic(sem.doif_depth)) {
3266 sem.mpaccatomic.ast = mk_stmt(A_MP_ATOMIC, 0);
3267 (void)add_stmt(sem.mpaccatomic.ast);
3268 } else {
3269 sem.mpaccatomic.ast = emit_bcs_ecs(A_MP_CRITICAL);
3270 }
3271 break;
3272
3273 /* ------------------------------------------------------------------ */
3274 /*
3275 * <doacross begin> ::= <mp doacross>
3276 */
3277 case DOACROSS_BEGIN1:
3278 parstuff_init();
3279 doif =
3280 enter_dir(DI_DOACROSS, FALSE, 0,
3281 DI_B(DI_PDO) | DI_B(DI_PARDO) | DI_B(DI_DOACROSS) |
3282 DI_B(DI_PARSECTS) | DI_B(DI_SECTS) | DI_B(DI_SINGLE) |
3283 DI_B(DI_CRITICAL) | DI_B(DI_MASTER) | DI_B(DI_ORDERED) |
3284 DI_B(DI_TASK) | DI_B(DI_ATOMIC_CAPTURE) |
3285 DI_B((DI_PDO | DI_SIMD)) | DI_B((DI_PARDO | DI_SIMD)));
3286 SST_CVALP(LHS, sem.doif_depth); /* always pass up do's DOIF index */
3287 break;
3288
3289 /* ------------------------------------------------------------------ */
3290 /*
3291 * <paralleldo begin> ::= <mp pardo>
3292 */
3293 case PARALLELDO_BEGIN1:
3294 parstuff_init();
3295 doif = enter_dir(DI_PARDO, FALSE, 0, DI_B(DI_ATOMIC_CAPTURE));
3296 SST_CVALP(LHS, sem.doif_depth); /* always pass up do's DOIF index */
3297 break;
3298
3299 /* ------------------------------------------------------------------ */
3300 /*
3301 * <parallelsections begin> ::= <mp parsections>
3302 */
3303 case PARALLELSECTIONS_BEGIN1:
3304 parstuff_init();
3305 doif = enter_dir(DI_PARSECTS, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3306 SST_CVALP(LHS, doif);
3307 break;
3308
3309 /* ------------------------------------------------------------------ */
3310 /*
3311 * <sections begin> ::= <mp sections>
3312 */
3313 case SECTIONS_BEGIN1:
3314 parstuff_init();
3315 doif = enter_dir(DI_SECTS, FALSE, 0,
3316 DI_B(DI_PDO) | DI_B(DI_PARDO) | DI_B(DI_DOACROSS) |
3317 DI_B(DI_SECTS) | DI_B(DI_SINGLE) | DI_B(DI_CRITICAL) |
3318 DI_B(DI_MASTER) | DI_B(DI_ORDERED) | DI_B(DI_TASK) |
3319 DI_B(DI_ATOMIC_CAPTURE) | DI_B((DI_PDO | DI_SIMD)) |
3320 DI_B((DI_PARDO | DI_SIMD)));
3321 SST_CVALP(LHS, doif);
3322 break;
3323
3324 /* ------------------------------------------------------------------ */
3325 /*
3326 * <parworkshare begin> ::= <mp parworkshare>
3327 */
3328 case PARWORKSHARE_BEGIN1:
3329 parstuff_init();
3330 doif = enter_dir(DI_PARWORKS, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3331 SST_CVALP(LHS, doif);
3332 break;
3333
3334 /* ------------------------------------------------------------------ */
3335 /*
3336 * <task begin> ::= <mp task>
3337 */
3338 case TASK_BEGIN1:
3339 parstuff_init();
3340 doif = enter_dir(DI_TASK, FALSE, 2, DI_B(DI_ATOMIC_CAPTURE));
3341 SST_CVALP(LHS, doif);
3342 break;
3343
3344 /* ------------------------------------------------------------------ */
3345 /*
3346 * <dosimd begin> ::= <mp dosimd>
3347 */
3348 case DOSIMD_BEGIN1:
3349 parstuff_init();
3350 doif =
3351 enter_dir(DI_PDO, FALSE, 0,
3352 DI_B(DI_PDO) | DI_B(DI_PARDO) | DI_B(DI_DOACROSS) |
3353 DI_B(DI_PARSECTS) | DI_B(DI_SECTS) | DI_B(DI_SINGLE) |
3354 DI_B(DI_CRITICAL) | DI_B(DI_MASTER) | DI_B(DI_ORDERED) |
3355 DI_B(DI_TASK) | DI_B(DI_ATOMIC_CAPTURE) |
3356 DI_B((DI_PDO | DI_SIMD)) | DI_B((DI_PARDO | DI_SIMD)));
3357 SST_CVALP(LHS, sem.doif_depth); /* always pass up do's DOIF index */
3358 if (doif)
3359 DI_ISSIMD(doif) = TRUE;
3360 break;
3361
3362 /* ------------------------------------------------------------------ */
3363 /*
3364 * <simd begin> ::= <mp simd>
3365 */
3366 case SIMD_BEGIN1:
3367 parstuff_init();
3368 doif = enter_dir(DI_SIMD, FALSE, 0, DI_B(DI_ATOMIC_CAPTURE));
3369 SST_CVALP(LHS, sem.doif_depth); /* always pass up do's DOIF index */
3370
3371 break;
3372
3373 /* ------------------------------------------------------------------ */
3374 /*
3375 * <targetdata begin> ::= <mp targetdata>
3376 */
3377 case TARGETDATA_BEGIN1:
3378 parstuff_init();
3379 doif = enter_dir(DI_TARGETDATA, TRUE, 0,
3380 DI_B(DI_ATOMIC_CAPTURE) | DI_B(DI_TARGET) |
3381 DI_B(DI_TARGETENTERDATA) | DI_B(DI_TARGETEXITDATA) |
3382 DI_B(DI_TARGETUPDATE) | DI_B(DI_TARGETDATA));
3383 SST_CVALP(LHS, doif);
3384 break;
3385
3386 /* ------------------------------------------------------------------ */
3387 /*
3388 * <targetenterdata begin> ::= <mp targetenterdata>
3389 */
3390 case TARGETENTERDATA_BEGIN1:
3391 parstuff_init();
3392 doif = enter_dir(DI_TARGETENTERDATA, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3393 SST_CVALP(LHS, doif);
3394 break;
3395
3396 /* ------------------------------------------------------------------ */
3397 /*
3398 * <targetexitdata begin> ::= <mp targetexitdata>
3399 */
3400 case TARGETEXITDATA_BEGIN1:
3401 parstuff_init();
3402 doif = enter_dir(DI_TARGETEXITDATA, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3403 SST_CVALP(LHS, doif);
3404 break;
3405
3406 /* ------------------------------------------------------------------ */
3407 /*
3408 * <target begin> ::= <mp target>
3409 */
3410 case TARGET_BEGIN1:
3411 parstuff_init();
3412 doif = enter_dir(DI_TARGET, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3413 SST_CVALP(LHS, doif);
3414 break;
3415
3416 /* ------------------------------------------------------------------ */
3417 /*
3418 * <targetupdate begin> ::= <mp targetupdate>
3419 */
3420 case TARGETUPDATE_BEGIN1:
3421 parstuff_init();
3422 doif = enter_dir(DI_TARGETUPDATE, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3423 SST_CVALP(LHS, doif);
3424 break;
3425
3426 /* ------------------------------------------------------------------ */
3427 /*
3428 * <teams begin> ::= <mp teams>
3429 */
3430 case TEAMS_BEGIN1:
3431 parstuff_init();
3432 doif = enter_dir(DI_TEAMS, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3433 SST_CVALP(LHS, doif);
3434 break;
3435
3436 /* ------------------------------------------------------------------ */
3437 /*
3438 * <distribute begin> ::= <mp distribute>
3439 */
3440 case DISTRIBUTE_BEGIN1:
3441 parstuff_init();
3442 doif = enter_dir(DI_DISTRIBUTE, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3443 SST_CVALP(LHS, doif);
3444 break;
3445
3446 /* ------------------------------------------------------------------ */
3447 /*
3448 * <distsimd begin> ::= <mp distsimd>
3449 */
3450 case DISTSIMD_BEGIN1:
3451 parstuff_init();
3452 doif = enter_dir(DI_DISTRIBUTE, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3453 SST_CVALP(LHS, doif);
3454 break;
3455
3456 /* ------------------------------------------------------------------ */
3457 /*
3458 * <distpardo begin> ::= <mp distpardo>
3459 */
3460 case DISTPARDO_BEGIN1:
3461 parstuff_init();
3462 doif = enter_dir(DI_DISTPARDO, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3463 SST_CVALP(LHS, doif);
3464 break;
3465
3466 /* ------------------------------------------------------------------ */
3467 /*
3468 * <distpardosimd begin> ::= <mp distpardosimd>
3469 */
3470 case DISTPARDOSIMD_BEGIN1:
3471 parstuff_init();
3472 doif = enter_dir(DI_DISTPARDO, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3473 SST_CVALP(LHS, doif);
3474 break;
3475
3476 /* ------------------------------------------------------------------ */
3477 /*
3478 * <pardosimd begin> ::= <mp pardosimd>
3479 */
3480 case PARDOSIMD_BEGIN1:
3481 parstuff_init();
3482 doif = enter_dir(DI_PARDO, FALSE, 0, DI_B(DI_ATOMIC_CAPTURE));
3483 SST_CVALP(LHS, sem.doif_depth); /* always pass up do's DOIF index */
3484 if (doif)
3485 DI_ISSIMD(doif) = TRUE;
3486 break;
3487
3488 /* ------------------------------------------------------------------ */
3489 /*
3490 * <targpar begin> ::= <mp targpar>
3491 */
3492 case TARGPAR_BEGIN1:
3493 parstuff_init();
3494 doif = enter_dir(DI_TARGET, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3495 SST_CVALP(LHS, doif);
3496 break;
3497
3498 /* ------------------------------------------------------------------ */
3499 /*
3500 * <targpardo begin> ::= <mp targpardo>
3501 */
3502 case TARGPARDO_BEGIN1:
3503 parstuff_init();
3504 doif = enter_dir(DI_TARGET, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3505 SST_CVALP(LHS, doif);
3506 break;
3507
3508 /* ------------------------------------------------------------------ */
3509 /*
3510 * <targparsimd begin> ::= <mp targparsimd>
3511 */
3512 case TARGPARSIMD_BEGIN1:
3513 parstuff_init();
3514 doif = enter_dir(DI_TARGET, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3515 SST_CVALP(LHS, doif);
3516 break;
3517
3518 /* ------------------------------------------------------------------ */
3519 /*
3520 * <targpardosimd begin> ::= <mp targpardosimd>
3521 */
3522 case TARGPARDOSIMD_BEGIN1:
3523 parstuff_init();
3524 doif = enter_dir(DI_TARGET, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3525 SST_CVALP(LHS, doif);
3526 break;
3527
3528 /* ------------------------------------------------------------------ */
3529 /*
3530 * <targsimd begin> ::= <mp targsimd>
3531 */
3532 case TARGSIMD_BEGIN1:
3533 parstuff_init();
3534 doif = enter_dir(DI_TARGET, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3535 SST_CVALP(LHS, doif);
3536 break;
3537
3538 /* ------------------------------------------------------------------ */
3539 /*
3540 * <targteams begin> ::= <mp targteams>
3541 */
3542 case TARGTEAMS_BEGIN1:
3543 parstuff_init();
3544 doif = enter_dir(DI_TARGET, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3545 SST_CVALP(LHS, doif);
3546 break;
3547
3548 /* ------------------------------------------------------------------ */
3549 /*
3550 * <teamsdist begin> ::= <mp teamsdist>
3551 */
3552 case TEAMSDIST_BEGIN1:
3553 parstuff_init();
3554 doif = enter_dir(DI_TEAMS, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3555 SST_CVALP(LHS, doif);
3556 break;
3557
3558 /* ------------------------------------------------------------------ */
3559 /*
3560 * <teamsdistsimd begin> ::= <mp teamsdistsimd>
3561 */
3562 case TEAMSDISTSIMD_BEGIN1:
3563 parstuff_init();
3564 doif = enter_dir(DI_TEAMS, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3565 SST_CVALP(LHS, doif);
3566 break;
3567
3568 /* ------------------------------------------------------------------ */
3569 /*
3570 * <targteamsdist begin> ::= <mp targteamsdist>
3571 */
3572 case TARGTEAMSDIST_BEGIN1:
3573 parstuff_init();
3574 doif = enter_dir(DI_TARGET, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3575 SST_CVALP(LHS, doif);
3576 break;
3577
3578 /* ------------------------------------------------------------------ */
3579 /*
3580 * <targteamsdistsimd begin> ::= <mp targteamsdistsimd>
3581 */
3582 case TARGTEAMSDISTSIMD_BEGIN1:
3583 parstuff_init();
3584 doif = enter_dir(DI_TARGET, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3585 SST_CVALP(LHS, doif);
3586 break;
3587
3588 /* ------------------------------------------------------------------ */
3589 /*
3590 * <teamsdistpardo begin> ::= <mp teamsdistpardo>
3591 */
3592 case TEAMSDISTPARDO_BEGIN1:
3593 parstuff_init();
3594 doif = enter_dir(DI_TEAMS, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3595 SST_CVALP(LHS, doif);
3596 break;
3597
3598 /* ------------------------------------------------------------------ */
3599 /*
3600 * <targteamsdistpardo begin> ::= <mp targteamsdistpardo>
3601 */
3602 case TARGTEAMSDISTPARDO_BEGIN1:
3603 parstuff_init();
3604 doif = enter_dir(DI_TARGET, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3605 SST_CVALP(LHS, doif);
3606 break;
3607
3608 /* ------------------------------------------------------------------ */
3609 /*
3610 * <teamsdistpardosimd begin> ::= <mp teamsdistpardosimd>
3611 */
3612 case TEAMSDISTPARDOSIMD_BEGIN1:
3613 parstuff_init();
3614 doif = enter_dir(DI_TEAMS, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3615 SST_CVALP(LHS, doif);
3616 break;
3617
3618 /* ------------------------------------------------------------------ */
3619 /*
3620 * <targteamsdistpardosimd begin> ::= <mp targteamsdistpardosimd>
3621 */
3622 case TARGTEAMSDISTPARDOSIMD_BEGIN1:
3623 parstuff_init();
3624 doif = enter_dir(DI_TARGET, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3625 SST_CVALP(LHS, doif);
3626 break;
3627
3628 /* ------------------------------------------------------------------ */
3629 /*
3630 * <taskloop begin> ::= <mp taskloop>
3631 */
3632 case TASKLOOP_BEGIN1:
3633 parstuff_init();
3634 doif = enter_dir(DI_TASKLOOP, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3635 SST_CVALP(LHS, doif);
3636 break;
3637
3638 /* ------------------------------------------------------------------ */
3639 /*
3640 * <taskloopsimd begin> ::= <mp taskloopsimd>
3641 */
3642 case TASKLOOPSIMD_BEGIN1:
3643 parstuff_init();
3644 doif = enter_dir(DI_TASKLOOP, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
3645 SST_CVALP(LHS, doif);
3646 break;
3647
3648 /* ------------------------------------------------------------------ */
3649 /*
3650 * <accel stmt> ::= <accel begin> ACCREGION <opt accel list> |
3651 */
3652 case ACCEL_STMT1:
3653 ditype = DI_ACCREG;
3654 dimask = 0;
3655 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL);
3656 bttype = BT_ACCREG;
3657 dirname = "ACC REGION";
3658 pr1 = PR_ACCEL;
3659 pr2 = 0;
3660 dignorenested = TRUE;
3661 goto ACCEL_ENTER_REGION;
3662 /*
3663 * <accel stmt> ::= <accel begin> ACCKERNELS <opt accel list> |
3664 */
3665 case ACCEL_STMT2:
3666 ditype = DI_ACCKERNELS;
3667 dimask = 0;
3668 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL);
3669 bttype = BT_ACCKERNELS;
3670 dirname = "ACC KERNELS";
3671 pr1 = PR_ACCKERNELS;
3672 pr2 = 0;
3673 dignorenested = TRUE;
3674 goto ACCEL_ENTER_REGION;
3675 /*
3676 * <accel stmt> ::= <accel begin> PARALLEL <opt accel list> |
3677 */
3678 case ACCEL_STMT3:
3679 ditype = DI_ACCPARALLEL;
3680 dimask = 0;
3681 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL);
3682 bttype = BT_ACCPARALLEL;
3683 dirname = "ACC PARALLEL";
3684 pr1 = PR_ACCPARCONSTRUCT;
3685 pr2 = 0;
3686 dignorenested = TRUE;
3687 goto ACCEL_ENTER_REGION;
3688 /*
3689 * <accel stmt> ::= <accel begin> ACCDATA <opt accel list> |
3690 */
3691 case ACCEL_STMT4:
3692 ditype = DI_ACCDATAREG;
3693 dimask = 0;
3694 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL);
3695 bttype = BT_ACCDATAREG;
3696 dirname = "ACC DATA";
3697 pr1 = PR_ACCDATAREG;
3698 pr2 = 0;
3699 dignorenested = FALSE;
3700 goto ACCEL_ENTER_REGION;
3701 /*
3702 * <accel stmt> ::= <accel begin> ACCDATAREGION <opt accel list> |
3703 */
3704 case ACCEL_STMT5:
3705 ditype = DI_ACCDATAREG;
3706 dimask = 0;
3707 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL);
3708 bttype = BT_ACCDATAREG;
3709 dirname = "ACC DATA REGION";
3710 pr1 = PR_ACCDATAREG;
3711 pr2 = 0;
3712 dignorenested = FALSE;
3713 goto ACCEL_ENTER_REGION;
3714 /*
3715 * <accel stmt> ::= <accel begin> ACCDO <opt accel list> |
3716 */
3717 case ACCEL_STMT6:
3718 ditype = DI_ACCDO;
3719 dimask = 0;
3720 dinestmask = 0;
3721 if (DI_IN_NEST(sem.doif_depth, DI_ACCREG)) {
3722 bttype = BT_ACCKDO;
3723 pr1 = PR_ACCELLP;
3724 dirname = "ACC DO";
3725 } else if (DI_IN_NEST(sem.doif_depth, DI_ACCKERNELS)) {
3726 bttype = BT_ACCKDO;
3727 pr1 = PR_ACCKLOOP;
3728 dirname = "ACC LOOP";
3729 } else {
3730 bttype = BT_ACCPDO;
3731 pr1 = PR_ACCPLOOP;
3732 dirname = "ACC LOOP";
3733 }
3734 pr2 = 0;
3735 dignorenested = FALSE;
3736 goto ACCEL_ENTER_REGION;
3737
3738 /*
3739 * <accel stmt> ::= <accel begin> ACCLOOP <opt accel list> |
3740 */
3741 case ACCEL_STMT7:
3742 ditype = DI_ACCLOOP;
3743 dimask = 0;
3744 dinestmask = 0;
3745 if (DI_IN_NEST(sem.doif_depth, DI_ACCREG)) {
3746 bttype = BT_ACCKLOOP;
3747 pr1 = PR_ACCELLP;
3748 dirname = "ACC DO";
3749 } else if (DI_IN_NEST(sem.doif_depth, DI_ACCKERNELS)) {
3750 bttype = BT_ACCKLOOP;
3751 pr1 = PR_ACCKLOOP;
3752 dirname = "ACC LOOP";
3753 } else if (DI_IN_NEST(sem.doif_depth, DI_ACCSERIAL)) {
3754 bttype = BT_ACCSLOOP;
3755 pr1 = PR_ACCSLOOP;
3756 dirname = "ACC LOOP";
3757 } else {
3758 bttype = BT_ACCPLOOP;
3759 pr1 = PR_ACCPLOOP;
3760 dirname = "ACC LOOP";
3761 }
3762 pr2 = 0;
3763 dignorenested = FALSE;
3764 goto ACCEL_ENTER_REGION;
3765 /*
3766 * <accel stmt> ::= <accel begin> ACCREGIONDO <opt accel list> |
3767 */
3768 case ACCEL_STMT8:
3769 dimask = DI_B(DI_ACCREG) | DI_B(DI_ACCDO);
3770 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL);
3771 bttype = BT_ACCREG | BT_ACCKDO;
3772 dirname = "ACC REGION DO";
3773 pr1 = PR_ACCEL;
3774 pr2 = PR_ACCELLP;
3775 dignorenested = TRUE;
3776 goto ACCEL_ENTER_REGION;
3777 /*
3778 * <accel stmt> ::= <accel begin> ACCREGIONLOOP <opt accel list> |
3779 */
3780 case ACCEL_STMT9:
3781 ditype = DI_ACCREGLOOP;
3782 dimask = DI_B(DI_ACCREG) | DI_B(DI_ACCLOOP);
3783 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL);
3784 bttype = BT_ACCREG | BT_ACCKLOOP;
3785 dirname = "ACC REGION LOOP";
3786 pr1 = PR_ACCEL;
3787 pr2 = PR_ACCELLP;
3788 dignorenested = TRUE;
3789 goto ACCEL_ENTER_REGION;
3790 /*
3791 * <accel stmt> ::= <accel begin> ACCKERNELSDO <opt accel list> |
3792 */
3793 case ACCEL_STMT10:
3794 ditype = DI_ACCKERNELSDO;
3795 dimask = DI_B(DI_ACCKERNELS) | DI_B(DI_ACCDO);
3796 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL);
3797 bttype = BT_ACCKERNELS | BT_ACCKDO;
3798 dirname = "ACC KERNELS DO";
3799 pr1 = PR_ACCKERNELS;
3800 pr2 = PR_ACCTKLOOP;
3801 dignorenested = TRUE;
3802 goto ACCEL_ENTER_REGION;
3803 /*
3804 * <accel stmt> ::= <accel begin> ACCKERNELSLOOP <opt accel list> |
3805 */
3806 case ACCEL_STMT11:
3807 dimask = DI_B(DI_ACCKERNELS) | DI_B(DI_ACCLOOP);
3808 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL);
3809 bttype = BT_ACCKERNELS | BT_ACCKLOOP;
3810 dirname = "ACC KERNELS LOOP";
3811 pr1 = PR_ACCKERNELS;
3812 pr2 = PR_ACCTKLOOP;
3813 dignorenested = TRUE;
3814 ACCEL_ENTER_REGION:
3815 SST_ASTP(LHS, 0);
3816 break;
3817 /*
3818 * <accel stmt> ::= <accel begin> ACCPARALLELDO <opt accel list> |
3819 */
3820 case ACCEL_STMT12:
3821 ditype = DI_ACCPARALLELDO;
3822 dimask = DI_B(DI_ACCPARALLEL) | DI_B(DI_ACCDO);
3823 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL);
3824 bttype = BT_ACCPARALLEL | BT_ACCPDO;
3825 dirname = "ACC PARALLEL DO";
3826 pr1 = PR_ACCPARCONSTRUCT;
3827 pr2 = PR_ACCTPLOOP;
3828 dignorenested = TRUE;
3829 goto ACCEL_ENTER_REGION;
3830 /*
3831 * <accel stmt> ::= <accel begin> ACCPARALLELLOOP <opt accel list> |
3832 */
3833 case ACCEL_STMT13:
3834 ditype = DI_ACCPARALLELLOOP;
3835 dimask = DI_B(DI_ACCPARALLEL) | DI_B(DI_ACCLOOP);
3836 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL);
3837 bttype = BT_ACCPARALLEL | BT_ACCPLOOP;
3838 dirname = "ACC PARALLEL LOOP";
3839 pr1 = PR_ACCPARCONSTRUCT;
3840 pr2 = PR_ACCTPLOOP;
3841 dignorenested = TRUE;
3842 goto ACCEL_ENTER_REGION;
3843 /*
3844 * <accel stmt> ::= <accel begin> <accel update dir> |
3845 */
3846 case ACCEL_STMT14:
3847 SST_ASTP(LHS, 0);
3848 break;
3849 /*
3850 * <accel stmt> ::= <accel begin> ACCENDREGION <opt end accel list> |
3851 */
3852 case ACCEL_STMT15:
3853 ditype = DI_ACCREG;
3854 ditype2 = DI_ACCREGDO;
3855 ditype3 = DI_ACCREGLOOP;
3856 bttype = BT_ACCENDREG;
3857 dirname = "ACC END REGION";
3858 pr1 = PR_ENDACCEL;
3859 ACCEL_END_REGION:
3860 SST_ASTP(LHS, 0);
3861 break;
3862 /*
3863 * <accel stmt> ::= <accel begin> ACCENDKERNELS |
3864 */
3865 case ACCEL_STMT16:
3866 ditype = DI_ACCKERNELS;
3867 ditype2 = DI_ACCKERNELSDO;
3868 ditype3 = DI_ACCKERNELSLOOP;
3869 bttype = 0;
3870 dirname = "ACC END KERNELS";
3871 pr1 = PR_ACCENDKERNELS;
3872 goto ACCEL_END_REGION;
3873 /*
3874 * <accel stmt> ::= <accel begin> ACCENDKERNDO |
3875 */
3876 case ACCEL_STMT17:
3877 ditype = DI_ACCKERNELS;
3878 ditype2 = DI_ACCKERNELSDO;
3879 ditype3 = DI_ACCKERNELSLOOP;
3880 bttype = 0;
3881 dirname = "ACC END KERNELS DO";
3882 pr1 = PR_ACCENDKERNELS;
3883 goto ACCEL_END_REGION;
3884 /*
3885 * <accel stmt> ::= <accel begin> ACCENDKERNLOOP |
3886 */
3887 case ACCEL_STMT18:
3888 ditype = DI_ACCKERNELS;
3889 ditype2 = DI_ACCKERNELSDO;
3890 ditype3 = DI_ACCKERNELSLOOP;
3891 bttype = 0;
3892 dirname = "ACC END KERNELS LOOP";
3893 pr1 = PR_ACCENDKERNELS;
3894 goto ACCEL_END_REGION;
3895 /*
3896 * <accel stmt> ::= <accel begin> ACCENDPARALLEL |
3897 */
3898 case ACCEL_STMT19:
3899 ditype = DI_ACCPARALLEL;
3900 ditype2 = DI_ACCPARALLELDO;
3901 ditype3 = DI_ACCPARALLELLOOP;
3902 bttype = 0;
3903 dirname = "ACC END PARALLEL";
3904 pr1 = PR_ACCENDPARCONSTRUCT;
3905 goto ACCEL_END_REGION;
3906 /*
3907 * <accel stmt> ::= <accel begin> ACCENDPARDO |
3908 */
3909 case ACCEL_STMT20:
3910 ditype = DI_ACCPARALLEL;
3911 ditype2 = DI_ACCPARALLELDO;
3912 ditype3 = DI_ACCPARALLELLOOP;
3913 bttype = 0;
3914 dirname = "ACC END PARALLEL DO";
3915 pr1 = PR_ACCENDPARCONSTRUCT;
3916 goto ACCEL_END_REGION;
3917 /*
3918 * <accel stmt> ::= <accel begin> ACCENDPARLOOP |
3919 */
3920 case ACCEL_STMT21:
3921 ditype = DI_ACCPARALLEL;
3922 ditype2 = DI_ACCPARALLELDO;
3923 ditype3 = DI_ACCPARALLELLOOP;
3924 bttype = 0;
3925 dirname = "ACC END PARALLEL LOOP";
3926 pr1 = PR_ACCENDPARCONSTRUCT;
3927 goto ACCEL_END_REGION;
3928 /*
3929 * <accel stmt> ::= ACCENDDATAREGION |
3930 */
3931 case ACCEL_STMT22:
3932 ditype = DI_ACCDATAREG;
3933 ditype2 = 0;
3934 ditype3 = 0;
3935 bttype = 0;
3936 dirname = "ACC END DATA REGION";
3937 pr1 = PR_ACCENDDATAREG;
3938 goto ACCEL_END_REGION;
3939
3940 /*
3941 * <accel stmt> ::= ACCENDDATA
3942 */
3943 case ACCEL_STMT23:
3944 ditype = DI_ACCDATAREG;
3945 ditype2 = 0;
3946 ditype3 = 0;
3947 bttype = 0;
3948 dirname = "ACC END DATA";
3949 pr1 = PR_ACCENDDATAREG;
3950 goto ACCEL_END_REGION;
3951
3952 /*
3953 * <accel stmt> ::= <accel begin> ACCSCALARREGION <opt accel list> |
3954 */
3955 case ACCEL_STMT24:
3956 ditype = DI_ACCREG;
3957 dimask = DI_B(DI_ACCREG);
3958 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL);
3959 ditype2 = -1;
3960 ditype3 = -1;
3961 bttype = BT_ACCSCALARREG;
3962 dirname = "ACC SCALAR REGION";
3963 pr1 = PR_ACCSCALARREG;
3964 pr2 = 0;
3965 dignorenested = TRUE;
3966 goto ACCEL_ENTER_REGION;
3967 /*
3968 * <accel stmt> ::= <accel begin> ACCENDSCALARREGION |
3969 */
3970 case ACCEL_STMT25:
3971 ditype = DI_ACCREG;
3972 ditype2 = 0;
3973 ditype3 = 0;
3974 bttype = BT_ACCENDREG;
3975 dirname = "ACC END SCALAR REGION";
3976 pr1 = PR_ENDACCEL;
3977 goto ACCEL_END_REGION;
3978 /*
3979 * <accel stmt> ::= <accel begin> ACCSCALAR ACCREGION <opt accel list> |
3980 */
3981 case ACCEL_STMT26:
3982 /* error case, should not occur */
3983 interr("semsmp: bad accelerator directive", rednum, 3);
3984 break;
3985 /*
3986 * <accel stmt> ::= ACCENDSCALAR
3987 */
3988 case ACCEL_STMT27:
3989 /* error case, should not occur */
3990 interr("semsmp: bad accelerator directive", rednum, 3);
3991 break;
3992 /*
3993 * <accel stmt> ::= <accel begin> ACCWAIT <opt wait list> |
3994 */
3995 case ACCEL_STMT28:
3996 SST_ASTP(LHS, 0);
3997 break;
3998 /*
3999 * <accel stmt> ::= <accel begin> CACHE ( <accel data list> ) |
4000 */
4001 case ACCEL_STMT29:
4002 SST_ASTP(LHS, 0);
4003 break;
4004 /*
4005 * <accel stmt> ::= <accel begin> ACCHOSTDATA <opt accel list> |
4006 */
4007 case ACCEL_STMT30:
4008 ditype = DI_ACCHOSTDATA;
4009 dimask = 0;
4010 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL);
4011 bttype = BT_ACCHOSTDATA;
4012 dirname = "ACC HOST_DATA";
4013 pr1 = PR_ACCHOSTDATA;
4014 pr2 = 0;
4015 dignorenested = FALSE;
4016 goto ACCEL_ENTER_REGION;
4017 /*
4018 * <accel stmt> ::= ACCENDHOSTDATA |
4019 */
4020 case ACCEL_STMT31:
4021 ditype = DI_ACCHOSTDATA;
4022 ditype2 = 0;
4023 ditype3 = 0;
4024 bttype = 0;
4025 dirname = "ACC END HOSTDATA";
4026 pr1 = PR_ACCENDHOSTDATA;
4027 goto ACCEL_END_REGION;
4028 /*
4029 * <accel stmt> ::= <accel begin> ACCENTER ACCDATA <opt accel list> |
4030 */
4031 case ACCEL_STMT32:
4032 SST_ASTP(LHS, 0);
4033 break;
4034 /*
4035 * <accel stmt> ::= <accel begin> ACCEXIT ACCDATA <opt accel list>
4036 */
4037 case ACCEL_STMT33:
4038 SST_ASTP(LHS, 0);
4039 break;
4040 /*
4041 * <accel stmt> ::= <accel begin> ACCENDLOOP |
4042 */
4043 case ACCEL_STMT34:
4044 /* ignore the endloop */
4045 SST_ASTP(LHS, 0);
4046 break;
4047 /*
4048 * <accel stmt> ::= <accel begin> ACCENDDO
4049 */
4050 case ACCEL_STMT35:
4051 /* ignore the endloop */
4052 SST_ASTP(LHS, 0);
4053 break;
4054
4055 /*
4056 * <accel stmt> ::= <accel begin> ACCATOMIC |
4057 * <accel begin> ACCATOMICUPDATE |
4058 * <accel begin> ACCATOMICREAD |
4059 * <accel begin> ACCATOMICWRITE |
4060 * <accel begin> ACCATOMICCAPTURE
4061 */
4062 case ACCEL_STMT36:
4063 case ACCEL_STMT37:
4064 case ACCEL_STMT38:
4065 case ACCEL_STMT39:
4066 case ACCEL_STMT40: {
4067 int atomic_action;
4068 if (rednum == ACCEL_STMT36 || rednum == ACCEL_STMT37) {
4069 atomic_action = A_ATOMIC;
4070 sem.mpaccatomic.action_type = ATOMIC_UPDATE;
4071 } else if (rednum == ACCEL_STMT38) {
4072 atomic_action = A_ATOMICREAD;
4073 sem.mpaccatomic.action_type = ATOMIC_READ;
4074 } else if (rednum == ACCEL_STMT39) {
4075 atomic_action = A_ATOMICWRITE;
4076 sem.mpaccatomic.action_type = ATOMIC_WRITE;
4077 } else if (rednum == ACCEL_STMT40) {
4078 atomic_action = A_ATOMICCAPTURE;
4079 sem.mpaccatomic.action_type = ATOMIC_CAPTURE;
4080 }
4081
4082 sem.mpaccatomic.is_acc = TRUE;
4083 sem.mpaccatomic.accassignc = 0;
4084 if (sem.mpaccatomic.pending) {
4085 sem.mpaccatomic.pending = FALSE;
4086 error(155, 3, gbl.lineno,
4087 "Statement after ATOMIC is not an assignment (no nesting)", CNULL);
4088 } else {
4089 int ast_atomic;
4090 sem.mpaccatomic.seen = TRUE;
4091 ast_atomic = mk_stmt(atomic_action, 0);
4092 add_stmt(ast_atomic);
4093 sem.mpaccatomic.ast = ast_atomic;
4094 }
4095 }
4096 SST_ASTP(LHS, 0);
4097 break;
4098
4099 /*
4100 * <accel begin> ::= ACCENDATOMIC
4101 */
4102 case ACCEL_STMT41:
4103 if (sem.mpaccatomic.is_acc == FALSE) {
4104 error(155, 3, gbl.lineno, "Unmatched atomic end", CNULL);
4105 } else {
4106 /* Nothing to do, yet... */
4107 if (sem.mpaccatomic.action_type == ATOMIC_CAPTURE) {
4108 int end_atomic;
4109 end_atomic = mk_stmt(A_ENDATOMIC, 0);
4110 add_stmt(end_atomic);
4111 sem.mpaccatomic.ast = end_atomic;
4112 }
4113 /* reset the sem.mpaccatomic.is_acc if the current processing statement
4114 is leaving the atomic region. If we do not reset this variable, the
4115 following statement can be compiled even it is incorrect syntax.
4116
4117 !$acc atomic update
4118 assignment stmt
4119 !$acc end atomic
4120 !$acc end atomic
4121
4122 The second end atomic directive is unmatched one and the compiler
4123 should issue an error.
4124
4125 Furthur more, this tag can be used to detect the illegal staements
4126 in the atomic region. For example, this flag is used in semant3.c
4127 to detect the mulitple assignment stmts which are illegal in the
4128 atomic region.
4129
4130 by daniel tian
4131 */
4132 if ((sem.mpaccatomic.is_acc &&
4133 sem.mpaccatomic.action_type == ATOMIC_CAPTURE &&
4134 sem.mpaccatomic.accassignc > 2) ||
4135 (sem.mpaccatomic.action_type != ATOMIC_CAPTURE &&
4136 sem.mpaccatomic.accassignc > 1)) {
4137 error(
4138 155, 3, gbl.lineno,
4139 "Multiple Assignment Statements were illegal in the Atomic Region",
4140 NULL);
4141 }
4142 sem.mpaccatomic.is_acc = FALSE;
4143 }
4144 sem.mpaccatomic.seen = FALSE;
4145 break;
4146 /*
4147 * <accel stmt> ::= <accel begin> ACCINIT <opt accel init list> |
4148 */
4149 case ACCEL_STMT42:
4150 break;
4151 /*
4152 * <accel stmt> ::= <accel begin> ACCSHUTDOWN <opt accel shutdown list> |
4153 */
4154 case ACCEL_STMT43:
4155 break;
4156 /*
4157 * <accel stmt> ::= <accel begin> <accel setdev dir>
4158 */
4159 case ACCEL_STMT44:
4160 break;
4161 /*
4162 * <accel stmt> ::= <accel begin> CACHE ( <ident> : <accel sdata list> )
4163 */
4164 case ACCEL_STMT45:
4165 SST_ASTP(LHS, 0);
4166 break;
4167 /*
4168 * <accel stmt> ::= <accel begin> ACCSERIAL <opt accel list> |
4169 */
4170 case ACCEL_STMT46:
4171 ditype = DI_ACCSERIAL;
4172 dimask = DI_B(DI_ACCSERIAL);
4173 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL) |
4174 DI_B(DI_ACCSERIAL);
4175 ditype2 = -1;
4176 ditype3 = -1;
4177 bttype = BT_ACCSERIAL;
4178 dirname = "ACC SERIAL";
4179 pr1 = PR_ACCSERIAL;
4180 pr2 = 0;
4181 dignorenested = TRUE;
4182 goto ACCEL_ENTER_REGION;
4183 /*
4184 * <accel stmt> ::= <accel begin> ACCENDSERIAL |
4185 */
4186 case ACCEL_STMT47:
4187 ditype = DI_ACCSERIAL;
4188 ditype2 = 0;
4189 ditype3 = 0;
4190 bttype = 0;
4191 dirname = "ACC END SERIAL";
4192 pr1 = PR_ENDACCEL;
4193 goto ACCEL_END_REGION;
4194 /*
4195 * <accel stmt> ::= <accel begin> ACCSERIALLOOP <opt accel list> |
4196 */
4197 case ACCEL_STMT48:
4198 ditype = DI_ACCSERIALLOOP;
4199 dimask = DI_B(DI_ACCSERIAL) | DI_B(DI_ACCLOOP);
4200 dinestmask = DI_B(DI_ACCREG) | DI_B(DI_ACCKERNELS) | DI_B(DI_ACCPARALLEL) |
4201 DI_B(DI_ACCSERIAL);
4202 bttype = BT_ACCSERIAL | BT_ACCSLOOP;
4203 dirname = "ACC SERIAL LOOP";
4204 pr1 = PR_ACCSERIAL;
4205 pr2 = PR_ACCTSLOOP;
4206 dignorenested = TRUE;
4207 goto ACCEL_ENTER_REGION;
4208 /*
4209 * <accel stmt> ::= <accel begin> ACCENDSERIALLOOP
4210 */
4211 case ACCEL_STMT49:
4212 ditype = DI_ACCSERIAL;
4213 ditype2 = 0;
4214 ditype3 = DI_ACCSERIALLOOP;
4215 bttype = 0;
4216 dirname = "ACC END SERIAL LOOP";
4217 pr1 = PR_ACCENDSERIAL;
4218 goto ACCEL_END_REGION;
4219
4220 /*
4221 * <accel stmt> ::= <accel begin> <accel compare dir> |
4222 */
4223 case ACCEL_STMT50:
4224 break;
4225 /*
4226 * <accel stmt> ::= <pgi begin> <pgi compare dir>
4227 */
4228 case ACCEL_STMT51:
4229 accel_pragmagen(PR_PCASTCOMPARE, 0, 0);
4230 break;
4231
4232 /* ------------------------------------------------------------------ */
4233 /*
4234 * <accel begin> ::=
4235 */
4236 case ACCEL_BEGIN1:
4237 parstuff_init();
4238 SST_ASTP(LHS, 0);
4239 break;
4240
4241 /* ------------------------------------------------------------------ */
4242 /*
4243 * <pgi begin> ::=
4244 */
4245 case PGI_BEGIN1:
4246 parstuff_init();
4247 SST_ASTP(LHS, 0);
4248 break;
4249
4250 /* ------------------------------------------------------------------ */
4251 /*
4252 * <opt accel list> ::= |
4253 */
4254 case OPT_ACCEL_LIST1:
4255 break;
4256 /*
4257 * <opt accel list> ::= <opt comma> <accel list>
4258 */
4259 case OPT_ACCEL_LIST2:
4260 break;
4261
4262 /* ------------------------------------------------------------------ */
4263 /*
4264 * <accel list> ::= <accel list> <opt comma> <accel attr> |
4265 */
4266 case ACCEL_LIST1:
4267 break;
4268 /*
4269 * <accel list> ::= <accel attr>
4270 */
4271 case ACCEL_LIST2:
4272 break;
4273
4274 /* ------------------------------------------------------------------ */
4275 /*
4276 * <accel attr> ::= COPYIN ( <accel data list> ) |
4277 */
4278 case ACCEL_ATTR1:
4279 break;
4280 /*
4281 * <accel attr> ::= COPYOUT ( <accel data list> ) |
4282 */
4283 case ACCEL_ATTR2:
4284 break;
4285 /*
4286 * <accel attr> ::= LOCAL ( <accel data list> ) |
4287 */
4288 case ACCEL_ATTR3:
4289 break;
4290 /*
4291 * <accel attr> ::= CREATE ( <accel data list> ) |
4292 */
4293 case ACCEL_ATTR4:
4294 break;
4295 /*
4296 * <accel attr> ::= PRESENT ( <accel data list> ) |
4297 */
4298 case ACCEL_ATTR5:
4299 break;
4300 /*
4301 * <accel attr> ::= PCOPY ( <accel data list> ) |
4302 */
4303 case ACCEL_ATTR6:
4304 break;
4305 /*
4306 * <accel attr> ::= PCOPYIN ( <accel data list> ) |
4307 */
4308 case ACCEL_ATTR7:
4309 break;
4310 /*
4311 * <accel attr> ::= PCOPYOUT ( <accel data list> ) |
4312 */
4313 case ACCEL_ATTR8:
4314 break;
4315 /*
4316 * <accel attr> ::= PLOCAL ( <accel data list> ) |
4317 */
4318 case ACCEL_ATTR9:
4319 break;
4320 /*
4321 * <accel attr> ::= PCREATE ( <accel data list> ) |
4322 */
4323 case ACCEL_ATTR10:
4324 break;
4325 /*
4326 * <accel attr> ::= DEVICEPTR ( <accel data list> ) |
4327 */
4328 case ACCEL_ATTR11:
4329 break;
4330 /*
4331 * <accel attr> ::= PRIVATE ( <accel data list> ) |
4332 */
4333 case ACCEL_ATTR12:
4334 break;
4335 /*
4336 * <accel attr> ::= FIRSTPRIVATE ( <accel data list> ) |
4337 */
4338 case ACCEL_ATTR13:
4339 break;
4340 /*
4341 * <accel attr> ::= CACHE ( <accel data list> ) |
4342 */
4343 case ACCEL_ATTR14:
4344 break;
4345 /*
4346 * <accel attr> ::= SHORTLOOP |
4347 */
4348 case ACCEL_ATTR15:
4349 break;
4350 /*
4351 * <accel attr> ::= VECTOR ( <ident> : <expression> ) |
4352 */
4353 case ACCEL_ATTR16:
4354 break;
4355 /*
4356 * <accel attr> ::= VECTOR ( <expression> ) |
4357 */
4358 case ACCEL_ATTR17:
4359 clause = CL_VECTOR;
4360 recent_loop_clause = clause;
4361 arg = 3;
4362 goto acc_sched_shared;
4363 /*
4364 * <accel attr> ::= VECTOR |
4365 */
4366 case ACCEL_ATTR18:
4367 clause = CL_VECTOR;
4368 recent_loop_clause = clause;
4369 goto acc_nowidth_shared;
4370 /*
4371 * <accel attr> ::= PARALLEL ( <expression> ) |
4372 */
4373 case ACCEL_ATTR19:
4374 clause = CL_PARALLEL;
4375 recent_loop_clause = clause;
4376 arg = 3;
4377 goto acc_sched_shared;
4378 /*
4379 * <accel attr> ::= PARALLEL |
4380 */
4381 case ACCEL_ATTR20:
4382 clause = CL_PARALLEL;
4383 recent_loop_clause = clause;
4384 goto acc_nowidth_shared;
4385 /*
4386 * <accel attr> ::= SEQ ( <expression> ) |
4387 */
4388 case ACCEL_ATTR21:
4389 if (ACCSTRICT || ACCVERYSTRICT)
4390 error(531, ACCVERYSTRICT ? 3 : 2, gbl.lineno,
4391 "seq clause with (<expression>)", "");
4392 clause = CL_SEQ;
4393 recent_loop_clause = clause;
4394 arg = 3;
4395 goto acc_sched_shared;
4396 /*
4397 * <accel attr> ::= SEQ |
4398 */
4399 case ACCEL_ATTR22:
4400 clause = CL_SEQ;
4401 recent_loop_clause = clause;
4402 goto acc_nowidth_shared;
4403 /*
4404 * <accel attr> ::= HOST ( <expression> ) |
4405 */
4406 case ACCEL_ATTR23:
4407 clause = CL_HOST;
4408 recent_loop_clause = clause;
4409 arg = 3;
4410
4411 acc_sched_shared:
4412 break;
4413 /*
4414 * <accel attr> ::= HOST |
4415 */
4416 case ACCEL_ATTR24:
4417 clause = CL_HOST;
4418 recent_loop_clause = clause;
4419
4420 acc_nowidth_shared:
4421 break;
4422 /*
4423 * <accel attr> ::= IF ( <expression> ) |
4424 */
4425 case ACCEL_ATTR25:
4426 break;
4427 /*
4428 * <accel attr> ::= UNROLL ( <expression> )
4429 */
4430 case ACCEL_ATTR26:
4431 switch (recent_loop_clause) {
4432 case CL_SEQ:
4433 clause = CL_SEQUNROLL;
4434 break;
4435 case CL_PARALLEL:
4436 case CL_GANG:
4437 clause = CL_PARUNROLL;
4438 break;
4439 case CL_VECTOR:
4440 case CL_WORKER:
4441 clause = CL_VECUNROLL;
4442 break;
4443 default:
4444 clause = CL_UNROLL;
4445 break;
4446 }
4447 arg = 3;
4448 goto acc_sched_shared;
4449 /*
4450 * <accel attr> ::= INDEPENDENT |
4451 */
4452 case ACCEL_ATTR27:
4453 break;
4454 /*
4455 * <accel attr> ::= KERNEL
4456 */
4457 case ACCEL_ATTR28:
4458 break;
4459 /*
4460 * <accel attr> ::= COPY ( <accel data list> )
4461 */
4462 case ACCEL_ATTR29:
4463 break;
4464 /*
4465 * <accel attr> ::= MIRROR ( <accel data list> )
4466 */
4467 case ACCEL_ATTR30:
4468 break;
4469 /*
4470 * <accel attr> ::= ACCUPDATE HOST ( <accel data list> ) |
4471 */
4472 case ACCEL_ATTR31:
4473 clause = CL_UPDATEHOST;
4474 op = 4;
4475 acc_update_clause_shared:
4476 break;
4477 /*
4478 * <accel attr> ::= ACCUPDATE SELF ( <accel data list> ) |
4479 */
4480 case ACCEL_ATTR32:
4481 clause = CL_UPDATESELF;
4482 op = 4;
4483 goto acc_update_clause_shared;
4484 /*
4485 * <accel attr> ::= ACCUPDATE DEVICE ( <accel data list> ) |
4486 */
4487 case ACCEL_ATTR33:
4488 clause = CL_UPDATEDEV;
4489 op = 4;
4490 goto acc_update_clause_shared;
4491 /*
4492 * <accel attr> ::= <accel short update> |
4493 */
4494 case ACCEL_ATTR34:
4495 break;
4496 /*
4497 * <accel attr> ::= ACCUPDATE ACCIN ( <accel data list> ) |
4498 */
4499 case ACCEL_ATTR35:
4500 clause = CL_UPDATEDEV;
4501 op = 4;
4502 goto acc_update_clause_shared;
4503 break;
4504 /*
4505 * <accel attr> ::= ACCUPDATE ACCOUT ( <accel data list> )
4506 */
4507 case ACCEL_ATTR36:
4508 clause = CL_UPDATEHOST;
4509 op = 4;
4510 goto acc_update_clause_shared;
4511 break;
4512 /*
4513 * <accel attr> ::= ACCWAIT |
4514 */
4515 case ACCEL_ATTR37:
4516 break;
4517 /*
4518 * <accel attr> ::= NOWAIT
4519 */
4520 case ACCEL_ATTR38:
4521 break;
4522 /*
4523 * <accel attr> ::= WORKER ( <ident> : <expression> ) |
4524 */
4525 case ACCEL_ATTR39:
4526 break;
4527 /*
4528 * <accel attr> ::= WORKER ( <expression> ) |
4529 */
4530 case ACCEL_ATTR40:
4531 break;
4532 /*
4533 * <accel attr> ::= WORKER |
4534 */
4535 case ACCEL_ATTR41:
4536 break;
4537 /*
4538 * <accel attr> ::= GANG ( <acc gang args> ) |
4539 */
4540 case ACCEL_ATTR42:
4541 break;
4542 /*
4543 * <accel attr> ::= GANG |
4544 */
4545 case ACCEL_ATTR43:
4546 break;
4547 /*
4548 * <accel attr> ::= COLLAPSE ( <expression> ) |
4549 */
4550 case ACCEL_ATTR44:
4551 break;
4552 /*
4553 * <accel attr> ::= ASYNC |
4554 */
4555 case ACCEL_ATTR45:
4556 break;
4557 /*
4558 * <accel attr> ::= ASYNC ( <expression> ) |
4559 */
4560 case ACCEL_ATTR46:
4561 break;
4562 /*
4563 * <accel attr> ::= REDUCTION ( <reduction> ) |
4564 */
4565 case ACCEL_ATTR47:
4566 break;
4567 /*
4568 * <accel attr> ::= NUM_WORKERS ( <expression> ) |
4569 */
4570 case ACCEL_ATTR48:
4571 break;
4572 /*
4573 * <accel attr> ::= NUM_GANGS ( <gangsizes> ) |
4574 */
4575 case ACCEL_ATTR49:
4576 break;
4577 /*
4578 * <accel attr> ::= VECTOR_LENGTH ( <expression> ) |
4579 */
4580 case ACCEL_ATTR50:
4581 break;
4582 /*
4583 * <accel attr> ::= USE_DEVICE ( <accel data list> )
4584 */
4585 case ACCEL_ATTR51:
4586 break;
4587 /*
4588 * <accel attr> ::= DEVICEID ( <expression> )
4589 */
4590 case ACCEL_ATTR52:
4591 break;
4592 /*
4593 * <accel attr> ::= DELETE ( <accel data list> ) |
4594 */
4595 case ACCEL_ATTR53:
4596 break;
4597 /*
4598 * <accel attr> ::= PDELETE ( <accel data list> )
4599 */
4600 case ACCEL_ATTR54:
4601 break;
4602 /*
4603 * <accel attr> ::= ACCWAIT ( <accel wait list> )
4604 */
4605 case ACCEL_ATTR55:
4606 break;
4607 /*
4608 * <accel attr> ::= DEVICE_TYPE ( <devtype list> ) |
4609 */
4610 case ACCEL_ATTR56:
4611 clause = CL_DEVICE_TYPE;
4612 add_clause(clause, FALSE);
4613 CL_VAL(CL_DEVICE_TYPE) = SST_DEVICEG(RHS(3));
4614 break;
4615 /*
4616 * <accel attr> ::= AUTO |
4617 */
4618 case ACCEL_ATTR57:
4619 break;
4620 /*
4621 * <accel attr> ::= ACCTILE ( <accsizelist> ) |
4622 */
4623 case ACCEL_ATTR58:
4624 break;
4625 /*
4626 * <accel attr> ::= DEFAULT ( <ident> ) |
4627 */
4628 case ACCEL_ATTR59:
4629 break;
4630 /*
4631 * <accel attr> ::= PNOT ( <accel data list> )
4632 */
4633 case ACCEL_ATTR60:
4634 break;
4635 /*
4636 * <accel attr> ::= COLLAPSE ( <ident> : <expression> )
4637 */
4638 case ACCEL_ATTR61:
4639 break;
4640 /*
4641 * <accel attr> ::= ACCFINALIZE |
4642 */
4643 case ACCEL_ATTR62:
4644 break;
4645 /*
4646 * <accel attr> ::= ACCIFPRESENT |
4647 */
4648 case ACCEL_ATTR63:
4649 break;
4650 /*
4651 * <accel attr> ::= ACCATTACH ( <accel data list> ) |
4652 */
4653 case ACCEL_ATTR64:
4654 break;
4655 /*
4656 * <accel attr> ::= ACCDETACH ( <accel data list> ) |
4657 */
4658 case ACCEL_ATTR65:
4659 break;
4660 /*
4661 * <accel attr> ::= NO_CREATE ( <accel data list> )
4662 */
4663 case ACCEL_ATTR66:
4664 break;
4665
4666 /* ------------------------------------------------------------------ */
4667 /*
4668 * <acc gang args> ::= <acc gang arg> |
4669 */
4670 case ACC_GANG_ARGS1:
4671 break;
4672 /*
4673 * <acc gang args> ::= <acc gang args> , <acc gang arg>
4674 */
4675 case ACC_GANG_ARGS2:
4676 break;
4677
4678 /* ------------------------------------------------------------------ */
4679 /*
4680 * <acc gang arg> ::= <expression> |
4681 */
4682 case ACC_GANG_ARG1:
4683 break;
4684 /*
4685 * <acc gang arg> ::= <ident> : <accsize> |
4686 */
4687 case ACC_GANG_ARG2:
4688 break;
4689
4690 /* ------------------------------------------------------------------ */
4691 /*
4692 * <gangsizes> ::= <expression> |
4693 */
4694 case GANGSIZES1:
4695 break;
4696 /*
4697 * <gangsizes> ::= <expression> , <gangsize2>
4698 */
4699 case GANGSIZES2:
4700 break;
4701
4702 /* ------------------------------------------------------------------ */
4703 /*
4704 * <gangsize2> ::= <expression> |
4705 */
4706 case GANGSIZE21:
4707 break;
4708 /*
4709 * <gangsize2> ::= <expression> , <gangsize3>
4710 */
4711 case GANGSIZE22:
4712 break;
4713
4714 /* ------------------------------------------------------------------ */
4715 /*
4716 * <gangsize3> ::= <expression>
4717 */
4718 case GANGSIZE31:
4719 break;
4720
4721 /* ------------------------------------------------------------------ */
4722 /*
4723 * <accsizelist> ::= <accsize> |
4724 */
4725 case ACCSIZELIST1:
4726 break;
4727 /*
4728 * <accsizelist> ::= <accsizelist> , <accsize>
4729 */
4730 case ACCSIZELIST2:
4731 break;
4732
4733 /* ------------------------------------------------------------------ */
4734 /*
4735 * <accsize> ::= <expression> |
4736 */
4737 case ACCSIZE1:
4738 chktyp(RHS(1), DT_INT, FALSE);
4739 SST_ASTP(LHS, SST_ASTG(RHS(1)));
4740 break;
4741 /*
4742 * <accsize> ::= *
4743 */
4744 case ACCSIZE2:
4745 SST_ASTP(LHS, new_node(A_NULL));
4746 break;
4747
4748 /* ------------------------------------------------------------------ */
4749 /*
4750 * <opt end accel list> ::= |
4751 */
4752 case OPT_END_ACCEL_LIST1:
4753 break;
4754 /*
4755 * <opt end accel list> ::= <end accel list>
4756 */
4757 case OPT_END_ACCEL_LIST2:
4758 break;
4759
4760 /* ------------------------------------------------------------------ */
4761 /*
4762 * <end accel list> ::= <end accel list> <opt comma> <end accel attr> |
4763 */
4764 case END_ACCEL_LIST1:
4765 break;
4766 /*
4767 * <end accel list> ::= <end accel attr>
4768 */
4769 case END_ACCEL_LIST2:
4770 break;
4771
4772 /* ------------------------------------------------------------------ */
4773 /*
4774 * <end accel attr> ::= ACCWAIT |
4775 */
4776 case END_ACCEL_ATTR1:
4777 break;
4778 /*
4779 * <end accel attr> ::= NOWAIT
4780 */
4781 case END_ACCEL_ATTR2:
4782 break;
4783
4784 /* ------------------------------------------------------------------ */
4785 /*
4786 * <accel data list> ::= <accel data list> , <accel data> |
4787 */
4788 case ACCEL_DATA_LIST1:
4789 accel_data_list1:
4790 if (SST_ASTG(RHS(3))) {
4791 itemp = (ITEM *)getitem(0, sizeof(ITEM));
4792 itemp->next = ITEM_END;
4793 itemp->ast = SST_ASTG(RHS(3));
4794 if (SST_ENDG(RHS(1)) != ITEM_END) {
4795 (SST_ENDG(RHS(1)))->next = itemp;
4796 SST_ENDP(LHS, itemp);
4797 } else {
4798 SST_BEGP(LHS, itemp);
4799 SST_ENDP(LHS, itemp);
4800 }
4801 }
4802 break;
4803 /*
4804 * <accel data list> ::= <accel data>
4805 */
4806 case ACCEL_DATA_LIST2:
4807 accel_data_list2:
4808 if (SST_ASTG(RHS(1))) {
4809 itemp = (ITEM *)getitem(0, sizeof(ITEM));
4810 itemp->next = ITEM_END;
4811 itemp->ast = SST_ASTG(RHS(1));
4812 SST_BEGP(LHS, itemp);
4813 SST_ENDP(LHS, itemp);
4814 } else {
4815 SST_BEGP(LHS, ITEM_END);
4816 SST_ENDP(LHS, ITEM_END);
4817 }
4818 break;
4819
4820 /* ------------------------------------------------------------------ */
4821 /*
4822 * <accel data> ::= <accel data name> ( <accel sub list> ) |
4823 */
4824 case ACCEL_DATA1:
4825 #if defined(OMP_OFFLOAD_LLVM) || defined(OMP_OFFLOAD_PGI)
4826 if(is_in_omptarget(sem.doif_depth) || is_in_omptarget_data(sem.doif_depth)) {
4827 //todo support array section in the map clause for openmp
4828 if (SST_IDG(RHS(1)) == S_IDENT || SST_IDG(RHS(1)) == S_DERIVED) {
4829 sptr = SST_SYMG(RHS(1));
4830 } else {
4831 sptr = SST_LSYMG(RHS(1));
4832 }
4833 error(1206, ERR_Warning, gbl.lineno, sptr ? SYMNAME(sptr) : CNULL, CNULL);
4834 goto accel_data2;
4835 break;
4836 }
4837 #endif
4838 accel_data1:
4839 if (SST_IDG(RHS(1)) == S_IDENT || SST_IDG(RHS(1)) == S_DERIVED) {
4840 sptr = SST_SYMG(RHS(1));
4841 } else {
4842 sptr = SST_LSYMG(RHS(1));
4843 }
4844 switch (STYPEG(sptr)) {
4845 case ST_MEMBER:
4846 case ST_ARRAY:
4847 itemp = SST_BEGG(RHS(3));
4848 (void)mkvarref(RHS(1), itemp);
4849 SST_PARENP(LHS, 0); /* ? */
4850 break;
4851 case ST_STFUNC:
4852 error(155, 3, gbl.lineno, "Illegal use of statement function -",
4853 SYMNAME(sptr));
4854 SST_ASTP(top, 0);
4855 break;
4856 default:
4857 error(155, 3, gbl.lineno, "Unknown symbol used in data clause -",
4858 SYMNAME(sptr));
4859 SST_ASTP(top, 0);
4860 break;
4861 }
4862 break;
4863 /*
4864 * <accel data> ::= <accel data name> |
4865 */
4866 case ACCEL_DATA2:
4867 accel_data2:
4868 if (SST_IDG(RHS(1)) == S_IDENT || SST_IDG(RHS(1)) == S_DERIVED) {
4869 sptr = SST_SYMG(RHS(1));
4870 } else {
4871 sptr = SST_LSYMG(RHS(1));
4872 }
4873 if (STYPEG(sptr) == ST_PARAM || STYPEG(sptr) == ST_CONST) {
4874 error(155, 2, gbl.lineno, "Constant or Parameter used in data clause -",
4875 SYMNAME(sptr));
4876 SST_ASTP(LHS, 0);
4877 } else if (STYPEG(sptr) == ST_STFUNC) {
4878 error(155, 3, gbl.lineno, "Illegal use of statement function -",
4879 SYMNAME(sptr));
4880 SST_ASTP(LHS, 0);
4881 } else {
4882 if (SST_IDG(RHS(1)) == S_IDENT) {
4883 SST_ASTP(LHS, mk_id(sptr));
4884 } else {
4885 SST_ASTP(LHS, SST_ASTG(RHS(1)));
4886 }
4887 }
4888 break;
4889 /*
4890 * <accel data> ::= <constant>
4891 */
4892 case ACCEL_DATA3:
4893 /* ignore constants; these sometimes come from preprocessor names getting
4894 * into data clauses */
4895 SST_ASTP(LHS, 0);
4896 break;
4897 /*
4898 * <accel data> ::= <common>
4899 */
4900 case ACCEL_DATA4:
4901 sptr = SST_SYMG(RHS(1));
4902 SST_SYMP(LHS, sptr);
4903 SST_DTYPEP(LHS, 0);
4904 SST_ASTP(LHS, mk_id(sptr));
4905 break;
4906 /*
4907 * <accel data> ::= <accel data name> '<' <ident> '>' ( <accel sub list> )
4908 *|
4909 */
4910 case ACCEL_DATA5:
4911 break;
4912 /*
4913 * <accel data> ::= <accel data name> '<' <ident> '>'
4914 */
4915 case ACCEL_DATA6:
4916 break;
4917
4918 /* ------------------------------------------------------------------ */
4919 /*
4920 * <accel mdata list> ::= <accel mdata list> , <accel mdata> |
4921 */
4922 case ACCEL_MDATA_LIST1:
4923 goto accel_data_list1;
4924 /*
4925 * <accel mdata list> ::= <accel mdata>
4926 */
4927 case ACCEL_MDATA_LIST2:
4928 goto accel_data_list2;
4929
4930 /* ------------------------------------------------------------------ */
4931 /*
4932 * <accel mdata> ::= <accel mdata name> ( <accel sub list> ) |
4933 */
4934 case ACCEL_MDATA1:
4935 goto accel_data1;
4936 /*
4937 * <accel mdata> ::= <accel mdata name> |
4938 */
4939 case ACCEL_MDATA2:
4940 goto accel_data2;
4941 /*
4942 * <accel mdata> ::= <constant>
4943 */
4944 case ACCEL_MDATA3:
4945 SST_ASTP(LHS, 0);
4946 break;
4947 /* ------------------------------------------------------------------ */
4948 /*
4949 * <accel sdata list> ::= <accel sdata list> , <accel sdata> |
4950 */
4951 case ACCEL_SDATA_LIST1:
4952 goto accel_data_list1;
4953 /*
4954 * <accel sdata list> ::= <accel sdata>
4955 */
4956 case ACCEL_SDATA_LIST2:
4957 goto accel_data_list2;
4958
4959 /* ------------------------------------------------------------------ */
4960 /*
4961 * <accel sdata> ::= <accel sdata name> |
4962 */
4963 case ACCEL_SDATA1:
4964 goto accel_data2;
4965 /*
4966 * <accel sdata> ::= <constant>
4967 */
4968 case ACCEL_SDATA2:
4969 SST_ASTP(LHS, 0);
4970 break;
4971
4972 /* ------------------------------------------------------------------ */
4973 /*
4974 * <accel sub list> ::= <accel sub list> , <accel sub> |
4975 */
4976 case ACCEL_SUB_LIST1:
4977 itemp = (ITEM *)getitem(0, sizeof(ITEM));
4978 itemp->next = ITEM_END;
4979 itemp->t.stkp = SST_E1G(RHS(3));
4980 (SST_ENDG(RHS(1)))->next = itemp;
4981 SST_ENDP(LHS, itemp);
4982 break;
4983 /*
4984 * <accel sub list> ::= <accel sub>
4985 */
4986 case ACCEL_SUB_LIST2:
4987 itemp = (ITEM *)getitem(0, sizeof(ITEM));
4988 itemp->next = ITEM_END;
4989 itemp->t.stkp = SST_E1G(RHS(1));
4990 SST_BEGP(LHS, itemp);
4991 SST_ENDP(LHS, itemp);
4992 break;
4993
4994 /* ------------------------------------------------------------------ */
4995 /*
4996 * <accel sub> ::= <opt sub> : <opt sub> |
4997 */
4998 case ACCEL_SUB1:
4999 e1 = (SST *)getitem(sem.ssa_area, sizeof(SST));
5000 SST_IDP(e1, S_TRIPLE);
5001 SST_E1P(e1, (SST *)getitem(sem.ssa_area, sizeof(SST)));
5002 *(SST_E1G(e1)) = *RHS(1);
5003 SST_E2P(e1, (SST *)getitem(sem.ssa_area, sizeof(SST)));
5004 *(SST_E2G(e1)) = *RHS(3);
5005 SST_E3P(e1, (SST *)getitem(sem.ssa_area, sizeof(SST)));
5006 SST_IDP(SST_E3G(e1), S_NULL);
5007 SST_E1P(LHS, e1);
5008 SST_E2P(LHS, 0);
5009 break;
5010 /*
5011 * <accel sub> ::= <expression>
5012 */
5013 case ACCEL_SUB2:
5014 e1 = (SST *)getitem(sem.ssa_area, sizeof(SST));
5015 *e1 = *RHS(1);
5016 SST_E1P(LHS, e1);
5017 SST_E2P(LHS, 0);
5018 break;
5019 /* ------------------------------------------------------------------ */
5020 /*
5021 * <accel update dir> ::= ACCUPDATE <accel update list> |
5022 */
5023 case ACCEL_UPDATE_DIR1:
5024 break;
5025 /*
5026 * <accel update dir> ::= ACCUPDATEHOST ( <accel data list> ) <opt update
5027 *list> |
5028 */
5029 case ACCEL_UPDATE_DIR2:
5030 clause = CL_UPDATEHOST;
5031 op = 3;
5032 goto acc_update_clause_shared;
5033 break;
5034 /*
5035 * <accel update dir> ::= ACCUPDATESELF ( <accel data list> ) <opt update
5036 *list> |
5037 */
5038 case ACCEL_UPDATE_DIR3:
5039 clause = CL_UPDATESELF;
5040 op = 3;
5041 goto acc_update_clause_shared;
5042 /*
5043 * <accel update dir> ::= ACCUPDATEDEV ( <accel data list> ) <opt update
5044 *list> |
5045 */
5046 case ACCEL_UPDATE_DIR4:
5047 clause = CL_UPDATEDEV;
5048 op = 3;
5049 goto acc_update_clause_shared;
5050 break;
5051 /*
5052 * <accel update dir> ::= ACCUPDATEIN ( <accel data list> ) <opt update
5053 *list> |
5054 */
5055 case ACCEL_UPDATE_DIR5:
5056 clause = CL_UPDATEDEV;
5057 op = 3;
5058 goto acc_update_clause_shared;
5059 break;
5060 /*
5061 * <accel update dir> ::= ACCUPDATEOUT ( <accel data list> ) <opt update
5062 *list>
5063 */
5064 case ACCEL_UPDATE_DIR6:
5065 clause = CL_UPDATEHOST;
5066 op = 3;
5067 goto acc_update_clause_shared;
5068 break;
5069
5070 /* ------------------------------------------------------------------ */
5071 /*
5072 * <opt update list> ::= |
5073 */
5074 case OPT_UPDATE_LIST1:
5075 break;
5076 /*
5077 * <opt update list> ::= <accel update list>
5078 */
5079 case OPT_UPDATE_LIST2:
5080 break;
5081
5082 /* ------------------------------------------------------------------ */
5083 /*
5084 * <opt atomic type> ::= |
5085 */
5086 case OPT_ATOMIC_TYPE1:
5087 sem.mpaccatomic.action_type = ATOMIC_UPDATE;
5088 sem.mpaccatomic.mem_order = MO_UNDEF;
5089 break;
5090
5091 /*
5092 * <opt atomic type> ::= <pre seq_cst> UPDATE <post seq_cst> |
5093 */
5094 case OPT_ATOMIC_TYPE2:
5095 sem.mpaccatomic.action_type = ATOMIC_UPDATE;
5096 break;
5097
5098 /*
5099 * <opt atomic type> ::= <pre seq_cst> READ <post seq_cst> |
5100 */
5101 case OPT_ATOMIC_TYPE3:
5102 sem.mpaccatomic.action_type = ATOMIC_READ;
5103 break;
5104
5105 /*
5106 * <opt atomic type> ::= <pre seq_cst> WRITE <post seq_cst> |
5107 */
5108 case OPT_ATOMIC_TYPE4:
5109 sem.mpaccatomic.action_type = ATOMIC_WRITE;
5110 break;
5111
5112 /*
5113 * <opt atomic type> ::= <pre seq_cst> CAPTURE <post seq_cst> |
5114 */
5115 case OPT_ATOMIC_TYPE5:
5116 sem.mpaccatomic.action_type = ATOMIC_CAPTURE;
5117 (void)enter_dir(DI_ATOMIC_CAPTURE, FALSE, 0, 0);
5118 break;
5119 /*
5120 * <opt atomic type> ::= <seq cst>
5121 */
5122 case OPT_ATOMIC_TYPE6:
5123 sem.mpaccatomic.action_type = ATOMIC_UPDATE;
5124 break;
5125
5126 /* ------------------------------------------------------------------ */
5127 /*
5128 * <pre seq_cst> ::= |
5129 */
5130 case PRE_SEQ_CST1:
5131 break;
5132 /*
5133 * <pre seq_cst> ::= <seq cst> <opt comma>
5134 */
5135 case PRE_SEQ_CST2:
5136 break;
5137
5138 /* ------------------------------------------------------------------ */
5139 /*
5140 * <post seq_cst> ::= |
5141 */
5142 case POST_SEQ_CST1:
5143 break;
5144 /*
5145 * <post seq_cst> ::= <opt comma> <seq cst>
5146 */
5147 case POST_SEQ_CST2:
5148 break;
5149
5150 /* ------------------------------------------------------------------ */
5151 /*
5152 * <seq cst> ::= SEQ_CST
5153 */
5154 case SEQ_CST1:
5155 sem.mpaccatomic.mem_order = MO_SEQ_CST;
5156 break;
5157
5158 /* ------------------------------------------------------------------ */
5159 /*
5160 * <accel update list> ::= <accel update attr> |
5161 */
5162 case ACCEL_UPDATE_LIST1:
5163 break;
5164 /*
5165 * <accel update list> ::= <accel update list> <opt comma> <accel update
5166 *attr>
5167 */
5168 case ACCEL_UPDATE_LIST2:
5169 break;
5170
5171 /* ------------------------------------------------------------------ */
5172 /*
5173 * <accel update attr> ::= HOST ( <accel data list> ) |
5174 */
5175 case ACCEL_UPDATE_ATTR1:
5176 clause = CL_UPDATEHOST;
5177 op = 3;
5178 goto acc_update_clause_shared;
5179 /*
5180 * <accel update attr> ::= SELF ( <accel data list> ) |
5181 */
5182 case ACCEL_UPDATE_ATTR2:
5183 clause = CL_UPDATESELF;
5184 op = 3;
5185 goto acc_update_clause_shared;
5186 /*
5187 * <accel update attr> ::= DEVICE ( <accel data list> )
5188 */
5189 case ACCEL_UPDATE_ATTR3:
5190 clause = CL_UPDATEDEV;
5191 op = 3;
5192 goto acc_update_clause_shared;
5193 /*
5194 * <accel update attr> ::= ACCIN ( <accel data list> ) |
5195 */
5196 case ACCEL_UPDATE_ATTR4:
5197 clause = CL_UPDATEDEV;
5198 op = 3;
5199 goto acc_update_clause_shared;
5200 /*
5201 * <accel update attr> ::= ACCOUT ( <accel data list> )
5202 */
5203 case ACCEL_UPDATE_ATTR5:
5204 clause = CL_UPDATEHOST;
5205 op = 3;
5206 goto acc_update_clause_shared;
5207 /*
5208 * <accel update attr> ::= IF ( <expression> ) |
5209 */
5210 case ACCEL_UPDATE_ATTR6:
5211 break;
5212 /*
5213 * <accel update attr> ::= ASYNC |
5214 */
5215 case ACCEL_UPDATE_ATTR7:
5216 break;
5217 /*
5218 * <accel update attr> ::= ASYNC ( <expression> )
5219 */
5220 case ACCEL_UPDATE_ATTR8:
5221 break;
5222 /*
5223 * <accel update attr> ::= DEVICEID ( <expression> )
5224 */
5225 case ACCEL_UPDATE_ATTR9:
5226 break;
5227 /*
5228 * <accel update attr> ::= ACCWAIT |
5229 */
5230 case ACCEL_UPDATE_ATTR10:
5231 break;
5232 /*
5233 * <accel update attr> ::= ACCWAIT ( <accel wait list> )
5234 */
5235 case ACCEL_UPDATE_ATTR11:
5236 break;
5237 /*
5238 * <accel update attr> ::= ACCIFPRESENT
5239 */
5240 case ACCEL_UPDATE_ATTR12:
5241 break;
5242
5243 /* ------------------------------------------------------------------ */
5244 /*
5245 * <accel short update> ::= ACCUPDATEHOST ( <accel data list> ) |
5246 */
5247 case ACCEL_SHORT_UPDATE1:
5248 clause = CL_UPDATEHOST;
5249 op = 3;
5250 goto acc_update_clause_shared;
5251 /*
5252 * <accel short update> ::= ACCUPDATESELF ( <accel data list> ) |
5253 */
5254 case ACCEL_SHORT_UPDATE2:
5255 clause = CL_UPDATESELF;
5256 op = 3;
5257 goto acc_update_clause_shared;
5258 /*
5259 * <accel short update> ::= ACCUPDATEDEV ( <accel data list> ) |
5260 */
5261 case ACCEL_SHORT_UPDATE3:
5262 clause = CL_UPDATEDEV;
5263 op = 3;
5264 goto acc_update_clause_shared;
5265 /*
5266 * <accel short update> ::= ACCUPDATEIN ( <accel data list> ) |
5267 */
5268 case ACCEL_SHORT_UPDATE4:
5269 clause = CL_UPDATEDEV;
5270 op = 3;
5271 goto acc_update_clause_shared;
5272 /*
5273 * <accel short update> ::= ACCUPDATEOUT ( <accel data list> )
5274 */
5275 case ACCEL_SHORT_UPDATE5:
5276 clause = CL_UPDATEHOST;
5277 op = 3;
5278 goto acc_update_clause_shared;
5279 /* ------------------------------------------------------------------ */
5280 /*
5281 * <opt wait list> ::= |
5282 */
5283 case OPT_WAIT_LIST1:
5284 /* begin the pragma before the first argument */
5285 add_pragma(PR_ACCBEGINDIR, PR_NOSCOPE, 0);
5286 break;
5287 /*
5288 * <opt wait list> ::= ( <accel wait list> ) |
5289 */
5290 case OPT_WAIT_LIST2:
5291 break;
5292 /*
5293 * <opt wait list> ::= <opt wait list> <wait item>
5294 */
5295 case OPT_WAIT_LIST3:
5296 break;
5297 /* ------------------------------------------------------------------ */
5298 /*
5299 * <wait item> ::= IF ( <expression> )
5300 */
5301 case WAIT_ITEM1:
5302 break;
5303 /*
5304 * <wait item> ::= DEVICEID ( <expression> )
5305 */
5306 case WAIT_ITEM2:
5307 break;
5308 /*
5309 * <wait item> ::= ASYNC |
5310 */
5311 case WAIT_ITEM3:
5312 break;
5313 /*
5314 * <wait item> ::= ASYNC ( <expression> )
5315 */
5316 case WAIT_ITEM4:
5317 break;
5318
5319 /* ------------------------------------------------------------------ */
5320 /*
5321 * <accel wait list> ::= <expression> |
5322 */
5323 case ACCEL_WAIT_LIST1:
5324 break;
5325 /*
5326 * <accel wait list> ::= <accel wait list> , <expression>
5327 */
5328 case ACCEL_WAIT_LIST2:
5329 break;
5330
5331 /* ------------------------------------------------------------------ */
5332 /*
5333 * <kernel stmt> ::= <kernel begin> KERNEL DO <kernel do list>
5334 */
5335 case KERNEL_STMT1:
5336 SST_ASTP(LHS, 0);
5337 break;
5338
5339 /* ------------------------------------------------------------------ */
5340 /*
5341 * <kernel begin> ::=
5342 */
5343 case KERNEL_BEGIN1:
5344 parstuff_init();
5345 kernel_do_nest = 1;
5346 break;
5347
5348 /* ------------------------------------------------------------------ */
5349 /*
5350 * <kernel do list> ::= <kernel do nest> <kernel do shape> <kernel do args>
5351 */
5352 case KERNEL_DO_LIST1:
5353 break;
5354
5355 /* ------------------------------------------------------------------ */
5356 /*
5357 * <kernel do nest> ::= |
5358 */
5359 case KERNEL_DO_NEST1:
5360 kernel_do_nest = 1;
5361 break;
5362 /*
5363 * <kernel do nest> ::= ( ) |
5364 */
5365 case KERNEL_DO_NEST2:
5366 kernel_do_nest = 1;
5367 break;
5368 /*
5369 * <kernel do nest> ::= ( <expression> )
5370 */
5371 case KERNEL_DO_NEST3:
5372 kernel_do_nest = chkcon_to_isz(RHS(2), TRUE);
5373 break;
5374
5375 /* ------------------------------------------------------------------ */
5376 /*
5377 * <kernel do shape> ::= |
5378 */
5379 case KERNEL_DO_SHAPE1:
5380 CL_FIRST(CL_KERNEL_GRID) = NULL;
5381 CL_FIRST(CL_KERNEL_BLOCK) = NULL;
5382 break;
5383 /*
5384 * <kernel do shape> ::= '<<<' '>>>' |
5385 */
5386 case KERNEL_DO_SHAPE2:
5387 CL_FIRST(CL_KERNEL_GRID) = NULL;
5388 CL_FIRST(CL_KERNEL_BLOCK) = NULL;
5389 break;
5390 /*
5391 * <kernel do shape> ::= '<<<' <kernel do grid shape> , <kernel do block
5392 *shape> <kernel do args> '>>>'
5393 */
5394 case KERNEL_DO_SHAPE3:
5395 break;
5396
5397 /* ------------------------------------------------------------------ */
5398 /*
5399 * <kernel do grid shape> ::= |
5400 */
5401 case KERNEL_DO_GRID_SHAPE1:
5402 CL_FIRST(CL_KERNEL_GRID) = NULL;
5403 break;
5404 /*
5405 * <kernel do grid shape> ::= * |
5406 */
5407 case KERNEL_DO_GRID_SHAPE2:
5408 CL_FIRST(CL_KERNEL_GRID) = NULL;
5409 break;
5410 /*
5411 * <kernel do grid shape> ::= <expression> |
5412 */
5413 case KERNEL_DO_GRID_SHAPE3:
5414 chk_scalartyp(RHS(1), DT_INT4, FALSE);
5415 itemp = (ITEM *)getitem(0, sizeof(ITEM));
5416 itemp->next = ITEM_END;
5417 itemp->ast = SST_ASTG(RHS(1));
5418 CL_FIRST(CL_KERNEL_GRID) = itemp;
5419 CL_LAST(CL_KERNEL_GRID) = itemp;
5420 CL_PRESENT(CL_KERNEL_GRID) = 1;
5421 break;
5422 /*
5423 * <kernel do grid shape> ::= <elp> ) |
5424 */
5425 case KERNEL_DO_GRID_SHAPE4:
5426 itemp = (ITEM *)getitem(0, sizeof(ITEM));
5427 itemp->next = ITEM_END;
5428 itemp->ast = mk_cval(1, DT_INT);
5429 CL_FIRST(CL_KERNEL_GRID) = itemp;
5430 CL_LAST(CL_KERNEL_GRID) = itemp;
5431 CL_PRESENT(CL_KERNEL_GRID) = 1;
5432 break;
5433 /*
5434 * <kernel do grid shape> ::= <elp> * ) |
5435 */
5436 case KERNEL_DO_GRID_SHAPE5:
5437 CL_FIRST(CL_KERNEL_GRID) = NULL;
5438 break;
5439 /*
5440 * <kernel do grid shape> ::= <elp> <kernel shape list> )
5441 */
5442 case KERNEL_DO_GRID_SHAPE6:
5443 CL_FIRST(CL_KERNEL_GRID) = SST_BEGG(RHS(2));
5444 CL_LAST(CL_KERNEL_GRID) = SST_ENDG(RHS(2));
5445 CL_PRESENT(CL_KERNEL_GRID) = 1;
5446 break;
5447
5448 /* ------------------------------------------------------------------ */
5449 /*
5450 * <kernel do block shape> ::= |
5451 */
5452 case KERNEL_DO_BLOCK_SHAPE1:
5453 CL_FIRST(CL_KERNEL_BLOCK) = NULL;
5454 break;
5455 /*
5456 * <kernel do block shape> ::= * |
5457 */
5458 case KERNEL_DO_BLOCK_SHAPE2:
5459 CL_FIRST(CL_KERNEL_BLOCK) = NULL;
5460 break;
5461 /*
5462 * <kernel do block shape> ::= <expression> |
5463 */
5464 case KERNEL_DO_BLOCK_SHAPE3:
5465 chk_scalartyp(RHS(1), DT_INT4, FALSE);
5466 itemp = (ITEM *)getitem(0, sizeof(ITEM));
5467 itemp->next = ITEM_END;
5468 itemp->ast = SST_ASTG(RHS(1));
5469 CL_FIRST(CL_KERNEL_BLOCK) = itemp;
5470 CL_LAST(CL_KERNEL_BLOCK) = itemp;
5471 CL_PRESENT(CL_KERNEL_BLOCK) = 1;
5472 break;
5473 /*
5474 * <kernel do block shape> ::= <elp> ) |
5475 */
5476 case KERNEL_DO_BLOCK_SHAPE4:
5477 itemp = (ITEM *)getitem(0, sizeof(ITEM));
5478 itemp->next = ITEM_END;
5479 itemp->ast = mk_cval(1, DT_INT);
5480 CL_FIRST(CL_KERNEL_BLOCK) = itemp;
5481 CL_LAST(CL_KERNEL_BLOCK) = itemp;
5482 CL_PRESENT(CL_KERNEL_BLOCK) = 1;
5483 break;
5484 /*
5485 * <kernel do block shape> ::= <elp> * ) |
5486 */
5487 case KERNEL_DO_BLOCK_SHAPE5:
5488 CL_FIRST(CL_KERNEL_BLOCK) = NULL;
5489 break;
5490 /*
5491 * <kernel do block shape> ::= <elp> <kernel shape list> )
5492 */
5493 case KERNEL_DO_BLOCK_SHAPE6:
5494 CL_FIRST(CL_KERNEL_BLOCK) = SST_BEGG(RHS(2));
5495 CL_LAST(CL_KERNEL_BLOCK) = SST_ENDG(RHS(2));
5496 CL_PRESENT(CL_KERNEL_BLOCK) = 1;
5497 break;
5498
5499 /* ------------------------------------------------------------------ */
5500 /*
5501 * <kernel shape list> ::= <kernel shape expr> , <kernel shape expr> |
5502 */
5503 case KERNEL_SHAPE_LIST1:
5504 itemp = (ITEM *)getitem(0, sizeof(ITEM));
5505 itemp->next = (ITEM *)getitem(0, sizeof(ITEM));
5506 itemp->next->next = ITEM_END;
5507 itemp->ast = SST_ASTG(RHS(1));
5508 itemp->next->ast = SST_ASTG(RHS(3));
5509 SST_BEGP(LHS, itemp);
5510 SST_ENDP(LHS, itemp->next);
5511 break;
5512 /*
5513 * <kernel shape list> ::= <kernel shape list> , <kernel shape expr>
5514 */
5515 case KERNEL_SHAPE_LIST2:
5516 itemp = (ITEM *)getitem(0, sizeof(ITEM));
5517 itemp->next = ITEM_END;
5518 itemp->ast = SST_ASTG(RHS(3));
5519 (SST_ENDG(RHS(1)))->next = itemp;
5520 SST_ENDP(LHS, itemp);
5521 break;
5522
5523 /* ------------------------------------------------------------------ */
5524 /*
5525 * <kernel shape expr> ::= |
5526 */
5527 case KERNEL_SHAPE_EXPR1:
5528 SST_ASTP(LHS, mk_cval(1, DT_INT));
5529 break;
5530 /*
5531 * <kernel shape expr> ::= * |
5532 */
5533 case KERNEL_SHAPE_EXPR2:
5534 SST_ASTP(LHS, new_node(A_NULL));
5535 break;
5536 /*
5537 * <kernel shape expr> ::= <expression>
5538 */
5539 case KERNEL_SHAPE_EXPR3:
5540 chk_scalartyp(RHS(1), DT_INT, TRUE);
5541 break;
5542
5543 /* ------------------------------------------------------------------ */
5544 /*
5545 * <kernel do args> ::= |
5546 */
5547 case KERNEL_DO_ARGS1:
5548 kernel_argnum = 0;
5549 break;
5550 /*
5551 * <kernel do args> ::= <kernel do args> , <kernel do arg>
5552 */
5553 case KERNEL_DO_ARGS2:
5554 break;
5555
5556 /* ------------------------------------------------------------------ */
5557 /*
5558 * <kernel do arg> ::= |
5559 */
5560 case KERNEL_DO_ARG1:
5561 if (kernel_argnum >= 0)
5562 ++kernel_argnum;
5563 break;
5564 /*
5565 * <kernel do arg> ::= <expression> |
5566 */
5567 case KERNEL_DO_ARG2:
5568 if (kernel_argnum < 0) {
5569 error(155, 3, gbl.lineno,
5570 "Non-keyword CUF KERNEL DO argument may not "
5571 "follow a keyword argument",
5572 NULL);
5573 } else {
5574 ++kernel_argnum;
5575 /* first argument is shared memory, ignore it (should be zero)
5576 * second argument is stream argument */
5577 if (kernel_argnum == 1) {
5578 int astx, sptr;
5579 /* must be zero */
5580 astx = SST_ASTG(RHS(1));
5581 if (astx && A_TYPEG(astx) != A_CNST) {
5582 error(155, 3, gbl.lineno,
5583 "Shared memory value for CUF KERNEL DO must be zero", NULL);
5584 } else if (astx) {
5585 sptr = A_SPTRG(astx);
5586 if (STYPEG(sptr) != ST_CONST) {
5587 error(155, 3, gbl.lineno,
5588 "Shared memory value for CUF KERNEL DO must be zero", NULL);
5589 } else if (!DT_ISINT(DTYPEG(sptr))) {
5590 error(155, 3, gbl.lineno,
5591 "Shared memory value for CUF KERNEL DO must be zero", NULL);
5592 } else if (CONVAL1G(sptr) != 0 || CONVAL2G(sptr) != 0) {
5593 error(155, 3, gbl.lineno,
5594 "Shared memory value for CUF KERNEL DO must be zero", NULL);
5595 }
5596 }
5597 } else if (kernel_argnum == 2) {
5598 chk_scalartyp(RHS(1), DT_INT8, FALSE);
5599 itemp = (ITEM *)getitem(0, sizeof(ITEM));
5600 itemp->next = ITEM_END;
5601 itemp->ast = SST_ASTG(RHS(1));
5602 CL_FIRST(CL_STREAM) = itemp;
5603 CL_LAST(CL_STREAM) = itemp;
5604 CL_PRESENT(CL_STREAM) = 1;
5605 } else {
5606 error(155, 3, gbl.lineno, "Too many arguments in CUF KERNEL DO <<< >>>",
5607 NULL);
5608 }
5609 }
5610 break;
5611 /*
5612 * <kernel do arg> ::= <id name> = <expression>
5613 */
5614 case KERNEL_DO_ARG3:
5615 kernel_argnum = -1;
5616 if (strcmp(scn.id.name + SST_CVALG(RHS(1)), "stream") == 0) {
5617 if (CL_PRESENT(CL_STREAM)) {
5618 error(155, 3, gbl.lineno,
5619 "Two STREAM arguments to CUF KERNEL directive", "");
5620 } else {
5621 chk_scalartyp(RHS(3), DT_INT8, FALSE);
5622 itemp = (ITEM *)getitem(0, sizeof(ITEM));
5623 itemp->next = ITEM_END;
5624 itemp->ast = SST_ASTG(RHS(3));
5625 CL_FIRST(CL_STREAM) = itemp;
5626 CL_LAST(CL_STREAM) = itemp;
5627 CL_PRESENT(CL_STREAM) = 1;
5628 }
5629 } else if (strcmp(scn.id.name + SST_CVALG(RHS(1)), "device") == 0) {
5630 if (CL_PRESENT(CL_DEVICE)) {
5631 error(155, 3, gbl.lineno,
5632 "Two DEVICE arguments to CUF KERNEL directive", "");
5633 } else {
5634 chk_scalartyp(RHS(3), DT_INT8, FALSE);
5635 itemp = (ITEM *)getitem(0, sizeof(ITEM));
5636 itemp->next = ITEM_END;
5637 itemp->ast = SST_ASTG(RHS(3));
5638 CL_FIRST(CL_DEVICE) = itemp;
5639 CL_LAST(CL_DEVICE) = itemp;
5640 CL_PRESENT(CL_DEVICE) = 1;
5641 }
5642 } else {
5643 error(155, 3, gbl.lineno, "Unknown keyword to CUF KERNEL directive -",
5644 scn.id.name + SST_CVALG(RHS(1)));
5645 }
5646 break;
5647 /* ------------------------------------------------------------------ */
5648 /*
5649 * <opt accel init list> ::= |
5650 */
5651 case OPT_ACCEL_INIT_LIST1:
5652 break;
5653 /*
5654 * <opt accel init list> ::= <opt accel init list> <opt comma> <acc init
5655 *attr> |
5656 */
5657 case OPT_ACCEL_INIT_LIST2:
5658 break;
5659
5660 /* ------------------------------------------------------------------ */
5661 /*
5662 * <acc init attr> ::= DEVICE_NUM ( <expression> )
5663 */
5664 case ACC_INIT_ATTR1:
5665 break;
5666 /*
5667 * <acc init attr> ::= DEVICE_TYPE ( <devtype list> ) |
5668 */
5669 case ACC_INIT_ATTR2:
5670 break;
5671 /* ------------------------------------------------------------------ */
5672 /*
5673 * <accel setdev dir> ::= ACCSET <accel setdev list>
5674 */
5675 case ACCEL_SETDEV_DIR1:
5676 break;
5677 /*
5678 * <accel setdev list> ::= <accel setdev attr> |
5679 */
5680 case ACCEL_SETDEV_LIST1:
5681 break;
5682 /*
5683 * <accel setdev list> ::= <accel setdev list> <opt comma> <accel setdev
5684 *attr>
5685 */
5686 case ACCEL_SETDEV_LIST2:
5687 break;
5688
5689 /* ------------------------------------------------------------------ */
5690 /*
5691 * <accel setdev attr> ::= DEVICE_TYPE ( <ident> ) |
5692 */
5693 case ACCEL_SETDEV_ATTR1:
5694 break;
5695 /*
5696 * <accel setdev attr> ::= DEVICE_NUM ( <expression> ) |
5697 */
5698 case ACCEL_SETDEV_ATTR2:
5699 break;
5700 /*
5701 * <accel setdev attr> ::= DEFAULT_ASYNC ( <expression> )
5702 */
5703 case ACCEL_SETDEV_ATTR3:
5704 break;
5705
5706 /* ------------------------------------------------------------------ */
5707 /*
5708 * <opt accel shutdown list> ::= |
5709 */
5710 case OPT_ACCEL_SHUTDOWN_LIST1:
5711 break;
5712 /*
5713 * <opt accel shutdown list> ::= <opt accel shutdown list> <opt comma> <acc
5714 *shutdown attr> |
5715 */
5716 case OPT_ACCEL_SHUTDOWN_LIST2:
5717 break;
5718
5719 /* ------------------------------------------------------------------ */
5720 /*
5721 * <acc shutdown attr> ::= DEVICE_NUM ( <expression> ) |
5722 */
5723 case ACC_SHUTDOWN_ATTR1:
5724 break;
5725 /*
5726 * <acc shutdown attr> ::= DEVICE_TYPE ( <devtype list> )
5727 */
5728 case ACC_SHUTDOWN_ATTR2:
5729 break;
5730
5731 /*
5732 * <accel compare dir> ::= COMPARE ( <accel data list> )
5733 */
5734 case ACCEL_COMPARE_DIR1:
5735 clause = CL_ACCCOMPARE;
5736 op = 3;
5737 add_clause(clause, FALSE);
5738 if (CL_FIRST(clause) == NULL)
5739 CL_FIRST(clause) = SST_BEGG(RHS(op));
5740 else
5741 ((ITEM *)CL_LAST(clause))->next = SST_BEGG(RHS(op));
5742 CL_LAST(clause) = SST_ENDG(RHS(op));
5743 break;
5744
5745 /*
5746 * <pgi compare dir> ::= PGICOMPARE ( <accel data list> )
5747 */
5748 case PGI_COMPARE_DIR1:
5749 clause = CL_PGICOMPARE;
5750 op = 3;
5751 add_clause(clause, FALSE);
5752 if (CL_FIRST(clause) == NULL)
5753 CL_FIRST(clause) = SST_BEGG(RHS(op));
5754 else
5755 ((ITEM *)CL_LAST(clause))->next = SST_BEGG(RHS(op));
5756 CL_LAST(clause) = SST_ENDG(RHS(op));
5757 break;
5758 /* ------------------------------------------------------------------ */
5759 default:
5760 interr("semsmp: bad rednum ", rednum, 3);
5761 break;
5762 }
5763 }
5764
5765 void
parstuff_init(void)5766 parstuff_init(void)
5767 {
5768 int i;
5769
5770 chunk = 0;
5771 distchunk = 0;
5772 for (i = 0; i < CL_MAXV; i++) {
5773 CL_PRESENT(i) = 0;
5774 CL_VAL(i) = 0;
5775 CL_FIRST(i) = NULL;
5776 CL_LAST(i) = NULL;
5777 }
5778 recent_loop_clause = 0;
5779 any_pflsr_private = FALSE;
5780 mp_iftype = IF_DEFAULT;
5781 }
5782
5783 static void
add_clause(int clause,LOGICAL one_only)5784 add_clause(int clause, LOGICAL one_only)
5785 {
5786 if (CL_PRESENT(clause)) {
5787 if (one_only)
5788 error(155, 3, gbl.lineno, "Repeated clause -", CL_NAME(clause));
5789 } else
5790 CL_PRESENT(clause) = 1;
5791 }
5792
5793 static bool
clause_errchk(BIGINT64 bt,char * dirname)5794 clause_errchk(BIGINT64 bt, char *dirname)
5795 {
5796 int i;
5797 bool any = false;
5798
5799 for (i = 0; i < CL_MAXV; i++)
5800 if (CL_PRESENT(i)) {
5801 any = true;
5802 if (!(CL_STMT(i) & bt))
5803 error(533, 3, gbl.lineno, CL_NAME(i), dirname);
5804 }
5805 return any;
5806 }
5807
5808 static void
add_pragma(int pragmatype,int pragmascope,int pragmaarg)5809 add_pragma(int pragmatype, int pragmascope, int pragmaarg)
5810 {
5811 int ast;
5812
5813 ast = mk_stmt(A_PRAGMA, 0);
5814 A_PRAGMATYPEP(ast, pragmatype);
5815 A_PRAGMASCOPEP(ast, pragmascope);
5816 A_LOPP(ast, pragmaarg);
5817 (void)add_stmt(ast);
5818 }
5819
5820 static void
add_pragma2(int pragmatype,int pragmascope,int pragmaarg,int pragmaarg2)5821 add_pragma2(int pragmatype, int pragmascope, int pragmaarg, int pragmaarg2)
5822 {
5823 int ast;
5824
5825 ast = mk_stmt(A_PRAGMA, 0);
5826 A_PRAGMATYPEP(ast, pragmatype);
5827 A_PRAGMASCOPEP(ast, pragmascope);
5828 A_LOPP(ast, pragmaarg);
5829 A_ROPP(ast, pragmaarg2);
5830 (void)add_stmt(ast);
5831 }
5832
5833 static void
add_pragma3(int pragmatype,int pragmascope,int pragmaarg,int pragmaarg2,int pragmaarg3)5834 add_pragma3(int pragmatype, int pragmascope, int pragmaarg, int pragmaarg2,
5835 int pragmaarg3)
5836 {
5837 int ast;
5838
5839 ast = mk_stmt(A_PRAGMA, 0);
5840 A_PRAGMATYPEP(ast, pragmatype);
5841 A_PRAGMASCOPEP(ast, pragmascope);
5842 A_LOPP(ast, pragmaarg);
5843 A_ROPP(ast, pragmaarg2);
5844 A_PRAGMAARGP(ast, pragmaarg3);
5845 (void)add_stmt(ast);
5846 }
5847
5848 static void
add_pragmasyms(int pragmatype,int pragmascope,ITEM * itemp,int docopy)5849 add_pragmasyms(int pragmatype, int pragmascope, ITEM *itemp, int docopy)
5850 {
5851 int prtype = pragmatype;
5852 for (; itemp != ITEM_END; itemp = itemp->next) {
5853 int sptr, ast_devcopy = 0;
5854 sptr = memsym_of_ast(itemp->ast);
5855 if (docopy)
5856 prtype = itemp->t.cltype;
5857 #ifdef DEVCOPYG
5858 if (DEVCOPYG(sptr)) {
5859 if ((sem.parallel || sem.task || sem.target || sem.teams)) {
5860 int stblk;
5861 stblk = BLK_UPLEVEL_SPTR(sem.scope_level);
5862 if (!stblk)
5863 stblk = get_stblk_uplevel_sptr();
5864 mp_add_shared_var(DEVCOPYG(sptr), stblk);
5865 }
5866 ast_devcopy = mk_id(DEVCOPYG(sptr));
5867 }
5868 #endif
5869 add_pragma2(prtype, pragmascope, itemp->ast, ast_devcopy);
5870 }
5871 }
5872
5873 static void
add_reduction_pragmas(void)5874 add_reduction_pragmas(void)
5875 {
5876 REDUC *reducp;
5877 REDUC_SYM *reduc_symp;
5878 int accreduct_op, ast;
5879 char *name;
5880
5881 for (reducp = CL_FIRST(CL_REDUCTION); reducp; reducp = reducp->next) {
5882 switch (reducp->opr) {
5883 case 0: /* intrinsic */
5884 name = SYMNAME(reducp->intrin);
5885 if (strcmp(name, "max") == 0) {
5886 accreduct_op = PR_ACCREDUCT_OP_MAX;
5887 break;
5888 }
5889 if (strcmp(name, "min") == 0) {
5890 accreduct_op = PR_ACCREDUCT_OP_MIN;
5891 break;
5892 }
5893 if (strcmp(name, "iand") == 0) {
5894 accreduct_op = PR_ACCREDUCT_OP_BITAND;
5895 break;
5896 }
5897 if (strcmp(name, "ior") == 0) {
5898 accreduct_op = PR_ACCREDUCT_OP_BITIOR;
5899 break;
5900 }
5901 if (strcmp(name, "ieor") == 0) {
5902 accreduct_op = PR_ACCREDUCT_OP_BITEOR;
5903 break;
5904 }
5905 interr("add_reduction_pragmas - illegal intrinsic", reducp->intrin, 3);
5906 break;
5907 case OP_SUB:
5908 /* OP_SUB reduction operator: flag as PGI extension? */
5909 case OP_ADD:
5910 accreduct_op = PR_ACCREDUCT_OP_ADD;
5911 break;
5912 case OP_MUL:
5913 accreduct_op = PR_ACCREDUCT_OP_MUL;
5914 break;
5915 case OP_LOG:
5916 switch (reducp->intrin) {
5917 case OP_LAND:
5918 accreduct_op = PR_ACCREDUCT_OP_LOGAND;
5919 break;
5920 case OP_LEQV:
5921 accreduct_op = PR_ACCREDUCT_OP_EQV;
5922 break;
5923 case OP_LOR:
5924 accreduct_op = PR_ACCREDUCT_OP_LOGOR;
5925 break;
5926 case OP_LNEQV:
5927 accreduct_op = PR_ACCREDUCT_OP_NEQV;
5928 break;
5929 default:
5930 interr("add_reduction_pragmas - illegal log operator", reducp->intrin,
5931 3);
5932 }
5933 break;
5934 default:
5935 interr("add_reduction_pragmas - illegal operator", reducp->opr, 3);
5936 break;
5937 }
5938 ast = mk_stmt(A_PRAGMA, 0);
5939 A_PRAGMATYPEP(ast, PR_ACCREDUCTOP);
5940 A_PRAGMASCOPEP(ast, PR_NOSCOPE);
5941 A_PRAGMAVALP(ast, accreduct_op);
5942 (void)add_stmt(ast);
5943 for (reduc_symp = reducp->list; reduc_symp; reduc_symp = reduc_symp->next) {
5944 if (reduc_symp->shared == 0)
5945 /* error - illegal reduction variable */
5946 continue;
5947 add_pragma(PR_ACCREDUCTION, PR_NOSCOPE, mk_id(reduc_symp->shared));
5948 }
5949 }
5950 }
5951
5952 static void
add_wait_pragmas(ITEM * itemp)5953 add_wait_pragmas(ITEM *itemp)
5954 {
5955 if (!itemp) {
5956 add_pragma(PR_ACCWAIT, PR_NOSCOPE, 0);
5957 } else {
5958 for (; itemp; itemp = itemp->next) {
5959 add_pragma(PR_ACCWAITARG, PR_NOSCOPE, itemp->ast);
5960 }
5961 }
5962 CL_PRESENT(CL_WAIT) = 0;
5963 } /* add_wait_pragmas */
5964
5965 static void
accel_pragmagen(int pragma,int pragma1,int pragma2)5966 accel_pragmagen(int pragma, int pragma1, int pragma2)
5967 {
5968 }
5969
5970 static int
sched_type(char * nm)5971 sched_type(char *nm)
5972 {
5973 /* allow both the openmp & SGI schedule spellings */
5974 if (sem_strcmp(nm, "static") == 0 || sem_strcmp(nm, "simple") == 0 ||
5975 sem_strcmp(nm, "interleave") == 0 || sem_strcmp(nm, "interleaved") == 0)
5976 return DI_SCH_STATIC;
5977
5978 if (sem_strcmp(nm, "dynamic") == 0)
5979 return DI_SCH_DYNAMIC;
5980
5981 if (sem_strcmp(nm, "guided") == 0 || sem_strcmp(nm, "gss") == 0)
5982 return DI_SCH_GUIDED;
5983
5984 if (sem_strcmp(nm, "runtime") == 0)
5985 return DI_SCH_RUNTIME;
5986
5987 if (sem_strcmp(nm, "auto") == 0)
5988 return DI_SCH_AUTO;
5989
5990 error(34, 3, gbl.lineno, nm, CNULL);
5991 return DI_SCH_STATIC;
5992 }
5993
5994 /* return 1: parallel
5995 2: do
5996 3: taskgroup
5997 4: sections
5998 0: unknown
5999 */
6000 static int
cancel_type(char * nm)6001 cancel_type(char *nm)
6002 {
6003 if (sem_strcmp(nm, "parallel") == 0)
6004 return 1;
6005 else if (sem_strcmp(nm, "do") == 0)
6006 return 2;
6007 else if (sem_strcmp(nm, "sections") == 0)
6008 return 3;
6009 else if (sem_strcmp(nm, "taskgroup") == 0)
6010 return 4;
6011 else
6012 error(155, 3, gbl.lineno,
6013 "Unknown construct-type-clause in CANCEL construct", NULL);
6014 return 0;
6015 }
6016
6017 static int
get_iftype(int argcnt,char * nm1,char * nm2,char * nm3)6018 get_iftype(int argcnt, char *nm1, char *nm2, char *nm3)
6019 {
6020 switch (argcnt) {
6021 case 3:
6022 if (strcmp(nm1, "target") == 0) {
6023 if (strcmp(nm2, "exit") == 0) {
6024 if (strcmp(nm3, "data") == 0)
6025 return IF_TARGETEXITDATA;
6026 else
6027 error(155, ERR_Severe, gbl.lineno, "Unknown directive modifier", nm3);
6028 } else if (strcmp(nm2, "enter") == 0) {
6029 if (strcmp(nm3, "data") == 0)
6030 return IF_TARGETENTERDATA;
6031 else
6032 error(155, ERR_Severe, gbl.lineno, "Unknown directive modifier", nm3);
6033 } else {
6034 error(155, ERR_Severe, gbl.lineno, "Unknown directive modifier", nm2);
6035 }
6036 } else {
6037 error(155, ERR_Severe, gbl.lineno, "Unknown directive modifier", nm1);
6038 }
6039 break;
6040 case 2:
6041 if (strcmp(nm1, "target") == 0) {
6042 if (strcmp(nm2, "update") == 0)
6043 return IF_TARGETUPDATE;
6044 else if (strcmp(nm2, "data") == 0)
6045 return IF_TARGETDATA;
6046 else
6047 error(155, ERR_Severe, gbl.lineno, "Unknown directive modifier", nm2);
6048 } else {
6049 error(155, ERR_Severe, gbl.lineno, "Unknown directive modifier", nm1);
6050 }
6051 break;
6052 case 1:
6053 default:
6054 if (strcmp(nm1, "parallel") == 0)
6055 return IF_PARALLEL;
6056 else if (strcmp(nm1, "target") == 0)
6057 return IF_TARGET;
6058
6059 else if (strcmp(nm1, "task") == 0)
6060 return IF_TASK;
6061 else if (strcmp(nm1, "taskloop") == 0)
6062 return IF_TASKLOOP;
6063 else
6064 error(155, ERR_Severe, gbl.lineno, "Unknown directive modifier", nm1);
6065 }
6066 error(155, ERR_Severe, gbl.lineno, "Unknown directive modifier", nm1);
6067 return 0;
6068 }
6069
6070 static void
set_iftype(int argcnt,char * nm,char * nm2,char * nm3)6071 set_iftype(int argcnt, char *nm, char *nm2, char *nm3)
6072 {
6073 /* now check nm against current region */
6074
6075 int prev;
6076 int type;
6077 prev = sem.doif_depth;
6078
6079 type = get_iftype(argcnt, nm, nm2, nm3);
6080
6081 if (CL_PRESENT(CL_IF)) {
6082 if (mp_iftype == IF_DEFAULT)
6083 error(155, ERR_Severe, gbl.lineno,
6084 "At most one IF without directive-name-modifier can be present",
6085 NULL);
6086 else if (type == IF_DEFAULT && mp_iftype != IF_DEFAULT)
6087 error(155, ERR_Severe, gbl.lineno,
6088 "All IF must have directive-name-modifier", NULL);
6089 else if ((mp_iftype & type) == type)
6090 error(155, ERR_Severe, gbl.lineno,
6091 "At most one IF with same directive-name-modifier can be present",
6092 NULL);
6093 }
6094 mp_iftype = mp_iftype | type;
6095 }
6096
6097 static void
validate_if(int type,char * nm)6098 validate_if(int type, char *nm)
6099 {
6100 if (!CL_PRESENT(CL_IF)) {
6101 return;
6102 }
6103 switch (type) {
6104 case IF_TARGET:
6105 if ((mp_iftype != IF_DEFAULT) && (mp_iftype & type) != IF_TARGET) {
6106 error(155, ERR_Severe, gbl.lineno, "Unexpected directive in if clause",
6107 NULL);
6108 }
6109 break;
6110 case IF_TARGETUPDATE:
6111 if ((mp_iftype != IF_DEFAULT) && mp_iftype != IF_TARGETUPDATE) {
6112 error(155, ERR_Severe, gbl.lineno, "Unexpected directive in if clause",
6113 NULL);
6114 }
6115 break;
6116 case IF_TARGETDATA:
6117 if ((mp_iftype != IF_DEFAULT) && mp_iftype != IF_TARGETDATA) {
6118 error(155, ERR_Severe, gbl.lineno, "Unexpected directive in if clause",
6119 NULL);
6120 }
6121 break;
6122 case IF_TARGETENTERDATA:
6123 if ((mp_iftype != IF_DEFAULT) && mp_iftype != IF_TARGETENTERDATA) {
6124 error(155, ERR_Severe, gbl.lineno, "Unexpected directive in if clause",
6125 NULL);
6126 }
6127 break;
6128 case IF_TARGETEXITDATA:
6129 if ((mp_iftype != IF_DEFAULT) && mp_iftype != IF_TARGETEXITDATA) {
6130 error(155, ERR_Severe, gbl.lineno, "Unexpected directive in if clause",
6131 CNULL);
6132 }
6133 break;
6134 case IF_PARALLEL:
6135 if ((mp_iftype != IF_DEFAULT) && (mp_iftype & type) != IF_PARALLEL) {
6136 error(155, ERR_Severe, gbl.lineno, "Unexpected directive in if clause",
6137 NULL);
6138 }
6139 break;
6140 case IF_TASK:
6141 if ((mp_iftype != IF_DEFAULT) && (mp_iftype & type) != IF_TASK) {
6142 error(155, ERR_Severe, gbl.lineno, "Unexpected directive in if clause",
6143 NULL);
6144 }
6145 break;
6146 case IF_TASKLOOP:
6147 if ((mp_iftype != IF_DEFAULT) && (mp_iftype & type) != IF_TASKLOOP) {
6148 error(155, ERR_Severe, gbl.lineno, "Unexpected directive in if clause",
6149 NULL);
6150 }
6151 break;
6152 default:
6153 if (type == (IF_TARGET | IF_PARALLEL)) {
6154 if ((mp_iftype != IF_DEFAULT) &&
6155 ((mp_iftype & type) != (IF_TARGET | IF_PARALLEL))) {
6156 error(155, ERR_Severe, gbl.lineno, "Unexpected directive in if clause",
6157 NULL);
6158 }
6159 }
6160 }
6161 }
6162
6163 static int
get_stblk_uplevel_sptr()6164 get_stblk_uplevel_sptr()
6165 {
6166 int i;
6167 int sptr = BLK_UPLEVEL_SPTR(sem.scope_level);
6168 int scope = BLK_SCOPE_SPTR(sem.scope_level);
6169
6170 if (sptr == 0) {
6171 i = sem.scope_level;
6172 if (i > 0) {
6173 while (sptr == 0 && i) {
6174 sptr = BLK_UPLEVEL_SPTR(i);
6175 scope = BLK_SCOPE_SPTR(i);
6176 --i;
6177 }
6178 if (sptr == 0) {
6179 /* If we get here, this should really be an error */
6180 sptr = getccsym('b', sem.blksymnum++, ST_BLOCK);
6181 PARSYMSP(sptr, 0);
6182 llmp_create_uplevel(sptr);
6183 BLK_UPLEVEL_SPTR(sem.scope_level) = sptr;
6184 if (scope) {
6185 BLK_SCOPE_SPTR(sem.scope_level) = scope;
6186 PARUPLEVELP(scope, sptr);
6187 }
6188 } else {
6189 BLK_UPLEVEL_SPTR(sem.scope_level) = sptr;
6190 BLK_SCOPE_SPTR(sem.scope_level) = scope;
6191 }
6192 }
6193 }
6194 return sptr;
6195 }
6196
6197 static int
emit_btarget(int atype)6198 emit_btarget(int atype)
6199 {
6200 int opc;
6201 int ast, shast;
6202 int sptr, stblk;
6203
6204 ast = mk_stmt(atype, 0);
6205 sem.target++;
6206 if (CL_PRESENT(CL_IF)) {
6207 if (mp_iftype != OMP_DEFAULT && (mp_iftype & OMP_TARGET) != OMP_TARGET)
6208 error(155, 3, gbl.lineno,
6209 "IF (target:) or IF is expected in TARGET or "
6210 "combined TARGET construct ",
6211 NULL);
6212 else
6213 A_IFPARP(ast, CL_VAL(CL_IF));
6214 }
6215 if (CL_PRESENT(CL_DEPEND)) {
6216 }
6217 if (CL_PRESENT(CL_NOWAIT)) {
6218 }
6219 (void)add_stmt(ast);
6220 return ast;
6221 }
6222
6223 int
emit_etarget()6224 emit_etarget()
6225 {
6226 int ast;
6227 ast = mk_stmt(A_MP_ENDTARGET, 0);
6228
6229 if (sem.target < 0)
6230 sem.target = 0;
6231 (void)add_stmt(ast);
6232 return ast;
6233 }
6234
6235 static int
emit_bpar(void)6236 emit_bpar(void)
6237 {
6238 int opc;
6239 int ast, shast;
6240 int sptr, stblk;
6241
6242 if (sem.parallel++ == 0) {
6243 /* outermost parallel */
6244 opc = A_MP_PARALLEL;
6245 } else
6246 /* nested parallel */
6247 opc = A_MP_PARALLEL;
6248
6249 ast = mk_stmt(A_MP_PARALLEL, 0);
6250 A_ENDLABP(ast, 0);
6251 if (CL_PRESENT(CL_IF)) {
6252 if (mp_iftype != OMP_DEFAULT && (mp_iftype & OMP_PARALLEL) != OMP_PARALLEL)
6253 error(155, 3, gbl.lineno,
6254 "IF (parallel:) or IF is expected in PARALLEL "
6255 "or combined PARALLEL construct ",
6256 NULL);
6257 else
6258 A_IFPARP(ast, CL_VAL(CL_IF));
6259 }
6260 if (CL_PRESENT(CL_NUM_THREADS))
6261 A_NPARP(ast, CL_VAL(CL_NUM_THREADS));
6262
6263 /* PROC_BIND ast should be constant value */
6264 if (CL_PRESENT(CL_PROC_BIND)) {
6265 A_PROCBINDP(ast, CL_VAL(CL_PROC_BIND));
6266 }
6267
6268 (void)add_stmt(ast);
6269 return ast;
6270 }
6271
6272 int
emit_epar(void)6273 emit_epar(void)
6274 {
6275 int opc;
6276 int ast;
6277
6278 if (sem.parallel == 0)
6279 /* outermost parallel region */
6280 opc = A_MP_ENDPARALLEL;
6281 else {
6282 /* nested parallel */
6283 opc = A_MP_ENDPARALLEL;
6284 if (sem.parallel < 0)
6285 sem.parallel = 0;
6286 }
6287 ast = mk_stmt(A_MP_ENDPARALLEL, 0);
6288 (void)add_stmt(ast);
6289 return ast;
6290 }
6291
6292 int
emit_bcs_ecs(int opc)6293 emit_bcs_ecs(int opc)
6294 {
6295 int ast;
6296 #if DEBUG
6297 assert(opc == A_MP_CRITICAL || opc == A_MP_ENDCRITICAL,
6298 "emit_bcs_ecs - illegal opc", opc, 3);
6299 #endif
6300 ast = 0;
6301 /* If already in a critical section, don't create another one */
6302 if (DI_IN_NEST(sem.doif_depth, DI_CRITICAL) == 0) {
6303 ast = mk_stmt(opc, 0);
6304 (void)add_stmt(ast);
6305 }
6306 return ast;
6307 }
6308
6309 static void
do_schedule(int doif)6310 do_schedule(int doif)
6311 {
6312 int di_id;
6313 if (doif == 0)
6314 return;
6315
6316 DI_DISTCHUNK(doif) = 0;
6317 if (CL_PRESENT(CL_SCHEDULE) || CL_PRESENT(CL_MP_SCHEDTYPE)) {
6318 DI_SCHED_TYPE(doif) = CL_VAL(CL_SCHEDULE);
6319 if (chunk) {
6320 if (DI_SCHED_TYPE(doif) == DI_SCH_RUNTIME ||
6321 DI_SCHED_TYPE(doif) == DI_SCH_AUTO) {
6322 error(155, 3, gbl.lineno,
6323 "chunk size not allowed with SCHEDULE AUTO or RUNTIME", NULL);
6324 DI_CHUNK(doif) = 0;
6325 } else if (A_ALIASG(chunk))
6326 DI_CHUNK(doif) = chunk;
6327 else {
6328 int sptr;
6329 int ast;
6330 sptr = get_itemp(DT_INT);
6331 ENCLFUNCP(sptr, BLK_SYM(sem.scope_level));
6332 set_parref_flag(sptr, sptr, BLK_UPLEVEL_SPTR(sem.scope_level));
6333
6334 ast = mk_assn_stmt(mk_id(sptr), chunk, DT_INT);
6335 (void)add_stmt(ast);
6336 DI_CHUNK(doif) = A_DESTG(ast);
6337 }
6338 } else
6339 DI_CHUNK(doif) = 0;
6340 } else {
6341 /* default schedule */
6342 DI_SCHED_TYPE(doif) = DI_SCH_STATIC;
6343 if (XBIT(69, 0x08))
6344 DI_SCHED_TYPE(doif) = DI_SCH_DYNAMIC;
6345 else if (XBIT(69, 0x10))
6346 DI_SCHED_TYPE(doif) = DI_SCH_GUIDED;
6347 else if (XBIT(69, 0x20))
6348 DI_SCHED_TYPE(doif) = DI_SCH_RUNTIME;
6349 DI_CHUNK(doif) = 0;
6350 }
6351 DI_IS_ORDERED(doif) = CL_PRESENT(CL_ORDERED);
6352 DI_ISSIMD(doif) = 0;
6353 sem.collapse = 0;
6354 if (CL_PRESENT(CL_COLLAPSE)) {
6355 sem.collapse = CL_VAL(CL_COLLAPSE);
6356 }
6357 }
6358
6359 static void
do_dist_schedule(int doif,LOGICAL chk_collapse)6360 do_dist_schedule(int doif, LOGICAL chk_collapse)
6361 {
6362 int ast;
6363 if (doif == 0)
6364 return;
6365 if (CL_PRESENT(CL_DIST_SCHEDULE)) {
6366 if (distchunk) {
6367 if (A_ALIASG(distchunk))
6368 DI_DISTCHUNK(doif) = distchunk;
6369 else {
6370 int sptr;
6371 sptr = get_itemp(DT_INT);
6372 ENCLFUNCP(sptr, BLK_SYM(sem.scope_level));
6373 set_parref_flag(sptr, sptr, BLK_UPLEVEL_SPTR(sem.scope_level));
6374
6375 ast = mk_assn_stmt(mk_id(sptr), distchunk, DT_INT);
6376 (void)add_stmt(ast);
6377 DI_DISTCHUNK(doif) = A_DESTG(ast);
6378 }
6379 } else
6380 DI_DISTCHUNK(doif) = 0;
6381 } else {
6382 DI_DISTCHUNK(doif) = 0;
6383 }
6384 DI_CHUNK(doif) = DI_DISTCHUNK(doif);
6385 DI_SCHED_TYPE(doif) = DI_SCH_DIST_STATIC;
6386 DI_IS_ORDERED(doif) = CL_PRESENT(CL_ORDERED);
6387 DI_ISSIMD(doif) = 0;
6388 sem.collapse = 0;
6389 if (chk_collapse) {
6390 if (CL_PRESENT(CL_COLLAPSE))
6391 sem.collapse = CL_VAL(CL_COLLAPSE);
6392 }
6393 }
6394
6395 /* Handle distribute parallel do construct
6396 * We are making 2 loops:
6397 * 1) distribute loop
6398 * 2) parallel do loop
6399 */
6400 int
do_distbegin(DOINFO * doinfo,int do_label,int named_construct)6401 do_distbegin(DOINFO *doinfo, int do_label, int named_construct)
6402 {
6403 int iv, di_id, doif, sptr, initvar, limitvar, stepvar;
6404 int dast, dovar, step_expr;
6405 int past, aast;
6406 SST dsst, ssst;
6407
6408 iv = doinfo->index_var;
6409 if (!DT_ISINT(DTYPEG(iv))) {
6410 error(155, ERR_Severe, gbl.lineno,
6411 "The index variable of a distribute DO must be integer -",
6412 SYMNAME(iv));
6413 sem.expect_dist_do = FALSE;
6414 return do_begin(doinfo);
6415 } else if (sem.teams <= 0) {
6416 error(155, ERR_Severe, gbl.lineno,
6417 "DISTRIBUTE construct must be nested in TEAMS construct", NULL);
6418 sem.expect_dist_do = FALSE;
6419 return do_begin(doinfo);
6420 }
6421 doinfo->prev_dovar = DOVARG(iv);
6422 doinfo->distloop = LP_DISTPARDO;
6423 DOCHK(iv);
6424 DOVARP(iv, 1);
6425 step_expr = doinfo->step_expr;
6426
6427 /* Distribute loop */
6428 dast = mk_stmt(A_MP_PDO, 0 /* SST_ASTG(RHS(1)) BLOCKDO */);
6429 dovar = mk_id(iv);
6430
6431 /* need to store to bounds/stride so that we can put it in
6432 * uplevel struct for reference in parallel do
6433 */
6434 initvar = getccssym_sc("i", sem.itemps++, ST_VAR, SC_PRIVATE);
6435 DTYPEP(initvar, DTYPEG(iv));
6436 aast = mk_assn_stmt(mk_id(initvar), doinfo->init_expr, DTYPEG(initvar));
6437 add_stmt(aast);
6438
6439 limitvar = getccssym_sc("i", sem.itemps++, ST_VAR, SC_PRIVATE);
6440 DTYPEP(limitvar, DTYPEG(iv));
6441 aast = mk_assn_stmt(mk_id(limitvar), doinfo->limit_expr, DTYPEG(initvar));
6442 add_stmt(aast);
6443
6444 stepvar = getccssym_sc("i", sem.itemps++, ST_VAR, SC_PRIVATE);
6445 DTYPEP(stepvar, DTYPEG(iv));
6446 aast = mk_assn_stmt(mk_id(stepvar), doinfo->step_expr, DTYPEG(initvar));
6447 add_stmt(aast);
6448
6449 ENCLFUNCP(initvar, ENCLFUNCG(iv));
6450 ENCLFUNCP(limitvar, ENCLFUNCG(iv));
6451 ENCLFUNCP(stepvar, ENCLFUNCG(iv));
6452 DTYPEP(initvar, DTYPEG(iv));
6453 DTYPEP(limitvar, DTYPEG(iv));
6454 DTYPEP(stepvar, DTYPEG(iv));
6455 ASSNP(limitvar, 1);
6456 ASSNP(initvar, 1);
6457 ASSNP(stepvar, 1);
6458
6459 A_DOVARP(dast, dovar);
6460 A_M1P(dast, mk_id(initvar));
6461 A_M2P(dast, mk_id(limitvar));
6462
6463 if (A_TYPEG(step_expr) == A_CNST) {
6464 A_M3P(dast, step_expr);
6465 } else {
6466 A_M3P(dast, mk_id(stepvar));
6467 }
6468 A_CHUNKP(dast, DI_DISTCHUNK(sem.doif_depth));
6469 A_DISTCHUNKP(dast, DI_DISTCHUNK(sem.doif_depth));
6470 A_SCHED_TYPEP(dast, DI_SCHED_TYPE(sem.doif_depth));
6471 A_ORDEREDP(dast, DI_IS_ORDERED(sem.doif_depth));
6472 if (doinfo->lastval_var) {
6473 int lv_ast = mk_id(doinfo->lastval_var);
6474 A_LASTVALP(dast, lv_ast);
6475 } else {
6476 A_LASTVALP(dast, 0);
6477 }
6478 A_ENDLABP(dast, 0);
6479 A_DISTPARDOP(dast, 0);
6480 A_DISTRIBUTEP(dast, 1);
6481
6482 NEED_DOIF(doif, DI_DO);
6483 DI_DO_LABEL(doif) = do_label;
6484 DI_DO_AST(doif) = dast;
6485 DI_DOINFO(doif) = doinfo;
6486 DI_NAME(doif) = named_construct;
6487 direct_loop_enter();
6488 (void)add_stmt(dast);
6489
6490 /* simulate enter_dir(DI_PARDO...) */
6491 {
6492 int cur, prev;
6493 prev = sem.doif_depth;
6494 NEED_DOIF(cur, DI_PARDO);
6495 DI_REDUC(cur) = NULL;
6496 DI_LASTPRIVATE(cur) = NULL;
6497 DI_REGIONVARS(cur) = NULL;
6498 DI_ALLOCATED(cur) = NULL;
6499 DI_SECT_VAR(cur) = 0;
6500 }
6501 restore_clauses();
6502
6503 doif = sem.doif_depth;
6504 if (CL_PRESENT(CL_COLLAPSE))
6505 sem.collapse = CL_VAL(CL_COLLAPSE);
6506 sem.collapse_depth = sem.collapse;
6507 do_schedule(doif);
6508 sem.expect_do = TRUE;
6509 mk_lastprivate_list();
6510 if (has_team) { /* in same construct as teams */
6511 mk_reduction_list();
6512 mk_shared_list();
6513 has_team = FALSE;
6514 }
6515 mp_create_bscope(0);
6516 DI_BPAR(sem.doif_depth) = emit_bpar();
6517 par_push_scope(FALSE);
6518 begin_parallel_clause(sem.doif_depth);
6519
6520 set_parref_flag(initvar, initvar, BLK_UPLEVEL_SPTR(sem.scope_level));
6521 set_parref_flag(limitvar, limitvar, BLK_UPLEVEL_SPTR(sem.scope_level));
6522 ref_object(initvar);
6523 ref_object(limitvar);
6524 sptr = decl_private_sym(iv);
6525 DTYPEP(sptr, DTYPEG(iv));
6526
6527 doinfo = get_doinfo(1);
6528 doinfo->index_var = sptr;
6529 doinfo->init_expr = mk_id(initvar);
6530 doinfo->limit_expr = mk_id(limitvar);
6531 doinfo->distloop = LP_PARDO_OTHER;
6532 ADDRTKNP(initvar, 1);
6533 ADDRTKNP(limitvar, 1);
6534 ADDRTKNP(iv, 1);
6535 if (A_TYPEG(step_expr) == A_CNST) {
6536 doinfo->step_expr = step_expr;
6537 } else {
6538 ref_object(stepvar);
6539 doinfo->step_expr = mk_id(stepvar);
6540 ADDRTKNP(stepvar, 1);
6541 }
6542 sem.expect_do = FALSE;
6543 do_lastval(doinfo);
6544 if (sem.collapse_depth < 2) {
6545 sem.collapse_depth = 0;
6546 past = do_parbegin(doinfo);
6547 (void)add_stmt(past);
6548 dast = 0;
6549 } else {
6550 doinfo->collapse = sem.collapse_depth;
6551 past = collapse_begin(doinfo);
6552 dast = past;
6553 }
6554
6555 NEED_DOIF(doif, DI_DO);
6556 DI_DO_LABEL(doif) = 0;
6557 DI_DO_AST(doif) = past;
6558 DI_DOINFO(doif) = doinfo;
6559 DI_DO_LABEL(doif) = do_label;
6560 DI_NAME(doif) = named_construct;
6561 direct_loop_enter(); /* Check if we need this */
6562 A_DISTPARDOP(past, 1);
6563 A_ENDLABP(past, 0);
6564
6565 return dast;
6566 }
6567
6568 static void
do_private(void)6569 do_private(void)
6570 {
6571 ITEM *itemp;
6572
6573 if (CL_PRESENT(CL_PRIVATE))
6574 for (itemp = CL_FIRST(CL_PRIVATE); itemp != ITEM_END; itemp = itemp->next) {
6575 non_private_check(itemp->t.sptr, "PRIVATE");
6576 (void)decl_private_sym(itemp->t.sptr);
6577 }
6578 }
6579
6580
6581 static void
mk_firstprivate(int sptr1,int taskdupstd)6582 mk_firstprivate(int sptr1, int taskdupstd)
6583 {
6584 int savepar, savetask, saveteams, savetarget, sptr, std;
6585 SST tmpsst;
6586 if(sptr1 == SPTR_NULL)
6587 return;
6588 set_parref_flag(sptr1, sptr1, BLK_UPLEVEL_SPTR(sem.scope_level));
6589 non_private_check(sptr1, "FIRSTPRIVATE");
6590 (void)mk_storage(sptr1, &tmpsst);
6591 sptr = decl_private_sym(sptr1);
6592 {
6593 savepar = sem.parallel;
6594 savetask = sem.task;
6595 savetarget = sem.target;
6596 saveteams = sem.teams;
6597 sem.parallel = 0;
6598 sem.task = 0;
6599 sem.target = 0;
6600 sem.teams = 0;
6601 /* TODO: Task is done in above?
6602 * should not do for task here?
6603 */
6604
6605 std = 0;
6606 if (!POINTERG(sptr)) {
6607 if (!XBIT(54, 0x1) && ALLOCATTRG(sptr)) {
6608 std = sem.scope_stack[sem.scope_level].end_prologue;
6609 if (std == 0) {
6610 std = STD_PREV(0);
6611 }
6612 add_assignment_before(sptr, &tmpsst, std);
6613 } else {
6614 add_assignment(sptr, &tmpsst);
6615 }
6616 } else {
6617 add_ptr_assignment(sptr, &tmpsst);
6618 }
6619 sem.task = savetask;
6620 sem.teams = saveteams;
6621 saveteams = sem.teams;
6622 sem.target = savetarget;
6623 if (SC_BASED == SCG(sptr)) {
6624 add_firstprivate_assn(sptr, sptr1, taskdupstd);
6625 } else if (sem.task && TASKG(sptr)) {
6626 int ast = mk_stmt(A_MP_TASKFIRSTPRIV, 0);
6627 int sptr1_ast = mk_id(sptr1);
6628 int sptr_ast = mk_id(sptr);
6629 A_LOPP(ast, sptr1_ast);
6630 A_ROPP(ast, sptr_ast);
6631 add_stmt_after(ast, taskdupstd);
6632 }
6633 sem.parallel = savepar;
6634 }
6635 }
6636
6637 static void
do_firstprivate(int istask)6638 do_firstprivate(int istask)
6639 {
6640 ITEM *itemp;
6641 int ast, taskdupstd, cntfp = 0, maxfp = 50, sptr, i;
6642 SST tmpsst;
6643 int *fpsptr;
6644 LOGICAL isnew;
6645 taskdupstd = 0;
6646 NEW(fpsptr, int, maxfp);
6647 LLUplevel *uplevel;
6648 if (istask && sem.parallel) {
6649 uplevel = llmp_has_uplevel(get_stblk_uplevel_sptr());
6650 if (uplevel != NULL)
6651 uplevel = llmp_has_uplevel(uplevel->parent);
6652 if (uplevel != NULL) {
6653 if(maxfp < uplevel->vals_count)
6654 NEED(maxfp, fpsptr, int, maxfp, uplevel->vals_count);
6655 maxfp = uplevel->vals_count;
6656 for (i = 0; i < uplevel->vals_count; ++i) {
6657 sptr = uplevel->vals[i];
6658 if (sptr == SPTR_NULL)
6659 continue;
6660 if ((SCG(sptr) == SC_PRIVATE) ||
6661 (SDSCG(sptr) != 0 && SCG(SDSCG(sptr)) == SC_PRIVATE))
6662 fpsptr[cntfp++] = sptr;
6663 }
6664 }
6665 }
6666 if (CL_PRESENT(CL_FIRSTPRIVATE)) {
6667 for (itemp = CL_FIRST(CL_FIRSTPRIVATE); itemp != ITEM_END;
6668 itemp = itemp->next) {
6669 isnew = TRUE;
6670 sptr = itemp->t.sptr;
6671 for (i = 0; i < cntfp; ++i)
6672 if (fpsptr[i] == sptr) {
6673 isnew = FALSE;
6674 break;
6675 }
6676 if (isnew) {
6677 if (cntfp > maxfp) {
6678 NEED(maxfp, fpsptr, int, maxfp, maxfp + 100);
6679 maxfp = maxfp + 100;
6680 }
6681 fpsptr[cntfp++] = sptr;
6682 }
6683 }
6684 }
6685
6686 if(cntfp) {
6687 if (istask) {
6688 ast = mk_stmt(A_MP_TASKDUP, 0);
6689 taskdupstd = add_stmt(ast);
6690 }
6691 for(i=0;i<cntfp;++i)
6692 mk_firstprivate(fpsptr[i], taskdupstd);
6693 if (istask) {
6694 ast = mk_stmt(A_MP_ETASKDUP, 0);
6695 add_stmt(ast);
6696 }
6697 }
6698 FREE(fpsptr);
6699 }
6700
6701 static void
do_lastprivate(void)6702 do_lastprivate(void)
6703 {
6704 int sptr, curr_scope_level;
6705 REDUC_SYM *reduc_symp;
6706 SCOPESTACK *scope;
6707
6708 if (!CL_PRESENT(CL_LASTPRIVATE))
6709 return;
6710 for (reduc_symp = CL_FIRST(CL_LASTPRIVATE); reduc_symp;
6711 reduc_symp = reduc_symp->next) {
6712 sptr = reduc_symp->shared;
6713 if (sem.doif_depth > 1 && DI_ID(sem.doif_depth - 1) == DI_PAR &&
6714 SCG(sptr) == SC_PRIVATE && is_last_private(sptr) &&
6715 (DI_ID(sem.doif_depth) == DI_PARDO || DI_ID(sem.doif_depth) == DI_PDO ||
6716 DI_ID(sem.doif_depth) == DI_SINGLE ||
6717 DI_ID(sem.doif_depth) == DI_PARSECTS ||
6718 DI_ID(sem.doif_depth) == DI_PARWORKS ||
6719 DI_ID(sem.doif_depth) == DI_SECTS)) {
6720
6721 scope = curr_scope();
6722 while ((scope = next_scope(scope)) != 0) {
6723 if (scope->di_par == sem.doif_depth - 1) {
6724 if (SCOPEG(sptr) == scope->sptr)
6725 error(155, ERR_Severe, gbl.lineno, SYMNAME(sptr),
6726 "private variable may not appear in worksharing construct");
6727 }
6728 }
6729 }
6730
6731 set_parref_flag(reduc_symp->shared, reduc_symp->shared,
6732 BLK_UPLEVEL_SPTR(sem.scope_level));
6733 non_private_check(reduc_symp->shared, "LASTPRIVATE");
6734 reduc_symp->Private = decl_private_sym(reduc_symp->shared);
6735 }
6736 DI_LASTPRIVATE(sem.doif_depth) = CL_FIRST(CL_LASTPRIVATE);
6737 }
6738
6739 static void
mk_lastprivate_list(void)6740 mk_lastprivate_list(void)
6741 {
6742 int sptr, curr_scope_level;
6743 REDUC_SYM *reduc_symp;
6744 REDUC_SYM *first, *last, *tmp;
6745 SCOPESTACK *scope;
6746 first = last = NULL;
6747
6748 if (CL_PRESENT(CL_LASTPRIVATE)) {
6749 first = last = (REDUC_SYM *)getitem(0, sizeof(REDUC_SYM));
6750 for (reduc_symp = CL_FIRST(CL_LASTPRIVATE); reduc_symp;
6751 reduc_symp = reduc_symp->next) {
6752
6753 tmp = (REDUC_SYM *)getitem(1, sizeof(REDUC_SYM));
6754 tmp->shared = reduc_symp->Private;
6755 last->next = tmp;
6756 last = last->next;
6757 }
6758 last->next = NULL;
6759 first = first->next;
6760 }
6761 CL_FIRST(CL_LASTPRIVATE) = first;
6762 CL_LAST(CL_LASTPRIVATE) = last;
6763 }
6764
6765 static LOGICAL
validate_atomic_expr(int lop,int rop,int read)6766 validate_atomic_expr(int lop, int rop, int read)
6767 {
6768 int sptr;
6769 DTYPE dtype1, dtype2;
6770 if (sem.mpaccatomic.accassignc > 2) {
6771 error(155, ERR_Severe, gbl.lineno,
6772 "Too many statements in ATOMIC CONSTRUCT", CNULL);
6773 return FALSE;
6774 } else if (sem.mpaccatomic.accassignc > 1 &&
6775 sem.mpaccatomic.action_type != ATOMIC_CAPTURE) {
6776 error(155, ERR_Severe, gbl.lineno,
6777 "Too many statements in ATOMIC CONSTRUCT", CNULL);
6778 return FALSE;
6779 }
6780 {
6781 sptr = memsym_of_ast(lop);
6782 if (sptr && ALLOCATTRG(sptr)) {
6783 if (A_TYPEG(lop) != A_SUBSCR) {
6784 error(155, ERR_Severe, gbl.lineno,
6785 "Alloctable is not allowed on lhs in ATOMIC", CNULL);
6786 return FALSE;
6787 }
6788 }
6789 }
6790
6791 dtype1 = A_DTYPEG(lop);
6792 dtype2 = A_DTYPEG(rop);
6793
6794 if (!DT_ISSCALAR(dtype1) && !DT_ISSCALAR(dtype2)) {
6795 error(155, ERR_Severe, gbl.lineno,
6796 "Scalar intrinsic type is expected in ATOMIC", CNULL);
6797 return FALSE;
6798 }
6799
6800 if ((DTY(dtype1) == TY_DERIVED) || (DTY(dtype2) == TY_DERIVED)) {
6801 error(155, ERR_Severe, gbl.lineno,
6802 "Scalar intrinsic type is expected in ATOMIC", CNULL);
6803 return FALSE;
6804 }
6805 if (lop == rop) {
6806 error(155, ERR_Severe, gbl.lineno,
6807 "lhs and rhs must be distinctive locations in ATOMIC", CNULL);
6808 return FALSE;
6809 }
6810 return TRUE;
6811 }
6812
6813 static int
mk_atomic_read(int lop,int src)6814 mk_atomic_read(int lop, int src)
6815 {
6816 int ast = 0;
6817 if (is_valid_atomic_read(lop, src)) {
6818 ast = mk_atomic(A_MP_ATOMICREAD, 0, src, A_DTYPEG(src));
6819 A_MEM_ORDERP(ast, sem.mpaccatomic.mem_order);
6820 }
6821 return ast;
6822 }
6823
6824 static int
mk_atomic_write(int lop,int rop)6825 mk_atomic_write(int lop, int rop)
6826 {
6827 int ast = 0;
6828
6829 if (is_valid_atomic_write(lop, rop)) {
6830 ast = mk_stmt(A_MP_ATOMICWRITE, 0);
6831 A_LOPP(ast, lop);
6832 A_ROPP(ast, rop);
6833 A_MEM_ORDERP(ast, sem.mpaccatomic.mem_order);
6834 }
6835 return ast;
6836 }
6837
6838 static void
_is_atomic_update_binop(int rop,int * arg)6839 _is_atomic_update_binop(int rop, int *arg)
6840 {
6841 int lhs, rhs, cnt;
6842 int lop = arg[0];
6843 sem.mpaccatomic.rmw_op = AOP_UNDEF;
6844 cnt = 0;
6845 {
6846 if (A_TYPEG(rop) == A_BINOP) {
6847 switch (A_OPTYPEG(rop)) {
6848 case OP_ADD:
6849 sem.mpaccatomic.rmw_op = AOP_ADD;
6850 break;
6851 case OP_SUB:
6852 sem.mpaccatomic.rmw_op = AOP_SUB;
6853 break;
6854 case OP_MUL:
6855 sem.mpaccatomic.rmw_op = AOP_MUL;
6856 break;
6857 case OP_DIV:
6858 sem.mpaccatomic.rmw_op = AOP_DIV;
6859 break;
6860 case OP_LOR:
6861 sem.mpaccatomic.rmw_op = AOP_OR;
6862 break;
6863 case OP_LAND:
6864 sem.mpaccatomic.rmw_op = AOP_OR;
6865 break;
6866 case OP_LEQV:
6867 sem.mpaccatomic.rmw_op = AOP_EQV;
6868 break;
6869 case OP_LNEQV:
6870 sem.mpaccatomic.rmw_op = AOP_NEQV;
6871 break;
6872 default:
6873 return;
6874 }
6875 lhs = A_LOPG(rop);
6876 rhs = A_ROPG(rop);
6877 if (lop == lhs) {
6878 ++cnt;
6879 }
6880 if (lop == rhs) {
6881 ++cnt;
6882 }
6883 } else
6884 return;
6885 }
6886 arg[1] = arg[1] + cnt;
6887 }
6888
6889 static LOGICAL
is_atomic_update_binop(int lop,int rop)6890 is_atomic_update_binop(int lop, int rop)
6891 {
6892 int arg[2];
6893 ast_visit(1, 1);
6894 arg[0] = lop;
6895 arg[1] = 0;
6896 ast_traverse(rop, NULL, _is_atomic_update_binop, arg);
6897 ast_unvisit();
6898 if (arg[1] == 1) {
6899 return TRUE;
6900 } else if (arg[1] > 1) {
6901 sem.mpaccatomic.rmw_op = AOP_UNDEF;
6902 return TRUE;
6903 } else {
6904 return FALSE;
6905 }
6906 }
6907
6908 static LOGICAL
is_atomic_update_intr(int lop,int rop)6909 is_atomic_update_intr(int lop, int rop)
6910 {
6911 int lhs, rhs, cnt;
6912 int argcnt, argt, i;
6913 ATOMIC_RMW_OP aop_op = sem.mpaccatomic.rmw_op;
6914
6915 switch (aop_op) {
6916 case AOP_AND:
6917 case AOP_OR:
6918 case AOP_XOR:
6919 case AOP_MIN:
6920 case AOP_MAX:
6921 case AOP_EQV:
6922 case AOP_NEQV:
6923 break;
6924 default:
6925 error(155, ERR_Severe, gbl.lineno, "Unexpected ATOMIC UPDATE intrinsic",
6926 CNULL);
6927 sem.mpaccatomic.rmw_op = AOP_UNDEF;
6928 return FALSE;
6929 }
6930 argcnt = A_ARGCNTG(rop);
6931 argt = A_ARGSG(rop);
6932 cnt = 0;
6933 for (i = 0; i < argcnt; ++i) {
6934 if (lop == ARGT_ARG(argt, i))
6935 cnt++;
6936 }
6937 if (cnt == 0)
6938 return FALSE;
6939 else if (cnt > 1) {
6940 sem.mpaccatomic.rmw_op = AOP_UNDEF;
6941 return TRUE;
6942 } else
6943 return TRUE;
6944 }
6945
6946 static int
mk_atomic_update_binop(int lop,int rop)6947 mk_atomic_update_binop(int lop, int rop)
6948 {
6949 int ast;
6950
6951 if (is_atomic_update_binop(lop, rop)) {
6952 if (sem.mpaccatomic.rmw_op == AOP_UNDEF) {
6953 error(155, ERR_Severe, gbl.lineno, "Unexpected ATOMIC UPDATE statement",
6954 CNULL);
6955 return 0;
6956 }
6957 }
6958 ast = mk_stmt(A_MP_ATOMICUPDATE, 0);
6959 A_LOPP(ast, lop);
6960 A_ROPP(ast, rop);
6961
6962 A_OPTYPEP(ast, sem.mpaccatomic.rmw_op); /* AOP_ADD/SUB/... */
6963 A_MEM_ORDERP(ast, sem.mpaccatomic.mem_order);
6964 return ast;
6965 }
6966
6967 static int
mk_atomic_update_intr(int lop,int rop)6968 mk_atomic_update_intr(int lop, int rop)
6969 {
6970 int ast;
6971 ATOMIC_RMW_OP aop_op;
6972 MEMORY_ORDER mem_order = sem.mpaccatomic.mem_order;
6973
6974 if (is_atomic_update_intr(lop, rop)) {
6975 if (sem.mpaccatomic.rmw_op == AOP_UNDEF) {
6976 error(155, ERR_Severe, gbl.lineno, "Unexpected ATOMIC UPDATE statement ",
6977 CNULL);
6978 return 0;
6979 }
6980 }
6981 ast = mk_stmt(A_MP_ATOMICUPDATE, 0);
6982 A_LOPP(ast, lop);
6983 A_ROPP(ast, rop);
6984
6985 aop_op = sem.mpaccatomic.rmw_op;
6986 A_OPTYPEP(ast, aop_op); /* AOP_ADD/SUB/... */
6987 A_MEM_ORDERP(ast, mem_order);
6988
6989 return ast;
6990 }
6991
6992 static int
mk_atomic_capture(int lop,int rop)6993 mk_atomic_capture(int lop, int rop)
6994
6995 {
6996 int ast = 0;
6997 LOGICAL isupdate = FALSE;
6998 ATOMIC_RMW_OP aop_op;
6999 MEMORY_ORDER mem_order = sem.mpaccatomic.mem_order;
7000
7001 if (is_valid_atomic_capture(lop, rop)) {
7002 aop_op = sem.mpaccatomic.rmw_op;
7003 ast = mk_stmt(A_MP_ATOMICCAPTURE, 0);
7004 A_LOPP(ast, lop);
7005 A_ROPP(ast, rop);
7006 A_OPTYPEP(ast, aop_op); /* AOP_ADD/SUB/... */
7007 A_MEM_ORDERP(ast, mem_order);
7008 }
7009 return ast;
7010 }
7011
7012 int
do_openmp_atomics(SST * l_stktop,SST * r_stktop)7013 do_openmp_atomics(SST *l_stktop, SST *r_stktop)
7014 {
7015 int ast, opr, first, lop, rop, shape;
7016 int action_type = sem.mpaccatomic.action_type;
7017 LOGICAL atomic_ok = FALSE;
7018 DTYPE dtype;
7019 sem.mpaccatomic.apply = TRUE;
7020
7021 if (mklvalue(l_stktop, 1) == 0) {
7022 /* Avoid assignment ILM's if lvalue is illegal */
7023 error(155, 3, gbl.lineno, "Expect lvalue on lhs in ATOMIC CONSTRUCT",
7024 CNULL);
7025 return 0;
7026 }
7027 dtype = SST_DTYPEG(l_stktop);
7028 shape = SST_SHAPEG(l_stktop);
7029
7030 if (shape) {
7031 error(155, 3, gbl.lineno, "Expect scalar type in ATOMIC CONSTRUCT", CNULL);
7032 return 0;
7033 } else if (DTYG(dtype) == TY_STRUCT || DTYG(dtype) == TY_DERIVED ||
7034 DTY(dtype) == TY_ARRAY) {
7035 error(155, 3, gbl.lineno, "Expect scalar type in ATOMIC CONSTRUCT", CNULL);
7036 return 0;
7037 }
7038 ast = 0;
7039 lop = SST_ASTG(l_stktop);
7040
7041 switch (action_type) {
7042 case ATOMIC_UPDATE:
7043 mkexpr1(r_stktop);
7044 rop = SST_ASTG(r_stktop);
7045 atomic_ok = validate_atomic_expr(lop, rop, 0);
7046 if (atomic_ok) {
7047 if (A_TYPEG(rop) == A_BINOP)
7048 ast = mk_atomic_update_binop(lop, rop);
7049 else if (A_TYPEG(rop) == A_INTR)
7050 ast = mk_atomic_update_intr(lop, rop);
7051 else
7052 error(155, 3, gbl.lineno, "Invalid ATOMIC UPDATE statement", CNULL);
7053 }
7054 if (ast)
7055 (void)add_stmt(ast);
7056 sem.mpaccatomic.mem_order = MO_UNDEF;
7057 sem.mpaccatomic.rmw_op = AOP_UNDEF;
7058 sem.mpaccatomic.seen = FALSE;
7059 return 0;
7060 case ATOMIC_READ:
7061 if (mklvalue(r_stktop, 1) == 0) {
7062 error(155, 3, gbl.lineno, "Invalid ATOMIC READ", CNULL);
7063 }
7064 rop = SST_ASTG(r_stktop);
7065 ast = mk_atomic_read(lop, rop);
7066 mkexpr1(r_stktop);
7067 if (ast) {
7068 SST_ASTP(r_stktop, ast);
7069 }
7070 sem.mpaccatomic.mem_order = MO_UNDEF;
7071 sem.mpaccatomic.seen = FALSE;
7072 return ast;
7073
7074 case ATOMIC_WRITE:
7075 mkexpr1(r_stktop);
7076 rop = SST_ASTG(r_stktop);
7077 ast = mk_atomic_write(lop, rop);
7078 if (ast)
7079 (void)add_stmt(ast);
7080 sem.mpaccatomic.mem_order = MO_UNDEF;
7081 sem.mpaccatomic.seen = FALSE;
7082 return 0;
7083 case ATOMIC_CAPTURE:
7084 mkexpr1(r_stktop);
7085 rop = SST_ASTG(r_stktop);
7086 ast = mk_atomic_capture(lop, rop);
7087 if (ast)
7088 (void)add_stmt(ast);
7089 sem.mpaccatomic.rmw_op = AOP_UNDEF;
7090 return 0;
7091 default:
7092 break;
7093 }
7094 return ast;
7095 }
7096
7097 static LOGICAL
is_valid_atomic_update(int lop,int rop)7098 is_valid_atomic_update(int lop, int rop)
7099 {
7100 LOGICAL isvalid = TRUE;
7101
7102 if (!lop || !rop) {
7103 isvalid = FALSE;
7104 goto end_valid;
7105 }
7106 isvalid = validate_atomic_expr(lop, rop, 0);
7107 if (isvalid) {
7108 if (A_TYPEG(rop) == A_BINOP) {
7109 if (is_atomic_update_binop(lop, rop)) {
7110 if (sem.mpaccatomic.rmw_op == AOP_UNDEF) {
7111 isvalid = FALSE;
7112 goto end_valid;
7113 }
7114 }
7115 } else if (A_TYPEG(rop) == A_INTR) {
7116 if (is_atomic_update_intr(lop, rop)) {
7117 if (sem.mpaccatomic.rmw_op == AOP_UNDEF) {
7118 isvalid = FALSE;
7119 goto end_valid;
7120 }
7121 }
7122 } else {
7123 isvalid = FALSE;
7124 goto end_valid;
7125 }
7126 } else {
7127 return isvalid;
7128 }
7129 end_valid:
7130 if (!isvalid)
7131 error(155, 3, gbl.lineno, "Invalid ATOMIC UPDATE statement", CNULL);
7132 return isvalid;
7133 }
7134
7135 static LOGICAL
is_valid_atomic_read(int lop,int rop)7136 is_valid_atomic_read(int lop, int rop)
7137 {
7138 LOGICAL isvalid = TRUE;
7139
7140 if (!lop || !rop) {
7141 isvalid = FALSE;
7142 goto end_valid;
7143 }
7144 isvalid = validate_atomic_expr(lop, rop, 1);
7145
7146 end_valid:
7147 return isvalid;
7148 }
7149
7150 static LOGICAL
is_valid_atomic_write(int lop,int rop)7151 is_valid_atomic_write(int lop, int rop)
7152 {
7153 LOGICAL isvalid = TRUE;
7154
7155 if (!lop || !rop) {
7156 isvalid = FALSE;
7157 goto end_valid;
7158 }
7159 isvalid = validate_atomic_expr(lop, rop, 0);
7160
7161 end_valid:
7162 return isvalid;
7163 }
7164
7165 static LOGICAL
is_valid_atomic_capture(int lop,int rop)7166 is_valid_atomic_capture(int lop, int rop)
7167 {
7168 LOGICAL isvalid = TRUE;
7169 LOGICAL isupdate = FALSE;
7170
7171 if (!lop || !rop) {
7172 isvalid = FALSE;
7173 goto end_valid;
7174 }
7175 isvalid = validate_atomic_expr(lop, rop, 0);
7176 if (!isvalid)
7177 return isvalid;
7178
7179 if (A_TYPEG(rop) == A_BINOP) {
7180 isupdate = is_atomic_update_binop(lop, rop);
7181 if (isupdate && sem.mpaccatomic.rmw_op == AOP_UNDEF) {
7182 isvalid = FALSE;
7183 goto end_valid;
7184 }
7185 } else if (A_TYPEG(rop) == A_INTR) {
7186 isupdate = is_atomic_update_intr(lop, rop);
7187 if (isupdate && sem.mpaccatomic.rmw_op == AOP_UNDEF) {
7188 isvalid = FALSE;
7189 goto end_valid;
7190 }
7191 }
7192
7193 /* This could be just atomic write, make sure lhs is not in rhs */
7194 if (!isupdate) {
7195 if (contains_ast(rop, lop)) {
7196 isvalid = FALSE;
7197 goto end_valid;
7198 }
7199 }
7200
7201 end_valid:
7202 if (!isvalid)
7203 error(155, ERR_Severe, gbl.lineno, "Invalid ATOMIC CAPTURE statement ",
7204 CNULL);
7205 return isvalid;
7206 }
7207
7208 LOGICAL
validate_omp_atomic(SST * l_stktop,SST * r_stktop)7209 validate_omp_atomic(SST *l_stktop, SST *r_stktop)
7210 {
7211 SST lstk, rstk;
7212 int action_type = sem.mpaccatomic.action_type;
7213 lstk = *l_stktop;
7214 rstk = *r_stktop;
7215
7216 if (mklvalue(&lstk, 1) == 0) {
7217 error(155, 3, gbl.lineno, "Invalid ATOMIC statement: lhs", CNULL);
7218 return FALSE;
7219 }
7220 switch (action_type) {
7221 case ATOMIC_UPDATE:
7222 mkexpr1(&rstk);
7223 return is_valid_atomic_update(SST_ASTG(&lstk), SST_ASTG(&rstk));
7224 case ATOMIC_READ:
7225 return is_valid_atomic_read(SST_ASTG(&lstk), SST_ASTG(&rstk));
7226 case ATOMIC_WRITE:
7227 mkexpr1(&rstk);
7228 return is_valid_atomic_write(SST_ASTG(&lstk), SST_ASTG(&rstk));
7229 case ATOMIC_CAPTURE:
7230 mkexpr1(&rstk);
7231 return is_valid_atomic_capture(SST_ASTG(&lstk), SST_ASTG(&rstk));
7232 default:
7233 break;
7234 }
7235 return FALSE;
7236 }
7237
7238 static void
do_reduction(void)7239 do_reduction(void)
7240 {
7241 REDUC *reducp;
7242 REDUC_SYM *reduc_symp;
7243
7244 if (!CL_PRESENT(CL_REDUCTION))
7245 return;
7246
7247 for (reducp = CL_FIRST(CL_REDUCTION); reducp; reducp = reducp->next) {
7248 for (reduc_symp = reducp->list; reduc_symp; reduc_symp = reduc_symp->next) {
7249 int dtype, ast;
7250 INT val[2];
7251 INT conval;
7252 SST cnst;
7253 SST lhs;
7254 char *nm;
7255
7256 if (reduc_symp->shared == 0)
7257 /* error - illegal reduction variable */
7258 continue;
7259 reduc_symp->Private = decl_private_sym(reduc_symp->shared);
7260 set_parref_flag(reduc_symp->shared, reduc_symp->shared,
7261 BLK_UPLEVEL_SPTR(sem.scope_level));
7262 (void)mk_storage(reduc_symp->Private, &lhs);
7263 /*
7264 * emit the initialization of the private copy
7265 */
7266 dtype = DT_INT; /* assume the init constant is integer */
7267 switch (reducp->opr) {
7268 case 0: /* intrinsic */
7269 nm = SYMNAME(reducp->intrin);
7270 if (strcmp(nm, "max") == 0) {
7271 dtype = DTYPEG(reduc_symp->shared);
7272 dtype = DDTG(dtype);
7273 if (DT_ISINT(dtype)) {
7274 if (size_of(dtype) <= 4) {
7275 conval = 0x80000000;
7276 dtype = DT_INT;
7277 } else {
7278 val[0] = 0x80000000;
7279 val[1] = 0x00000000;
7280 conval = getcon(val, dtype);
7281 }
7282 } else if (dtype == DT_REAL)
7283 /* -3.402823466E+38 */
7284 conval = 0xff7fffff;
7285 else {
7286 /* -1.79769313486231571E+308 */
7287 val[0] = 0xffefffff;
7288 val[1] = 0xffffffff;
7289 conval = getcon(val, DT_DBLE);
7290 }
7291 break;
7292 }
7293 if (strcmp(nm, "min") == 0) {
7294 dtype = DTYPEG(reduc_symp->shared);
7295 dtype = DDTG(dtype);
7296 if (DT_ISINT(dtype)) {
7297 if (size_of(dtype) <= 4) {
7298 conval = 0x7fffffff;
7299 dtype = DT_INT;
7300 } else {
7301 val[0] = 0x7fffffff;
7302 val[1] = 0xffffffff;
7303 conval = getcon(val, dtype);
7304 }
7305 } else if (dtype == DT_REAL)
7306 /* 3.402823466E+38 */
7307 conval = 0x7f7fffff;
7308 else {
7309 /* 1.79769313486231571E+308 */
7310 val[0] = 0x7fefffff;
7311 val[1] = 0xffffffff;
7312 conval = getcon(val, DT_DBLE);
7313 }
7314 break;
7315 }
7316 if (strcmp(nm, "iand") == 0) {
7317 dtype = DTYPEG(reduc_symp->shared);
7318 dtype = DDTG(dtype);
7319 if (size_of(dtype) <= 4) {
7320 conval = 0xffffffff;
7321 dtype = DT_INT;
7322 } else {
7323 val[0] = 0xffffffff;
7324 val[1] = 0xffffffff;
7325 conval = getcon(val, dtype);
7326 }
7327 break;
7328 }
7329 if (strcmp(nm, "ior") == 0) {
7330 conval = 0;
7331 break;
7332 }
7333 if (strcmp(nm, "ieor") == 0) {
7334 conval = 0;
7335 break;
7336 }
7337 interr("do_reduction - illegal intrinsic", reducp->intrin, 0);
7338 break;
7339 case OP_ADD:
7340 case OP_SUB:
7341 conval = 0;
7342 break;
7343 case OP_MUL:
7344 conval = 1;
7345 break;
7346 case OP_LOG:
7347 dtype = DT_LOG;
7348 switch (reducp->intrin) {
7349 case OP_LAND:
7350 case OP_LEQV:
7351 conval = SCFTN_TRUE;
7352 break;
7353 case OP_LOR:
7354 case OP_LNEQV:
7355 conval = SCFTN_FALSE;
7356 break;
7357 default:
7358 interr("do_reduction - illegal log operator", reducp->intrin, 0);
7359 }
7360 break;
7361 default:
7362 interr("do_reduction - illegal operator", reducp->opr, 0);
7363 break;
7364 }
7365 SST_IDP(&cnst, S_CONST);
7366 SST_DTYPEP(&cnst, dtype);
7367 SST_CVALP(&cnst, conval);
7368 ast = mk_cval1(conval, dtype);
7369 SST_ASTP(&cnst, ast);
7370 (void)add_stmt(assign(&lhs, &cnst));
7371 }
7372 }
7373 DI_REDUC(sem.doif_depth) = CL_FIRST(CL_REDUCTION);
7374 }
7375
7376 static void
save_private_list(void)7377 save_private_list(void)
7378 {
7379 ITEM *tmp, *first, *last, *itemp;
7380 SAVCL_FIRST(CL_PRIVATE) = NULL;
7381 SAVCL_LAST(CL_PRIVATE) = NULL;
7382
7383 /* save private in a more permanent area for other construct */
7384 if (CL_PRESENT(CL_PRIVATE)) {
7385 last = first = (ITEM *)getitem(0, sizeof(ITEM));
7386 for (itemp = CL_FIRST(CL_PRIVATE); itemp != ITEM_END; itemp = itemp->next) {
7387 tmp = (ITEM *)getitem(1, sizeof(ITEM));
7388 tmp->t.sptr = itemp->t.sptr;
7389 last->next = tmp;
7390 last = last->next;
7391 }
7392 first = first->next;
7393 last->next = ITEM_END;
7394
7395 SAVCL_FIRST(CL_PRIVATE) = first;
7396 SAVCL_LAST(CL_PRIVATE) = last;
7397 }
7398 }
7399
7400 static void
save_firstprivate_list(void)7401 save_firstprivate_list(void)
7402 {
7403 ITEM *tmp, *first, *last, *itemp;
7404 SAVCL_FIRST(CL_FIRSTPRIVATE) = NULL;
7405 SAVCL_LAST(CL_FIRSTPRIVATE) = NULL;
7406
7407 if (CL_PRESENT(CL_FIRSTPRIVATE)) {
7408 last = first = (ITEM *)getitem(0, sizeof(ITEM));
7409 for (itemp = CL_FIRST(CL_FIRSTPRIVATE); itemp != ITEM_END;
7410 itemp = itemp->next) {
7411
7412 tmp = (ITEM *)getitem(1, sizeof(ITEM));
7413 tmp->t.sptr = itemp->t.sptr;
7414 last->next = tmp;
7415 last = last->next;
7416 }
7417 first = first->next;
7418 last->next = ITEM_END;
7419
7420 SAVCL_FIRST(CL_FIRSTPRIVATE) = first;
7421 SAVCL_LAST(CL_FIRSTPRIVATE) = last;
7422 }
7423 }
7424
7425 static void
save_shared_list(void)7426 save_shared_list(void)
7427 {
7428 ITEM *tmp, *first, *last, *itemp;
7429 SAVCL_FIRST(CL_SHARED) = NULL;
7430 SAVCL_LAST(CL_SHARED) = NULL;
7431 /* save shared in a more permanent area for other construct */
7432 if (CL_PRESENT(CL_SHARED)) {
7433 last = first = (ITEM *)getitem(0, sizeof(ITEM));
7434 for (itemp = CL_FIRST(CL_SHARED); itemp != ITEM_END; itemp = itemp->next) {
7435
7436 tmp = (ITEM *)getitem(1, sizeof(ITEM));
7437 tmp->t.sptr = itemp->t.sptr;
7438 last->next = tmp;
7439 last = last->next;
7440 }
7441 first = first->next;
7442 last->next = ITEM_END;
7443
7444 SAVCL_FIRST(CL_SHARED) = first;
7445 SAVCL_LAST(CL_SHARED) = last;
7446 }
7447 }
7448
7449 static void
mk_shared_list(void)7450 mk_shared_list(void)
7451 {
7452 ITEM *tmp, *first, *last, *itemp;
7453
7454 first = last = NULL;
7455
7456 if (CL_PRESENT(CL_SHARED)) {
7457 last = first = (ITEM *)getitem(0, sizeof(ITEM));
7458 for (itemp = CL_FIRST(CL_SHARED); itemp != ITEM_END; itemp = itemp->next) {
7459 /* get the current scope symbol */
7460 itemp->t.sptr = getsymbol(SYMNAME(itemp->t.sptr));
7461 last->next = itemp;
7462 last = last->next;
7463 }
7464 first = first->next;
7465 last->next = ITEM_END;
7466 }
7467 CL_FIRST(CL_SHARED) = first;
7468 CL_LAST(CL_SHARED) = last;
7469 }
7470
7471 static void
mk_reduction_list(void)7472 mk_reduction_list(void)
7473 {
7474 REDUC *reducp;
7475 REDUC_SYM *reduc_symp;
7476 REDUC *first, *last, *curr = NULL;
7477 REDUC_SYM *symp;
7478 REDUC_SYM *symp_last;
7479
7480 first = last = NULL;
7481 if (CL_PRESENT(CL_REDUCTION)) {
7482 first = last = (REDUC *)getitem(0, sizeof(REDUC));
7483 last->next = NULL;
7484 for (reducp = CL_FIRST(CL_REDUCTION); reducp; reducp = reducp->next) {
7485 curr = (REDUC *)getitem(1, sizeof(REDUC));
7486 curr->opr = reducp->opr;
7487 curr->intrin = reducp->intrin;
7488 last->next = curr;
7489 last = last->next;
7490
7491 curr->list = symp_last = (REDUC_SYM *)getitem(0, sizeof(REDUC_SYM));
7492 for (reduc_symp = reducp->list; reduc_symp;
7493 reduc_symp = reduc_symp->next) {
7494
7495 if (reduc_symp->shared == 0)
7496 continue;
7497
7498 symp = (REDUC_SYM *)getitem(1, sizeof(REDUC_SYM));
7499 symp->shared = reduc_symp->Private;
7500 symp_last->next = symp;
7501 symp_last = symp_last->next;
7502 }
7503 symp_last->next = NULL;
7504 curr->list = curr->list->next;
7505 }
7506 last->next = NULL;
7507 first = first->next;
7508 }
7509 CL_FIRST(CL_REDUCTION) = first;
7510 CL_LAST(CL_REDUCTION) = last;
7511 }
7512
7513 static void
do_copyin(void)7514 do_copyin(void)
7515 {
7516 ITEM *itemp;
7517 int sptr;
7518 int ast;
7519 int stblk;
7520
7521 if (CL_PRESENT(CL_COPYIN)) {
7522 ast = mk_stmt(A_MP_BCOPYIN, 0);
7523 (void)add_stmt(ast);
7524 for (itemp = CL_FIRST(CL_COPYIN); itemp != ITEM_END; itemp = itemp->next) {
7525 sptr = itemp->t.sptr;
7526 if (STYPEG(sptr) == ST_CMBLK) {
7527 if (!THREADG(sptr)) {
7528 error(155, 3, gbl.lineno, SYMNAME(sptr),
7529 "is not a THREADPRIVATE common block");
7530 continue;
7531 }
7532 } else if (SCG(sptr) == SC_CMBLK && !HCCSYMG(CMBLKG(sptr))) {
7533 sptr = refsym(sptr, OC_OTHER);
7534 if (!THREADG(CMBLKG(sptr))) {
7535 error(155, 3, gbl.lineno, SYMNAME(sptr),
7536 "is not a member of a THREADPRIVATE common block");
7537 continue;
7538 }
7539 } else if (!THREADG(sptr)) {
7540 error(155, 3, gbl.lineno, SYMNAME(sptr), "is not THREADPRIVATE");
7541 continue;
7542 }
7543 ast = mk_stmt(A_MP_COPYIN, 0);
7544 A_SPTRP(ast, sptr);
7545 if (!ALLOCATTRG(sptr))
7546 A_ROPP(ast, astb.i0);
7547 else
7548 A_ROPP(ast, size_of_allocatable(sptr));
7549 (void)add_stmt(ast);
7550 if ((sem.parallel || sem.task || sem.target || sem.teams)) {
7551 stblk = BLK_UPLEVEL_SPTR(sem.scope_level);
7552 if (!stblk)
7553 stblk = get_stblk_uplevel_sptr();
7554 mp_add_shared_var(sptr, stblk);
7555 /* add first element of common block to uplevel */
7556 if (CMEMFG(sptr)) {
7557 mp_add_shared_var(CMEMFG(sptr), stblk);
7558 }
7559 }
7560 }
7561 ast = mk_stmt(A_MP_ECOPYIN, 0);
7562 (void)add_stmt(ast);
7563 }
7564 }
7565
7566 static void
do_copyprivate()7567 do_copyprivate()
7568 {
7569 ITEM *itemp;
7570 int sptr;
7571 int ast;
7572
7573 if (CL_PRESENT(CL_COPYPRIVATE)) {
7574 ast = mk_stmt(A_MP_BCOPYPRIVATE, 0);
7575 (void)add_stmt(ast);
7576 for (itemp = CL_FIRST(CL_COPYPRIVATE); itemp != ITEM_END;
7577 itemp = itemp->next) {
7578 sptr = itemp->t.sptr;
7579 if (STYPEG(sptr) == ST_CMBLK) {
7580 if (!THREADG(sptr)) {
7581 error(155, 3, gbl.lineno, SYMNAME(sptr),
7582 "is not a THREADPRIVATE common block");
7583 continue;
7584 }
7585 } else if (SCG(sptr) == SC_CMBLK && !HCCSYMG(CMBLKG(sptr))) {
7586 sptr = refsym(sptr, OC_OTHER);
7587 if (!THREADG(CMBLKG(sptr))) {
7588 error(155, 3, gbl.lineno, SYMNAME(sptr),
7589 "is not a member of a THREADPRIVATE common block");
7590 continue;
7591 }
7592 }
7593 ast = mk_stmt(A_MP_COPYPRIVATE, 0);
7594 A_SPTRP(ast, sptr);
7595 if (!ALLOCATTRG(sptr))
7596 A_ROPP(ast, astb.i0);
7597 else
7598 A_ROPP(ast, size_of_allocatable(sptr));
7599 (void)add_stmt(ast);
7600 }
7601 ast = mk_stmt(A_MP_ECOPYPRIVATE, 0);
7602 (void)add_stmt(ast);
7603 }
7604 }
7605
7606 static void
do_map()7607 do_map()
7608 {
7609 if (!flg.omptarget)
7610 return;
7611
7612 ITEM *item;
7613 int ast;
7614 if (CL_PRESENT(CL_MAP)) {
7615 for (item = (ITEM *)CL_FIRST(CL_MAP); item != ITEM_END; item = item->next) {
7616 ast = mk_stmt(A_MP_MAP, 0);
7617 (void)add_stmt(ast);
7618 A_LOPP(ast, item->ast);
7619 A_PRAGMATYPEP(ast, item->t.cltype);
7620 // TODO ompaccel do later lower/upper bounds
7621 }
7622 }
7623 ast = mk_stmt(A_MP_EMAP, 0);
7624 (void)add_stmt(ast);
7625 }
7626
7627 static int
size_of_allocatable(int sptr)7628 size_of_allocatable(int sptr)
7629 {
7630 int nelems, dtype, dtyper, eltype;
7631 int ast;
7632
7633 ast = mk_id(sptr);
7634 dtype = DTYPEG(sptr);
7635 nelems = 0;
7636 if (size_of(DT_PTR) == 8) {
7637 dtyper = DT_INT8; /* 64-bit */
7638 } else {
7639 dtyper = DT_INT4; /* 32-bit */
7640 }
7641 if (DTY(dtype) == TY_ARRAY) {
7642 int argt, func_ast;
7643 argt = mk_argt(2);
7644 ARGT_ARG(argt, 0) = ast;
7645 ARGT_ARG(argt, 1) = astb.ptr0;
7646 func_ast = mk_id(intast_sym[I_SIZE]);
7647 nelems = mk_func_node(A_INTR, func_ast, 2, argt);
7648 A_DTYPEP(nelems, dtyper);
7649 A_DTYPEP(func_ast, dtyper);
7650 A_OPTYPEP(nelems, I_SIZE);
7651 eltype = DTY(dtype + 1);
7652 } else
7653 eltype = dtype;
7654 /* multiply by element type */
7655 if (eltype == DT_ASSCHAR || eltype == DT_ASSNCHAR || eltype == DT_DEFERCHAR ||
7656 eltype == DT_DEFERNCHAR) {
7657 ast = ast_intr(I_LEN, dtyper, 1, ast);
7658 } else
7659 ast = size_ast_of(ast, eltype);
7660 if (nelems)
7661 ast = mk_binop(OP_MUL, ast, nelems, dtyper);
7662
7663 return ast;
7664 }
7665
7666 /*
7667 * Process the DEFAULT clause -- this can only be done after all of the
7668 * clauses which may declare private variables have been processed.
7669 */
7670 static void
do_default_clause(int doif)7671 do_default_clause(int doif)
7672 {
7673 ITEM *itemp;
7674 int sptr;
7675 SCOPE_SYM *symlast, *symp;
7676
7677 /*
7678 * The DEFAULT scope is 'PRIVATE' or 'NONE'. Save away the default
7679 * scope value and process the symbols which appeared in all of the
7680 * SHARED clauses. The basic idea, if the default scope is not 'SHARED',
7681 * is to first look for symbols which were explicitly declared in the
7682 * current scope. Private variables, appearing in various clauses of the
7683 * current directive, have already been explicitly declared and have their
7684 * SCOPE fields set to the current scope. The function which will check
7685 * the scope of variables is sem_check_scope(); various semant functions,
7686 * such as ref_object() and ref_entry(), will call sem_check_scope().
7687 *
7688 * Variables appearing in the SHARED clause need to have their SCOPE
7689 * fields set to the current scope. But, when it's time to leave the
7690 * current scope, these symbols cannot be removed from the symbol table's
7691 * hash lists. Consequently, these variables need to have the scope
7692 * fields restored to their outer/previous values. These variables and
7693 * there previous scope values will be saved in a list which will be
7694 * processsed by semsym.c:sem_pop_scope().
7695 */
7696 if (CL_PRESENT(CL_DEFAULT) && CL_VAL(CL_DEFAULT) != PAR_SCOPE_SHARED) {
7697 sem.scope_stack[sem.scope_level].par_scope = CL_VAL(CL_DEFAULT);
7698 sem.scope_stack[sem.scope_level].end_prologue = STD_PREV(0);
7699 } else if (!CL_PRESENT(CL_DEFAULT) && DI_ID(doif) == DI_TASK) {
7700 /* TASK without a DEFAULT clause. Could have used
7701 * PAR_SCOPE_FIRSTPRIVATE, but decided to distinguish between the
7702 * presence of DEFAULT(FIRST_PRIVATE) and firstprivate implied by
7703 * TASK.
7704 */
7705 sem.scope_stack[sem.scope_level].par_scope = PAR_SCOPE_TASKNODEFAULT;
7706 sem.scope_stack[sem.scope_level].end_prologue = STD_PREV(0);
7707 }
7708
7709 if (!CL_PRESENT(CL_SHARED)) {
7710 return;
7711 }
7712 /*
7713 * create a fake SCOPE_SYM item (from area 0 freed during the end of
7714 * statement processing.
7715 */
7716 sem.scope_stack[sem.scope_level].shared_list = symlast =
7717 (SCOPE_SYM *)getitem(0, sizeof(SCOPE_SYM));
7718
7719 symlast->sptr = 0;
7720 for (itemp = CL_FIRST(CL_SHARED); itemp != ITEM_END; itemp = itemp->next) {
7721 sptr = itemp->t.sptr;
7722 /*
7723 * Need to keep the SCOPE_SYM items around until the end of the
7724 * parallel directive, so allocate them in area 1.
7725 */
7726 symlast->next = symp = (SCOPE_SYM *)getitem(1, sizeof(SCOPE_SYM));
7727 symp->sptr = sptr;
7728 /* save the scope of the variable */
7729 symp->scope = SCOPEG(sptr);
7730 symp->next = NULL;
7731 symlast = symp;
7732 /* set the scope to the current scope level */
7733 SCOPEP(sptr, sem.scope_stack[sem.scope_level].sptr);
7734 }
7735 /* skip past the fake SCOPE_SYM item */
7736 sem.scope_stack[sem.scope_level].shared_list =
7737 sem.scope_stack[sem.scope_level].shared_list->next;
7738 }
7739
7740 int
is_sptr_in_shared_list(int sptr)7741 is_sptr_in_shared_list(int sptr)
7742 {
7743 int region_level, current_level;
7744 SCOPE_SYM *list;
7745
7746 /* sem.scope_level may not be the same as SCOPEG
7747 * of the sptr, for example,
7748 * !$omp parallel shared(sptr) sem.scope_level
7749 * !$omp do sem.scope_level+1
7750 * if sptr is reference in do, we will miss it
7751 */
7752
7753 region_level = sem.scope_stack[sem.scope_level].rgn_scope;
7754 current_level = sem.scope_level;
7755 if (sem.scope_stack[current_level].kind == SCOPE_PAR) {
7756 while (current_level > 0 && current_level >= region_level) {
7757 list = sem.scope_stack[current_level].shared_list;
7758 for (; list; list = list->next) {
7759 if (list->sptr == sptr)
7760 return 1;
7761 }
7762 current_level--;
7763 }
7764 }
7765
7766 return 0;
7767 }
7768
7769 static void
begin_parallel_clause(int doif)7770 begin_parallel_clause(int doif)
7771 {
7772 {
7773 switch (DI_ID(doif)) {
7774 int sptr, ast;
7775 case DI_PARDO:
7776 break;
7777 case DI_PDO:
7778 ast = mk_stmt(A_MP_BPDO, 0);
7779 (void)add_stmt(ast);
7780 break;
7781 }
7782 }
7783
7784 switch (DI_ID(doif)) {
7785 case DI_PAR:
7786 case DI_PARDO:
7787 case DI_PDO:
7788 case DI_DOACROSS:
7789 case DI_SECTS:
7790 case DI_PARSECTS:
7791 case DI_SINGLE:
7792 case DI_PARWORKS:
7793 case DI_TASK:
7794 case DI_TASKLOOP:
7795 case DI_SIMD:
7796 case DI_TARGET:
7797 case DI_TEAMS:
7798 case DI_DISTRIBUTE:
7799 case DI_TEAMSDIST:
7800 case DI_TARGTEAMSDIST:
7801 case DI_DISTPARDO:
7802 case DI_TEAMSDISTPARDO:
7803 case DI_TARGTEAMSDISTPARDO:
7804 case DI_TARGPARDO:
7805 do_private();
7806 default:
7807 break;
7808 }
7809
7810 switch (DI_ID(doif)) {
7811 case DI_SINGLE:
7812 case DI_SECTS:
7813 case DI_PDO:
7814 case DI_SIMD:
7815 private_check();
7816
7817 case DI_PAR:
7818 case DI_PARDO:
7819 case DI_PARSECTS:
7820 case DI_PARWORKS:
7821 case DI_TASK:
7822 case DI_TASKLOOP:
7823 case DI_TARGET:
7824 case DI_TEAMS:
7825 case DI_DISTRIBUTE:
7826 case DI_TEAMSDIST:
7827 case DI_TARGTEAMSDIST:
7828 case DI_DISTPARDO:
7829 case DI_TARGTEAMSDISTPARDO:
7830 case DI_TEAMSDISTPARDO:
7831 case DI_TARGPARDO:
7832 do_firstprivate((DI_ID(doif) == DI_TASK || DI_ID(doif) == DI_TASKLOOP));
7833 default:
7834 break;
7835 }
7836
7837 switch (DI_ID(doif)) {
7838 case DI_PARDO:
7839 case DI_PDO:
7840 case DI_DOACROSS:
7841 case DI_SECTS:
7842 case DI_PARSECTS:
7843 case DI_SIMD:
7844 case DI_DISTRIBUTE:
7845 case DI_TEAMSDIST:
7846 case DI_TARGTEAMSDIST:
7847 case DI_DISTPARDO:
7848 case DI_TEAMSDISTPARDO:
7849 case DI_TARGTEAMSDISTPARDO:
7850 case DI_TARGPARDO:
7851 case DI_TASKLOOP:
7852 do_lastprivate();
7853 default:
7854 break;
7855 }
7856
7857 switch (DI_ID(doif)) {
7858 case DI_PAR:
7859 case DI_PARDO:
7860 case DI_TARGPARDO:
7861 case DI_PDO:
7862 case DI_DOACROSS:
7863 case DI_SECTS:
7864 case DI_PARSECTS:
7865 case DI_PARWORKS:
7866 case DI_SIMD:
7867 case DI_TEAMS:
7868 do_reduction();
7869 default:
7870 break;
7871 }
7872
7873 switch (DI_ID(doif)) {
7874 case DI_TARGET:
7875 do_map();
7876 break;
7877 default:
7878 break;
7879 }
7880
7881 switch (DI_ID(doif)) {
7882 case DI_PAR:
7883 case DI_PARDO:
7884 case DI_TARGPARDO:
7885 case DI_PARSECTS:
7886 case DI_PARWORKS:
7887 do_copyin();
7888 case DI_TASK:
7889 case DI_TASKLOOP:
7890 case DI_TEAMS:
7891 do_default_clause(doif);
7892 default:
7893 break;
7894 }
7895 }
7896
7897 void
end_parallel_clause(int doif)7898 end_parallel_clause(int doif)
7899 {
7900 /* combine reduction variables */
7901 switch (DI_ID(doif)) {
7902 case DI_PAR:
7903 case DI_PARDO:
7904 case DI_TARGPARDO:
7905 case DI_PDO:
7906 case DI_DOACROSS:
7907 case DI_PARSECTS:
7908 case DI_SECTS:
7909 case DI_PARWORKS:
7910 case DI_SIMD:
7911 case DI_TEAMS:
7912 end_reduction(DI_REDUC(doif), doif);
7913 default:
7914 break;
7915 }
7916
7917 /* last privates */
7918 switch (DI_ID(doif)) {
7919 case DI_PARDO:
7920 case DI_TARGPARDO:
7921 case DI_PDO:
7922 case DI_DOACROSS:
7923 case DI_PARSECTS:
7924 case DI_SECTS:
7925 case DI_SIMD:
7926 case DI_DISTRIBUTE:
7927 case DI_TEAMSDIST:
7928 case DI_TARGTEAMSDIST:
7929 case DI_DISTPARDO:
7930 case DI_TEAMSDISTPARDO:
7931 case DI_TARGTEAMSDISTPARDO:
7932 case DI_TASKLOOP:
7933 end_lastprivate(doif);
7934 break;
7935 default:
7936 break;
7937 }
7938
7939 /* deallocate any allocated privates */
7940 switch (DI_ID(doif)) {
7941 case DI_SINGLE:
7942 case DI_PAR:
7943 case DI_PARDO:
7944 case DI_TARGPARDO:
7945 case DI_PDO:
7946 case DI_DOACROSS:
7947 case DI_PARSECTS:
7948 case DI_SECTS:
7949 case DI_PARWORKS:
7950 case DI_TASK:
7951 case DI_TASKLOOP:
7952 case DI_TARGET:
7953 case DI_TEAMS:
7954 case DI_DISTRIBUTE:
7955 case DI_TEAMSDIST:
7956 case DI_TARGTEAMSDIST:
7957 case DI_DISTPARDO:
7958 case DI_TEAMSDISTPARDO:
7959 case DI_TARGTEAMSDISTPARDO:
7960 case DI_SIMD:
7961 deallocate_privates(doif);
7962 default:
7963 break;
7964 }
7965
7966 {
7967 switch (DI_ID(doif)) {
7968 int sptr, ast;
7969 case DI_PARDO:
7970 case DI_TARGPARDO:
7971 break;
7972 case DI_PDO:
7973 ast = mk_stmt(A_MP_EPDO, 0);
7974 (void)add_stmt(ast);
7975 break;
7976 }
7977 }
7978 }
7979
7980 static ATOMIC_RMW_OP
get_atomic_rmw_op(int op)7981 get_atomic_rmw_op(int op)
7982 {
7983 switch (op) {
7984 case OP_ADD:
7985 return AOP_ADD;
7986 case OP_SUB:
7987 return AOP_SUB;
7988 case OP_MUL:
7989 return AOP_MUL;
7990 case OP_DIV:
7991 return AOP_DIV;
7992 case OP_LOR:
7993 return AOP_OR;
7994 case OP_LAND:
7995 return AOP_AND;
7996 case OP_LEQV:
7997 return AOP_EQV;
7998 case OP_LNEQV:
7999 return AOP_NEQV;
8000 default:
8001 return AOP_UNDEF;
8002 }
8003 }
8004
8005 static void
gen_reduction(REDUC * reducp,REDUC_SYM * reduc_symp,LOGICAL rmme,LOGICAL in_parallel)8006 gen_reduction(REDUC *reducp, REDUC_SYM *reduc_symp, LOGICAL rmme,
8007 LOGICAL in_parallel)
8008 {
8009 int ast;
8010 LOGICAL nobar = FALSE;
8011 SST lhs;
8012 SST op1, opr, op2;
8013 SST intrin;
8014 ITEM *arg1, *arg2;
8015 int opc, sptr, encl, scope;
8016 LOGICAL noatomic = FALSE;
8017 int ast_crit = 0;
8018 int ast_endcrit = 0;
8019 ATOMIC_RMW_OP save_aop = sem.mpaccatomic.rmw_op;
8020
8021 if (rmme) {
8022 sptr = reduc_symp->shared;
8023 if (SCG(sptr) == SC_LOCAL && !in_parallel) {
8024 nobar = TRUE;
8025 } else if (SCG(sptr) == SC_PRIVATE) {
8026 encl = ENCLFUNCG(sptr);
8027 scope = BLK_SYM(sem.scope_level);
8028 if (encl == scope) {
8029 nobar = TRUE;
8030 } else {
8031 return;
8032 }
8033 } else {
8034 return;
8035 }
8036 }
8037 if (use_atomic_for_reduction(sem.doif_depth))
8038 add_stmt(mk_stmt(A_MP_ATOMIC, 0));
8039
8040 (void)mk_storage(reduc_symp->shared, &lhs);
8041 (void)mk_storage(reduc_symp->shared, &op1);
8042 (void)mk_storage(reduc_symp->Private, &op2);
8043 switch (opc = reducp->opr) {
8044 case 0: /* intrinsic - always 2 arguments */
8045 SST_IDP(&intrin, S_IDENT);
8046 SST_SYMP(&intrin, reducp->intrin);
8047 arg1 = (ITEM *)getitem(0, sizeof(ITEM));
8048 arg1->t.stkp = &op1;
8049 arg2 = (ITEM *)getitem(0, sizeof(ITEM));
8050 arg1->next = arg2;
8051 arg2->t.stkp = &op2;
8052 arg2->next = ITEM_END;
8053 /*
8054 * Generate:
8055 * shared <-- intrin(shared, private)
8056 */
8057 (void)ref_intrin(&intrin, arg1);
8058 if (use_atomic_for_reduction(sem.doif_depth) &&
8059 sem.mpaccatomic.rmw_op != AOP_UNDEF) {
8060 MEMORY_ORDER save_mem_order = sem.mpaccatomic.mem_order;
8061 sem.mpaccatomic.mem_order = MO_SEQ_CST;
8062 mklvalue(&lhs, 1);
8063 ast = SST_ASTG(&intrin);
8064 ast = mk_atomic_update_intr(SST_ASTG(&lhs), ast);
8065 (void)add_stmt(ast);
8066
8067 sem.mpaccatomic.rmw_op = save_aop;
8068 sem.mpaccatomic.mem_order = save_mem_order;
8069 add_stmt(mk_stmt(A_MP_ENDATOMIC, 0));
8070 goto end_reduction;
8071 } else {
8072 add_stmt(mk_stmt(A_MP_ENDATOMIC, 0));
8073 noatomic = TRUE;
8074 ast_crit = emit_bcs_ecs(A_MP_CRITICAL);
8075 }
8076
8077 (void)add_stmt(assign(&lhs, &intrin));
8078 goto end_reduction;
8079 case OP_SUB:
8080 opc = OP_ADD;
8081 /* fall thru */
8082 case OP_ADD:
8083 case OP_MUL:
8084 SST_OPTYPEP(&opr, opc);
8085 goto do_binop;
8086 case OP_LOG:
8087 SST_OPTYPEP(&opr, opc);
8088 opc = reducp->intrin;
8089 SST_OPCP(&opr, opc);
8090 /*
8091 * Generate:
8092 * shared <-- shared <op> private
8093 */
8094 do_binop:
8095
8096 binop(&op1, &op1, &opr, &op2);
8097 if (SST_IDG(&op1) == S_CONST) {
8098 ast = mk_cval1(SST_CVALG(&op1), (int)SST_DTYPEG(&op1));
8099 } else {
8100 ast = mk_binop(opc, SST_ASTG(&op1), SST_ASTG(&op2), SST_DTYPEG(&op1));
8101 }
8102 SST_ASTP(&op1, ast);
8103 SST_SHAPEP(&op1, A_SHAPEG(ast));
8104
8105 if (use_atomic_for_reduction(sem.doif_depth)&& get_atomic_rmw_op(opc) != AOP_UNDEF) {
8106 MEMORY_ORDER save_mem_order = sem.mpaccatomic.mem_order;
8107
8108 sem.mpaccatomic.rmw_op = get_atomic_rmw_op(opc);
8109 sem.mpaccatomic.mem_order = MO_SEQ_CST;
8110 mklvalue(&lhs, 1);
8111 ast = mk_atomic_update_binop(SST_ASTG(&lhs), ast);
8112 (void)add_stmt(ast);
8113
8114 sem.mpaccatomic.rmw_op = save_aop;
8115 sem.mpaccatomic.mem_order = save_mem_order;
8116 add_stmt(mk_stmt(A_MP_ENDATOMIC, 0));
8117 goto end_reduction;
8118 } else {
8119 add_stmt(mk_stmt(A_MP_ENDATOMIC, 0));
8120 ast_crit = emit_bcs_ecs(A_MP_CRITICAL);
8121 noatomic = TRUE;
8122 }
8123
8124 (void)add_stmt(assign(&lhs, &op1));
8125
8126 goto end_reduction;
8127 default:
8128 interr("end_reduction - illegal operator", reducp->opr, 0);
8129 goto end_reduction;
8130 }
8131 end_reduction:
8132 if (noatomic) {
8133 ast_endcrit = emit_bcs_ecs(A_MP_ENDCRITICAL);
8134 A_LOPP(ast_crit, ast_endcrit);
8135 A_LOPP(ast_endcrit, ast_crit);
8136 }
8137 if (nobar) {
8138 reduc_symp->shared = 0;
8139 }
8140 }
8141
8142 static void
end_reduction(REDUC * red,int doif)8143 end_reduction(REDUC *red, int doif)
8144 {
8145 REDUC *reducp;
8146 REDUC_SYM *reduc_symp;
8147 int ast_crit, ast_endcrit, ast_red;
8148 int save_par, save_target, save_teams;
8149 LOGICAL done = FALSE;
8150 LOGICAL in_parallel = FALSE;
8151
8152 if (red == NULL)
8153 return;
8154
8155 sem.ignore_default_none = TRUE;
8156 /*
8157 * Do not want ref_object() -> sem_check_scope() to apply any default
8158 * scoping rules of the variables referenced in the updates.
8159 * Could really use sem.ignore_default_scope.
8160 */
8161 save_par = sem.parallel;
8162 sem.parallel = 0;
8163 save_target = sem.target;
8164 sem.target = 0;
8165 save_teams = sem.teams;
8166 sem.teams = 0;
8167 in_parallel = (save_par || save_target || save_teams);
8168
8169 if (DI_ID(doif) == DI_SIMD) {
8170 for (reducp = red; reducp; reducp = reducp->next) {
8171 for (reduc_symp = reducp->list; reduc_symp;
8172 reduc_symp = reduc_symp->next) {
8173 if (reduc_symp->shared == 0)
8174 /* error - illegal reduction variable */
8175 continue;
8176 if (!use_atomic_for_reduction(sem.doif_depth) && !done) {
8177 ast_crit = emit_bcs_ecs(A_MP_CRITICAL);
8178 done = TRUE;
8179 }
8180 gen_reduction(reducp, reduc_symp, TRUE, in_parallel);
8181 }
8182 }
8183 }
8184
8185 for (reducp = red; reducp; reducp = reducp->next) {
8186 for (reduc_symp = reducp->list; reduc_symp; reduc_symp = reduc_symp->next) {
8187 if (reduc_symp->shared == 0)
8188 /* error - illegal reduction variable or set by loop above */
8189 continue;
8190 if (!use_atomic_for_reduction(sem.doif_depth) && !done) {
8191 #ifdef OMP_OFFLOAD_LLVM
8192 ast_red = mk_stmt(A_MP_BREDUCTION, 0);
8193 (void) add_stmt(ast_red);
8194 #endif
8195 ast_crit = emit_bcs_ecs(A_MP_CRITICAL);
8196 #ifdef OMP_OFFLOAD_LLVM
8197 if (!use_atomic_for_reduction(sem.doif_depth)) {
8198 A_ISOMPREDUCTIONP(ast_crit, 1);
8199 gen_reduction_ompaccel(reducp, reduc_symp, FALSE, in_parallel);
8200 }
8201 #endif
8202 done = TRUE;
8203 }
8204 gen_reduction(reducp, reduc_symp, FALSE, in_parallel);
8205 }
8206 }
8207
8208 sem.ignore_default_none = FALSE;
8209 sem.parallel = save_par;
8210 sem.target = save_target;
8211 sem.teams = save_teams;
8212 if (!use_atomic_for_reduction(sem.doif_depth)) {
8213 ast_endcrit = emit_bcs_ecs(A_MP_ENDCRITICAL);
8214 A_LOPP(ast_crit, ast_endcrit);
8215 A_LOPP(ast_endcrit, ast_crit);
8216 #ifdef OMP_OFFLOAD_LLVM
8217 A_ISOMPREDUCTIONP(ast_endcrit, 1);
8218 #endif
8219 #ifdef OMP_OFFLOAD_LLVM
8220 ast_red = mk_stmt(A_MP_EREDUCTION, 0);
8221 (void)add_stmt(ast_red);
8222 #endif
8223 }
8224 }
8225
8226 static void
end_lastprivate(int doif)8227 end_lastprivate(int doif)
8228 {
8229 REDUC_SYM *reduc_symp;
8230 int i1, i2;
8231 int lab;
8232 int sptr;
8233 INT val[2];
8234 int save_par, save_target, save_teams;
8235
8236 if (DI_LASTPRIVATE(doif) == NULL)
8237 return;
8238 lab = 0;
8239 switch (DI_ID(doif)) {
8240 case DI_SIMD:
8241 sptr = DI_DOINFO(doif + 1)->index_var;
8242 i1 = mk_id(sptr);
8243 sptr = DI_DOINFO(doif + 1)->lastval_var;
8244 i2 = mk_id(sptr);
8245 i1 = mk_binop(OP_EQ, i1, i2, DT_LOG4);
8246 i2 = mk_stmt(A_IFTHEN, 0);
8247 A_IFEXPRP(i2, i1);
8248 (void)add_stmt(i2);
8249 lab = 1;
8250 break;
8251 case DI_DISTRIBUTE:
8252 case DI_TEAMSDIST:
8253 case DI_TARGTEAMSDIST:
8254 case DI_DISTPARDO:
8255 case DI_TEAMSDISTPARDO:
8256 case DI_TARGTEAMSDISTPARDO:
8257 case DI_PARDO:
8258 case DI_TARGPARDO:
8259 case DI_PDO:
8260 case DI_DOACROSS:
8261 case DI_TASKLOOP:
8262 i1 = astb.k0;
8263 sptr = DI_DOINFO(doif + 1)->lastval_var;
8264 i2 = mk_id(sptr);
8265 i1 = mk_binop(OP_NE, i1, i2, DT_LOG4);
8266 i2 = mk_stmt(A_IFTHEN, 0);
8267 A_IFEXPRP(i2, i1);
8268 (void)add_stmt(i2);
8269 lab = 1;
8270 break;
8271 case DI_PARSECTS:
8272 case DI_SECTS:
8273 /* Todo: use p_last to determine which one is the last iteration */
8274 if ((sptr = DI_SECT_VAR(doif))) {
8275 i1 = mk_id(sptr);
8276 i2 = mk_cval1(DI_SECT_CNT(doif), DT_INT4);
8277 i1 = mk_binop(OP_EQ, i1, i2, DT_LOG4);
8278 i2 = mk_stmt(A_IFTHEN, 0);
8279 A_IFEXPRP(i2, i1);
8280 (void)add_stmt(i2);
8281 lab = 1;
8282 }
8283 break;
8284 }
8285
8286 sem.ignore_default_none = TRUE;
8287 /*
8288 * Do not want ref_object() -> sem_check_scope() to apply any default
8289 * scoping rules of the variables referenced in the updates.
8290 * Could really use sem.ignore_default_scope.
8291 */
8292 save_par = sem.parallel;
8293 sem.parallel = 0;
8294 save_target = sem.target;
8295 sem.target = 0;
8296 save_teams = sem.teams;
8297 sem.teams = 0;
8298 for (reduc_symp = DI_LASTPRIVATE(doif); reduc_symp;
8299 reduc_symp = reduc_symp->next) {
8300 SST tmpsst;
8301 (void)mk_storage(reduc_symp->Private, &tmpsst);
8302 if (!POINTERG(reduc_symp->shared))
8303 add_assignment(reduc_symp->shared, &tmpsst);
8304 else {
8305 add_ptr_assignment(reduc_symp->shared, &tmpsst);
8306 }
8307 }
8308 sem.ignore_default_none = FALSE;
8309 sem.parallel = save_par;
8310 sem.target = save_target;
8311 sem.teams = save_teams;
8312
8313 if (lab) {
8314 i2 = mk_stmt(A_ENDIF, 0);
8315 (void)add_stmt(i2);
8316 }
8317 }
8318
8319 #define IN_WRKSHR 0
8320 #define IN_PARALLEL 1
8321 static void
end_workshare(int s_std,int e_std)8322 end_workshare(int s_std, int e_std)
8323 {
8324 int std;
8325 int ast;
8326 int state = IN_WRKSHR;
8327 int parallellevel = 0;
8328 int lasterror = 0;
8329
8330 for (std = STD_NEXT(s_std); std && std != e_std; std = STD_NEXT(std)) {
8331 ast = STD_AST(std);
8332 switch (state) {
8333 case IN_WRKSHR:
8334 switch (A_TYPEG(ast)) {
8335 case A_FORALL:
8336 case A_ENDFORALL:
8337 case A_ASN:
8338 case A_WHERE:
8339 case A_ELSEWHERE:
8340 case A_ENDWHERE:
8341 case A_MP_CRITICAL:
8342 case A_MP_ENDCRITICAL:
8343 case A_MP_ATOMIC:
8344 case A_MP_ENDATOMIC:
8345 case A_MP_ATOMICREAD:
8346 case A_MP_ATOMICWRITE:
8347 case A_MP_ATOMICUPDATE:
8348 case A_MP_ATOMICCAPTURE:
8349 case A_MP_BMPSCOPE:
8350 case A_MP_EMPSCOPE:
8351 break;
8352 case A_MP_PARALLEL:
8353 parallellevel++;
8354 state = IN_PARALLEL;
8355 break;
8356 default:
8357 if (lasterror != STD_LINENO(std)) {
8358 error(155, 3, STD_LINENO(std),
8359 "Statement not allowed in WORKSHARE construct", NULL);
8360 lasterror = STD_LINENO(std);
8361 }
8362 break;
8363 }
8364 break;
8365 case IN_PARALLEL:
8366 switch (A_TYPEG(ast)) {
8367 case A_MP_PARALLEL:
8368 parallellevel++;
8369 break;
8370 case A_MP_ENDPARALLEL:
8371 if (--parallellevel == 0) {
8372 state = IN_WRKSHR;
8373 }
8374 break;
8375 }
8376 break;
8377 }
8378 }
8379 }
8380
8381 static void
do_btarget(int doif)8382 do_btarget(int doif)
8383 {
8384 mp_create_bscope(0);
8385 DI_BTARGET(doif) = emit_btarget(A_MP_TARGET);
8386 par_push_scope(TRUE);
8387 begin_parallel_clause(doif);
8388 }
8389
8390 static void
do_bteams(int doif)8391 do_bteams(int doif)
8392 {
8393 int ast, num_teams, thread_limit;
8394 mp_create_bscope(0);
8395
8396 num_teams = 0;
8397 thread_limit = 0;
8398 ast = mk_stmt(A_MP_TEAMS, 0);
8399 DI_BTEAMS(doif) = ast;
8400
8401 if (CL_PRESENT(CL_NUM_TEAMS)) {
8402 num_teams = CL_VAL(CL_NUM_TEAMS);
8403 }
8404 if (CL_PRESENT(CL_THREAD_LIMIT)) {
8405 thread_limit = CL_VAL(CL_THREAD_LIMIT);
8406 }
8407 A_NTEAMSP(ast, num_teams);
8408 A_THRLIMITP(ast, thread_limit);
8409 add_stmt(ast);
8410
8411 sem.teams++;
8412 par_push_scope(FALSE);
8413 begin_parallel_clause(doif);
8414 }
8415
8416 static void
do_bdistribute(int doif,LOGICAL chk_collapse)8417 do_bdistribute(int doif, LOGICAL chk_collapse)
8418 {
8419 int ast;
8420
8421 do_dist_schedule(doif, chk_collapse);
8422 ast = mk_stmt(A_MP_DISTRIBUTE, 0);
8423 DI_BDISTRIBUTE(doif) = ast;
8424 add_stmt(ast);
8425
8426 get_stblk_uplevel_sptr();
8427 par_push_scope(TRUE);
8428 get_stblk_uplevel_sptr();
8429 begin_parallel_clause(doif);
8430 }
8431
8432 static struct {
8433 int chunk;
8434 int distchunk;
8435 int mp_iftype;
8436 } sav_chk;
8437
8438 static void
save_clauses()8439 save_clauses()
8440 {
8441 int i, ast, sptr;
8442 for (i = 0; i < CL_MAXV; i++) {
8443 SAVCL_PRESENT(i) = CL_PRESENT(i);
8444 SAVCL_VAL(i) = CL_VAL(i);
8445 SAVCL_FIRST(i) = CL_FIRST(i);
8446 SAVCL_LAST(i) = CL_LAST(i);
8447 }
8448 sav_chk.chunk = chunk;
8449 sav_chk.distchunk = distchunk;
8450 sav_chk.mp_iftype = mp_iftype;
8451
8452 save_private_list();
8453 save_firstprivate_list();
8454 save_shared_list();
8455
8456 /* create tmp and store the value from ast to tmp */
8457 if (CL_PRESENT(CL_NUM_THREADS)) {
8458 sptr = get_itemp(DT_INT);
8459 ast = CL_VAL(CL_NUM_THREADS);
8460 ast = mk_assn_stmt(mk_id(sptr), ast, DT_INT);
8461 (void)add_stmt(ast);
8462 SAVCL_VAL(CL_NUM_THREADS) = sptr;
8463 }
8464 if (CL_PRESENT(CL_NUM_TEAMS)) {
8465 sptr = get_itemp(DT_INT);
8466 ast = CL_VAL(CL_NUM_TEAMS);
8467 ast = mk_assn_stmt(mk_id(sptr), ast, DT_INT);
8468 (void)add_stmt(ast);
8469 SAVCL_VAL(CL_NUM_TEAMS) = sptr;
8470 }
8471 if (CL_PRESENT(CL_THREAD_LIMIT)) {
8472 sptr = get_itemp(DT_INT);
8473 ast = CL_VAL(CL_THREAD_LIMIT);
8474 ast = mk_assn_stmt(mk_id(sptr), ast, DT_INT);
8475 (void)add_stmt(ast);
8476 SAVCL_VAL(CL_THREAD_LIMIT) = sptr;
8477 }
8478 if (CL_PRESENT(CL_IF)) {
8479 sptr = get_itemp(DT_INT);
8480 ast = CL_VAL(CL_IF);
8481 ast = mk_assn_stmt(mk_id(sptr), ast, DT_INT);
8482 (void)add_stmt(ast);
8483 SAVCL_VAL(CL_IF) = sptr;
8484 }
8485 if (CL_PRESENT(CL_SCHEDULE)) {
8486 if (chunk) {
8487 sptr = get_itemp(DT_INT);
8488 ast = chunk;
8489 ast = mk_assn_stmt(mk_id(sptr), ast, DT_INT);
8490 (void)add_stmt(ast);
8491 sav_chk.chunk = sptr;
8492 }
8493 }
8494 if (CL_PRESENT(CL_DIST_SCHEDULE)) {
8495 if (distchunk) {
8496 sptr = get_itemp(DT_INT);
8497 ast = distchunk;
8498 ast = mk_assn_stmt(mk_id(sptr), ast, DT_INT);
8499 (void)add_stmt(ast);
8500 sav_chk.distchunk = sptr;
8501 }
8502 }
8503
8504 /* todo: ordered(n) */
8505 }
8506
8507 static void
restore_clauses(void)8508 restore_clauses(void)
8509 {
8510 int i, ast, sptr;
8511 for (i = 0; i < CL_MAXV; i++) {
8512 CL_PRESENT(i) = SAVCL_PRESENT(i);
8513 CL_VAL(i) = SAVCL_VAL(i);
8514 CL_FIRST(i) = SAVCL_FIRST(i);
8515 CL_LAST(i) = SAVCL_LAST(i);
8516 }
8517 chunk = sav_chk.chunk;
8518 distchunk = sav_chk.distchunk;
8519 mp_iftype = sav_chk.mp_iftype;
8520 switch (DI_ID(sem.doif_depth)) {
8521 case DI_TARGET:
8522 if (CL_PRESENT(CL_IF) &&
8523 (mp_iftype == IF_DEFAULT || mp_iftype == IF_TARGET)) {
8524 sptr = CL_VAL(CL_IF);
8525 CL_VAL(CL_IF) = mk_id(sptr);
8526 set_parref_flag(sptr, sptr, BLK_UPLEVEL_SPTR(sem.scope_level));
8527 }
8528 break;
8529 case DI_TEAMS:
8530 if (CL_PRESENT(CL_NUM_TEAMS)) {
8531 sptr = CL_VAL(CL_NUM_TEAMS);
8532 CL_VAL(CL_NUM_TEAMS) = mk_id(sptr);
8533 set_parref_flag(sptr, sptr, BLK_UPLEVEL_SPTR(sem.scope_level));
8534 }
8535 if (CL_PRESENT(CL_THREAD_LIMIT)) {
8536 sptr = CL_VAL(CL_THREAD_LIMIT);
8537 CL_VAL(CL_THREAD_LIMIT) = mk_id(sptr);
8538 set_parref_flag(sptr, sptr, BLK_UPLEVEL_SPTR(sem.scope_level));
8539 }
8540 break;
8541 case DI_PARDO:
8542 case DI_TARGPARDO:
8543 if (CL_PRESENT(CL_NUM_THREADS)) {
8544 sptr = CL_VAL(CL_NUM_THREADS);
8545 CL_VAL(CL_NUM_THREADS) = mk_id(sptr);
8546 set_parref_flag(sptr, sptr, BLK_UPLEVEL_SPTR(sem.scope_level));
8547 }
8548 if (CL_PRESENT(CL_IF) &&
8549 (mp_iftype == IF_DEFAULT || mp_iftype == IF_PARALLEL)) {
8550 sptr = CL_VAL(CL_IF);
8551 CL_VAL(CL_IF) = mk_id(sptr);
8552 set_parref_flag(sptr, sptr, BLK_UPLEVEL_SPTR(sem.scope_level));
8553 }
8554 if (CL_PRESENT(CL_SCHEDULE)) {
8555 if (chunk) {
8556 sptr = sav_chk.chunk;
8557 chunk = mk_id(sptr);
8558 set_parref_flag(sptr, sptr, BLK_UPLEVEL_SPTR(sem.scope_level));
8559 }
8560 }
8561 break;
8562 case DI_PAR:
8563 if (CL_PRESENT(CL_NUM_THREADS)) {
8564 sptr = CL_VAL(CL_NUM_THREADS);
8565 CL_VAL(CL_NUM_THREADS) = mk_id(sptr);
8566 set_parref_flag(sptr, sptr, BLK_UPLEVEL_SPTR(sem.scope_level));
8567 }
8568 if (CL_PRESENT(CL_IF) &&
8569 (mp_iftype == IF_DEFAULT || mp_iftype == IF_PARALLEL)) {
8570 sptr = CL_VAL(CL_IF);
8571 CL_VAL(CL_IF) = mk_id(sptr);
8572 set_parref_flag(sptr, sptr, BLK_UPLEVEL_SPTR(sem.scope_level));
8573 }
8574 break;
8575 case DI_DISTRIBUTE:
8576 case DI_TEAMSDIST:
8577 case DI_TARGTEAMSDIST:
8578 case DI_DISTPARDO:
8579 case DI_TEAMSDISTPARDO:
8580 case DI_TARGTEAMSDISTPARDO:
8581 if (CL_PRESENT(CL_DIST_SCHEDULE)) {
8582 if (distchunk) {
8583 sptr = sav_chk.distchunk;
8584 distchunk = mk_id(sptr);
8585 set_parref_flag(sptr, sptr, BLK_UPLEVEL_SPTR(sem.scope_level));
8586 }
8587 }
8588 break;
8589 }
8590 }
8591
8592 /* handle begin combine constructs for target/teams/distribute/parallel/do
8593 */
8594 static void
begin_combine_constructs(BIGINT64 construct)8595 begin_combine_constructs(BIGINT64 construct)
8596 {
8597 int doif = sem.doif_depth;
8598 int ast, combinedMode;
8599 LOGICAL do_enter = FALSE;
8600
8601 has_team = FALSE;
8602 #if defined(OMP_OFFLOAD_LLVM) || defined(OMP_OFFLOAD_PGI)
8603 combinedMode = get_omp_combined_mode(construct);
8604 if (flg.omptarget) {
8605 if (!CL_PRESENT(CL_SCHEDULE)) {
8606 if (combinedMode == mode_target_teams_distribute_parallel_for_simd ||
8607 combinedMode == mode_target_teams_distribute_parallel_for)
8608 add_clause(CL_SCHEDULE, TRUE);
8609 CL_VAL(CL_SCHEDULE) = DI_SCH_STATIC;
8610 chunk = 3;
8611 }
8612 }
8613 #endif
8614 save_clauses();
8615
8616 if (BT_SIMD & construct) {
8617 apply_nodepchk(gbl.lineno, 1);
8618 }
8619
8620 if (BT_TARGET & construct) {
8621 do_btarget(sem.doif_depth);
8622 ast = DI_BTARGET(sem.doif_depth);
8623 #ifdef OMP_OFFLOAD_LLVM
8624 if (flg.omptarget) {
8625 if (combinedMode == mode_target_teams_distribute_parallel_for_simd) {
8626 errwarn(1203);
8627 combinedMode = mode_target_teams_distribute_parallel_for;
8628 } else if (combinedMode == mode_target_parallel_for_simd) {
8629 errwarn(1203);
8630 combinedMode = mode_target_parallel_for;
8631 } else if (combinedMode == mode_target_teams_distribute) {
8632 error(1202, ERR_Severe, gbl.lineno, "target teams distribute",
8633 "parallel do");
8634 } else if (combinedMode == mode_target_teams) {
8635 error(1202, ERR_Severe, gbl.lineno, "target teams",
8636 "distribute parallel do");
8637 }
8638 A_COMBINEDTYPEP(ast, combinedMode);
8639 }
8640 #endif
8641 do_enter = TRUE;
8642 }
8643 if (BT_TEAMS & construct) {
8644 if (do_enter) {
8645 parstuff_init();
8646 doif = enter_dir(DI_TEAMS, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
8647 }
8648 restore_clauses();
8649 do_bteams(sem.doif_depth);
8650 do_enter = TRUE;
8651 has_team = TRUE;
8652 }
8653 if (BT_DISTRIBUTE & construct) {
8654 if (do_enter) {
8655 parstuff_init();
8656 if ((BT_PARDO & construct)) {
8657 if (BT_TARGET & construct)
8658 doif = enter_dir(DI_TARGTEAMSDISTPARDO, TRUE, 0,
8659 DI_B(DI_ATOMIC_CAPTURE));
8660 else if (BT_TEAMS & construct)
8661 doif = enter_dir(DI_TEAMSDISTPARDO, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
8662 else
8663 doif = enter_dir(DI_DISTPARDO, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
8664 } else {
8665 if (BT_TARGET & construct)
8666 doif = enter_dir(DI_TARGTEAMSDIST, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
8667 else if (BT_TEAMS & construct)
8668 doif = enter_dir(DI_TEAMSDIST, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
8669 else
8670 doif = enter_dir(DI_DISTRIBUTE, TRUE, 0, DI_B(DI_ATOMIC_CAPTURE));
8671 }
8672 }
8673 restore_clauses();
8674 if ((BT_PARDO & construct))
8675 sem.expect_dist_do = TRUE;
8676 do_bdistribute(sem.doif_depth, !(BT_PARDO & construct));
8677
8678 /* need to push scope so that dovar is not the same as
8679 * lastprivate(dovar) for distributed parallel do loop
8680 */
8681 if ((BT_PARDO & construct)) {
8682 par_push_scope(TRUE);
8683 }
8684 return;
8685 }
8686 if ((BT_PARDO & construct)) {
8687 if (do_enter) {
8688 parstuff_init();
8689 doif = enter_dir(DI_PARDO, FALSE, 0, DI_B(DI_ATOMIC_CAPTURE));
8690 }
8691 do_schedule(doif);
8692 sem.expect_do = TRUE;
8693 restore_clauses();
8694 mp_create_bscope(0);
8695 DI_BPAR(doif) = emit_bpar();
8696 par_push_scope(FALSE);
8697 begin_parallel_clause(sem.doif_depth);
8698 }
8699 if (BT_PAR & construct) {
8700 if (do_enter) {
8701 parstuff_init();
8702 doif = enter_dir(DI_PAR, FALSE, 0, DI_B(DI_ATOMIC_CAPTURE));
8703 }
8704 mp_create_bscope(0);
8705 restore_clauses();
8706 DI_BPAR(doif) = emit_bpar();
8707 par_push_scope(FALSE);
8708 begin_parallel_clause(sem.doif_depth);
8709 return;
8710 }
8711 }
8712
8713 void
end_teams()8714 end_teams()
8715 {
8716 int doif, ast;
8717 end_parallel_clause(doif = sem.doif_depth);
8718 (void)leave_dir(DI_TEAMS, TRUE, 0);
8719 --sem.teams;
8720 par_pop_scope();
8721 if (doif) {
8722 ast = mk_stmt(A_MP_ENDTEAMS, 0);
8723 add_stmt(ast);
8724 A_LOPP(DI_BTEAMS(doif), ast);
8725 A_LOPP(ast, DI_BTEAMS(doif));
8726 mp_create_escope();
8727 }
8728 }
8729
8730 void
end_target()8731 end_target()
8732 {
8733 int doif, ast;
8734 end_parallel_clause(doif = sem.doif_depth);
8735 (void)leave_dir(DI_TARGET, TRUE, 0);
8736 sem.target--;
8737 par_pop_scope();
8738 if (doif) {
8739 ast = emit_etarget();
8740 mp_create_escope();
8741 A_LOPP(DI_BTARGET(doif), ast);
8742 A_LOPP(ast, DI_BTARGET(doif));
8743 }
8744 }
8745
8746 void
end_targteams()8747 end_targteams()
8748 {
8749 end_teams();
8750 end_target();
8751 }
8752
8753 static void
deallocate_privates(int doif)8754 deallocate_privates(int doif)
8755 {
8756 ITEM *itemp;
8757
8758 for (itemp = DI_ALLOCATED(doif); itemp != NULL; itemp = itemp->next) {
8759 gen_conditional_dealloc(ALLOCATTRG(itemp->t.sptr), mk_id(itemp->t.sptr),
8760 STD_PREV(0));
8761 }
8762 }
8763
8764 /**
8765 * This function includes the actions performed by the production
8766 * `<var ref> ::= <ident>` in the context of starting a parallel region
8767 * or in the context of a parallel region. In either case, the symbol
8768 * returned is the 'outer' symbol upon which the private symbol is
8769 * based.
8770 * In addition:
8771 * 1. if the symbol is a function entry, refer to its local variable,
8772 * 2. if the symbol is based, its associated pointer variable is
8773 * created.
8774 * 3. if the symbol is not yet a variable, it will be classified as if
8775 * it was declared in the outer/nonparallel region.
8776 */
8777 int
find_outer_sym(int sym)8778 find_outer_sym(int sym)
8779 {
8780 int sptr;
8781
8782 sptr = refsym(sym, OC_OTHER);
8783 if (STYPEG(sptr) != ST_PARAM) {
8784 if (!IS_INTRINSIC(STYPEG(sptr)) && STYPEG(sptr) != ST_PROC) {
8785 DCLCHK(sptr);
8786 }
8787 /* Pick up the data type from the symbol table entry which was
8788 * either: 1) explicitly set by the user, or 2) has the current
8789 * default value.
8790 */
8791 if (DTYPEG(sptr) == DT_NONE) {
8792 /* This is only okay if identifier is an intrinsic,
8793 * generic, or predeclared. This means the function was
8794 * used as an identifier without parenthesized arguments.
8795 */
8796 if (IS_INTRINSIC(STYPEG(sptr)))
8797 setimplicit(sptr);
8798 } else if (STYPEG(sptr) == ST_ENTRY && gbl.rutype == RU_FUNC)
8799 sptr = ref_entry(sptr);
8800 }
8801 if (IS_INTRINSIC(STYPEG(sptr))) {
8802 int sptr1;
8803 sptr1 = newsym(sptr);
8804 if (sptr1 != 0)
8805 sptr = sptr1;
8806 else {
8807 sptr = insert_sym(sptr);
8808 SCOPEP(sptr, stb.curr_scope);
8809 }
8810 }
8811 if (SCG(sptr) == SC_NONE)
8812 sem_set_storage_class(sptr);
8813 if (SCG(sptr) == SC_BASED)
8814 (void)ref_based_object(sptr);
8815
8816 switch (STYPEG(sptr)) {
8817 case ST_UNKNOWN:
8818 case ST_IDENT:
8819 STYPEP(sptr, ST_VAR);
8820 break;
8821 default:
8822 break;
8823 }
8824
8825 return sptr;
8826 }
8827
8828 int
mk_storage(int sptr,SST * stkp)8829 mk_storage(int sptr, SST *stkp)
8830 {
8831 #if DEBUG
8832 switch (STYPEG(sptr)) {
8833 case ST_UNKNOWN:
8834 case ST_IDENT:
8835 interr("mk_storage: stype should have been set", sptr, 2);
8836 STYPEP(sptr, ST_VAR);
8837 break;
8838 default:
8839 break;
8840 }
8841 #endif
8842 SST_IDP(stkp, S_IDENT);
8843 SST_DTYPEP(stkp, DTYPEG(sptr));
8844 SST_SYMP(stkp, sptr);
8845 SST_CVLENP(stkp, 0);
8846 SST_SHAPEP(stkp, 0);
8847
8848 return SST_SYMG(stkp);
8849 }
8850
8851 /* x <== y, x is x's symbol table entry; y_stkp is a pointer to y's SST */
8852 static void
add_assignment_before(int x,SST * y_stkp,int std)8853 add_assignment_before(int x, SST *y_stkp, int std)
8854 {
8855 SST x_sst;
8856
8857 SST_IDP(&x_sst, S_IDENT);
8858 SST_DTYPEP(&x_sst, DTYPEG(x));
8859 SST_SYMP(&x_sst, x);
8860 SST_ASTP(&x_sst, 0);
8861 (void)add_stmt_before(assign(&x_sst, y_stkp), std);
8862 }
8863
8864 /* x <== y, x is x's symbol table entry; y_stkp is a pointer to y's SST */
8865 static void
add_assignment(int x,SST * y_stkp)8866 add_assignment(int x, SST *y_stkp)
8867 {
8868 SST x_sst;
8869
8870 SST_IDP(&x_sst, S_IDENT);
8871 SST_DTYPEP(&x_sst, DTYPEG(x));
8872 SST_SYMP(&x_sst, x);
8873 SST_ASTP(&x_sst, 0);
8874 (void)add_stmt(assign(&x_sst, y_stkp));
8875 }
8876
8877 /* x => y, x is x's symbol table entry; y_stkp is a pointer to y's SST */
8878 static void
add_ptr_assignment(int x,SST * y_stkp)8879 add_ptr_assignment(int x, SST *y_stkp)
8880 {
8881 SST x_sst;
8882
8883 SST_IDP(&x_sst, S_IDENT);
8884 SST_DTYPEP(&x_sst, DTYPEG(x));
8885 SST_SYMP(&x_sst, x);
8886 SST_ASTP(y_stkp, mk_id(SST_SYMG(y_stkp)));
8887 (void)add_stmt(assign_pointer(&x_sst, y_stkp));
8888 }
8889
8890 /** \brief Add an assignment to the parallel prologue.
8891 \param dstsym The symbol assigned to.
8892 \param srcsym The symbol assigned from.
8893 */
8894 void
add_assign_firstprivate(int dstsym,int srcsym)8895 add_assign_firstprivate(int dstsym, int srcsym)
8896 {
8897 SST srcsst, dstsst;
8898 int where, savepar, savetask, savetarget, ast;
8899 int dupwhere;
8900
8901 dupwhere = where = sem.scope_stack[sem.scope_level].end_prologue;
8902 if (where == 0) {
8903 interr("add_assign_firstprivate - can't find prologue", 0, 3);
8904 return;
8905 }
8906 (void)mk_storage(srcsym, &srcsst);
8907 SST_IDP(&dstsst, S_IDENT);
8908 SST_DTYPEP(&dstsst, DTYPEG(dstsym));
8909 SST_SYMP(&dstsst, dstsym);
8910 SST_ASTP(&dstsst, 0);
8911 /* assign() calls ref_object() calls sem_check_scope() which can call
8912 * back here. Avoid infinite recursion by setting sem.parallel to zero
8913 * for the duration of assign(), preventing sem_check_scope() from
8914 * calling here again.
8915 */
8916 savepar = sem.parallel;
8917 savetask = sem.task;
8918 savetarget = sem.target;
8919 sem.parallel = 0;
8920 if (sem.task && TASKG(dstsym)) {
8921 ast = mk_stmt(A_MP_TASKFIRSTPRIV, 0);
8922 int src_ast = mk_id(srcsym);
8923 int dst_ast = mk_id(dstsym);
8924 A_LOPP(ast, src_ast);
8925 A_ROPP(ast, dst_ast);
8926 where = add_stmt_after(ast, where);
8927 }
8928 set_parref_flag(srcsym, srcsym, BLK_UPLEVEL_SPTR(sem.scope_level));
8929 sem.task = 0;
8930 sem.target = 0;
8931 if (!POINTERG(srcsym))
8932 where = add_stmt_after(assign(&dstsst, &srcsst), where);
8933 else {
8934 SST_ASTP(&srcsst, mk_id(SST_SYMG(&srcsst)));
8935 where = add_stmt_after(assign_pointer(&dstsst, &srcsst), where);
8936 }
8937 sem.parallel = savepar;
8938 sem.task = savetask;
8939 sem.target = savetarget;
8940 sem.scope_stack[sem.scope_level].end_prologue = where;
8941 if (sem.task && TASKG(dstsym)) {
8942 ast = mk_stmt(A_MP_TASKDUP, 0);
8943 add_stmt_after(ast, dupwhere);
8944 ast = mk_stmt(A_MP_ETASKDUP, 0);
8945 add_stmt_after(ast, where);
8946 }
8947 }
8948
8949 static void
assign_cval(int sptr,int v,int d)8950 assign_cval(int sptr, int v, int d)
8951 {
8952 SST tmpsst;
8953 int ast;
8954
8955 SST_IDP(&tmpsst, S_CONST);
8956 SST_DTYPEP(&tmpsst, d);
8957 SST_CVALP(&tmpsst, v);
8958 ast = mk_cval1(v, d);
8959 SST_ASTP(&tmpsst, ast);
8960 add_assignment(sptr, &tmpsst);
8961 }
8962
8963 static int
enter_dir(int typ,LOGICAL ignore_nested,LOGICAL ignore_sev,BITMASK64 illegal_region)8964 enter_dir(int typ, /* begin what structured directive */
8965 LOGICAL ignore_nested, /* ignore directive if nested within itself */
8966 LOGICAL ignore_sev, /* error severity if nested directive ignored;
8967 * 0 => don't issue error message.
8968 */
8969 BITMASK64 illegal_region /* bit vector - which directives cannot
8970 * contain this directive.
8971 */
8972 )
8973 {
8974 int prev;
8975 int cur;
8976 char bf[128];
8977 LOGICAL ignore_it;
8978
8979 prev = sem.doif_depth;
8980 NEED_DOIF(cur, typ);
8981 DI_REDUC(cur) = NULL;
8982 DI_LASTPRIVATE(cur) = NULL;
8983 DI_REGIONVARS(cur) = NULL;
8984 DI_ALLOCATED(cur) = NULL;
8985 DI_SECT_VAR(cur) = 0;
8986 ignore_it = FALSE;
8987 if (ignore_nested && (DI_NEST(prev) & DI_B(typ))) {
8988 /* nested directive */
8989 if (ignore_sev) {
8990 sprintf(bf, "Nested directive %s ignored", name_of_dir(typ));
8991 error(155, ignore_sev, gbl.lineno, bf, NULL);
8992 }
8993 ignore_it = TRUE;
8994 }
8995 if (DI_NEST(prev) & illegal_region) {
8996 switch (typ) {
8997 /*
8998 * These are legally nested as long as they bind to different PARALLEL
8999 * directives.
9000 */
9001 case DI_PDO:
9002 case DI_SINGLE:
9003 case DI_SECTS:
9004 while (prev) {
9005 int di;
9006 di = DI_ID(prev);
9007 switch (di) {
9008 case DI_PDO:
9009 case DI_SINGLE:
9010 case DI_SECTS:
9011 goto nest_err; /* bind to the same parallel directive */
9012 case DI_PAR:
9013 goto return_it; /* bind to a different parallel directive */
9014 default:
9015 if (DI_NEST(prev) & illegal_region) {
9016 if (DI_B(di) & ~illegal_region) {
9017 /*
9018 * Need to skip the immediate enclosing construct
9019 * if it's actually legal, such as a DI_DO (see
9020 * f21436)
9021 */
9022 break; /* go to the next level */
9023 }
9024 /*
9025 * This one is in the set of regions that cannot
9026 * enclose the one being entered.
9027 */
9028 goto nest_err;
9029 }
9030 break;
9031 }
9032 prev--;
9033 }
9034 /* Not lexically bound to the same parallel directive */
9035 break;
9036 default:
9037 break;
9038 }
9039 nest_err:
9040 error(155, 3, gbl.lineno, "Illegal context for", name_of_dir(typ));
9041 ignore_it = TRUE;
9042 }
9043 return_it:
9044 if (ignore_it)
9045 return 0;
9046 return cur;
9047 }
9048
9049 static int
leave_dir(int typ,LOGICAL ignore_nested,LOGICAL ignore_sev)9050 leave_dir(int typ, /* end of which structured directive */
9051 LOGICAL ignore_nested, /* ignore directive if nested within itself */
9052 LOGICAL ignore_sev /* error severity if nested directive ignored */
9053 )
9054 {
9055 int prev;
9056 int cur;
9057 char bf[128];
9058
9059 deallocate_no_scope_sptr();
9060 cur = sem.doif_depth;
9061 if (DI_ID(cur) == typ) {
9062 sem.doif_depth--;
9063 prev = sem.doif_depth;
9064 if (ignore_nested && (DI_NEST(prev) & DI_B(typ))) {
9065 /* nested directive */
9066 if (ignore_sev) {
9067 sprintf(bf, "Nested directive END %s ignored", name_of_dir(typ));
9068 error(155, ignore_sev, gbl.lineno, bf, NULL);
9069 }
9070 return 0;
9071 }
9072 return cur;
9073 }
9074 if (typ == DI_PARDO) {
9075 if (DI_ISSIMD(cur))
9076 error(155, 3, gbl.lineno,
9077 "ENDPARALLELDOSIMD must immediately follow a DO loop", NULL);
9078 else
9079 error(155, 3, gbl.lineno,
9080 "ENDPARALLELDO must immediately follow a DO loop", NULL);
9081 }
9082 if (typ == DI_PDO || typ == DI_SIMD)
9083 error(155, 3, gbl.lineno, "ENDDO must immediately follow a DO loop", NULL);
9084 else
9085 error(155, 3, gbl.lineno, "Unmatched directive END", name_of_dir(typ));
9086 return 0;
9087 }
9088
9089 static char *
name_of_dir(int typ)9090 name_of_dir(int typ)
9091 {
9092 switch (typ) {
9093 case DI_PAR:
9094 return "PARALLEL";
9095 case DI_PARDO:
9096 return "PARALLEL DO";
9097 case DI_TARGPARDO:
9098 return "TARGET PARALLEL DO";
9099 case DI_PDO:
9100 return "DO";
9101 case DI_SIMD:
9102 return "SIMD";
9103 case DI_DOACROSS:
9104 return "DOACROSS";
9105 case DI_PARSECTS:
9106 return "PARALLEL SECTIONS";
9107 case DI_SECTS:
9108 return "SECTIONS";
9109 case DI_SINGLE:
9110 return "SINGLE";
9111 case DI_CRITICAL:
9112 return "CRITICAL";
9113 case DI_TASK:
9114 return "TASK";
9115 case DI_ATOMIC_CAPTURE:
9116 return "ATOMIC CAPTURE";
9117 case DI_MASTER:
9118 return "MASTER";
9119 case DI_ORDERED:
9120 return "ORDERED";
9121 case DI_PARWORKS:
9122 return "PARALLEL WORKSHARE";
9123 case DI_ACCREG:
9124 return "REGION";
9125 case DI_ACCKERNELS:
9126 return "KERNELS";
9127 case DI_ACCPARALLEL:
9128 return "PARALLEL";
9129 case DI_ACCSERIAL:
9130 return "SERIAL";
9131 case DI_ACCDO:
9132 return "DO";
9133 case DI_ACCLOOP:
9134 return "LOOP";
9135 case DI_ACCREGDO:
9136 return "REGION DO";
9137 case DI_ACCREGLOOP:
9138 return "REGION LOOP";
9139 case DI_ACCKERNELSDO:
9140 return "KERNELS DO";
9141 case DI_ACCKERNELSLOOP:
9142 return "KERNELS LOOP";
9143 case DI_ACCPARALLELDO:
9144 return "PARALLEL DO";
9145 case DI_ACCPARALLELLOOP:
9146 return "PARALLEL LOOP";
9147 case DI_ACCSERIALLOOP:
9148 return "SERIAL LOOP";
9149 case DI_ACCDATAREG:
9150 return "DATA";
9151 case DI_ACCHOSTDATA:
9152 return "HOST_DATA";
9153 case DI_TARGET:
9154 return "TARGET";
9155 case DI_TEAMS:
9156 return "TEAMS";
9157 case DI_DISTRIBUTE:
9158 return "DISTRIBUTE";
9159 case DI_TEAMSDIST:
9160 return "TEAMS DISTRIBUTE";
9161 case DI_TARGTEAMSDIST:
9162 return "TARGET TEAMS DISTRIBUTE";
9163 case DI_DISTPARDO:
9164 return "DISTRIBUTE PARALLEL DO";
9165 case DI_TEAMSDISTPARDO:
9166 return "TEAMS DISTRIBUTE PARALLEL DO";
9167 case DI_TARGTEAMSDISTPARDO:
9168 return "TARGET TEAMS DISTRIBUTE PARALLEL DO";
9169 case DI_TASKLOOP:
9170 return "TASKLOOP";
9171 }
9172 return "NEED NAME";
9173 }
9174
9175 static int
find_reduc_intrinsic(int ident)9176 find_reduc_intrinsic(int ident)
9177 {
9178 char *nm;
9179 int sptr;
9180
9181 nm = SYMNAME(ident);
9182 if (strcmp(nm, "max") != 0 && strcmp(nm, "min") != 0 &&
9183 strcmp(nm, "iand") != 0 && strcmp(nm, "ior") != 0 &&
9184 strcmp(nm, "ieor") != 0) {
9185 error(155, 3, gbl.lineno,
9186 "The reduction intrinsic must be MAX, MIN, IAND, IOR, or IEOR, not",
9187 nm);
9188 return 0;
9189 }
9190 sptr = ident;
9191 do {
9192 if (STYPEG(sptr) == ST_GENERIC)
9193 return sptr;
9194 sptr = HASHLKG(sptr);
9195 } while (sptr && NMPTRG(sptr) == NMPTRG(ident));
9196 interr("find_reduc_intrinsic: generic not found ", ident, 3);
9197 return 0;
9198 }
9199
9200 static int
get_csect_sym(char * nm)9201 get_csect_sym(char *nm)
9202 {
9203 #undef CSECT_PFX
9204 #define CSECT_PFX "__cs_"
9205 int sptr = getsymf(CSECT_PFX "%s", nm);
9206
9207 sptr = refsym_inscope(sptr, OC_CMBLK);
9208 if (STYPEG(sptr) == ST_UNKNOWN) {
9209 STYPEP(sptr, ST_CMBLK);
9210 SYMLKP(sptr, gbl.cmblks); /* link into list */
9211 gbl.cmblks = sptr;
9212 if (!XBIT(69, 0x100)) {
9213 int sptr1, sptr2;
9214 ADSC *ad;
9215 int dtype;
9216
9217 /*
9218 * kmpc requires a semaphore variable to be 32 bytes and
9219 * 8-byte aligned
9220 */
9221 sptr1 = get_next_sym(SYMNAME(sptr), "sem");
9222 dtype = get_array_dtype(1, DT_INT8);
9223 DTYPEP(sptr1, dtype);
9224 STYPEP(sptr1, ST_ARRAY);
9225 SCP(sptr1, SC_CMBLK);
9226 ad = AD_DPTR(dtype);
9227 AD_LWAST(ad, 0) = AD_LWBD(ad, 0) = 0;
9228 AD_UPBD(ad, 0) = AD_UPAST(ad, 0) = mk_isz_cval(4, astb.bnd.dtype);
9229 AD_EXTNTAST(ad, 0) = mk_isz_cval(8, astb.bnd.dtype);
9230 CMEMFP(sptr, sptr1);
9231 CMEMLP(sptr, sptr1);
9232 CMBLKP(sptr1, sptr);
9233 SCP(sptr1, SC_CMBLK);
9234 SYMLKP(sptr1, NOSYM);
9235 } else {
9236 int sptr1, sptr2;
9237 ADSC *ad;
9238 int dtype;
9239
9240 sptr1 = get_next_sym(SYMNAME(sptr), "sel");
9241 dtype = get_array_dtype(1, DT_INT4);
9242 DTYPEP(sptr1, dtype);
9243 STYPEP(sptr1, ST_ARRAY);
9244 SCP(sptr1, SC_CMBLK);
9245 ad = AD_DPTR(dtype);
9246 AD_LWAST(ad, 0) = AD_LWBD(ad, 0) = 0;
9247 AD_UPBD(ad, 0) = AD_UPAST(ad, 0) = mk_isz_cval(16, astb.bnd.dtype);
9248 AD_EXTNTAST(ad, 0) = mk_isz_cval(16, astb.bnd.dtype);
9249
9250 sptr2 = get_next_sym(SYMNAME(sptr), "sem");
9251 DTYPEP(sptr2, dtype);
9252 STYPEP(sptr2, ST_ARRAY);
9253 SCP(sptr2, SC_CMBLK);
9254
9255 CMEMFP(sptr, sptr1);
9256 SYMLKP(sptr1, sptr2);
9257 SYMLKP(sptr2, NOSYM);
9258 CMEMLP(sptr, sptr2);
9259 CMBLKP(sptr1, sptr);
9260 CMBLKP(sptr2, sptr);
9261 }
9262 }
9263 return sptr;
9264 }
9265
9266 static int
get_csect_pfxlen(void)9267 get_csect_pfxlen(void)
9268 {
9269 return strlen(CSECT_PFX);
9270 }
9271
9272 static void
check_barrier(void)9273 check_barrier(void)
9274 {
9275 int prev;
9276 prev = sem.doif_depth;
9277 while (prev > 0) {
9278 switch (DI_ID(prev)) {
9279 case DI_PDO:
9280 case DI_PARDO:
9281 case DI_TARGPARDO:
9282 case DI_SECTS:
9283 case DI_PARSECTS:
9284 case DI_SINGLE:
9285 case DI_CRITICAL:
9286 case DI_MASTER:
9287 case DI_ORDERED:
9288 case DI_TASK:
9289 case DI_TASKLOOP:
9290 error(155, 3, gbl.lineno, "Illegal context for barrier", NULL);
9291 return;
9292 case DI_PAR: /* reached the barrier's binding thread */
9293 return;
9294 default:
9295 break;
9296 }
9297 prev--;
9298 }
9299 }
9300
9301 static void
check_crit(char * nm)9302 check_crit(char *nm)
9303 {
9304 int sptr;
9305 int prev;
9306
9307 prev = sem.doif_depth;
9308 while (--prev) {
9309 if (DI_ID(prev) == DI_CRITICAL) {
9310 sptr = DI_CRITSYM(prev);
9311 if (sptr && nm != NULL) {
9312 if (strcmp(nm, SYMNAME(sptr) + get_csect_pfxlen()) == 0) {
9313 error(155, 3, gbl.lineno,
9314 "CRITICAL sections with the same name may not be nested -", nm);
9315 break;
9316 }
9317 } else if (sptr == 0 && nm == NULL) {
9318 error(155, 3, gbl.lineno, "Unnamed CRITICAL sections may not be nested",
9319 NULL);
9320 break;
9321 }
9322 }
9323 }
9324 }
9325
9326 static void
check_targetdata(int type,char * nm)9327 check_targetdata(int type, char *nm)
9328 {
9329 int i;
9330 if (type == OMP_TARGET) {
9331 clause_errchk(BT_TARGET, nm);
9332 }
9333 for (i = 0; i < CL_MAXV; i++) {
9334 if (CL_PRESENT(i)) {
9335 switch (i) {
9336 case CL_OMPDEVICE:
9337 case CL_IF:
9338 break;
9339 case CL_MAP:
9340 if (type == OMP_TARGETUPDATE)
9341 error(533, 3, gbl.lineno, CL_NAME(i), nm);
9342 break;
9343 case CL_DEPEND:
9344 if (type != OMP_TARGETENTERDATA && type != OMP_TARGETEXITDATA &&
9345 type != OMP_TARGETUPDATE)
9346 error(533, 3, gbl.lineno, CL_NAME(i), nm);
9347 break;
9348 case CL_TO:
9349 case CL_FROM:
9350 if (type != OMP_TARGETUPDATE)
9351 error(533, 3, gbl.lineno, CL_NAME(i), nm);
9352 break;
9353 case CL_NOWAIT:
9354 if (type != OMP_TARGETENTERDATA && type != OMP_TARGETEXITDATA)
9355 error(533, 3, gbl.lineno, CL_NAME(i), nm);
9356 break;
9357 case CL_USE_DEVICE_PTR:
9358 if (type != OMP_TARGETDATA)
9359 error(533, 3, gbl.lineno, CL_NAME(i), nm);
9360 break;
9361 default:
9362 error(533, 3, gbl.lineno, CL_NAME(i), nm);
9363 }
9364 }
9365 }
9366 }
9367
9368 /* from cancel_type 1: parallel
9369 2: do
9370 3: sections
9371 4: taskgroup
9372 */
9373 static int
check_cancel(int cancel_type)9374 check_cancel(int cancel_type)
9375 {
9376 int sptr;
9377 int prev;
9378 int res;
9379 prev = sem.doif_depth;
9380 while (prev > 0) {
9381 switch (DI_ID(prev)) {
9382 case DI_PAR:
9383 if (cancel_type == 1) {
9384 res = DI_BPAR(prev);
9385 return res;
9386 } else {
9387 error(155, 3, gbl.lineno,
9388 "Expect PARALLEL as construct-type-clause in "
9389 "CANCEL/CANCELLATION POINT",
9390 NULL);
9391 return 0;
9392 }
9393 break;
9394 case DI_DO:
9395 if (cancel_type == 2) {
9396 if ((prev - 1) > 0 && DI_ID(prev - 1) != DI_PDO)
9397 break;
9398 res = DI_DO_AST(prev); /* This is a do ast */
9399 if (A_ORDEREDG(res)) {
9400 error(155, 3, gbl.lineno,
9401 "A loop construct that is canceled must "
9402 "not have an ordered clause",
9403 NULL);
9404 return 0;
9405 }
9406 return res;
9407 }
9408 break;
9409 case DI_SECTS:
9410 case DI_PARSECTS:
9411 if (cancel_type == 3) {
9412 res = DI_BEGINP(prev);
9413 return res;
9414 } else {
9415 error(155, 3, gbl.lineno,
9416 "Expect SECTIONS as construct-type-clause in "
9417 "CANCEL/CANCELLATION POINT",
9418 NULL);
9419 return 0;
9420 }
9421 break;
9422 case DI_TASK:
9423 if (cancel_type == 4) {
9424 res = DI_BEGINP(prev);
9425 return res;
9426 } else {
9427 error(155, 3, gbl.lineno,
9428 "Expect TASKGROUP as construct-type-clause "
9429 "in CANCEL/CANCELLATION POINT",
9430 NULL);
9431 return 0;
9432 }
9433 break;
9434 default:
9435 break;
9436 }
9437 --prev;
9438 }
9439 if (prev <= 0) {
9440 error(155, 3, gbl.lineno,
9441 "CANCEL/CANCELLATION POINT expects enclosing region to be PARALLEL,"
9442 " DO, SECTIONS, or TASK",
9443 NULL);
9444 }
9445 return 0;
9446 }
9447
9448 static int
get_mp_bind_type(char * nm)9449 get_mp_bind_type(char *nm)
9450 {
9451 INT val[2];
9452 int cnst_sptr;
9453 val[0] = 0;
9454
9455 if (strcmp(nm, "master") == 0) {
9456 /* MP_PROC_BIND_MASTER */
9457 val[1] = 2;
9458 } else if (strcmp(nm, "close") == 0) {
9459 /* MP_PROC_BIND_CLOSE */
9460 val[1] = 3;
9461 } else if (strcmp(nm, "spread") == 0) {
9462 /* MP_PROC_BIND_SPREAD */
9463 val[1] = 4;
9464 } else {
9465 /* MP_PROC_BIND_FALSE */
9466 error(155, 3, gbl.lineno, "Unknown PROC_BIND type", CNULL);
9467 return 0;
9468 }
9469
9470 cnst_sptr = getcon(val, DT_INT);
9471 return mk_cnst(cnst_sptr);
9472 }
9473
9474 static void
cray_pointer_check(ITEM * itp,int clause)9475 cray_pointer_check(ITEM *itp, int clause)
9476 {
9477 ITEM *itemp;
9478 int sptr;
9479 char bf[128];
9480
9481 sprintf(bf, "A Cray pointer may not appear in the %s clause -",
9482 CL_NAME(clause));
9483 for (itemp = itp; itemp != ITEM_END; itemp = itemp->next) {
9484 sptr = itemp->t.sptr;
9485 if (SCG(sptr) == SC_BASED && MIDNUMG(sptr) && !CCSYMG(MIDNUMG(sptr)) &&
9486 !HCCSYMG(MIDNUMG(sptr)))
9487 error(155, 3, gbl.lineno, bf, SYMNAME(sptr));
9488 }
9489 }
9490
9491 static void
other_firstlast_check(ITEM * itp,int clause)9492 other_firstlast_check(ITEM *itp, int clause)
9493 {
9494 ITEM *itemp;
9495 int sptr;
9496 char bf[128];
9497
9498 for (itemp = itp; itemp != ITEM_END; itemp = itemp->next) {
9499 sptr = itemp->t.sptr;
9500 if ((SCG(sptr) == SC_BASED || SCG(sptr) == SC_DUMMY) && MIDNUMG(sptr)) {
9501 }
9502 }
9503 }
9504 static void
private_check()9505 private_check()
9506 {
9507 ITEM *itemp;
9508 int sptr, i;
9509 int sptr1;
9510 SST tmpsst;
9511 char bf[128];
9512
9513 if (CL_PRESENT(CL_FIRSTPRIVATE)) {
9514 for (itemp = CL_FIRST(CL_FIRSTPRIVATE); itemp != ITEM_END;
9515 itemp = itemp->next) {
9516 sptr1 = itemp->t.sptr;
9517 if (SCG(sptr1) == SC_PRIVATE &&
9518 sem.scope_stack[sem.scope_level].par_scope) {
9519 if (SCOPEG(sptr1) == sem.scope_stack[sem.scope_level - 1].sptr) {
9520 sprintf(
9521 bf,
9522 "private variable may not appear in the FIRSTPRIVATE clause ");
9523 error(155, 3, gbl.lineno, bf, SYMNAME(sptr1));
9524 }
9525 }
9526 }
9527 }
9528 }
9529
9530 static int
sym_in_clause(int sptr,int clause)9531 sym_in_clause(int sptr, int clause)
9532 {
9533 ITEM *itemp;
9534
9535 if (CL_PRESENT(clause)) {
9536 for (itemp = CL_FIRST(clause); itemp != ITEM_END; itemp = itemp->next) {
9537 if (itemp->t.sptr == sptr) {
9538 return 1;
9539 }
9540 }
9541 }
9542
9543 return 0;
9544 }
9545
9546 void
add_non_private(int sptr)9547 add_non_private(int sptr)
9548 {
9549 int i;
9550 i = sem.non_private_avail;
9551 ++sem.non_private_avail;
9552 NEED(sem.non_private_avail, sem.non_private_base, int, sem.non_private_size,
9553 sem.non_private_size + 20);
9554 sem.non_private_base[i] = sptr;
9555 }
9556
9557 static void
non_private_check(int sptr,char * cl)9558 non_private_check(int sptr, char *cl)
9559 {
9560 int i;
9561 for (i = 0; i < sem.non_private_avail; i++) {
9562 if (sem.non_private_base[i] == sptr) {
9563 char bf[128];
9564 sprintf(bf, "may not appear in a %s clause", cl);
9565 error(155, 3, gbl.lineno, SYMNAME(sptr), bf);
9566 break;
9567 }
9568 }
9569 }
9570
9571 void
add_no_scope_sptr(int oldsptr,int newsptr,int lineno)9572 add_no_scope_sptr(int oldsptr, int newsptr, int lineno)
9573 {
9574 int i;
9575 if (sem.doif_depth == 0)
9576 return;
9577 i = DI_NOSCOPE_AVL(sem.doif_depth);
9578 ++DI_NOSCOPE_AVL(sem.doif_depth);
9579 NEED(DI_NOSCOPE_AVL(sem.doif_depth), DI_NOSCOPE_BASE(sem.doif_depth),
9580 NOSCOPE_SYM, DI_NOSCOPE_SIZE(sem.doif_depth),
9581 DI_NOSCOPE_SIZE(sem.doif_depth) + 20);
9582 BZERO(DI_NOSCOPE_BASE(sem.doif_depth) + i, NOSCOPE_SYM,
9583 DI_NOSCOPE_SIZE(sem.doif_depth) - i);
9584
9585 (DI_NOSCOPE_BASE(sem.doif_depth))[i].oldsptr = oldsptr;
9586 (DI_NOSCOPE_BASE(sem.doif_depth))[i].newsptr = newsptr;
9587 (DI_NOSCOPE_BASE(sem.doif_depth))[i].lineno = gbl.lineno;
9588 (DI_NOSCOPE_BASE(sem.doif_depth))[i].is_dovar = 0;
9589 }
9590
9591 static void
deallocate_no_scope_sptr()9592 deallocate_no_scope_sptr()
9593 {
9594 if (sem.doif_depth == 0)
9595 return;
9596 FREE((DI_NOSCOPE_BASE(sem.doif_depth)));
9597 DI_NOSCOPE_AVL(sem.doif_depth) = 0;
9598 DI_NOSCOPE_SIZE(sem.doif_depth) = 0;
9599 DI_NOSCOPE_BASE(sem.doif_depth) = NULL;
9600 }
9601
9602 void
clear_no_scope_sptr()9603 clear_no_scope_sptr()
9604 {
9605 int i, newsptr;
9606
9607 for (i = 0; i < DI_NOSCOPE_AVL(sem.doif_depth); i++) {
9608 newsptr = (DI_NOSCOPE_BASE(sem.doif_depth))[i].newsptr;
9609 if (newsptr) {
9610 if ((DI_NOSCOPE_BASE(sem.doif_depth))[i].is_dovar) {
9611 if (SCG(newsptr) == SC_PRIVATE)
9612 pop_sym(newsptr);
9613 }
9614 }
9615 }
9616 DI_NOSCOPE_AVL(sem.doif_depth) = 0;
9617 }
9618
9619 void
check_no_scope_sptr()9620 check_no_scope_sptr()
9621 {
9622 int i, in_forall;
9623
9624 if (sem.doif_depth == 0)
9625 return;
9626 for (i = 0; i < DI_NOSCOPE_AVL(sem.doif_depth); i++) {
9627 if ((DI_NOSCOPE_BASE(sem.doif_depth))[i].newsptr) {
9628 if (!(DI_NOSCOPE_BASE(sem.doif_depth))[i].is_dovar) {
9629 error(155, 3, gbl.lineno,
9630 SYMNAME((DI_NOSCOPE_BASE(sem.doif_depth))[i].oldsptr),
9631 "must appear in a SHARED or PRIVATE clause");
9632 break;
9633 }
9634 }
9635 }
9636 in_forall = DI_NOSCOPE_FORALL(sem.doif_depth);
9637
9638 if (in_forall)
9639 return;
9640
9641 clear_no_scope_sptr();
9642 }
9643
9644 void
is_dovar_sptr(int sptr)9645 is_dovar_sptr(int sptr)
9646 {
9647 int i;
9648 if (sem.doif_depth == 0)
9649 return;
9650 for (i = 0; i < DI_NOSCOPE_AVL(sem.doif_depth); i++) {
9651 if ((DI_NOSCOPE_BASE(sem.doif_depth))[i].newsptr == sptr) {
9652 (DI_NOSCOPE_BASE(sem.doif_depth))[i].is_dovar = 1;
9653 break;
9654 }
9655 }
9656 }
9657
9658 void
par_add_stblk_shvar()9659 par_add_stblk_shvar()
9660 {
9661 int i, ncnt = 0;
9662 }
9663
9664 static LLUplevel *
findUplevelForSharedVar(int sptr,int stblk)9665 findUplevelForSharedVar(int sptr, int stblk)
9666 {
9667 LLUplevel *up, *curr_up;
9668 int parent;
9669 if (SCG(sptr) == SC_PRIVATE) {
9670 SPTR paruplevel;
9671 SPTR encl = ENCLFUNCG(sptr);
9672 /* find variable scope which contains uplevel struct */
9673 paruplevel = PARUPLEVELG(encl);
9674 while (!paruplevel && encl) {
9675 encl = ENCLFUNCG(encl);
9676 paruplevel = PARUPLEVELG(encl);
9677 }
9678 up = NULL;
9679 if (paruplevel) {
9680 up = llmp_get_uplevel(paruplevel);
9681 #if DEBUG
9682 assert(up, "uplevel does not exist", paruplevel, 3);
9683 #endif
9684 /* find the paruplevel where up is its parent */
9685 while (stblk) {
9686 curr_up = llmp_parent_uplevel(stblk);
9687 if (up == curr_up) {
9688 return llmp_get_uplevel(stblk);
9689 }
9690 stblk = llmp_get_parent_sptr(stblk);
9691 }
9692 }
9693 return NULL;
9694 } else {
9695 up = llmp_outermost_uplevel(stblk);
9696 return up;
9697 }
9698 }
9699
9700 static bool
needCharLen(int sptr)9701 needCharLen(int sptr)
9702 {
9703 DTYPE dtype = DTYPEG(sptr);
9704 TY_KIND dty = DTYG(dtype);
9705 switch (dty) {
9706 case TY_CHAR:
9707 case TY_NCHAR:
9708 return true;
9709 case TY_PTR:
9710 if (DTYG(DTYG(dtype)) == TY_CHAR) {
9711 return true;
9712 } else if (DTYG(DTYG(dtype)) == TY_NCHAR) {
9713 return true;
9714 }
9715 default:
9716 return false;
9717 }
9718 return false;
9719 }
9720
9721 static void
mp_add_shared_var(int sptr,int stblk)9722 mp_add_shared_var(int sptr, int stblk)
9723 {
9724 SCOPE_SYM *newsh;
9725 int paramct, parsyms, i;
9726 int dolen = 0;
9727
9728 if (stblk) {
9729 LLUplevel *up;
9730 up = findUplevelForSharedVar(sptr, stblk);
9731 if (!up) {
9732 return;
9733 }
9734 if (needCharLen(sptr) || DTY(DTYPEG(sptr)) == TY_CHAR) {
9735 /* how we load and search uplevel struct
9736 * put cvlen field first if being referenced.
9737 */
9738 if (CVLENG(sptr)) {
9739 llmp_add_shared_var(up, CVLENG(sptr));
9740 PARREFP(CVLENG(sptr), 1);
9741 } else if (ADJLENG(sptr)) {
9742 int cvlen = CVLENG(sptr);
9743 if (cvlen == 0) {
9744 cvlen = sym_get_scalar(SYMNAME(sptr), "len", DT_INT);
9745 CVLENP(sptr, cvlen);
9746 if (SCG(sptr) == SC_DUMMY)
9747 CCSYMP(cvlen, 1);
9748 }
9749 llmp_add_shared_var(up, CVLENG(sptr));
9750 }
9751 }
9752 dolen = llmp_add_shared_var(up, sptr);
9753 PARREFP(sptr, 1);
9754 if (dolen && needCharLen(sptr)) {
9755 llmp_add_shared_var_charlen(up, sptr);
9756 }
9757 return;
9758 }
9759 }
9760
9761 static void
parref_bnd(int ast,int stblk)9762 parref_bnd(int ast, int stblk)
9763 {
9764 if (ast && A_TYPEG(ast) == A_ID) {
9765 int sptr;
9766 sptr = A_SPTRG(ast);
9767 mp_add_shared_var(sptr, stblk);
9768 }
9769 }
9770
9771 void
set_parref_flag(int sptr,int psptr,int stblk)9772 set_parref_flag(int sptr, int psptr, int stblk)
9773 {
9774 if (!SCG(sptr))
9775 return;
9776 if (STYPEG(sptr) == ST_MEMBER)
9777 return;
9778 if (SCG(sptr) == SC_CMBLK || SCG(sptr) == SC_STATIC)
9779 return;
9780 if (SCG(sptr) == SC_EXTERN && ST_ISVAR(sptr)) /* No global vars in uplevel */
9781 return;
9782 if (DINITG(sptr) || SAVEG(sptr)) {
9783 if (SCG(sptr) != SC_LOCAL) {
9784 if (SCG(sptr) == SC_BASED) {
9785 int sym = MIDNUMG(sptr);
9786 if (SCG(sym) != SC_LOCAL)
9787 return;
9788 }
9789 }
9790 }
9791 if (!stblk)
9792 stblk = get_stblk_uplevel_sptr();
9793
9794 mp_add_shared_var(sptr, stblk);
9795 if (psptr)
9796 PARREFP(psptr, 1);
9797 if (DTY(DTYPEG(sptr)) == TY_ARRAY || POINTERG(sptr) || ALLOCATTRG(sptr)) {
9798 int descr, sdsc, midnum;
9799 descr = DESCRG(sptr);
9800 sdsc = SDSCG(sptr);
9801 midnum = MIDNUMG(sptr);
9802 if (descr) {
9803 mp_add_shared_var(descr, stblk);
9804 }
9805 if (sdsc) {
9806 mp_add_shared_var(sdsc, stblk);
9807 }
9808 if (midnum) {
9809 mp_add_shared_var(midnum, stblk);
9810 }
9811 } else if (STYPEG(sptr) == ST_PROC && IS_PROC_DUMMYG(sptr)) {
9812 int sdsc = SDSCG(sptr);
9813 if (sdsc == 0) {
9814 get_static_descriptor(sptr);
9815 sdsc = SDSCG(sptr);
9816 }
9817 mp_add_shared_var(sdsc, stblk);
9818 }
9819 if (DTY(DTYPEG(sptr)) == TY_ARRAY) {
9820 ADSC *ad;
9821 ad = AD_DPTR(DTYPEG(sptr));
9822 if (AD_ADJARR(ad) || ALLOCATTRG(sptr) || ASSUMSHPG(sptr)) {
9823 int i, ndim;
9824 ndim = AD_NUMDIM(ad);
9825 for (i = 0; i < ndim; i++) {
9826 parref_bnd(AD_LWAST(ad, i), stblk);
9827 parref_bnd(AD_UPAST(ad, i), stblk);
9828 parref_bnd(AD_MLPYR(ad, i), stblk);
9829 parref_bnd(AD_EXTNTAST(ad, i), stblk);
9830 }
9831 parref_bnd(AD_NUMELM(ad), stblk);
9832 parref_bnd(AD_ZBASE(ad), stblk);
9833 }
9834 }
9835 }
9836
9837 /**
9838 \brief set_parref_flag set PARREF flag after semant phase
9839 \param sptr shared symbol - set PARREF field and put in uplevel
9840 structure
9841 \param psptr shared symbol - use it as key to search for uplevel
9842 \param std statement where the reference of sptr occurs
9843 */
9844 void
set_parref_flag2(int sptr,int psptr,int std)9845 set_parref_flag2(int sptr, int psptr, int std)
9846 {
9847 int i, stblk, paramct, parsyms, ast, key;
9848 LLUplevel *up;
9849 if (!SCG(sptr))
9850 return;
9851 if (STYPEG(sptr) == ST_MEMBER)
9852 return;
9853 if (SCG(sptr) == SC_CMBLK || SCG(sptr) == SC_STATIC)
9854 return;
9855 if (SCG(sptr) == SC_EXTERN && ST_ISVAR(sptr)) /* No global vars in uplevel */
9856 return;
9857 if (DINITG(sptr) || SAVEG(sptr)) {
9858 if (SCG(sptr) != SC_LOCAL) {
9859 if (SCG(sptr) == SC_BASED) {
9860 int sym = MIDNUMG(sptr);
9861 if (SCG(sym) != SC_LOCAL)
9862 return;
9863 }
9864 }
9865 }
9866 if (std) { /* use std to trace back to previous A_MP_BMPSCOPE */
9867 int nested = 0;
9868 std = STD_PREV(std);
9869 ast = STD_AST(std);
9870 while (std && ast) {
9871 if (A_TYPEG(ast) == A_MP_BMPSCOPE) {
9872 nested++;
9873 if (nested == 1)
9874 break;
9875 }
9876 if (A_TYPEG(ast) == A_MP_EMPSCOPE)
9877 nested--;
9878 std = STD_PREV(std);
9879 ast = STD_AST(std);
9880 }
9881 if (std && ast && A_TYPEG(ast) == A_MP_BMPSCOPE) {
9882 int paruplevel, astblk;
9883 astblk = A_STBLKG(ast);
9884 stblk = A_SPTRG(astblk);
9885 paruplevel = PARUPLEVELG(stblk);
9886 mp_add_shared_var(sptr, paruplevel);
9887 }
9888 return;
9889 }
9890 for (stblk = stb.firstusym; stblk < stb.stg_avail; ++stblk) {
9891 parsyms = PARSYMSG(stblk);
9892 if (STYPEG(stblk) == ST_BLOCK && parsyms) {
9893 /* do exhaustive search for each stblk because we don't know which stblck
9894 * psptr is in.
9895 * those MIDNUM/DESCRIPTOR are set very late so there is way to know when
9896 * we check
9897 * scope that it needs temp/midnum/etc. Very inefficient.
9898 */
9899 up = llmp_get_uplevel(stblk);
9900 if (up) {
9901 if (psptr)
9902 key = psptr;
9903 else
9904 key = sptr;
9905 for (i = 0; i < up->vals_count; ++i) {
9906 if (up->vals[i] == key) {
9907 if (psptr)
9908 mp_add_shared_var(sptr, stblk);
9909 else
9910 set_parref_flag(sptr, sptr, stblk);
9911 }
9912 }
9913 }
9914 }
9915 }
9916 }
9917
9918 static void
set_private_bnd_encl(int ast,int scope,int encl)9919 set_private_bnd_encl(int ast, int scope, int encl)
9920 {
9921 if (ast && A_TYPEG(ast) == A_ID) {
9922 int sptr;
9923 sptr = A_SPTRG(ast);
9924 SCOPEP(sptr, scope);
9925 ENCLFUNCP(sptr, encl);
9926 }
9927 }
9928
9929 void
set_private_encl(int old,int new)9930 set_private_encl(int old, int new)
9931 {
9932 /* make sure its midnum and bound has has scope and encl set - backend relies
9933 * on it */
9934 int scope, encl, midnum, sdsc, descr;
9935
9936 if ((ALLOCG(old) || POINTERG(old)) && new) {
9937
9938 scope = SCOPEG(new);
9939 encl = ENCLFUNCG(new);
9940
9941 midnum = MIDNUMG(new);
9942 if (midnum) {
9943 SCOPEP(midnum, scope);
9944 ENCLFUNCP(midnum, encl);
9945 }
9946 sdsc = SDSCG(new);
9947 if (sdsc) {
9948 SCOPEP(sdsc, scope);
9949 ENCLFUNCP(sdsc, encl);
9950 }
9951 descr = DESCRG(new);
9952 if (descr) {
9953 SCOPEP(descr, scope);
9954 ENCLFUNCP(descr, encl);
9955 }
9956 if (DTY(DTYPEG(new)) == TY_ARRAY) {
9957 ADSC *ad;
9958 ad = AD_DPTR(DTYPEG(new));
9959 if (AD_ADJARR(ad) || ALLOCATTRG(new) || ASSUMSHPG(new)) {
9960 int i, ndim;
9961 ndim = AD_NUMDIM(ad);
9962 for (i = 0; i < ndim; i++) {
9963 set_private_bnd_encl(AD_LWAST(ad, i), scope, encl);
9964 set_private_bnd_encl(AD_UPAST(ad, i), scope, encl);
9965 set_private_bnd_encl(AD_MLPYR(ad, i), scope, encl);
9966 set_private_bnd_encl(AD_EXTNTAST(ad, i), scope, encl);
9967 }
9968 set_private_bnd_encl(AD_NUMELM(ad), scope, encl);
9969 set_private_bnd_encl(AD_ZBASE(ad), scope, encl);
9970 }
9971 }
9972 }
9973 }
9974
9975 static void
set_private_bnd_taskflag(int ast)9976 set_private_bnd_taskflag(int ast)
9977 {
9978 if (ast && A_TYPEG(ast) == A_ID) {
9979 int sptr;
9980 sptr = A_SPTRG(ast);
9981 TASKP(sptr, 1);
9982 }
9983 }
9984
9985 void
set_private_taskflag(int sptr)9986 set_private_taskflag(int sptr)
9987 {
9988 /* make sure its midnum and bound has has scope and encl set - backend relies
9989 * on it */
9990 int midnum, sdsc, descr;
9991
9992 if (!sem.task)
9993 return;
9994
9995 if (ALLOCG(sptr) || POINTERG(sptr)) {
9996
9997 midnum = MIDNUMG(sptr);
9998 if (midnum) {
9999 TASKP(midnum, 1);
10000 }
10001 sdsc = SDSCG(sptr);
10002 if (sdsc) {
10003 TASKP(sdsc, 1);
10004 }
10005 } else if (ADJARRG(sptr) || RUNTIMEG(sptr)) {
10006 midnum = MIDNUMG(sptr);
10007 if (midnum && SCG(midnum) == SC_PRIVATE)
10008 TASKP(midnum, 1);
10009 }
10010 }
10011
10012 static void
add_firstprivate_bnd_assn(int ast,int ast1)10013 add_firstprivate_bnd_assn(int ast, int ast1)
10014 {
10015 if (A_TYPEG(ast) == A_ID && A_TYPEG(ast1) == A_ID) {
10016 int sptr = A_SPTRG(ast);
10017 int sptr1 = A_SPTRG(ast1);
10018 if (TASKG(sptr)) {
10019 int ast = mk_stmt(A_MP_TASKFIRSTPRIV, 0);
10020 int sptr1_ast = mk_id(sptr1);
10021 int sptr_ast = mk_id(sptr);
10022 A_LOPP(ast, sptr1_ast);
10023 A_ROPP(ast, sptr_ast);
10024 add_stmt(ast);
10025 }
10026 }
10027 }
10028
10029 static int
add_firstprivate_assn(int sptr,int sptr1,int std)10030 add_firstprivate_assn(int sptr, int sptr1, int std)
10031 {
10032 int add = 0;
10033 if (!sem.task)
10034 return 0;
10035
10036 if (std == 0)
10037 std = STD_PREV(0);
10038 if (ALLOCG(sptr) || POINTERG(sptr) || ADJARRG(sptr)) {
10039 int midnum = MIDNUMG(sptr);
10040 int midnum1 = MIDNUMG(sptr1);
10041 int sdsc, sdsc1;
10042
10043 if (midnum && TASKG(midnum)) {
10044 int midnum1_ast;
10045 int ast = mk_stmt(A_MP_TASKFIRSTPRIV, 0);
10046 int midnum_ast = mk_id(midnum);
10047 if (midnum1) {
10048 midnum1_ast = mk_id(midnum1);
10049 } else {
10050 midnum1_ast = astb.i0;
10051 }
10052 A_LOPP(ast, midnum1_ast);
10053 A_ROPP(ast, midnum_ast);
10054 add_stmt_after(ast, std);
10055 add = 1;
10056 }
10057 sdsc = SDSCG(sptr);
10058 sdsc1 = SDSCG(sptr1);
10059 if (sdsc && TASKG(sdsc)) {
10060 int sdsc1_ast;
10061 int ast = mk_stmt(A_MP_TASKFIRSTPRIV, 0);
10062 int sdsc_ast = mk_id(sdsc);
10063 if (sdsc1)
10064 sdsc1_ast = mk_id(sdsc1);
10065 else
10066 sdsc1_ast = astb.i0;
10067 A_LOPP(ast, sdsc1_ast);
10068 A_ROPP(ast, sdsc_ast);
10069 add_stmt_after(ast, std);
10070 add = 1;
10071 }
10072 }
10073 return add;
10074 }
10075
10076 /* Return 'TRUE' if sptr is the shared sptr for a last private value */
10077 static LOGICAL
is_last_private(int sptr)10078 is_last_private(int sptr)
10079 {
10080 const REDUC_SYM *sym;
10081
10082 for (sym = CL_FIRST(CL_LASTPRIVATE); sym; sym = sym->next)
10083 if (sptr == sym->shared || sptr == sym->Private)
10084 return TRUE;
10085
10086 return FALSE;
10087 }
10088
10089 /* Return 'TRUE' if sptr is in the specified clause list */
10090 static LOGICAL
is_in_list(int clause,int sptr)10091 is_in_list(int clause, int sptr)
10092 {
10093 const ITEM *item;
10094
10095 for (item = CL_FIRST(clause); item && item != ITEM_END; item = item->next) {
10096 const int sym = item->t.sptr;
10097 if (sptr == sym)
10098 return TRUE;
10099 }
10100
10101 return FALSE;
10102 }
10103 #ifdef OMP_OFFLOAD_LLVM
10104
10105 static void
gen_reduction_ompaccel(REDUC * reducp,REDUC_SYM * reduc_symp,LOGICAL rmme,LOGICAL in_parallel)10106 gen_reduction_ompaccel(REDUC *reducp, REDUC_SYM *reduc_symp, LOGICAL rmme,
10107 LOGICAL in_parallel)
10108 {
10109 int ast_reditem;
10110 REDUC *current_red = reducp;
10111 REDUC_SYM *current_redsym;
10112 while (true) {
10113 if (current_red == NULL)
10114 break;
10115 current_redsym = current_red->list;
10116 while (true) {
10117 if (current_redsym == NULL)
10118 break;
10119
10120 ast_reditem = mk_stmt(A_MP_REDUCTIONITEM, 0);
10121 A_SHSYMP(ast_reditem, current_redsym->shared);
10122 A_PRVSYMP(ast_reditem, current_redsym->Private);
10123 if (current_red->opr == 0)
10124 A_REDOPRP(ast_reditem, current_red->intrin);
10125 else
10126 A_REDOPRP(ast_reditem, current_red->opr);
10127 add_stmt(ast_reditem);
10128
10129 current_redsym = current_redsym->next;
10130 }
10131 current_red = current_red->next;
10132 }
10133 }
10134 #endif /* OMP_OFFLOAD_LLVM */
10135
10136 #if defined(OMP_OFFLOAD_LLVM) || defined(OMP_OFFLOAD_PGI)
10137 static void
mp_check_maptype(const char * maptype)10138 mp_check_maptype(const char *maptype)
10139 {
10140 if (strcmp(maptype, "tofrom") && strcmp(maptype, "from") &&
10141 strcmp(maptype, "to") && strcmp(maptype, "alloc") &&
10142 strcmp(maptype, "release") && strcmp(maptype, "delete"))
10143 error(1205, ERR_Severe, gbl.lineno, maptype, 0);
10144 }
10145
10146 static void
mp_handle_map_clause(SST * top,int clause,char * maptype,int op,int construct,bool isalways)10147 mp_handle_map_clause(SST *top, int clause, char *maptype, int op, int construct,
10148 bool isalways)
10149 {
10150 ITEM *itemp, *itembeg, *itemend;
10151 int type = 0;
10152 type |= OMP_TGT_MAPTYPE_TARGET_PARAM;
10153 if (isalways)
10154 type |= OMP_TGT_MAPTYPE_ALWAYS;
10155
10156 if (!strcmp(maptype, "tofrom"))
10157 type |= OMP_TGT_MAPTYPE_FROM | OMP_TGT_MAPTYPE_TO;
10158 else if (!strcmp(maptype, "from"))
10159 type |= OMP_TGT_MAPTYPE_FROM;
10160 else if (!strcmp(maptype, "to"))
10161 type |= OMP_TGT_MAPTYPE_TO;
10162 else if (!strcmp(maptype, "alloc"))
10163 type |= OMP_TGT_MAPTYPE_NONE; // todo opmaccel dunno what to pass
10164 else if (!strcmp(maptype, "delete"))
10165 type |= OMP_TGT_MAPTYPE_DELETE;
10166 else if (!strcmp(maptype, "release"))
10167 type |= OMP_TGT_MAPTYPE_NONE; // todo opmaccel dunno what to pass
10168
10169 if (construct == DI_TARGETENTERDATA) {
10170 if (strcmp(maptype, "to") && strcmp(maptype, "alloc")) {
10171 error(1205, ERR_Severe, gbl.lineno, maptype, 0);
10172 }
10173 }
10174 if (construct == DI_TARGETEXITDATA) {
10175 if (strcmp(maptype, "from") && strcmp(maptype, "delete") &&
10176 strcmp(maptype, "release")) {
10177 error(1203, ERR_Severe, gbl.lineno, maptype, 0);
10178 }
10179 }
10180
10181 itembeg = SST_BEGG(RHS(op));
10182 itemend = SST_ENDG(RHS(op));
10183 if (itembeg == ITEM_END)
10184 return;
10185 for (itemp = itembeg; itemp != ITEM_END; itemp = itemp->next) {
10186 itemp->t.cltype = type;
10187 }
10188 add_clause(clause, FALSE);
10189 if (CL_FIRST(clause) == NULL)
10190 CL_FIRST(clause) = itembeg;
10191 else
10192 ((ITEM *)CL_LAST(clause))->next = itembeg;
10193 CL_LAST(clause) = itemend;
10194 }
10195
10196 static int
get_omp_combined_mode(BIGINT64 type)10197 get_omp_combined_mode(BIGINT64 type)
10198 {
10199 BIGINT64 combined_type;
10200 combined_type = BT_TARGET | BT_TEAMS | BT_DISTRIBUTE | BT_PARDO | BT_SIMD;
10201 if ((type & combined_type) == combined_type)
10202 return mode_target_teams_distribute_parallel_for_simd;
10203 combined_type = BT_TARGET | BT_TEAMS | BT_DISTRIBUTE | BT_PARDO;
10204 if ((type & combined_type) == combined_type)
10205 return mode_target_teams_distribute_parallel_for;
10206 combined_type = BT_TARGET | BT_TEAMS | BT_DISTRIBUTE;
10207 if ((type & combined_type) == combined_type)
10208 return mode_target_teams_distribute;
10209 combined_type = BT_TARGET | BT_TEAMS;
10210 if ((type & combined_type) == combined_type)
10211 return mode_target_teams;
10212 combined_type = BT_TARGET | BT_PARDO;
10213 if ((type & combined_type) == combined_type)
10214 return mode_target_parallel_for;
10215 combined_type = BT_TARGET | BT_PAR;
10216 if ((type & combined_type) == combined_type)
10217 return mode_target_parallel;
10218 combined_type = BT_TARGET | BT_PARDO | BT_SIMD;
10219 if ((type & combined_type) == combined_type)
10220 return mode_target_parallel_for_simd;
10221 if ((type & BT_TARGET))
10222 return mode_target;
10223 return mode_none_target;
10224 return -1;
10225 }
10226 #endif
10227 /* Return FALSE if the sptr is presented in multiple
10228 * data sharing clauses: (e.g., shared(x) private(x)),
10229 * which is illegal.
10230 *
10231 * See OpenMP 4.5 specification, page 188, lines 16-17.
10232 */
10233 static void
check_valid_data_sharing(int sptr)10234 check_valid_data_sharing(int sptr)
10235 {
10236 int count = 0;
10237
10238 /* In shared list? */
10239 if (is_in_list(CL_SHARED, sptr))
10240 ++count;
10241
10242 /* In private list? */
10243 if (is_in_list(CL_PRIVATE, sptr)) {
10244 if (count) {
10245 error(155, ERR_Severe, gbl.lineno, SYMNAME(sptr),
10246 "is used in multiple data sharing clauses");
10247 return;
10248 } else {
10249 ++count;
10250 }
10251 }
10252
10253 /* In lastprivate or firstprivate or both? */
10254 if (is_last_private(sptr) || is_in_list(CL_FIRSTPRIVATE, sptr)) {
10255 if (count) {
10256 error(155, ERR_Severe, gbl.lineno, SYMNAME(sptr),
10257 "is used in multiple data sharing clauses");
10258 }
10259 }
10260 }
10261
10262 static LOGICAL
check_map_data_sharing(int sptr)10263 check_map_data_sharing(int sptr)
10264 {
10265 int count = 0;
10266
10267 /* In shared list? */
10268 if (is_in_list(CL_SHARED, sptr))
10269 ++count;
10270
10271 /* In private list? */
10272 if (is_in_list(CL_PRIVATE, sptr)) {
10273 if (count)
10274 return FALSE;
10275 else
10276 ++count;
10277 }
10278
10279 if (is_in_list(CL_FIRSTPRIVATE, sptr)) {
10280 if (count)
10281 return FALSE;
10282 else
10283 ++count;
10284 }
10285
10286 if (is_in_list(CL_LASTPRIVATE, sptr)) {
10287 if (count)
10288 return FALSE;
10289 else
10290 ++count;
10291 }
10292
10293 return TRUE;
10294 }
10295
is_in_omptarget_data(int d)10296 static LOGICAL is_in_omptarget_data(int d)
10297 {
10298 if(flg.omptarget && (DI_IN_NEST(d, DI_TARGETENTERDATA) ||
10299 DI_IN_NEST(d, DI_TARGETEXITDATA) ||
10300 DI_IN_NEST(d, DI_TARGETDATA)))
10301 return TRUE;
10302 return FALSE;
10303 }
is_in_omptarget(int d)10304 static LOGICAL is_in_omptarget(int d)
10305 {
10306 if(flg.omptarget && (DI_IN_NEST(d, DI_TARGET) ||
10307 DI_IN_NEST(d, DI_TARGTEAMSDISTPARDO) ||
10308 DI_IN_NEST(d, DI_TARGPARDO) ||
10309 DI_IN_NEST(d, DI_TARGETSIMD) ||
10310 DI_IN_NEST(d, DI_TARGTEAMSDIST) ||
10311 DI_IN_NEST(d, DI_TARGETENTERDATA)))
10312 return TRUE;
10313 return FALSE;
10314 }
10315 /**
10316 * \brief Decide to use optimized atomic usage.
10317 */
use_opt_atomic(int d)10318 LOGICAL use_opt_atomic(int d)
10319 {
10320 #ifdef OMP_OFFLOAD_LLVM
10321 return is_in_omptarget(d);
10322 #endif
10323 return OPT_OMP_ATOMIC;
10324 }
10325
10326 /**
10327 \brief Decide whether to use llvm atomic for reduction or not.
10328 Atomic is used only for teams reduction.
10329 */
use_atomic_for_reduction(int d)10330 static LOGICAL use_atomic_for_reduction(int d)
10331 {
10332 #ifdef OMP_OFFLOAD_LLVM
10333 if(flg.omptarget && DI_IN_NEST(d, DI_TARGET) ) {
10334 if(DI_IN_NEST(d, DI_PARDO) ||
10335 DI_IN_NEST(d, DI_TARGTEAMSDISTPARDO))
10336 return OPT_OMP_ATOMIC;
10337 else
10338 return TRUE;
10339 }
10340 #endif
10341 return OPT_OMP_ATOMIC;
10342 }
10343