I was looking to get this - Page 2

andrew_4619 · ‎08-27-2014

After the install some code I has gave a number of build errors most of which are now resolved but there are a few things I really do not understand. Consider the source below which is a simple pared down to the bare bones example...

program Console4
    use OpenGL_GLU
    implicit none
    real(8)    :: rad=1.0_8
    real(8)    :: fred=0.0_8
    integer(4) :: slices=16
    integer(4) :: loops=2 
    integer(4) :: quad=1234  
    call gludisk(quad, fred, rad, slices, loops) 
end program Console4


!DEC$ objcomment lib:"glu32.lib"
MODULE OpenGL_GLU
    PUBLIC :: gluDisk
    INTERFACE
        SUBROUTINE gluDisk(quad, inner, outer, slices, loops)                         
            !DEC$ ATTRIBUTES STDCALL, REFERENCE, DECORATE, ALIAS:"gluDisk" :: gluDisk
            IMPORT
            INTEGER(4) :: slices
            INTEGER(4) :: loops
            REAL(8)    :: inner
            REAL(8)    :: outer
            integer(4) :: quad
        END SUBROUTINE gluDisk
    END INTERFACE
END MODULE OpenGL_GLU

The above are two separate source files for a x32 build (I will post the build log to the thread). I get the error:

Console4.obj : error LNK2019: unresolved external symbol _gluDisk@20 referenced in function _MAIN__

I set the link to verbose to check that glu32.lib was actually searched and where the lib used resided. If I do a dumpbin of that LIB the symbol is _gluDisk@28 which is what I would expect as we have 2*8 + 3*4 = 28bytes on the call. Where are things going wrong????

andrew_4619 · ‎08-29-2014

with ifort 15>>>

1>------ Build started: Project: Console4, Configuration: Debug Win32 ------
1>Compiling with Intel(R) Visual Fortran Compiler XE 15.0.0.108 [IA-32]...
1>Console4.f90
1>C:\Users\...Console4\Console4.f90(53): error #5508: Declaration of routine 'GLUDISK28' conflicts with a previous declaration
1>compilation aborted for C:\Users\,,,\Console4\Console4.f90 (code 1)

I guess the conflict is with a decorated name, not quite getting that.

Steven_L_Intel1 · ‎08-29-2014

Hmm - I see what RO wants to do.One can do this with ALIAS, maybe not with BIND(C), given that both gludisk20 and gludisk28 have the same binding label (which does not include decoration), and the standard disallows that.

JVanB · ‎08-29-2014

Quite frustrating bug in the standard. The same binding label doesn't imply the same externally visible name. gfortran complained as well. The workaround is to change the binding name of gluDisk5 and gluDisk20 to 'gluDiskA', or separate compilation so the compiler can't see them both at once. Also add the line

iptr = 500

at the end of subroutine gluDisk20.

Steven_L_Intel1 · ‎08-29-2014

I don't agree that this is a bug in the standard in that you can't run into this problem until you step outside the standard. It will be moot soon anyway as 32-bit development tapers off. I'm seeing more and more applications require x64, which doesn't have STDCALL as a calling convention.

So if you want to play STDCALL naming games like this, you can't use BIND(C).

andrew_4619 · ‎08-31-2014

I was looking to get this clear in my mind so I had a look at the documents. Release_Notes_F_2015_W_EN.pdf says:

3.2.4.1 ATTRIBUTES STDCALL now allowed with BIND(C)
As of compiler version 15.0, the ATTRIBUTES STDCALL directive may be specified for an
interoperable procedure (a procedure whose declaration includes the BIND(C) language binding
attribute.) This combination has the following effects for Windows* applications targeting IA-32
architecture:
 The calling mechanism is changed to STDCALL, which affects how the stack is cleaned
up on procedure exit
 The external name from the BIND attribute is suffixed with “@n”, where n is the number
of bytes to be removed from the stack on return.
No other effects from STDCALL, such as pass-by-value, are provided. The Fortran standard
VALUE attribute (not ATTRIBUTES VALUE) may be used if desired. For all other platforms,
specifying STDCALL with BIND(C) has no effect.

and the help says:

The BIND attribute is similar to directive !DIR$ ATTRIBUTES C as follows:

The compiler applies the same naming rules, that is, names are lowercase (unless NAME= specifies otherwise).

The compiler applies the appropriate platform decoration, such as a leading underscore.

However, procedure argument passing differs. When BIND is specified, procedure arguments are passed by reference unless the VALUE attribute is also specified.

So why to I get the error:

error #8039: The INTENT(OUT) or INTENT(INOUT) attribute is not allowed for arguments received by value. [PARAMS]

For the code:

SUBROUTINE glGetPointerv(pname, params) BIND(C,NAME="glGetPointerv")
    !DEC$ ATTRIBUTES STDCALL  :: glGetPointerv
    IMPORT
    INTEGER(GLenum), VALUE :: pname
    integer(C_INTPTR_T), INTENT(OUT) :: params 
END SUBROUTINE glGetPointerv

To get that to compile you have to add !DEC$ ATTRIBUTES REFERENCE :: params which should not be so IMO

Steven_L_Intel1 · ‎08-31-2014

That's probably a bug. We'll check it out.

JVanB · ‎09-01-2014

I keep thinking that more comprehensive tests are desirable. What happens if we have a file called 'include.f90':

         type(C_PTR), value :: X
         integer(C_INTPTR_T) I
         integer(C_INTPTR_T), pointer :: V
         I = transfer(X,I)
         if(I == 0) then
            R = 0
         else
            call C_F_POINTER(X,V)
            if(V == 0) then
               R = 1
               V = 1
            else
               R = 2
            end if
         end if
      end subroutine S
end module M

program P
   use M
   implicit none
   integer(C_INTPTR_T) X
   X = 0
   call test(X)
   open(10,file='VALUE.txt',status='OLD',position='APPEND')
   write(10,'(5(a:1x))',advance='no') BINDC,CLASS,GLOBAL,LOCAL,VALUE
   select case(R)
      case(0)
         write(10,'(1x,a)') 'VALUE'
      case(1)
         if(X == 0) then
            write(10,'(1x,a)') 'COPY'
         else if(X == 1) then
            write(10,'(1x,a)') 'REFERENCE'
         else
            write(10,'(1x,a)') 'UNKNOWN'
         end if
      case(2)
         write(10,'(1x,a)') 'UNKNOWN'
   end select
   flush 10
   close(10)
end program P

And a driver program that compiles it for various combinations of attributes, here called 'testall.f90':

program testall
   use ISO_C_BINDING
   implicit none
   integer BINDC,CLASS,GLOBAL,LOCAL,VALUE
   integer EXITSTAT
   open(10,file='VALUE.txt',status='REPLACE')
   write(10,'(6(a:1x))') ' BINDC ',' CLASS ',' GLOBAL',' LOCAL ',' VALUE ','RESULT'
   flush 10
   close(10)
   do BINDC = 1,2
      do CLASS = 1,3
         do GLOBAL = 1,3
            do LOCAL = 1,3
               do VALUE = 1,2
                  open(10,file='test.f90',status='REPLACE')
                  write(10,'(a)') "module M"
                  write(10,'(a)') "   use ISO_C_BINDING"
                  write(10,'(a)') "   implicit none"
                  if(BINDC == 1) then
                     write(10,'(a)') "   character(*), parameter :: BINDC = 'FORTRAN'"
                  else
                     write(10,'(a)') "   character(*), parameter :: BINDC = 'BIND(C)'"
                  end if
                  if(CLASS == 1) then
                     write(10,'(a)') "   character(*), parameter :: CLASS = 'DEFAULT'"
                  else if(CLASS == 2) then
                     write(10,'(a)') "   character(*), parameter :: CLASS = '   C   '"
                  else
                     write(10,'(a)') "   character(*), parameter :: CLASS = 'STDCALL'"
                  end if
                  if(GLOBAL == 1) then
                     write(10,'(a)') "   character(*), parameter :: GLOBAL = 'DEFAULT'"
                  else if(GLOBAL == 2) then
                     write(10,'(a)') "   character(*), parameter :: GLOBAL = '  REF  '"
                  else
                     write(10,'(a)') "   character(*), parameter :: GLOBAL = ' VALUE '"
                  end if
                  if(LOCAL == 1) then
                     write(10,'(a)') "   character(*), parameter :: LOCAL = 'DEFAULT'"
                  else if(LOCAL == 2) then
                     write(10,'(a)') "   character(*), parameter :: LOCAL = '  REF  '"
                  else
                     write(10,'(a)') "   character(*), parameter :: LOCAL = ' VALUE '"
                  end if
                  if(VALUE == 1) then
                     write(10,'(a)') "   character(*), parameter :: VALUE = 'DEFAULT'"
                  else
                     write(10,'(a)') "   character(*), parameter :: VALUE = ' VALUE '"
                  end if
                  write(10,'(a)') "   integer R"
                  write(10,'(a)') "   interface"
                  if(BINDC == 1) then
                     write(10,'(a)') "      subroutine test(X)"
                     write(10,'(a)') "         import"
                     write(10,'(a)') "         implicit none"
                     write(10,'(a)') "!DEC$ATTRIBUTES DECORATE,ALIAS: 's' :: test"
                  else
                     write(10,'(a)') "      subroutine test(X) bind(C,name = 's')"
                     write(10,'(a)') "         import"
                     write(10,'(a)') "         implicit none"
                  end if
                  if(CLASS == 2) then
                     write(10,'(a)') "!DEC$ATTRIBUTES C :: test"
                  else if(CLASS == 3) then
                     write(10,'(a)') "!DEC$ATTRIBUTES STDCALL :: test"
                  end if
                  if(GLOBAL == 2) then
                     write(10,'(a)') "!DEC$ATTRIBUTES REFERENCE :: test"
                  else if(GLOBAL == 3) then
                     write(10,'(a)') "!DEC$ATTRIBUTES VALUE :: test"
                  end if
                  if(LOCAL == 2) then
                     write(10,'(a)') "!DEC$ATTRIBUTES REFERENCE :: X"
                  else if(LOCAL == 3) then
                     write(10,'(a)') "!DEC$ATTRIBUTES VALUE :: X"
                  end if
                  if(VALUE == 1) then
                     write(10,'(a)') "         integer(C_INTPTR_T) :: X"
                  else
                     write(10,'(a)') "         integer(C_INTPTR_T), value :: X"
                  end if
                  write(10,'(a)') "      end subroutine test"
                  write(10,'(a)') "   end interface"
                  write(10,'(a)') "   contains"
                  write(10,'(a)') "      subroutine S(X) bind(C,name = 's')"
                  write(10,'(a)') "         implicit none"
                  if(CLASS == 2) then
                     write(10,'(a)') "!DEC$ATTRIBUTES STDCALL :: S"
                  end if
                  write(10,'(a)') "include 'include.f90'"
                  flush 10
                  close(10)
                  call EXECUTE_COMMAND_LINE('ifort test.f90',EXITSTAT=EXITSTAT)
                  if(EXITSTAT == 0) then
                     call EXECUTE_COMMAND_LINE('test')
                  else
                     open(10,file='VALUE.txt',status='OLD',position='APPEND')
                     if(BINDC == 1) then
                        write(10,'(a)',advance='no') 'FORTRAN'
                     else
                        write(10,'(a)',advance='no') 'BIND(C)'
                     end if
                     if(CLASS == 1) then
                        write(10,'(1x,a)',advance='no') 'DEFAULT'
                     else if(CLASS == 2) then
                        write(10,'(1x,a)',advance='no') '   C   '
                     else
                        write(10,'(1x,a)',advance='no') 'STDCALL'
                     end if
                     if(GLOBAL == 1) then
                        write(10,'(1x,a)',advance='no') 'DEFAULT'
                     else if(GLOBAL == 2) then
                        write(10,'(1x,a)',advance='no') '  REF  '
                     else
                        write(10,'(1x,a)',advance='no') ' VALUE '
                     end if
                     if(LOCAL == 1) then
                        write(10,'(1x,a)',advance='no') 'DEFAULT'
                     else if(LOCAL == 2) then
                        write(10,'(1x,a)',advance='no') '  REF  '
                     else
                        write(10,'(1x,a)',advance='no') ' VALUE '
                     end if
                     if(VALUE == 1) then
                        write(10,'(1x,a)',advance='no') 'DEFAULT'
                     else
                        write(10,'(1x,a)',advance='no') ' VALUE '
                     end if
                     write(10,'(1x,a)') 'COMPILATION FAILED'
                     flush 10
                     close(10)
                  end if
               end do
            end do
         end do
      end do
   end do
end program testall

Now we are hoping that testall.f90 can be compiled and run at the command prompt to yield a VALUE.txt output file. If it works, could you please attach the resulting VALUE.txt?

andrew_4619 · ‎09-03-2014

Steve Lionel (Intel) wrote:

That's probably a bug. We'll check it out.

Did you conclude on this Steve? Since then I have come across this for a number of new api interfaces I had to make and have taken to having the "intent(out)" just added as a comment on the end of the code line as a workaround. I presume it is a problem with the code checking only not the actual object code generation correctness?

Steven_L_Intel1 · ‎09-03-2014

I hadn't gotten to that yet - hope to do so tomorrow. I suspect it's just a wrong check, probably not recognizing the new stdcall+bind(C) combination.

Steven_L_Intel1 · ‎09-04-2014

Escalated as issue DPD200360618. It is just the error check that is wrong.

Problem after XE 15.0.0.108 install