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