January 2017 Archives

Send in a Perl aref to C, get back a Perl array (and using the generated XS)

This is a tutorial as much as it is a request for guidance from experienced XS/C/perlguts folks, as TIMTOWTDI, and in this case, likely, a better way.

This will show you how to pass a Perl array reference (aref) into a C function, convert the aref into a C array, work on it, then push it back onto the stack so the C function returns it as a Perl array.

It'll also show that although we bite off of Inline::C, the XS code it generates can be used in your distribution, even without the end-user needing Inline installed.

First, straight to the code. Comments inline for what's happening (or, at least, what I think is happening... feedback welcomed):

use warnings;
use strict;
use feature 'say';

use Inline 'Noclean';
use Inline 'C';

my $aref = [qw(1 2 3 4 5)];

# overwrite the existing aref to
# minimize memory usage

@$aref = aref_to_array($aref);

say $_ for @$aref;


__END__
__C__

void aref_to_array(SV* aref){

    // check if the param is an array reference...
    // die() if not

    if (! SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV){
        croak("not an aref\n");
    }

    // convert the array reference into a Perl array

    AV* chars = (AV*)SvRV(aref);

    // allocate for a C array, with the same number of
    // elements the Perl array has

    unsigned char buf[av_len(chars)+1];

    // convert the Perl array to a C array

    int i;

    for (i=0; i<sizeof(buf); i++){
        SV** elem = av_fetch(chars, i, 0);
        buf[i] = (unsigned char)SvNV(*elem);
    }

    // prepare the stack

    inline_stack_vars;
    inline_stack_reset;

    int x;

    for (x=0; x<sizeof(buf); x++){

        // extract elem, do stuff with it, 
        // then push to stack

        char* elem = buf[x];
        elem++;        

        inline_stack_push(sv_2mortal(newSViv(elem)));
    }

    // done!

    inline_stack_done;
}

We now get an _Inline directory created within the current working directory, which has a build/ dir and then a sub directory (or multiple, just look at the one with the most recent timestamp). Peek in there, and you'll see a file with an .xs extention. This is the file you want if you want to include your work into a real Perl distribution. This essentially allows one to utilize my favourite feature of Inline::C, which is to build XS code for us, without having to know any XS (or little XS) at all.

After I run the above example, I get this in the XS file (my comments removed):

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "INLINE.h"

void aref_to_array(SV* aref){

    if (! SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV){
        croak("not an aref\n");
    }

    AV* chars = (AV*)SvRV(aref);

    unsigned char buf[av_len(chars)+1];

    int i;

    for (i=0; i<sizeof(buf); i++){
        SV** elem = av_fetch(chars, i, 0);
        buf[i] = (unsigned char)SvNV(*elem);
    }

    inline_stack_vars;
    inline_stack_reset;

    int x;

    for (x=0; x<sizeof(buf); x++){

        char* elem = buf[x];
        elem++;        

        inline_stack_push(sv_2mortal(newSViv(elem)));
    }

    inline_stack_done;
}

MODULE = c_and_back_pl_f8ff  PACKAGE = main  

PROTOTYPES: DISABLE


void
aref_to_array (aref)
    SV *    aref
        PREINIT:
        I32* temp;
        PPCODE:
        temp = PL_markstack_ptr++;
        aref_to_array(aref);
        if (PL_markstack_ptr != temp) {
          /* truly void, because dXSARGS not invoked */
          PL_markstack_ptr = temp;
          XSRETURN_EMPTY; /* return empty stack */
        }
        /* must have used dXSARGS; list context implied */
        return; /* assume stack size is correct */

To note is the following line:

MODULE = c_and_back_pl_f8ff  PACKAGE = main

That dictates the name of the module you're creating the XS for. You'll want to change it to something like:

MODULE = My::Module  PACKAGE = My::Module

...then put that file in the root of your distribution, and add, into your distributions primary .pm module file:

require XSLoader;
XSLoader::load('My::Module', $VERSION);

Normally, the INLINE.h include can be removed, but because we're using some Inline functionality, we need to grab a copy of INLINE.h from somewhere and copy it into the root directory of our distribution so that everything compiles nicely. There's always a copy of it in the _Inline/build/* directory mentioned above. Providing this header file will allow users of your distribution that don't have Inline::C installed to use your module as if they did have it.

SPI bus access, analog in/out on the Raspberry Pi powered by Perl

Well, all of the learning and testing I've done with C, XS, managing bits, reading and understanding hardware datatsheets etc in the last few months is really starting to pay off, with a lot of kudos going out to many Perlers for providing guidance and help with my questions, particularly with XS and C.

We now have reliable, working Perl code to output and receive input analog signals on the Raspberry Pi. This example uses an MCP41010 digital potentiometer for the analog out, and an ADC1015 analog to digital converter for analog in. I still have two different ADCs to write code for, two more models of digital pots, and later this week I should be receiving my DACs (digital to analog converter), my GPS receiver chip, and my MCP3004/8 ADCs.

As a bonus, we also now have direct access to communicate on the SPI bus (as the potentiometer does), with RPi::SPI. I even learned (with help) how to pass a Perl array reference into a C function which gets converted into a C unsigned char *, and how to return a Perl array back from C (I'll write another blog post about these two actions in the coming days).

This setup doesn't really do much, but it's the base of what will eventually allow me to have a Pi in the corner that all it does is pull from github and continuously (and automatically!) run unit tests for the Pi software. However, with true analog output/inputs, there's a lot more a Pi can do.

The schematic and the breadboard layout for the setup.

Code:

use warnings;
use strict;

use RPi::WiringPi;

my $pi = RPi::WiringPi->new;

my $adc = $pi->adc;

my $cs = $pi->pin(18);
my $dpot = $pi->dpot($cs->num, 0);

$dpot->set(0);

print "\nValue, Output %\n\n";

for (0..255){

    if (($_ % 10) != 0 && $_ != 255){
        next;
    }

    $dpot->set($_);

    my $p = $adc->percent(0);

    print "$_/255: $p %\n";

    select(undef, undef, undef, 0.3);
}

print "\n\nOutput % at 127/255\n\n";

$dpot->set(127);

for (0..10){
    print $adc->percent(0) . " %\n";
    select(undef, undef, undef, 0.2);
}

$pi->cleanup;

All it does is switch to different taps (resistor level) on the digital pot which increases/decreases output voltage. The ADC's input pin (A0) is connected directly to the output of the pot, as is the LED, just so I can see visually the changes as well as receive them digitally via the software.

Output:

Value, Output %

0/255: 0.36 %
10/255: 4.24 %
20/255: 8.12 %
30/255: 12.00 %
40/255: 15.88 %
50/255: 19.76 %
60/255: 23.70 %
70/255: 27.58 %
80/255: 31.45 %
90/255: 35.33 %
100/255: 39.21 %
110/255: 43.09 %
120/255: 46.97 %
130/255: 50.85 %
140/255: 54.79 %
150/255: 58.61 %
160/255: 62.48 %
170/255: 66.42 %
180/255: 70.24 %
190/255: 74.12 %
200/255: 77.70 %
210/255: 81.21 %
220/255: 84.91 %
230/255: 88.67 %
240/255: 92.67 %
250/255: 96.97 %
255/255: 99.21 %


Output % at 127/255

49.70 %
49.70 %
49.70 %
49.70 %
49.70 %
49.70 %
49.70 %
49.70 %
49.76 %
49.76 %
49.70 %

Bit string manipulation made easy with Bit::Manip

I've been writing a lot of software lately that deals with direct hardware access (specifically analog and digital hardware for the Raspberry Pi). This means that I've had to learn some C, as well as get proficient with bit manipulation and the bitwise operators.

As part of my learning, I thought I'd write a module to do this bit manipulation for me, hence Bit::Manip was born. (There's also a Bit::Manip::PP for those who can't/don't want to use XS. It should be indexed shortly).

Here's a scenario based example of how the software can be used.

You have a 16-bit configuration register for a piece of hardware that you want to configure and send in. Here's the bit configuration

|<--------- 16-bit config register ---------->|
|                             |               |
|---------------------------------------------|
|                             |               |
|                             |               |
|<------Byte 1: Control------>|<-Byte0: Data->|
|                             |               |
|-----------------------------|---------------|
| 15 | 14 13 | 12 11 | 10 9 8 | 7 6 5 4 3 2 1 |
  __   _____   _____   ______   _____________
  ^      ^       ^        ^          ^
  |      |       |        |          |
START    |       |      UNUSED      DATA
      CHANNEL    |
              PIN SELECT

...and the bit configuration:

15:     Start conversation
        00 - do nothing
        01 - start conversation

14-13:  Channel selection
        00 - channel 0
        01 - channel 1
        11 - both channels

12-11: Pin selection
        00 - no pin
        01 - pin 1
        11 - pin 2

10-8:   Unused (Don't care bits)

7-0:    Data

Let's start out with a 16-bit word, and set the start bit. Normally, we'd pass in an actual value as the first param ($data), but we'll just set bit 15 on 0 to get our initial data.

my $data = bit_on(0, 15);

A couple of helper functions to verify that we indeed have a 16-bit integer, and that the correct bit was set:

say bit_count($data);
say bit_bin($data);

Output to ensure we're good.

16
1000000000000000

Now, we've got the conversation start bit set in our register, and we want to set the channel. Let's use both channels. For this, we need to set multiple bits at once. The datasheet says that the channel is at bits 14-13. Take the LSB (13), pass it along with the data to bit_set(), followed by the number of bits to update and as the last parameter, put the binary bit string that coincides with the option you want (0b11 for both channels):

# setting channel

my $bits_to_update = 2;
$data = bit_set($data, 13, $bits_to_update, 0b11);

# result: 1110000000000000

We'll use pin 1, and per the datasheet, that's 0b01 starting from bit 11:

# setting pin

$data = bit_set($data, 11, 2, 0b01);

# result: 1110100000000000

The next two bits are unused, so we'll ignore them, and set the data. Let's use 186 as the data value (10111010 in binary):

# setting data

$data = bit_set($data, 0, 8, 186);

# or: bit_set($data, 0, 8, 0b10111010);

# result: 1110100010111010

Now we realize that we made a mistake above. We don't want both channels after all, we want to use only channel 1 (value: 0b01). Since we know exactly which bit we need to disable (14), we can just turn it off:

$data = bit_off($data, 14);

# result: 1010100010111010

(You could also use bit_set() to reset the entire channel register bits (14-13) like we did above).

Let's verify that we've got the register configured correctly before we send it to the hardware. We use bit_get() for this. The 2nd and 3rd parameters are MSB and LSB respectively, and in this case, we only want the value from that single bit:

my $value = bit_get($data, 15, 15);
say bit_bin($value);

# result: 1

So yep, our start bit is set. Let's verify the rest:

# data

# (note no LSB param. We're reading from bit 7 through to 0. LSB defaults 
# to 0 if not sent in).

# since we readily know the data value in decimal (186), we don't need
# to worry about the binary representation

say bit_get($data, 7);

# result 186

# channel

say bit_bin(bit_get($data, 14, 13));

# result 1

# pin select

say bit_bin(bit_get($data, 12, 11));

# result 1

# ensure the unused bits weren't set

say bit_get($data, 10, 8);

So now we've set up all of our register bits, and confirmed it's ready to be sent to the hardware for processing.

About Steve Bertrand

user-pic Just Another Perl Hacker