Weak symbol directive

Does anyone know if the Intel Fortran compiler has a weak symbol directive? The search box in the Intel Fortran Developer Guide finds only one (unrelated) result for the keyword “weak”.

In gfortran the ATTRIBUTES directive can be used:

function spcrad(neqn,t,y)
!GCC$ ATTRIBUTES WEAK :: spcrad
integer :: neqn
real(kind(1.0d0)) :: t, y(neqn), spcrad
spcrad = -1.0
end function

The HPE Cray compiler uses !DIR$ WEAK.

In C compilers, you’ll usually see something like:

double spcrad( /* args */ ) __attribute__((weak))
{ 
    /* ... */ 
}

I do not know of an ifx directive but typical weak usage I know of can usually be resolved at load time by allowing duplicates but presenting the desired symbol first; options to not use the default libraries implicitly; even intrinsic/external statements and renaming via the use statement and private procedures or ones only visible via OOP can be useful. Curious what the use case is as perhaps there are other solutions; although the loader options are usually as platform-specific as the directives are.

In the rare cases where I wanted to control what symbol definition was used with duplicates present, which I think might be the problem(?) the ld(1) command has things like -z muldefs and -z unique-symbol or other load options that worked for me; but I am not sure I understand the problem.

The use case is a library which expects a user-defined external function with a fixed name (https://netlib.org/ode/rkc.f). The user can control if this routine is used or not, via an integer option flag:

c  INFO(2)  = 0  RKC is to compute the estimate internally.  
c                Assign any value to SPCRAD.
c
c           = 1  SPCRAD returns an upper bound on the spectral
c                radius of the Jacobian of f at (t,y). 

However even when info(2) = 0 a dummy routine needs to be available to satisfy the linker. Hence my idea was to provide a weak symbol:

! Dummy function, just here for linking
function spcrad(neqn,t,y)
!GCC$ ATTRIBUTES WEAK :: spcrad
integer :: neqn
real(kind(1.0d0)) :: t, y(neqn), spcrad
spcrad = -1.0d0
end function

and then if a user wants to use info(2) = 1, they just provide their own “strong” spcrad which over-rides the weak one. The long-term fix would be to avoid the “global” subroutine, and use a procedure dummy argument.

If I understand correctly, this weak symbol would only matter for a static library?

An alternative could be to let the user register a routine to use (procedure pointer) and have SPCRAD call that routine. That way you avoid linker trickery.

2 Likes

That is a good idea (a sort of shim). In principle one can have both, the default weak symbol which is then over-ridden by a strong symbol which calls a procedure pointer:

module spcrad_ptr
implicit none
abstract interface
    function spcrad_fun(neqn,t,y)
        integer, intent(in) :: neqn
        real(kind(1.0d0)), intent(in) :: t, y(neqn)
        real(kind(1.0d0)) :: spcrad_fun
    end function
end interface
procedure(spcrad_fun), pointer :: ptr => null()
end module

! Fixed-name procedure (strong symbol)
! invoked from the RKC library as external function
function spcrad(neqn,t,y)
    use spcrad_ptr, only: ptr
    integer :: neqn
    real(kind(1.0d0)) :: t, y(neqn), spcrad
    if (associated(ptr)) then
        spcrad = ptr(neqn,t,y)
    else
        error stop
    end if
end function

program demo
use spcrad_ptr, only: ptr
implicit none

ptr => sigma
call rkc(...)   ! rkc -> spcrad -> ptr -> sigma

contains
    !> Spectral radius estimate
    function sigma(neqn,t,y)
        integer, intent(in) :: neqn
        real(kind(1.0d0)), intent(in) :: t, y(neqn)
        real(kind(1.0d0)) :: sigma
        sigma = ...
    end function 
end program

One could then wrap the interface, to expose a spcrad_fun procedure dummy argument.

In absence of an equivalent weak symbol directive with other compilers (Intel Fortran, flang, nvfortran), it seems that explicitly “registering” a global procedure pointer is the more portable way to go. And assuming that multi-threading is not needed.

If you go the extra mile and use a DT to encapsulate the procedure pointer you might regain the thread safety by ensuring locality of the DT.

Yes. I thought I had several examples in github, but at least GitHub - urbanjost/M_calculator: parse Fortran-like double precision scalar expressions shows having an optional subroutine and function that initially point to stub routines but can use user-supplied routines via pointers (the juown1() subroutine and c() function). But that code has decades of history in it so it would be nice to have some examples like that.

Something like this one might be a good example for the Fortran wiki if it does not have one.

Had not run across the “shim” term before. After reading the description
I suppose the way I often wrap old code in a module for a newer API but leave something looking like the old interface exposed for backward compatibility could be called a shim ( I generally call it a kludge :slight_smile: ).

1 Like