Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Passing integer pointer in XS?

by martin67 (Novice)
on Jul 18, 2016 at 14:49 UTC ( #1167975=perlquestion: print w/replies, xml ) Need Help??

martin67 has asked for the wisdom of the Perl Monks concerning the following question:

Hi, I've started to use XS for interfacing an existing C library. It works so far until I come to passing integer pointers. I could really use some help here... The C function is defined as
int WINAPI tdSensor( char * protocol, int protocolLen, char * model, int modelLen, int * id, int * dataTypes ) Use this function to iterate over all sensors. Iterate until TELLSTICK +_SUCCESS is not returned. Parameters: [out] protocol A by ref string where the protocol of the sensor +will be placed. [in] protocolLen The length of the protocol parameter. [out] model A by ref string where the model of the sensor will b +e placed. [in] modelLen The length of the model parameter. [out] id A by ref int where the id of the sensor will be placed. [out] dataTypes A by ref int with flags for the supported sensor + values. Returns: TELLSTICK_SUCCESS if there is more sensors to be fetched.
My definition in the XS file look like this:
int tdSensor(protocol, protocolLen, model, modelLen, id, dataTypes) char * protocol int protocolLen char * model int modelLen int * id int * dataTypes
I had to add a definition in my typedef file:
TYPEMAP int * T_PTR
But this doesn't work as I think it should. I've tried with T_PV and T_PTRREF but no luck. When I call the code from my test program it looks like this:
my $protocol = "aaaaaaaaaaaaaaaaaaaaaaaaa"; my $model = "bbbbbbbbbbbbbbbbbbbbbbbbb"; my $sensorId = 1; my $dataTypes = 2; while (TellStick::tdSensor($protocol, 25, $model, 25, $sensorId, $data +Types) == TELLSTICK_SUCCESS) { print "res: $res, protocol: $protocol, model: $model, sensorId: $sen +sorId, dataTypes: $dataTypes\n"; }
I'm not really sure how I should call the function from Perl. Trial and error gave me that I needed to set a value on the strings (protocl & model) before calling tdSensor. But this does not seem to work for the integer pointers. Or should I call them like '\$sensorID' instead?

It seems like it should be pretty trivial to pass a integer pointer so I hope to get some wisdom on how to do this from the Monks...

Replies are listed 'Best First'.
Re: Passing integer pointer in XS? (&)
by tye (Sage) on Jul 18, 2016 at 18:35 UTC

    Change all of those "int *" to "int &" and I suspect it will "just work".

    Update: Or, worst case, you might have to change the XS code to something like:

    int tdSensor(protocol, protocolLen, model, modelLen, id, dataTypes) char * protocol int protocolLen char * model int modelLen int & id int & dataTypes CODE: RETVAL = tdSensor(protocol, protocolLen, model, modelLen, &id, &da +taTypes);

    - tye        

      Thanks, But it still is a mystery... By using "int & " instead of "int *", the C-code looks alright and the C-function is called with the right parameters. But the value that the C-funtion writes to the int pointers are not passed back to perl.

      Example in the generated C-file:

      XS_EUPXS(XS_TellStick_tdSensor); /* prototype to pass -Wmissing-protot +ypes */ XS_EUPXS(XS_TellStick_tdSensor) { dVAR; dXSARGS; if (items != 6) croak_xs_usage(cv, "protocol, protocolLen, model, modelLen, id, d +ataTypes"); { char * protocol = (char *)SvPV_nolen(ST(0)) ; int protocolLen = (int)SvIV(ST(1)) ; char * model = (char *)SvPV_nolen(ST(2)) ; int modelLen = (int)SvIV(ST(3)) ; int id = (int)SvIV(ST(4)) ; int dataTypes = (int)SvIV(ST(5)) ; int RETVAL; dXSTARG; printf("id1: %d\n", id); RETVAL = tdSensor(protocol, protocolLen, model, modelLen, &id, &da +taTypes); printf("id2: %d\n", id); XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); }
      I added two printf for debugging (best debug tool...) and when I run it with like this:
      ... my $sensorId = 1; TellStick::tdSensor($protocol, 25, $model, 25, $sensorId, $dataTypes); print "protocol: $protocol, model: $model, sensorId: $sensorId, dataT +ypes: $dataTypes\n"; I get the output id1: 1 id2: 51 protocol: mandolyn, model: temperaturehumidity, sensorId: 1, dataTypes +: 2
      So it gets the correct value (51), but that is not passed back.

      It looks like the XS code only sees the id parameter as an input value (casting it right), but no output is generated (except the return value). The string arguments (protocol, model), seems to work in modifying what the value is pointing to.

      Should I somehow use "int *" in the XS anyway, but writing some special code for INPUT/OUTPUT in the typemap? Or is there some other way of returing the correct value?

        So, you'll need to add just a bit more:

        int tdSensor(protocol, protocolLen, model, modelLen, id, dataTypes) char * protocol int protocolLen char * model int modelLen int & id int & dataTypes CODE: RETVAL = tdSensor(protocol, protocolLen, model, modelLen, &id, &da +taTypes); OUTPUT: RETVAL id dataTypes

        Sorry, it has been many years since I learned this stuff.

        - tye        

Re: Passing integer pointer in XS?
by ikegami (Patriarch) on Jul 18, 2016 at 20:23 UTC

    Provides the specified interface:

    #define _MAX_PROTOCOL_LEN 25 #define _MAX_MODEL_LEN 25 int tdSensor(SV* protocol_sv, SV* model_sv, SV* id_sv, SV* dataTypes_sv) CODE: { char protocol[_MAX_PROTOCOL_LEN + 1]; char model[_MAX_MODEL_LEN + 1]; int id; int dataTypes; RETVAL = tdSensor( protocol, sizeof(protocol), model, sizeof(model), &id, &dataTypes ); if (RETVAL == TELLSTICK_SUCCESS) { SV* sv; sv = sv_2mortal(newSVpv(protocol, 0))); SvSetMagicSV(protoco +l_sv, sv); sv = sv_2mortal(newSVpv(model, 0)); SvSetMagicSV(model_s +v, sv); sv = sv_2mortal(newIV(id)); SvSetMagicSV(id_sv, + sv); sv = sv_2mortal(newIV(dataTypes)); SvSetMagicSV(dataTyp +es_sv, sv); } else { SvSetMagicSV(protocol_sv, &PL_sv_undef); SvSetMagicSV(model_sv, &PL_sv_undef); SvSetMagicSV(id_sv, &PL_sv_undef); SvSetMagicSV(dataTypes_sv, &PL_sv_undef); } } OUTPUT: RETVAL

    Untested.


    Provides a more Perlish interface:

    #define _MAX_PROTOCOL_LEN 25 #define _MAX_MODEL_LEN 25 SV* tdSensor() CODE: { char protocol[_MAX_PROTOCOL_LEN + 1]; char model[_MAX_MODEL_LEN + 1]; int id; int dataTypes; int rv = tdSensor( protocol, sizeof(protocol), model, sizeof(model), &id, &dataTypes ); if (rv == TELLSTICK_SUCCESS) { HV* hv = newHV(); SV* sv; /* In theory, hv_stores can fail. */ /* However, I suspect it can't happen for this new hash. */ /* It it were to happen here, this code would leak. */ sv = newSVpv(protocol, 0); hv_stores(hv, "protocol", sv); sv = newSVpv(model, 0); hv_stores(hv, "model", sv); sv = newIV(id); hv_stores(hv, "id", sv); sv = newIV(dataTypes); hv_stores(hv, "dataTypes", sv); RETVAL = newRV_noinc(MUTABLE_SV(hv)); } else { RETVAL = &PL_sv_undef; } } OUTPUT: RETVAL

    Usage:

    use feature qw( say ); while (my $rec = tdSensor()) { say join ', ', "protocol: $rec->{protocol}", "model: $rec->{model}", "sensorId: $rec->{id}", "dataTypes: $rec->{dataTypes}"; }

    Untested.

    Update: Fixed missing sv declaration and missing typecast for newRV_noinc's argument.

      Thank you! This looks interesting - and definately a new area of Perl for me... I tried to compile it but ran into an error:
      TellStick.xs:70:10: error: ‘sv’ undeclared (first use in this function +)
      I guess sv needs to be declared. And there was a typo for NewSViv. So now it looks like
      if (rv == TELLSTICK_SUCCESS) { HV* hv = newHV(); SV *sv = newSV(0); sv = newSVpv(protocol, 0); hv_stores(hv, "protocol", sv); sv = newSVpv(model, 0); hv_stores(hv, "model", sv); sv = newSViv(id); hv_stores(hv, "id", sv); sv = newSViv(dataTypes); hv_stores(hv, "dataTypes", sv); RETVAL = newRV_noinc(hv); } else { RETVAL = &PL_sv_undef; }
      There were some compilation warnings as well, don't know if they are important:
      In file included from /usr/lib/arm-linux-gnueabihf/perl/5.20/CORE/perl +.h:5102:0, from TellStick.xs:2: TellStick.xs: In function ‘XS_TellStick_tdSensor’: TellStick.xs:76:31: warning: passing argument 2 of ‘Perl_newRV_noinc’ +from incompatible pointer type RETVAL = newRV_noinc(hv); ^ /usr/lib/arm-linux-gnueabihf/perl/5.20/CORE/embed.h:371:48: note: in d +efinition of macro ‘newRV_noinc’ #define newRV_noinc(a) Perl_newRV_noinc(aTHX_ a) ^ In file included from /usr/lib/arm-linux-gnueabihf/perl/5.20/CORE/perl +.h:5061:0, from TellStick.xs:2: /usr/lib/arm-linux-gnueabihf/perl/5.20/CORE/proto.h:2874:19: note: exp +ected ‘struct SV * const’ but argument is of type ‘struct HV *’ PERL_CALLCONV SV* Perl_newRV_noinc(pTHX_ SV *const sv)
      But the code works!!!

      I get the correct values:

      protocol: mandolyn, model: temperaturehumidity, sensorId: 51, dataType +s: 3 protocol: mandolyn, model: temperaturehumidity, sensorId: 61, dataType +s: 3
      Thank you very much for your help! Now I have a way forward for implementing the rest of fucntion in the C library.

        This is the kind of code that, in my experience, is one of the most likely sources of particularly troublesome errors/bugs. If you want to provide a Perlish interface, then I'd implement that in Perl code, not in XS code.

        If you are having to deal with reference counts, for example, then you are highly likely to get it wrong sooner rather than later and more than once and probably not always notice the problem before you release the code.

        Just write a tiny wrapper function in mundane Perl code and have that call the very, very thinly wrapped XS that calls the C code. Only do in XS those things that you really have to do in XS.

        - tye        

        SV *sv = newSV(0); leaks. You want SV *sv;

        The other issue is because I forgot to cast it. newRV_noinc(hv) should be newRV_noinc(MUTABLE_SV(hv)).

        Fixed in original.

Re: Passing integer pointer in XS?
by ikegami (Patriarch) on Jul 18, 2016 at 19:55 UTC

    [ Oops! I somehow thought you were using Win32::API and not XS. Ignore this. ]


    use feature qw( say state ); use Win32::API qw( ); use constant { _MAX_PROTOCOL_LEN => 25, _MAX_MODEL_LEN => 25, }; use constant { TELLSTICK_SUCCESS => '~~~', }; sub tdSensor { state $tdSensor = Win32::API->new( '~~~.dll', 'tdSensor', 'PIPIPP', 'I', ); my $protocol_buf = "\0" x (_MAX_PROTOCOL_LEN + 1); my $model_buf = "\0" x (_MAX_MODEL_LEN + 1); my $id_buf = pack('i', 0); my $dataTypes_buf = pack('i', 0); my $rv = $tdSensor->Call( $protocol_buf, length($protocol_buf), $model_buf, length($model_buf), $id_buf, $dataTypes_buf, ); if ($rv != TELLSTICK_SUCCESS) { return undef; } return { protocol = unpack('Z*', $protocol_buf), model = unpack('Z*', $model_buf), id = unpack('i', $id_buf), dataTypes = unpack('i', $dataTypes_buf), }; } while (my $rec = tdSensor()) { say join ', ', "protocol: $rec->{protocol}", "model: $rec->{model}", "sensorId: $rec->{id}", "dataTypes: $rec->{dataTypes}"; }

    Untested. Assumes a 32-bit build of Perl.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1167975]
Approved by marto
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (1)
As of 2022-11-26 18:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?