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