************************************************** J3/02-230r3 To: J3 From: Aleksandar Donev Reviewed by J3 Interop Subgroup at 162 Date: August 15 2002 Subject: Enhanced C_LOC and C_F_POINTER Reference: Paper J3/02-229r1 ************************************************** Summary ______________________________________ We have modified the specification of C_LOC from ISO_C_BINDING to ensure that association of C pointers with Fortran objects propagates through argument association just as for Fortran pointers, as described in 12.4.1.2. We use a hook to the existing Fortran rules to achieve this important effect. We also propose a modification of the specification of C_LOC to allow nonpolymorphic scalar targets of any (interoperable or not) type as an argument. The modification will significantly enhance C_LOC's functionality by allowing limited (opaque) interoperability of any Fortran object with C. The associated (required) enhancement to C_F_POINTER is also proposed. ______________________________________ Rationale ______________________________________ A Fortran program needs to provide the following data to a C library in an opaque way because that library will call a Fortran routine that uses this data to do something (in this case perform a matrix-vector product): TYPE :: My_Data TYPE(Matrix(KIND=C_DOUBLE,SIZE=:)), POINTER :: A=>NULL() REAL(KIND=C_DOUBLE), DIMENSION(:), ALLOCATABLE :: x, y END TYPE My_Data TYPE(My_Data), TARGET :: Fortran_data Using the proposed extension, this can be done by simply making a C pointer handle to the object Fortran_data: TYPE(C_PTR) :: C_handle C_handle=C_LOC(Fortran_data) ______________________________________ Edits: ______________________________________ The edits in this paper replace the ones in 02-229r1. ___________________ 382:17-25 Replace with: C_LOC(X) Description: Returns the C address of the argument. Class: Inquiry function Argument: X shall (1) be (a) a procedure that is interoperable, or (b) a procedure pointer associated with an interoperable procedure, (2) have interoperable type and type parameters and be (a) a variable that has the TARGET attribute and is interoperable, (b) an allocated allocatable variable that has the TARGET attribute, or (c) an associated scalar pointer, or (3) be a nonpolymorphic scalar and have no nonkind type parameters and be (a) a nonallocatable, nonpointer variable that has the TARGET attribute, (b) an allocated allocatable variable that has the TARGET attribute, or (c) an associated scalar pointer. Result: The result is determined as if a pointer assignment PX => X were made. If X is interoperable or has interoperable type and type parameters, then the result is the value that the C processor returns as the result of applying the unary "&" operator (as defined in the C standard, 6.5.3.2.) to the target of PX. If X is scalar, the result is a value that can be used as an actual CPTR argument in a call to C_F_POINTER where FPTR is scalar and has the same type and type parameters as X. Such a call to C_F_POINTER shall have the effect of the pointer assignment FPTR => PX. NOTE: When the actual argument is of noninteroperable type or type parameters, the result of C_LOC provides an opaque ``handle'' for it. In an actual implementation, this handle may be the C ``base'' address of the argument; However, portable C functions should treat it as a void (generic) C pointer that cannot be dereferenced (6.5.3.2 in the C standard). ___________________ ___________________ 383:14-17 Replace with: C_F_POINTER(CPTR, FPTR [, SHAPE]) Description: Associates a pointer with the target of a C pointer and specifies its shape. Class: Subroutine Arguments: CPTR shall be a scalar of type C_PTR. It is an INTENT(IN) argument. FPTR shall be a pointer. It is an INTENT(OUT) argument. SHAPE (optional) shall be of type integer and rank one. It is an INTENT(IN) argument. If SHAPE is present, its size shall be equal to the rank of FPTR. If FPTR is an array, SHAPE shall be present. The value of CPTR is the C address of an entity that is interoperable with variables of the type and type parameters of FPTR and is not a Fortran variable that does not have the TARGET attribute. FPTR shall have interoperable type and type parameters. It becomes pointer associated with the target of CPTR. If it is an array, its shape is specified by SHAPE, and each lower bound is 1. The value of CPTR is the result of a reference to C_LOC(X) with a scalar argument X of the same type and type parameters as FPTR. That reference to C_LOC behaves as if a pointer assignment PX => X were made. The association status of PX has not changed since the reference to C_LOC. The target of PX shall not have been deallocated or have become undefined due to execution of a RETURN or END statement since the reference to C_LOC. FPTR shall be scalar. It becomes pointer associated with the target of PX. ___________________ ___________________ 471:22+ Add: C.10.2.3 Example of calling C functions with non-interoperable data. Many Fortran processors support 16-byte real numbers, not supported by the C processor. Assume a Fortran programmer wants to use a C procedure from a message passing library for an array of these reals. The C prototype of this procedure is: void ProcessBuffer(void *buffer, int n_bytes); with the corresponding Fortran interface: USE, INTRINSIC :: ISO_C_BINDING INTERFACE SUBROUTINE PROCESS_BUFFER(BUFFER,N_BYTES), BIND(C,NAME="ProcessBuffer") IMPORT :: C_PTR, C_INT TYPE(C_PTR), VALUE :: BUFFER ! The ``C address'' of the array buffer INTEGER(C_INT), VALUE :: N_BYTES ! Number of bytes in buffer END SUBROUTINE PROCESS_BUFFER END INTERFACE This may be done using C_LOC if the particular Fortran processor specifies that C_LOC returns an appropriate address: REAL(R_QUAD), DIMENSION(:), ALLOCATABLE, TARGET :: QUAD_ARRAY ... CALL PROCESS_BUFFER(C_LOC(QUAD_ARRAY), INT(16*SIZE(QUAD_ARRAY),C_INT)) ! One quad real takes 16 bytes on this processor C.10.2.4 Example of opaque communication between C and Fortran. The following example demonstrates how a Fortran processor can make a modern OO random number generator written in Fortran available to a C program: USE, INTRINSIC :: ISO_C_BINDING ! Assume this code is inside a module TYPE, EXTENSIBLE :: RANDOM_STREAM ! A (uniform) random number generator (URNG) CONTAINS PROCEDURE(RANDOM_UNIFORM), PASS(STREAM) :: NEXT=>NULL() ! Generates the next number from the stream END TYPE RANDOM_STREAM ABSTRACT INTERFACE ! Abstract interface of Fortran URNG FUNCTION RANDOM_UNIFORM(STREAM) RESULT(NUMBER) IMPORT :: RANDOM_STREAM, C_DOUBLE CLASS(RANDOM_STREAM), INTENT(INOUT) :: STREAM REAL(C_DOUBLE) :: NUMBER END FUNCTION RANDOM_UNIFORM END INTERFACE A polymorphic object of base type RANDOM_STREAM is not interoperable with C. However, we can make such a random number generator available to C by packaging it inside another nonpolymorphic, nonparameterized derived type: TYPE :: URNG_STATE ! No BIND(C), as this type is not interoperable CLASS(RANDOM_STREAM), ALLOCATABLE :: STREAM END TYPE URNG_STATE The following two procedures will enable a C program to use our Fortran URNG: ! Initialize a uniform random number generator: SUBROUTINE INITIALIZE_URNG(STATE_HANDLE, METHOD), & BIND(C, NAME="InitializeURNG") TYPE(C_PTR), INTENT(OUT) :: STATE_HANDLE ! An opaque handle for the URNG CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: METHOD ! The algorithm to be used TYPE(URNG_STATE), POINTER :: STATE ! An actual URNG object ALLOCATE(STATE) ! There needs to be a corresponding finalization ! procedure to avoid memory leaks, not shown in this example ! Allocate STATE%STREAM with a dynamic type depending on METHOD ... STATE_HANDLE=C_LOC(STATE) ! Obtain an opaque handle to return to C END SUBROUTINE INITIALIZE_URNG ! Generate a random number: FUNCTION GENERATE_UNIFORM(STATE_HANDLE) RESULT(NUMBER), & BIND(C, NAME="GenerateUniform") TYPE(C_PTR), INTENT(IN), VALUE :: STATE_HANDLE ! An opaque handle: Obtained via a call to INITIALIZE_URNG REAL(C_DOUBLE) :: NUMBER TYPE(URNG_STATE), POINTER :: STATE ! A pointer to the actual URNG CALL C_F_POINTER(CPTR=STATE_HANDLE, FPTR=STATE) ! Convert the opaque handle into a usable pointer NUMBER=STATE%STREAM%NEXT() ! Use the type-bound function NEXT to generate NUMBER END FUNCTION GENERATE_UNIFORM ___________________