Perl Gerl

It is my pleasure to announce that after much fooling around with XS, I am now reading temperatures from the device with Perl.

ok 1 - use Vernier::GoTemp;
ok 2 - The object isa Vernier::GoTemp
# 27.4995159422979
# 27.4995159422979

That is the ambient temperature in Celsius.

Update: My ten-year-old son and I had a grand time measuring temperatures under our armpits, behind our knees, in front of the fan, and in glasses of ice, lukewarm and warm water.

Today I belatedly discovered the usefulness of Devel::Peek.

While hacking on the newly-rebaptised Vernier::GoIO I found that get_device_info was handing me back garbage. Using Devel::Peek helped me pinpoint the problem more quickly.

get_device_info should return an array consisting of device name, vendor ID and product ID; the former is a string in hex and the latter integers required by HID USB.

Devel::Peek to the rescue. At the top of Vernier/GoIO.pm:

use Devel::Peek qw(Dump);


and in the offending routine, a strategically-placed call to Dump:

sub get_device_info {

    my $handle = shift;

    my @info = Sensor_GetOpenDeviceName($handle);

    Dump(\@info);

    die "No device info found for $handle!" unless @info;

    return (
        'name'       =>  $info[0],
        'vendor_id'  =>  $info[1],
        'product_id' =>  $info[2],
    );
}

Running a test nets me this output:

SV = RV(0x82603c) at 0x86590c
  REFCNT = 1
  FLAGS = (TEMP,ROK)
  RV = 0x8633bc
  SV = PVAV(0x864684) at 0x8633bc
    REFCNT = 2
    FLAGS = (PADBUSY,PADMY)
    IV = 0
    NV = 0
    ARRAY = 0x30b9e0
    FILL = 2
    MAX = 3
    ARYLEN = 0x0
    FLAGS = (REAL)
    Elt No. 0
    SV = PV(0x849ad4) at 0x866074
      REFCNT = 1
      FLAGS = (POK,pPOK)
      PV = 0x304eb0 "0x1d100000"
      CUR = 10
      LEN = 12
    Elt No. 1
    SV = IV(0x80d3ac) at 0x865954
      REFCNT = 1
      FLAGS = (IOK,pIOK)
      IV = 8388740
    Elt No. 2
    SV = IV(0x80d380) at 0x8660c8
      REFCNT = 1
      FLAGS = (IOK,pIOK)
      IV = 8388740

An array ref with three elements. Looks good. But those last two values? Not what I had in mind. I should get 2295 and 2, respectively.

perlguts gave me a clue:

Despite their suggestions in earlier versions of this document the macros (X)PUSH[iunp] are not suited to XSUBs which return multiple results. For that, either stick to the (X)PUSHs macros shown above, or use the new m(X)PUSH[iunp] macros instead; see “Putting a C value on Perl stack”.

I’d pushed three scalars on the stack, the first using the macro XPUSHs and the next two with XPUSHi:

            XPUSHs(sv_2mortal(newSVpv(name, strlen(name))));
            XPUSHi(sv_2mortal(newSViv(vendorId)));
            XPUSHi(sv_2mortal(newSViv(productId)));

I changed the XPUSHi to XPUSHs as advised by perlguts, re(generated|compiled|tested) and lo! correct return values.

SV = RV(0x82603c) at 0x86590c
  REFCNT = 1
  FLAGS = (TEMP,ROK)
  RV = 0x8633bc
  SV = PVAV(0x864684) at 0x8633bc
    REFCNT = 2
    FLAGS = (PADBUSY,PADMY)
    IV = 0
    NV = 0
    ARRAY = 0x30b9e0
    FILL = 2
    MAX = 3
    ARYLEN = 0x0
    FLAGS = (REAL)
    Elt No. 0
    SV = PV(0x849ad4) at 0x866074
      REFCNT = 1
      FLAGS = (POK,pPOK)
      PV = 0x304eb0 "0x1d100000"
      CUR = 10
      LEN = 12
    Elt No. 1
    SV = IV(0x80d334) at 0x865954
      REFCNT = 1
      FLAGS = (IOK,pIOK)
      IV = 2295
    Elt No. 2
    SV = IV(0x80d3ac) at 0x8660c8
      REFCNT = 1
      FLAGS = (IOK,pIOK)
      IV = 2

perlguts has this to say about why those two integer values were identical:

The following code will not do what you think:

 XPUSHi(10);
 XPUSHi(20);

This translates as “set TARG to 10, push a pointer to TARG onto the stack; set TARG to 20, push a pointer to TARG onto the stack”. At the end of the operation, the stack does not contain the values 10 and 20, but actually contains two pointers to TARG, which we have set to 20.

Okay then. Point taken, and mental note made to study
“Putting a C Value on the Perl Stack” more closely.

Today’s XS problem was solved with a tweak of the typemap.

I wrote a constructor for the Go! Temp device class Vernier::GoTemp that, amongst other things, ‘opens’ the device; that is, establishes communications with and initializes it.

The C prototype is

GOIO_DLL_INTERFACE_DECL GOIO_SENSOR_HANDLE GoIO_Sensor_Open(
        const char *pDeviceName,        
        gtype_int32 vendorId,   
        gtype_int32 productId,  
        gtype_int32   strictDDSValidationFlag);

and the XSUB is

GOIO_SENSOR_HANDLE
GoIO_Sensor_Open(pDeviceName, vendorId, productId, strictDDSValidationFlag)
        const char *    pDeviceName
        gtype_int32     vendorId
        gtype_int32     productId
        gtype_int32     strictDDSValidationFlag

The make test error I got was

pDeviceName is not of type const charPtr at /Users/zrusilla/proj/goio/Vernier/blib/lib/Vernier/GoIO.pm line 150.

The device name is a hexadecimal number 0x1d100000, so I thought the integer part of the scalar was being passed long to the XSUB, which howled in protest. How to fix? With a tweak of the typemap.

The previous entry for a const char *was
const char * T_PTROBJ

The typemap documentation tells me:

T_PTROBJ
Similar to T_PTRREF except that the reference is blessed into a class. This allows the pointer to be used as an object. Most commonly used to deal with C structs. The typemap checks that the perl object passed into the XS routine is of the correct class (or part of a subclass).

The pointer is blessed into a class that is derived from the name of type of the pointer but with all ‘*’ in the name replaced with ‘Ptr’.

Ah, so that’s the problem. When the C header says char *, it means char *. So I changed the typemap entry to a T_PV, which is a plain old char *:

const char * T_PV

rebuilt and tested. And all tests pass.

Back to the GoIO project.

I’ve got a C subroutine

gtype_int32 GoIO_GetNthAvailableDeviceName(
        char *pBuf,  //[out] ptr to buffer to store device name string.
        gtype_int32 bufSize,  //[in] number of bytes in pBuf
        gtype_int32 vendorId, //[in] USB vendor id
        gtype_int32 productId, //[in] USB product id
        gtype_int32 N);   //[in] index into list of known devices
                                 // 0 => first device in list.

that I wish to call from Perl as:

my $name = GetNthAvailableDeviceName(vendorID, productID);

dispensing with the need to pass in a string buffer. The XSUB to do this is:

NO_OUTPUT gtype_int32
GoIO_GetNthAvailableDeviceName(gtype_int32 vendorId, gtype_int32 productId)
    PREINIT:
        char s[GOIO_MAX_SIZE_DEVICE_NAME];
        gtype_int32 found;
    PPCODE:
        found = GoIO_GetNthAvailableDeviceName(s, GOIO_MAX_SIZE_DEVICE_NAME, vendorId, productId, 0);
        printf("%d\n", found);
        printf("%s\n", s);
        if (found == 0) {
            EXTEND(SP, 1);
            PUSHs(sv_2mortal(newSVpv(s, GOIO_MAX_SIZE_DEVICE_NAME)));
        }

The test passes, returning the device name in glorious hexadecimal:
t/05_available_device….# 0x1d100000

Exciting stuff, huh?

I think I’ll go watch some grass grow now.

h2xs minus the -A argument should generate code to turn C #define macros and enums into constants accessible by Perl. Yet I could not access the enum from Perl.

The file const-c generated by ExtUtils::Constant contains C routines to determine which value to return for a given string.

  case 'N':
    if (memEQ(name, "VERNIER_DEFAULT_VENDOR_ID", 25)) {
      *iv_return = VERNIER_DEFAULT_VENDOR_ID;
      return PERL_constant_ISIV;
    }

It’s looking for a #define VERNIER_DEFAULT_VENDOR_ID some place. But there was none to be found. Why?

After much messing around with h2xs I turned to Google and found I was not alone. Alexander Kolbasov wrote an excellent blog post on his difficulties with generating constants from enums.

I decided to cut out the ExtUtils::Constant middleman altogether and define the constants in GoIO.xs, as he suggests. I removed the line

INCLUDE const-xs.inc

and added a new section, taking the opportunity to give the constants friendly names:

PROTOTYPES: ENABLE
#
# Define any constants that need to be exported.  By doing it this way we can
# avoid the overhead of using the DynaLoader package, and in addition constants
# defined using this mechanism are eligible for inlining by the perl
# interpreter at compile time.
#
BOOT:
{
    HV *stash;
    stash = gv_stashpv("GoIO", TRUE);
    newCONSTSUB(stash, "VernierID",            newSViv(VERNIER_DEFAULT_VENDOR_ID));
    newCONSTSUB(stash, "LabPro",               newSViv(LABPRO_DEFAULT_PRODUCT_ID));
    newCONSTSUB(stash, "GoTemp",               newSViv(USB_DIRECT_TEMP_DEFAULT_PRODUCT_ID));
    newCONSTSUB(stash, "GoLink",               newSViv(SKIP_DEFAULT_PRODUCT_ID));
    newCONSTSUB(stash, "GoMotion",             newSViv(CYCLOPS_DEFAULT_PRODUCT_ID));
    newCONSTSUB(stash, "LabQuest",             newSViv(NGI_DEFAULT_PRODUCT_ID));
    newCONSTSUB(stash, "CKSpectrometer",       newSViv(LOWCOST_SPEC_DEFAULT_PRODUCT_ID));
    newCONSTSUB(stash, "MiniGasChromatograph", newSViv(MINI_GC_DEFAULT_PRODUCT_ID));
}

I also removed the entire ExtUtils::Const section from the Makefile.PL.

In lib/GoIO.pm I trimmed all the autoloading code and made the new constant names exportable.

I added a test, t/03_const.t


use strict;
use warnings;
use Test::More tests => 8;

use GoIO;
is (VernierID, 0x08F7);
is (LabPro, 1);
is (GoTemp, 2);
is (GoLink, 3);
is (GoMotion, 4);
is (LabQuest, 5);
is (CKSpectrometer, 6);
is (MiniGasChromatograph, 7);

I regenerated the whole chimichanga, ran make test and lo! I have constants.

On to the next hurdle.

The next subroutine I tackled was UpdateListOfAvailableDevices. Its C protoype is:

GOIO_DLL_INTERFACE_DECL gtype_int32 GoIO_UpdateListOfAvailableDevices(
    gtype_int32 vendorId, //[in]
    gtype_int32 productId); //[in]

and its XSUB is

gtype_int32
GoIO_UpdateListOfAvailableDevices(vendorId, productId)
    gtype_int32 vendorId
    gtype_int32 productId

    OUTPUT:
        RETVAL

So what is this vendorId and productId? They are required by the USB protocol to identify the vendor and device. For the Vernier devices they are defined in GVernierUSB.h:


//Constants used by the USB protocol to identify our devices:
enum { VERNIER_DEFAULT_VENDOR_ID = 0x08F7 };

enum { LABPRO_DEFAULT_PRODUCT_ID = 0x0001,
       USB_DIRECT_TEMP_DEFAULT_PRODUCT_ID = 0x0002, //aka GoTemp
       SKIP_DEFAULT_PRODUCT_ID = 0x0003,      //aka GoLink
       CYCLOPS_DEFAULT_PRODUCT_ID = 0x0004,   //aka GoMotion
       NGI_DEFAULT_PRODUCT_ID = 0x0005,       //aka LabQuest
       LOWCOST_SPEC_DEFAULT_PRODUCT_ID = 0x0006, //aka CK Spectrometer
       MINI_GC_DEFAULT_PRODUCT_ID = 0x0007, //aka Vernier Mini Gas Chromatograph
       STANDALONE_DAQ_DEFAULT_PRODUCT_ID = 0x0008
};

h2xs is supposed to generate constants, but I saw none. After some poking about I learned the problem was the -A flag. This suppresses creation of constants from enums as well as the autoload.

Not wanting to clobber my existing module, I hopped over to /tmp and reran h2xs without -A and with GVernierUSB.h:


h2xs -a -n GoIO -x include/GoIO_DLL_interface.h include/GVernierUSB.h -lGoIO_DLL -p GoIO_


This time I got constant definitions in my Makefile.PL:

 

if  (eval {require ExtUtils::Constant; 1}) {
  # If you edit these definitions to change the constants used by this module,
  # you will need to use the generated const-c.inc and const-xs.inc
  # files to replace their "fallback" counterparts before distributing your
  # changes.
  my @names = (qw(FTDI_GENERIC_PRODUCT_ID FTDI_GENERIC_VENDOR_ID
         GOIO_MAX_SIZE_DEVICE_NAME LABPRO_DEFAULT_PRODUCT_ID
         LABQUEST_DEFAULT_PRODUCT_ID
         NATIONAL_INSTRUMENTS_DEFAULT_VENDOR_ID
         OCEAN_OPTICS_DEFAULT_PRODUCT_ID OCEAN_OPTICS_DEFAULT_VENDOR_ID
         OCEAN_OPTICS_HR4000_PRODUCT_ID OCEAN_OPTICS_USB2000_PRODUCT_ID
         OCEAN_OPTICS_USB325_PRODUCT_ID OCEAN_OPTICS_USB4000_PRODUCT_ID
         OCEAN_OPTICS_USB650_PRODUCT_ID SENSORDAQ_DEFAULT_PRODUCT_ID
         SKIP_TIMEOUT_MS_DEFAULT SKIP_TIMEOUT_MS_READ_DDSMEMBLOCK
         SKIP_TIMEOUT_MS_WRITE_DDSMEMBLOCK
         USB_DIRECT_TEMP_DEFAULT_PRODUCT_ID VERNIER_DEFAULT_VENDOR_ID
         aka));
  ExtUtils::Constant::WriteConstants(
                                     NAME         => 'GoIO',
                                     NAMES        => \@names,
                                     DEFAULT_TYPE => 'IV',
                                     C_FILE       => 'const-c.inc',
                                     XS_FILE      => 'const-xs.inc',
                                  );

}
else {
  use File::Copy;
  use File::Spec;
  foreach my $file ('const-c.inc', 'const-xs.inc') {
    my $fallback = File::Spec->catfile('fallback', $file);
    copy ($fallback, $file) or die "Can't copy $fallback to $file: $!";
  }
}

I gingerly copied this section into my existing Makefile.PL.  

The build will generate two files, const-c.inc and const-xs.inc. I added references to them in GoIO.xs thusly:

#include

#include "const-c.inc"

MODULE = GoIO PACKAGE = GoIO PREFIX = GoIO_

INCLUDE: const-xs.inc

I created a ‘constants’ entry in the %EXPORT_TAGS hash in lib/GoIO.pm to export all the constants at once:

constants => [ qw(
FTDI_GENERIC_PRODUCT_ID
FTDI_GENERIC_VENDOR_ID
GOIO_MAX_SIZE_DEVICE_NAME
LABPRO_DEFAULT_PRODUCT_ID
LABQUEST_DEFAULT_PRODUCT_ID
NATIONAL_INSTRUMENTS_DEFAULT_VENDOR_ID
OCEAN_OPTICS_DEFAULT_PRODUCT_ID
OCEAN_OPTICS_DEFAULT_VENDOR_ID
OCEAN_OPTICS_HR4000_PRODUCT_ID
OCEAN_OPTICS_USB2000_PRODUCT_ID
OCEAN_OPTICS_USB325_PRODUCT_ID
OCEAN_OPTICS_USB4000_PRODUCT_ID
OCEAN_OPTICS_USB650_PRODUCT_ID
SENSORDAQ_DEFAULT_PRODUCT_ID
SKIP_TIMEOUT_MS_DEFAULT
SKIP_TIMEOUT_MS_READ_DDSMEMBLOCK
SKIP_TIMEOUT_MS_WRITE_DDSMEMBLOCK
USB_DIRECT_TEMP_DEFAULT_PRODUCT_ID
VERNIER_DEFAULT_VENDOR_ID
)],

And make this tag exportable:

our @EXPORT_OK = (
@{ $EXPORT_TAGS{'constants'} },
);

I wrote a test, and it failed. Why? We’ll find out tomorrow.

References:

Discussion on constants on perl-xs mailing list.
Alexander Kolbasov mentions an alternative to ExtUtils::Constant.

Next thing I tried was calling one of GoIO’s subroutines from Perl. I chose GoIO_GetDLLVersion, which fetches the major and minor version of the library.

Here’s the subroutine declaration in include/GoIO_DLL_interface.h:

GOIO_DLL_INTERFACE_DECL gtype_int32 GoIO_GetDLLVersion(
gtype_uint16 *pMajorVersion, //[o]
gtype_uint16 *pMinorVersion); //[o]

And here’s the generated XSUB in GoIO.xs:

gtype_int32
GoIO_GetDLLVersion(pMajorVersion, pMinorVersion)
gtype_uint16 * pMajorVersion
gtype_uint16 * pMinorVersion

It takes two unsigned int pointers and returns an int with 0 for success and -1 for failure. That’s not very Perly, so I fixed it up. I made it croak upon failure and return the major and minor version, as follows:

NO_OUTPUT gtype_int32
GoIO_GetDLLVersion(OUTLIST gtype_uint16 pMajorVersion, OUTLIST gtype_uint16 pMinorVersion)
POSTCALL:
if (RETVAL != 0)
croak("Error %d while retrieving GoIO library version");

NO_OUTPUT means don’t return the C function return value.
OUTLIST means return these parameters from the Perl wrapper.
POSTCALL is an XS macro that adds some code after the C function call.

You’ll notice that the parameters are not specified as pointers. The perlxs documentation mentions

Parameters preceded by OUTLIST /IN_OUTLIST /OUT /IN_OUT keywords are considered to be used by the C subroutine via pointers

I added GetDLLVersion to the @EXPORT array in lib/GoIO.pm, then created a test:


$ vi t/01_dll_version.t

use Test::More tests => 2;
use GoIO;

my ($major, $minor) = GetDLLVersion();
ok($major);
ok($minor);


I then rebuilt and tested:


$ make test
PERL_DL_NONLAZY=1 /opt/local/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/01_dll_version....ok
t/GoIO..............ok
All tests successful.
Files=2, Tests=3, 0 wallclock secs ( 0.07 cusr + 0.03 csys = 0.10 CPU)


I love it when tests pass, don’t you?

I had a look at the new module:

$ cd GoIO
$ ls
Changes MANIFEST README lib t
GoIO.c Makefile blib pm_to_blib typemap
GoIO.xs Makefile.PL fallback ppport.h

Full of things I don’t quite grok yet. But that’s okay.

I copied the GoIO headers to the new module.

$ cp -rp path/to/include GoIO

and edited the GoIO.xs file accordingly:

#include "include/GoIO_DLL_interface.h"
Now to take a good look at the GoIO.xs file.

I only need XSUBs for the routines defined in GoIO_DLL_interface, but I seem to have XSUBs defined for every header.

This struck me as a good moment to put everything into version control. I stuffed the project into a git repository and returned to editing.

I only wanted to keep the XSUBs defined under module and package GoIO:

MODULE = GoIO PACKAGE = GoIO PREFIX = GoIO_

I skipped down to the next package, GSkipWriteI2CMemParams, and deleted everything thereafter.

I then tried building.

$ perl Makefile.PL
$ make
/opt/local/bin/perl /opt/local/lib/perl5/5.8.8/ExtUtils/xsubpp -typemap /opt/local/lib/perl5/5.8.8/ExtUtils/typemap -typemap typemap GoIO.xs > GoIO.xsc && mv GoIO.xsc GoIO.c
Please specify prototyping behavior for GoIO.xs (see perlxs manual)
cc -c -I. -I/opt/local/include -fno-common -DPERL_DARWIN -no-cpp-precomp -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include -I/opt/local/include -O3 -DVERSION=\"0.01\" -DXS_VERSION=\"0.01\" "-I/opt/local/lib/perl5/5.8.8/darwin-2level/CORE" GoIO.c
Running Mkbootstrap for GoIO ()
chmod 644 GoIO.bs
rm -f blib/arch/auto/GoIO/GoIO.bundle
LD_RUN_PATH="/usr/local/lib" env MACOSX_DEPLOYMENT_TARGET=10.3 cc -L/opt/local/lib -bundle -undefined dynamic_lookup -L/usr/local/lib GoIO.o -o blib/arch/auto/GoIO/GoIO.bundle \
-lGoIO_DLL \

chmod 755 blib/arch/auto/GoIO/GoIO.bundle
cp GoIO.bs blib/arch/auto/GoIO/GoIO.bs
chmod 644 blib/arch/auto/GoIO/GoIO.bs
Manifying blib/man3/GoIO.3

The request to specify prototyping behavior can be safely ignored.

How about test?

make test
PERL_DL_NONLAZY=1 /opt/local/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/GoIO....ok
All tests successful.
Files=1, Tests=1, 0 wallclock secs ( 0.04 cusr + 0.02 csys = 0.06 CPU)

I can use GoIO. That’s good to know.