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;
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;
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"
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;
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
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
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');
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
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 });
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);
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 });
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);
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 });
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);
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)
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:
As far as I can tell you also leak references to the SVs you return, for example with items:
If I make the returned SVs mortal:
You can handle the UTF8 issue by passing a negative length for UTF8 to hv_exists() etc but this gets messy rapidly:
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:
resulting in:
Of course, since you always set the key you can simplify this further by just asking hv_fetch_ent() for an lvalue:
which saves creating a new
SVt_IV
SV when the hash entry exists.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?
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: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.
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