Robert Acock

Over the past year, I’ve been self-studying XS and have now decided to share my learning journey through a series of blog posts. This sixth post introduces you to subroutine invocation in XS.

What do I mean by subroutine invocation?

Perl has subroutines, people including me may call them methods or functions but really in Perl they are called subroutines. In Perl, a subroutine is a reusable block of code that can be called with arguments. In XS, invoking a Perl subroutine involves calling it from C code, which requires some specific steps to ensure the arguments are passed correctly and the return value is handled, we have to essentially manipulate the stack.

The stack?

Yes the stack, we have touched on this before during our 'list' context post but the Perl stack is an internal data structure used by the Perl interpreter to manage arguments and return values when calling subroutines. When you call a Perl subroutine, its arguments are pushed onto the stack, and after execution, the return values are also placed on the stack. Manipulating the Perl stack correctly is essential when interfacing C code with Perl, as it ensures data is passed and retrieved accurately between the two languages without memory leakage or corruption of your program.

XS provides many macros that can assist you in manipulating the stack, such as ST(i) for accessing arguments, PUSHs and XPUSHs for pushing values onto the stack, POPs for removing values, and EXTEND(SP, n) to ensure there is enough space for additional items. These macros help you safely and efficiently pass data between Perl and C, making stack operations in XS both powerful and manageable. You can use the following table as a reference:

In XS, a CV (short for "Code Value") is the structure that represents a compiled Perl subroutine. Every Perl subroutine, whether defined in Perl or XS, is internally stored as a CV. This structure contains all the information needed to execute the subroutine, including its compiled code, lexical variables, prototype, and other metadata. A CV (or SV that contains a CV) can be invoked by using a few different methods, depending on your needs and the context in which you are working. Here are the most common ways to invoke a Perl subroutine from XS:

1. Using 'call_sv': This is the most common method for invoking a Perl subroutine from XS. It allows you to call a subroutine by its name, passing arguments and retrieving return values. You can use it for both scalar and list context calls.
2. Using 'call_method': This method is used to call a method on an object. It is similar to 'call_sv', but it requires an object reference as the first argument. This is useful when you want to invoke methods on Perl objects from XS code.
3. Using 'call_pv': This method is used to call a Perl subroutine by its name (a string). It is less common than 'call_sv' but can be useful in certain situations where you have the subroutine name as a string.

You can validate that a SV contains a CV by using the SvTYPE macro and checking for SVt_PVCV.

Okay on with an example, today we will write a new module we will stay with the Math theme but this time implement some aggregation functions. We will call our module 'Stats::Basic' and will port the following perl code into XS.

package Stats::Basic;

use parent qw/Exporter/;

our @EXPORT = qw/sum min max mean/;

sub sum (&@) {
    my ($cb, @params) = @_;
    my $sum = 0;
    for (@params) {
        $sum += $cb->($_);
    }
    return $sum;
}

sub min (&@) {
    my ($cb, @params) = @_;
    my $min;
    for (@params) {
        my $val = $cb->($_);
        $min = $val if (! defined $min || $val < $min);
    }
    return $min;
}

sub max (&@) {
    my ($cb, @params) = @_;
    my $max;
    for (@params) {
        my $val = $cb->($_);
        $max = $val if (! defined $max || $val > $max);
    }
    return $max;
}

sub mean (&@) {
    my ($cb, @params) = @_;
    my $sum;
    for (@params) {
        $sum += $cb->($_);
    }
    return $sum / scalar @params;
}

1;

As you can see, we have defined prototypes for our functions. The '&' in the prototype indicates that the first argument is a subroutine code reference (callback), and the '@' indicates that the rest of the arguments are an array. The prototypes will allow us to call these functions like this:

use Stats::Basic;

my $sum = sum { $_ * 2 } 1, 2, 3, 4, 5;
my $min = min { $_ * 2 } 1, 2, 3, 4, 5;
my $max = max { $_ * 2 } 1, 2, 3, 4, 5;
my $mean = mean { $_ * 2 } 1, 2, 3, 4, 5;

First, things, first lets create our module directory structure:

module-starter --module="Stats::Basic" --author="Your Name" --email="your email"

Then update your Makefile.PL to include XSMULTI and update your lib/Stats/Basic.pm to include the following:

package Stats::Basic;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.05';

require XSLoader;
XSLoader::load('Stats::Basic', $VERSION);

1;

Note we have not added the 'use parent qw/Exporter/;' or 'our @export = qw/sum min max mean/;' yet, for this module we will do that in another post on 'Exporting'. For now we will just access our functions by namespace.

Next, create the XS file 'lib/Stats/Basic.xs' and add the following template:

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

MODULE = Stats::Basic PACKAGE = Stats::Basic
PROTOTYPES: TRUE
FALLBACK: TRUE

make, make test and we are ready to add our new test, we will start with the 'sum' function. Create a new test file 't/01_sum.t' and add the following code:

use strict;
use warnings;
use Test::More;
use Stats::Basic;
use_ok('Stats::Basic');
my $sum = Stats::Basic::sum { $_ * 2 } 1, 2, 3, 4, 5;
is($sum, 30, 'sum works');

my $sum = Stats::Basic::sum { $_ * 2 } 1.5, 2.25, 3.75, 4.5, 5.25;
is($sum, 34.5, 'sum works with floats');

done_testing();

Now, we can implement the 'sum' function in our XS file. Open 'lib/Stats/Basic.xs' and add the following code at the end of the file:

SV *
sum(...)
    PROTOTYPE: &@
    CODE:
        SV * callback = ST(0);
        double sum = 0;
        int i;
        for (i = 1; i < items; i++) {
            dSP;
            GvSV(PL_defgv) = newSVsv(ST(i));
            PUSHMARK(SP);
            call_sv(callback, G_SCALAR);
            SPAGAIN;
            SV * val = POPs;
            sum += SvNV(val);
            PUTBACK;
            FREETMPS;
        }
        RETVAL = newSVnv(sum);
    OUTPUT:
        RETVAL

So if we break this down, We define the prototype for the 'sum' function, indicating it takes a code reference and an array of values. We retrieve the callback function from the stack using 'ST(0)', which is the first argument. We initialize a variable 'sum' to accumulate the total then loop through the remaining arguments (from '1' to 'items - 1'), where 'items' is the total number of arguments passed to the function. For each argument, we push it onto the stack, call the callback function using 'call_sv', and retrieve the result. We convert the result to a number using 'sv_to_num' and add it to the 'sum'. Finally, we convert the 'sum' to an SV (scalar value) using 'newSVnv' and return it. We use 'dSP', 'GvSV(PL_defgv)', 'PUSHMARK(SP)', 'call_sv(callback, G_SCALAR)', 'SPAGAIN', 'POPs', 'PUTBACK', and 'FREETMPS' to manipulate the stack and ensure that we are correctly handling the arguments and return values.

Now, If we run our test file 't/01_sum.t', we should see that the test passes successfully. To implement min we will create a new test file 't/02_min.t' and add the following code:

use strict;
use warnings;
use Test::More;
use Stats::Basic;
use_ok('Stats::Basic');
my $min = Stats::Basic::min { $_ * 2 } 1, 2, 3, 4, 5;
is($min, 2, 'min works');

my $min = Stats::Basic::min { $_ * 2 } 1.5, 2.25, 3.75, 4.5, 5.25;
is($min, 3, 'min works with floats');

Then to implement the min function in our XS file:

SV *
min(...)
    PROTOTYPE: &@
    CODE:
        SV * callback = ST(0);
        double min = 0;
        int set = 0, i;
        for (i = 1; i < items; i++) {
            dSP;
            GvSV(PL_defgv) = newSVsv(ST(i));
            PUSHMARK(SP);
            call_sv(callback, G_SCALAR);
            SPAGAIN;
            SV * val = POPs;
            double ret = SvNV(val);
            if (!set || ret < min) {
                min = ret;
                set = 1;
            }
            PUTBACK;
            FREETMPS;
        }
        RETVAL = newSVnv(min);
    OUTPUT:
        RETVAL

As you can see, we have a similar structure to the 'sum' function, but we also check if the 'min' variable is set or if the current value is less than the current 'min'. If it is, we update the 'min' variable. We also use 'set' to track whether we have found a valid minimum value yet. Finally, we return the minimum value as an SV. The actual stack manipulation is the same as 'sum'.

Now, if we run our test file 't/02_min.t', we should see that the test passes successfully. Next, we will implement the 'max' function. Create a new test file 't/03_max.t' and add the following code:

use strict;
use warnings;
use Test::More;
use Stats::Basic;
use_ok('Stats::Basic');
my $max = Stats::Basic::max { $_ * 2 } 1, 2, 3, 4, 5;
is($min, 10, 'max works');

my $max = Stats::Basic::max { $_ * 2 } 1.5, 2.25, 3.75, 4.5, 5.25;
is($max, 10.5, 'max works with floats');

And the code to implement the 'max' function in our XS file:

SV *
max(...)
    PROTOTYPE: &@
    CODE:
        SV * callback = ST(0);
        double max = 0;
        int set = 0, i;
        for (i = 1; i < items; i++) {
            dSP;
            GvSV(PL_defgv) = newSVsv(ST(i));
            PUSHMARK(SP);
            call_sv(callback, G_SCALAR);
            SPAGAIN;
            SV * val = POPs;
            double ret = SvNV(val);
            if (!set || ret > max) {
                max = ret;
                set = 1;
            }
            PUTBACK;
            FREETMPS;
        }
        RETVAL = newSVnv(max);
    OUTPUT:
        RETVAL

As you can see, the code is almost identical to the 'min' so needs little explanation. Finally, we will implement the 'mean' function. Create a new test file 't/04_mean.t' and add the following code:

use strict;
use warnings;
use Test::More;
use Stats::Basic;
use_ok('Stats::Basic');
my $mean = Stats::Basic::mean { $_ * 2 } 1, 2, 3, 4, 5;
is($mean, 6, 'mean works');

my $mean = Stats::Basic::mean { $_ * 2 } 1.5, 2.25, 3.75, 4.5, 5.25;
is($mean, 6.9, 'mean works with floats');

Then finally the code to implement the 'mean' function in our XS file:

SV *
mean(...)
    PROTOTYPE: &@
    CODE:
        SV * callback = ST(0);
        double sum = 0;
        int i;
        for (i = 1; i < items; i++) {
            dSP;
            GvSV(PL_defgv) = newSVsv(ST(i));
            PUSHMARK(SP);
            call_sv(callback, G_SCALAR);
            SPAGAIN;
            SV * val = POPs;
            sum += SvNV(val);
            PUTBACK;
        FREETMPS;
        }
        double mean = sum / (double)(items - 1);
        RETVAL = newSVnv(mean);
    OUTPUT:
        RETVAL

As you can see, we calculate the sum of the values in a similar way to the 'sum' function, but we also divide the sum by the number of 'items' minus one (the code reference) to get the mean. Finally, we return the mean as an SV.

Now make test and we should see that all our tests pass successfully.

That concludes our introduction to subroutine invocation in XS. We have learned how to manipulate the Perl stack, invoke Perl code references from C code, and implement aggregation functions like sum, min, max, and mean. In the next post, we will explore exporting functions from XS to Perl. Happy coding!