Forgot files

src/Utils/fortran_mmap.c

@@ -0,0 +1,72 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <sys/mman.h>
+
+
+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);
+}

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
+
+