Retro68/gcc/liboffloadmic/runtime/mic_lib.f90
2017-04-10 13:32:00 +02:00

283 lines
13 KiB
Fortran

!
! Copyright (c) 2014-2015 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