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
57struct 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
69unsigned long gomp_max_active_levels_var = INT_MAX;
70bool gomp_cancel_var = false;
71#ifndef HAVE_SYNC_BUILTINS
72gomp_mutex_t gomp_managed_threads_lock;
73#endif
74unsigned long gomp_available_cpus = 1, gomp_managed_threads = 1;
75unsigned long long gomp_spin_count_var, gomp_throttled_spin_count_var;
76unsigned long *gomp_nthreads_var_list, gomp_nthreads_var_list_len;
77char *gomp_bind_var_list;
78unsigned long gomp_bind_var_list_len;
79void **gomp_places_list;
80unsigned long gomp_places_list_len;
81int gomp_debug_var;
82char *goacc_device_type;
83int goacc_device_num;
84
85/* Parse the OMP_SCHEDULE environment variable.  */
86
87static void
88parse_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
168static bool
169parse_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
204static bool
205parse_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
222static bool
223parse_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
312static bool
313parse_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
425static bool
426parse_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
555static bool
556parse_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
721static bool
722parse_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
782static bool
783parse_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
855static void
856parse_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
887static int
888parse_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
922static bool
923parse_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
1019static void
1020parse_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
1030static void
1031handle_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
1178static void __attribute__((constructor))
1179initialize_env (void)
1180{
1181  unsigned long thread_limit_var, stacksize;
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
1304void
1305omp_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
1311void
1312omp_set_dynamic (int val)
1313{
1314  struct gomp_task_icv *icv = gomp_icv (true);
1315  icv->dyn_var = val;
1316}
1317
1318int
1319omp_get_dynamic (void)
1320{
1321  struct gomp_task_icv *icv = gomp_icv (false);
1322  return icv->dyn_var;
1323}
1324
1325void
1326omp_set_nested (int val)
1327{
1328  struct gomp_task_icv *icv = gomp_icv (true);
1329  icv->nest_var = val;
1330}
1331
1332int
1333omp_get_nested (void)
1334{
1335  struct gomp_task_icv *icv = gomp_icv (false);
1336  return icv->nest_var;
1337}
1338
1339void
1340omp_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
1364void
1365omp_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
1372int
1373omp_get_max_threads (void)
1374{
1375  struct gomp_task_icv *icv = gomp_icv (false);
1376  return icv->nthreads_var;
1377}
1378
1379int
1380omp_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
1386void
1387omp_set_max_active_levels (int max_levels)
1388{
1389  if (max_levels >= 0)
1390    gomp_max_active_levels_var = max_levels;
1391}
1392
1393int
1394omp_get_max_active_levels (void)
1395{
1396  return gomp_max_active_levels_var;
1397}
1398
1399int
1400omp_get_cancellation (void)
1401{
1402  return gomp_cancel_var;
1403}
1404
1405omp_proc_bind_t
1406omp_get_proc_bind (void)
1407{
1408  struct gomp_task_icv *icv = gomp_icv (false);
1409  return icv->bind_var;
1410}
1411
1412void
1413omp_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
1419int
1420omp_get_default_device (void)
1421{
1422  struct gomp_task_icv *icv = gomp_icv (false);
1423  return icv->default_device_var;
1424}
1425
1426int
1427omp_get_num_devices (void)
1428{
1429  return gomp_get_num_devices ();
1430}
1431
1432int
1433omp_get_num_teams (void)
1434{
1435  /* Hardcoded to 1 on host, MIC, HSAIL?  Maybe variable on PTX.  */
1436  return 1;
1437}
1438
1439int
1440omp_get_team_num (void)
1441{
1442  /* Hardcoded to 0 on host, MIC, HSAIL?  Maybe variable on PTX.  */
1443  return 0;
1444}
1445
1446int
1447omp_is_initial_device (void)
1448{
1449  /* Hardcoded to 1 on host, should be 0 on MIC, HSAIL, PTX.  */
1450  return 1;
1451}
1452
1453ialias (omp_set_dynamic)
1454ialias (omp_set_nested)
1455ialias (omp_set_num_threads)
1456ialias (omp_get_dynamic)
1457ialias (omp_get_nested)
1458ialias (omp_set_schedule)
1459ialias (omp_get_schedule)
1460ialias (omp_get_max_threads)
1461ialias (omp_get_thread_limit)
1462ialias (omp_set_max_active_levels)
1463ialias (omp_get_max_active_levels)
1464ialias (omp_get_cancellation)
1465ialias (omp_get_proc_bind)
1466ialias (omp_set_default_device)
1467ialias (omp_get_default_device)
1468ialias (omp_get_num_devices)
1469ialias (omp_get_num_teams)
1470ialias (omp_get_team_num)
1471ialias (omp_is_initial_device)
1472