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 } 579