diff --git a/src/Utils/fortran_mmap.c b/src/Utils/fortran_mmap.c new file mode 100644 index 00000000..2748dcba --- /dev/null +++ b/src/Utils/fortran_mmap.c @@ -0,0 +1,72 @@ +#include +#include +#include +#include +#include +#include +#include + + +void* mmap_fortran(char* filename, size_t bytes, int* file_descr, int read_only) +{ + int i; + int fd; + int result; + void* map; + + if (read_only == 1) + { + fd = open(filename, O_RDONLY, (mode_t)0600); + if (fd == -1) { + printf("%s:\n", filename); + perror("Error opening mmap file for reading"); + exit(EXIT_FAILURE); + } + map = mmap(0, bytes, PROT_READ, MAP_SHARED, fd, 0); + } + else + { + fd = open(filename, O_RDWR | O_CREAT, (mode_t)0600); + if (fd == -1) { + printf("%s:\n", filename); + perror("Error opening mmap file for writing"); + exit(EXIT_FAILURE); + } + + result = lseek(fd, bytes, SEEK_SET); + if (result == -1) { + close(fd); + printf("%s:\n", filename); + perror("Error calling lseek() to stretch the file"); + exit(EXIT_FAILURE); + } + + result = write(fd, "", 1); + if (result != 1) { + close(fd); + printf("%s:\n", filename); + perror("Error writing last byte of the file"); + exit(EXIT_FAILURE); + } + + map = mmap(0, bytes, PROT_READ | PROT_WRITE, MAP_SHARED, fd, 0); + } + + if (map == MAP_FAILED) { + close(fd); + printf("%s:\n", filename); + perror("Error mmapping the file"); + exit(EXIT_FAILURE); + } + + *file_descr = fd; + return map; +} + +void munmap_fortran(size_t bytes, int fd, void* map) +{ + if (munmap(map, bytes) == -1) { + perror("Error un-mmapping the file"); + } + close(fd); +} diff --git a/src/Utils/mmap.f90 b/src/Utils/mmap.f90 new file mode 100644 index 00000000..ce33e301 --- /dev/null +++ b/src/Utils/mmap.f90 @@ -0,0 +1,69 @@ +module mmap_module + + use iso_c_binding + + interface + + ! File descriptors + ! ---------------- + + type(c_ptr) function c_mmap_fortran(filename, length, fd, read_only) bind(c,name='mmap_fortran') + use iso_c_binding + character(c_char), intent(in) :: filename(*) + integer(c_size_t), intent(in), value :: length + integer(c_int), intent(out) :: fd + integer(c_int), intent(in), value :: read_only + end function + + subroutine c_munmap(length, fd, map) bind(c,name='munmap_fortran') + use iso_c_binding + integer(c_size_t), intent(in), value :: length + integer(c_int), intent(in), value :: fd + type(c_ptr), intent(in), value :: map + end subroutine + + end interface + + contains + + subroutine mmap(filename, shape, bytes, fd, read_only, map) + use iso_c_binding + implicit none + character*(*), intent(in) :: filename ! Name of the mapped file + integer*8, intent(in) :: shape(:) ! Shape of the array to map + integer, intent(in) :: bytes ! Number of bytes per element + logical, intent(in) :: read_only ! If true, mmap is read-only + integer, intent(out) :: fd ! File descriptor + type(c_ptr), intent(out) :: map ! C Pointer + + integer(c_long) :: length + integer(c_int) :: fd_ + + length = PRODUCT( shape(:) ) * bytes + if (read_only) then + map = c_mmap_fortran( trim(filename)//char(0), length, fd_, 1) + else + map = c_mmap_fortran( trim(filename)//char(0), length, fd_, 0) + endif + fd = fd_ + end subroutine + + subroutine munmap(shape, bytes, fd, map) + use iso_c_binding + implicit none + integer*8, intent(in) :: shape(:) ! Shape of the array to map + integer, intent(in) :: bytes ! Number of bytes per element + integer, intent(in) :: fd ! File descriptor + type(c_ptr), intent(in) :: map ! C pointer + + integer(c_long) :: length + integer(c_int) :: fd_ + + length = PRODUCT( shape(:) ) * bytes + fd_ = fd + call c_munmap( length, fd_, map) + end + +end module mmap_module + +