Skip to content

Instantly share code, notes, and snippets.

@ivan-pi
Last active Jan 16, 2023
Embed
What would you like to do?
Virtual memory array in Fortran based on POSIX system headers
! test_mmap.f90
!
! compile with:
! gfortran -Wall -O2 -o test_mmap test_mmap.f90
!
! inspired by the work:
! Rojc, B., & Depolli, M. (2021). A Resizable C++ Container using Virtual Memory. In ICSOFT (pp. 481-488).
! https://www.scitepress.org/Papers/2021/105571/105571.pdf
!
! so far I've only tested this on MacOS
! may still contain errors
!
! for clarity it's probably best to prefix arrays with `mm_` to note they are memory-mapped
! and should be freed by a different sub-program than usual
!
module mmap_array
use, intrinsic :: iso_c_binding
implicit none
private
public :: get_mmap_array, destroy_mmap_array
integer(c_int), parameter :: PROT_NONE = int(z'00',c_int)
integer(c_int), parameter :: PROT_READ = int(z'01',c_int)
integer(c_int), parameter :: PROT_WRITE = int(z'02',c_int)
integer(c_int), parameter :: PROT_EXEC = int(z'04',c_int)
integer(c_int), parameter :: MAP_SHARED = int(z'0001',c_int)
integer(c_int), parameter :: MAP_PRIVATE = int(z'0002',c_int)
integer(c_int), parameter :: MAP_FIXED = int(z'0010',c_int)
!> MAP_ANON on Darwin
integer(c_int), parameter :: MAP_ANONYMOUS = int(z'1000',c_int)
interface
!> Map files or devices into memmory
type(c_ptr) function c_mmap(addr,len,prot,flags,fildes,offset) bind(c,name="mmap")
import c_ptr, c_size_t, c_int
type(c_ptr), value :: addr
integer(c_size_t), value :: len
integer(c_int), value :: prot
integer(c_int), value :: flags
integer(c_int), value :: fildes
integer(c_size_t), value :: offset
end function
!> Control the protection of pages
integer(c_int) function c_mprotect(addr,len,prot) bind(c,name="mprotect")
import c_ptr, c_size_t, c_int
type(c_ptr), value :: addr
integer(c_size_t), value :: len
integer(c_int), value :: prot
end function
!> Remove a mapping
integer(c_int) function c_munmap(addr,len) bind(c,name="munmap")
import c_ptr, c_size_t, c_int
type(c_ptr), value :: addr
integer(c_size_t), value :: len
end function
end interface
contains
subroutine get_mmap_array(array_ptr, max_elements, stat)
integer, intent(in) :: max_elements
real(c_double), pointer, intent(out) :: array_ptr(:)
integer, intent(out) :: stat
type(c_ptr) :: raw_ptr
integer(c_int64_t), parameter :: block_size = 1048576
integer(c_int64_t) :: remaining
type(c_ptr) :: head
integer(c_ptrdiff_t) :: ihead
integer(c_int) :: ret
stat = 0
raw_ptr = c_mmap(c_null_ptr,max_elements*c_sizeof(1.0_c_double), &
PROT_NONE, ior(MAP_PRIVATE,MAP_ANONYMOUS), &
-1_c_int, 0_c_size_t)
if (transfer(raw_ptr,1.0_c_double) == -1.0_c_double) then
stat = -1
return
end if
remaining = c_sizeof(1.0_c_double)*max_elements
ihead = transfer(raw_ptr,ihead)
do while (remaining > 0)
head = transfer(ihead, head)
ret = c_mprotect(head, min(block_size,remaining), &
ior(PROT_READ,PROT_WRITE))
if (ret /= 0) then
stat = -2
return
end if
ihead = ihead + block_size
remaining = remaining - block_size
end do
call c_f_pointer(raw_ptr,array_ptr,[max_elements])
end subroutine
subroutine destroy_mmap_array(array,stat)
real(c_double), intent(inout), pointer :: array(:)
integer, intent(out) :: stat
stat = c_munmap(c_loc(array), size(array)*c_sizeof(1.0_c_double))
nullify(array)
end subroutine
end module
program test_mmap
use, intrinsic :: iso_c_binding, only: dp => c_double
use mmap_array
implicit none
real(dp), pointer, contiguous :: a(:) => null()
integer :: stat
print *, "associated: ", associated(a)
call get_mmap_array(a,10000000,stat)
print *, "status flag = ", stat
print *, "associated: ", associated(a)
a(1) = 3
a(2) = 6
a(3) = 18
print *, a(1:5)
! array a has pointer attribute meaning we are in charge of destruction
! Since it was created via mmap we must also use the routines from the
! mman system header to unmap it.
call destroy_mmap_array(a,stat)
if (stat /= 0) then
print *, "something went wrong"
stop 1
end if
end program
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment