libgomp/fortran.c

   1 /* Copyright (C) 2005-2015 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_set_default_device)
  72 ialias_redirect (omp_get_default_device)
  73 ialias_redirect (omp_get_num_devices)
  74 ialias_redirect (omp_get_num_teams)
  75 ialias_redirect (omp_get_team_num)
  76 ialias_redirect (omp_is_initial_device)
  77 #endif
  78
  79 #ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
  80 # define gomp_init_lock__30 omp_init_lock_
  81 # define gomp_destroy_lock__30 omp_destroy_lock_
  82 # define gomp_set_lock__30 omp_set_lock_
  83 # define gomp_unset_lock__30 omp_unset_lock_
  84 # define gomp_test_lock__30 omp_test_lock_
  85 # define gomp_init_nest_lock__30 omp_init_nest_lock_
  86 # define gomp_destroy_nest_lock__30 omp_destroy_nest_lock_
  87 # define gomp_set_nest_lock__30 omp_set_nest_lock_
  88 # define gomp_unset_nest_lock__30 omp_unset_nest_lock_
  89 # define gomp_test_nest_lock__30 omp_test_nest_lock_
  90 #endif
  91
  92 void
  93 gomp_init_lock__30 (omp_lock_arg_t lock)
  94 {
  95 #ifndef OMP_LOCK_DIRECT
  96   omp_lock_arg (lock) = malloc (sizeof (omp_lock_t));
  97 #endif
  98   gomp_init_lock_30 (omp_lock_arg (lock));
  99 }
 100
 101 void
 102 gomp_init_nest_lock__30 (omp_nest_lock_arg_t lock)
 103 {
 104 #ifndef OMP_NEST_LOCK_DIRECT
 105   omp_nest_lock_arg (lock) = malloc (sizeof (omp_nest_lock_t));
 106 #endif
 107   gomp_init_nest_lock_30 (omp_nest_lock_arg (lock));
 108 }
 109
 110 void
 111 gomp_destroy_lock__30 (omp_lock_arg_t lock)
 112 {
 113   gomp_destroy_lock_30 (omp_lock_arg (lock));
 114 #ifndef OMP_LOCK_DIRECT
 115   free (omp_lock_arg (lock));
 116   omp_lock_arg (lock) = NULL;
 117 #endif
 118 }
 119
 120 void
 121 gomp_destroy_nest_lock__30 (omp_nest_lock_arg_t lock)
 122 {
 123   gomp_destroy_nest_lock_30 (omp_nest_lock_arg (lock));
 124 #ifndef OMP_NEST_LOCK_DIRECT
 125   free (omp_nest_lock_arg (lock));
 126   omp_nest_lock_arg (lock) = NULL;
 127 #endif
 128 }
 129
 130 void
 131 gomp_set_lock__30 (omp_lock_arg_t lock)
 132 {
 133   gomp_set_lock_30 (omp_lock_arg (lock));
 134 }
 135
 136 void
 137 gomp_set_nest_lock__30 (omp_nest_lock_arg_t lock)
 138 {
 139   gomp_set_nest_lock_30 (omp_nest_lock_arg (lock));
 140 }
 141
 142 void
 143 gomp_unset_lock__30 (omp_lock_arg_t lock)
 144 {
 145   gomp_unset_lock_30 (omp_lock_arg (lock));
 146 }
 147
 148 void
 149 gomp_unset_nest_lock__30 (omp_nest_lock_arg_t lock)
 150 {
 151   gomp_unset_nest_lock_30 (omp_nest_lock_arg (lock));
 152 }
 153
 154 int32_t
 155 gomp_test_lock__30 (omp_lock_arg_t lock)
 156 {
 157   return gomp_test_lock_30 (omp_lock_arg (lock));
 158 }
 159
 160 int32_t
 161 gomp_test_nest_lock__30 (omp_nest_lock_arg_t lock)
 162 {
 163   return gomp_test_nest_lock_30 (omp_nest_lock_arg (lock));
 164 }
 165
 166 #ifdef LIBGOMP_GNU_SYMBOL_VERSIONING
 167 void
 168 gomp_init_lock__25 (omp_lock_25_arg_t lock)
 169 {
 170 #ifndef OMP_LOCK_25_DIRECT
 171   omp_lock_25_arg (lock) = malloc (sizeof (omp_lock_25_t));
 172 #endif
 173   gomp_init_lock_25 (omp_lock_25_arg (lock));
 174 }
 175
 176 void
 177 gomp_init_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 178 {
 179 #ifndef OMP_NEST_LOCK_25_DIRECT
 180   omp_nest_lock_25_arg (lock) = malloc (sizeof (omp_nest_lock_25_t));
 181 #endif
 182   gomp_init_nest_lock_25 (omp_nest_lock_25_arg (lock));
 183 }
 184
 185 void
 186 gomp_destroy_lock__25 (omp_lock_25_arg_t lock)
 187 {
 188   gomp_destroy_lock_25 (omp_lock_25_arg (lock));
 189 #ifndef OMP_LOCK_25_DIRECT
 190   free (omp_lock_25_arg (lock));
 191   omp_lock_25_arg (lock) = NULL;
 192 #endif
 193 }
 194
 195 void
 196 gomp_destroy_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 197 {
 198   gomp_destroy_nest_lock_25 (omp_nest_lock_25_arg (lock));
 199 #ifndef OMP_NEST_LOCK_25_DIRECT
 200   free (omp_nest_lock_25_arg (lock));
 201   omp_nest_lock_25_arg (lock) = NULL;
 202 #endif
 203 }
 204
 205 void
 206 gomp_set_lock__25 (omp_lock_25_arg_t lock)
 207 {
 208   gomp_set_lock_25 (omp_lock_25_arg (lock));
 209 }
 210
 211 void
 212 gomp_set_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 213 {
 214   gomp_set_nest_lock_25 (omp_nest_lock_25_arg (lock));
 215 }
 216
 217 void
 218 gomp_unset_lock__25 (omp_lock_25_arg_t lock)
 219 {
 220   gomp_unset_lock_25 (omp_lock_25_arg (lock));
 221 }
 222
 223 void
 224 gomp_unset_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 225 {
 226   gomp_unset_nest_lock_25 (omp_nest_lock_25_arg (lock));
 227 }
 228
 229 int32_t
 230 gomp_test_lock__25 (omp_lock_25_arg_t lock)
 231 {
 232   return gomp_test_lock_25 (omp_lock_25_arg (lock));
 233 }
 234
 235 int32_t
 236 gomp_test_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 237 {
 238   return gomp_test_nest_lock_25 (omp_nest_lock_25_arg (lock));
 239 }
 240
 241 omp_lock_symver (omp_init_lock_)
 242 omp_lock_symver (omp_destroy_lock_)
 243 omp_lock_symver (omp_set_lock_)
 244 omp_lock_symver (omp_unset_lock_)
 245 omp_lock_symver (omp_test_lock_)
 246 omp_lock_symver (omp_init_nest_lock_)
 247 omp_lock_symver (omp_destroy_nest_lock_)
 248 omp_lock_symver (omp_set_nest_lock_)
 249 omp_lock_symver (omp_unset_nest_lock_)
 250 omp_lock_symver (omp_test_nest_lock_)
 251 #endif
 252
 253 #define TO_INT(x) ((x) > INT_MIN ? (x) < INT_MAX ? (x) : INT_MAX : INT_MIN)
 254
 255 void
 256 omp_set_dynamic_ (const int32_t *set)
 257 {
 258   omp_set_dynamic (*set);
 259 }
 260
 261 void
 262 omp_set_dynamic_8_ (const int64_t *set)
 263 {
 264   omp_set_dynamic (!!*set);
 265 }
 266
 267 void
 268 omp_set_nested_ (const int32_t *set)
 269 {
 270   omp_set_nested (*set);
 271 }
 272
 273 void
 274 omp_set_nested_8_ (const int64_t *set)
 275 {
 276   omp_set_nested (!!*set);
 277 }
 278
 279 void
 280 omp_set_num_threads_ (const int32_t *set)
 281 {
 282   omp_set_num_threads (*set);
 283 }
 284
 285 void
 286 omp_set_num_threads_8_ (const int64_t *set)
 287 {
 288   omp_set_num_threads (TO_INT (*set));
 289 }
 290
 291 int32_t
 292 omp_get_dynamic_ (void)
 293 {
 294   return omp_get_dynamic ();
 295 }
 296
 297 int32_t
 298 omp_get_nested_ (void)
 299 {
 300   return omp_get_nested ();
 301 }
 302
 303 int32_t
 304 omp_in_parallel_ (void)
 305 {
 306   return omp_in_parallel ();
 307 }
 308
 309 int32_t
 310 omp_get_max_threads_ (void)
 311 {
 312   return omp_get_max_threads ();
 313 }
 314
 315 int32_t
 316 omp_get_num_procs_ (void)
 317 {
 318   return omp_get_num_procs ();
 319 }
 320
 321 int32_t
 322 omp_get_num_threads_ (void)
 323 {
 324   return omp_get_num_threads ();
 325 }
 326
 327 int32_t
 328 omp_get_thread_num_ (void)
 329 {
 330   return omp_get_thread_num ();
 331 }
 332
 333 double
 334 omp_get_wtick_ (void)
 335 {
 336   return omp_get_wtick ();
 337 }
 338
 339 double
 340 omp_get_wtime_ (void)
 341 {
 342   return omp_get_wtime ();
 343 }
 344
 345 void
 346 omp_set_schedule_ (const int32_t *kind, const int32_t *modifier)
 347 {
 348   omp_set_schedule (*kind, *modifier);
 349 }
 350
 351 void
 352 omp_set_schedule_8_ (const int32_t *kind, const int64_t *modifier)
 353 {
 354   omp_set_schedule (*kind, TO_INT (*modifier));
 355 }
 356
 357 void
 358 omp_get_schedule_ (int32_t *kind, int32_t *modifier)
 359 {
 360   omp_sched_t k;
 361   int m;
 362   omp_get_schedule (&k, &m);
 363   *kind = k;
 364   *modifier = m;
 365 }
 366
 367 void
 368 omp_get_schedule_8_ (int32_t *kind, int64_t *modifier)
 369 {
 370   omp_sched_t k;
 371   int m;
 372   omp_get_schedule (&k, &m);
 373   *kind = k;
 374   *modifier = m;
 375 }
 376
 377 int32_t
 378 omp_get_thread_limit_ (void)
 379 {
 380   return omp_get_thread_limit ();
 381 }
 382
 383 void
 384 omp_set_max_active_levels_ (const int32_t *levels)
 385 {
 386   omp_set_max_active_levels (*levels);
 387 }
 388
 389 void
 390 omp_set_max_active_levels_8_ (const int64_t *levels)
 391 {
 392   omp_set_max_active_levels (TO_INT (*levels));
 393 }
 394
 395 int32_t
 396 omp_get_max_active_levels_ (void)
 397 {
 398   return omp_get_max_active_levels ();
 399 }
 400
 401 int32_t
 402 omp_get_level_ (void)
 403 {
 404   return omp_get_level ();
 405 }
 406
 407 int32_t
 408 omp_get_ancestor_thread_num_ (const int32_t *level)
 409 {
 410   return omp_get_ancestor_thread_num (*level);
 411 }
 412
 413 int32_t
 414 omp_get_ancestor_thread_num_8_ (const int64_t *level)
 415 {
 416   return omp_get_ancestor_thread_num (TO_INT (*level));
 417 }
 418
 419 int32_t
 420 omp_get_team_size_ (const int32_t *level)
 421 {
 422   return omp_get_team_size (*level);
 423 }
 424
 425 int32_t
 426 omp_get_team_size_8_ (const int64_t *level)
 427 {
 428   return omp_get_team_size (TO_INT (*level));
 429 }
 430
 431 int32_t
 432 omp_get_active_level_ (void)
 433 {
 434   return omp_get_active_level ();
 435 }
 436
 437 int32_t
 438 omp_in_final_ (void)
 439 {
 440   return omp_in_final ();
 441 }
 442
 443 int32_t
 444 omp_get_cancellation_ (void)
 445 {
 446   return omp_get_cancellation ();
 447 }
 448
 449 int32_t
 450 omp_get_proc_bind_ (void)
 451 {
 452   return omp_get_proc_bind ();
 453 }
 454
 455 void
 456 omp_set_default_device_ (const int32_t *device_num)
 457 {
 458   return omp_set_default_device (*device_num);
 459 }
 460
 461 void
 462 omp_set_default_device_8_ (const int64_t *device_num)
 463 {
 464   return omp_set_default_device (TO_INT (*device_num));
 465 }
 466
 467 int32_t
 468 omp_get_default_device_ (void)
 469 {
 470   return omp_get_default_device ();
 471 }
 472
 473 int32_t
 474 omp_get_num_devices_ (void)
 475 {
 476   return omp_get_num_devices ();
 477 }
 478
 479 int32_t
 480 omp_get_num_teams_ (void)
 481 {
 482   return omp_get_num_teams ();
 483 }
 484
 485 int32_t
 486 omp_get_team_num_ (void)
 487 {
 488   return omp_get_team_num ();
 489 }
 490
 491 int32_t
 492 omp_is_initial_device_ (void)
 493 {
 494   return omp_is_initial_device ();
 495 }