soccer jersey forums.silverfrost.com :: View topic - Workaround for C_F_POINTER
forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Workaround for C_F_POINTER

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support
View previous topic :: View next topic  
Author Message
jlb



Joined: 21 Oct 2020
Posts: 67

PostPosted: Fri Mar 08, 2024 12:22 pm    Post subject: Workaround for C_F_POINTER Reply with quote

Is there any workaround code for the F2003 intrinsic procedure C_F_POINTER?

I am trying to adapt a DLL interface to FTN95 using the following function calling C_F_POINTER:
Code:
function C_to_F_string(c_string_pointer) result(f_string)
use, intrinsic :: iso_c_binding, only: c_ptr,c_f_pointer,c_char,c_null_char
type(c_ptr), intent(in) :: c_string_pointer
character(len=:), allocatable :: f_string
character(kind=c_char), dimension(:), pointer :: char_array_pointer => null()
character(len=255) :: aux_string
integer :: i,length
call c_f_pointer(c_string_pointer,char_array_pointer,[255])
if (.not.associated(char_array_pointer)) then
  allocate(character(len=4)::f_string); f_string="NULL"; return
end if
aux_string=" "
do i=1,255
  if (char_array_pointer(i)==c_null_char) then
    length=i-1; exit
  end if
  aux_string(i:i)=char_array_pointer(i)
end do
allocate(character(len=length)::f_string)
f_string=aux_string(1:length)
end function C_to_F_string

Courtesy of: https://stackoverflow.com/questions/9972743/creating-a-fortran-interface-to-a-c-function-that-returns-a-char
Back to top
View user's profile Send private message
wahorger



Joined: 13 Oct 2014
Posts: 1225
Location: Morrison, CO, USA

PostPosted: Fri Mar 08, 2024 11:35 pm    Post subject: Reply with quote

Interesting problem.

So this function takes a pointer to a string (null terminated) and transfers this to a FORTRAN compatible CHARACTER*(*).

Do you need it to be fully portable, or can it be compatible with FTN95 alone?
Back to top
View user's profile Send private message Visit poster's website
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 8011
Location: Salford, UK

PostPosted: Sat Mar 09, 2024 8:57 am    Post subject: Reply with quote

I am not able to provide an immediate answer to this question but I will add it to my list of issues to investigate.
Back to top
View user's profile Send private message AIM Address
jlb



Joined: 21 Oct 2020
Posts: 67

PostPosted: Sat Mar 09, 2024 9:47 am    Post subject: Reply with quote

Bill
I "only" need a FTN95 compatible workaround. I encountered two difficulties: the F2003 intrinsic procedure C_F_POINTER and the dynamic allocation of a string length allocate(character(len=length)::f_string).

Paul
Thanks for your help.
Back to top
View user's profile Send private message
wahorger



Joined: 13 Oct 2014
Posts: 1225
Location: Morrison, CO, USA

PostPosted: Sat Mar 09, 2024 4:29 pm    Post subject: Reply with quote

jlb,

Can you give me an example of how this function would be used?

I'll admit to not being 2003 aware of all the changes in syntax, etc. That said, I may have an answer to your query, albeit perhaps not as powerful as the intrinsic might have been.

Bill
Back to top
View user's profile Send private message Visit poster's website
wahorger



Joined: 13 Oct 2014
Posts: 1225
Location: Morrison, CO, USA

PostPosted: Sat Mar 09, 2024 6:12 pm    Post subject: Reply with quote

Here's the code that take a pointer to a "C" style string and returns the characters in a FORTRAN CHARACTER data type.

Note: You have to declare the function in the calling program with a specific length. That said, you could use a similar function to return the length of the string BEFORE calling the routine that declares the function and use that, if it something that really, truly needs to be variable.
Code:
!FTN95 application...
PROGRAM main
  INTEGER k
  character*(255),external:: C_TO_F_STRING ! has to be assigned a specific length here
  character*255:: my_string='This is me'//char(0) ! simulated "C" string, length s/b 10
  character*32:: result
  ! loc(mystring might be the return value of a "C" funtion of the form
  ! char* c_function(variables)
  result = c_to_f_string(loc(my_string))
  print *,'Actual non blank data returned=',len_trim(result),'=',trim(result),' full result=[',result,']'
  k= len(c_to_f_string(loc(my_string)))
  print *,'Function length returned=',k
  pause
END PROGRAM main
character*(*) function C_TO_F_STRING(c_string_pointer)
! no error checking has been performed here (like for a NULL result from the allocate()
integer(7):: c_string_pointer ! this is a pointer to somewhere in memory
character(:) , allocatable:: f_string

integer:: array_index ! this will be used to determine how long the string is before allocation
array_index = 0
do while(ichar(ccore1(c_string_pointer+array_index)) .ne.0)
  array_index = array_index+1
  end do
if(array_index.le.0)array_index = 1 ! always return something
allocate(character*(array_index):: f_string)
f_string = " " ! make the entire string blank, regardless
print *,'Length of result string to be allocated=',len(f_string) ! comment out for production
do i=1,array_index
  f_string(i:i) = ccore1(c_string_pointer+i-1)
  end do
c_to_f_string = f_string
deallocate(f_string)
return
end

Here's the run-time. Note: The "full result" here is shown truncated because multiple spaces are removed when posting.
Quote:
Length of result string to be allocated= 10
Actual non blank data returned= 10=This is me full result=[This is me ]
Length of result string to be allocated= 10
Function length returned= 255
Back to top
View user's profile Send private message Visit poster's website
jlb



Joined: 21 Oct 2020
Posts: 67

PostPosted: Sat Mar 09, 2024 6:53 pm    Post subject: Reply with quote

Bill
Thanks a lot for your help. I didn't know about the FTN95-function CCORE1. I will test your code as soon as possible.
For your complete information, here is the interface module to the 3rd part DLL in its Intel Fortran version:
Code:
MODULE Test
USE, INTRINSIC::ISO_C_BINDING

INTERFACE
  TYPE(C_PTR) FUNCTION FuncPtr(handle) BIND(C, NAME='FuncPtrA')
  USE, INTRINSIC :: ISO_C_BINDING
  TYPE(C_PTR), VALUE :: handle         
  END FUNCTION
END INTERFACE

CONTAINS

FUNCTION C_to_F_string(c_string_pointer) RESULT(f_string)
  USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_PTR, C_F_POINTER, C_CHAR, C_NULL_CHAR
  type(C_PTR), INTENT(IN) :: c_string_pointer
  CHARACTER(LEN=:), ALLOCATABLE :: f_string
  CHARACTER(KIND=C_CHAR), DIMENSION(:), POINTER :: char_array_pointer => NULL()
  CHARACTER(LEN=255) :: aux_string
  INTEGER :: i, length   
  CALL C_F_POINTER(c_string_pointer, char_array_pointer, [255])
  IF (.NOT.ASSOCIATED(char_array_pointer)) THEN
    ALLOCATE(CHARACTER(LEN=4)::f_string); f_string="NULL"; RETURN
  END IF
  aux_string=" "
  DO i=1,255
    IF (char_array_pointer(i)==c_null_char) THEN
      length=i-1; EXIT
    END IF
  aux_string(i:i)=char_array_pointer(i)
  END DO
  ALLOCATE(CHARACTER(LEN=length)::f_string)
  f_string=aux_string(1:length)
END FUNCTION C_to_F_string

FUNCTION Func(handle) RESULT(f_string)
  USE ISO_C_BINDING
  TYPE(C_PTR), VALUE :: handle         
  CHARACTER(:), ALLOCATABLE :: f_string
  f_string = C_to_F_string(FuncPtr(handle))   
END FUNCTION

END MODULE
Back to top
View user's profile Send private message
wahorger



Joined: 13 Oct 2014
Posts: 1225
Location: Morrison, CO, USA

PostPosted: Sun Mar 10, 2024 12:06 am    Post subject: Reply with quote

Just an FYI. Here's the FTN95 statement for the interface to one of my DLL's. It returns the pointer to a file handle from "C". So, it's size will be either 32-bit or 64-bit depending on the memory model.
Code:
C_EXTERNAL OPEN_LOG_FILE 'open_log_file'(string,string):INTEGER(7)! returns the file pointer


And. here's the function definition for that call:
Code:
compile_header
 FILE *open_log_file(char *name,char *option) // returns the file pointer


where "compile_header" is:
Code:
#define compile_header extern "C"


I'm finding that for 64-bit, no header is needed, depending on the "C" compiler.
Back to top
View user's profile Send private message Visit poster's website
jlb



Joined: 21 Oct 2020
Posts: 67

PostPosted: Mon Mar 11, 2024 1:12 pm    Post subject: Reply with quote

Bill

Thanks a lot for this workaround, which does the trick.
Back to top
View user's profile Send private message
wahorger



Joined: 13 Oct 2014
Posts: 1225
Location: Morrison, CO, USA

PostPosted: Tue Mar 12, 2024 2:51 pm    Post subject: Reply with quote

jlb,

Happy to help!

Bill
Back to top
View user's profile Send private message Visit poster's website
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 8011
Location: Salford, UK

PostPosted: Tue Mar 19, 2024 2:22 pm    Post subject: Reply with quote

jib

The ClearWin+ interfaces in \Silverfrost\FTN95\source64\clrwin.f95 illustrate one way to pass C strings to and from Fortran code.

See, for example, send_accelerator$ which sends a null terminated string.

For strings passed from C to Fortran, see the subroutine called PAD and note how it is used.
Back to top
View user's profile Send private message AIM Address
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 8011
Location: Salford, UK

PostPosted: Thu Mar 21, 2024 5:07 pm    Post subject: Reply with quote

C_F_POINTER in the ISO_C_BINDING module (2003 Fortran Standard) has now been implemented for the next full release of FTN95.

It will appear in the next interim release but will also require an extended definition for the ISO_C_BINDING module (in \Silverfrost\FTN95\include).
Back to top
View user's profile Send private message AIM Address
jlb



Joined: 21 Oct 2020
Posts: 67

PostPosted: Fri Mar 22, 2024 10:42 am    Post subject: Reply with quote

Paul

Thanks for pointing out the send_accelerator$ and PAD subroutines, i wasn't aware of them, as well as for the C_F_POINTER implementation.
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group