Re: ASM allowed in Fortran? and OpenDir?

[Tobias Burnus <burnus at net-b dot de>]

RadSurfer wrote:
> I was just curious if there was such a thing as discreet assembly code ever
> being allowed inside a Fortran program...
> Perhpas that seems like a ludicrous question -- but I'll have to wait to see
> what the replies are.
>   
This slowly becomes a frequently ask question:
http://gcc.gnu.org/ml/fortran/2007-07/msg00470.html

> One other question, seriously:
> I did not notice any functions/extensions/etc. which permit the getting of
> directory information which allows to "walk through" files...
> I refer to "opendir" or "findfirst" type of directory-walking functions.
> I realize there are extensions which allow information about _known_ files
> to be returned... but not retreiving files from a directory to be placed
> into a list for processing and that sort of functionality.
>   

In principle the following program should do this; however, I only get
NULL returned by opendir (with gfortran), a compiler error (g95) or an
endless loop (NAG f95). Besides compiler errors, I think I made a
mistake somewhere too.

Tobias


module mod
  use iso_c_binding
  implicit none
  integer(c_int), bind(c,name="errno") :: errno
end module mod

program test
use iso_c_binding
use mod
implicit none
type, bind(C) :: dirent
  integer(c_long)    :: d_ino
  integer(c_long)    :: d_off; ! __off_t, check size
  integer(c_short)   :: d_reclen
  character(len=1,kind=c_char) :: d_name(256)
end type
interface
  function opendir(a) bind(C,name='opendir')
    import
    type(c_ptr)                  :: opendir
    character(len=1,kind=c_char), intent(in) :: a(*)
  end function opendir
  function readdir(dir) bind(C,name='readdir')
    import
    type(c_ptr), intent(in) :: dir
    type(c_ptr)             :: readdir
  end function readdir
end interface
type(c_ptr) :: dir, dc
type(dirent), pointer :: d
errno = 0
dir = opendir(".")
if(.not.c_associated(dir)) then
  print *, 'Error opening "."', errno
else
  do
    dc = readdir (dir)
    if(.not. c_associated(dc)) exit
    call c_f_pointer(dc,d)
    print *, "Result: ", d%d_name
  end do
end if
end program