- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hi,
I have to port a windows fortran project to linux. The windows version uses CreateFileMapping,OpenFileMapping,MapViewOfFile and CopyMemory.
After some search I found, that linux has something similar with mmap and shm_open. Also I could use memcpy on both platforms.
My problem is that memcpy only works on windows and I always get undefined reference when I try to use shm_open for example. I guess I'm missing some compiler flags and/or using the wrong syntax for the external routines?
Here a little code example:
module test
integer,parameter :: PROT_READ=1
integer,parameter :: PROT_WRITE=2
integer,parameter :: MAP_PRIVATE=2
integer,parameter :: MAP_SHARED=1
integer,parameter :: O_RDONLY=0
integer,parameter :: O_WRONLY=1
integer,parameter :: O_RDWR=2
integer,parameter :: O_ACCMODE=3
integer,parameter :: O_CREAT=512
integer,parameter :: O_EXCL=2048
integer,parameter :: O_TRUNC=1024
integer,parameter :: S_IRUSR=1024
integer,parameter :: S_IWUSR=512
integer,parameter :: S_IXUSR=256
integer,parameter :: S_IRGRP=64
integer,parameter :: S_IWGRP=32
integer,parameter :: S_IXGRP=16
integer,parameter :: S_IROTH=4
integer,parameter :: S_IWOTH=2
integer,parameter :: S_IXOTH=1
integer,parameter :: S_ISUID=16384
integer,parameter :: S_ISGID=8192
interface
subroutine memcpy(dest, src, n) bind(C,name='memcpy')
use iso_c_binding
INTEGER(c_intptr_t), intent(in):: dest
INTEGER(c_intptr_t), intent(in):: src
integer(c_size_t), value :: n
end subroutine memcpy
end interface
interface
INTEGER(c_intptr_t) function mmap(addr,len,prot,flags,fildes,off) bind(c,name='mmap')
use iso_c_binding
integer(c_int), 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 :: off
end function mmap
end interface
interface
integer(c_int) function munmap(addr, len) bind(c,name='munmap')
use iso_c_binding
integer(c_int), value :: addr
integer(c_size_t), value :: len
end function munmap
end interface
interface
integer(c_int) function shm_open(name,oflag,mode) \
bind(c,name='shm_open')
use iso_c_binding
character(kind=c_char) :: name(*)
integer(c_int), value :: oflag
integer(c_int16_t), value :: mode
end function shm_open
end interface
interface
integer(c_int) function shm_unlink(name) bind(c,name='shm_unlink')
use iso_c_binding
character(kind=c_char) :: name(*)
end function shm_unlink
end interface
end module
program FortranTest
use iso_c_binding
use test
implicit none
real*8, allocatable, dimension(:) :: testarr, testarr2
integer :: i, oflag, sflag
oflag = ior(O_RDWR, O_CREAT)
sflag = ior(S_IWUSR, S_IRUSR)
i = shm_open('/home/lbb/FEAP/test/test123.blub', oflag, sflag)
allocate(testarr(10))
allocate(testarr2(10))
do i=1,10
testarr(i) = 1
testarr2(i) = 2
end do
print *, 'testarr'
do i=1,10
print *, testarr(i)
end do
print *, 'testarr2'
do i=1,10
print *, testarr2(i)
end do
print *, 'call memcpy'
call memcpy(loc(testarr(1)), loc(testarr2(1)), 16)
print *, 'testarr'
do i=1,10
print *, testarr(i)
end do
read (*,*)
end program FortranTest
The makefile looks like this:
# fortran compiler = intel fortran fcomp = ifort switch = -module obj -w -f77rtl -fpp -qopenmp -parallel -intconstant -zero -assume:byterecl -check:pointers -check:bounds -check:uninit baseList = test2.for baseObj = $(baseList:.for=.o) all: base test base: $(baseObj) %.o: %.for $(fcomp) $(switch) -c $< -o obj/$(notdir $@) test: base $(fcomp) $(switch) obj/*.o -o obj/test2 -mkl -shared-libgcc -threads -cxxlib clean: @echo "target clean: delete obj/*" rm -f obj/*
If I run this example (without shm_open) on windows I get the expected result:
testarr 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 testarr2 2.00000000000000 2.00000000000000 2.00000000000000 2.00000000000000 2.00000000000000 2.00000000000000 2.00000000000000 2.00000000000000 2.00000000000000 2.00000000000000 call memcpy testarr 2.00000000000000 2.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000
On linux I get :
lbb@dev-01:~/FEAP/test$ obj/test2 testarr 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 testarr2 2.00000000000000 2.00000000000000 2.00000000000000 2.00000000000000 2.00000000000000 2.00000000000000 2.00000000000000 2.00000000000000 2.00000000000000 2.00000000000000 call memcpy testarr 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000 1.00000000000000
So memcpy isn't working as expected (maybe the c function isn't called at all?)
So any hints for me?
Kind regards,
Stephan
Link Copied
4 Replies
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
You need VALUE on the dest and src arguments in the interface to memcpy.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thank you Steve.
In my last attempt I had "INTEGER(c_intptr_t), intent(in), value:: dest"
This worked on windows. After removing the "intent(in)" it works on both. Adding '-lrt' fixes the undefined reference error. I can now create a file with the correct size in /dev/shm. But it always contains zero. I guess I didn't understand how the different pointer types in fortran/c work. Any hints?
My current example:
module test
! O_CREAT | O_RDWR
integer, parameter :: ocreate = 66
! O_RDONLY
integer, parameter :: oread = 0
! PROT_READ | PROT_WRITE
integer, parameter :: preadwrite = 6
! MAP_SHARED
integer, parameter :: mshare = 8
! file permissions 0666
integer, parameter :: fperm = 438
interface
subroutine memcpy(dest, src, n) bind(C,name='memcpy')
use iso_c_binding
INTEGER(c_intptr_t), value:: dest
INTEGER(c_intptr_t), value:: src
integer(c_size_t), value :: n
end subroutine memcpy
end interface
interface
INTEGER(c_intptr_t) function mmap(addr,len,prot, \
flags,fildes,off) bind(c,name='mmap')
use iso_c_binding
integer(c_int), 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 :: off
end function mmap
end interface
interface
integer(c_int) function munmap(addr, len) \
bind(c,name='munmap')
use iso_c_binding
integer(c_int), value :: addr
integer(c_size_t), value :: len
end function munmap
end interface
interface
integer(c_int) function ftruncate(fd, len) \
bind(c,name='ftruncate')
use iso_c_binding
integer(c_int), value :: fd
integer(c_size_t), value :: len
end function ftruncate
end interface
interface
integer(c_int) function close(fd) \
bind(c,name='close')
use iso_c_binding
integer(c_int), value :: fd
end function close
end interface
interface
integer(c_int) function shm_open(name,oflag,mode) \
bind(c,name='shm_open')
use iso_c_binding
character(kind=c_char) :: name(*)
integer(c_int), value :: oflag
integer(c_int16_t), value :: mode
end function shm_open
end interface
interface
integer(c_int) function shm_unlink(name) \
bind(c,name='shm_unlink')
use iso_c_binding
character(kind=c_char) :: name(*)
end function shm_unlink
end interface
end module
program FortranTest
use iso_c_binding
use test
implicit none
real*8, allocatable, dimension(:) :: testarr
INTEGER(c_intptr_t) :: adr
integer :: i, fd
allocate(testarr(10))
do i=1,10
testarr(i) = i
end do
fd = shm_open('test123', ocreate, fperm)
if(fd == -1) stop 'shm_open error'
i = ftruncate(fd, 80)
if(i == -1) stop 'ftruncate error'
adr = mmap(0, 80, preadwrite, mshare, fd, 0)
print *, 'call first memcpy'
call memcpy(loc(adr), loc(testarr), 80)
i = munmap(adr, 80)
if(i == -1) stop 'munmap error'
i = close(fd)
if(i == -1) stop 'close error'
! i = shm_unlink('test123')
! if(i == -1) stop 'shm_unlink error'
end program FortranTest
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I can make only a general comment here. You declare the dest and src arguments to memcpy as address-sized integers, not pointers in the Fortran sense. memcpy wants to see the address of the dest and src by value in the argument list, so that's why you need VALUE as otherwise Fortran would pass the integer (that contains an address) itself by reference (address of an address). INTENT would have absolutely no effect on how it was passed.
I suggest stepping through the code in the debugger and make sure that all the arguments have the correct values as you go. However, I do see something that raises a red flag - you declare the "addr" argument to mmap and munmap as integer(c_int). This is absolutely wrong - use integer(c_intptr_t) instead. On Linux you are almost certainly on a 64-bit system and using an int for the address will result in errors.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thank you. I got it now. For anyone who might need the same here the working code:
module test
! O_CREAT | O_RDWR
integer, parameter :: ocreate = 66
! O_RDONLY
integer, parameter :: oread = 0
! PROT_READ | PROT_WRITE
integer, parameter :: preadwrite = 3
! PROT_READ
integer, parameter :: pread = 1
! MAP_SHARED
integer, parameter :: mshare = 1
! S_IRUSR | S_IWUSR
integer, parameter :: fperm = 384
interface
subroutine memcpy(dest, src, n) bind(C,name='memcpy')
use iso_c_binding
INTEGER(c_intptr_t), value:: dest
INTEGER(c_intptr_t), value:: src
integer(c_size_t), value :: n
end subroutine memcpy
end interface
interface
INTEGER(c_intptr_t) function mmap(addr,len,prot, \
flags,fildes,off) result(result) bind(c,name='mmap')
use iso_c_binding
INTEGER(c_intptr_t), 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 :: off
end function mmap
end interface
interface
integer(c_int) function munmap(addr, len) \
bind(c,name='munmap')
use iso_c_binding
INTEGER(c_intptr_t), value :: addr
integer(c_size_t), value :: len
end function munmap
end interface
interface
integer(c_int) function ftruncate(fd, len) \
bind(c,name='ftruncate')
use iso_c_binding
integer(c_int), value :: fd
integer(c_size_t), value :: len
end function ftruncate
end interface
interface
integer(c_int) function close(fd) \
bind(c,name='close')
use iso_c_binding
integer(c_int), value :: fd
end function close
end interface
interface
integer(c_int) function shm_open(name,oflag,mode) \
bind(c,name='shm_open')
use iso_c_binding
character(kind=c_char) :: name(*)
integer(c_int), value :: oflag
integer(c_int16_t), value :: mode
end function shm_open
end interface
interface
integer(c_int) function shm_unlink(name) \
bind(c,name='shm_unlink')
use iso_c_binding
character(kind=c_char) :: name(*)
end function shm_unlink
end interface
end module
program FortranTest
use iso_c_binding
use test
use ifport
implicit none
real*8, allocatable, dimension(:) :: testarr, testarr2
INTEGER(c_intptr_t) :: adr
integer :: i, fd, err
allocate(testarr(10))
allocate(testarr2(10))
do i=1,10
testarr(i) = i
end do
fd = shm_open('test123', ocreate, fperm)
if(fd == -1) stop 'shm_open error'
i = ftruncate(fd, 80)
if(i == -1) then
err = GetLastError()
print *, err
stop 'ftruncate error'
end if
adr = mmap(loc(0), 80, preadwrite, mshare, fd, 0)
if(adr == -1) then
err = GetLastError()
print *, err
stop 'mmap error'
endif
print *,'adress:',loc(adr)
print *,'adress:',adr
print *, 'call first memcpy'
call memcpy(adr, loc(testarr), 80)
i = munmap(adr, 80)
if(i == -1) stop 'munmap error'
i = close(fd)
if(i == -1) stop 'close error'
fd = shm_open('test123', oread, fperm)
if(fd == -1) stop 'shm_open error'
adr = mmap(loc(0), 80, pread, mshare, fd, 0)
if(adr == -1) then
err = GetLastError()
print *, err
stop 'mmap error'
endif
print *, 'call second memcpy'
call memcpy(loc(testarr2), adr, 80)
i = munmap(adr, 80)
if(i == -1) stop 'munmap error'
i = close(fd)
if(i == -1) stop 'close error'
i = shm_unlink('test123')
if(i == -1) stop 'shm_unlink error'
do i=1,10
print *, testarr2(i)
end do
end program FortranTest
Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page