DEV Community

Cover image for Learning XS - List context
LNATION for LNATION

Posted on • Edited on

Learning XS - List context

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 third post introduces you to list context in XS.

What do I mean by list context?

In Perl, there are two main contexts in which a function can be called: scalar context and list context. Scalar context means that the function is expected to return a single value, while list context means that the function is expected to return a list of values.

In XS, list context is a bit more complex than scalar context. When a function is called in list context, it can return multiple values, so in XS you need to push each value onto the stack. This is done by manipulating ST and using the 'XSRETURN' macro, which takes the number of values to return as an argument. I will demonstrate how all of this works in our next example.

Today we are going to build a simple OO shopping list module. We will port the following perl code:

package Shopping::List;

sub new {
    my ($pkg, @args) = @_;
    my %list;
    $list{$_}++ for @args;
    return bless \%list, $pkg;
}

sub add {
    my ($self, @items) = @_;
    $self->{$_}++ for @items;
    return @items;
}

sub remove {
    my ($self, @items) = @_;
    my @deleted;
    push(@deleted, $_) && delete $self->{$_} for @items;
    return \@deleted;
}

sub items {
    my ($self) = @_;
    return %$self;
}

1;
Enter fullscreen mode Exit fullscreen mode

You can then call it like this:

use Shopping::List;
my $list = Shopping::List->new('apple', 'banana', 'carrot');
$list->add('date', 'eggplant', 'apple');
$list->remove('banana', 'carrot');
$list->items;
Enter fullscreen mode Exit fullscreen mode

As you can see, in Perl list context is simple, in XS we have to do a bit more work. Let’s start by creating a new distribution 'Shopping::List'. We again will use 'Module::Starter' to create the distribution structure:

module-starter --module="Shopping::List" --author="Your Name" --email="your email"
Enter fullscreen mode Exit fullscreen mode

Update the Makefile.PL to include XSMULTI => 1, and then open the generated Shopping/List.pm file to update the boiler plate code to the following:

package Shopping::List;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.01';

require XSLoader;
XSLoader::load('Shopping::List', $VERSION);

1;
Enter fullscreen mode Exit fullscreen mode

Next we will create the skeleton XS file. Create a new file called 'Shopping/List.xs' and add the following code:

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

MODULE = Shopping::List  PACKAGE = Shopping::List
PROTOTYPES: DISABLE

SV*
new(pkg, ...)
    SV * pkg
    CODE:
        HV *hash = newHV();
        RETVAL = sv_bless(newRV_noinc((SV*)hash), gv_stashsv(pkg, 0));
    OUTPUT:
        RETVAL
Enter fullscreen mode Exit fullscreen mode

When defining new we have defined pkg as a required variable and used the ... for optional arguments, this signals to perl that our method can be called in list context.

With that in place we can build the distribution to ensure everything is set up correctly:

perl Makefile.PL
make
make test
Enter fullscreen mode Exit fullscreen mode

Next lets write a quick test for the first method which we will implement, which is the 'new' method. Create a new file called 't/01-shopping-list.t':

use Test::More;

use Shopping::List;

my $list = Shopping::List->new('apple', 'banana', 'carrot');
is_deeply($list, { apple => 1, banana => 1, carrot => 1 }, 'Shopping list created with initial items');
Enter fullscreen mode Exit fullscreen mode

Now lets actually implement the method inside 'Shopping/List.xs' update new to:

SV*
new(pkg, ...)
    SV * pkg
    CODE:
        HV *hash = newHV();
        int i = 1;
        for (; i < items; i++) {
            SV *item = ST(i);
            if (SvTYPE((item)) < SVt_PVAV) {
                STRLEN retlen;
                char *key = SvPV(item, retlen);
                if (hv_exists(hash, key, retlen)) {
                    int current = SvIV(*hv_fetch(hash, key, retlen, 0));
                    hv_store(hash, key, retlen, newSViv(current + 1), 0);
                } else{
                    hv_store(hash, key, retlen, newSViv(1), 0);
                }
            }
        }
        RETVAL = sv_bless(newRV_noinc((SV*)hash), gv_stashsv(pkg, 0));
    OUTPUT:
        RETVAL
Enter fullscreen mode Exit fullscreen mode

If you now run the test again it will pass. What we are doing is using 'items', which is a special variable in XS that contains the number of items passed to the function. When iterating over the items, we start our count at 1 because 0 is pkg. Inside the for loop we check if the item is a string by using SvTYPE and checking whether its less than the value of an Array aka a scalar, and if it is, we then check if it already exists in the hash. If it does, we increment the count, otherwise we add it with a count of 1.

Next we will write another test for the 'add' method, which will return in list context the list which is passed.

my @added = $list->add('date', 'eggplant', 'apple');
is_deeply(\@added, ['date', 'eggplant', 'apple']);
is_deeply($list, { apple => 2, banana => 1, carrot => 1, date => 1, eggplant => 1 });
Enter fullscreen mode Exit fullscreen mode

And the code to implement this method in 'Shopping/List.xs':

SV*
add(self, ...)
    SV * self
    CODE:
        HV *hash = (HV*)SvRV(self);
        int i = 1;
        for (; i < items; i++) {
            SV *item = ST(i);
            if (SvTYPE((item)) < SVt_PVAV) {
                STRLEN retlen;
                char *key = SvPV(item, retlen);
                if (hv_exists(hash, key, retlen)) {
                    int current = SvIV(*hv_fetch(hash, key, retlen, 0));
                    hv_store(hash, key, retlen, newSViv(current + 1), 0);
                } else{
                    hv_store(hash, key, retlen, newSViv(1), 0);
                }
            }
            SvREFCNT_inc(item);
            ST(i - 1) = item;
        }

        XSRETURN(i - 1);
Enter fullscreen mode Exit fullscreen mode

If we step through this, we first get the hash reference from the self object, then we iterate over the items passed to the function. For each item, we check if it is a string and if it exists in the hash. If it does, we increment the count, otherwise we add it with a count of 1. After that, we increment the reference count of the item and move it one position left on the stack. Finally, we return the number of items pushed onto the stack using 'XSRETURN'. we use the variable 'i' - 1(pkg) as this is our total count of items processed. Note also we do not have an OUTPUT or RETVAL defined, this is not needed when returning a list context with XSRETURN. Now if you run the test again it will pass, so lets add another test for remove.

my @removed = $list->remove('banana', 'carrot');
is_deeply(\@removed, ['banana', 'carrot']);
is_deeply($list, { apple => 2, date => 1, eggplant => 1 });
Enter fullscreen mode Exit fullscreen mode

Then the code to implement this method in 'Shopping/List.xs':

SV*
remove(self, ...)
    SV * self
    CODE:
        HV *hash = (HV*)SvRV(self);
        int i = 1;
        for (; i < items; i++) {
            SV *item = ST(i);
            if (SvTYPE((item)) < SVt_PVAV) {
                STRLEN retlen;
                char *key = SvPV(item, retlen);
                if (hv_exists(hash, key, retlen)) {
                    hv_delete(hash, key, retlen, 0);
                }
            }
            SvREFCNT_inc(item);
            ST(i - 1) = item;
        }

        XSRETURN(i - 1);
Enter fullscreen mode Exit fullscreen mode

Again if we step through this, we first get the hash reference from the self object, then we iterate over the items passed to the function. For each item, we check if it is a string and if it exists in the hash. If it does, we delete it from the hash. After that, we increment the reference count of the item and move it one position left on the stack. Finally, we return the number of items pushed onto the stack using 'XSRETURN'.

Finally, lets add the items method test:

my %list = $list->items();
is_deeply(\%list, { apple => 2, date => 1, eggplant => 1 });
Enter fullscreen mode Exit fullscreen mode

We will take a slightly different approach this time, add this code to implement the items method in 'Shopping/List.xs':

SV*
items(self)
    SV * self
    CODE:
        POPs;
        HV *hash = (HV*)SvRV(self);
        HE *item;
        int count = hv_iterinit(hash);
        EXTEND(SP, count * 2);
        while ((item = hv_iternext(hash))) {
            SV *key = hv_iterkeysv(item);
            SV *value = hv_iterval(hash, item);
            SvREFCNT_inc(key);
            SvREFCNT_inc(value);
            PUSHs(key);
            PUSHs(value);
        }
        XSRETURN(count * 2);
Enter fullscreen mode Exit fullscreen mode

To explain this, we first pop the self object from the stack, then we get the hash reference from the self object. We then initialize an iterator for the hash and extend the stack to accommodate the number of items in the hash. We then iterate over each item in the hash, getting both the key and value, incrementing their reference counts, and pushing them onto the stack. Finally, we return the count of items multiplied by 2 (as we are returning both keys and values).

Now if you run the test again it will pass, and we have a fully functional shopping list module in XS that supports list context.

In the next blog I will cover overloading methods.

Top comments (5)

Collapse
 
tonycoz profile image
Tony Cook

Hi,

You're missing the * to dereference the result of hv_fetch() in the definition of new().

This code also mishandles UTF-8, some strings can have two representations, plain bytes (or Latin-1) and UTF-8, if I add the same name with both encodings here, I get two entries:

$ perl -CS -Mblib -MShopping::List -Mutf8 -E '$x = "Frischkäse"; utf8::downgrade(my $y = $x); my $s = Shopping::List->new($x, $y); say for $s->items'
Frischkäse
1
Frischkäse
1
Enter fullscreen mode Exit fullscreen mode

As far as I can tell you also leak references to the SVs you return, for example with items:

$ perl -CS -Mblib -MShopping::List -Mutf8 -E '$x = "Frischkäse"; utf8::downgrade(my $y = $x); system "ps -o sz $$"; for (1 .. 10_000_000) { my $s = Shopping::List->new($x, $y); $s->items; } system "ps -o sz $$"'
   SZ
57672
   SZ
215511
Enter fullscreen mode Exit fullscreen mode

If I make the returned SVs mortal:

-            PUSHs(key);
-            PUSHs(value);
+            PUSHs(sv_2mortal(key));
+            PUSHs(sv_2mortal(value));
Enter fullscreen mode Exit fullscreen mode
$ perl -CS -Mblib -MShopping::List -Mutf8 -E '$x = "Frischkäse"; utf8::downgrade(my $y = $x); system "ps -o sz $$"; for (1 .. 10_000_000) { my $s = Shopping::List->new($x, $y); $s->items; } system "ps -o sz $$"'
   SZ
57664
   SZ
57664
Enter fullscreen mode Exit fullscreen mode

You can handle the UTF8 issue by passing a negative length for UTF8 to hv_exists() etc but this gets messy rapidly:

                if (hv_exists(hash, key, SvUTF8(item) ? -retlen : retlen)) {
                    int current = SvIV(*hv_fetch(hash, key, SvUTF8(item) ? -retlen : retlen, 0));
                    hv_store(hash, key, SvUTF8(item) ? -retlen : retlen, newSViv(current + 1), 0);
                } else{
                    hv_store(hash, key, SvUTF8(item) ? -retlen : retlen, newSViv(1), 0);
                }
Enter fullscreen mode Exit fullscreen mode

though you can avoid the mess by assigning that ternary to a variable.

A simpler way is to use the _ent() variants of the functions:

            if (SvTYPE((item)) < SVt_PVAV) {
                if (hv_exists_ent(hash, item, 0)) {
                    int current = SvIV(HeVAL(hv_fetch_ent(hash, item, 0, 0)));
                    hv_store_ent(hash, item, newSViv(current + 1), 0);
                } else{
                    hv_store_ent(hash, item, newSViv(1), 0);
                }
            }
Enter fullscreen mode Exit fullscreen mode

resulting in:

$ perl -CS -Mblib -MShopping::List -Mutf8 -E '$x = "Frischkäse"; utf8::downgrade(my $y = $x); my $s = Shopping::List->new($x, $y); say for $s->items'
Frischkäse
2
Enter fullscreen mode Exit fullscreen mode

Of course, since you always set the key you can simplify this further by just asking hv_fetch_ent() for an lvalue:

            if (SvTYPE((item)) < SVt_PVAV) {
                HE *ent = hv_fetch_ent(hash, item, 1, 0);
                SV *val = HeVAL(ent);
                IV current = SvOK(val) ? SvIV(val) : 0;
                sv_setiv(val, current+1);
                SvSETMAGIC(val); // not really needed here though
            }
Enter fullscreen mode Exit fullscreen mode

which saves creating a new SVt_IV SV when the hash entry exists.

Collapse
 
lnation profile image
LNATION

Hi Tony, thanks for reading and making very relevant suggestions for improvements I have one question with sv_2mortal, When to (and when not to) use it?

Collapse
 
tonycoz profile image
Tony Cook

When you push SVs on the stack yourself you need to mortalize or otherwise ensure they're released.

If you return a single SV via RETVAL xsubpp will generate the sv_2mortal() for you, for example this code is generated for your new() method:

        RETVAL = sv_bless(newRV_noinc((SV*)hash), gv_stashsv(pkg, 0));
#line 186 "lib/Shopping/List.c"
        RETVAL = sv_2mortal(RETVAL);
        ST(0) = RETVAL;
    }
    XSRETURN(1);
Enter fullscreen mode Exit fullscreen mode
Collapse
 
fgasper profile image
Felipe Gasper

Thank you for this! It’s great to see more folks taking the plunge into XS and discussing their experiences. I believe one of Perl’s core maintainers actually intends to overhaul that part of Perl’s documentation soon, so these sorts of write-ups could be really useful shortly.

More to @tonycoz’s point: just avoid SvPV entirely unless you really need to optimize. For general use it’s far better to tell Perl’s API whether you want UTF-8 (e.g., SvPV_utf8 or bytes/Latin-1 (e.g. SvPV_bytes).

I wrote a post about this sometime ago.

Collapse
 
nathan_tarbert profile image
Nathan Tarbert

pretty cool seeing someone actually build all that out and pass tests bit by bit - you think learning in public like this makes stuff stick more long-term or nah