libgomp/env.c

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