Creating interface for undocumented ClearWin+ function

I have code that uses the upcase$ subroutine and I'm trying to port it to 64 bit via gFortran. It is not defined in the clrwin.f95 module source though.

I can see that it is present in clearwin64.lib but I am uncertain about the interface syntax due to the terminating null character normally required in C calls.

My guess is that upcase$ requires an additional parameter for the length of the string as the code that I am porting does not seem to use null terminators (I may be wrong).

I'm unsure whether gFortran will do the invisible length parameter fixup automatically and I can't find an example of it.

Can someone please advise me on the interface syntax to call this subroutine from gFortran?

The ClearWin+ parameter spec is defined at http://www.silverfrost.com/ftn95-help/char/h_upcasea.aspx .

I think it should look something like the following, but with an additional length parameter.

interface
subroutine upcase$(text) bind(C,Name='UPCASE$')
use ISO_C_BINDING
character(C_CHAR)::text(*)
end subroutine upcase$
end interface

Ryan

clearwin64.dll contains many functions with arguments that are null terminated strings but there are exceptions like UPCASE$. The header for UPCASE$ in C is

extern 'C' void UPCASE$(char* str, long long len)

This relies on the fact that FTN95 passes CHARACTER variables by adding the length of the variable as an extra argument at the end of the argument list.

All Fortran compilers do this in one way or another. Some put the length immediately after the string, others like FTN95 put all the lengths at the end. In this case there is only one character variable so the two approaches have the same result.

I am guessing that you can probably use UPCASE$ without any interface but I haven't tried this. If not then I don't have a quick answer to your question.

Thanks Paul, that should be enough information to write a wrapper of some sort.

I have it working, below is the interface specification for anyone else who might be porting.

Paul, once I have this debugged and working would you be interested in a copy of my updated clrwin.f95 module? I've added a few undocumented functions. I could host it on github.com to enable others to contribute fixes / updates.

The interface specification for UpCase$;

interface
  subroutine UpCase$(str,len) bind(C, name='UPCASE$')
    USE,INTRINSIC :: ISO_C_BINDING
    IMPLICIT NONE
    CHARACTER(kind=c_char), DIMENSION(*), INTENT(INOUT) :: str
    INTEGER(C_LONG_LONG), value, INTENT(IN) :: len
  end subroutine UpCase$
end interface

Called as follows from gFortran. I can't figure out how to hint to gFortran that it should supply the length automatically, therefore I've passed it explicitly and it seems to work fine.

      character str*128
      call upcase$(str,INT8(len_trim(str)))

Ryan

It turns out that we need upcase$, etc. (lowercase letters) in the DLL for gFortran whilst FTN95 requires UPCASE$, etc..

I have added upcase$,lcase$ and nonblk$ to clearwin64.dll and to clrwin.f95 for the next release. Other functions can be added if you will let me know.

I've added the following definitions to our copy of of clrwin.f95. It's linking but I'm still working through runtime errors so I won't repeat the parameters here as they may not be correct.

I appreciate that some of these are not publicly documented, they were in the old code base.

subroutine auxSolidSphere(radius) bind(C,Name='auxSolidSphere')
subroutine closef$(handle,error_code) bind(C,Name='CLOSEF$')
subroutine Command_Line$(str,len) bind(C, name='COMMAND_LINE')
subroutine date_time_seed$() bind(C,Name='DATE_TIME_SEED$')
subroutine dclock$(r) bind(C,Name='DCLOCK$')
subroutine exit$(error_code) bind(C,Name='exit$')
subroutine file_size$(file,s,error_code) bind(C,Name='FILE_SIZE$')
subroutine get_file_attribute$(file,iat,error_code,strlen) bind(C,Name='GET_FILE_ATTRIBUTE$')
function OPEN_GL_PRINTER$(ID,ATTRIB,WIDTH,HEIGHT) bind(C,Name='__open_gl_printer')
subroutine openw$(file,handle,error_code) bind(C,Name='OPENW$')
function PRINT_OPENGL_IMAGE$(ID,LEAVE_OPEN) bind(C,Name='__print_opengl_image')
function random$() bind(C,Name='RANDOM$')
subroutine set_seed$(seed) bind(C,Name='SET_SEED$')
subroutine SET_OPENGL_CONTEXT$(ID) bind(C,Name='__set_opengl_context')
subroutine swap_opengl_buffers() bind(C,Name='__swap_opengl_buffers')
subroutine UpCase$(str,len) bind(C, name='UPCASE$')
subroutine writef$(data,handle,nbytes,error_code) bind(C,Name='WRITEF$')

Thanks again Paul