c - Fortran 相当于 C struct malloc/free 用于插件机制

Question

我正在编写一个基于dlopen 的插件机制，我想展示如何用各种语言实现一个"hello world" 插件。 接下来是 Fortran。我的 Fortran 时代有点落后了(当时拼写为 FORTRAN77)。

我想用 Fortran ISO_C_BINDING 机制做等效的 C hello world:

#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;
}

这是我现在拥有的:

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

想法是让另一个组件 dlopen 给定 .so，找到一些“众所周知”的符号并要求:

• 实例化插件组件的符号
• 删除插件组件的符号
• 用于初始化、执行、完成插件组件的三个符号。

插件组件将由插件组件的“管理器”实例化。

对于如何编写 f_alg_new、f_alg_del 和 f_alg_{ini,exe,fin} Fortran 等价物，我有点不知所措。

有什么提示吗？

---

编辑

在插件管理器方面，这里有一些模拟代码:

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);
}

插件分配的内存由插件端管理(因此 xyz_new 和 xyz_del Hook )，“主”程序仅安排这些 Hook 的执行xyz_new Hook 返回的不透明地址。

Answer 1

我设法让一些东西工作:

• 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

关于更好地处理 alg 的 name 字段的建议表示赞赏 :) (以及对一般样式和内容的改进)