From c26babb43f94e6217d9057211afb03e6ea451a4e Mon Sep 17 00:00:00 2001 From: Willem Deconinck Date: Thu, 10 Oct 2024 14:28:25 +0000 Subject: [PATCH] Add Fortran interface to pluto --- pluto/CMakeLists.txt | 5 + pluto/src/CMakeLists.txt | 8 + pluto/src/pluto_f/pluto_module.F90 | 829 ++++++++++++++++++ pluto/src/pluto_f/pluto_module.cc | 93 ++ pluto/tests/CMakeLists.txt | 7 + .../tests/fortran/test_fortran_allocator.F90 | 37 + .../test_fortran_memory_pool_resource.F90 | 60 ++ .../fortran/test_fortran_memory_resource.F90 | 35 + pluto/tests/fortran/test_fortran_scope.F90 | 50 ++ 9 files changed, 1124 insertions(+) create mode 100644 pluto/src/pluto_f/pluto_module.F90 create mode 100644 pluto/src/pluto_f/pluto_module.cc create mode 100644 pluto/tests/fortran/test_fortran_allocator.F90 create mode 100644 pluto/tests/fortran/test_fortran_memory_pool_resource.F90 create mode 100644 pluto/tests/fortran/test_fortran_memory_resource.F90 create mode 100644 pluto/tests/fortran/test_fortran_scope.F90 diff --git a/pluto/CMakeLists.txt b/pluto/CMakeLists.txt index 835e3f315..2d9112d43 100644 --- a/pluto/CMakeLists.txt +++ b/pluto/CMakeLists.txt @@ -63,6 +63,11 @@ if(HAVE_WARNING_AS_ERROR) ecbuild_add_cxx_flags("-Werror" NO_FAIL NAME pluto_cxx_warning_as_error QUIET) endif() +ecbuild_add_option( FEATURE FORTRAN DESCRIPTION "Fortran API for pluto" ) +if( HAVE_FORTRAN ) + ecbuild_enable_fortran( REQUIRED MODULE_DIRECTORY ${PROJECT_BINARY_DIR}/module ) +endif() + include("cmake/pluto_hic_macros.cmake") add_subdirectory(src) diff --git a/pluto/src/CMakeLists.txt b/pluto/src/CMakeLists.txt index 07569b5ca..6c506ce64 100644 --- a/pluto/src/CMakeLists.txt +++ b/pluto/src/CMakeLists.txt @@ -97,3 +97,11 @@ ecbuild_add_library( TARGET pluto target_compile_features( pluto INTERFACE cxx_std_17 ) target_compile_options( pluto PUBLIC $<$:--extended-lambda>) + +ecbuild_add_library( TARGET pluto_f + SOURCES + pluto_f/pluto_module.F90 + pluto_f/pluto_module.cc + PRIVATE_LIBS pluto + PUBLIC_INCLUDES $ +) diff --git a/pluto/src/pluto_f/pluto_module.F90 b/pluto/src/pluto_f/pluto_module.F90 new file mode 100644 index 000000000..9417e3d9f --- /dev/null +++ b/pluto/src/pluto_f/pluto_module.F90 @@ -0,0 +1,829 @@ +module pluto_module + +use iso_c_binding, only: c_loc, c_ptr, c_int, c_size_t, c_null_ptr, c_double, c_float, c_int32_t, c_int64_t, c_f_pointer +implicit none +private + +public :: pluto, pluto_memory_resource, pluto_allocator + +interface + subroutine c_pluto_host_set_default_resource_name(name, name_size) bind(c) + use iso_c_binding, only: c_ptr, c_int + type(c_ptr), value, intent(in) :: name + integer(c_int), value, intent(in) :: name_size + end subroutine + subroutine c_pluto_host_set_default_resource_ptr(memory_resource) bind(c) + use iso_c_binding, only: c_ptr + type(c_ptr), value, intent(in) :: memory_resource + end subroutine + subroutine c_pluto_device_set_default_resource_name(name, name_size) bind(c) + use iso_c_binding, only: c_ptr, c_int + type(c_ptr), value, intent(in) :: name + integer(c_int), value, intent(in) :: name_size + end subroutine + subroutine c_pluto_device_set_default_resource_ptr(memory_resource) bind(c) + use iso_c_binding, only: c_ptr + type(c_ptr), value, intent(in) :: memory_resource + end subroutine + function c_pluto_host_get_default_resource() result(memory_resource) bind(c) + use iso_c_binding, only: c_ptr + type(c_ptr) :: memory_resource + end function + function c_pluto_device_get_default_resource() result(memory_resource) bind(c) + use iso_c_binding, only: c_ptr + type(c_ptr) :: memory_resource + end function + function c_pluto_get_registered_resource(name, name_size) result(memory_resource) bind(c) + use iso_c_binding, only: c_ptr, c_int + type(c_ptr) :: memory_resource + type(c_ptr), value, intent(in) :: name + integer(c_int), value, intent(in) :: name_size + end function + function c_pluto_memory_resource_allocate(memory_resource, bytes, alignment) result(memory) bind(c) + use iso_c_binding, only: c_ptr, c_size_t + type(c_ptr) :: memory + type(c_ptr), value :: memory_resource + integer(c_size_t), value :: bytes + integer(c_size_t), value :: alignment + end function + subroutine c_pluto_memory_resource_deallocate(memory_resource, memory, bytes, alignment) bind(c) + use iso_c_binding, only: c_ptr, c_size_t + type(c_ptr), value :: memory_resource + type(c_ptr), value :: memory + integer(c_size_t), value :: bytes + integer(c_size_t), value :: alignment + end subroutine + function c_pluto_memory_pool_resource_size(memory_resource) result(size) bind(c) + use iso_c_binding, only: c_ptr, c_size_t + integer(c_size_t) :: size + type(c_ptr), value :: memory_resource + end function + function c_pluto_memory_pool_resource_capacity(memory_resource) result(capacity) bind(c) + use iso_c_binding, only: c_ptr, c_size_t + integer(c_size_t) :: capacity + type(c_ptr), value :: memory_resource + end function + subroutine c_pluto_memory_pool_resource_reserve(memory_resource, bytes) bind(c) + use iso_c_binding, only: c_ptr, c_size_t + type(c_ptr), value :: memory_resource + integer(c_size_t), value :: bytes + end subroutine + subroutine c_pluto_memory_pool_resource_release(memory_resource) bind(c) + use iso_c_binding, only: c_ptr + type(c_ptr), value :: memory_resource + end subroutine + subroutine c_pluto_scope_push() bind(c) + end subroutine + subroutine c_pluto_scope_pop() bind(c) + end subroutine +end interface + +type :: pluto_memory_resource + type(c_ptr) :: c_memory_resource +contains + procedure :: allocate => pluto_memory_resource_allocate + procedure :: deallocate => pluto_memory_resource_deallocate + procedure :: reserve => pluto_memory_pool_resource_reserve + procedure :: release => pluto_memory_pool_resource_release + procedure :: capacity => pluto_memory_pool_resource_capacity + procedure :: size => pluto_memory_pool_resource_size +end type + +type pluto_allocator + type(pluto_memory_resource) :: memory_resource +contains + + procedure :: pluto_allocator_allocate_int32_r1 + procedure :: pluto_allocator_allocate_int32_r2 + procedure :: pluto_allocator_allocate_int32_r3 + procedure :: pluto_allocator_allocate_int32_r4 + procedure :: pluto_allocator_allocate_int64_r1 + procedure :: pluto_allocator_allocate_int64_r2 + procedure :: pluto_allocator_allocate_int64_r3 + procedure :: pluto_allocator_allocate_int64_r4 + procedure :: pluto_allocator_allocate_real32_r1 + procedure :: pluto_allocator_allocate_real32_r2 + procedure :: pluto_allocator_allocate_real32_r3 + procedure :: pluto_allocator_allocate_real32_r4 + procedure :: pluto_allocator_allocate_real64_r1 + procedure :: pluto_allocator_allocate_real64_r2 + procedure :: pluto_allocator_allocate_real64_r3 + procedure :: pluto_allocator_allocate_real64_r4 + + generic :: allocate => & + & pluto_allocator_allocate_int32_r1, & + & pluto_allocator_allocate_int32_r2, & + & pluto_allocator_allocate_int32_r3, & + & pluto_allocator_allocate_int32_r4, & + & pluto_allocator_allocate_int64_r1, & + & pluto_allocator_allocate_int64_r2, & + & pluto_allocator_allocate_int64_r3, & + & pluto_allocator_allocate_int64_r4, & + & pluto_allocator_allocate_real32_r1, & + & pluto_allocator_allocate_real32_r2, & + & pluto_allocator_allocate_real32_r3, & + & pluto_allocator_allocate_real32_r4, & + & pluto_allocator_allocate_real64_r1, & + & pluto_allocator_allocate_real64_r2, & + & pluto_allocator_allocate_real64_r3, & + & pluto_allocator_allocate_real64_r4 + + procedure :: pluto_allocator_deallocate_int32_r1 + procedure :: pluto_allocator_deallocate_int32_r2 + procedure :: pluto_allocator_deallocate_int32_r3 + procedure :: pluto_allocator_deallocate_int32_r4 + procedure :: pluto_allocator_deallocate_int64_r1 + procedure :: pluto_allocator_deallocate_int64_r2 + procedure :: pluto_allocator_deallocate_int64_r3 + procedure :: pluto_allocator_deallocate_int64_r4 + procedure :: pluto_allocator_deallocate_real32_r1 + procedure :: pluto_allocator_deallocate_real32_r2 + procedure :: pluto_allocator_deallocate_real32_r3 + procedure :: pluto_allocator_deallocate_real32_r4 + procedure :: pluto_allocator_deallocate_real64_r1 + procedure :: pluto_allocator_deallocate_real64_r2 + procedure :: pluto_allocator_deallocate_real64_r3 + procedure :: pluto_allocator_deallocate_real64_r4 + + generic :: deallocate => & + & pluto_allocator_deallocate_int32_r1, & + & pluto_allocator_deallocate_int32_r2, & + & pluto_allocator_deallocate_int32_r3, & + & pluto_allocator_deallocate_int32_r4, & + & pluto_allocator_deallocate_int64_r1, & + & pluto_allocator_deallocate_int64_r2, & + & pluto_allocator_deallocate_int64_r3, & + & pluto_allocator_deallocate_int64_r4, & + & pluto_allocator_deallocate_real32_r1, & + & pluto_allocator_deallocate_real32_r2, & + & pluto_allocator_deallocate_real32_r3, & + & pluto_allocator_deallocate_real32_r4, & + & pluto_allocator_deallocate_real64_r1, & + & pluto_allocator_deallocate_real64_r2, & + & pluto_allocator_deallocate_real64_r3, & + & pluto_allocator_deallocate_real64_r4 +end type + +type pluto_host_t + integer :: dummy +contains + procedure, nopass :: get_default_resource => pluto_host_get_default_resource + procedure, nopass :: make_allocator => pluto_host_make_allocator + procedure, private :: set_default_resource_name => pluto_host_set_default_resource_name + procedure, private :: set_default_resource_type => pluto_host_set_default_resource_type + generic, public :: set_default_resource => set_default_resource_type, set_default_resource_name +end type + +type pluto_device_t +contains + procedure, nopass :: get_default_resource => pluto_device_get_default_resource + procedure, nopass :: make_allocator => pluto_device_make_allocator + procedure, private :: set_default_resource_name => pluto_device_set_default_resource_name + procedure, private :: set_default_resource_type => pluto_device_set_default_resource_type + generic :: set_default_resource => set_default_resource_name, set_default_resource_type +end type + +type pluto_scope_t +contains + procedure, nopass :: push => pluto_scope_push + procedure, nopass :: pop => pluto_scope_pop +end type + +type pluto_t + type(pluto_host_t) :: host + type(pluto_device_t) :: device + type(pluto_scope_t) :: scope +contains + procedure, nopass :: get_registered_resource => pluto_get_registered_resource + procedure, nopass :: new_delete_resource => pluto_new_delete_resource + procedure, nopass :: pinned_resource => pluto_pinned_resource + procedure, nopass :: device_resource => pluto_device_resource + procedure, nopass :: managed_resource => pluto_managed_resource + procedure, nopass :: pool_resource => pluto_pool_resource + procedure, nopass :: pinned_pool_resource => pluto_pinned_pool_resource + procedure, nopass :: device_pool_resource => pluto_device_pool_resource + procedure, nopass :: managed_pool_resource => pluto_managed_pool_resource + procedure, private :: make_allocator_type => pluto_make_allocator_type + procedure, private :: make_allocator_name => pluto_make_allocator_name + generic :: make_allocator => make_allocator_type, make_allocator_name + procedure, nopass :: reserve => pluto_memory_pool_resource_reserve + procedure, nopass :: release => pluto_memory_pool_resource_release +end type + +type(pluto_t) :: pluto + +contains + +subroutine pluto_host_set_default_resource_name(this, name) + class(pluto_host_t) :: this + character(len=*), target, intent(in) :: name + call c_pluto_host_set_default_resource_name(c_loc(name), len(name,kind=c_int)) +end subroutine + +subroutine pluto_host_set_default_resource_type(this, memory_resource) + class(pluto_host_t) :: this + type(pluto_memory_resource), intent(in) :: memory_resource + call c_pluto_host_set_default_resource_ptr(memory_resource%c_memory_resource) +end subroutine + +subroutine pluto_device_set_default_resource_name(this, name) + class(pluto_device_t) :: this + character(len=*), target, intent(in) :: name + call c_pluto_device_set_default_resource_name(c_loc(name), len(name,kind=c_int)) +end subroutine + +subroutine pluto_device_set_default_resource_type(this, memory_resource) + class(pluto_device_t) :: this + type(pluto_memory_resource), intent(in) :: memory_resource + call c_pluto_device_set_default_resource_ptr(memory_resource%c_memory_resource) +end subroutine + +subroutine pluto_scope_push() + call c_pluto_scope_push() +end subroutine + +subroutine pluto_scope_pop() + call c_pluto_scope_pop() +end subroutine + +function pluto_get_registered_resource(name) result(memory_resource) + type(pluto_memory_resource) :: memory_resource + character(len=*), target, intent(in) :: name + memory_resource%c_memory_resource = & + & c_pluto_get_registered_resource(c_loc(name), len(name,kind=c_int)) +end function + +function pluto_host_get_default_resource() result(memory_resource) + type(pluto_memory_resource) :: memory_resource + memory_resource%c_memory_resource = c_pluto_host_get_default_resource() +end function + +function pluto_device_get_default_resource() result(memory_resource) + type(pluto_memory_resource) :: memory_resource + memory_resource%c_memory_resource = c_pluto_device_get_default_resource() +end function + +subroutine pluto_memory_resource_allocate(this, memory, bytes, alignment) + class(pluto_memory_resource) :: this + type(c_ptr), intent(out) :: memory + integer(c_size_t), intent(in) :: bytes + integer(c_size_t), intent(in), optional :: alignment + if (present(alignment)) then + memory = c_pluto_memory_resource_allocate(this%c_memory_resource, bytes, alignment) + else + memory = c_pluto_memory_resource_allocate(this%c_memory_resource, bytes, int(0,c_size_t)) + endif +end subroutine + +subroutine pluto_memory_resource_deallocate(this, memory, bytes, alignment) + class(pluto_memory_resource) :: this + type(c_ptr), intent(inout) :: memory + integer(c_size_t), intent(in) :: bytes + integer(c_size_t), intent(in), optional :: alignment + if (present(alignment)) then + call c_pluto_memory_resource_deallocate(this%c_memory_resource, memory, bytes, alignment) + else + call c_pluto_memory_resource_deallocate(this%c_memory_resource, memory, bytes, int(0,c_size_t)) + endif + memory = c_null_ptr +end subroutine + +subroutine pluto_memory_pool_resource_release(this) + class(pluto_memory_resource), intent(in) :: this + call c_pluto_memory_pool_resource_release(this%c_memory_resource) +end subroutine + +subroutine pluto_memory_pool_resource_reserve(this, bytes) + class(pluto_memory_resource) :: this + integer(c_size_t), intent(in) :: bytes + call c_pluto_memory_pool_resource_reserve(this%c_memory_resource, bytes) +end subroutine + +function pluto_memory_pool_resource_size(this) + integer(c_size_t) :: pluto_memory_pool_resource_size + class(pluto_memory_resource), intent(in) :: this + pluto_memory_pool_resource_size = c_pluto_memory_pool_resource_size(this%c_memory_resource) +end function + +function pluto_memory_pool_resource_capacity(this) + integer(c_size_t) :: pluto_memory_pool_resource_capacity + class(pluto_memory_resource), intent(in) :: this + pluto_memory_pool_resource_capacity = c_pluto_memory_pool_resource_capacity(this%c_memory_resource) +end function + +function pluto_host_make_allocator() result(allocator) + type(pluto_allocator) :: allocator + allocator%memory_resource = pluto_host_get_default_resource() +end function + +function pluto_device_make_allocator() result(allocator) + type(pluto_allocator) :: allocator + allocator%memory_resource = pluto_device_get_default_resource() +end function + +function pluto_make_allocator_type(this, memory_resource) result(allocator) + class(pluto_t) :: this + type(pluto_allocator) :: allocator + type(pluto_memory_resource) :: memory_resource + allocator%memory_resource%c_memory_resource = memory_resource%c_memory_resource +end function + +function pluto_make_allocator_name(this, memory_resource) result(allocator) + class(pluto_t) :: this + type(pluto_allocator) :: allocator + character(len=*), target, intent(in) :: memory_resource + allocator%memory_resource%c_memory_resource = & + & c_pluto_get_registered_resource(c_loc(memory_resource), len(memory_resource,kind=c_int)) +end function + + +subroutine pluto_allocator_allocate_int32_r1(this, array, shape) + class(pluto_allocator) :: this + integer(c_int32_t), pointer, intent(out) :: array(:) + integer(c_int), intent(in) :: shape(1) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 4 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_int32_r2(this, array, shape) + class(pluto_allocator) :: this + integer(c_int32_t), pointer, intent(out) :: array(:,:) + integer(c_int), intent(in) :: shape(2) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 4 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_int32_r3(this, array, shape) + class(pluto_allocator) :: this + integer(c_int32_t), pointer, intent(out) :: array(:,:,:) + integer(c_int), intent(in) :: shape(3) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 4 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_int32_r4(this, array, shape) + class(pluto_allocator) :: this + integer(c_int32_t), pointer, intent(out) :: array(:,:,:,:) + integer(c_int), intent(in) :: shape(4) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 4 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_int64_r1(this, array, shape) + class(pluto_allocator) :: this + integer(c_int64_t), pointer, intent(out) :: array(:) + integer(c_int), intent(in) :: shape(1) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 8 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_int64_r2(this, array, shape) + class(pluto_allocator) :: this + integer(c_int64_t), pointer, intent(out) :: array(:,:) + integer(c_int), intent(in) :: shape(2) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 8 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_int64_r3(this, array, shape) + class(pluto_allocator) :: this + integer(c_int64_t), pointer, intent(out) :: array(:,:,:) + integer(c_int), intent(in) :: shape(3) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 8 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_int64_r4(this, array, shape) + class(pluto_allocator) :: this + integer(c_int64_t), pointer, intent(out) :: array(:,:,:,:) + integer(c_int), intent(in) :: shape(4) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 8 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_real32_r1(this, array, shape) + class(pluto_allocator) :: this + real(c_float), pointer, intent(out) :: array(:) + integer(c_int), intent(in) :: shape(1) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 4 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_real32_r2(this, array, shape) + class(pluto_allocator) :: this + real(c_float), pointer, intent(out) :: array(:,:) + integer(c_int), intent(in) :: shape(2) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 4 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_real32_r3(this, array, shape) + class(pluto_allocator) :: this + real(c_float), pointer, intent(out) :: array(:,:,:) + integer(c_int), intent(in) :: shape(3) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 4 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_real32_r4(this, array, shape) + class(pluto_allocator) :: this + real(c_float), pointer, intent(out) :: array(:,:,:,:) + integer(c_int), intent(in) :: shape(4) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 4 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_real64_r1(this, array, shape) + class(pluto_allocator) :: this + real(c_double), pointer, intent(out) :: array(:) + integer(c_int), intent(in) :: shape(1) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 8 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_real64_r2(this, array, shape) + class(pluto_allocator) :: this + real(c_double), pointer, intent(out) :: array(:,:) + integer(c_int), intent(in) :: shape(2) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 8 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_real64_r3(this, array, shape) + class(pluto_allocator) :: this + real(c_double), pointer, intent(out) :: array(:,:,:) + integer(c_int), intent(in) :: shape(3) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 8 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_allocate_real64_r4(this, array, shape) + class(pluto_allocator) :: this + real(c_double), pointer, intent(out) :: array(:,:,:,:) + integer(c_int), intent(in) :: shape(4) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = product(shape) * 8 + if (bytes > 0) then + call this%memory_resource%allocate(mem, bytes) + call c_f_pointer(mem, array, shape) + else + array => null() + endif +end subroutine + +subroutine pluto_allocator_deallocate_int32_r1(this, array) + class(pluto_allocator) :: this + integer(c_int32_t), pointer, intent(inout) :: array(:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 4 + if (bytes > 0) then + mem = c_loc(array(1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +subroutine pluto_allocator_deallocate_int32_r2(this, array) + class(pluto_allocator) :: this + integer(c_int32_t), pointer, intent(inout) :: array(:,:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 4 + if (bytes > 0) then + mem = c_loc(array(1,1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +subroutine pluto_allocator_deallocate_int32_r3(this, array) + class(pluto_allocator) :: this + integer(c_int32_t), pointer, intent(inout) :: array(:,:,:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 4 + if (bytes > 0) then + mem = c_loc(array(1,1,1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +subroutine pluto_allocator_deallocate_int32_r4(this, array) + class(pluto_allocator) :: this + integer(c_int32_t), pointer, intent(inout) :: array(:,:,:,:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 4 + if (bytes > 0) then + mem = c_loc(array(1,1,1,1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + + +subroutine pluto_allocator_deallocate_int64_r1(this, array) + class(pluto_allocator) :: this + integer(c_int64_t), pointer, intent(inout) :: array(:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 8 + if (bytes > 0) then + mem = c_loc(array(1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +subroutine pluto_allocator_deallocate_int64_r2(this, array) + class(pluto_allocator) :: this + integer(c_int64_t), pointer, intent(inout) :: array(:,:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 8 + if (bytes > 0) then + mem = c_loc(array(1,1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +subroutine pluto_allocator_deallocate_int64_r3(this, array) + class(pluto_allocator) :: this + integer(c_int64_t), pointer, intent(inout) :: array(:,:,:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 8 + if (bytes > 0) then + mem = c_loc(array(1,1,1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +subroutine pluto_allocator_deallocate_int64_r4(this, array) + class(pluto_allocator) :: this + integer(c_int64_t), pointer, intent(inout) :: array(:,:,:,:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 8 + if (bytes > 0) then + mem = c_loc(array(1,1,1,1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +subroutine pluto_allocator_deallocate_real32_r1(this, array) + class(pluto_allocator) :: this + real(c_float), pointer, intent(inout) :: array(:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 4 + if (bytes > 0) then + mem = c_loc(array(1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +subroutine pluto_allocator_deallocate_real32_r2(this, array) + class(pluto_allocator) :: this + real(c_float), pointer, intent(inout) :: array(:,:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 4 + if (bytes > 0) then + mem = c_loc(array(1,1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +subroutine pluto_allocator_deallocate_real32_r3(this, array) + class(pluto_allocator) :: this + real(c_float), pointer, intent(inout) :: array(:,:,:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 4 + if (bytes > 0) then + mem = c_loc(array(1,1,1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +subroutine pluto_allocator_deallocate_real32_r4(this, array) + class(pluto_allocator) :: this + real(c_float), pointer, intent(inout) :: array(:,:,:,:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 4 + if (bytes > 0) then + mem = c_loc(array(1,1,1,1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +subroutine pluto_allocator_deallocate_real64_r1(this, array) + class(pluto_allocator) :: this + real(c_double), pointer, intent(inout) :: array(:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 8 + if (bytes > 0) then + mem = c_loc(array(1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +subroutine pluto_allocator_deallocate_real64_r2(this, array) + class(pluto_allocator) :: this + real(c_double), pointer, intent(inout) :: array(:,:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 8 + if (bytes > 0) then + mem = c_loc(array(1,1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +subroutine pluto_allocator_deallocate_real64_r3(this, array) + class(pluto_allocator) :: this + real(c_double), pointer, intent(inout) :: array(:,:,:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 8 + if (bytes > 0) then + mem = c_loc(array(1,1,1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +subroutine pluto_allocator_deallocate_real64_r4(this, array) + class(pluto_allocator) :: this + real(c_double), pointer, intent(inout) :: array(:,:,:,:) + type(c_ptr) :: mem + integer(c_size_t) :: bytes + bytes = size(array) * 8 + if (bytes > 0) then + mem = c_loc(array(1,1,1,1)) + call this%memory_resource%deallocate(mem, bytes) + endif + array => null() +end subroutine + +function pluto_new_delete_resource() result(memory_resource) + type(pluto_memory_resource) :: memory_resource + memory_resource = pluto_get_registered_resource("pluto::new_delete_resource") +end function + +function pluto_pinned_resource() result(memory_resource) + type(pluto_memory_resource) :: memory_resource + memory_resource = pluto_get_registered_resource("pluto::pinned_resource") +end function + +function pluto_device_resource() result(memory_resource) + type(pluto_memory_resource) :: memory_resource + memory_resource = pluto_get_registered_resource("pluto::device_resource") +end function + +function pluto_managed_resource() result(memory_resource) + type(pluto_memory_resource) :: memory_resource + memory_resource = pluto_get_registered_resource("pluto::managed_resource") +end function + +function pluto_pool_resource() result(memory_resource) + type(pluto_memory_resource) :: memory_resource + memory_resource = pluto_get_registered_resource("pluto::pool_resource") +end function + +function pluto_pinned_pool_resource() result(memory_resource) + type(pluto_memory_resource) :: memory_resource + memory_resource = pluto_get_registered_resource("pluto::pinned_pool_resource") +end function + +function pluto_device_pool_resource() result(memory_resource) + type(pluto_memory_resource) :: memory_resource + memory_resource = pluto_get_registered_resource("pluto::device_pool_resource") +end function + +function pluto_managed_pool_resource() result(memory_resource) + type(pluto_memory_resource) :: memory_resource + memory_resource = pluto_get_registered_resource("pluto::managed_pool_resource") +end function + +end module diff --git a/pluto/src/pluto_f/pluto_module.cc b/pluto/src/pluto_f/pluto_module.cc new file mode 100644 index 000000000..b195cc428 --- /dev/null +++ b/pluto/src/pluto_f/pluto_module.cc @@ -0,0 +1,93 @@ +#include +#include + +#include "pluto/pluto.h" + +extern "C" { +void c_pluto_host_set_default_resource_name(const char* name, int name_size) { + pluto::host::set_default_resource(std::string_view{name, static_cast(name_size)}); +} +void c_pluto_device_set_default_resource_name(const char* name, int name_size) { + pluto::device::set_default_resource(std::string_view{name, static_cast(name_size)}); +} +void c_pluto_host_set_default_resource_ptr(pluto::memory_resource* memory_resource) { + pluto::host::set_default_resource(memory_resource); +} +void c_pluto_device_set_default_resource_ptr(pluto::memory_resource* memory_resource) { + pluto::device::set_default_resource(memory_resource); +} +void c_pluto_scope_push() { + pluto::scope::push(); +} +void c_pluto_scope_pop() { + pluto::scope::pop(); +} +pluto::memory_resource* c_pluto_host_get_default_resource() { + return pluto::host::get_default_resource(); +} +pluto::memory_resource* c_pluto_device_get_default_resource() { + return pluto::device::get_default_resource(); +} +void* c_pluto_memory_resource_allocate(pluto::memory_resource* memory_resource, std::size_t bytes, + std::size_t alignment) { + if (alignment) { + return memory_resource->allocate(bytes, alignment); + } + else { + return memory_resource->allocate(bytes); + } +} +void c_pluto_memory_resource_deallocate(pluto::memory_resource* memory_resource, void* memory, std::size_t bytes, + std::size_t alignment) { + if (alignment) { + memory_resource->deallocate(memory, bytes, alignment); + } + else { + memory_resource->deallocate(memory, bytes); + } +} +std::size_t c_pluto_memory_pool_resource_size(const pluto::memory_resource* memory_resource) { + if (auto* pool = dynamic_cast(memory_resource)) { + return pool->size(); + } + return 0; +} +std::size_t c_pluto_memory_pool_resource_capacity(const pluto::memory_resource* memory_resource) { + if (auto* pool = dynamic_cast(memory_resource)) { + return pool->capacity(); + } + return 0; +} +void c_pluto_memory_pool_resource_release(pluto::memory_resource* memory_resource) { + if (auto* pool = dynamic_cast(memory_resource)) { + return pool->release(); + } +} +void c_pluto_memory_pool_resource_reserve(pluto::memory_resource* memory_resource, std::size_t bytes) { + if (auto* pool = dynamic_cast(memory_resource)) { + return pool->reserve(bytes); + } +} + +pluto::memory_resource* c_pluto_get_registered_resource(const char* name, int name_size) { + return pluto::get_registered_resource(std::string_view{name, static_cast(name_size)}); +} +pluto::memory_resource* c_pluto_new_delete_resource() { + return pluto::new_delete_resource(); +} +pluto::memory_resource* c_pluto_device_resource() { + return pluto::device_resource(); +} +pluto::memory_pool_resource* c_pluto_pool_resource() { + return pluto::pool_resource(); +} +pluto::memory_pool_resource* c_pluto_pinned_pool_resource() { + return pluto::pinned_pool_resource(); +} +pluto::memory_pool_resource* c_pluto_managed_pool_resource() { + return pluto::managed_pool_resource(); +} +pluto::memory_pool_resource* c_pluto_device_pool_resource() { + return pluto::managed_pool_resource(); +} +} diff --git a/pluto/tests/CMakeLists.txt b/pluto/tests/CMakeLists.txt index bc276f875..3f432a593 100644 --- a/pluto/tests/CMakeLists.txt +++ b/pluto/tests/CMakeLists.txt @@ -12,3 +12,10 @@ add_subdirectory(sandbox) ecbuild_add_test( TARGET pluto_test_memory_pool SOURCES pluto_test_memory_pool.cc LIBS pluto ) +if( HAVE_FORTRAN ) + ecbuild_add_test( TARGET pluto_test_fortran_memory_resource SOURCES fortran/test_fortran_memory_resource.F90 LIBS pluto_f ) + ecbuild_add_test( TARGET pluto_test_fortran_allocator SOURCES fortran/test_fortran_allocator.F90 LIBS pluto_f ) + ecbuild_add_test( TARGET pluto_test_fortran_memory_pool_resource SOURCES fortran/test_fortran_memory_pool_resource.F90 LIBS pluto_f ) + ecbuild_add_test( TARGET pluto_test_fortran_scope SOURCES fortran/test_fortran_scope.F90 LIBS pluto_f ) +endif() + diff --git a/pluto/tests/fortran/test_fortran_allocator.F90 b/pluto/tests/fortran/test_fortran_allocator.F90 new file mode 100644 index 000000000..18a0b51a1 --- /dev/null +++ b/pluto/tests/fortran/test_fortran_allocator.F90 @@ -0,0 +1,37 @@ +program pluto_test_fortran_allocator + +use pluto_module, only : pluto, pluto_allocator +use, intrinsic :: iso_c_binding, only : c_float + +implicit none + +call run_allocate( pluto%host%make_allocator() ) +call pluto%host%set_default_resource("pluto::pinned_resource") +call run_allocate(pluto%host%make_allocator()) +call run_allocate(pluto%make_allocator(pluto%managed_resource())) +call run_allocate(pluto%make_allocator("pluto::managed_resource")) +call run_allocate(pluto%make_allocator("pluto::managed_resource")) +call pluto%host%set_default_resource("pluto::pinned_resource") + +contains + +subroutine run_allocate(allocator) + implicit none + type(pluto_allocator) :: allocator + integer, parameter :: wp = c_float + real(wp), pointer :: array1d(:), array2d(:,:), array3d(:,:,:), array4d(:,:,:,:) + + call allocator%allocate(array1d, [20]) + call allocator%deallocate(array1d) + + call allocator%allocate(array2d, [5,6]) + call allocator%deallocate(array2d) + + call allocator%allocate(array3d, [5,3,6]) + call allocator%deallocate(array3d) + + call allocator%allocate(array4d, [5,2,3,6]) + call allocator%deallocate(array4d) +end subroutine + +end program diff --git a/pluto/tests/fortran/test_fortran_memory_pool_resource.F90 b/pluto/tests/fortran/test_fortran_memory_pool_resource.F90 new file mode 100644 index 000000000..5f272384e --- /dev/null +++ b/pluto/tests/fortran/test_fortran_memory_pool_resource.F90 @@ -0,0 +1,60 @@ +program pluto_test_fortran_memory_pool_resource + +use pluto_module, only : pluto, pluto_memory_resource, pluto_allocator +use iso_c_binding +implicit none + +write(0,*) "reserve" +call reserve_mem() +write(0,*) "release" +call release_mem() + +write(0,*) "allocate" +call run_allocate() +write(0,*) "release" +call release_mem() +write(0,*) "reserve" +call pluto%reserve(pluto%managed_pool_resource(), int(1024*1024*500,c_size_t)) +write(0,*) "allocate" +call run_allocate() + +! following should be a no-op, as new_delete_resource is not a memory_pool_resource +call pluto%reserve(pluto%new_delete_resource(), int(1024*1024*500,c_size_t)) +call pluto%release(pluto%new_delete_resource()) + +write(0,*) "end" + +contains + +subroutine reserve_mem() + type(pluto_memory_resource) :: memory_resource + memory_resource = pluto%managed_pool_resource() + call memory_resource%reserve(int(1024*1024*8,c_size_t)) + + ! Or one-liner + call pluto%reserve(pluto%managed_pool_resource(), int(1024*1024*257,c_size_t)) +end subroutine + +subroutine release_mem() + type(pluto_memory_resource) :: memory_resource + memory_resource = pluto%managed_pool_resource() + call memory_resource%release() + + ! Or one-liner + call pluto%release(pluto%managed_pool_resource()) +end subroutine + +subroutine run_allocate() + implicit none + integer :: j + integer, parameter :: wp = c_float + real(wp), pointer :: array2d(:,:) + type(pluto_allocator) :: allocator + allocator = pluto%make_allocator(pluto%managed_pool_resource()) + do j=1,100 + call allocator%allocate(array2d, shape=[1000*j, 1000]) + call allocator%deallocate(array2d) + enddo +end subroutine + +end program \ No newline at end of file diff --git a/pluto/tests/fortran/test_fortran_memory_resource.F90 b/pluto/tests/fortran/test_fortran_memory_resource.F90 new file mode 100644 index 000000000..9c54819de --- /dev/null +++ b/pluto/tests/fortran/test_fortran_memory_resource.F90 @@ -0,0 +1,35 @@ + +program pluto_test_fortran_memory_resource + +use pluto_module, only : pluto, pluto_memory_resource +use, intrinsic :: iso_c_binding, only: c_ptr, c_sizeof, c_float, c_f_pointer + +implicit none + +type(pluto_memory_resource) :: mr +call run_allocate(pluto%host%get_default_resource()) +call run_allocate(pluto%new_delete_resource()) +call run_allocate(pluto%managed_resource()) +call run_allocate(pluto%pinned_resource()) +call pluto%host%set_default_resource(pluto%managed_resource()) +call run_allocate(pluto%host%get_default_resource()) +call pluto%host%set_default_resource("pluto::pinned_resource") +call run_allocate(pluto%host%get_default_resource()) + +contains + +subroutine run_allocate(memory_resource) + implicit none + integer, parameter :: wp = c_float + type(pluto_memory_resource) :: memory_resource + type(c_ptr) :: mem + real(wp), pointer :: array1d(:) + real(wp) :: real_value + integer :: N = 10 + call memory_resource%allocate(mem, N*c_sizeof(real_value)) + call c_f_pointer(mem, array1d, [N]) + array1d(:) = 5 + call memory_resource%deallocate(mem, N*c_sizeof(real_value)) +end subroutine + +end program \ No newline at end of file diff --git a/pluto/tests/fortran/test_fortran_scope.F90 b/pluto/tests/fortran/test_fortran_scope.F90 new file mode 100644 index 000000000..01d0f3e58 --- /dev/null +++ b/pluto/tests/fortran/test_fortran_scope.F90 @@ -0,0 +1,50 @@ +program pluto_test_fortran_allocator + +use pluto_module, only : pluto, pluto_allocator +use, intrinsic :: iso_c_binding, only : c_float + +implicit none + +type(pluto_allocator) :: allocator(2) + +call run_allocate(pluto%host%make_allocator(), "program -- default") + +call pluto%scope%push() + call pluto%host%set_default_resource("pluto::pinned_resource") + + allocator(1) = pluto%host%make_allocator() + call run_allocate(pluto%host%make_allocator(), "scope 1 -- pinned") + + call pluto%scope%push() + call pluto%host%set_default_resource("pluto::managed_resource") + + allocator(2) = pluto%host%make_allocator() + call run_allocate(pluto%host%make_allocator(), "scope 2 -- managed") + + call pluto%scope%pop() + + call run_allocate(pluto%host%make_allocator(), "scope 1 -- pinned") + +call pluto%scope%pop() + +call run_allocate(pluto%host%make_allocator(), "program -- default") + +call run_allocate(allocator(1), "allocator(1) -- pinned") +call run_allocate(allocator(2), "allocator(2) -- managed") + +contains + +subroutine run_allocate(allocator, message) + implicit none + type(pluto_allocator) :: allocator + character(len=*) :: message + integer, parameter :: wp = c_float + real(wp), pointer :: array4d(:,:,:,:) + + write(0,*) "run_allocate: ", message + + call allocator%allocate(array4d, [5,2,3,6]) + call allocator%deallocate(array4d) +end subroutine + +end program