xref: /netbsd-src/external/gpl3/gcc.old/dist/libgomp/env.c (revision bdc22b2e01993381dcefeff2bc9b56ca75a4235c)
1 /* Copyright (C) 2005-2015 Free Software Foundation, Inc.
2    Contributed by Richard Henderson <rth@redhat.com>.
3 
4    This file is part of the GNU Offloading and Multi Processing Library
5    (libgomp).
6 
7    Libgomp is free software; you can redistribute it and/or modify it
8    under the terms of the GNU General Public License as published by
9    the Free Software Foundation; either version 3, or (at your option)
10    any later version.
11 
12    Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
13    WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14    FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
15    more details.
16 
17    Under Section 7 of GPL version 3, you are granted additional
18    permissions described in the GCC Runtime Library Exception, version
19    3.1, as published by the Free Software Foundation.
20 
21    You should have received a copy of the GNU General Public License and
22    a copy of the GCC Runtime Library Exception along with this program;
23    see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
24    <http://www.gnu.org/licenses/>.  */
25 
26 /* This file defines the OpenMP internal control variables, and arranges
27    for them to be initialized from environment variables at startup.  */
28 
29 #include "libgomp.h"
30 #include "libgomp_f.h"
31 #include "oacc-int.h"
32 #include <ctype.h>
33 #include <stdlib.h>
34 #include <stdio.h>
35 #ifdef HAVE_INTTYPES_H
36 # include <inttypes.h>	/* For PRIu64.  */
37 #endif
38 #ifdef STRING_WITH_STRINGS
39 # include <string.h>
40 # include <strings.h>
41 #else
42 # ifdef HAVE_STRING_H
43 #  include <string.h>
44 # else
45 #  ifdef HAVE_STRINGS_H
46 #   include <strings.h>
47 #  endif
48 # endif
49 #endif
50 #include <limits.h>
51 #include <errno.h>
52 
53 #ifndef HAVE_STRTOULL
54 # define strtoull(ptr, eptr, base) strtoul (ptr, eptr, base)
55 #endif
56 
57 struct gomp_task_icv gomp_global_icv = {
58   .nthreads_var = 1,
59   .thread_limit_var = UINT_MAX,
60   .run_sched_var = GFS_DYNAMIC,
61   .run_sched_modifier = 1,
62   .default_device_var = 0,
63   .dyn_var = false,
64   .nest_var = false,
65   .bind_var = omp_proc_bind_false,
66   .target_data = NULL
67 };
68 
69 unsigned long gomp_max_active_levels_var = INT_MAX;
70 bool gomp_cancel_var = false;
71 #ifndef HAVE_SYNC_BUILTINS
72 gomp_mutex_t gomp_managed_threads_lock;
73 #endif
74 unsigned long gomp_available_cpus = 1, gomp_managed_threads = 1;
75 unsigned long long gomp_spin_count_var, gomp_throttled_spin_count_var;
76 unsigned long *gomp_nthreads_var_list, gomp_nthreads_var_list_len;
77 char *gomp_bind_var_list;
78 unsigned long gomp_bind_var_list_len;
79 void **gomp_places_list;
80 unsigned long gomp_places_list_len;
81 int gomp_debug_var;
82 char *goacc_device_type;
83 int goacc_device_num;
84 
85 /* Parse the OMP_SCHEDULE environment variable.  */
86 
87 static void
88 parse_schedule (void)
89 {
90   char *env, *end;
91   unsigned long value;
92 
93   env = getenv ("OMP_SCHEDULE");
94   if (env == NULL)
95     return;
96 
97   while (isspace ((unsigned char) *env))
98     ++env;
99   if (strncasecmp (env, "static", 6) == 0)
100     {
101       gomp_global_icv.run_sched_var = GFS_STATIC;
102       env += 6;
103     }
104   else if (strncasecmp (env, "dynamic", 7) == 0)
105     {
106       gomp_global_icv.run_sched_var = GFS_DYNAMIC;
107       env += 7;
108     }
109   else if (strncasecmp (env, "guided", 6) == 0)
110     {
111       gomp_global_icv.run_sched_var = GFS_GUIDED;
112       env += 6;
113     }
114   else if (strncasecmp (env, "auto", 4) == 0)
115     {
116       gomp_global_icv.run_sched_var = GFS_AUTO;
117       env += 4;
118     }
119   else
120     goto unknown;
121 
122   while (isspace ((unsigned char) *env))
123     ++env;
124   if (*env == '\0')
125     {
126       gomp_global_icv.run_sched_modifier
127 	= gomp_global_icv.run_sched_var != GFS_STATIC;
128       return;
129     }
130   if (*env++ != ',')
131     goto unknown;
132   while (isspace ((unsigned char) *env))
133     ++env;
134   if (*env == '\0')
135     goto invalid;
136 
137   errno = 0;
138   value = strtoul (env, &end, 10);
139   if (errno)
140     goto invalid;
141 
142   while (isspace ((unsigned char) *end))
143     ++end;
144   if (*end != '\0')
145     goto invalid;
146 
147   if ((int)value != value)
148     goto invalid;
149 
150   if (value == 0 && gomp_global_icv.run_sched_var != GFS_STATIC)
151     value = 1;
152   gomp_global_icv.run_sched_modifier = value;
153   return;
154 
155  unknown:
156   gomp_error ("Unknown value for environment variable OMP_SCHEDULE");
157   return;
158 
159  invalid:
160   gomp_error ("Invalid value for chunk size in "
161 	      "environment variable OMP_SCHEDULE");
162   return;
163 }
164 
165 /* Parse an unsigned long environment variable.  Return true if one was
166    present and it was successfully parsed.  */
167 
168 static bool
169 parse_unsigned_long (const char *name, unsigned long *pvalue, bool allow_zero)
170 {
171   char *env, *end;
172   unsigned long value;
173 
174   env = getenv (name);
175   if (env == NULL)
176     return false;
177 
178   while (isspace ((unsigned char) *env))
179     ++env;
180   if (*env == '\0')
181     goto invalid;
182 
183   errno = 0;
184   value = strtoul (env, &end, 10);
185   if (errno || (long) value <= 0 - allow_zero)
186     goto invalid;
187 
188   while (isspace ((unsigned char) *end))
189     ++end;
190   if (*end != '\0')
191     goto invalid;
192 
193   *pvalue = value;
194   return true;
195 
196  invalid:
197   gomp_error ("Invalid value for environment variable %s", name);
198   return false;
199 }
200 
201 /* Parse a positive int environment variable.  Return true if one was
202    present and it was successfully parsed.  */
203 
204 static bool
205 parse_int (const char *name, int *pvalue, bool allow_zero)
206 {
207   unsigned long value;
208   if (!parse_unsigned_long (name, &value, allow_zero))
209     return false;
210   if (value > INT_MAX)
211     {
212       gomp_error ("Invalid value for environment variable %s", name);
213       return false;
214     }
215   *pvalue = (int) value;
216   return true;
217 }
218 
219 /* Parse an unsigned long list environment variable.  Return true if one was
220    present and it was successfully parsed.  */
221 
222 static bool
223 parse_unsigned_long_list (const char *name, unsigned long *p1stvalue,
224 			  unsigned long **pvalues,
225 			  unsigned long *pnvalues)
226 {
227   char *env, *end;
228   unsigned long value, *values = NULL;
229 
230   env = getenv (name);
231   if (env == NULL)
232     return false;
233 
234   while (isspace ((unsigned char) *env))
235     ++env;
236   if (*env == '\0')
237     goto invalid;
238 
239   errno = 0;
240   value = strtoul (env, &end, 10);
241   if (errno || (long) value <= 0)
242     goto invalid;
243 
244   while (isspace ((unsigned char) *end))
245     ++end;
246   if (*end != '\0')
247     {
248       if (*end == ',')
249 	{
250 	  unsigned long nvalues = 0, nalloced = 0;
251 
252 	  do
253 	    {
254 	      env = end + 1;
255 	      if (nvalues == nalloced)
256 		{
257 		  unsigned long *n;
258 		  nalloced = nalloced ? nalloced * 2 : 16;
259 		  n = realloc (values, nalloced * sizeof (unsigned long));
260 		  if (n == NULL)
261 		    {
262 		      free (values);
263 		      gomp_error ("Out of memory while trying to parse"
264 				  " environment variable %s", name);
265 		      return false;
266 		    }
267 		  values = n;
268 		  if (nvalues == 0)
269 		    values[nvalues++] = value;
270 		}
271 
272 	      while (isspace ((unsigned char) *env))
273 		++env;
274 	      if (*env == '\0')
275 		goto invalid;
276 
277 	      errno = 0;
278 	      value = strtoul (env, &end, 10);
279 	      if (errno || (long) value <= 0)
280 		goto invalid;
281 
282 	      values[nvalues++] = value;
283 	      while (isspace ((unsigned char) *end))
284 		++end;
285 	      if (*end == '\0')
286 		break;
287 	      if (*end != ',')
288 		goto invalid;
289 	    }
290 	  while (1);
291 	  *p1stvalue = values[0];
292 	  *pvalues = values;
293 	  *pnvalues = nvalues;
294 	  return true;
295 	}
296       goto invalid;
297     }
298 
299   *p1stvalue = value;
300   return true;
301 
302  invalid:
303   free (values);
304   gomp_error ("Invalid value for environment variable %s", name);
305   return false;
306 }
307 
308 /* Parse environment variable set to a boolean or list of omp_proc_bind_t
309    enum values.  Return true if one was present and it was successfully
310    parsed.  */
311 
312 static bool
313 parse_bind_var (const char *name, char *p1stvalue,
314 		char **pvalues, unsigned long *pnvalues)
315 {
316   char *env;
317   char value = omp_proc_bind_false, *values = NULL;
318   int i;
319   static struct proc_bind_kinds
320   {
321     const char name[7];
322     const char len;
323     omp_proc_bind_t kind;
324   } kinds[] =
325   {
326     { "false", 5, omp_proc_bind_false },
327     { "true", 4, omp_proc_bind_true },
328     { "master", 6, omp_proc_bind_master },
329     { "close", 5, omp_proc_bind_close },
330     { "spread", 6, omp_proc_bind_spread }
331   };
332 
333   env = getenv (name);
334   if (env == NULL)
335     return false;
336 
337   while (isspace ((unsigned char) *env))
338     ++env;
339   if (*env == '\0')
340     goto invalid;
341 
342   for (i = 0; i < 5; i++)
343     if (strncasecmp (env, kinds[i].name, kinds[i].len) == 0)
344       {
345 	value = kinds[i].kind;
346 	env += kinds[i].len;
347 	break;
348       }
349   if (i == 5)
350     goto invalid;
351 
352   while (isspace ((unsigned char) *env))
353     ++env;
354   if (*env != '\0')
355     {
356       if (*env == ',')
357 	{
358 	  unsigned long nvalues = 0, nalloced = 0;
359 
360 	  if (value == omp_proc_bind_false
361 	      || value == omp_proc_bind_true)
362 	    goto invalid;
363 
364 	  do
365 	    {
366 	      env++;
367 	      if (nvalues == nalloced)
368 		{
369 		  char *n;
370 		  nalloced = nalloced ? nalloced * 2 : 16;
371 		  n = realloc (values, nalloced);
372 		  if (n == NULL)
373 		    {
374 		      free (values);
375 		      gomp_error ("Out of memory while trying to parse"
376 				  " environment variable %s", name);
377 		      return false;
378 		    }
379 		  values = n;
380 		  if (nvalues == 0)
381 		    values[nvalues++] = value;
382 		}
383 
384 	      while (isspace ((unsigned char) *env))
385 		++env;
386 	      if (*env == '\0')
387 		goto invalid;
388 
389 	      for (i = 2; i < 5; i++)
390 		if (strncasecmp (env, kinds[i].name, kinds[i].len) == 0)
391 		  {
392 		    value = kinds[i].kind;
393 		    env += kinds[i].len;
394 		    break;
395 		  }
396 	      if (i == 5)
397 		goto invalid;
398 
399 	      values[nvalues++] = value;
400 	      while (isspace ((unsigned char) *env))
401 		++env;
402 	      if (*env == '\0')
403 		break;
404 	      if (*env != ',')
405 		goto invalid;
406 	    }
407 	  while (1);
408 	  *p1stvalue = values[0];
409 	  *pvalues = values;
410 	  *pnvalues = nvalues;
411 	  return true;
412 	}
413       goto invalid;
414     }
415 
416   *p1stvalue = value;
417   return true;
418 
419  invalid:
420   free (values);
421   gomp_error ("Invalid value for environment variable %s", name);
422   return false;
423 }
424 
425 static bool
426 parse_one_place (char **envp, bool *negatep, unsigned long *lenp,
427 		 long *stridep)
428 {
429   char *env = *envp, *start;
430   void *p = gomp_places_list ? gomp_places_list[gomp_places_list_len] : NULL;
431   unsigned long len = 1;
432   long stride = 1;
433   int pass;
434   bool any_negate = false;
435   *negatep = false;
436   while (isspace ((unsigned char) *env))
437     ++env;
438   if (*env == '!')
439     {
440       *negatep = true;
441       ++env;
442       while (isspace ((unsigned char) *env))
443 	++env;
444     }
445   if (*env != '{')
446     return false;
447   ++env;
448   while (isspace ((unsigned char) *env))
449     ++env;
450   start = env;
451   for (pass = 0; pass < (any_negate ? 2 : 1); pass++)
452     {
453       env = start;
454       do
455 	{
456 	  unsigned long this_num, this_len = 1;
457 	  long this_stride = 1;
458 	  bool this_negate = (*env == '!');
459 	  if (this_negate)
460 	    {
461 	      if (gomp_places_list)
462 		any_negate = true;
463 	      ++env;
464 	      while (isspace ((unsigned char) *env))
465 		++env;
466 	    }
467 
468 	  errno = 0;
469 	  this_num = strtoul (env, &env, 10);
470 	  if (errno)
471 	    return false;
472 	  while (isspace ((unsigned char) *env))
473 	    ++env;
474 	  if (*env == ':')
475 	    {
476 	      ++env;
477 	      while (isspace ((unsigned char) *env))
478 		++env;
479 	      errno = 0;
480 	      this_len = strtoul (env, &env, 10);
481 	      if (errno || this_len == 0)
482 		return false;
483 	      while (isspace ((unsigned char) *env))
484 		++env;
485 	      if (*env == ':')
486 		{
487 		  ++env;
488 		  while (isspace ((unsigned char) *env))
489 		    ++env;
490 		  errno = 0;
491 		  this_stride = strtol (env, &env, 10);
492 		  if (errno)
493 		    return false;
494 		  while (isspace ((unsigned char) *env))
495 		    ++env;
496 		}
497 	    }
498 	  if (this_negate && this_len != 1)
499 	    return false;
500 	  if (gomp_places_list && pass == this_negate)
501 	    {
502 	      if (this_negate)
503 		{
504 		  if (!gomp_affinity_remove_cpu (p, this_num))
505 		    return false;
506 		}
507 	      else if (!gomp_affinity_add_cpus (p, this_num, this_len,
508 						this_stride, false))
509 		return false;
510 	    }
511 	  if (*env == '}')
512 	    break;
513 	  if (*env != ',')
514 	    return false;
515 	  ++env;
516 	}
517       while (1);
518     }
519 
520   ++env;
521   while (isspace ((unsigned char) *env))
522     ++env;
523   if (*env == ':')
524     {
525       ++env;
526       while (isspace ((unsigned char) *env))
527 	++env;
528       errno = 0;
529       len = strtoul (env, &env, 10);
530       if (errno || len == 0 || len >= 65536)
531 	return false;
532       while (isspace ((unsigned char) *env))
533 	++env;
534       if (*env == ':')
535 	{
536 	  ++env;
537 	  while (isspace ((unsigned char) *env))
538 	    ++env;
539 	  errno = 0;
540 	  stride = strtol (env, &env, 10);
541 	  if (errno)
542 	    return false;
543 	  while (isspace ((unsigned char) *env))
544 	    ++env;
545 	}
546     }
547   if (*negatep && len != 1)
548     return false;
549   *envp = env;
550   *lenp = len;
551   *stridep = stride;
552   return true;
553 }
554 
555 static bool
556 parse_places_var (const char *name, bool ignore)
557 {
558   char *env = getenv (name), *end;
559   bool any_negate = false;
560   int level = 0;
561   unsigned long count = 0;
562   if (env == NULL)
563     return false;
564 
565   while (isspace ((unsigned char) *env))
566     ++env;
567   if (*env == '\0')
568     goto invalid;
569 
570   if (strncasecmp (env, "threads", 7) == 0)
571     {
572       env += 7;
573       level = 1;
574     }
575   else if (strncasecmp (env, "cores", 5) == 0)
576     {
577       env += 5;
578       level = 2;
579     }
580   else if (strncasecmp (env, "sockets", 7) == 0)
581     {
582       env += 7;
583       level = 3;
584     }
585   if (level)
586     {
587       count = ULONG_MAX;
588       while (isspace ((unsigned char) *env))
589 	++env;
590       if (*env != '\0')
591 	{
592 	  if (*env++ != '(')
593 	    goto invalid;
594 	  while (isspace ((unsigned char) *env))
595 	    ++env;
596 
597 	  errno = 0;
598 	  count = strtoul (env, &end, 10);
599 	  if (errno)
600 	    goto invalid;
601 	  env = end;
602 	  while (isspace ((unsigned char) *env))
603 	    ++env;
604 	  if (*env != ')')
605 	    goto invalid;
606 	  ++env;
607 	  while (isspace ((unsigned char) *env))
608 	    ++env;
609 	  if (*env != '\0')
610 	    goto invalid;
611 	}
612 
613       if (ignore)
614 	return false;
615 
616       return gomp_affinity_init_level (level, count, false);
617     }
618 
619   count = 0;
620   end = env;
621   do
622     {
623       bool negate;
624       unsigned long len;
625       long stride;
626       if (!parse_one_place (&end, &negate, &len, &stride))
627 	goto invalid;
628       if (negate)
629 	{
630 	  if (!any_negate)
631 	    count++;
632 	  any_negate = true;
633 	}
634       else
635 	count += len;
636       if (count > 65536)
637 	goto invalid;
638       if (*end == '\0')
639 	break;
640       if (*end != ',')
641 	goto invalid;
642       end++;
643     }
644   while (1);
645 
646   if (ignore)
647     return false;
648 
649   gomp_places_list_len = 0;
650   gomp_places_list = gomp_affinity_alloc (count, false);
651   if (gomp_places_list == NULL)
652     return false;
653 
654   do
655     {
656       bool negate;
657       unsigned long len;
658       long stride;
659       gomp_affinity_init_place (gomp_places_list[gomp_places_list_len]);
660       if (!parse_one_place (&env, &negate, &len, &stride))
661 	goto invalid;
662       if (negate)
663 	{
664 	  void *p;
665 	  for (count = 0; count < gomp_places_list_len; count++)
666 	    if (gomp_affinity_same_place
667 			(gomp_places_list[count],
668 			 gomp_places_list[gomp_places_list_len]))
669 	      break;
670 	  if (count == gomp_places_list_len)
671 	    {
672 	      gomp_error ("Trying to remove a non-existing place from list "
673 			  "of places");
674 	      goto invalid;
675 	    }
676 	  p = gomp_places_list[count];
677 	  memmove (&gomp_places_list[count],
678 		   &gomp_places_list[count + 1],
679 		   (gomp_places_list_len - count - 1) * sizeof (void *));
680 	  --gomp_places_list_len;
681 	  gomp_places_list[gomp_places_list_len] = p;
682 	}
683       else if (len == 1)
684 	++gomp_places_list_len;
685       else
686 	{
687 	  for (count = 0; count < len - 1; count++)
688 	    if (!gomp_affinity_copy_place
689 			(gomp_places_list[gomp_places_list_len + count + 1],
690 			 gomp_places_list[gomp_places_list_len + count],
691 			 stride))
692 	      goto invalid;
693 	  gomp_places_list_len += len;
694 	}
695       if (*env == '\0')
696 	break;
697       env++;
698     }
699   while (1);
700 
701   if (gomp_places_list_len == 0)
702     {
703       gomp_error ("All places have been removed");
704       goto invalid;
705     }
706   if (!gomp_affinity_finalize_place_list (false))
707     goto invalid;
708   return true;
709 
710  invalid:
711   free (gomp_places_list);
712   gomp_places_list = NULL;
713   gomp_places_list_len = 0;
714   gomp_error ("Invalid value for environment variable %s", name);
715   return false;
716 }
717 
718 /* Parse the OMP_STACKSIZE environment varible.  Return true if one was
719    present and it was successfully parsed.  */
720 
721 static bool
722 parse_stacksize (const char *name, unsigned long *pvalue)
723 {
724   char *env, *end;
725   unsigned long value, shift = 10;
726 
727   env = getenv (name);
728   if (env == NULL)
729     return false;
730 
731   while (isspace ((unsigned char) *env))
732     ++env;
733   if (*env == '\0')
734     goto invalid;
735 
736   errno = 0;
737   value = strtoul (env, &end, 10);
738   if (errno)
739     goto invalid;
740 
741   while (isspace ((unsigned char) *end))
742     ++end;
743   if (*end != '\0')
744     {
745       switch (tolower ((unsigned char) *end))
746 	{
747 	case 'b':
748 	  shift = 0;
749 	  break;
750 	case 'k':
751 	  break;
752 	case 'm':
753 	  shift = 20;
754 	  break;
755 	case 'g':
756 	  shift = 30;
757 	  break;
758 	default:
759 	  goto invalid;
760 	}
761       ++end;
762       while (isspace ((unsigned char) *end))
763 	++end;
764       if (*end != '\0')
765 	goto invalid;
766     }
767 
768   if (((value << shift) >> shift) != value)
769     goto invalid;
770 
771   *pvalue = value << shift;
772   return true;
773 
774  invalid:
775   gomp_error ("Invalid value for environment variable %s", name);
776   return false;
777 }
778 
779 /* Parse the GOMP_SPINCOUNT environment varible.  Return true if one was
780    present and it was successfully parsed.  */
781 
782 static bool
783 parse_spincount (const char *name, unsigned long long *pvalue)
784 {
785   char *env, *end;
786   unsigned long long value, mult = 1;
787 
788   env = getenv (name);
789   if (env == NULL)
790     return false;
791 
792   while (isspace ((unsigned char) *env))
793     ++env;
794   if (*env == '\0')
795     goto invalid;
796 
797   if (strncasecmp (env, "infinite", 8) == 0
798       || strncasecmp (env, "infinity", 8) == 0)
799     {
800       value = ~0ULL;
801       end = env + 8;
802       goto check_tail;
803     }
804 
805   errno = 0;
806   value = strtoull (env, &end, 10);
807   if (errno)
808     goto invalid;
809 
810   while (isspace ((unsigned char) *end))
811     ++end;
812   if (*end != '\0')
813     {
814       switch (tolower ((unsigned char) *end))
815 	{
816 	case 'k':
817 	  mult = 1000LL;
818 	  break;
819 	case 'm':
820 	  mult = 1000LL * 1000LL;
821 	  break;
822 	case 'g':
823 	  mult = 1000LL * 1000LL * 1000LL;
824 	  break;
825 	case 't':
826 	  mult = 1000LL * 1000LL * 1000LL * 1000LL;
827 	  break;
828 	default:
829 	  goto invalid;
830 	}
831       ++end;
832      check_tail:
833       while (isspace ((unsigned char) *end))
834 	++end;
835       if (*end != '\0')
836 	goto invalid;
837     }
838 
839   if (value > ~0ULL / mult)
840     value = ~0ULL;
841   else
842     value *= mult;
843 
844   *pvalue = value;
845   return true;
846 
847  invalid:
848   gomp_error ("Invalid value for environment variable %s", name);
849   return false;
850 }
851 
852 /* Parse a boolean value for environment variable NAME and store the
853    result in VALUE.  */
854 
855 static void
856 parse_boolean (const char *name, bool *value)
857 {
858   const char *env;
859 
860   env = getenv (name);
861   if (env == NULL)
862     return;
863 
864   while (isspace ((unsigned char) *env))
865     ++env;
866   if (strncasecmp (env, "true", 4) == 0)
867     {
868       *value = true;
869       env += 4;
870     }
871   else if (strncasecmp (env, "false", 5) == 0)
872     {
873       *value = false;
874       env += 5;
875     }
876   else
877     env = "X";
878   while (isspace ((unsigned char) *env))
879     ++env;
880   if (*env != '\0')
881     gomp_error ("Invalid value for environment variable %s", name);
882 }
883 
884 /* Parse the OMP_WAIT_POLICY environment variable and store the
885    result in gomp_active_wait_policy.  */
886 
887 static int
888 parse_wait_policy (void)
889 {
890   const char *env;
891   int ret = -1;
892 
893   env = getenv ("OMP_WAIT_POLICY");
894   if (env == NULL)
895     return -1;
896 
897   while (isspace ((unsigned char) *env))
898     ++env;
899   if (strncasecmp (env, "active", 6) == 0)
900     {
901       ret = 1;
902       env += 6;
903     }
904   else if (strncasecmp (env, "passive", 7) == 0)
905     {
906       ret = 0;
907       env += 7;
908     }
909   else
910     env = "X";
911   while (isspace ((unsigned char) *env))
912     ++env;
913   if (*env == '\0')
914     return ret;
915   gomp_error ("Invalid value for environment variable OMP_WAIT_POLICY");
916   return -1;
917 }
918 
919 /* Parse the GOMP_CPU_AFFINITY environment varible.  Return true if one was
920    present and it was successfully parsed.  */
921 
922 static bool
923 parse_affinity (bool ignore)
924 {
925   char *env, *end, *start;
926   int pass;
927   unsigned long cpu_beg, cpu_end, cpu_stride;
928   size_t count = 0, needed;
929 
930   env = getenv ("GOMP_CPU_AFFINITY");
931   if (env == NULL)
932     return false;
933 
934   start = env;
935   for (pass = 0; pass < 2; pass++)
936     {
937       env = start;
938       if (pass == 1)
939 	{
940 	  if (ignore)
941 	    return false;
942 
943 	  gomp_places_list_len = 0;
944 	  gomp_places_list = gomp_affinity_alloc (count, true);
945 	  if (gomp_places_list == NULL)
946 	    return false;
947 	}
948       do
949 	{
950 	  while (isspace ((unsigned char) *env))
951 	    ++env;
952 
953 	  errno = 0;
954 	  cpu_beg = strtoul (env, &end, 0);
955 	  if (errno || cpu_beg >= 65536)
956 	    goto invalid;
957 	  cpu_end = cpu_beg;
958 	  cpu_stride = 1;
959 
960 	  env = end;
961 	  if (*env == '-')
962 	    {
963 	      errno = 0;
964 	      cpu_end = strtoul (++env, &end, 0);
965 	      if (errno || cpu_end >= 65536 || cpu_end < cpu_beg)
966 		goto invalid;
967 
968 	      env = end;
969 	      if (*env == ':')
970 		{
971 		  errno = 0;
972 		  cpu_stride = strtoul (++env, &end, 0);
973 		  if (errno || cpu_stride == 0 || cpu_stride >= 65536)
974 		    goto invalid;
975 
976 		  env = end;
977 		}
978 	    }
979 
980 	  needed = (cpu_end - cpu_beg) / cpu_stride + 1;
981 	  if (pass == 0)
982 	    count += needed;
983 	  else
984 	    {
985 	      while (needed--)
986 		{
987 		  void *p = gomp_places_list[gomp_places_list_len];
988 		  gomp_affinity_init_place (p);
989 		  if (gomp_affinity_add_cpus (p, cpu_beg, 1, 0, true))
990 		    ++gomp_places_list_len;
991 		  cpu_beg += cpu_stride;
992 		}
993 	    }
994 
995 	  while (isspace ((unsigned char) *env))
996 	    ++env;
997 
998 	  if (*env == ',')
999 	    env++;
1000 	  else if (*env == '\0')
1001 	    break;
1002 	}
1003       while (1);
1004     }
1005 
1006   if (gomp_places_list_len == 0)
1007     {
1008       free (gomp_places_list);
1009       gomp_places_list = NULL;
1010       return false;
1011     }
1012   return true;
1013 
1014  invalid:
1015   gomp_error ("Invalid value for enviroment variable GOMP_CPU_AFFINITY");
1016   return false;
1017 }
1018 
1019 static void
1020 parse_acc_device_type (void)
1021 {
1022   const char *env = getenv ("ACC_DEVICE_TYPE");
1023 
1024   if (env && *env != '\0')
1025     goacc_device_type = strdup (env);
1026   else
1027     goacc_device_type = NULL;
1028 }
1029 
1030 static void
1031 handle_omp_display_env (unsigned long stacksize, int wait_policy)
1032 {
1033   const char *env;
1034   bool display = false;
1035   bool verbose = false;
1036   int i;
1037 
1038   env = getenv ("OMP_DISPLAY_ENV");
1039   if (env == NULL)
1040     return;
1041 
1042   while (isspace ((unsigned char) *env))
1043     ++env;
1044   if (strncasecmp (env, "true", 4) == 0)
1045     {
1046       display = true;
1047       env += 4;
1048     }
1049   else if (strncasecmp (env, "false", 5) == 0)
1050     {
1051       display = false;
1052       env += 5;
1053     }
1054   else if (strncasecmp (env, "verbose", 7) == 0)
1055     {
1056       display = true;
1057       verbose = true;
1058       env += 7;
1059     }
1060   else
1061     env = "X";
1062   while (isspace ((unsigned char) *env))
1063     ++env;
1064   if (*env != '\0')
1065     gomp_error ("Invalid value for environment variable OMP_DISPLAY_ENV");
1066 
1067   if (!display)
1068     return;
1069 
1070   fputs ("\nOPENMP DISPLAY ENVIRONMENT BEGIN\n", stderr);
1071 
1072   fputs ("  _OPENMP = '201307'\n", stderr);
1073   fprintf (stderr, "  OMP_DYNAMIC = '%s'\n",
1074 	   gomp_global_icv.dyn_var ? "TRUE" : "FALSE");
1075   fprintf (stderr, "  OMP_NESTED = '%s'\n",
1076 	   gomp_global_icv.nest_var ? "TRUE" : "FALSE");
1077 
1078   fprintf (stderr, "  OMP_NUM_THREADS = '%lu", gomp_global_icv.nthreads_var);
1079   for (i = 1; i < gomp_nthreads_var_list_len; i++)
1080     fprintf (stderr, ",%lu", gomp_nthreads_var_list[i]);
1081   fputs ("'\n", stderr);
1082 
1083   fprintf (stderr, "  OMP_SCHEDULE = '");
1084   switch (gomp_global_icv.run_sched_var)
1085     {
1086     case GFS_RUNTIME:
1087       fputs ("RUNTIME", stderr);
1088       break;
1089     case GFS_STATIC:
1090       fputs ("STATIC", stderr);
1091       break;
1092     case GFS_DYNAMIC:
1093       fputs ("DYNAMIC", stderr);
1094       break;
1095     case GFS_GUIDED:
1096       fputs ("GUIDED", stderr);
1097       break;
1098     case GFS_AUTO:
1099       fputs ("AUTO", stderr);
1100       break;
1101     }
1102   fputs ("'\n", stderr);
1103 
1104   fputs ("  OMP_PROC_BIND = '", stderr);
1105   switch (gomp_global_icv.bind_var)
1106     {
1107     case omp_proc_bind_false:
1108       fputs ("FALSE", stderr);
1109       break;
1110     case omp_proc_bind_true:
1111       fputs ("TRUE", stderr);
1112       break;
1113     case omp_proc_bind_master:
1114       fputs ("MASTER", stderr);
1115       break;
1116     case omp_proc_bind_close:
1117       fputs ("CLOSE", stderr);
1118       break;
1119     case omp_proc_bind_spread:
1120       fputs ("SPREAD", stderr);
1121       break;
1122     }
1123   for (i = 1; i < gomp_bind_var_list_len; i++)
1124     switch (gomp_bind_var_list[i])
1125       {
1126       case omp_proc_bind_master:
1127 	fputs (",MASTER", stderr);
1128 	break;
1129       case omp_proc_bind_close:
1130 	fputs (",CLOSE", stderr);
1131 	break;
1132       case omp_proc_bind_spread:
1133 	fputs (",SPREAD", stderr);
1134 	break;
1135       }
1136   fputs ("'\n", stderr);
1137   fputs ("  OMP_PLACES = '", stderr);
1138   for (i = 0; i < gomp_places_list_len; i++)
1139     {
1140       fputs ("{", stderr);
1141       gomp_affinity_print_place (gomp_places_list[i]);
1142       fputs (i + 1 == gomp_places_list_len ? "}" : "},", stderr);
1143     }
1144   fputs ("'\n", stderr);
1145 
1146   fprintf (stderr, "  OMP_STACKSIZE = '%lu'\n", stacksize);
1147 
1148   /* GOMP's default value is actually neither active nor passive.  */
1149   fprintf (stderr, "  OMP_WAIT_POLICY = '%s'\n",
1150 	   wait_policy > 0 ? "ACTIVE" : "PASSIVE");
1151   fprintf (stderr, "  OMP_THREAD_LIMIT = '%u'\n",
1152 	   gomp_global_icv.thread_limit_var);
1153   fprintf (stderr, "  OMP_MAX_ACTIVE_LEVELS = '%lu'\n",
1154 	   gomp_max_active_levels_var);
1155 
1156   fprintf (stderr, "  OMP_CANCELLATION = '%s'\n",
1157 	   gomp_cancel_var ? "TRUE" : "FALSE");
1158   fprintf (stderr, "  OMP_DEFAULT_DEVICE = '%d'\n",
1159 	   gomp_global_icv.default_device_var);
1160 
1161   if (verbose)
1162     {
1163       fputs ("  GOMP_CPU_AFFINITY = ''\n", stderr);
1164       fprintf (stderr, "  GOMP_STACKSIZE = '%lu'\n", stacksize);
1165 #ifdef HAVE_INTTYPES_H
1166       fprintf (stderr, "  GOMP_SPINCOUNT = '%"PRIu64"'\n",
1167 	       (uint64_t) gomp_spin_count_var);
1168 #else
1169       fprintf (stderr, "  GOMP_SPINCOUNT = '%lu'\n",
1170 	       (unsigned long) gomp_spin_count_var);
1171 #endif
1172     }
1173 
1174   fputs ("OPENMP DISPLAY ENVIRONMENT END\n", stderr);
1175 }
1176 
1177 
1178 static void __attribute__((constructor))
1179 initialize_env (void)
1180 {
1181   unsigned long thread_limit_var, stacksize = 0;
1182   int wait_policy;
1183 
1184   /* Do a compile time check that mkomp_h.pl did good job.  */
1185   omp_check_defines ();
1186 
1187   parse_schedule ();
1188   parse_boolean ("OMP_DYNAMIC", &gomp_global_icv.dyn_var);
1189   parse_boolean ("OMP_NESTED", &gomp_global_icv.nest_var);
1190   parse_boolean ("OMP_CANCELLATION", &gomp_cancel_var);
1191   parse_int ("OMP_DEFAULT_DEVICE", &gomp_global_icv.default_device_var, true);
1192   parse_unsigned_long ("OMP_MAX_ACTIVE_LEVELS", &gomp_max_active_levels_var,
1193 		       true);
1194   if (parse_unsigned_long ("OMP_THREAD_LIMIT", &thread_limit_var, false))
1195     {
1196       gomp_global_icv.thread_limit_var
1197 	= thread_limit_var > INT_MAX ? UINT_MAX : thread_limit_var;
1198     }
1199   parse_int ("GOMP_DEBUG", &gomp_debug_var, true);
1200 #ifndef HAVE_SYNC_BUILTINS
1201   gomp_mutex_init (&gomp_managed_threads_lock);
1202 #endif
1203   gomp_init_num_threads ();
1204   gomp_available_cpus = gomp_global_icv.nthreads_var;
1205   if (!parse_unsigned_long_list ("OMP_NUM_THREADS",
1206 				 &gomp_global_icv.nthreads_var,
1207 				 &gomp_nthreads_var_list,
1208 				 &gomp_nthreads_var_list_len))
1209     gomp_global_icv.nthreads_var = gomp_available_cpus;
1210   bool ignore = false;
1211   if (parse_bind_var ("OMP_PROC_BIND",
1212 		      &gomp_global_icv.bind_var,
1213 		      &gomp_bind_var_list,
1214 		      &gomp_bind_var_list_len)
1215       && gomp_global_icv.bind_var == omp_proc_bind_false)
1216     ignore = true;
1217   /* Make sure OMP_PLACES and GOMP_CPU_AFFINITY env vars are always
1218      parsed if present in the environment.  If OMP_PROC_BIND was set
1219      explictly to false, don't populate places list though.  If places
1220      list was successfully set from OMP_PLACES, only parse but don't process
1221      GOMP_CPU_AFFINITY.  If OMP_PROC_BIND was not set in the environment,
1222      default to OMP_PROC_BIND=true if OMP_PLACES or GOMP_CPU_AFFINITY
1223      was successfully parsed into a places list, otherwise to
1224      OMP_PROC_BIND=false.  */
1225   if (parse_places_var ("OMP_PLACES", ignore))
1226     {
1227       if (gomp_global_icv.bind_var == omp_proc_bind_false)
1228 	gomp_global_icv.bind_var = true;
1229       ignore = true;
1230     }
1231   if (parse_affinity (ignore))
1232     {
1233       if (gomp_global_icv.bind_var == omp_proc_bind_false)
1234 	gomp_global_icv.bind_var = true;
1235       ignore = true;
1236     }
1237   if (gomp_global_icv.bind_var != omp_proc_bind_false)
1238     gomp_init_affinity ();
1239   wait_policy = parse_wait_policy ();
1240   if (!parse_spincount ("GOMP_SPINCOUNT", &gomp_spin_count_var))
1241     {
1242       /* Using a rough estimation of 100000 spins per msec,
1243 	 use 5 min blocking for OMP_WAIT_POLICY=active,
1244 	 3 msec blocking when OMP_WAIT_POLICY is not specificed
1245 	 and 0 when OMP_WAIT_POLICY=passive.
1246 	 Depending on the CPU speed, this can be e.g. 5 times longer
1247 	 or 5 times shorter.  */
1248       if (wait_policy > 0)
1249 	gomp_spin_count_var = 30000000000LL;
1250       else if (wait_policy < 0)
1251 	gomp_spin_count_var = 300000LL;
1252     }
1253   /* gomp_throttled_spin_count_var is used when there are more libgomp
1254      managed threads than available CPUs.  Use very short spinning.  */
1255   if (wait_policy > 0)
1256     gomp_throttled_spin_count_var = 1000LL;
1257   else if (wait_policy < 0)
1258     gomp_throttled_spin_count_var = 100LL;
1259   if (gomp_throttled_spin_count_var > gomp_spin_count_var)
1260     gomp_throttled_spin_count_var = gomp_spin_count_var;
1261 
1262   /* Not strictly environment related, but ordering constructors is tricky.  */
1263   pthread_attr_init (&gomp_thread_attr);
1264   pthread_attr_setdetachstate (&gomp_thread_attr, PTHREAD_CREATE_DETACHED);
1265 
1266   if (parse_stacksize ("OMP_STACKSIZE", &stacksize)
1267       || parse_stacksize ("GOMP_STACKSIZE", &stacksize))
1268     {
1269       int err;
1270 
1271       err = pthread_attr_setstacksize (&gomp_thread_attr, stacksize);
1272 
1273 #ifdef PTHREAD_STACK_MIN
1274       if (err == EINVAL)
1275 	{
1276 	  if (stacksize < PTHREAD_STACK_MIN)
1277 	    gomp_error ("Stack size less than minimum of %luk",
1278 			PTHREAD_STACK_MIN / 1024ul
1279 			+ (PTHREAD_STACK_MIN % 1024 != 0));
1280 	  else
1281 	    gomp_error ("Stack size larger than system limit");
1282 	}
1283       else
1284 #endif
1285       if (err != 0)
1286 	gomp_error ("Stack size change failed: %s", strerror (err));
1287     }
1288 
1289   handle_omp_display_env (stacksize, wait_policy);
1290 
1291   /* OpenACC.  */
1292 
1293   if (!parse_int ("ACC_DEVICE_NUM", &goacc_device_num, true))
1294     goacc_device_num = 0;
1295 
1296   parse_acc_device_type ();
1297 
1298   goacc_runtime_initialize ();
1299 }
1300 
1301 
1302 /* The public OpenMP API routines that access these variables.  */
1303 
1304 void
1305 omp_set_num_threads (int n)
1306 {
1307   struct gomp_task_icv *icv = gomp_icv (true);
1308   icv->nthreads_var = (n > 0 ? n : 1);
1309 }
1310 
1311 void
1312 omp_set_dynamic (int val)
1313 {
1314   struct gomp_task_icv *icv = gomp_icv (true);
1315   icv->dyn_var = val;
1316 }
1317 
1318 int
1319 omp_get_dynamic (void)
1320 {
1321   struct gomp_task_icv *icv = gomp_icv (false);
1322   return icv->dyn_var;
1323 }
1324 
1325 void
1326 omp_set_nested (int val)
1327 {
1328   struct gomp_task_icv *icv = gomp_icv (true);
1329   icv->nest_var = val;
1330 }
1331 
1332 int
1333 omp_get_nested (void)
1334 {
1335   struct gomp_task_icv *icv = gomp_icv (false);
1336   return icv->nest_var;
1337 }
1338 
1339 void
1340 omp_set_schedule (omp_sched_t kind, int modifier)
1341 {
1342   struct gomp_task_icv *icv = gomp_icv (true);
1343   switch (kind)
1344     {
1345     case omp_sched_static:
1346       if (modifier < 1)
1347 	modifier = 0;
1348       icv->run_sched_modifier = modifier;
1349       break;
1350     case omp_sched_dynamic:
1351     case omp_sched_guided:
1352       if (modifier < 1)
1353 	modifier = 1;
1354       icv->run_sched_modifier = modifier;
1355       break;
1356     case omp_sched_auto:
1357       break;
1358     default:
1359       return;
1360     }
1361   icv->run_sched_var = kind;
1362 }
1363 
1364 void
1365 omp_get_schedule (omp_sched_t *kind, int *modifier)
1366 {
1367   struct gomp_task_icv *icv = gomp_icv (false);
1368   *kind = icv->run_sched_var;
1369   *modifier = icv->run_sched_modifier;
1370 }
1371 
1372 int
1373 omp_get_max_threads (void)
1374 {
1375   struct gomp_task_icv *icv = gomp_icv (false);
1376   return icv->nthreads_var;
1377 }
1378 
1379 int
1380 omp_get_thread_limit (void)
1381 {
1382   struct gomp_task_icv *icv = gomp_icv (false);
1383   return icv->thread_limit_var > INT_MAX ? INT_MAX : icv->thread_limit_var;
1384 }
1385 
1386 void
1387 omp_set_max_active_levels (int max_levels)
1388 {
1389   if (max_levels >= 0)
1390     gomp_max_active_levels_var = max_levels;
1391 }
1392 
1393 int
1394 omp_get_max_active_levels (void)
1395 {
1396   return gomp_max_active_levels_var;
1397 }
1398 
1399 int
1400 omp_get_cancellation (void)
1401 {
1402   return gomp_cancel_var;
1403 }
1404 
1405 omp_proc_bind_t
1406 omp_get_proc_bind (void)
1407 {
1408   struct gomp_task_icv *icv = gomp_icv (false);
1409   return icv->bind_var;
1410 }
1411 
1412 void
1413 omp_set_default_device (int device_num)
1414 {
1415   struct gomp_task_icv *icv = gomp_icv (true);
1416   icv->default_device_var = device_num >= 0 ? device_num : 0;
1417 }
1418 
1419 int
1420 omp_get_default_device (void)
1421 {
1422   struct gomp_task_icv *icv = gomp_icv (false);
1423   return icv->default_device_var;
1424 }
1425 
1426 int
1427 omp_get_num_devices (void)
1428 {
1429   return gomp_get_num_devices ();
1430 }
1431 
1432 int
1433 omp_get_num_teams (void)
1434 {
1435   /* Hardcoded to 1 on host, MIC, HSAIL?  Maybe variable on PTX.  */
1436   return 1;
1437 }
1438 
1439 int
1440 omp_get_team_num (void)
1441 {
1442   /* Hardcoded to 0 on host, MIC, HSAIL?  Maybe variable on PTX.  */
1443   return 0;
1444 }
1445 
1446 int
1447 omp_is_initial_device (void)
1448 {
1449   /* Hardcoded to 1 on host, should be 0 on MIC, HSAIL, PTX.  */
1450   return 1;
1451 }
1452 
1453 ialias (omp_set_dynamic)
1454 ialias (omp_set_nested)
1455 ialias (omp_set_num_threads)
1456 ialias (omp_get_dynamic)
1457 ialias (omp_get_nested)
1458 ialias (omp_set_schedule)
1459 ialias (omp_get_schedule)
1460 ialias (omp_get_max_threads)
1461 ialias (omp_get_thread_limit)
1462 ialias (omp_set_max_active_levels)
1463 ialias (omp_get_max_active_levels)
1464 ialias (omp_get_cancellation)
1465 ialias (omp_get_proc_bind)
1466 ialias (omp_set_default_device)
1467 ialias (omp_get_default_device)
1468 ialias (omp_get_num_devices)
1469 ialias (omp_get_num_teams)
1470 ialias (omp_get_team_num)
1471 ialias (omp_is_initial_device)
1472