libgomp/fortran.c

   1 /* Copyright (C) 2005, 2007, 2008, 2009, 2011 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 # define ULP            STR1(__USER_LABEL_PREFIX__)
  35 # define STR1(x)        STR2(x)
  36 # define STR2(x)        #x
  37 # define ialias_redirect(fn) \
  38   extern __typeof (fn) fn __asm__ (ULP "gomp_ialias_" #fn) attribute_hidden;
  39 # ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
  40 ialias_redirect (omp_init_lock)
  41 ialias_redirect (omp_init_nest_lock)
  42 ialias_redirect (omp_destroy_lock)
  43 ialias_redirect (omp_destroy_nest_lock)
  44 ialias_redirect (omp_set_lock)
  45 ialias_redirect (omp_set_nest_lock)
  46 ialias_redirect (omp_unset_lock)
  47 ialias_redirect (omp_unset_nest_lock)
  48 ialias_redirect (omp_test_lock)
  49 ialias_redirect (omp_test_nest_lock)
  50 # endif
  51 ialias_redirect (omp_set_dynamic)
  52 ialias_redirect (omp_set_nested)
  53 ialias_redirect (omp_set_num_threads)
  54 ialias_redirect (omp_get_dynamic)
  55 ialias_redirect (omp_get_nested)
  56 ialias_redirect (omp_in_parallel)
  57 ialias_redirect (omp_get_max_threads)
  58 ialias_redirect (omp_get_num_procs)
  59 ialias_redirect (omp_get_num_threads)
  60 ialias_redirect (omp_get_thread_num)
  61 ialias_redirect (omp_get_wtick)
  62 ialias_redirect (omp_get_wtime)
  63 ialias_redirect (omp_set_schedule)
  64 ialias_redirect (omp_get_schedule)
  65 ialias_redirect (omp_get_thread_limit)
  66 ialias_redirect (omp_set_max_active_levels)
  67 ialias_redirect (omp_get_max_active_levels)
  68 ialias_redirect (omp_get_level)
  69 ialias_redirect (omp_get_ancestor_thread_num)
  70 ialias_redirect (omp_get_team_size)
  71 ialias_redirect (omp_get_active_level)
  72 #endif
  73
  74 #ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
  75 # define gomp_init_lock__30 omp_init_lock_
  76 # define gomp_destroy_lock__30 omp_destroy_lock_
  77 # define gomp_set_lock__30 omp_set_lock_
  78 # define gomp_unset_lock__30 omp_unset_lock_
  79 # define gomp_test_lock__30 omp_test_lock_
  80 # define gomp_init_nest_lock__30 omp_init_nest_lock_
  81 # define gomp_destroy_nest_lock__30 omp_destroy_nest_lock_
  82 # define gomp_set_nest_lock__30 omp_set_nest_lock_
  83 # define gomp_unset_nest_lock__30 omp_unset_nest_lock_
  84 # define gomp_test_nest_lock__30 omp_test_nest_lock_
  85 #endif
  86
  87 void
  88 gomp_init_lock__30 (omp_lock_arg_t lock)
  89 {
  90 #ifndef OMP_LOCK_DIRECT
  91   omp_lock_arg (lock) = malloc (sizeof (omp_lock_t));
  92 #endif
  93   gomp_init_lock_30 (omp_lock_arg (lock));
  94 }
  95
  96 void
  97 gomp_init_nest_lock__30 (omp_nest_lock_arg_t lock)
  98 {
  99 #ifndef OMP_NEST_LOCK_DIRECT
 100   omp_nest_lock_arg (lock) = malloc (sizeof (omp_nest_lock_t));
 101 #endif
 102   gomp_init_nest_lock_30 (omp_nest_lock_arg (lock));
 103 }
 104
 105 void
 106 gomp_destroy_lock__30 (omp_lock_arg_t lock)
 107 {
 108   gomp_destroy_lock_30 (omp_lock_arg (lock));
 109 #ifndef OMP_LOCK_DIRECT
 110   free (omp_lock_arg (lock));
 111   omp_lock_arg (lock) = NULL;
 112 #endif
 113 }
 114
 115 void
 116 gomp_destroy_nest_lock__30 (omp_nest_lock_arg_t lock)
 117 {
 118   gomp_destroy_nest_lock_30 (omp_nest_lock_arg (lock));
 119 #ifndef OMP_NEST_LOCK_DIRECT
 120   free (omp_nest_lock_arg (lock));
 121   omp_nest_lock_arg (lock) = NULL;
 122 #endif
 123 }
 124
 125 void
 126 gomp_set_lock__30 (omp_lock_arg_t lock)
 127 {
 128   gomp_set_lock_30 (omp_lock_arg (lock));
 129 }
 130
 131 void
 132 gomp_set_nest_lock__30 (omp_nest_lock_arg_t lock)
 133 {
 134   gomp_set_nest_lock_30 (omp_nest_lock_arg (lock));
 135 }
 136
 137 void
 138 gomp_unset_lock__30 (omp_lock_arg_t lock)
 139 {
 140   gomp_unset_lock_30 (omp_lock_arg (lock));
 141 }
 142
 143 void
 144 gomp_unset_nest_lock__30 (omp_nest_lock_arg_t lock)
 145 {
 146   gomp_unset_nest_lock_30 (omp_nest_lock_arg (lock));
 147 }
 148
 149 int32_t
 150 gomp_test_lock__30 (omp_lock_arg_t lock)
 151 {
 152   return gomp_test_lock_30 (omp_lock_arg (lock));
 153 }
 154
 155 int32_t
 156 gomp_test_nest_lock__30 (omp_nest_lock_arg_t lock)
 157 {
 158   return gomp_test_nest_lock_30 (omp_nest_lock_arg (lock));
 159 }
 160
 161 #ifdef LIBGOMP_GNU_SYMBOL_VERSIONING
 162 void
 163 gomp_init_lock__25 (omp_lock_25_arg_t lock)
 164 {
 165 #ifndef OMP_LOCK_25_DIRECT
 166   omp_lock_25_arg (lock) = malloc (sizeof (omp_lock_25_t));
 167 #endif
 168   gomp_init_lock_25 (omp_lock_25_arg (lock));
 169 }
 170
 171 void
 172 gomp_init_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 173 {
 174 #ifndef OMP_NEST_LOCK_25_DIRECT
 175   omp_nest_lock_25_arg (lock) = malloc (sizeof (omp_nest_lock_25_t));
 176 #endif
 177   gomp_init_nest_lock_25 (omp_nest_lock_25_arg (lock));
 178 }
 179
 180 void
 181 gomp_destroy_lock__25 (omp_lock_25_arg_t lock)
 182 {
 183   gomp_destroy_lock_25 (omp_lock_25_arg (lock));
 184 #ifndef OMP_LOCK_25_DIRECT
 185   free (omp_lock_25_arg (lock));
 186   omp_lock_25_arg (lock) = NULL;
 187 #endif
 188 }
 189
 190 void
 191 gomp_destroy_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 192 {
 193   gomp_destroy_nest_lock_25 (omp_nest_lock_25_arg (lock));
 194 #ifndef OMP_NEST_LOCK_25_DIRECT
 195   free (omp_nest_lock_25_arg (lock));
 196   omp_nest_lock_25_arg (lock) = NULL;
 197 #endif
 198 }
 199
 200 void
 201 gomp_set_lock__25 (omp_lock_25_arg_t lock)
 202 {
 203   gomp_set_lock_25 (omp_lock_25_arg (lock));
 204 }
 205
 206 void
 207 gomp_set_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 208 {
 209   gomp_set_nest_lock_25 (omp_nest_lock_25_arg (lock));
 210 }
 211
 212 void
 213 gomp_unset_lock__25 (omp_lock_25_arg_t lock)
 214 {
 215   gomp_unset_lock_25 (omp_lock_25_arg (lock));
 216 }
 217
 218 void
 219 gomp_unset_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 220 {
 221   gomp_unset_nest_lock_25 (omp_nest_lock_25_arg (lock));
 222 }
 223
 224 int32_t
 225 gomp_test_lock__25 (omp_lock_25_arg_t lock)
 226 {
 227   return gomp_test_lock_25 (omp_lock_25_arg (lock));
 228 }
 229
 230 int32_t
 231 gomp_test_nest_lock__25 (omp_nest_lock_25_arg_t lock)
 232 {
 233   return gomp_test_nest_lock_25 (omp_nest_lock_25_arg (lock));
 234 }
 235
 236 omp_lock_symver (omp_init_lock_)
 237 omp_lock_symver (omp_destroy_lock_)
 238 omp_lock_symver (omp_set_lock_)
 239 omp_lock_symver (omp_unset_lock_)
 240 omp_lock_symver (omp_test_lock_)
 241 omp_lock_symver (omp_init_nest_lock_)
 242 omp_lock_symver (omp_destroy_nest_lock_)
 243 omp_lock_symver (omp_set_nest_lock_)
 244 omp_lock_symver (omp_unset_nest_lock_)
 245 omp_lock_symver (omp_test_nest_lock_)
 246 #endif
 247
 248 #define TO_INT(x) ((x) > INT_MIN ? (x) < INT_MAX ? (x) : INT_MAX : INT_MIN)
 249
 250 void
 251 omp_set_dynamic_ (const int32_t *set)
 252 {
 253   omp_set_dynamic (*set);
 254 }
 255
 256 void
 257 omp_set_dynamic_8_ (const int64_t *set)
 258 {
 259   omp_set_dynamic (!!*set);
 260 }
 261
 262 void
 263 omp_set_nested_ (const int32_t *set)
 264 {
 265   omp_set_nested (*set);
 266 }
 267
 268 void
 269 omp_set_nested_8_ (const int64_t *set)
 270 {
 271   omp_set_nested (!!*set);
 272 }
 273
 274 void
 275 omp_set_num_threads_ (const int32_t *set)
 276 {
 277   omp_set_num_threads (*set);
 278 }
 279
 280 void
 281 omp_set_num_threads_8_ (const int64_t *set)
 282 {
 283   omp_set_num_threads (TO_INT (*set));
 284 }
 285
 286 int32_t
 287 omp_get_dynamic_ (void)
 288 {
 289   return omp_get_dynamic ();
 290 }
 291
 292 int32_t
 293 omp_get_nested_ (void)
 294 {
 295   return omp_get_nested ();
 296 }
 297
 298 int32_t
 299 omp_in_parallel_ (void)
 300 {
 301   return omp_in_parallel ();
 302 }
 303
 304 int32_t
 305 omp_get_max_threads_ (void)
 306 {
 307   return omp_get_max_threads ();
 308 }
 309
 310 int32_t
 311 omp_get_num_procs_ (void)
 312 {
 313   return omp_get_num_procs ();
 314 }
 315
 316 int32_t
 317 omp_get_num_threads_ (void)
 318 {
 319   return omp_get_num_threads ();
 320 }
 321
 322 int32_t
 323 omp_get_thread_num_ (void)
 324 {
 325   return omp_get_thread_num ();
 326 }
 327
 328 double
 329 omp_get_wtick_ (void)
 330 {
 331   return omp_get_wtick ();
 332 }
 333
 334 double
 335 omp_get_wtime_ (void)
 336 {
 337   return omp_get_wtime ();
 338 }
 339
 340 void
 341 omp_set_schedule_ (const int32_t *kind, const int32_t *modifier)
 342 {
 343   omp_set_schedule (*kind, *modifier);
 344 }
 345
 346 void
 347 omp_set_schedule_8_ (const int32_t *kind, const int64_t *modifier)
 348 {
 349   omp_set_schedule (*kind, TO_INT (*modifier));
 350 }
 351
 352 void
 353 omp_get_schedule_ (int32_t *kind, int32_t *modifier)
 354 {
 355   omp_sched_t k;
 356   int m;
 357   omp_get_schedule (&k, &m);
 358   *kind = k;
 359   *modifier = m;
 360 }
 361
 362 void
 363 omp_get_schedule_8_ (int32_t *kind, int64_t *modifier)
 364 {
 365   omp_sched_t k;
 366   int m;
 367   omp_get_schedule (&k, &m);
 368   *kind = k;
 369   *modifier = m;
 370 }
 371
 372 int32_t
 373 omp_get_thread_limit_ (void)
 374 {
 375   return omp_get_thread_limit ();
 376 }
 377
 378 void
 379 omp_set_max_active_levels_ (const int32_t *levels)
 380 {
 381   omp_set_max_active_levels (*levels);
 382 }
 383
 384 void
 385 omp_set_max_active_levels_8_ (const int64_t *levels)
 386 {
 387   omp_set_max_active_levels (TO_INT (*levels));
 388 }
 389
 390 int32_t
 391 omp_get_max_active_levels_ (void)
 392 {
 393   return omp_get_max_active_levels ();
 394 }
 395
 396 int32_t
 397 omp_get_level_ (void)
 398 {
 399   return omp_get_level ();
 400 }
 401
 402 int32_t
 403 omp_get_ancestor_thread_num_ (const int32_t *level)
 404 {
 405   return omp_get_ancestor_thread_num (*level);
 406 }
 407
 408 int32_t
 409 omp_get_ancestor_thread_num_8_ (const int64_t *level)
 410 {
 411   return omp_get_ancestor_thread_num (TO_INT (*level));
 412 }
 413
 414 int32_t
 415 omp_get_team_size_ (const int32_t *level)
 416 {
 417   return omp_get_team_size (*level);
 418 }
 419
 420 int32_t
 421 omp_get_team_size_8_ (const int64_t *level)
 422 {
 423   return omp_get_team_size (TO_INT (*level));
 424 }
 425
 426 int32_t
 427 omp_get_active_level_ (void)
 428 {
 429   return omp_get_active_level ();
 430 }