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