libgomp/env.c

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