libgomp/fortran.c

   1 /* Copyright (C) 2005-2018 Free Software Foundation, Inc.
   2    Contributed by Jakub Jelinek <jakub@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 contains Fortran wrapper routines.  */
  27
  28 #include "libgomp.h"
  29 #include "libgomp_f.h"
  30 #include <stdlib.h>
  31 #include <limits.h>
  32
  33 #ifdef HAVE_ATTRIBUTE_ALIAS
  34 /* Use internal aliases if possible.  */
  35 # ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
  36 ialias_redirect (omp_init_lock)
  37 ialias_redirect (omp_init_nest_lock)
  38 ialias_redirect (omp_destroy_lock)
  39 ialias_redirect (omp_destroy_nest_lock)
  40 ialias_redirect (omp_set_lock)
  41 ialias_redirect (omp_set_nest_lock)
  42 ialias_redirect (omp_unset_lock)
  43 ialias_redirect (omp_unset_nest_lock)
  44 ialias_redirect (omp_test_lock)
  45 ialias_redirect (omp_test_nest_lock)
  46 # endif
  47 ialias_redirect (omp_set_dynamic)
  48 ialias_redirect (omp_set_nested)
  49 ialias_redirect (omp_set_num_threads)
  50 ialias_redirect (omp_get_dynamic)
  51 ialias_redirect (omp_get_nested)
  52 ialias_redirect (omp_in_parallel)
  53 ialias_redirect (omp_get_max_threads)
  54 ialias_redirect (omp_get_num_procs)
  55 ialias_redirect (omp_get_num_threads)
  56 ialias_redirect (omp_get_thread_num)
  57 ialias_redirect (omp_get_wtick)
  58 ialias_redirect (omp_get_wtime)
  59 ialias_redirect (omp_set_schedule)
  60 ialias_redirect (omp_get_schedule)
  61 ialias_redirect (omp_get_thread_limit)
  62 ialias_redirect (omp_set_max_active_levels)
  63 ialias_redirect (omp_get_max_active_levels)
  64 ialias_redirect (omp_get_level)
  65 ialias_redirect (omp_get_ancestor_thread_num)
  66 ialias_redirect (omp_get_team_size)
  67 ialias_redirect (omp_get_active_level)
  68 ialias_redirect (omp_in_final)
  69 ialias_redirect (omp_get_cancellation)
  70 ialias_redirect (omp_get_proc_bind)
  71 ialias_redirect (omp_get_num_places)
  72 ialias_redirect (omp_get_place_num_procs)
  73 ialias_redirect (omp_get_place_proc_ids)
  74 ialias_redirect (omp_get_place_num)
  75 ialias_redirect (omp_get_partition_num_places)
  76 ialias_redirect (omp_get_partition_place_nums)
  77 ialias_redirect (omp_set_default_device)
  78 ialias_redirect (omp_get_default_device)
  79 ialias_redirect (omp_get_num_devices)
  80 ialias_redirect (omp_get_num_teams)
  81 ialias_redirect (omp_get_team_num)
  82 ialias_redirect (omp_is_initial_device)
  83 ialias_redirect (omp_get_initial_device)
  84 ialias_redirect (omp_get_max_task_priority)
  85 #endif
  86
  87 #ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
  88 # define gomp_init_lock__30 omp_init_lock_
  89 # define gomp_destroy_lock__30 omp_destroy_lock_
  90 # define gomp_set_lock__30 omp_set_lock_
  91 # define gomp_unset_lock__30 omp_unset_lock_
  92 # define gomp_test_lock__30 omp_test_lock_
  93 # define gomp_init_nest_lock__30 omp_init_nest_lock_
  94 # define gomp_destroy_nest_lock__30 omp_destroy_nest_lock_
  95 # define gomp_set_nest_lock__30 omp_set_nest_lock_
  96 # define gomp_unset_nest_lock__30 omp_unset_nest_lock_
  97 # define gomp_test_nest_lock__30 omp_test_nest_lock_
  98 #endif
  99
 100 void
 101 gomp_init_lock__30 (omp_lock_arg_t lock)
 102 {
 103 #ifndef OMP_LOCK_DIRECT
 104   omp_lock_arg (lock) = malloc (sizeof (omp_lock_t));
 105 #endif
 106   gomp_init_lock_30 (omp_lock_arg (lock));
 107 }
 108
 109 void
 110 gomp_init_nest_lock__30 (omp_nest_lock_arg_t lock)
 111 {
 112 #ifndef OMP_NEST_LOCK_DIRECT
 113   omp_nest_lock_arg (lock) = malloc (sizeof (omp_nest_lock_t));
 114 #endif
 115   gomp_init_nest_lock_30 (omp_nest_lock_arg (lock));
 116 }
 117
 118 void
 119 gomp_destroy_lock__30 (omp_lock_arg_t lock)
 120 {
 121   gomp_destroy_lock_30 (omp_lock_arg (lock));
 122 #ifndef OMP_LOCK_DIRECT
 123   free (omp_lock_arg (lock));
 124   omp_lock_arg (lock) = NULL;
 125 #endif
 126 }
 127
 128 void
 129 gomp_destroy_nest_lock__30 (omp_nest_lock_arg_t lock)
 130 {
 131   gomp_destroy_nest_lock_30 (omp_nest_lock_arg (lock));
 132 #ifndef OMP_NEST_LOCK_DIRECT
 133   free (omp_nest_lock_arg (lock));
 134   omp_nest_lock_arg (lock) = NULL;
 135 #endif
 136 }
 137
 138 void
 139 gomp_set_lock__30 (omp_lock_arg_t lock)
 140 {
 141   gomp_set_lock_30 (omp_lock_arg (lock));
 142 }
 143
 144 void
 145 gomp_set_nest_lock__30 (omp_nest_lock_arg_t lock)
 146 {
 147   gomp_set_nest_lock_30 (omp_nest_lock_arg (lock));
 148 }
 149
 150 void
 151 gomp_unset_lock__30 (omp_lock_arg_t lock)
 152 {
 153   gomp_unset_lock_30 (omp_lock_arg (lock));
 154 }
 155
 156 void
 157 gomp_unset_nest_lock__30 (omp_nest_lock_arg_t lock)
 158 {
 159   gomp_unset_nest_lock_30 (omp_nest_lock_arg (lock));
 160 }
 161
 162 int32_t
 163 gomp_test_lock__30 (omp_lock_arg_t lock)
 164 {
 165   return gomp_test_lock_30 (omp_lock_arg (lock));
 166 }
 167
 168 int32_t
 169 gomp_test_nest_lock__30 (omp_nest_lock_arg_t lock)
 170 {
 171   return gomp_test_nest_lock_30 (omp_nest_lock_arg (lock));
 172 }
 173
 174 #ifdef LIBGOMP_GNU_SYMBOL_VERSIONING
 175 void
 176 gomp_init_lock__25 (omp_lock_25_arg_t lock)
 177 {
 178 #ifndef OMP_LOCK_25_DIRECT
 179   omp_lock_25_arg (lock) = malloc (sizeof (omp_lock_25_t));
 180 #endif
 181   gomp_init_lock_25 (omp_lock_25_arg (lock));
 182 }
 183
 184 void
 185 gomp_init_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 186 {
 187 #ifndef OMP_NEST_LOCK_25_DIRECT
 188   omp_nest_lock_25_arg (lock) = malloc (sizeof (omp_nest_lock_25_t));
 189 #endif
 190   gomp_init_nest_lock_25 (omp_nest_lock_25_arg (lock));
 191 }
 192
 193 void
 194 gomp_destroy_lock__25 (omp_lock_25_arg_t lock)
 195 {
 196   gomp_destroy_lock_25 (omp_lock_25_arg (lock));
 197 #ifndef OMP_LOCK_25_DIRECT
 198   free (omp_lock_25_arg (lock));
 199   omp_lock_25_arg (lock) = NULL;
 200 #endif
 201 }
 202
 203 void
 204 gomp_destroy_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 205 {
 206   gomp_destroy_nest_lock_25 (omp_nest_lock_25_arg (lock));
 207 #ifndef OMP_NEST_LOCK_25_DIRECT
 208   free (omp_nest_lock_25_arg (lock));
 209   omp_nest_lock_25_arg (lock) = NULL;
 210 #endif
 211 }
 212
 213 void
 214 gomp_set_lock__25 (omp_lock_25_arg_t lock)
 215 {
 216   gomp_set_lock_25 (omp_lock_25_arg (lock));
 217 }
 218
 219 void
 220 gomp_set_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 221 {
 222   gomp_set_nest_lock_25 (omp_nest_lock_25_arg (lock));
 223 }
 224
 225 void
 226 gomp_unset_lock__25 (omp_lock_25_arg_t lock)
 227 {
 228   gomp_unset_lock_25 (omp_lock_25_arg (lock));
 229 }
 230
 231 void
 232 gomp_unset_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 233 {
 234   gomp_unset_nest_lock_25 (omp_nest_lock_25_arg (lock));
 235 }
 236
 237 int32_t
 238 gomp_test_lock__25 (omp_lock_25_arg_t lock)
 239 {
 240   return gomp_test_lock_25 (omp_lock_25_arg (lock));
 241 }
 242
 243 int32_t
 244 gomp_test_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 245 {
 246   return gomp_test_nest_lock_25 (omp_nest_lock_25_arg (lock));
 247 }
 248
 249 omp_lock_symver (omp_init_lock_)
 250 omp_lock_symver (omp_destroy_lock_)
 251 omp_lock_symver (omp_set_lock_)
 252 omp_lock_symver (omp_unset_lock_)
 253 omp_lock_symver (omp_test_lock_)
 254 omp_lock_symver (omp_init_nest_lock_)
 255 omp_lock_symver (omp_destroy_nest_lock_)
 256 omp_lock_symver (omp_set_nest_lock_)
 257 omp_lock_symver (omp_unset_nest_lock_)
 258 omp_lock_symver (omp_test_nest_lock_)
 259 #endif
 260
 261 #define TO_INT(x) ((x) > INT_MIN ? (x) < INT_MAX ? (x) : INT_MAX : INT_MIN)
 262
 263 void
 264 omp_set_dynamic_ (const int32_t *set)
 265 {
 266   omp_set_dynamic (*set);
 267 }
 268
 269 void
 270 omp_set_dynamic_8_ (const int64_t *set)
 271 {
 272   omp_set_dynamic (!!*set);
 273 }
 274
 275 void
 276 omp_set_nested_ (const int32_t *set)
 277 {
 278   omp_set_nested (*set);
 279 }
 280
 281 void
 282 omp_set_nested_8_ (const int64_t *set)
 283 {
 284   omp_set_nested (!!*set);
 285 }
 286
 287 void
 288 omp_set_num_threads_ (const int32_t *set)
 289 {
 290   omp_set_num_threads (*set);
 291 }
 292
 293 void
 294 omp_set_num_threads_8_ (const int64_t *set)
 295 {
 296   omp_set_num_threads (TO_INT (*set));
 297 }
 298
 299 int32_t
 300 omp_get_dynamic_ (void)
 301 {
 302   return omp_get_dynamic ();
 303 }
 304
 305 int32_t
 306 omp_get_nested_ (void)
 307 {
 308   return omp_get_nested ();
 309 }
 310
 311 int32_t
 312 omp_in_parallel_ (void)
 313 {
 314   return omp_in_parallel ();
 315 }
 316
 317 int32_t
 318 omp_get_max_threads_ (void)
 319 {
 320   return omp_get_max_threads ();
 321 }
 322
 323 int32_t
 324 omp_get_num_procs_ (void)
 325 {
 326   return omp_get_num_procs ();
 327 }
 328
 329 int32_t
 330 omp_get_num_threads_ (void)
 331 {
 332   return omp_get_num_threads ();
 333 }
 334
 335 int32_t
 336 omp_get_thread_num_ (void)
 337 {
 338   return omp_get_thread_num ();
 339 }
 340
 341 double
 342 omp_get_wtick_ (void)
 343 {
 344   return omp_get_wtick ();
 345 }
 346
 347 double
 348 omp_get_wtime_ (void)
 349 {
 350   return omp_get_wtime ();
 351 }
 352
 353 void
 354 omp_set_schedule_ (const int32_t *kind, const int32_t *chunk_size)
 355 {
 356   omp_set_schedule (*kind, *chunk_size);
 357 }
 358
 359 void
 360 omp_set_schedule_8_ (const int32_t *kind, const int64_t *chunk_size)
 361 {
 362   omp_set_schedule (*kind, TO_INT (*chunk_size));
 363 }
 364
 365 void
 366 omp_get_schedule_ (int32_t *kind, int32_t *chunk_size)
 367 {
 368   omp_sched_t k;
 369   int cs;
 370   omp_get_schedule (&k, &cs);
 371   *kind = k;
 372   *chunk_size = cs;
 373 }
 374
 375 void
 376 omp_get_schedule_8_ (int32_t *kind, int64_t *chunk_size)
 377 {
 378   omp_sched_t k;
 379   int cs;
 380   omp_get_schedule (&k, &cs);
 381   *kind = k;
 382   *chunk_size = cs;
 383 }
 384
 385 int32_t
 386 omp_get_thread_limit_ (void)
 387 {
 388   return omp_get_thread_limit ();
 389 }
 390
 391 void
 392 omp_set_max_active_levels_ (const int32_t *levels)
 393 {
 394   omp_set_max_active_levels (*levels);
 395 }
 396
 397 void
 398 omp_set_max_active_levels_8_ (const int64_t *levels)
 399 {
 400   omp_set_max_active_levels (TO_INT (*levels));
 401 }
 402
 403 int32_t
 404 omp_get_max_active_levels_ (void)
 405 {
 406   return omp_get_max_active_levels ();
 407 }
 408
 409 int32_t
 410 omp_get_level_ (void)
 411 {
 412   return omp_get_level ();
 413 }
 414
 415 int32_t
 416 omp_get_ancestor_thread_num_ (const int32_t *level)
 417 {
 418   return omp_get_ancestor_thread_num (*level);
 419 }
 420
 421 int32_t
 422 omp_get_ancestor_thread_num_8_ (const int64_t *level)
 423 {
 424   return omp_get_ancestor_thread_num (TO_INT (*level));
 425 }
 426
 427 int32_t
 428 omp_get_team_size_ (const int32_t *level)
 429 {
 430   return omp_get_team_size (*level);
 431 }
 432
 433 int32_t
 434 omp_get_team_size_8_ (const int64_t *level)
 435 {
 436   return omp_get_team_size (TO_INT (*level));
 437 }
 438
 439 int32_t
 440 omp_get_active_level_ (void)
 441 {
 442   return omp_get_active_level ();
 443 }
 444
 445 int32_t
 446 omp_in_final_ (void)
 447 {
 448   return omp_in_final ();
 449 }
 450
 451 int32_t
 452 omp_get_cancellation_ (void)
 453 {
 454   return omp_get_cancellation ();
 455 }
 456
 457 int32_t
 458 omp_get_proc_bind_ (void)
 459 {
 460   return omp_get_proc_bind ();
 461 }
 462
 463 int32_t
 464 omp_get_num_places_ (void)
 465 {
 466   return omp_get_num_places ();
 467 }
 468
 469 int32_t
 470 omp_get_place_num_procs_ (const int32_t *place_num)
 471 {
 472   return omp_get_place_num_procs (*place_num);
 473 }
 474
 475 int32_t
 476 omp_get_place_num_procs_8_ (const int64_t *place_num)
 477 {
 478   return omp_get_place_num_procs (TO_INT (*place_num));
 479 }
 480
 481 void
 482 omp_get_place_proc_ids_ (const int32_t *place_num, int32_t *ids)
 483 {
 484   omp_get_place_proc_ids (*place_num, (int *) ids);
 485 }
 486
 487 void
 488 omp_get_place_proc_ids_8_ (const int64_t *place_num, int64_t *ids)
 489 {
 490   gomp_get_place_proc_ids_8 (TO_INT (*place_num), ids);
 491 }
 492
 493 int32_t
 494 omp_get_place_num_ (void)
 495 {
 496   return omp_get_place_num ();
 497 }
 498
 499 int32_t
 500 omp_get_partition_num_places_ (void)
 501 {
 502   return omp_get_partition_num_places ();
 503 }
 504
 505 void
 506 omp_get_partition_place_nums_ (int32_t *place_nums)
 507 {
 508   omp_get_partition_place_nums ((int *) place_nums);
 509 }
 510
 511 void
 512 omp_get_partition_place_nums_8_ (int64_t *place_nums)
 513 {
 514   if (gomp_places_list == NULL)
 515     return;
 516
 517   struct gomp_thread *thr = gomp_thread ();
 518   if (thr->place == 0)
 519     gomp_init_affinity ();
 520
 521   unsigned int i;
 522   for (i = 0; i < thr->ts.place_partition_len; i++)
 523     *place_nums++ = (int64_t) thr->ts.place_partition_off + i;
 524 }
 525
 526 void
 527 omp_set_default_device_ (const int32_t *device_num)
 528 {
 529   return omp_set_default_device (*device_num);
 530 }
 531
 532 void
 533 omp_set_default_device_8_ (const int64_t *device_num)
 534 {
 535   return omp_set_default_device (TO_INT (*device_num));
 536 }
 537
 538 int32_t
 539 omp_get_default_device_ (void)
 540 {
 541   return omp_get_default_device ();
 542 }
 543
 544 int32_t
 545 omp_get_num_devices_ (void)
 546 {
 547   return omp_get_num_devices ();
 548 }
 549
 550 int32_t
 551 omp_get_num_teams_ (void)
 552 {
 553   return omp_get_num_teams ();
 554 }
 555
 556 int32_t
 557 omp_get_team_num_ (void)
 558 {
 559   return omp_get_team_num ();
 560 }
 561
 562 int32_t
 563 omp_is_initial_device_ (void)
 564 {
 565   return omp_is_initial_device ();
 566 }
 567
 568 int32_t
 569 omp_get_initial_device_ (void)
 570 {
 571   return omp_get_initial_device ();
 572 }
 573
 574 int32_t
 575 omp_get_max_task_priority_ (void)
 576 {
 577   return omp_get_max_task_priority ();
 578 }