mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-23 04:43:50 +01:00
Forgot files
This commit is contained in:
parent
ff391db161
commit
27571fc087
72
src/Utils/fortran_mmap.c
Normal file
72
src/Utils/fortran_mmap.c
Normal file
@ -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);
|
||||
}
|
69
src/Utils/mmap.f90
Normal file
69
src/Utils/mmap.f90
Normal file
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user