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.
SOCIAL SHARE CARD GENERATOR