Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.

64 bit C to FORTRAN character interface issue.

e013805
Beginner
1,429 Views

I have a program which has a C routine calling a FORTRAN routine with
a string argument.

The C routine looks like this:

    INTEGER str_len = 128;
    CHARACTER qc_soln_name[128];

    .  .  .  .
    .  .  .  .

    get_slc_status_item( &k_case, &k_soln, &k_converged,
                             qc_soln_name, str_len);

    .  .  .  .
    .  .  .  .

The called FORTRAN routine looks like this:

      SUBROUTINE GET_SLC_STATUS_ITEM( K_CASE       ,
     +                                K_SOLN       ,
     +                                K_CONVERGED  ,
     +                                QC_SOLN_NAME )

      CHARACTER  QC_SOLN_NAME * 31
      CHARACTER  QC_END       *  1

      QC_END       = CHAR( 0 )
      QC_SOLN_NAME = QC_END

    .  .  .  .
    .  .  .  .


When the C is compiled 32 bit and the FORTRAN is compiled 32 bit,
there is no problem.

When the C is compiled 64 bit and the FORTRAN is compiled 64 bit,
execution stops at the QC_SOLN_NAME assignment with the error message:

forrtl: severe (400): fort: (19) Dummy character variable
'QC_SOLN_NAME' has length 31 which is greater then actual variable
length -3689348818177884032

This is using the Intel FORTRAN 11.1.072 compiler.

Any ideas what the problem is and how to fix it?

Thanks for any help.

0 Kudos
22 Replies
TimP
Honored Contributor III
1,226 Views

As your version of ifort has full support for f2003 iso_c_binding, you might consider adopting that so as to avoid non-portable aspects of hidden character length arguments.  It may be difficult to remember or look up which compiler versions use int64_t for hidden lengths in 64-bit mode, and when you can get away with a mis-match in little-endian mode.

We'd have to guess what you may be doing with macros on the C side, but it looks like you're taking chances with inconsistent length declarations between C and Fortran, which may or may not raise run-time errors.

0 Kudos
e013805
Beginner
1,226 Views

Sadly, I don't think this is a viable solution for me.  The program is HUGE, not all written by me (especially the C code about which I know little).  The people who wrote that are either gone now or retired.

There are roughly 200 FORTRAN to C interface routines that would need to be changed.  And then all of the calls to them from C, I assume a minimum of another 200.  Quite a daunting task I'm afraid.

What I really do not understand is the difference between the Win32 which works fine and the x64 which falls on its face.  I feel there may be a compiler solution that would be much preferable to making many hundreds of source code changes.

0 Kudos
Steven_L_Intel1
Employee
1,226 Views

On x64, Intel Fortran expects 64-bit character lengths. Naive C code passes 32-bit int values for lengths. I assume your INTEGER is a macro or typedef for "int". If you want the easy fix, make this translate to size_t instead.

0 Kudos
mecej4
Honored Contributor III
1,226 Views

Here are some clues to what may be happening (you did not provide a complete example, so it is not possible to be more specific).

The string length is expected to be passed as a hidden argument to the Fortran subroutine, at the end of the other arguments. That length is a 4-byte integer in the 32-bit case, 8-bytes in the 64-bit case. If you specify the type of the hidden length argument as size_t, you can cover both cases. If you pass, in error, a 4-byte length when an 8-byte length expected, errors will occur. The number in the error, -3689348818177884032, expressed in hexadecimal, can be revealing: it is a paste up of a 4-byte length plus 4-bytes in the adjacent memory locations. In other words, 4 bytes were passed and 8 bytes are being extracted.

The following is just for illustration.

subroutine get_slc_status_item(k_case,k_soln,k_converged,qc_soln_name)
implicit none
integer k_case,k_soln,k_converged
character(len=*) qc_soln_name
!
k_case=len(qc_soln_name)
k_soln=2001
k_converged=0
qc_soln_name='aaabbbcccdddxyzptlk'C
return
end subroutine

The C-program to call the above subroutine:

#include <stdio.h>
extern void GET_SLC_STATUS_ITEM(int *,int *,int *,char *,size_t);

main(){
int k_case,k_soln,k_converged;
char qc_soln_name[128];

GET_SLC_STATUS_ITEM(&k_case,&k_soln,&k_converged,qc_soln_name,(size_t)128);
printf("%d\n",k_case);
puts(qc_soln_name);
}

 

0 Kudos
e013805
Beginner
1,226 Views

elsewhere in my program I discovered a C routine like this:
    int     str_len = 32 ;
    char    qc_case_name[32];
    int     k_error_code;

    .  .  .  .
    .  .  .  .
    .  .  .  .

     get_case_name ( &ktr, &k_case, qc_case_name, str_len );

    .  .  .  .
    .  .  .  .
    .  .  .  .

The called FORTRAN routine looks like this:

      SUBROUTINE GET_CASE_NAME( KTR          ,
     +                          K_CASE       ,
     +                          QC_CASE_NAME )

      CHARACTER  QC_CASE_NAME * 32
      CHARACTER  QC_END       *  1

      QC_END = CHAR( 0 )

    .  .  .  .
    .  .  .  .
    .  .  .  .

      QC_CASE_NAME = QC_END

and this x64 code executes just fine and is essentially the same as
the earlier example that does not work, except for the mismatch in string lengths.

You are correct that INTEGER is defined like this:

typedef         int             INTEGER;

So you propose that I change its definition to this:


typedef         size_t             INTEGER;

And that will work??

 

typedef         size_t             INTEGER;

0 Kudos
e013805
Beginner
1,226 Views

And that "fix" would work in both 32 bit and 64 bit modes?

0 Kudos
mecej4
Honored Contributor III
1,226 Views

The example code that I displayed in #5 works in both 32 and 64 bits, when I used the Parallel Studio compilers. If you use other compilers, the C compiler's notion of size_t must agree with the string-length argument of the Fortran compiler. The Fortran standard cannot force the C compiler to work with it, but you can use the test code of #5 to ascertain for yourself.

0 Kudos
FortranFan
Honored Contributor II
1,226 Views

e013805 wrote:

.. So you propose that I change its definition to this:

typedef         size_t             INTEGER;

And that will work??

You should check your C code for all the places the macro INTEGER is used; it's possibly used where a C int is expected in which case the above change can cause issues.

You may want to follow mecej4's example is Message #5 and look at the function prototype for Fortran procedures on the C side and change the type of the "hidden" length (i.e., the last parameter in that message) to size_t and use a cast of (size_t) as shown in the example.

Your latest post suggests you have an additional Fortran function with a different string length and it's possible you have other such functions; in that case you may want to make use of the enumerator facility in C to define all the string lengths in one place and use them consistently everywhere in your C code as 'good coding practice' to minimize errors.

0 Kudos
e013805
Beginner
1,226 Views

Steve,

You said that x64 Intel Fortran is expecting 64 bit character lengths.  My Fortran is compiled with the Default Integer KIND of 4 and the Default Real KIND of 8,  The C compiler apparently has no switch for changing default integer and real sizes.  The C prototypes for my Fortran subroutines look like this:

void get_slc_status_item( INTEGER   *K_CASE       ,
                                         INTEGER   *K_SOLN       ,
                                         INTEGER   *K_CONVERGED  ,
                                        CHARACTER *QC_SOLN_NAME ,
                                        INTEGER    KC_SOLN_NAME);

They all use the "INTEGER" macro which is defined as just "int", which is 4 bytes.  Apparently when my Fortran is compiled Win32, the hidden arguments are 4 bytes and when my Fortran is compiled x64 the hidden arguments are 8 bytes,.but the C is still sending 4 byte integers.  With all of the optional compilation inputs for Intel Fortran, is there not one which allows me to change the x64 hidden arguments back to 4 bytes?? 

Not being much of a C programmer I am loathe to jump in to the C code (written by others than myself who are no longer around) and making massive changes to it.

Or is it possible to just get rid of the hidden argument on the C side and have Fortran look for the null terminator?  A less desirable solution from my perspective.
 

0 Kudos
Steven_L_Intel1
Employee
1,226 Views

Default integer has no effect on character lengths. Note that the mechanism by which a particular Fortran compiler passes character values is implementation and platform-dependent.

You can tell Fortran to not expect a length. You can't have it automatically look for nul-termination. The F2003 standard approach is to declare the Fortran routine with BIND(C) and have the dummy argument to be an array of single characters. When calling from Fortran to C this is pretty simple (since Fortran allows a character value of any length to be passed to a character array with BIND(C), but the C to Fortran direction is more of a pain.

Fortran 2015 provides the "C descriptor" that allows a more natural interface for character values, but it is then some work on the C side to put the length into the descriptor. There's still no nul-termination support in the standard.

My recommendation is to use the C interoperability features in the standard and not rely on implementation-dependent methods.

0 Kudos
JVanB
Valued Contributor II
1,226 Views

Passing character lengths explicitly from C is a problem and to solve it from the Fortran side you would need to change all the procedures invoked by C and also all the Fortran procedure that call them. To change it from the C side you need a macro that sets the type of the hidden LEN parameter (size_t doesn't cut it) and there doesn't seem to be a CFI_type_len in ISO_Fortran_binding.h. The following code tries to paas a hidden 64-bit length:

module M
   use ISO_FORTRAN_ENV, only: INT64
   contains
      subroutine S(x)
         character(*) x(:)
         write(*,'(*(g0))') 'len(x) = ',len(x,kind=INT64)
      end subroutine S
end module M

program P
   use M
   implicit none
   integer(INT64) i
   i = 10000000000_INT64
   BLOCK
      character(len=i) x(0)
      call S(x)
   END BLOCK
end program P

It prints out 10000000000 on ifort 64 bits but 1410065408 on ifort 32 bits or gfortran 5.3 64 bits. Steve could probably turn to his left to ask whether it works on the latest gfortran.

0 Kudos
Steven_L_Intel1
Employee
1,226 Views

size_t is what we recommend for this purpose. But it is better to not rely on implementation-dependent features.

0 Kudos
FortranFan
Honored Contributor II
1,226 Views

Repeat Offender wrote:

.. To change it from the C side you need a macro that sets the type of the hidden LEN parameter (size_t doesn't cut it) and ..

The above comment does not make sense.  From what I understand, size_t in C is an unsigned integer of a certain minimum size to represent the size of objects.  And Microsoft documentation indicates size_t is an unsigned __int64 or unsigned integer, depending on the target platform.  So I'm not sure why size_t won't "cut it" - it seems the most natural, standard way to represent the hidden length parameter.

module m

   use, intrinsic :: iso_c_binding, only : c_size_t
   use, intrinsic :: iso_fortran_env, only : output_unit

   implicit none

   character(len=*), parameter :: msg = "Hello World!"
   character(len=*), parameter :: fmt_gen = "(*(g0))"
   character(len=*), parameter :: fmt_hex = "(g0,z0)"

contains

   subroutine F_sub( s )
   !DIR$ATTRIBUTES REFERENCE, ALIAS:'F_sub' :: F_sub
   !DIR$ATTRIBUTES REFERENCE :: s

      character(len=*), intent(inout) :: s

      write( output_unit, fmt=fmt_gen ) "F_sub: len(s) in decimal = ", len(s, kind=c_size_t)
      write( output_unit, fmt=fmt_hex ) "       len(s) in hex     = ", len(s, kind=c_size_t)

      s = msg // char(0)

      return

   end subroutine F_sub

end module m
#include <inttypes.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>

extern void F_sub(char *, size_t);

static const size_t MAXSIZE = (size_t)-1;

int main()
{

   char* s;
   size_t lens;

   printf("main: MAXSIZE in decimal = %" PRIu64 "\n", MAXSIZE);
   printf("      MAXSIZE in hex     = %" PRIx64 "\n", MAXSIZE);

   lens = (size_t)10000000000;
   printf("main: lens in decimal = %" PRIu64 "\n", lens);
   printf("      lens in hex     = %" PRIx64 "\n", lens);
   s = (char *)malloc(sizeof(char *) * lens);

   if (s == NULL) return(1);
   memset(s, ' ', lens);

   F_sub(s, lens);
   printf("main: s = %s\n", s);

   return(0);
}

Upon execution of the x64 target on a system with sufficient memory,

S:\>p64
main: MAXSIZE in decimal = 18446744073709551615
      MAXSIZE in hex     = ffffffffffffffff
main: lens in decimal = 10000000000
      lens in hex     = 2540be400
F_sub: len(s) in decimal = 10000000000
       len(s) in hex     = 2540BE400
main: s = Hello World!

S:\>

 

0 Kudos
mecej4
Honored Contributor III
1,226 Views

My guess is that R/O's point is that although Intel's implementation may have chosen size_t as the type for Fortran string length parameters, other compilers may use a different type (Gfortran for example, as he mentions).

I doubt if the C standard committee has any plans to define Fortran compatibility for C, one item of that being, let us say, "size_fsl" for Fortran string length for a companion Fortran processor! Perhaps a header file could be provided with a typedef for Fortran string length? What do C programmers think about all this?

0 Kudos
FortranFan
Honored Contributor II
1,226 Views

mecej4 wrote:

My guess is that R/O's point is that although Intel's implementation may have chosen size_t as the type for Fortran string length parameters, other compilers may use a different type (Gfortran for example, as he mentions).

I doubt if the C standard committee has any plans to define Fortran compatibility for C, one item of that being, let us say, "size_fsl" for Fortran string length for a companion Fortran processor! Perhaps a header file could be provided with a typedef for Fortran string length? What do C programmers think about all this?

Well, Steve et al. have already advised OP to use standard features for interoperability, especially if portability is desired.

The 'hidden' character length issue only appears relevant to OP because of the specific use with Intel Fortran toward 32-bit and 64-bit targets, so not sure how compatibility across different compilers comes into play.  Oh.. whatever..

0 Kudos
e013805
Beginner
1,226 Views

Steve, Not sure I am understanding.  I changed my C function prototype to this:

void get_slc_status_item( INTEGER   *K_CASE       ,
                                         INTEGER   *K_SOLN       ,
                                         INTEGER   *K_CONVERGED  ,
                                        CHARACTER *QC_SOLN_NAME ,
                                        long             KC_SOLN_NAME);

and now my C routine looks like this:

a string argument.

The C routine looks like this:

    long                 str_len = 128;
    CHARACTER qc_soln_name[128];

    .  .  .  .
    .  .  .  .

    get_slc_status_item( &k_case, &k_soln, &k_converged,
                             qc_soln_name, str_len);

And still have the same problem.  (I'm not really all that concerned about portability at this time)  Based on your comment that the Intel Fortran is expecting 64 bit character lengths, I rather expected this to work, shouldn't it have worked??

0 Kudos
e013805
Beginner
1,226 Views

Making the prototype long long and the specification for str_len long long seems to make the Fortran happy, or at least happier.

0 Kudos
Steven_L_Intel1
Employee
1,226 Views

long is still 32-bit. Why didn't you use size_t as I recommended? long long won't work on 32-bit - this is exactly what size_t is for. 

Of course, I also recommended using the standard's features for C interoperability rather than depending on implementation-dependent hidden arguments.

0 Kudos
e013805
Beginner
1,226 Views

Using long long was just an experiment.  Apparently FortranFan was correct in his assumption that INTEGER might be used in a location where a C int was required, as when I tried doing this:

typedef         size_t             INTEGER;

the program dies in the debugger with an error whose source is not clear to me.  It might be this call:

k_x_def_vec = calloc(k_x_num_ctr_pts, sizeof(INTEGER));

where INTEGER is now size_t

0 Kudos
Steven_L_Intel1
Employee
965 Views

Ok. Then either use size_t directly or create a new CHARACTER_LEN macro or typedef that resolves to size_t, keeping in mind that other Fortran compilers might do something different.

0 Kudos
Reply