libgomp/fortran.c

   1 /* Copyright (C) 2005-2014 Free Software Foundation, Inc.
   2    Contributed by Jakub Jelinek <jakub@redhat.com>.
   3
   4    This file is part of the GNU OpenMP Library (libgomp).
   5
   6    Libgomp is free software; you can redistribute it and/or modify it
   7    under the terms of the GNU General Public License as published by
   8    the Free Software Foundation; either version 3, or (at your option)
   9    any later version.
  10
  11    Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
  12    WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  13    FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
  14    more details.
  15
  16    Under Section 7 of GPL version 3, you are granted additional
  17    permissions described in the GCC Runtime Library Exception, version
  18    3.1, as published by the Free Software Foundation.
  19
  20    You should have received a copy of the GNU General Public License and
  21    a copy of the GCC Runtime Library Exception along with this program;
  22    see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  23    <http://www.gnu.org/licenses/>.  */
  24
  25 /* This file contains Fortran wrapper routines.  */
  26
  27 #include "libgomp.h"
  28 #include "libgomp_f.h"
  29 #include <stdlib.h>
  30 #include <limits.h>
  31
  32 #ifdef HAVE_ATTRIBUTE_ALIAS
  33 /* Use internal aliases if possible.  */
  34 # ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
  35 ialias_redirect (omp_init_lock)
  36 ialias_redirect (omp_init_nest_lock)
  37 ialias_redirect (omp_destroy_lock)
  38 ialias_redirect (omp_destroy_nest_lock)
  39 ialias_redirect (omp_set_lock)
  40 ialias_redirect (omp_set_nest_lock)
  41 ialias_redirect (omp_unset_lock)
  42 ialias_redirect (omp_unset_nest_lock)
  43 ialias_redirect (omp_test_lock)
  44 ialias_redirect (omp_test_nest_lock)
  45 # endif
  46 ialias_redirect (omp_set_dynamic)
  47 ialias_redirect (omp_set_nested)
  48 ialias_redirect (omp_set_num_threads)
  49 ialias_redirect (omp_get_dynamic)
  50 ialias_redirect (omp_get_nested)
  51 ialias_redirect (omp_in_parallel)
  52 ialias_redirect (omp_get_max_threads)
  53 ialias_redirect (omp_get_num_procs)
  54 ialias_redirect (omp_get_num_threads)
  55 ialias_redirect (omp_get_thread_num)
  56 ialias_redirect (omp_get_wtick)
  57 ialias_redirect (omp_get_wtime)
  58 ialias_redirect (omp_set_schedule)
  59 ialias_redirect (omp_get_schedule)
  60 ialias_redirect (omp_get_thread_limit)
  61 ialias_redirect (omp_set_max_active_levels)
  62 ialias_redirect (omp_get_max_active_levels)
  63 ialias_redirect (omp_get_level)
  64 ialias_redirect (omp_get_ancestor_thread_num)
  65 ialias_redirect (omp_get_team_size)
  66 ialias_redirect (omp_get_active_level)
  67 ialias_redirect (omp_in_final)
  68 ialias_redirect (omp_get_cancellation)
  69 ialias_redirect (omp_get_proc_bind)
  70 ialias_redirect (omp_set_default_device)
  71 ialias_redirect (omp_get_default_device)
  72 ialias_redirect (omp_get_num_devices)
  73 ialias_redirect (omp_get_num_teams)
  74 ialias_redirect (omp_get_team_num)
  75 ialias_redirect (omp_is_initial_device)
  76 #endif
  77
  78 #ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
  79 # define gomp_init_lock__30 omp_init_lock_
  80 # define gomp_destroy_lock__30 omp_destroy_lock_
  81 # define gomp_set_lock__30 omp_set_lock_
  82 # define gomp_unset_lock__30 omp_unset_lock_
  83 # define gomp_test_lock__30 omp_test_lock_
  84 # define gomp_init_nest_lock__30 omp_init_nest_lock_
  85 # define gomp_destroy_nest_lock__30 omp_destroy_nest_lock_
  86 # define gomp_set_nest_lock__30 omp_set_nest_lock_
  87 # define gomp_unset_nest_lock__30 omp_unset_nest_lock_
  88 # define gomp_test_nest_lock__30 omp_test_nest_lock_
  89 #endif
  90
  91 void
  92 gomp_init_lock__30 (omp_lock_arg_t lock)
  93 {
  94 #ifndef OMP_LOCK_DIRECT
  95   omp_lock_arg (lock) = malloc (sizeof (omp_lock_t));
  96 #endif
  97   gomp_init_lock_30 (omp_lock_arg (lock));
  98 }
  99
 100 void
 101 gomp_init_nest_lock__30 (omp_nest_lock_arg_t lock)
 102 {
 103 #ifndef OMP_NEST_LOCK_DIRECT
 104   omp_nest_lock_arg (lock) = malloc (sizeof (omp_nest_lock_t));
 105 #endif
 106   gomp_init_nest_lock_30 (omp_nest_lock_arg (lock));
 107 }
 108
 109 void
 110 gomp_destroy_lock__30 (omp_lock_arg_t lock)
 111 {
 112   gomp_destroy_lock_30 (omp_lock_arg (lock));
 113 #ifndef OMP_LOCK_DIRECT
 114   free (omp_lock_arg (lock));
 115   omp_lock_arg (lock) = NULL;
 116 #endif
 117 }
 118
 119 void
 120 gomp_destroy_nest_lock__30 (omp_nest_lock_arg_t lock)
 121 {
 122   gomp_destroy_nest_lock_30 (omp_nest_lock_arg (lock));
 123 #ifndef OMP_NEST_LOCK_DIRECT
 124   free (omp_nest_lock_arg (lock));
 125   omp_nest_lock_arg (lock) = NULL;
 126 #endif
 127 }
 128
 129 void
 130 gomp_set_lock__30 (omp_lock_arg_t lock)
 131 {
 132   gomp_set_lock_30 (omp_lock_arg (lock));
 133 }
 134
 135 void
 136 gomp_set_nest_lock__30 (omp_nest_lock_arg_t lock)
 137 {
 138   gomp_set_nest_lock_30 (omp_nest_lock_arg (lock));
 139 }
 140
 141 void
 142 gomp_unset_lock__30 (omp_lock_arg_t lock)
 143 {
 144   gomp_unset_lock_30 (omp_lock_arg (lock));
 145 }
 146
 147 void
 148 gomp_unset_nest_lock__30 (omp_nest_lock_arg_t lock)
 149 {
 150   gomp_unset_nest_lock_30 (omp_nest_lock_arg (lock));
 151 }
 152
 153 int32_t
 154 gomp_test_lock__30 (omp_lock_arg_t lock)
 155 {
 156   return gomp_test_lock_30 (omp_lock_arg (lock));
 157 }
 158
 159 int32_t
 160 gomp_test_nest_lock__30 (omp_nest_lock_arg_t lock)
 161 {
 162   return gomp_test_nest_lock_30 (omp_nest_lock_arg (lock));
 163 }
 164
 165 #ifdef LIBGOMP_GNU_SYMBOL_VERSIONING
 166 void
 167 gomp_init_lock__25 (omp_lock_25_arg_t lock)
 168 {
 169 #ifndef OMP_LOCK_25_DIRECT
 170   omp_lock_25_arg (lock) = malloc (sizeof (omp_lock_25_t));
 171 #endif
 172   gomp_init_lock_25 (omp_lock_25_arg (lock));
 173 }
 174
 175 void
 176 gomp_init_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 177 {
 178 #ifndef OMP_NEST_LOCK_25_DIRECT
 179   omp_nest_lock_25_arg (lock) = malloc (sizeof (omp_nest_lock_25_t));
 180 #endif
 181   gomp_init_nest_lock_25 (omp_nest_lock_25_arg (lock));
 182 }
 183
 184 void
 185 gomp_destroy_lock__25 (omp_lock_25_arg_t lock)
 186 {
 187   gomp_destroy_lock_25 (omp_lock_25_arg (lock));
 188 #ifndef OMP_LOCK_25_DIRECT
 189   free (omp_lock_25_arg (lock));
 190   omp_lock_25_arg (lock) = NULL;
 191 #endif
 192 }
 193
 194 void
 195 gomp_destroy_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 196 {
 197   gomp_destroy_nest_lock_25 (omp_nest_lock_25_arg (lock));
 198 #ifndef OMP_NEST_LOCK_25_DIRECT
 199   free (omp_nest_lock_25_arg (lock));
 200   omp_nest_lock_25_arg (lock) = NULL;
 201 #endif
 202 }
 203
 204 void
 205 gomp_set_lock__25 (omp_lock_25_arg_t lock)
 206 {
 207   gomp_set_lock_25 (omp_lock_25_arg (lock));
 208 }
 209
 210 void
 211 gomp_set_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 212 {
 213   gomp_set_nest_lock_25 (omp_nest_lock_25_arg (lock));
 214 }
 215
 216 void
 217 gomp_unset_lock__25 (omp_lock_25_arg_t lock)
 218 {
 219   gomp_unset_lock_25 (omp_lock_25_arg (lock));
 220 }
 221
 222 void
 223 gomp_unset_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 224 {
 225   gomp_unset_nest_lock_25 (omp_nest_lock_25_arg (lock));
 226 }
 227
 228 int32_t
 229 gomp_test_lock__25 (omp_lock_25_arg_t lock)
 230 {
 231   return gomp_test_lock_25 (omp_lock_25_arg (lock));
 232 }
 233
 234 int32_t
 235 gomp_test_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 236 {
 237   return gomp_test_nest_lock_25 (omp_nest_lock_25_arg (lock));
 238 }
 239
 240 omp_lock_symver (omp_init_lock_)
 241 omp_lock_symver (omp_destroy_lock_)
 242 omp_lock_symver (omp_set_lock_)
 243 omp_lock_symver (omp_unset_lock_)
 244 omp_lock_symver (omp_test_lock_)
 245 omp_lock_symver (omp_init_nest_lock_)
 246 omp_lock_symver (omp_destroy_nest_lock_)
 247 omp_lock_symver (omp_set_nest_lock_)
 248 omp_lock_symver (omp_unset_nest_lock_)
 249 omp_lock_symver (omp_test_nest_lock_)
 250 #endif
 251
 252 #define TO_INT(x) ((x) > INT_MIN ? (x) < INT_MAX ? (x) : INT_MAX : INT_MIN)
 253
 254 void
 255 omp_set_dynamic_ (const int32_t *set)
 256 {
 257   omp_set_dynamic (*set);
 258 }
 259
 260 void
 261 omp_set_dynamic_8_ (const int64_t *set)
 262 {
 263   omp_set_dynamic (!!*set);
 264 }
 265
 266 void
 267 omp_set_nested_ (const int32_t *set)
 268 {
 269   omp_set_nested (*set);
 270 }
 271
 272 void
 273 omp_set_nested_8_ (const int64_t *set)
 274 {
 275   omp_set_nested (!!*set);
 276 }
 277
 278 void
 279 omp_set_num_threads_ (const int32_t *set)
 280 {
 281   omp_set_num_threads (*set);
 282 }
 283
 284 void
 285 omp_set_num_threads_8_ (const int64_t *set)
 286 {
 287   omp_set_num_threads (TO_INT (*set));
 288 }
 289
 290 int32_t
 291 omp_get_dynamic_ (void)
 292 {
 293   return omp_get_dynamic ();
 294 }
 295
 296 int32_t
 297 omp_get_nested_ (void)
 298 {
 299   return omp_get_nested ();
 300 }
 301
 302 int32_t
 303 omp_in_parallel_ (void)
 304 {
 305   return omp_in_parallel ();
 306 }
 307
 308 int32_t
 309 omp_get_max_threads_ (void)
 310 {
 311   return omp_get_max_threads ();
 312 }
 313
 314 int32_t
 315 omp_get_num_procs_ (void)
 316 {
 317   return omp_get_num_procs ();
 318 }
 319
 320 int32_t
 321 omp_get_num_threads_ (void)
 322 {
 323   return omp_get_num_threads ();
 324 }
 325
 326 int32_t
 327 omp_get_thread_num_ (void)
 328 {
 329   return omp_get_thread_num ();
 330 }
 331
 332 double
 333 omp_get_wtick_ (void)
 334 {
 335   return omp_get_wtick ();
 336 }
 337
 338 double
 339 omp_get_wtime_ (void)
 340 {
 341   return omp_get_wtime ();
 342 }
 343
 344 void
 345 omp_set_schedule_ (const int32_t *kind, const int32_t *modifier)
 346 {
 347   omp_set_schedule (*kind, *modifier);
 348 }
 349
 350 void
 351 omp_set_schedule_8_ (const int32_t *kind, const int64_t *modifier)
 352 {
 353   omp_set_schedule (*kind, TO_INT (*modifier));
 354 }
 355
 356 void
 357 omp_get_schedule_ (int32_t *kind, int32_t *modifier)
 358 {
 359   omp_sched_t k;
 360   int m;
 361   omp_get_schedule (&k, &m);
 362   *kind = k;
 363   *modifier = m;
 364 }
 365
 366 void
 367 omp_get_schedule_8_ (int32_t *kind, int64_t *modifier)
 368 {
 369   omp_sched_t k;
 370   int m;
 371   omp_get_schedule (&k, &m);
 372   *kind = k;
 373   *modifier = m;
 374 }
 375
 376 int32_t
 377 omp_get_thread_limit_ (void)
 378 {
 379   return omp_get_thread_limit ();
 380 }
 381
 382 void
 383 omp_set_max_active_levels_ (const int32_t *levels)
 384 {
 385   omp_set_max_active_levels (*levels);
 386 }
 387
 388 void
 389 omp_set_max_active_levels_8_ (const int64_t *levels)
 390 {
 391   omp_set_max_active_levels (TO_INT (*levels));
 392 }
 393
 394 int32_t
 395 omp_get_max_active_levels_ (void)
 396 {
 397   return omp_get_max_active_levels ();
 398 }
 399
 400 int32_t
 401 omp_get_level_ (void)
 402 {
 403   return omp_get_level ();
 404 }
 405
 406 int32_t
 407 omp_get_ancestor_thread_num_ (const int32_t *level)
 408 {
 409   return omp_get_ancestor_thread_num (*level);
 410 }
 411
 412 int32_t
 413 omp_get_ancestor_thread_num_8_ (const int64_t *level)
 414 {
 415   return omp_get_ancestor_thread_num (TO_INT (*level));
 416 }
 417
 418 int32_t
 419 omp_get_team_size_ (const int32_t *level)
 420 {
 421   return omp_get_team_size (*level);
 422 }
 423
 424 int32_t
 425 omp_get_team_size_8_ (const int64_t *level)
 426 {
 427   return omp_get_team_size (TO_INT (*level));
 428 }
 429
 430 int32_t
 431 omp_get_active_level_ (void)
 432 {
 433   return omp_get_active_level ();
 434 }
 435
 436 int32_t
 437 omp_in_final_ (void)
 438 {
 439   return omp_in_final ();
 440 }
 441
 442 int32_t
 443 omp_get_cancellation_ (void)
 444 {
 445   return omp_get_cancellation ();
 446 }
 447
 448 int32_t
 449 omp_get_proc_bind_ (void)
 450 {
 451   return omp_get_proc_bind ();
 452 }
 453
 454 void
 455 omp_set_default_device_ (const int32_t *device_num)
 456 {
 457   return omp_set_default_device (*device_num);
 458 }
 459
 460 void
 461 omp_set_default_device_8_ (const int64_t *device_num)
 462 {
 463   return omp_set_default_device (TO_INT (*device_num));
 464 }
 465
 466 int32_t
 467 omp_get_default_device_ (void)
 468 {
 469   return omp_get_default_device ();
 470 }
 471
 472 int32_t
 473 omp_get_num_devices_ (void)
 474 {
 475   return omp_get_num_devices ();
 476 }
 477
 478 int32_t
 479 omp_get_num_teams_ (void)
 480 {
 481   return omp_get_num_teams ();
 482 }
 483
 484 int32_t
 485 omp_get_team_num_ (void)
 486 {
 487   return omp_get_team_num ();
 488 }
 489
 490 int32_t
 491 omp_is_initial_device_ (void)
 492 {
 493   return omp_is_initial_device ();
 494 }