minwin-gcc-5-2/liboffloadmic/runtime/mic_lib.f90

!
!    Copyright (c) 2014 Intel Corporation.  All Rights Reserved.
!
!    Redistribution and use in source and binary forms, with or without
!    modification, are permitted provided that the following conditions
!    are met:
!
!      * Redistributions of source code must retain the above copyright
!        notice, this list of conditions and the following disclaimer.
!      * Redistributions in binary form must reproduce the above copyright
!        notice, this list of conditions and the following disclaimer in the
!        documentation and/or other materials provided with the distribution.
!      * Neither the name of Intel Corporation nor the names of its
!        contributors may be used to endorse or promote products derived
!        from this software without specific prior written permission.
!
!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
!    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
!    A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
!    HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
!    SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
!    LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
!    DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
!    THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
!    (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
!    OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!


! **********************************************************************************
! * This file is intended to support the Intel(r) Many Integrated Core Architecture.
! **********************************************************************************
! free form Fortran source - should be named .f90
! lines are longer than 72 characters

module mic_lib
use, intrinsic :: iso_c_binding

integer, parameter:: target_mic=2
integer, parameter:: default_target_type=target_mic
integer, parameter:: default_target_number=0

enum, bind(C)
    enumerator :: OFFLOAD_SUCCESS  = 0
    enumerator :: OFFLOAD_DISABLED          ! offload is disabled
    enumerator :: OFFLOAD_UNAVAILABLE       ! card is not available
    enumerator :: OFFLOAD_OUT_OF_MEMORY     ! not enough memory on device
    enumerator :: OFFLOAD_PROCESS_DIED      ! target process has died
    enumerator :: OFFLOAD_ERROR             ! unspecified error
end enum

type, bind (C) :: offload_status
    integer(kind=c_int)    ::  result          = OFFLOAD_DISABLED
    integer(kind=c_int)    ::  device_number   = -1
    integer(kind=c_size_t) ::  data_sent       = 0
    integer(kind=c_size_t) ::  data_received   = 0
end type offload_status

interface
function offload_number_of_devices ()                                  &
           bind (C, name = "_Offload_number_of_devices")
!dec$ attributes default :: offload_number_of_devices
  import :: c_int
  integer (kind=c_int)        :: offload_number_of_devices
!dec$ attributes offload:mic :: offload_number_of_devices
!dir$ attributes known_intrinsic ::  offload_number_of_devices
end function offload_number_of_devices

function offload_signaled(target_number, signal)                       &
           bind (C, name = "_Offload_signaled")
!dec$ attributes default :: offload_signaled
  import :: c_int, c_int64_t
  integer (kind=c_int) :: offload_signaled
  integer (kind=c_int), value :: target_number
  integer (kind=c_int64_t), value :: signal
!dec$ attributes offload:mic :: offload_signaled
end function offload_signaled

subroutine offload_report(val)                                         &
           bind (C, name = "_Offload_report")
!dec$ attributes default :: offload_report
  import :: c_int
  integer (kind=c_int), value :: val
!dec$ attributes offload:mic :: offload_report
end subroutine offload_report

function offload_get_device_number()                                   &
           bind (C, name = "_Offload_get_device_number")
!dec$ attributes default :: offload_get_device_number
  import :: c_int
  integer (kind=c_int)        :: offload_get_device_number
!dec$ attributes offload:mic :: offload_get_device_number
end function offload_get_device_number

function offload_get_physical_device_number()                          &
           bind (C, name = "_Offload_get_physical_device_number")
!dec$ attributes default :: offload_get_physical_device_number
  import :: c_int
  integer (kind=c_int)        :: offload_get_physical_device_number
!dec$ attributes offload:mic :: offload_get_physical_device_number
end function offload_get_physical_device_number

! OpenMP API wrappers

subroutine omp_set_num_threads_target (target_type,                    &
                                       target_number,                  &
                                       num_threads)                    &
           bind (C, name = "omp_set_num_threads_target")
  import :: c_int
  integer (kind=c_int), value :: target_type, target_number, num_threads
end subroutine omp_set_num_threads_target

function omp_get_max_threads_target (target_type,                      &
                                     target_number)                    &
         bind (C, name = "omp_get_max_threads_target")
  import :: c_int
  integer (kind=c_int)        :: omp_get_max_threads_target
  integer (kind=c_int), value :: target_type, target_number
end function omp_get_max_threads_target

function omp_get_num_procs_target (target_type,                        &
                                   target_number)                      &
         bind (C, name = "omp_get_num_procs_target")
  import :: c_int
  integer (kind=c_int)        :: omp_get_num_procs_target
  integer (kind=c_int), value :: target_type, target_number
end function omp_get_num_procs_target

subroutine omp_set_dynamic_target (target_type,                        &
                                   target_number,                      &
                                   num_threads)                        &
           bind (C, name = "omp_set_dynamic_target")
  import :: c_int
  integer (kind=c_int), value :: target_type, target_number, num_threads
end subroutine omp_set_dynamic_target

function omp_get_dynamic_target (target_type,                          &
                                 target_number)                        &
         bind (C, name = "omp_get_dynamic_target")
  import :: c_int
  integer (kind=c_int)        :: omp_get_dynamic_target
  integer (kind=c_int), value :: target_type, target_number
end function omp_get_dynamic_target

subroutine omp_set_nested_target (target_type,                         &
                                  target_number,                       &
                                  nested)                              &
           bind (C, name = "omp_set_nested_target")
  import :: c_int
  integer (kind=c_int), value :: target_type, target_number, nested
end subroutine omp_set_nested_target

function omp_get_nested_target (target_type,                           &
                                target_number)                         &
         bind (C, name = "omp_get_nested_target")
  import :: c_int
  integer (kind=c_int)        :: omp_get_nested_target
  integer (kind=c_int), value :: target_type, target_number
end function omp_get_nested_target

subroutine omp_set_schedule_target (target_type,                       &
                                    target_number,                     &
                                    kind,                              &
                                    modifier)                          &
           bind (C, name = "omp_set_schedule_target")
  import :: c_int
  integer (kind=c_int), value :: target_type, target_number, kind, modifier
end subroutine omp_set_schedule_target

subroutine omp_get_schedule_target (target_type,                       &
                                    target_number,                     &
                                    kind,                              &
                                    modifier)                          &
           bind (C, name = "omp_get_schedule_target")
  import :: c_int, c_intptr_t
  integer (kind=c_int), value :: target_type, target_number
  integer (kind=c_intptr_t), value :: kind, modifier
end subroutine omp_get_schedule_target

! lock API functions

subroutine omp_init_lock_target (target_type,                          &
                                 target_number,                        &
                                 lock)                                 &
           bind (C, name = "omp_init_lock_target")
  import :: c_int, c_intptr_t
  !dir$ attributes known_intrinsic ::  omp_init_lock_target
  integer (kind=c_int), value :: target_type, target_number
  integer (kind=c_intptr_t), value :: lock
end subroutine omp_init_lock_target

subroutine omp_destroy_lock_target (target_type,                       &
                                    target_number,                     &
                                    lock)                              &
           bind (C, name = "omp_destroy_lock_target")
  import :: c_int, c_intptr_t
  !dir$ attributes known_intrinsic ::  omp_destroy_lock_target
  integer (kind=c_int), value :: target_type, target_number
  integer (kind=c_intptr_t), value :: lock
end subroutine omp_destroy_lock_target

subroutine omp_set_lock_target (target_type,                           &
                                target_number,                         &
                                lock)                                  &
           bind (C, name = "omp_set_lock_target")
  import :: c_int, c_intptr_t
  !dir$ attributes known_intrinsic ::  omp_set_lock_target
  integer (kind=c_int), value :: target_type, target_number
  integer (kind=c_intptr_t), value :: lock
end subroutine omp_set_lock_target

subroutine omp_unset_lock_target (target_type,                         &
                                  target_number,                       &
                                  lock)                                &
           bind (C, name = "omp_unset_lock_target")
  import :: c_int, c_intptr_t
  !dir$ attributes known_intrinsic ::  omp_unset_lock_target
  integer (kind=c_int), value :: target_type, target_number
  integer (kind=c_intptr_t), value :: lock
end subroutine omp_unset_lock_target

function omp_test_lock_target (target_type,                            &
                               target_number,                          &
                               lock)                                   &
           bind (C, name = "omp_test_lock_target")
  import :: c_int, c_intptr_t
  integer (kind=c_int)        :: omp_test_lock_target
  integer (kind=c_int), value :: target_type, target_number
  integer (kind=c_intptr_t), value :: lock
end function omp_test_lock_target

! nested lock API functions

subroutine omp_init_nest_lock_target (target_type,                     &
                                      target_number,                   &
                                      lock)                            &
           bind (C, name = "omp_init_nest_lock_target")
  import :: c_int, c_intptr_t
  integer (kind=c_int), value :: target_type, target_number
  integer (kind=c_intptr_t), value :: lock
end subroutine omp_init_nest_lock_target

subroutine omp_destroy_nest_lock_target (target_type,                  &
                                         target_number,                &
                                         lock)                         &
           bind (C, name = "omp_destroy_nest_lock_target")
  import :: c_int, c_intptr_t
  integer (kind=c_int), value :: target_type, target_number
  integer (kind=c_intptr_t), value :: lock
end subroutine omp_destroy_nest_lock_target

subroutine omp_set_nest_lock_target (target_type,                      &
                                     target_number,                    &
                                     lock)                             &
           bind (C, name = "omp_set_nest_lock_target")
  import :: c_int, c_intptr_t
  integer (kind=c_int), value :: target_type, target_number
  integer (kind=c_intptr_t), value :: lock
end subroutine omp_set_nest_lock_target

subroutine omp_unset_nest_lock_target (target_type,                    &
                                       target_number,                  &
                                       lock)                           &
           bind (C, name = "omp_unset_nest_lock_target")
  import :: c_int, c_intptr_t
  integer (kind=c_int), value :: target_type, target_number
  integer (kind=c_intptr_t), value :: lock
end subroutine omp_unset_nest_lock_target

function omp_test_nest_lock_target (target_type,                       &
                                    target_number,                     &
                                    lock)                              &
           bind (C, name = "omp_test_nest_lock_target")
  import :: c_int, c_intptr_t
  integer (kind=c_int)        :: omp_test_nest_lock_target
  integer (kind=c_int), value :: target_type, target_number
  integer (kind=c_intptr_t), value :: lock
end function omp_test_nest_lock_target

end interface
end module mic_lib