1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
| /*
* kmp_error.cpp -- KPTS functions for error checking at runtime
*/
//===----------------------------------------------------------------------===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
#include "kmp.h"
#include "kmp_error.h"
#include "kmp_i18n.h"
#include "kmp_str.h"
/* ------------------------------------------------------------------------ */
#define MIN_STACK 100
static char const *cons_text_c[] = {
"(none)", "\"parallel\"", "work-sharing", /* this is not called "for"
because of lowering of
"sections" pragmas */
"\"ordered\" work-sharing", /* this is not called "for ordered" because of
lowering of "sections" pragmas */
"\"sections\"",
"work-sharing", /* this is not called "single" because of lowering of
"sections" pragmas */
"\"critical\"", "\"ordered\"", /* in PARALLEL */
"\"ordered\"", /* in PDO */
"\"master\"", "\"reduce\"", "\"barrier\""};
#define get_src(ident) ((ident) == NULL ? NULL : (ident)->psource)
#define PUSH_MSG(ct, ident) \
"\tpushing on stack: %s (%s)\n", cons_text_c[(ct)], get_src((ident))
#define POP_MSG(p) \
"\tpopping off stack: %s (%s)\n", cons_text_c[(p)->stack_data[tos].type], \
get_src((p)->stack_data[tos].ident)
static int const cons_text_c_num = sizeof(cons_text_c) / sizeof(char const *);
/* --------------- START OF STATIC LOCAL ROUTINES ------------------------- */
static void __kmp_check_null_func(void) { /* nothing to do */
}
static void __kmp_expand_cons_stack(int gtid, struct cons_header *p) {
int i;
struct cons_data *d;
/* TODO for monitor perhaps? */
if (gtid < 0)
__kmp_check_null_func();
KE_TRACE(10, ("expand cons_stack (%d %d)\n", gtid, __kmp_get_gtid()));
d = p->stack_data;
p->stack_size = (p->stack_size * 2) + 100;
/* TODO free the old data */
p->stack_data = (struct cons_data *)__kmp_allocate(sizeof(struct cons_data) *
(p->stack_size + 1));
for (i = p->stack_top; i >= 0; --i)
p->stack_data[i] = d[i];
/* NOTE: we do not free the old stack_data */
}
// NOTE: Function returns allocated memory, caller must free it!
static char *__kmp_pragma(int ct, ident_t const *ident) {
char const *cons = NULL; // Construct name.
char *file = NULL; // File name.
char *func = NULL; // Function (routine) name.
char *line = NULL; // Line number.
kmp_str_buf_t buffer;
kmp_msg_t prgm;
__kmp_str_buf_init(&buffer);
if (0 < ct && ct < cons_text_c_num) {
cons = cons_text_c[ct];
} else {
KMP_DEBUG_ASSERT(0);
}
if (ident != NULL && ident->psource != NULL) {
char *tail = NULL;
__kmp_str_buf_print(&buffer, "%s",
ident->psource); // Copy source to buffer.
// Split string in buffer to file, func, and line.
tail = buffer.str;
__kmp_str_split(tail, ';', NULL, &tail);
__kmp_str_split(tail, ';', &file, &tail);
__kmp_str_split(tail, ';', &func, &tail);
__kmp_str_split(tail, ';', &line, &tail);
}
prgm = __kmp_msg_format(kmp_i18n_fmt_Pragma, cons, file, func, line);
__kmp_str_buf_free(&buffer);
return prgm.str;
} // __kmp_pragma
/* ----------------- END OF STATIC LOCAL ROUTINES ------------------------- */
void __kmp_error_construct(kmp_i18n_id_t id, // Message identifier.
enum cons_type ct, // Construct type.
ident_t const *ident // Construct ident.
) {
char *construct = __kmp_pragma(ct, ident);
__kmp_fatal(__kmp_msg_format(id, construct), __kmp_msg_null);
KMP_INTERNAL_FREE(construct);
}
void __kmp_error_construct2(kmp_i18n_id_t id, // Message identifier.
enum cons_type ct, // First construct type.
ident_t const *ident, // First construct ident.
struct cons_data const *cons // Second construct.
) {
char *construct1 = __kmp_pragma(ct, ident);
char *construct2 = __kmp_pragma(cons->type, cons->ident);
__kmp_fatal(__kmp_msg_format(id, construct1, construct2), __kmp_msg_null);
KMP_INTERNAL_FREE(construct1);
KMP_INTERNAL_FREE(construct2);
}
struct cons_header *__kmp_allocate_cons_stack(int gtid) {
struct cons_header *p;
/* TODO for monitor perhaps? */
if (gtid < 0) {
__kmp_check_null_func();
}
KE_TRACE(10, ("allocate cons_stack (%d)\n", gtid));
p = (struct cons_header *)__kmp_allocate(sizeof(struct cons_header));
p->p_top = p->w_top = p->s_top = 0;
p->stack_data = (struct cons_data *)__kmp_allocate(sizeof(struct cons_data) *
(MIN_STACK + 1));
p->stack_size = MIN_STACK;
p->stack_top = 0;
p->stack_data[0].type = ct_none;
p->stack_data[0].prev = 0;
p->stack_data[0].ident = NULL;
return p;
}
void __kmp_free_cons_stack(void *ptr) {
struct cons_header *p = (struct cons_header *)ptr;
if (p != NULL) {
if (p->stack_data != NULL) {
__kmp_free(p->stack_data);
p->stack_data = NULL;
}
__kmp_free(p);
}
}
#if KMP_DEBUG
static void dump_cons_stack(int gtid, struct cons_header *p) {
int i;
int tos = p->stack_top;
kmp_str_buf_t buffer;
__kmp_str_buf_init(&buffer);
__kmp_str_buf_print(
&buffer,
"+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-\n");
__kmp_str_buf_print(&buffer,
"Begin construct stack with %d items for thread %d\n",
tos, gtid);
__kmp_str_buf_print(&buffer, " stack_top=%d { P=%d, W=%d, S=%d }\n", tos,
p->p_top, p->w_top, p->s_top);
for (i = tos; i > 0; i--) {
struct cons_data *c = &(p->stack_data[i]);
__kmp_str_buf_print(
&buffer, " stack_data[%2d] = { %s (%s) %d %p }\n", i,
cons_text_c[c->type], get_src(c->ident), c->prev, c->name);
}
__kmp_str_buf_print(&buffer, "End construct stack for thread %d\n", gtid);
__kmp_str_buf_print(
&buffer,
"+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-\n");
__kmp_debug_printf("%s", buffer.str);
__kmp_str_buf_free(&buffer);
}
#endif
void __kmp_push_parallel(int gtid, ident_t const *ident) {
int tos;
struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
KMP_DEBUG_ASSERT(__kmp_threads[gtid]->th.th_cons);
KE_TRACE(10, ("__kmp_push_parallel (%d %d)\n", gtid, __kmp_get_gtid()));
KE_TRACE(100, (PUSH_MSG(ct_parallel, ident)));
if (p->stack_top >= p->stack_size) {
__kmp_expand_cons_stack(gtid, p);
}
tos = ++p->stack_top;
p->stack_data[tos].type = ct_parallel;
p->stack_data[tos].prev = p->p_top;
p->stack_data[tos].ident = ident;
p->stack_data[tos].name = NULL;
p->p_top = tos;
KE_DUMP(1000, dump_cons_stack(gtid, p));
}
void __kmp_check_workshare(int gtid, enum cons_type ct, ident_t const *ident) {
struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
KMP_DEBUG_ASSERT(__kmp_threads[gtid]->th.th_cons);
KE_TRACE(10, ("__kmp_check_workshare (%d %d)\n", gtid, __kmp_get_gtid()));
if (p->stack_top >= p->stack_size) {
__kmp_expand_cons_stack(gtid, p);
}
if (p->w_top > p->p_top) {
// We are already in a WORKSHARE construct for this PARALLEL region.
__kmp_error_construct2(kmp_i18n_msg_CnsInvalidNesting, ct, ident,
&p->stack_data[p->w_top]);
}
if (p->s_top > p->p_top) {
// We are already in a SYNC construct for this PARALLEL region.
__kmp_error_construct2(kmp_i18n_msg_CnsInvalidNesting, ct, ident,
&p->stack_data[p->s_top]);
}
}
void __kmp_push_workshare(int gtid, enum cons_type ct, ident_t const *ident) {
int tos;
struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
KE_TRACE(10, ("__kmp_push_workshare (%d %d)\n", gtid, __kmp_get_gtid()));
__kmp_check_workshare(gtid, ct, ident);
KE_TRACE(100, (PUSH_MSG(ct, ident)));
tos = ++p->stack_top;
p->stack_data[tos].type = ct;
p->stack_data[tos].prev = p->w_top;
p->stack_data[tos].ident = ident;
p->stack_data[tos].name = NULL;
p->w_top = tos;
KE_DUMP(1000, dump_cons_stack(gtid, p));
}
void
#if KMP_USE_DYNAMIC_LOCK
__kmp_check_sync( int gtid, enum cons_type ct, ident_t const * ident, kmp_user_lock_p lck, kmp_uint32 seq )
#else
__kmp_check_sync( int gtid, enum cons_type ct, ident_t const * ident, kmp_user_lock_p lck )
#endif
{
struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
KE_TRACE(10, ("__kmp_check_sync (gtid=%d)\n", __kmp_get_gtid()));
if (p->stack_top >= p->stack_size)
__kmp_expand_cons_stack(gtid, p);
if (ct == ct_ordered_in_parallel || ct == ct_ordered_in_pdo) {
if (p->w_top <= p->p_top) {
/* we are not in a worksharing construct */
#ifdef BUILD_PARALLEL_ORDERED
/* do not report error messages for PARALLEL ORDERED */
KMP_ASSERT(ct == ct_ordered_in_parallel);
#else
__kmp_error_construct(kmp_i18n_msg_CnsBoundToWorksharing, ct, ident);
#endif /* BUILD_PARALLEL_ORDERED */
} else {
/* inside a WORKSHARING construct for this PARALLEL region */
if (!IS_CONS_TYPE_ORDERED(p->stack_data[p->w_top].type)) {
__kmp_error_construct2(kmp_i18n_msg_CnsNoOrderedClause, ct, ident,
&p->stack_data[p->w_top]);
}
}
if (p->s_top > p->p_top && p->s_top > p->w_top) {
/* inside a sync construct which is inside a worksharing construct */
int index = p->s_top;
enum cons_type stack_type;
stack_type = p->stack_data[index].type;
if (stack_type == ct_critical ||
((stack_type == ct_ordered_in_parallel ||
stack_type == ct_ordered_in_pdo) &&
/* C doesn't allow named ordered; ordered in ordered gets error */
p->stack_data[index].ident != NULL &&
(p->stack_data[index].ident->flags & KMP_IDENT_KMPC))) {
/* we are in ORDERED which is inside an ORDERED or CRITICAL construct */
__kmp_error_construct2(kmp_i18n_msg_CnsInvalidNesting, ct, ident,
&p->stack_data[index]);
}
}
} else if (ct == ct_critical) {
#if KMP_USE_DYNAMIC_LOCK
if (lck != NULL &&
__kmp_get_user_lock_owner(lck, seq) ==
gtid) { /* this thread already has lock for this critical section */
#else
if (lck != NULL &&
__kmp_get_user_lock_owner(lck) ==
gtid) { /* this thread already has lock for this critical section */
#endif
int index = p->s_top;
struct cons_data cons = {NULL, ct_critical, 0, NULL};
/* walk up construct stack and try to find critical with matching name */
while (index != 0 && p->stack_data[index].name != lck) {
index = p->stack_data[index].prev;
}
if (index != 0) {
/* found match on the stack (may not always because of interleaved
* critical for Fortran) */
cons = p->stack_data[index];
}
/* we are in CRITICAL which is inside a CRITICAL construct of same name */
__kmp_error_construct2(kmp_i18n_msg_CnsNestingSameName, ct, ident, &cons);
}
} else if (ct == ct_master || ct == ct_reduce) {
if (p->w_top > p->p_top) {
/* inside a WORKSHARING construct for this PARALLEL region */
__kmp_error_construct2(kmp_i18n_msg_CnsInvalidNesting, ct, ident,
&p->stack_data[p->w_top]);
}
if (ct == ct_reduce && p->s_top > p->p_top) {
/* inside a another SYNC construct for this PARALLEL region */
__kmp_error_construct2(kmp_i18n_msg_CnsInvalidNesting, ct, ident,
&p->stack_data[p->s_top]);
}
}
}
void
#if KMP_USE_DYNAMIC_LOCK
__kmp_push_sync( int gtid, enum cons_type ct, ident_t const * ident, kmp_user_lock_p lck, kmp_uint32 seq )
#else
__kmp_push_sync( int gtid, enum cons_type ct, ident_t const * ident, kmp_user_lock_p lck )
#endif
{
int tos;
struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
KMP_ASSERT(gtid == __kmp_get_gtid());
KE_TRACE(10, ("__kmp_push_sync (gtid=%d)\n", gtid));
#if KMP_USE_DYNAMIC_LOCK
__kmp_check_sync(gtid, ct, ident, lck, seq);
#else
__kmp_check_sync(gtid, ct, ident, lck);
#endif
KE_TRACE(100, (PUSH_MSG(ct, ident)));
tos = ++p->stack_top;
p->stack_data[tos].type = ct;
p->stack_data[tos].prev = p->s_top;
p->stack_data[tos].ident = ident;
p->stack_data[tos].name = lck;
p->s_top = tos;
KE_DUMP(1000, dump_cons_stack(gtid, p));
}
/* ------------------------------------------------------------------------ */
void __kmp_pop_parallel(int gtid, ident_t const *ident) {
int tos;
struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
tos = p->stack_top;
KE_TRACE(10, ("__kmp_pop_parallel (%d %d)\n", gtid, __kmp_get_gtid()));
if (tos == 0 || p->p_top == 0) {
__kmp_error_construct(kmp_i18n_msg_CnsDetectedEnd, ct_parallel, ident);
}
if (tos != p->p_top || p->stack_data[tos].type != ct_parallel) {
__kmp_error_construct2(kmp_i18n_msg_CnsExpectedEnd, ct_parallel, ident,
&p->stack_data[tos]);
}
KE_TRACE(100, (POP_MSG(p)));
p->p_top = p->stack_data[tos].prev;
p->stack_data[tos].type = ct_none;
p->stack_data[tos].ident = NULL;
p->stack_top = tos - 1;
KE_DUMP(1000, dump_cons_stack(gtid, p));
}
enum cons_type __kmp_pop_workshare(int gtid, enum cons_type ct,
ident_t const *ident) {
int tos;
struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
tos = p->stack_top;
KE_TRACE(10, ("__kmp_pop_workshare (%d %d)\n", gtid, __kmp_get_gtid()));
if (tos == 0 || p->w_top == 0) {
__kmp_error_construct(kmp_i18n_msg_CnsDetectedEnd, ct, ident);
}
if (tos != p->w_top ||
(p->stack_data[tos].type != ct &&
// below is the exception to the rule that construct types must match
!(p->stack_data[tos].type == ct_pdo_ordered && ct == ct_pdo))) {
__kmp_check_null_func();
__kmp_error_construct2(kmp_i18n_msg_CnsExpectedEnd, ct, ident,
&p->stack_data[tos]);
}
KE_TRACE(100, (POP_MSG(p)));
p->w_top = p->stack_data[tos].prev;
p->stack_data[tos].type = ct_none;
p->stack_data[tos].ident = NULL;
p->stack_top = tos - 1;
KE_DUMP(1000, dump_cons_stack(gtid, p));
return p->stack_data[p->w_top].type;
}
void __kmp_pop_sync(int gtid, enum cons_type ct, ident_t const *ident) {
int tos;
struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
tos = p->stack_top;
KE_TRACE(10, ("__kmp_pop_sync (%d %d)\n", gtid, __kmp_get_gtid()));
if (tos == 0 || p->s_top == 0) {
__kmp_error_construct(kmp_i18n_msg_CnsDetectedEnd, ct, ident);
}
if (tos != p->s_top || p->stack_data[tos].type != ct) {
__kmp_check_null_func();
__kmp_error_construct2(kmp_i18n_msg_CnsExpectedEnd, ct, ident,
&p->stack_data[tos]);
}
if (gtid < 0) {
__kmp_check_null_func();
}
KE_TRACE(100, (POP_MSG(p)));
p->s_top = p->stack_data[tos].prev;
p->stack_data[tos].type = ct_none;
p->stack_data[tos].ident = NULL;
p->stack_top = tos - 1;
KE_DUMP(1000, dump_cons_stack(gtid, p));
}
/* ------------------------------------------------------------------------ */
void __kmp_check_barrier(int gtid, enum cons_type ct, ident_t const *ident) {
struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
KE_TRACE(10, ("__kmp_check_barrier (loc: %p, gtid: %d %d)\n", ident, gtid,
__kmp_get_gtid()));
if (ident != 0) {
__kmp_check_null_func();
}
if (p->w_top > p->p_top) {
/* we are already in a WORKSHARING construct for this PARALLEL region */
__kmp_error_construct2(kmp_i18n_msg_CnsInvalidNesting, ct, ident,
&p->stack_data[p->w_top]);
}
if (p->s_top > p->p_top) {
/* we are already in a SYNC construct for this PARALLEL region */
__kmp_error_construct2(kmp_i18n_msg_CnsInvalidNesting, ct, ident,
&p->stack_data[p->s_top]);
}
}
|