3

I am writing a little dlopen-based plugin mechanism and I'd like to show how to implement a "hello world" plugin in various languages. Fortran is next. My Fortran days are a bit behind (at the time it was spelled FORTRAN77).

I'd like to do the equivalent C hello world, with Fortran ISO_C_BINDING mechanism:

#include <stdlib.h>
#include <stdio.h>

typedef struct {
    const char *name;
    void       *svcLocator;
} Alg_t;

// c_alg_new returns a new Alg_t C-algorithm.
void *c_alg_new(const char *name, void *svcLocator) {
    Alg_t *ctx = (Alg_t*)malloc(sizeof(Alg_t));
    ctx->name = name;
    ctx->svcLocator = svcLocator;
    return (void*)ctx;
}

// c_alg_del deletes an Alg_t C-algorithm.
void c_alg_del(void *self) {
    free(self);
    return;
}

int c_alg_ini(void *self) {
    Alg_t *ctx = (Alg_t*)self;
    fprintf(stdout, ">>> initialize [%s]...\n", ctx->name);
    fprintf(stdout, ">>> initialize [%s]... [done]\n", ctx->name);
    return 0;
}

int c_alg_exe(void *self) {
    Alg_t *ctx = (Alg_t*)self;
    fprintf(stdout, ">>> execute [%s]...\n", ctx->name);
    fprintf(stdout, ">>> execute [%s]... [done]\n", ctx->name);
    return 0;
}

int c_alg_fin(void *self) {
    Alg_t *ctx = (Alg_t*)self;
    fprintf(stdout, ">>> finalize [%s]...\n", ctx->name);
    fprintf(stdout, ">>> finalize [%s]... [done]\n", ctx->name);
    return 0;
}

here is what I have right now:

program foo

use, intrinsic :: iso_c_binding, only : c_int, c_ptr, c_char, c_null_char
implicit none (type, external)

type, bind(C) :: Alg
    character(kind=c_char) :: name(1000)
    type (c_ptr)    :: svcloc
end type Alg

!! function f_alg_new() result(ctx)
!!     type(Alg) :: ctx
!! end function

end program

the idea is to have another component dlopen a given .so, locate some "well known" symbols and require:

  • a symbol to instantiate plugin components
  • a symbol to delete a plugin component
  • a trio of symbols to initialize, execute, finalize plugin components.

the plugin components would be instantiated by the "manager" of plugin components.

I am a bit at loss as how to write the f_alg_new, f_alg_del and f_alg_{ini,exe,fin} Fortran equivalents.

any hint?


EDIT

on the plugin manager side, here is some mock up code:

void foo(void *lib) {
    // load "component-new" symbol
    void *cnew = dlsym(lib, "f_alg_new");
    if (cnew == NULL) { ... }

    void *cdel = dlsym(lib, "f_alg_del");
    if (cdel == NULL) { ... }

    void *cini = dlsym(lib, "f_alg_ini");
    if (cini == NULL) { ... }

    // etc...

    // create a new Fortran, C, Go, ... component
    void *ctx = (*cnew)("f-alg-0", NULL);

    // initialize it:
    int err = (*cini)(ctx);
    if (err != 0) { ... } 

    for (int ievent=0; ievent < NEVTS; ievent++) {
        int err = (*cexe)(ctx);
        if (err != 0) { ... }
    }

    // finalize it:
    err = (*cfin)(ctx);
    if (err != 0) { ... }

    // destroy/clean-up
    (*cdel)(ctx);
}

memory allocated by the plugin is managed plugin-side (hence the xyz_new and xyz_del hooks), and the "main" program only schedules the execution of these hooks on the opaque address returned by the xyz_new hook.

sbinet
  • 41
  • 3
  • Could you expand a bit on what the C is doing, for those of us whose Fortran is better than our C? – veryreverie Sep 29 '21 at 09:05
  • [these](https://stackoverflow.com/questions/38998241/freeing-a-c-pointer-returned-by-a-c-function-to-fortran) [questions](https://stackoverflow.com/questions/19147743/passing-allocatable-array-from-fortran-to-c-and-malloc-it) might help. I believe the rule of thumb is that if you've allocated memory in C you should deallocate it in C. C's `malloc` and `free` don't play nicely with Fortran's `allocate` and `deallocate`. – veryreverie Sep 29 '21 at 09:20
  • 1
    @veryreverie Nitpick, I would say "... are not guaranteed to play nicely with ..." but in practice I agree that what you say should be how it is done, or via `CFI_allocate` and `CFI_deallocate` – Ian Bush Sep 29 '21 at 10:01
  • @veryreverie I've added a little blurb on what the `C` side is doing with the loaded plugin. I'll have a look at your pointers. thanks. – sbinet Sep 29 '21 at 13:01

1 Answers1

1

I managed to get something working:

  • lib.f90
!! function f_alg_new creates a new alg value.
type(c_ptr) function f_alg_new(name, svc) bind(C) result(cptr)
    use, intrinsic  :: iso_c_binding
    use falg
    implicit none

    character(kind=c_char),dimension(*), intent(in) :: name(1024)
    type (c_ptr), intent(in), value                 :: svc
    type (alg), pointer                             :: ctx
    integer                                         :: len

    allocate(ctx)

    len=0
    do
       if (name(len+1) == c_null_char) exit
       len = len + 1
       ctx%name(len) = name(len)
    end do
    ctx%len = len

    cptr = c_loc(ctx)
end function

!! function f_alg_del destroys the alg value.
subroutine f_alg_del(cptr) bind(C)
    use, intrinsic  :: iso_c_binding
    use falg
    implicit none

    type (c_ptr), intent(in), value :: cptr
    type (alg), pointer :: ctx

    call c_f_pointer(cptr, ctx)
    deallocate(ctx)

end subroutine

integer(c_int) function f_alg_ini(cptr) bind(C) result(sc)
    use, intrinsic  :: iso_c_binding
    use falg
    implicit none

    type (c_ptr), intent(in), value :: cptr
    type (alg), pointer :: ctx

    call c_f_pointer(cptr, ctx)

    print *,"initialize... [", ctx%name(1:ctx%len), "]"
    print *,"initialize... [", ctx%name(1:ctx%len), "] [done]"

    sc = 0
end function

integer(c_int) function f_alg_exe(cptr) bind(C) result(sc)
    use, intrinsic  :: iso_c_binding
    use falg
    implicit none

    type (c_ptr), intent(in), value :: cptr
    type (alg), pointer :: ctx

    call c_f_pointer(cptr, ctx)

    print *,"execute... [", ctx%name(1:ctx%len), "]"
    print *,"execute... [", ctx%name(1:ctx%len), "] [done]"

    sc = 0
end function


integer(c_int) function f_alg_fin(cptr) bind(C) result(sc)
    use, intrinsic  :: iso_c_binding
    use falg
    implicit none

    type (c_ptr), intent(in), value :: cptr
    type (alg), pointer :: ctx

    call c_f_pointer(cptr, ctx)

    print *,"finalize... [", ctx%name(1:ctx%len), "]"
    print *,"finalize... [", ctx%name(1:ctx%len), "] [done]"

    sc = 0
end function
  • falg.f90
module falg

    use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_char, c_loc
    implicit none

    type, bind(C) :: alg
        character(kind=c_char) :: name(1024)
        integer(c_size_t)      :: len
        type (c_ptr)           :: svcloc
    end type alg

end module falg

suggestions for better handling of the name field of alg appreciated :) (as well as improvements on general style and stuff)

sbinet
  • 41
  • 3