[flang] Add the OpenMP module.
authorSteve Scalpone <sscalpone@nvidia.com>
Mon, 26 Aug 2019 16:57:06 +0000 (09:57 -0700)
committerSteve Scalpone <sscalpone@nvidia.com>
Mon, 26 Aug 2019 16:57:06 +0000 (09:57 -0700)
Original-commit: flang-compiler/f18@09d8b0d6e1da1435228f339674718881f09a49a2
Reviewed-on: https://github.com/flang-compiler/f18/pull/690
Tree-same-pre-rewrite: false

flang/module/omp_lib.f90 [new file with mode: 0644]
flang/tools/f18/CMakeLists.txt

diff --git a/flang/module/omp_lib.f90 b/flang/module/omp_lib.f90
new file mode 100644 (file)
index 0000000..7f9c782
--- /dev/null
@@ -0,0 +1,553 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+       module omp_lib
+       use, intrinsic :: iso_c_binding
+
+          integer, parameter :: omp_integer_kind        = 4
+          integer, parameter :: omp_logical_kind        = 4
+          integer, parameter :: omp_pause_resource_kind = 4
+          integer, parameter :: omp_event_handle_kind   = 4
+          integer, parameter :: omp_lock_kind           = c_intptr_t
+          integer, parameter :: omp_nest_lock_kind      = c_intptr_t
+          integer, parameter :: omp_sched_kind          =               &
+     &        omp_integer_kind
+          integer, parameter :: omp_proc_bind_kind      =               &
+     &        omp_integer_kind
+          integer, parameter :: omp_sync_hint_kind      =               &
+     &        omp_integer_kind
+          integer, parameter :: omp_depend_kind         =               &
+     &        omp_integer_kind
+          integer, parameter :: omp_memspace_handle_kind  = 4
+          integer, parameter :: omp_allocator_handle_kind = 4
+          integer, parameter :: omp_alloctrait_key_kind   = 4
+          integer, parameter :: omp_alloctrait_val_kind   = 4
+
+          integer(kind=omp_sched_kind), parameter ::                    & 
+     &        omp_sched_static = 1
+          integer(kind=omp_sched_kind), parameter ::                    & 
+     &        omp_sched_dynamic = 2
+          integer(kind=omp_sched_kind), parameter ::                    & 
+     &        omp_sched_guided = 3
+          integer(kind=omp_sched_kind), parameter :: omp_sched_auto = 4
+
+          integer (kind=omp_proc_bind_kind), parameter ::               &
+     &        omp_proc_bind_false = 0
+          integer (kind=omp_proc_bind_kind), parameter ::               &
+     &        omp_proc_bind_true = 1
+          integer (kind=omp_proc_bind_kind), parameter ::               &
+     &        omp_proc_bind_master = 2
+          integer (kind=omp_proc_bind_kind), parameter ::               &
+     &        omp_proc_bind_close = 3
+          integer (kind=omp_proc_bind_kind), parameter ::               &
+     &        omp_proc_bind_spread = 4
+
+          integer (kind=omp_pause_resource_kind), parameter ::          &
+     &        omp_pause_soft = 1
+          integer (kind=omp_pause_resource_kind), parameter ::          &
+     &        omp_pause_hard = 2
+
+          integer, parameter :: omp_lock_hint_kind = omp_sync_hint_kind
+          integer (kind=omp_sync_hint_kind), parameter ::               &
+     &        omp_sync_hint_none = int(Z'0', kind=omp_sync_hint_kind)
+          integer (kind=omp_lock_hint_kind), parameter ::               &
+     &        omp_lock_hint_none = omp_sync_hint_none
+          integer (kind=omp_sync_hint_kind), parameter ::               &
+     &        omp_sync_hint_uncontended =                               &
+     &        int(Z'1', kind=omp_sync_hint_kind)
+          integer (kind=omp_lock_hint_kind), parameter ::               &
+     &        omp_lock_hint_uncontended = omp_sync_hint_uncontended
+          integer (kind=omp_sync_hint_kind), parameter ::               &
+     &        omp_sync_hint_contended =                                 &
+     &        int(Z'2', kind=omp_sync_hint_kind)
+          integer (kind=omp_lock_hint_kind), parameter ::               &
+     &        omp_lock_hint_contended = omp_sync_hint_contended
+          integer (kind=omp_sync_hint_kind), parameter ::               &
+     &        omp_sync_hint_nonspeculative =                            &
+     &        int(Z'4', kind=omp_sync_hint_kind)
+          integer (kind=omp_lock_hint_kind), parameter ::               &
+     &        omp_lock_hint_nonspeculative =                            &
+     &        omp_sync_hint_nonspeculative
+          integer (kind=omp_sync_hint_kind), parameter ::               &
+     &        omp_sync_hint_speculative =                               &
+     &        int(Z'8', kind=omp_sync_hint_kind)
+          integer (kind=omp_lock_hint_kind), parameter ::               &
+     &        omp_lock_hint_speculative = omp_sync_hint_speculative
+
+          integer (kind=omp_event_handle_kind), parameter ::            &
+     &        omp_allow_completion_event = 0
+          integer (kind=omp_event_handle_kind), parameter ::            &
+     &        omp_task_fulfill_event = 1
+
+          integer(kind=omp_alloctrait_key_kind), parameter ::           &
+     &        omp_atk_sync_hint = 1
+          integer(kind=omp_alloctrait_key_kind), parameter ::           &
+     &        omp_atk_alignment = 2
+          integer(kind=omp_alloctrait_key_kind), parameter ::           &
+     &        omp_atk_access = 3
+          integer(kind=omp_alloctrait_key_kind), parameter ::           &
+     &        omp_atk_pool_size = 4
+          integer(kind=omp_alloctrait_key_kind), parameter ::           &
+     &        omp_atk_fallback = 5
+          integer(kind=omp_alloctrait_key_kind), parameter ::           &
+     &        omp_atk_fb_data = 6
+          integer(kind=omp_alloctrait_key_kind), parameter ::           &
+     &        omp_atk_pinned = 7
+          integer(kind=omp_alloctrait_key_kind), parameter ::           &
+     &        omp_atk_partition = 8
+
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_false = 0
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_true = 1
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_default = 2
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_contended = 3
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_uncontended = 4
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_sequential = 5
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_private = 6
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_all = 7
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_thread = 8
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_pteam = 9
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_cgroup = 10
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_default_mem_fb = 11
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_null_fb = 12
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_abort_fb = 13
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_allocator_fb = 14
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_environment = 15
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_nearest = 16
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_blocked = 17
+          integer(kind=omp_alloctrait_val_kind), parameter ::           &
+     &        omp_atv_interleaved = 18
+
+          type omp_alloctrait
+          integer(kind=omp_alloctrait_key_kind) key
+          integer(kind=omp_alloctrait_val_kind) value
+          end type omp_alloctrait
+
+          integer(kind=omp_allocator_handle_kind), parameter ::         &
+     &        omp_null_allocator = 0
+
+          integer (kind=omp_memspace_handle_kind), parameter ::         &
+     &        omp_default_mem_space = 0
+          integer (kind=omp_memspace_handle_kind), parameter ::         &
+     &        omp_large_cap_mem_space = 0
+          integer (kind=omp_memspace_handle_kind), parameter ::         &
+     &        omp_const_mem_space = 0
+          integer (kind=omp_memspace_handle_kind), parameter ::         &
+     &        omp_high_bw_mem_space = 0
+          integer (kind=omp_memspace_handle_kind), parameter ::         &
+     &        omp_low_lat_mem_space = 0
+
+          integer (kind=omp_memspace_handle_kind), parameter ::         &
+     &        omp_default_mem_alloc = 1
+          integer (kind=omp_memspace_handle_kind), parameter ::         &
+     &        omp_large_cap_mem_alloc = omp_default_mem_alloc
+          integer (kind=omp_memspace_handle_kind), parameter ::         &
+     &        omp_const_mem_alloc = 1
+          integer (kind=omp_memspace_handle_kind), parameter ::         &
+     &        omp_high_bw_mem_alloc = 1
+          integer (kind=omp_memspace_handle_kind), parameter ::         &
+     &        omp_low_lat_mem_alloc = 1
+          integer (kind=omp_memspace_handle_kind), parameter ::         &
+     &        omp_thread_mem_alloc = omp_atv_thread
+          integer (kind=omp_memspace_handle_kind), parameter ::         &
+     &        omp_pteam_mem_alloc = omp_atv_pteam
+          integer (kind=omp_memspace_handle_kind), parameter ::         &
+     &        omp_cgroup_mem_alloc = omp_atv_cgroup
+
+          integer (kind=omp_integer_kind), parameter ::                 &
+     &        openmp_version = 200805
+
+      interface
+
+          subroutine omp_set_num_threads(nthreads) bind(c)
+              import
+              integer (kind=omp_integer_kind), VALUE :: nthreads
+          end subroutine omp_set_num_threads
+
+          function omp_get_num_threads() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_num_threads
+          end function omp_get_num_threads
+
+          function omp_get_max_threads() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_max_threads
+          end function omp_get_max_threads
+
+          function omp_get_thread_num() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_thread_num
+          end function omp_get_thread_num
+
+          function omp_get_num_procs() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_num_procs
+          end function omp_get_num_procs
+
+          function omp_in_parallel() bind(c)
+              import
+              logical (kind=omp_logical_kind) omp_in_parallel
+          end function omp_in_parallel
+
+          subroutine omp_set_dynamic(enable) bind(c)
+              import
+              logical (kind=omp_logical_kind), VALUE :: enable
+          end subroutine omp_set_dynamic
+
+          function omp_get_dynamic() bind(c)
+              import
+              logical (kind=omp_logical_kind) omp_get_dynamic
+          end function omp_get_dynamic
+
+          function omp_get_cancelation() bind(c)
+              import
+              logical (kind=omp_logical_kind) omp_get_cancelation
+          end function omp_get_cancelation
+
+          subroutine omp_set_nested(enable) bind(c)
+              import
+              logical (kind=omp_logical_kind), VALUE :: enable
+          end subroutine omp_set_nested
+
+          function omp_get_nested() bind(c)
+              import
+              logical (kind=omp_logical_kind) omp_get_nested
+          end function omp_get_nested
+
+          subroutine omp_set_schedule(kind, modifier) bind(c)
+              import
+              integer (kind=omp_integer_kind), VALUE :: kind
+              integer (kind=omp_integer_kind), VALUE :: modifier
+          end subroutine omp_set_schedule
+
+          subroutine omp_get_schedule(kind, modifier) bind(c)
+              import
+              integer (kind=omp_integer_kind) :: kind
+              integer (kind=omp_integer_kind) :: modifier
+          end subroutine omp_get_schedule
+
+          function omp_get_thread_limit() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_thread_limit
+          end function omp_get_thread_limit
+
+          function omp_get_supported_active_levels() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_supported_active_levels
+          end function omp_get_supported_active_levels
+
+          subroutine omp_set_max_active_levels(max_levels) bind(c)
+              import
+              integer (kind=omp_integer_kind), VALUE :: max_levels
+          end subroutine omp_set_max_active_levels
+
+          function omp_get_max_active_levels() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_max_active_levels
+          end function omp_get_max_active_levels
+
+          function omp_get_level() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_level
+          end function omp_get_level
+
+          function omp_get_ancestor_thread_num(level) bind(c)
+              import
+              integer (kind=omp_integer_kind) level
+              integer (kind=omp_integer_kind) omp_get_ancestor_thread_num
+          end function omp_get_ancestor_thread_num
+
+          function omp_get_team_size(level) bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_team_size
+              integer (kind=omp_integer_kind), VALUE :: level
+          end function omp_get_team_size
+
+          function omp_get_active_level() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_active_level
+          end function omp_get_active_level
+
+          function omp_in_final() bind(c)
+              import
+              logical (kind=omp_logical_kind) omp_in_final
+          end function omp_in_final
+
+          function  omp_get_proc_bind() bind(c)
+              import
+              integer (kind=omp_proc_bind_kind) omp_get_proc_bind
+          end function omp_get_proc_bind
+
+          function omp_get_num_places() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_num_places
+          end function omp_get_num_places
+
+          function omp_get_place_num_procs(place_num) bind(c)
+              import
+              integer (kind=omp_integer_kind), VALUE :: place_num
+              integer (kind=omp_integer_kind) omp_get_place_num_procs
+          end function omp_get_place_num_procs
+
+          subroutine omp_get_place_proc_ids(place_num, ids) bind(c)
+              import
+              integer (kind=omp_integer_kind), VALUE :: place_num
+              integer (kind=omp_integer_kind), intent(out) :: ids(*)
+          end subroutine omp_get_place_proc_ids
+
+          function omp_get_place_num() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_place_num
+          end function omp_get_place_num
+
+          function omp_get_partition_num_places() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_partition_num_places
+          end function omp_get_partition_num_places
+
+          subroutine omp_get_partition_place_nums(place_nums) bind(c)
+              import
+              integer (kind=omp_integer_kind), intent(out) :: place_nums(*)
+          end subroutine omp_get_partition_place_nums
+
+          subroutine omp_set_affinity_format(format)
+              import
+              character(len=*), intent(in) :: format
+          end subroutine omp_set_affinity_format
+
+          function omp_get_affinity_format(buffer)
+              import
+              character(len=*), intent(out) :: buffer
+              integer (kind=omp_integer_kind) omp_get_affinity_format
+          end function omp_get_affinity_format
+
+          subroutine omp_display_affinity(format)
+              import
+              character(len=*), intent(in) :: format
+          end subroutine omp_display_affinity
+
+          function omp_capture_affinity(buffer, format)
+              import
+              character(len=*), intent(out) :: buffer
+              character(len=*), intent(in) :: format
+              integer (kind=omp_integer_kind) omp_capture_affinity
+          end function omp_capture_affinity
+
+          subroutine omp_set_default_device(device_num) bind(c)
+              import
+              integer (kind=omp_integer_kind) device_num
+          end subroutine omp_set_default_device
+
+          function omp_get_default_device() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_default_device
+          end function omp_get_default_device
+
+          function omp_get_num_devices() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_num_devices
+          end function omp_get_num_devices
+
+          function omp_get_device_num() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_device_num
+          end function omp_get_device_num
+
+          function omp_get_num_teams() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_num_teams
+          end function omp_get_num_teams
+
+          function omp_get_team_num() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_team_num
+          end function omp_get_team_num
+
+          function omp_is_initial_device() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_is_initial_device
+          end function omp_is_initial_device
+
+          function omp_get_initial_device() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_initial_device
+          end function omp_get_initial_device
+
+          function omp_get_max_task_priority() bind(c)
+              import
+              integer (kind=omp_integer_kind) omp_get_max_task_priority
+          end function omp_get_max_task_priority
+
+          function omp_pause_resource(kind, device_num) bind(c)
+              import
+              integer (kind=omp_pause_resource_kind) kind
+              integer device_num
+              integer omp_pause_resource
+          end function omp_pause_resource
+
+          function omp_pause_resource_all(kind)
+              import
+              integer (kind=omp_pause_resource_kind) kind
+              integer omp_pause_resource_all
+          end function omp_pause_resource_all
+
+! Lock routines
+          subroutine omp_init_lock(lockvar)                             &
+     &    bind(c, name='omp_init_lock_')
+              import
+              integer (kind=omp_lock_kind), intent(out) :: lockvar
+          end subroutine omp_init_lock
+
+          subroutine omp_init_lock_with_hint(lockvar, hint)             &
+     &    bind(c, name='omp_init_lock_with_hint_')
+              import
+              integer (kind=omp_lock_kind), intent(out) :: lockvar
+              integer (kind=omp_sync_hint_kind), intent(in) :: hint
+          end subroutine omp_init_lock_with_hint
+
+          subroutine omp_destroy_lock(lockvar)                          &
+     &    bind(c, name='omp_destroy_lock_')
+              import
+              integer (kind=omp_lock_kind), intent(inout) :: lockvar
+          end subroutine omp_destroy_lock
+
+          subroutine omp_set_lock(lockvar)                              &
+     &    bind(c, name='omp_set_lock_')
+              import
+              integer (kind=omp_lock_kind), intent(inout) :: lockvar
+          end subroutine omp_set_lock
+
+          subroutine omp_unset_lock(lockvar)                            &
+     &    bind(c, name='omp_unset_lock_')
+              import
+              integer (kind=omp_lock_kind), intent(inout) :: lockvar
+          end subroutine omp_unset_lock
+
+          function omp_test_lock(lockvar)                               &
+     &    bind(c, name='omp_test_lock_')
+              import
+              logical (kind=omp_logical_kind) omp_test_lock
+              integer (kind=omp_lock_kind), intent(inout) :: lockvar
+          end function omp_test_lock
+
+          subroutine omp_init_nest_lock(lockvar)                        &
+     &    bind(c, name='omp_init_nest_lock_')
+              import
+              integer (kind=omp_nest_lock_kind), intent(out) :: lockvar
+          end subroutine omp_init_nest_lock
+
+          subroutine omp_init_nest_lock_with_hint(lockvar, hint)        &
+     &    bind(c, name='omp_init_nest_lock_with_hint_')
+              import
+              integer (kind=omp_lock_kind), intent(out) :: lockvar
+              integer (kind=omp_sync_hint_kind), intent(in) :: hint
+          end subroutine omp_init_nest_lock_with_hint
+
+          subroutine omp_destroy_nest_lock(lockvar)                     &
+     &    bind(c, name='omp_destroy_nest_lock_')
+              import
+              integer (kind=omp_nest_lock_kind),                        &
+     &            intent(inout) :: lockvar
+          end subroutine omp_destroy_nest_lock
+
+          subroutine omp_set_nest_lock(lockvar)                         &
+     &    bind(c, name='omp_set_nest_lock_')
+              import
+              integer (kind=omp_nest_lock_kind),                        &
+     &            intent(inout) :: lockvar
+          end subroutine omp_set_nest_lock
+
+          subroutine omp_unset_nest_lock(lockvar)                       &
+     &    bind(c, name='omp_unset_nest_lock_')
+              import
+              integer (kind=omp_nest_lock_kind),                        &
+     &            intent(inout) :: lockvar
+          end subroutine omp_unset_nest_lock
+
+          function omp_test_nest_lock(lockvar)                          &
+     &    bind(c, name='omp_test_nest_lock_')
+              import
+              integer (kind=omp_integer_kind) omp_test_nest_lock
+              integer (kind=omp_nest_lock_kind),                        &
+     &            intent(inout) :: lockvar
+          end function omp_test_nest_lock
+
+! Timing routines
+          function omp_get_wtime() bind(c)
+              import
+              double precision omp_get_wtime
+          end function omp_get_wtime
+
+          function omp_get_wtick() bind(c)
+              import
+              double precision omp_get_wtick
+          end function omp_get_wtick
+
+
+! Event Routine
+          subroutine omp_fullfill_event(event) bind(c)
+              import
+              integer (kind=omp_event_handle_kind) event
+          end subroutine omp_fullfill_event
+
+! Device Memory Routines
+
+! Memory Management Routines
+          function omp_init_allocator(memspace, ntraits, traits)
+              import
+              integer (kind=omp_memspace_handle_kind),                  &
+     &            intent(in) :: memspace
+              integer, intent(in) :: ntraits
+              type(omp_alloctrait), intent(in) :: traits(*)
+              integer (kind=omp_allocator_handle_kind) omp_init_allocator
+          end function omp_init_allocator
+
+          subroutine omp_destroy_allocator(allocator) bind(c)
+              import
+              integer (kind=omp_allocator_handle_kind),                 &
+     &            intent(in) :: allocator
+          end subroutine omp_destroy_allocator
+
+          subroutine omp_set_default_allocator(allocator) bind(c)
+              import
+              integer(kind=omp_allocator_handle_kind),                  &
+     &            intent(in) :: allocator
+          end subroutine omp_set_default_allocator
+
+          function omp_get_default_allocator()
+              import
+              integer (kind=omp_allocator_handle_kind)                  &
+     &            omp_get_default_allocator
+          end function omp_get_default_allocator
+
+      end interface
+
+      end module omp_lib
index 3ad00e6..cbdaf0c 100644 (file)
@@ -46,6 +46,7 @@ set(MODULES
   "ieee_features"
   "iso_c_binding"
   "iso_fortran_env"
+  "omp_lib"
 )
 
 # Create module files directly from the top-level module source directory