Fortran等效的C结构malloc/可与插件机制一起使用

Question

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

我想用Fortran ISO_C_BINDING机制做一个等价的C hello世界：

#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钩子)，“主”程序只在xyz_new钩子返回的不透明地址上调度这些钩子的执行。

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

关于更好地处理name领域alg的建议值得赞赏:) (以及对一般风格和东西的改进)