liboffloadmic/runtime/mic_lib.f90

   1 !
   2 !    Copyright (c) 2014-2016 Intel Corporation.  All Rights Reserved.
   3 !
   4 !    Redistribution and use in source and binary forms, with or without
   5 !    modification, are permitted provided that the following conditions
   6 !    are met:
   7 !
   8 !      * Redistributions of source code must retain the above copyright
   9 !        notice, this list of conditions and the following disclaimer.
  10 !      * Redistributions in binary form must reproduce the above copyright
  11 !        notice, this list of conditions and the following disclaimer in the
  12 !        documentation and/or other materials provided with the distribution.
  13 !      * Neither the name of Intel Corporation nor the names of its
  14 !        contributors may be used to endorse or promote products derived
  15 !        from this software without specific prior written permission.
  16 !
  17 !    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  18 !    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  19 !    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  20 !    A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  21 !    HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  22 !    SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  23 !    LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  24 !    DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  25 !    THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  26 !    (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  27 !    OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  28 !
  29
  30
  31 ! **********************************************************************************
  32 ! * This file is intended to support the Intel(r) Many Integrated Core Architecture.
  33 ! **********************************************************************************
  34 ! free form Fortran source - should be named .f90
  35 ! lines are longer than 72 characters
  36
  37 module mic_lib
  38 use, intrinsic :: iso_c_binding
  39
  40 integer, parameter:: target_mic=2
  41 integer, parameter:: default_target_type=target_mic
  42 integer, parameter:: default_target_number=0
  43
  44 enum, bind(C)
  45     enumerator :: OFFLOAD_SUCCESS  = 0
  46     enumerator :: OFFLOAD_DISABLED          ! offload is disabled
  47     enumerator :: OFFLOAD_UNAVAILABLE       ! card is not available
  48     enumerator :: OFFLOAD_OUT_OF_MEMORY     ! not enough memory on device
  49     enumerator :: OFFLOAD_PROCESS_DIED      ! target process has died
  50     enumerator :: OFFLOAD_ERROR             ! unspecified error
  51 end enum
  52
  53 type, bind (C) :: offload_status
  54     integer(kind=c_int)    ::  result          = OFFLOAD_DISABLED
  55     integer(kind=c_int)    ::  device_number   = -1
  56     integer(kind=c_size_t) ::  data_sent       = 0
  57     integer(kind=c_size_t) ::  data_received   = 0
  58 end type offload_status
  59
  60 interface
  61 function offload_number_of_devices ()                                  &
  62            bind (C, name = "_Offload_number_of_devices")
  63 !dec$ attributes default :: offload_number_of_devices
  64   import :: c_int
  65   integer (kind=c_int)        :: offload_number_of_devices
  66 !dec$ attributes offload:mic :: offload_number_of_devices
  67 !dir$ attributes known_intrinsic ::  offload_number_of_devices
  68 end function offload_number_of_devices
  69
  70 function offload_signaled(target_number, signal)                       &
  71            bind (C, name = "_Offload_signaled")
  72 !dec$ attributes default :: offload_signaled
  73   import :: c_int, c_int64_t
  74   integer (kind=c_int) :: offload_signaled
  75   integer (kind=c_int), value :: target_number
  76   integer (kind=c_int64_t), value :: signal
  77 !dec$ attributes offload:mic :: offload_signaled
  78 end function offload_signaled
  79
  80 subroutine offload_report(val)                                         &
  81            bind (C, name = "_Offload_report")
  82 !dec$ attributes default :: offload_report
  83   import :: c_int
  84   integer (kind=c_int), value :: val
  85 !dec$ attributes offload:mic :: offload_report
  86 end subroutine offload_report
  87
  88 function offload_get_device_number()                                   &
  89            bind (C, name = "_Offload_get_device_number")
  90 !dec$ attributes default :: offload_get_device_number
  91   import :: c_int
  92   integer (kind=c_int)        :: offload_get_device_number
  93 !dec$ attributes offload:mic :: offload_get_device_number
  94 end function offload_get_device_number
  95
  96 function offload_get_physical_device_number()                          &
  97            bind (C, name = "_Offload_get_physical_device_number")
  98 !dec$ attributes default :: offload_get_physical_device_number
  99   import :: c_int
 100   integer (kind=c_int)        :: offload_get_physical_device_number
 101 !dec$ attributes offload:mic :: offload_get_physical_device_number
 102 end function offload_get_physical_device_number
 103
 104 ! OpenMP API wrappers
 105
 106 subroutine omp_set_num_threads_target (target_type,                    &
 107                                        target_number,                  &
 108                                        num_threads)                    &
 109            bind (C, name = "omp_set_num_threads_target")
 110   import :: c_int
 111   integer (kind=c_int), value :: target_type, target_number, num_threads
 112 end subroutine omp_set_num_threads_target
 113
 114 function omp_get_max_threads_target (target_type,                      &
 115                                      target_number)                    &
 116          bind (C, name = "omp_get_max_threads_target")
 117   import :: c_int
 118   integer (kind=c_int)        :: omp_get_max_threads_target
 119   integer (kind=c_int), value :: target_type, target_number
 120 end function omp_get_max_threads_target
 121
 122 function omp_get_num_procs_target (target_type,                        &
 123                                    target_number)                      &
 124          bind (C, name = "omp_get_num_procs_target")
 125   import :: c_int
 126   integer (kind=c_int)        :: omp_get_num_procs_target
 127   integer (kind=c_int), value :: target_type, target_number
 128 end function omp_get_num_procs_target
 129
 130 subroutine omp_set_dynamic_target (target_type,                        &
 131                                    target_number,                      &
 132                                    num_threads)                        &
 133            bind (C, name = "omp_set_dynamic_target")
 134   import :: c_int
 135   integer (kind=c_int), value :: target_type, target_number, num_threads
 136 end subroutine omp_set_dynamic_target
 137
 138 function omp_get_dynamic_target (target_type,                          &
 139                                  target_number)                        &
 140          bind (C, name = "omp_get_dynamic_target")
 141   import :: c_int
 142   integer (kind=c_int)        :: omp_get_dynamic_target
 143   integer (kind=c_int), value :: target_type, target_number
 144 end function omp_get_dynamic_target
 145
 146 subroutine omp_set_nested_target (target_type,                         &
 147                                   target_number,                       &
 148                                   nested)                              &
 149            bind (C, name = "omp_set_nested_target")
 150   import :: c_int
 151   integer (kind=c_int), value :: target_type, target_number, nested
 152 end subroutine omp_set_nested_target
 153
 154 function omp_get_nested_target (target_type,                           &
 155                                 target_number)                         &
 156          bind (C, name = "omp_get_nested_target")
 157   import :: c_int
 158   integer (kind=c_int)        :: omp_get_nested_target
 159   integer (kind=c_int), value :: target_type, target_number
 160 end function omp_get_nested_target
 161
 162 subroutine omp_set_schedule_target (target_type,                       &
 163                                     target_number,                     &
 164                                     kind,                              &
 165                                     modifier)                          &
 166            bind (C, name = "omp_set_schedule_target")
 167   import :: c_int
 168   integer (kind=c_int), value :: target_type, target_number, kind, modifier
 169 end subroutine omp_set_schedule_target
 170
 171 subroutine omp_get_schedule_target (target_type,                       &
 172                                     target_number,                     &
 173                                     kind,                              &
 174                                     modifier)                          &
 175            bind (C, name = "omp_get_schedule_target")
 176   import :: c_int, c_intptr_t
 177   integer (kind=c_int), value :: target_type, target_number
 178   integer (kind=c_intptr_t), value :: kind, modifier
 179 end subroutine omp_get_schedule_target
 180
 181 ! lock API functions
 182
 183 subroutine omp_init_lock_target (target_type,                          &
 184                                  target_number,                        &
 185                                  lock)                                 &
 186            bind (C, name = "omp_init_lock_target")
 187   import :: c_int, c_intptr_t
 188   !dir$ attributes known_intrinsic ::  omp_init_lock_target
 189   integer (kind=c_int), value :: target_type, target_number
 190   integer (kind=c_intptr_t), value :: lock
 191 end subroutine omp_init_lock_target
 192
 193 subroutine omp_destroy_lock_target (target_type,                       &
 194                                     target_number,                     &
 195                                     lock)                              &
 196            bind (C, name = "omp_destroy_lock_target")
 197   import :: c_int, c_intptr_t
 198   !dir$ attributes known_intrinsic ::  omp_destroy_lock_target
 199   integer (kind=c_int), value :: target_type, target_number
 200   integer (kind=c_intptr_t), value :: lock
 201 end subroutine omp_destroy_lock_target
 202
 203 subroutine omp_set_lock_target (target_type,                           &
 204                                 target_number,                         &
 205                                 lock)                                  &
 206            bind (C, name = "omp_set_lock_target")
 207   import :: c_int, c_intptr_t
 208   !dir$ attributes known_intrinsic ::  omp_set_lock_target
 209   integer (kind=c_int), value :: target_type, target_number
 210   integer (kind=c_intptr_t), value :: lock
 211 end subroutine omp_set_lock_target
 212
 213 subroutine omp_unset_lock_target (target_type,                         &
 214                                   target_number,                       &
 215                                   lock)                                &
 216            bind (C, name = "omp_unset_lock_target")
 217   import :: c_int, c_intptr_t
 218   !dir$ attributes known_intrinsic ::  omp_unset_lock_target
 219   integer (kind=c_int), value :: target_type, target_number
 220   integer (kind=c_intptr_t), value :: lock
 221 end subroutine omp_unset_lock_target
 222
 223 function omp_test_lock_target (target_type,                            &
 224                                target_number,                          &
 225                                lock)                                   &
 226            bind (C, name = "omp_test_lock_target")
 227   import :: c_int, c_intptr_t
 228   integer (kind=c_int)        :: omp_test_lock_target
 229   integer (kind=c_int), value :: target_type, target_number
 230   integer (kind=c_intptr_t), value :: lock
 231 end function omp_test_lock_target
 232
 233 ! nested lock API functions
 234
 235 subroutine omp_init_nest_lock_target (target_type,                     &
 236                                       target_number,                   &
 237                                       lock)                            &
 238            bind (C, name = "omp_init_nest_lock_target")
 239   import :: c_int, c_intptr_t
 240   integer (kind=c_int), value :: target_type, target_number
 241   integer (kind=c_intptr_t), value :: lock
 242 end subroutine omp_init_nest_lock_target
 243
 244 subroutine omp_destroy_nest_lock_target (target_type,                  &
 245                                          target_number,                &
 246                                          lock)                         &
 247            bind (C, name = "omp_destroy_nest_lock_target")
 248   import :: c_int, c_intptr_t
 249   integer (kind=c_int), value :: target_type, target_number
 250   integer (kind=c_intptr_t), value :: lock
 251 end subroutine omp_destroy_nest_lock_target
 252
 253 subroutine omp_set_nest_lock_target (target_type,                      &
 254                                      target_number,                    &
 255                                      lock)                             &
 256            bind (C, name = "omp_set_nest_lock_target")
 257   import :: c_int, c_intptr_t
 258   integer (kind=c_int), value :: target_type, target_number
 259   integer (kind=c_intptr_t), value :: lock
 260 end subroutine omp_set_nest_lock_target
 261
 262 subroutine omp_unset_nest_lock_target (target_type,                    &
 263                                        target_number,                  &
 264                                        lock)                           &
 265            bind (C, name = "omp_unset_nest_lock_target")
 266   import :: c_int, c_intptr_t
 267   integer (kind=c_int), value :: target_type, target_number
 268   integer (kind=c_intptr_t), value :: lock
 269 end subroutine omp_unset_nest_lock_target
 270
 271 function omp_test_nest_lock_target (target_type,                       &
 272                                     target_number,                     &
 273                                     lock)                              &
 274            bind (C, name = "omp_test_nest_lock_target")
 275   import :: c_int, c_intptr_t
 276   integer (kind=c_int)        :: omp_test_nest_lock_target
 277   integer (kind=c_int), value :: target_type, target_number
 278   integer (kind=c_intptr_t), value :: lock
 279 end function omp_test_nest_lock_target
 280
 281 end interface
 282 end module mic_lib