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