1/* Copyright (C) 2005-2020 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 38ialias_redirect (omp_init_lock) 39ialias_redirect (omp_init_nest_lock) 40ialias_redirect (omp_destroy_lock) 41ialias_redirect (omp_destroy_nest_lock) 42ialias_redirect (omp_set_lock) 43ialias_redirect (omp_set_nest_lock) 44ialias_redirect (omp_unset_lock) 45ialias_redirect (omp_unset_nest_lock) 46ialias_redirect (omp_test_lock) 47ialias_redirect (omp_test_nest_lock) 48# endif 49ialias_redirect (omp_set_dynamic) 50ialias_redirect (omp_set_nested) 51ialias_redirect (omp_set_num_threads) 52ialias_redirect (omp_get_dynamic) 53ialias_redirect (omp_get_nested) 54ialias_redirect (omp_in_parallel) 55ialias_redirect (omp_get_max_threads) 56ialias_redirect (omp_get_num_procs) 57ialias_redirect (omp_get_num_threads) 58ialias_redirect (omp_get_thread_num) 59ialias_redirect (omp_get_wtick) 60ialias_redirect (omp_get_wtime) 61ialias_redirect (omp_set_schedule) 62ialias_redirect (omp_get_schedule) 63ialias_redirect (omp_get_thread_limit) 64ialias_redirect (omp_set_max_active_levels) 65ialias_redirect (omp_get_max_active_levels) 66ialias_redirect (omp_get_level) 67ialias_redirect (omp_get_ancestor_thread_num) 68ialias_redirect (omp_get_team_size) 69ialias_redirect (omp_get_active_level) 70ialias_redirect (omp_in_final) 71ialias_redirect (omp_get_cancellation) 72ialias_redirect (omp_get_proc_bind) 73ialias_redirect (omp_get_num_places) 74ialias_redirect (omp_get_place_num_procs) 75ialias_redirect (omp_get_place_proc_ids) 76ialias_redirect (omp_get_place_num) 77ialias_redirect (omp_get_partition_num_places) 78ialias_redirect (omp_get_partition_place_nums) 79ialias_redirect (omp_set_default_device) 80ialias_redirect (omp_get_default_device) 81ialias_redirect (omp_get_num_devices) 82ialias_redirect (omp_get_num_teams) 83ialias_redirect (omp_get_team_num) 84ialias_redirect (omp_is_initial_device) 85ialias_redirect (omp_get_initial_device) 86ialias_redirect (omp_get_max_task_priority) 87ialias_redirect (omp_pause_resource) 88ialias_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 104void 105gomp_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 113void 114gomp_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 122void 123gomp_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 132void 133gomp_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 142void 143gomp_set_lock__30 (omp_lock_arg_t lock) 144{ 145 gomp_set_lock_30 (omp_lock_arg (lock)); 146} 147 148void 149gomp_set_nest_lock__30 (omp_nest_lock_arg_t lock) 150{ 151 gomp_set_nest_lock_30 (omp_nest_lock_arg (lock)); 152} 153 154void 155gomp_unset_lock__30 (omp_lock_arg_t lock) 156{ 157 gomp_unset_lock_30 (omp_lock_arg (lock)); 158} 159 160void 161gomp_unset_nest_lock__30 (omp_nest_lock_arg_t lock) 162{ 163 gomp_unset_nest_lock_30 (omp_nest_lock_arg (lock)); 164} 165 166int32_t 167gomp_test_lock__30 (omp_lock_arg_t lock) 168{ 169 return gomp_test_lock_30 (omp_lock_arg (lock)); 170} 171 172int32_t 173gomp_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 179void 180gomp_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 188void 189gomp_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 197void 198gomp_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 207void 208gomp_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 217void 218gomp_set_lock__25 (omp_lock_25_arg_t lock) 219{ 220 gomp_set_lock_25 (omp_lock_25_arg (lock)); 221} 222 223void 224gomp_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 229void 230gomp_unset_lock__25 (omp_lock_25_arg_t lock) 231{ 232 gomp_unset_lock_25 (omp_lock_25_arg (lock)); 233} 234 235void 236gomp_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 241int32_t 242gomp_test_lock__25 (omp_lock_25_arg_t lock) 243{ 244 return gomp_test_lock_25 (omp_lock_25_arg (lock)); 245} 246 247int32_t 248gomp_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 253omp_lock_symver (omp_init_lock_) 254omp_lock_symver (omp_destroy_lock_) 255omp_lock_symver (omp_set_lock_) 256omp_lock_symver (omp_unset_lock_) 257omp_lock_symver (omp_test_lock_) 258omp_lock_symver (omp_init_nest_lock_) 259omp_lock_symver (omp_destroy_nest_lock_) 260omp_lock_symver (omp_set_nest_lock_) 261omp_lock_symver (omp_unset_nest_lock_) 262omp_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 267void 268omp_set_dynamic_ (const int32_t *set) 269{ 270 omp_set_dynamic (*set); 271} 272 273void 274omp_set_dynamic_8_ (const int64_t *set) 275{ 276 omp_set_dynamic (!!*set); 277} 278 279void 280omp_set_nested_ (const int32_t *set) 281{ 282 omp_set_nested (*set); 283} 284 285void 286omp_set_nested_8_ (const int64_t *set) 287{ 288 omp_set_nested (!!*set); 289} 290 291void 292omp_set_num_threads_ (const int32_t *set) 293{ 294 omp_set_num_threads (*set); 295} 296 297void 298omp_set_num_threads_8_ (const int64_t *set) 299{ 300 omp_set_num_threads (TO_INT (*set)); 301} 302 303int32_t 304omp_get_dynamic_ (void) 305{ 306 return omp_get_dynamic (); 307} 308 309int32_t 310omp_get_nested_ (void) 311{ 312 return omp_get_nested (); 313} 314 315int32_t 316omp_in_parallel_ (void) 317{ 318 return omp_in_parallel (); 319} 320 321int32_t 322omp_get_max_threads_ (void) 323{ 324 return omp_get_max_threads (); 325} 326 327int32_t 328omp_get_num_procs_ (void) 329{ 330 return omp_get_num_procs (); 331} 332 333int32_t 334omp_get_num_threads_ (void) 335{ 336 return omp_get_num_threads (); 337} 338 339int32_t 340omp_get_thread_num_ (void) 341{ 342 return omp_get_thread_num (); 343} 344 345double 346omp_get_wtick_ (void) 347{ 348 return omp_get_wtick (); 349} 350 351double 352omp_get_wtime_ (void) 353{ 354 return omp_get_wtime (); 355} 356 357void 358omp_set_schedule_ (const int32_t *kind, const int32_t *chunk_size) 359{ 360 omp_set_schedule (*kind, *chunk_size); 361} 362 363void 364omp_set_schedule_8_ (const int32_t *kind, const int64_t *chunk_size) 365{ 366 omp_set_schedule (*kind, TO_INT (*chunk_size)); 367} 368 369void 370omp_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 381void 382omp_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 392int32_t 393omp_get_thread_limit_ (void) 394{ 395 return omp_get_thread_limit (); 396} 397 398void 399omp_set_max_active_levels_ (const int32_t *levels) 400{ 401 omp_set_max_active_levels (*levels); 402} 403 404void 405omp_set_max_active_levels_8_ (const int64_t *levels) 406{ 407 omp_set_max_active_levels (TO_INT (*levels)); 408} 409 410int32_t 411omp_get_max_active_levels_ (void) 412{ 413 return omp_get_max_active_levels (); 414} 415 416int32_t 417omp_get_level_ (void) 418{ 419 return omp_get_level (); 420} 421 422int32_t 423omp_get_ancestor_thread_num_ (const int32_t *level) 424{ 425 return omp_get_ancestor_thread_num (*level); 426} 427 428int32_t 429omp_get_ancestor_thread_num_8_ (const int64_t *level) 430{ 431 return omp_get_ancestor_thread_num (TO_INT (*level)); 432} 433 434int32_t 435omp_get_team_size_ (const int32_t *level) 436{ 437 return omp_get_team_size (*level); 438} 439 440int32_t 441omp_get_team_size_8_ (const int64_t *level) 442{ 443 return omp_get_team_size (TO_INT (*level)); 444} 445 446int32_t 447omp_get_active_level_ (void) 448{ 449 return omp_get_active_level (); 450} 451 452int32_t 453omp_in_final_ (void) 454{ 455 return omp_in_final (); 456} 457 458int32_t 459omp_get_cancellation_ (void) 460{ 461 return omp_get_cancellation (); 462} 463 464int32_t 465omp_get_proc_bind_ (void) 466{ 467 return omp_get_proc_bind (); 468} 469 470int32_t 471omp_get_num_places_ (void) 472{ 473 return omp_get_num_places (); 474} 475 476int32_t 477omp_get_place_num_procs_ (const int32_t *place_num) 478{ 479 return omp_get_place_num_procs (*place_num); 480} 481 482int32_t 483omp_get_place_num_procs_8_ (const int64_t *place_num) 484{ 485 return omp_get_place_num_procs (TO_INT (*place_num)); 486} 487 488void 489omp_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 494void 495omp_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 500int32_t 501omp_get_place_num_ (void) 502{ 503 return omp_get_place_num (); 504} 505 506int32_t 507omp_get_partition_num_places_ (void) 508{ 509 return omp_get_partition_num_places (); 510} 511 512void 513omp_get_partition_place_nums_ (int32_t *place_nums) 514{ 515 omp_get_partition_place_nums ((int *) place_nums); 516} 517 518void 519omp_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 533void 534omp_set_default_device_ (const int32_t *device_num) 535{ 536 return omp_set_default_device (*device_num); 537} 538 539void 540omp_set_default_device_8_ (const int64_t *device_num) 541{ 542 return omp_set_default_device (TO_INT (*device_num)); 543} 544 545int32_t 546omp_get_default_device_ (void) 547{ 548 return omp_get_default_device (); 549} 550 551int32_t 552omp_get_num_devices_ (void) 553{ 554 return omp_get_num_devices (); 555} 556 557int32_t 558omp_get_num_teams_ (void) 559{ 560 return omp_get_num_teams (); 561} 562 563int32_t 564omp_get_team_num_ (void) 565{ 566 return omp_get_team_num (); 567} 568 569int32_t 570omp_is_initial_device_ (void) 571{ 572 return omp_is_initial_device (); 573} 574 575int32_t 576omp_get_initial_device_ (void) 577{ 578 return omp_get_initial_device (); 579} 580 581int32_t 582omp_get_max_task_priority_ (void) 583{ 584 return omp_get_max_task_priority (); 585} 586 587void 588omp_set_affinity_format_ (const char *format, size_t format_len) 589{ 590 gomp_set_affinity_format (format, format_len); 591} 592 593int32_t 594omp_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 610void 611omp_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 645int32_t 646omp_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 668int32_t 669omp_pause_resource_ (const int32_t *kind, const int32_t *device_num) 670{ 671 return omp_pause_resource (*kind, *device_num); 672} 673 674int32_t 675omp_pause_resource_all_ (const int32_t *kind) 676{ 677 return omp_pause_resource_all (*kind); 678} 679