内容

名称

perlcall - 从 C 调用 Perl 约定

描述

本文档的目的是向您展示如何直接从 C 调用 Perl 子例程,即如何编写回调

除了讨论 Perl 为编写回调提供的 C 接口外,本文档还使用一系列示例来展示该接口在实践中的实际工作方式。此外,还介绍了一些用于编码回调的技术。

需要回调的示例包括

虽然这里描述的技术适用于将 Perl 嵌入到 C 程序中,但这并不是本文档的主要目标。还有一些其他细节需要考虑,这些细节是特定于嵌入 Perl 的。有关将 Perl 嵌入 C 的详细信息,请参阅 perlembed

在您深入研究本文档的其余部分之前,最好先阅读以下两篇文档:perlxsperlguts

CALL_ 函数

虽然用示例解释这些内容更容易,但您首先需要了解一些重要的定义。

Perl 有许多 C 函数,允许您调用 Perl 子例程。它们是

I32 call_sv(SV* sv, I32 flags);
I32 call_pv(char *subname, I32 flags);
I32 call_method(char *methname, I32 flags);
I32 call_argv(char *subname, I32 flags, char **argv);

关键函数是 call_sv。所有其他函数都是相当简单的包装器,它们使在特殊情况下调用 Perl 子例程变得更容易。最终,它们都将调用 call_sv 来调用 Perl 子例程。

所有 call_* 函数都有一个 flags 参数,用于将选项的位掩码传递给 Perl。此位掩码对每个函数的操作都相同。位掩码中可用的设置在 "FLAG 值" 中讨论。

现在将依次讨论每个函数。

call_sv

call_sv 接受两个参数。第一个,sv,是一个 SV*。这允许您将要调用的 Perl 子例程指定为 C 字符串(它首先已转换为 SV)或对子例程的引用。部分 "使用 call_sv" 展示了如何使用 call_sv

call_pv

函数 call_pvcall_sv 类似,只是它期望它的第一个参数是一个 C char*,它标识要调用的 Perl 子例程,例如,call_pv("fred", 0)。如果要调用的子例程在另一个包中,只需在字符串中包含包名,例如,"pkg::fred"

call_method

函数 call_method 用于调用 Perl 类中的方法。参数 methname 对应于要调用的方法的名称。请注意,方法所属的类是在 Perl 堆栈上传递的,而不是在参数列表中。此类可以是类的名称(对于静态方法)或对对象的引用(对于虚拟方法)。有关静态方法和虚拟方法的更多信息,请参见 perlobj,有关使用 call_method 的示例,请参见 "使用 call_method"

call_argv

call_argv 调用由 subname 参数中存储的 C 字符串指定的 Perl 子例程。它还采用通常的 flags 参数。最后一个参数 argv 包含一个以 NULL 结尾的 C 字符串列表,这些字符串将作为参数传递给 Perl 子例程。请参见 "使用 call_argv"

所有函数都返回一个整数。这是 Perl 子例程返回的项目数量。子例程返回的实际项目存储在 Perl 堆栈上。

作为一般规则,您应该始终检查这些函数的返回值。即使您期望 Perl 子例程只返回特定数量的值,也没有什么可以阻止某人做一些意想不到的事情——不要说您没有被警告。

标志值

所有 call_* 函数中的 flags 参数是 G_VOIDG_SCALARG_LIST 之一,它们指示调用上下文,或与下面定义的任何其他 G_* 符号的位掩码一起使用。

G_VOID

在空上下文下调用 Perl 子例程。

此标志有 2 个效果

  1. 它指示被调用的子例程它正在空上下文下执行(如果它执行 wantarray,结果将是未定义的值)。

  2. 它确保子例程实际上没有返回任何内容。

call_* 函数返回的值指示 Perl 子例程返回了多少个项目——在这种情况下,它将为 0。

G_SCALAR

在标量上下文中调用 Perl 子例程。这是所有 call_* 函数的默认上下文标志设置。

此标志有 2 个效果

  1. 它指示被调用的子例程正在标量上下文中执行(如果它执行 wantarray,结果将为假)。

  2. 它确保子例程实际上只返回一个标量。当然,子例程可以忽略 wantarray 并仍然返回一个列表。如果是这样,那么只返回列表的最后一个元素。

call_* 函数返回的值指示 Perl 子例程返回了多少个项目 - 在这种情况下,它将是 0 或 1。

如果为 0,则您已指定 G_DISCARD 标志。

如果为 1,则 Perl 子例程实际返回的项目将存储在 Perl 堆栈上 - 部分 "返回标量" 显示了如何在堆栈上访问此值。请记住,无论 Perl 子例程返回多少个项目,只有最后一个项目才能从堆栈中访问 - 将只返回一个值的案例视为只有一个元素的列表。在 call_* 函数返回控制权之前,任何其他返回的项目将不存在。部分 "在标量上下文中返回列表" 显示了此行为的示例。

G_LIST

在列表上下文中调用 Perl 子例程。在 Perl 5.35.1 版本之前,这被称为 G_ARRAY

与 G_SCALAR 一样,此标志有两个作用

  1. 它指示被调用的子例程正在列表上下文中执行(如果它执行 wantarray,结果将为真)。

  2. 它确保在从 call_* 函数返回控制权时,可以访问从子例程返回的所有项目。

call_* 函数返回的值指示 Perl 子例程返回了多少个项目。

如果为 0,则您已指定 G_DISCARD 标志。

如果非 0,则它将是子例程返回的项目数量。这些项目将存储在 Perl 堆栈上。部分 "返回值列表" 给出了使用 G_LIST 标志以及从 Perl 堆栈访问返回项目的机制的示例。

G_DISCARD

默认情况下,call_* 函数将 Perl 子例程返回的项目放置在堆栈上。如果您对这些项目不感兴趣,那么设置此标志将使 Perl 自动为您删除它们。请注意,仍然可以通过使用 G_SCALAR 或 G_LIST 来指示 Perl 子例程的上下文。

如果您没有设置此标志,那么您必须确保所有临时变量(即传递给 Perl 子例程的参数和从子例程返回的值)都由您自己处理。部分 "返回标量" 详细介绍了如何显式处理这些临时变量,部分 "使用 Perl 处理临时变量" 讨论了您可以忽略此问题并让 Perl 为您处理的具体情况。

G_NOARGS

当使用任何 call_* 函数调用 Perl 子程序时,默认情况下会假定参数将传递给子程序。如果您没有将任何参数传递给 Perl 子程序,则可以通过设置此标志来节省一些时间。它具有不为 Perl 子程序创建 @_ 数组的效果。

虽然此标志提供的功能看起来很简单,但只有在有充分理由的情况下才应使用它。谨慎的原因是,即使您指定了 G_NOARGS 标志,被调用的 Perl 子程序仍然可能认为您已将参数传递给它。

实际上,可能发生的情况是,您调用的 Perl 子程序可以访问来自先前 Perl 子程序的 @_ 数组。当执行 call_* 函数的代码本身是从另一个 Perl 子程序调用的时,就会发生这种情况。下面的代码说明了这一点

sub fred
  { print "@_\n"  }

sub joe
  { &fred }

&joe(1,2,3);

这将打印

1 2 3

发生的事情是 fred 访问了属于 joe@_ 数组。

G_EVAL

您调用的 Perl 子程序可能会异常终止,例如,通过显式调用 die 或根本不存在。默认情况下,当发生这些事件中的任何一个时,进程将立即终止。如果您想捕获此类事件,请指定 G_EVAL 标志。它将在子程序调用周围放置一个 eval { }

每当从 call_* 函数返回控制权时,您都需要检查 $@ 变量,就像在普通的 Perl 脚本中一样。

call_* 函数返回的值取决于已指定了哪些其他标志以及是否发生了错误。以下是可能发生的所有不同情况

有关使用 G_EVAL 的详细信息,请参阅 "使用 G_EVAL"

G_KEEPERR

使用上面描述的 G_EVAL 标志将始终设置 $@:如果未发生错误,则清除它;如果被调用代码中发生错误,则将其设置为描述错误。如果您打算处理可能的错误,这就是您想要的,但有时您只想捕获错误并阻止它们干扰程序的其余部分。

这种情况主要适用于旨在从析构函数、异步回调和信号处理程序中调用的代码。在这种情况下,被调用的代码与周围的动态上下文几乎没有关系,因此主程序需要与被调用代码中的错误隔离,即使这些错误无法智能地处理。对于__DIE____WARN__钩子和tie函数的代码,这样做也可能很有用。

G_KEEPERR 标志旨在与 G_EVAL 结合使用,用于实现此类代码的call_*函数,或与eval_sv结合使用。当不使用 G_EVAL 时,此标志对call_*函数没有影响。

当使用 G_KEEPERR 时,被调用代码中的任何错误都会像往常一样终止调用,并且错误不会传播到调用之外(如 G_EVAL 的通常情况),但它不会进入$@。相反,错误将被转换为警告,并在前面加上字符串“\t(in cleanup)”。这可以通过使用no warnings 'misc'来禁用。如果没有错误,$@将不会被清除。

请注意,G_KEEPERR 标志不会传播到内部 eval;这些 eval 仍然可以设置$@

G_KEEPERR 标志是在 Perl 版本 5.002 中引入的。

有关需要使用此标志的情况的示例,请参见"使用 G_KEEPERR"

确定上下文

如上所述,您可以使用wantarray确定 Perl 中当前执行的子例程的上下文。可以使用GIMME_V宏在 C 中进行等效测试,该宏在列表上下文中调用时返回G_LIST,在标量上下文中调用时返回G_SCALAR,在空上下文中调用时返回G_VOID(即,返回值不会被使用)。此宏的旧版本称为GIMME;在空上下文中,它返回G_SCALAR而不是G_VOID。有关使用GIMME_V宏的示例,请参见"使用 GIMME_V"部分。

示例

定义讨论就到这里!让我们看几个例子。

Perl 提供了许多宏来帮助访问 Perl 堆栈。在可能的情况下,在与 Perl 内部接口时应始终使用这些宏。我们希望这应该使代码不易受到将来对 Perl 所做更改的影响。

另一个值得注意的点是,在第一组示例中,我只使用了call_pv函数。这样做是为了使代码更简单,并让您更容易理解主题。在可能的情况下,如果在使用call_pvcall_sv之间进行选择,您应该始终尝试使用call_sv。有关详细信息,请参见"使用 call_sv"

没有参数,没有返回值

第一个简单的示例将调用 Perl 子例程PrintUID来打印出进程的 UID。

sub PrintUID
{
    print "UID is $<\n";
}

这里有一个调用它的 C 函数

static void
call_PrintUID()
{
    dSP;

    PUSHMARK(SP);
    call_pv("PrintUID", G_DISCARD|G_NOARGS);
}

很简单,对吧?

关于这个例子,需要注意几点

  1. 现在先忽略 dSPPUSHMARK(SP)。它们将在下一个例子中讨论。

  2. 我们没有向 PrintUID 传递任何参数,因此可以指定 G_NOARGS。

  3. 我们对 PrintUID 返回的任何内容都不感兴趣,因此指定了 G_DISCARD。即使 PrintUID 被更改为返回一些值,指定 G_DISCARD 也意味着在控制权从 call_pv 返回时,它们将被清除。

  4. 由于正在使用 call_pv,因此 Perl 子例程被指定为 C 字符串。在这种情况下,子例程名称已“硬编码”到代码中。

  5. 因为我们指定了 G_DISCARD,所以没有必要检查从 call_pv 返回的值。它将始终为 0。

传递参数

现在让我们做一个稍微复杂一点的例子。这次我们想调用一个 Perl 子例程 LeftString,它将接受 2 个参数——一个字符串 ($s) 和一个整数 ($n)。子例程将简单地打印字符串的前 $n 个字符。

所以 Perl 子例程看起来像这样

sub LeftString
{
    my($s, $n) = @_;
    print substr($s, 0, $n), "\n";
}

调用 LeftString 所需的 C 函数看起来像这样

    static void
    call_LeftString(a, b)
    char * a;
    int b;
    {
        dSP;

	ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        EXTEND(SP, 2);
        PUSHs(sv_2mortal(newSVpv(a, 0)));
        PUSHs(sv_2mortal(newSViv(b)));
        PUTBACK;

        call_pv("LeftString", G_DISCARD);

        FREETMPS;
        LEAVE;
    }

以下是关于 C 函数 call_LeftString 的一些说明。

  1. 参数使用 Perl 堆栈传递给 Perl 子例程。这是从 dSP 开始到 PUTBACK 结束的代码的目的。dSP 声明堆栈指针的本地副本。此本地副本应始终作为 SP 访问。

  2. 如果您要将某些内容放到 Perl 堆栈上,您需要知道将其放在哪里。这是宏 dSP 的目的——它声明并初始化 Perl 堆栈指针的本地副本。

    此示例中将使用的所有其他宏都需要您使用此宏。

    此规则的例外情况是,如果您直接从 XSUB 函数调用 Perl 子例程。在这种情况下,没有必要显式使用 dSP 宏——它将自动为您声明。

  3. 要推送到堆栈上的任何参数都应放在 PUSHMARKPUTBACK 宏之间。这两个宏的目的是在这种情况下去自动计算您正在推送的参数数量。然后,每当 Perl 为子例程创建 @_ 数组时,它就知道要使其多大。

    PUSHMARK 宏告诉 Perl 记录当前堆栈指针。即使您没有传递任何参数(例如 "无参数,无返回值" 部分中显示的示例),您仍然必须在调用任何 call_* 函数之前调用 PUSHMARK 宏——Perl 仍然需要知道没有参数。

    PUTBACK 宏将堆栈指针的全局副本设置为与我们的本地副本相同。如果我们不这样做,call_pv 将不知道我们推送的两个参数在哪里——请记住,到目前为止,我们所做的所有堆栈指针操作都是使用我们的本地副本,而不是全局副本。

  4. 接下来,我们来到 EXTEND 和 PUSHs。这是参数实际被推送到堆栈的地方。在本例中,我们正在推送一个字符串和一个整数。

    或者,您可以使用 XPUSHs() 宏,它将 EXTEND(SP, 1)PUSHs() 合并在一起。如果您要推送多个值,这效率较低。

    有关 PUSH 宏工作原理的详细信息,请参阅 "perlguts 中的 XSUB 和参数堆栈"

  5. 由于我们创建了临时值(通过 sv_2mortal() 调用),因此我们将不得不清理 Perl 堆栈并处理掉临时的 SV。

    这是

    ENTER;
    SAVETMPS;

    在函数开头,以及

    FREETMPS;
    LEAVE;

    在结尾处的目的。ENTER/SAVETMPS 对为我们创建的任何临时变量创建了一个边界。这意味着我们清除的临时变量将仅限于在这些调用之后创建的那些临时变量。

    FREETMPS/LEAVE 对将清除 Perl 子例程返回的任何值(参见下一个示例),它还将转储我们创建的临时 SV。在代码开头使用 ENTER/SAVETMPS 可确保不会销毁其他临时变量。

    将这些宏视为在 Perl 中类似于 {},用于限制局部变量的范围。

    有关使用这些宏的替代方法的详细信息,请参阅 "使用 Perl 处理临时变量" 部分。

  6. 最后,LeftString 现在可以通过 call_pv 函数调用。这次指定的唯一标志是 G_DISCARD。因为我们这次向 Perl 子例程传递了 2 个参数,所以我们没有指定 G_NOARGS。

返回标量

现在举一个处理从 Perl 子例程返回的项目的例子。

这是一个 Perl 子例程 Adder,它接受 2 个整数参数,并简单地返回它们的总和。

sub Adder
{
    my($a, $b) = @_;
    $a + $b;
}

由于我们现在关注的是Adder的返回值,因此调用它的C函数现在变得更加复杂。

static void
call_Adder(a, b)
int a;
int b;
{
    dSP;
    int count;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sv_2mortal(newSViv(a)));
    PUSHs(sv_2mortal(newSViv(b)));
    PUTBACK;

    count = call_pv("Adder", G_SCALAR);

    SPAGAIN;

    if (count != 1)
        croak("Big trouble\n");

    printf ("The sum of %d and %d is %d\n", a, b, POPi);

    PUTBACK;
    FREETMPS;
    LEAVE;
}

需要注意的几点是

  1. 这次唯一指定的标志是G_SCALAR。这意味着@_数组将被创建,并且Adder返回的值在调用call_pv后仍然存在。

  2. SPAGAIN的目的是刷新堆栈指针的本地副本。这是必要的,因为在call_pv调用期间,分配给Perl堆栈的内存可能已被重新分配。

    如果你的代码中使用了Perl堆栈指针,那么在使用call_*函数或任何其他Perl内部函数时,必须始终使用SPAGAIN刷新本地副本。

  3. 虽然我们只期望从Adder返回一个值,但检查call_pv的返回值仍然是最佳实践。

    期望一个值并不完全等同于知道会存在一个值。如果有人修改了Adder以返回一个列表,而我们没有检查这种可能性并采取适当的措施,那么Perl堆栈最终将处于不一致的状态。这是你绝对不想发生的。

  4. POPi宏在这里用于从堆栈中弹出返回值。在这种情况下,我们想要一个整数,所以使用了POPi

    以下是可用的所有POP宏的完整列表,以及它们返回的类型。

    POPs	SV
    POPp	pointer (PV)
    POPpbytex   pointer to bytes (PV)
    POPn	double (NV)
    POPi	integer (IV)
    POPu        unsigned integer (UV)
    POPl	long
    POPul       unsigned long

    由于这些宏具有副作用,因此不要将它们用作可能多次评估其参数的宏的参数,例如

    /* Bad idea, don't do this */
    STRLEN len;
    const char *s = SvPV(POPs, len);

    相反,使用一个临时变量

    STRLEN len;
    SV *sv = POPs;
    const char *s = SvPV(sv, len);

    或一个保证只评估其参数一次的宏

    STRLEN len;
    const char *s = SvPVx(POPs, len);
  5. 最后的PUTBACK用于在退出函数之前将Perl堆栈置于一致状态。这是必要的,因为当我们使用POPi从堆栈中弹出返回值时,它只更新了我们堆栈指针的本地副本。请记住,PUTBACK将全局堆栈指针设置为与我们的本地副本相同。

返回一个值列表

现在,让我们扩展前面的示例,以返回参数的总和和差。

以下是Perl子例程

sub AddSubtract
{
   my($a, $b) = @_;
   ($a+$b, $a-$b);
}

这是C函数

static void
call_AddSubtract(a, b)
int a;
int b;
{
    dSP;
    int count;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sv_2mortal(newSViv(a)));
    PUSHs(sv_2mortal(newSViv(b)));
    PUTBACK;

    count = call_pv("AddSubtract", G_LIST);

    SPAGAIN;

    if (count != 2)
        croak("Big trouble\n");

    printf ("%d - %d = %d\n", a, b, POPi);
    printf ("%d + %d = %d\n", a, b, POPi);

    PUTBACK;
    FREETMPS;
    LEAVE;
}

如果call_AddSubtract像这样调用

call_AddSubtract(7, 4);

那么输出如下

7 - 4 = 3
7 + 4 = 11

注意

  1. 我们想要列表上下文,所以使用了G_LIST。

  2. 不出所料,POPi这次被使用了两次,因为我们从堆栈中检索了2个值。需要注意的是,在使用POP*宏时,它们是从堆栈中以反向顺序弹出的。

在标量上下文中返回列表

假设上一节中的 Perl 子例程在标量上下文中被调用,如下所示

static void
call_AddSubScalar(a, b)
int a;
int b;
{
    dSP;
    int count;
    int i;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sv_2mortal(newSViv(a)));
    PUSHs(sv_2mortal(newSViv(b)));
    PUTBACK;

    count = call_pv("AddSubtract", G_SCALAR);

    SPAGAIN;

    printf ("Items Returned = %d\n", count);

    for (i = 1; i <= count; ++i)
        printf ("Value %d = %d\n", i, POPi);

    PUTBACK;
    FREETMPS;
    LEAVE;
}

另一个修改是,call_AddSubScalar 将打印从 Perl 子例程返回的项目数量及其值(为简单起见,它假设它们是整数)。因此,如果调用 call_AddSubScalar

call_AddSubScalar(7, 4);

那么输出将是

Items Returned = 1
Value 1 = 3

在这种情况下,需要注意的主要点是,只有列表中的最后一个项目从子例程返回。AddSubtract 实际上回到了 call_AddSubScalar

通过参数列表从 Perl 返回数据

也可以通过参数列表直接返回值——是否真正需要这样做是另一回事。

下面的 Perl 子例程 Inc 接受 2 个参数并直接递增每个参数。

sub Inc
{
    ++ $_[0];
    ++ $_[1];
}

这是一个调用它的 C 函数。

    static void
    call_Inc(a, b)
    int a;
    int b;
    {
        dSP;
        int count;
        SV * sva;
        SV * svb;

        ENTER;
        SAVETMPS;

        sva = sv_2mortal(newSViv(a));
        svb = sv_2mortal(newSViv(b));

        PUSHMARK(SP);
        EXTEND(SP, 2);
        PUSHs(sva);
        PUSHs(svb);
        PUTBACK;

        count = call_pv("Inc", G_DISCARD);

        if (count != 0)
            croak ("call_Inc: expected 0 values from 'Inc', got %d\n",
                   count);

        printf ("%d + 1 = %d\n", a, SvIV(sva));
        printf ("%d + 1 = %d\n", b, SvIV(svb));

	FREETMPS;
	LEAVE;
    }

为了能够访问从 call_pv 返回后压入堆栈的两个参数,有必要记下它们的地址——因此有两个变量 svasvb

之所以需要这样做,是因为当控制权从 call_pv 返回时,保存它们的 Perl 堆栈区域很可能已经被其他内容覆盖。

使用 G_EVAL

现在,使用 G_EVAL 的示例。下面是一个 Perl 子例程,它计算其 2 个参数的差值。如果这会导致负结果,则子例程将调用 die

sub Subtract
{
    my ($a, $b) = @_;

    die "death can be fatal\n" if $a < $b;

    $a - $b;
}

以及一些调用它的 C 代码

static void
call_Subtract(a, b)
int a;
int b;
{
    dSP;
    int count;
    SV *err_tmp;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sv_2mortal(newSViv(a)));
    PUSHs(sv_2mortal(newSViv(b)));
    PUTBACK;

    count = call_pv("Subtract", G_EVAL|G_SCALAR);

    SPAGAIN;

    /* Check the eval first */
    err_tmp = ERRSV;
    if (SvTRUE(err_tmp))
    {
        printf ("Uh oh - %s\n", SvPV_nolen(err_tmp));
        POPs;
    }
    else
    {
      if (count != 1)
       croak("call_Subtract: wanted 1 value from 'Subtract', got %d\n",
             count);

        printf ("%d - %d = %d\n", a, b, POPi);
    }

    PUTBACK;
    FREETMPS;
    LEAVE;
}

如果 call_Subtract 被这样调用

call_Subtract(4, 5)

将打印以下内容

Uh oh - death can be fatal

注意

  1. 我们希望能够捕获 die,因此我们使用了 G_EVAL 标志。不指定此标志意味着程序将在子例程 Subtract 中的 die 语句处立即终止。

  2. 代码

    err_tmp = ERRSV;
    if (SvTRUE(err_tmp))
    {
        printf ("Uh oh - %s\n", SvPV_nolen(err_tmp));
        POPs;
    }

    等效于这段 Perl 代码

    print "Uh oh - $@\n" if $@;

    PL_errgv 是一个类型为 GV * 的 Perl 全局变量,它指向包含错误的符号表条目。因此,ERRSV 指的是 $@ 的 C 等价物。我们使用一个局部临时变量 err_tmp,因为 ERRSV 是一个调用函数的宏,而 SvTRUE(ERRSV) 最终会多次调用该函数。

  3. 请注意,在 SvTRUE(err_tmp) 为真的块中,使用 POPs 弹出堆栈。这是必要的,因为每当使用 G_EVAL|G_SCALAR 调用的 call_* 函数返回错误时,堆栈顶部都会保存值 undef。因为我们希望程序在检测到此错误后继续执行,所以必须通过删除 undef 来清理堆栈。

使用 G_KEEPERR

考虑这个相当滑稽的例子,我们在析构函数中使用了上面 call_Subtract 例子的 XS 版本

    package Foo;
    sub new { bless {}, $_[0] }
    sub Subtract {
        my($a,$b) = @_;
        die "death can be fatal" if $a < $b;
        $a - $b;
    }
    sub DESTROY { call_Subtract(5, 4); }
    sub foo { die "foo dies"; }

    package main;
    {
	my $foo = Foo->new;
	eval { $foo->foo };
    }
    print "Saw: $@" if $@;             # should be, but isn't

这个例子将无法识别 eval {} 内部发生的错误。原因如下:call_Subtract 代码在 Perl 清理临时变量时退出外部大括号块时执行,并且由于 call_Subtract 使用 G_EVAL 标志通过 call_pv 实现,因此它立即重置了 $@。这会导致对 $@ 的最外层测试失败,从而导致错误陷阱失败。

附加 G_KEEPERR 标志,以便 call_Subtract 中的 call_pv 调用读取

count = call_pv("Subtract", G_EVAL|G_SCALAR|G_KEEPERR);

将保留错误并恢复可靠的错误处理。

使用 call_sv

在我之前的所有示例中,我都“硬编码”了从 C 调用的 Perl 子例程的名称。但是,大多数情况下,能够从 Perl 脚本中指定 Perl 子例程的名称会更方便,并且您需要使用 call_sv

考虑下面的 Perl 代码

sub fred
{
    print "Hello there\n";
}

CallSubPV("fred");

这是一个定义 CallSubPV 的 XSUB 片段。

    void
    CallSubPV(name)
    	char *	name
    	CODE:
	PUSHMARK(SP);
	call_pv(name, G_DISCARD|G_NOARGS);

就目前而言,这很好。问题是,Perl 子例程只能指定为字符串,但是,Perl 允许对子例程和匿名子例程进行引用。这就是 call_sv 有用的地方。

下面 CallSubSV 的代码与 CallSubPV 相同,只是 name 参数现在定义为 SV*,我们使用 call_sv 而不是 call_pv

    void
    CallSubSV(name)
    	SV *	name
    	CODE:
	PUSHMARK(SP);
	call_sv(name, G_DISCARD|G_NOARGS);

因为我们使用 SV 来调用 fred,所以以下所有内容都可以使用

CallSubSV("fred");
CallSubSV(\&fred);
$ref = \&fred;
CallSubSV($ref);
CallSubSV( sub { print "Hello there\n" } );

如您所见,call_sv 使您在指定 Perl 子例程的方式上具有更大的灵活性。

您应该注意,如果需要存储与 Perl 子例程相对应的 SV(上面示例中的 name),以便稍后在程序中使用它,仅仅存储指向 SV 的指针的副本是不够的。假设上面的代码是这样的

    static SV * rememberSub;

    void
    SaveSub1(name)
    	SV *	name
    	CODE:
	rememberSub = name;

    void
    CallSavedSub1()
    	CODE:
	PUSHMARK(SP);
	call_sv(rememberSub, G_DISCARD|G_NOARGS);

这样做是错误的,因为当您在 CallSavedSub1 中使用指针 rememberSub 时,它可能仍然指向在 SaveSub1 中记录的 Perl 子例程,也可能不指向。对于以下情况尤其如此

SaveSub1(\&fred);
CallSavedSub1();

SaveSub1( sub { print "Hello there\n" } );
CallSavedSub1();

当上面每个SaveSub1语句执行完毕后,与参数对应的 SV* 将不再存在。预计 Perl 会出现以下形式的错误消息

Can't use an undefined value as a subroutine reference at ...

对于每行CallSavedSub1

类似地,对于这段代码

$ref = \&fred;
SaveSub1($ref);
$ref = 47;
CallSavedSub1();

您可能会收到以下其中一条消息(实际收到的消息取决于您使用的 Perl 版本)

Not a CODE reference at ...
Undefined subroutine &main::47 called ...

变量 $ref 在调用SaveSub1时可能引用了子程序fred,但当CallSavedSub1被调用时,它现在保存了数字47。因为我们只在SaveSub1中保存了指向原始 SV 的指针,所以对 $ref 的任何更改都将由指针rememberSub跟踪。这意味着,无论何时调用CallSavedSub1,它都会尝试执行由 SV* rememberSub 引用的代码。在这种情况下,它现在引用了整数47,因此预计 Perl 会发出强烈抱怨。

这段代码展示了一个类似但更微妙的问题

$ref = \&fred;
SaveSub1($ref);
$ref = \&joe;
CallSavedSub1();

这次,无论何时调用CallSavedSub1,它都会执行 Perl 子程序joe(假设它存在),而不是SaveSub1调用中最初请求的fred

为了解决这些问题,有必要对 SV 进行完整复制。下面的代码展示了修改后的SaveSub2,用于执行此操作。

    /* this isn't thread-safe */
    static SV * keepSub = (SV*)NULL;

    void
    SaveSub2(name)
        SV *	name
    	CODE:
     	/* Take a copy of the callback */
    	if (keepSub == (SV*)NULL)
    	    /* First time, so create a new SV */
	    keepSub = newSVsv(name);
    	else
    	    /* Been here before, so overwrite */
	    SvSetSV(keepSub, name);

    void
    CallSavedSub2()
    	CODE:
	PUSHMARK(SP);
	call_sv(keepSub, G_DISCARD|G_NOARGS);

为了避免每次调用SaveSub2时都创建一个新的 SV,该函数首先检查它是否已被调用过。如果没有,则会分配一个新的 SV 的空间,并将对 Perl 子程序name的引用复制到变量keepSub中,使用newSVsv一次性完成操作。此后,无论何时调用SaveSub2,现有的 SV keepSub 都会使用SvSetSV被新的值覆盖。

注意:使用静态或全局变量存储 SV 不是线程安全的。您可以使用 "perlxs 中的“安全存储静态数据” 文档中描述的 MY_CXT 机制,该机制速度很快,或者使用 get_sv() 将值存储在 Perl 全局变量中,这要慢得多。

使用 call_argv

这是一个 Perl 子例程,它打印传递给它的所有参数。

sub PrintList
{
    my(@list) = @_;

    foreach (@list) { print "$_\n" }
}

这是一个使用 call_argv 调用 PrintList 的示例。

static char * words[] = {"alpha", "beta", "gamma", "delta", NULL};

static void
call_PrintList()
{
    call_argv("PrintList", G_DISCARD, words);
}

请注意,在这种情况下不需要调用 PUSHMARK。这是因为 call_argv 会为您执行此操作。

使用 call_method

考虑以下 Perl 代码

{
    package Mine;

    sub new
    {
        my($type) = shift;
        bless [@_]
    }

    sub Display
    {
        my ($self, $index) = @_;
        print "$index: $$self[$index]\n";
    }

    sub PrintID
    {
        my($class) = @_;
        print "This is Class $class version 1.0\n";
    }
}

它实现了一个非常简单的类来管理数组。除了构造函数 new 之外,它还声明了方法,一个静态方法和一个虚拟方法。静态方法 PrintID 只打印类名和版本号。虚拟方法 Display 打印数组中的单个元素。以下是一个使用它的全 Perl 示例。

$a = Mine->new('red', 'green', 'blue');
$a->Display(1);
Mine->PrintID;

将打印

1: green
This is Class Mine version 1.0

从 C 调用 Perl 方法相当简单。需要以下内容

这是一个简单的 XSUB,它说明了从 C 调用 PrintIDDisplay 方法的机制。

void
call_Method(ref, method, index)
    SV *	ref
    char *	method
    int		index
    CODE:
    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(ref);
    PUSHs(sv_2mortal(newSViv(index)));
    PUTBACK;

    call_method(method, G_DISCARD);

void
call_PrintID(class, method)
    char *	class
    char *	method
    CODE:
    PUSHMARK(SP);
    XPUSHs(sv_2mortal(newSVpv(class, 0)));
    PUTBACK;

    call_method(method, G_DISCARD);

因此,可以像这样调用 PrintIDDisplay 方法

$a = Mine->new('red', 'green', 'blue');
call_Method($a, 'Display', 1);
call_PrintID('Mine', 'PrintID');

唯一需要注意的是,在静态方法和虚拟方法中,方法名不是通过堆栈传递的,而是用作 call_method 的第一个参数。

使用 GIMME_V

这是一个简单的 XSUB,它打印当前执行的上下文。

void
PrintContext()
    CODE:
    U8 gimme = GIMME_V;
    if (gimme == G_VOID)
        printf ("Context is Void\n");
    else if (gimme == G_SCALAR)
        printf ("Context is Scalar\n");
    else
        printf ("Context is Array\n");

以下是一些 Perl 代码来测试它。

PrintContext;
$a = PrintContext;
@a = PrintContext;

该代码的输出将是

Context is Void
Context is Scalar
Context is Array

使用 Perl 处理临时变量

在迄今为止给出的示例中,回调中创建的任何临时变量(即传递给 call_* 函数堆栈的参数或通过堆栈返回的值)都已通过以下方法之一释放

还有一种方法可以使用,即让 Perl 在回调结束后重新获得控制权时自动执行此操作。这可以通过在回调中不使用以下内容来实现:

ENTER;
SAVETMPS;
...
FREETMPS;
LEAVE;

序列(当然,也不指定 G_DISCARD 标志)。

如果您要使用此方法,则必须注意在非常特定的情况下可能会出现内存泄漏。为了解释这些情况,您需要了解 Perl 和回调例程之间控制流的一些知识。

文档开头给出的示例(错误处理程序和事件驱动程序)是您在回调中可能遇到的两种主要控制流类型的典型代表。它们之间存在非常重要的区别,请注意。

在第一个示例中,错误处理程序,控制流可能如下。您已创建了一个与外部库的接口。控制可以像这样到达外部库

perl --> XSUB --> external library

当控制在库中时,发生了错误条件。您之前已设置了一个 Perl 回调来处理这种情况,因此它将被执行。回调完成后,控制将返回到 Perl。以下是这种情况下的控制流

perl --> XSUB --> external library
                  ...
                  error occurs
                  ...
                  external library --> call_* --> perl
                                                      |
perl <-- XSUB <-- external library <-- call_* <----+

使用 call_* 完成错误处理后,控制几乎立即返回到 Perl。

在图中,您越往右走,范围嵌套的越深。只有当控制回到图的最左侧的 perl 时,您才会回到封闭范围,并且您留下的任何临时变量都将被释放。

在第二个示例中,事件驱动程序,控制流将更像这样

perl --> XSUB --> event handler
                  ...
                  event handler --> call_* --> perl
                                                   |
                  event handler <-- call_* <----+
                  ...
                  event handler --> call_* --> perl
                                                   |
                  event handler <-- call_* <----+
                  ...
                  event handler --> call_* --> perl
                                                   |
                  event handler <-- call_* <----+

在这种情况下,控制流可能仅包含重复的序列

event handler --> call_* --> perl

实际上在程序的整个持续时间内。这意味着控制可能永远不会返回到最左侧的 Perl 中的周围范围。

那么大问题是什么呢?好吧,如果您期望 Perl 为您清理这些临时变量,您可能要等很久了。为了让 Perl 处理您的临时变量,控制必须在某个阶段返回到封闭范围。在事件驱动的场景中,这可能永远不会发生。这意味着随着时间的推移,您的程序将创建越来越多的临时变量,这些临时变量永远不会被释放。由于每个临时变量都会消耗一些内存,因此您的程序最终将消耗系统中所有可用的内存——砰!

所以底线是——如果您确定控制将在回调结束后的相当短的时间内返回到封闭的 Perl 范围,那么您不必显式地处理您可能创建的任何临时变量。请注意,如果您对该怎么做有任何疑问,清理一下也无妨。

存储回调上下文信息的策略

在设计回调接口时,最棘手的问题之一可能是弄清楚如何存储 C 回调函数和 Perl 等效函数之间的映射关系。

为了帮助理解为什么这会是一个真正的问题,首先考虑一下在全 C 环境中如何设置回调。通常,C API 会提供一个函数来注册回调。该函数会期望一个指向函数的指针作为其参数之一。下面是调用一个假设函数 register_fatal 的示例,该函数注册了在发生致命错误时要调用的 C 函数。

register_fatal(cb1);

单个参数 cb1 是指向函数的指针,因此您必须在代码中定义 cb1,例如:

static void
cb1()
{
    printf ("Fatal Error\n");
    exit(1);
}

现在将其更改为调用 Perl 子例程:

static SV * callback = (SV*)NULL;

static void
cb1()
{
    dSP;

    PUSHMARK(SP);

    /* Call the Perl sub to process the callback */
    call_sv(callback, G_DISCARD);
}


void
register_fatal(fn)
    SV *	fn
    CODE:
    /* Remember the Perl sub */
    if (callback == (SV*)NULL)
        callback = newSVsv(fn);
    else
        SvSetSV(callback, fn);

    /* register the callback with the external library */
    register_fatal(cb1);

其中 register_fatal 的 Perl 等效函数及其注册的回调 pcb1 可能如下所示:

# Register the sub pcb1
register_fatal(\&pcb1);

sub pcb1
{
    die "I'm dying...\n";
}

C 回调和 Perl 等效函数之间的映射存储在全局变量 callback 中。

如果您只需要在任何时候注册一个回调,这将足够。一个例子可能是像上面草拟的代码那样的错误处理程序。但请记住,对 register_fatal 的重复调用会用新的回调函数替换先前注册的回调函数。

例如,假设您想与允许异步文件 I/O 的库进行交互。在这种情况下,您可能能够在每次读取操作完成后注册一个回调。为了发挥作用,我们希望能够为打开的每个文件调用单独的 Perl 子例程。就目前而言,上面的错误处理程序示例将不足以满足要求,因为它只允许在任何时候定义一个回调。我们需要的是一种方法来存储打开的文件和我们希望为该文件调用的 Perl 子例程之间的映射关系。

假设 I/O 库有一个函数 asynch_read,它将 C 函数 ProcessRead 与文件句柄 fh 关联在一起 - 这假设它还提供了一些例程来打开文件并获取文件句柄。

asynch_read(fh, ProcessRead)

这可能需要这种形式的 C ProcessRead 函数:

void
ProcessRead(fh, buffer)
int	fh;
char *	buffer;
{
     ...
}

为了提供一个 Perl 接口到这个库,我们需要能够在 fh 参数和我们想要调用的 Perl 子程序之间进行映射。哈希是一个方便的机制来存储这种映射。下面的代码展示了一个可能的实现。

static HV * Mapping = (HV*)NULL;

void
asynch_read(fh, callback)
    int	fh
    SV *	callback
    CODE:
    /* If the hash doesn't already exist, create it */
    if (Mapping == (HV*)NULL)
        Mapping = newHV();

    /* Save the fh -> callback mapping */
    hv_store(Mapping, (char*)&fh, sizeof(fh), newSVsv(callback), 0);

    /* Register with the C Library */
    asynch_read(fh, asynch_read_if);

以及 asynch_read_if 可以像这样。

static void
asynch_read_if(fh, buffer)
int	fh;
char *	buffer;
{
    dSP;
    SV ** sv;

    /* Get the callback associated with fh */
    sv =  hv_fetch(Mapping, (char*)&fh , sizeof(fh), FALSE);
    if (sv == (SV**)NULL)
        croak("Internal error...\n");

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sv_2mortal(newSViv(fh)));
    PUSHs(sv_2mortal(newSVpv(buffer, 0)));
    PUTBACK;

    /* Call the Perl sub */
    call_sv(*sv, G_DISCARD);
}

为了完整起见,这里有 asynch_close。这展示了如何从哈希 Mapping 中删除条目。

void
asynch_close(fh)
    int	fh
    CODE:
    /* Remove the entry from the hash */
    (void) hv_delete(Mapping, (char*)&fh, sizeof(fh), G_DISCARD);

    /* Now call the real asynch_close */
    asynch_close(fh);

所以 Perl 接口看起来像这样。

sub callback1
{
    my($handle, $buffer) = @_;
}

# Register the Perl callback
asynch_read($fh, \&callback1);

asynch_close($fh);

C 回调和 Perl 之间的映射这次存储在全局哈希 Mapping 中。使用哈希具有明显的优势,因为它允许注册无限数量的回调。

如果 C 回调提供的接口不包含允许文件句柄到 Perl 子程序映射的参数怎么办?比如在异步 I/O 包中,回调函数只传递 buffer 参数,像这样。

void
ProcessRead(buffer)
char *	buffer;
{
    ...
}

没有文件句柄,就没有直接的方法从 C 回调映射到 Perl 子程序。

在这种情况下,解决这个问题的一个可能方法是预定义一系列 C 函数作为 Perl 的接口,因此。

#define MAX_CB		3
#define NULL_HANDLE	-1
typedef void (*FnMap)();

struct MapStruct {
    FnMap    Function;
    SV *     PerlSub;
    int      Handle;
  };

static void  fn1();
static void  fn2();
static void  fn3();

static struct MapStruct Map [MAX_CB] =
    {
        { fn1, NULL, NULL_HANDLE },
        { fn2, NULL, NULL_HANDLE },
        { fn3, NULL, NULL_HANDLE }
    };

static void
Pcb(index, buffer)
int index;
char * buffer;
{
    dSP;

    PUSHMARK(SP);
    XPUSHs(sv_2mortal(newSVpv(buffer, 0)));
    PUTBACK;

    /* Call the Perl sub */
    call_sv(Map[index].PerlSub, G_DISCARD);
}

static void
fn1(buffer)
char * buffer;
{
    Pcb(0, buffer);
}

static void
fn2(buffer)
char * buffer;
{
    Pcb(1, buffer);
}

static void
fn3(buffer)
char * buffer;
{
    Pcb(2, buffer);
}

void
array_asynch_read(fh, callback)
    int		fh
    SV *	callback
    CODE:
    int index;
    int null_index = MAX_CB;

    /* Find the same handle or an empty entry */
    for (index = 0; index < MAX_CB; ++index)
    {
        if (Map[index].Handle == fh)
            break;

        if (Map[index].Handle == NULL_HANDLE)
            null_index = index;
    }

    if (index == MAX_CB && null_index == MAX_CB)
        croak ("Too many callback functions registered\n");

    if (index == MAX_CB)
        index = null_index;

    /* Save the file handle */
    Map[index].Handle = fh;

    /* Remember the Perl sub */
    if (Map[index].PerlSub == (SV*)NULL)
        Map[index].PerlSub = newSVsv(callback);
    else
        SvSetSV(Map[index].PerlSub, callback);

    asynch_read(fh, Map[index].Function);

void
array_asynch_close(fh)
    int	fh
    CODE:
    int index;

    /* Find the file handle */
    for (index = 0; index < MAX_CB; ++ index)
        if (Map[index].Handle == fh)
            break;

    if (index == MAX_CB)
        croak ("could not close fh %d\n", fh);

    Map[index].Handle = NULL_HANDLE;
    SvREFCNT_dec(Map[index].PerlSub);
    Map[index].PerlSub = (SV*)NULL;

    asynch_close(fh);

在这种情况下,函数 fn1fn2fn3 用于记住要调用的 Perl 子程序。每个函数都包含一个单独的硬编码索引,该索引在函数 Pcb 中用于访问 Map 数组并实际调用 Perl 子程序。

这种技术有一些明显的缺点。

首先,代码比前面的例子复杂得多。

其次,对可以同时存在的回调数量有一个硬编码限制(在本例中为 3)。增加限制的唯一方法是修改代码以添加更多函数,然后重新编译。尽管如此,只要仔细选择函数数量,它仍然是一个可行的解决方案,在某些情况下是唯一可用的解决方案。

总结一下,这里有一些你可以考虑用于存储 C 和 Perl 回调之间映射的可能方法。

1. 忽略问题 - 只允许 1 个回调

对于很多情况,比如与错误处理程序接口,这可能是一个完全足够的解决方案。

2. 创建回调序列 - 硬编码限制

如果无法从 C 回调传递回来的参数中判断上下文是什么,那么你可能需要创建一个 C 回调接口函数序列,并将指向每个函数的指针存储在一个数组中。

3. 使用参数映射到 Perl 回调

哈希是存储 C 和 Perl 之间映射的理想机制。

备用堆栈操作

虽然我仅使用了POP*宏来访问从 Perl 子例程返回的值,但也可以绕过这些宏并使用ST宏读取堆栈(有关ST宏的完整描述,请参阅perlxs)。

大多数情况下,POP*宏应该足够了;它们的主要问题是它们强制你按顺序处理返回的值。在某些情况下,这可能不是处理值的最佳方式。我们想要的是能够以随机顺序访问堆栈。在编写 XSUB 时使用的ST宏非常适合此目的。

下面的代码是在"返回值列表"部分中给出的示例,使用ST而不是POP*重新编码。

static void
call_AddSubtract2(a, b)
int a;
int b;
{
    dSP;
    I32 ax;
    int count;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(sv_2mortal(newSViv(a)));
    PUSHs(sv_2mortal(newSViv(b)));
    PUTBACK;

    count = call_pv("AddSubtract", G_LIST);

    SPAGAIN;
    SP -= count;
    ax = (SP - PL_stack_base) + 1;

    if (count != 2)
        croak("Big trouble\n");

    printf ("%d + %d = %d\n", a, b, SvIV(ST(0)));
    printf ("%d - %d = %d\n", a, b, SvIV(ST(1)));

    PUTBACK;
    FREETMPS;
    LEAVE;
}

注意

  1. 请注意,有必要定义变量ax。这是因为ST宏期望它存在。如果我们在 XSUB 中,则不需要定义ax,因为它已经为我们定义了。

  2. 代码

    SPAGAIN;
    SP -= count;
    ax = (SP - PL_stack_base) + 1;

    设置堆栈,以便我们可以使用ST宏。

  3. 与该示例的原始编码不同,返回的值不是以相反的顺序访问的。因此,ST(0)指的是 Perl 子例程返回的第一个值,而ST(count-1)指的是最后一个值。

在 C 中创建和调用匿名子例程

正如我们已经展示的那样,call_sv可以用来调用匿名子例程。但是,我们的示例展示了一个 Perl 脚本调用 XSUB 来执行此操作。让我们看看如何在我们的 C 代码中完成它

...

SV *cvrv
   = eval_pv("sub {
               print 'You will not find me cluttering any namespace!'
              }", TRUE);

...

call_sv(cvrv, G_VOID|G_NOARGS);

eval_pv用于编译匿名子例程,它也将是返回值(有关eval_pv的更多信息,请参阅"eval_pv" in perlapi)。一旦获得此代码引用,就可以将其与我们之前展示的所有示例混合使用。

轻量级回调

有时你需要重复调用同一个子例程。这通常发生在对值列表执行操作的函数中,例如 Perl 的内置排序函数 sort()。你可以将比较函数传递给 sort(),然后它将对需要比较的每一对值进行调用。来自List::Util 的 first() 和 reduce() 函数遵循类似的模式。

在这种情况下,可以使用轻量级回调 API 来加速例程(通常会大幅加速)。其理念是,调用上下文只需要创建和销毁一次,并且可以在两者之间任意多次调用子例程。

通常使用全局变量传递参数(通常是 $_ 用于一个参数,或者 $a 和 $b 用于两个参数),而不是通过 @_。(如果你知道自己在做什么,可以使用 @_ 机制,尽管目前还没有支持的 API。它本身也比较慢。)

宏调用的模式如下

    dMULTICALL;			/* Declare local variables */
    U8 gimme = G_SCALAR;	/* context of the call: G_SCALAR,
				 * G_LIST, or G_VOID */

    PUSH_MULTICALL(cv);		/* Set up the context for calling cv,
				   and set local vars appropriately */

    /* loop */ {
        /* set the value(s) af your parameter variables */
        MULTICALL;		/* Make the actual call */
    } /* end of loop */

    POP_MULTICALL;		/* Tear down the calling context */

有关一些具体的示例,请参阅 List::Util 1.18 中 first() 和 reduce() 函数的实现。在那里您还会找到一个头文件,它在旧版本的 perl 上模拟了 multicall API。

另请参阅

perlxsperlgutsperlembed

作者

Paul Marquess

特别感谢以下人员在文档创建过程中提供的帮助。

Jeff Okamoto、Tim Bunce、Nick Gianniotis、Steve Kelem、Gurusamy Sarathy 和 Larry Wall。

日期

最后更新于 perl 5.23.1。