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