[EMAIL PROTECTED] wrote:
Hi  everyone,
                     I am new to inline  and am using Inline::C  to embed C in  
my perl code. I  am trying  to  return a struct from a C subroutine back to  
the perl  caller. How do I deal  with  structs when  I use Inline::C? Any help  
would  be appreciated.

Thanks,
G

Reference: This document might still be accessible as

    http://yaakovnet.net/Inline/docu.txt


=== Question: How do I return a C structure to perl?

=== Documentation

First of all, here is some friendly documentation (from which I extracted
the method explained below):

perldoc Inline::C-Cookbook
--- excellent examples from simple to advanced
perldoc perlguts
--- how perl works with C
perldoc perlcall
--- don't read this now! Wait until you want to call perl functions from C.

If you have problems compiling your code or if you want to include
external libraries, you also should read:

perldoc Inline::C


=== Convention:

All indented lines below are either C or perl code.
Non-indented lines are explanation.

We call "use Inline C=> ..." from within the package ZTest; so the
C functions defined below will appear as methods of this class.

At the end, I have collected the lines in the correct arrangement to
be passed into perl.  You can also find this at:

   http://yaakovnet.net/Inline/code.txt


=== ZTest* sample C structure

For our example, we use a simple C structure.  You can easily add and
remove fields after you completed reading this documentation.
   typedef struct {
     int i;               // integer data
     SV* p; SV* q;        // perl data included in the structure
   } ZTest;

=== Wrapper objects

Of course, perl deals with SV* structures, so you need to create a perl
scalar that somehow contains a pointer to your C structure.  You should
take care that this pointer is not accedentially changed: this causes
segmentation faults!

Here is one solution: We store the address of the structure in a
non-modifiable integer perl scalar.  Then, we bless a reference to this
scalar into the class "ZTest" and use the convention: Every object derived
from this class contains a pointer to a ZTest*.

I use the following general macros to build the wrapper object and to extract
the (ZTest*) pointer out of such a perl object:

   #define perl_obj(pointer,class) ({                 \
     SV* ref=newSViv(0); SV* obj=newSVrv(ref, class); \
     sv_setiv(obj, (IV) pointer); SvREADONLY_on(obj); \
     ref;                                             \
   })

   #define c_obj(sv,type) (                           \
     (sv_isobject(sv) && sv_derived_from(sv, #type))  \
       ? ((type*)SvIV(SvRV(sv)))                      \
       : NULL                                         \
     )

For example:
   ZTest* zt=...;
   SV*    sv=perl_obj(zt, "ZTest");   // create a wrapper object for perl
   ZTest* z2=c_obj(sv, ZTest);        // convert back to C structure

Notes:

* These macros work with any types. They assume that the perl class
has the same name as the C type, e.g. "ZTest".

* The perl_obj macro uses GCC statement expressions. If your compiler
doesn't support this extension, use the following less general function
and adjust it to your needs
   SV* perl_from_ztest (ZTest* pointer) {
     SV* ref=newSViv(0); SV* obj=newSVrv(ref, "ZTest");
     sv_setiv(obj, (IV) pointer); SvREADONLY_on(obj);
     return ref;
   }

* The c_obj(sv,type) macro checks the class of the object (it must be
defived from the type), otherwise it returns NULL.  Check for that or
you might get segmentation faults!


=== Typemaps

Inline::C can apply these macros for you automatically.  You just have
to ask for it.  Here is a typemap file:

TYPEMAP
ZTest*  ZTest

INPUT
ZTest
       $var = c_obj($arg,ZTest);

OUTPUT
ZTest
       $arg = perl_obj($var,"ZTest");

Store it into /path/to/typemap and do this:
   package ZTest; use Inline C=> <<'END', "TYPEMAPS"  => "/path/to/typemap";
     // put your C code in here ...
   END

Notes: In fact, I never use the OUTPUT section. So you can leave it out
(more about this later).


=== Constructor and Destructor

This constructor can be called from perl to create a ZTest object with
data filled in:

   SV* new(char* class, int i, SV* p, SV* q) {      // constructor:
     ZTest* zt=malloc(sizeof(ZTest));               //   allocate memory
     zt->i=i;                                       //   store data
     zt->p=newSVsv(p);                              //   CORRECT
     zt->q=SvREFCNT_inc(q);                         //   INCORRECT
     return perl_obj(zt,class);                     //   create perl object
   }

Notes:

* Of course, you can perform the same operations in code that creates ZTest
object from within C. You don't need to call it from perl.

* You should know about reference counts and understand why an initialization
like "zt->p=p" would mess up the reference counts. If you don't understand
this, don't try to store perl data in C structures --- you will not be
happy with your code.

* Both "zt->p=newSVsv(p)" and "zt->q=SvREFCNT_inc(q)" are correct as far
as reference counts are concerned.  In most cases, both work.  But the
latter will give you strange results ... sometime.  I explain that further
down.

Now, add the following destructor code:

   void DESTROY(ZTest* zt) {                        // destructor
     SvREFCNT_dec(zt->p); SvREFCNT_dec(zt->q);      //   release references
     free(zt);                                      //   free memory
   }

This will be called automatically when the perl object is destroyed (don't
call DESTROY manually).  Make sure that you free all pointed-to data structures
and (only after that) free the memory.


=== Accessors

If you want to read and write your C data from perl, you may want to
define methods like these:

   int i(ZTest* zt) { return zt->i; }               // accessor: i
   SV* p(ZTest* zt) { return SvREFCNT_inc(zt->p); } // accessor: p
   SV* q(ZTest* zt) { return SvREFCNT_inc(zt->q); } // accessor: q

   void set_i(ZTest* zt, int i) { zt->i=i; }
   void set_p(ZTest* zt, SV* p) { SvREFCNT_dec(zt->p); zt->p=newSVsv(p); }
   void set_q(ZTest* zt, SV* q) { SvREFCNT_dec(zt->q); zt->q=newSVsv(q); }

Again, use "newSVsv" and not "SvREFCNT_inc" (explanation further down).

=== Some examples

After completing the "use Inline => C..." call, we add more perl code:
   sub ZTest::show {my($zt)[EMAIL PROTECTED];
     print "i=",$zt->i," p=",$zt->p," q=",$zt->q,"\n";
   }

This demonstrates that the same object can have some methods implemented in
C and some methods implemented in perl!

Here are examples:

   my $zt=ZTest->new(1,"a","b"); # this creates a ZTest object with values
   print $zt->i,"\n";                 # this prints "1".
   print $zt->p,"\n";                 # this prints "a".
   print $zt->q,"\n";                 # this prints "b".
   $zt->show;                         # this prints "i=1 p=a q=b".

   $zt->set_i(2); $zt->show;          # this prints "i=2 p=a q=b".

Now, you should play with the example: add a few computations
into the methods, add or remove some data fields in the data structure.


=== L-values (and newSVsv versus SvREFCNT_inc)

Here is some perl magic that can bite you if you don't understand it.
So read on!

Let's add the following little method to our C-code:
   void add_i_to (ZTest* zt, SV* arg) {
     sv_setnv(arg, SvNV(arg)+zt->i);
   }

Then, try the following perl code:
   $zt=ZTest->new(10,10,10);  # We know that. Now, zt->i is 10.
   my $x=5;                   # Now, $x is 5.
   $zt->add_i_to($x);         # Call our method...
   print $x,"\n";             # This prints "15".

As you see, the method changes the passed argument. This is known as
"pass by reference" as supposed to "pass by value": Instead of creating
a copy of the argument, perl gives you the reference to the argument
itself --- so you can change it.

The functions "sv_setnv" and "SvNV" are documented in "perlguts": They
write and read perl scalars.

What happens if we store this reference to the actual argument in a C
structure?  You recall that above we (intentionally) made this mistake
and wrote the incorrect "zt->q=SvREFCNT_inc(q)" instead of
the correct "zt->q=newSVsv(q)". Try the following:

   $x=10;  $zt=ZTest->new(1,2,$x);  # we are interested in zt->q only
   print $zt->q,"\n";               # this prints "10" -- ok until now.
   $x=20; print $zt->q,"\n";        # this prints "20".
   $x=30; print $zt->q,"\n";        # this prints "30".

   $x=10;  $zt=ZTest->new(1,$x,2);  # Now, we are interested in zt->p
   print $zt->p,"\n";               # this prints "10" -- ok until now.
   $x=20; print $zt->p,"\n";        # this prints "10" -- still ok.
   $x=30; print $zt->p,"\n";        # this prints "10" -- ok.

As you see, we did not copy the *value* of $x into the field zt->q.  Instead,
we copied a reference to the variable $x; Whenever the variable $x changes,
the value of zt->q changes as well (because it's the same perl object)!

That's cute --- but usually not what you want.

The second example with zt->p is better: The value does no longer depend
on the variable $x.  This is because "zt->p=newSVsv(p)" makes a new copy.

Simple rule: Never store a function argument (input from perl into C via
Inline::C) directly into a data structure!  Either extract the value as
C data (e.g. int/double...) or copy the data with "newSVsv" into a new
perl scalar.

=== The full source

Copy the following lines into a new file and run it through perl:

#!/usr/bin/perl -w

my $typemap;
BEGIN {
$typemap= ">/tmp/typemap";     # change this if necessary!
open T, $typemap or die "open $typemap: $!"; print T <<'END'; close T;
TYPEMAP
ZTest*  ZTest

INPUT
ZTest
       $var = c_obj($arg,ZTest);

OUTPUT
ZTest
       $arg = perl_obj($var,"ZTest");

END
}
package ZTest;
use Inline C=> <<'END', "TYPEMAPS"  => "/tmp/typemap";

   typedef struct {
     int i;               // integer data
     SV* p; SV* q;        // perl data included in the structure
   } ZTest;

   #define perl_obj(pointer,class) ({                 \
     SV* ref=newSViv(0); SV* obj=newSVrv(ref, class); \
     sv_setiv(obj, (IV) pointer); SvREADONLY_on(obj); \
     ref;                                             \
   })

   #define c_obj(sv,type) (                           \
     (sv_isobject(sv) && sv_derived_from(sv, #type))  \
       ? ((type*)SvIV(SvRV(sv)))                      \
       : NULL                                         \
     )

   SV* new(char* class, int i, SV* p, SV* q) {      // constructor:
     ZTest* zt=malloc(sizeof(ZTest));               //   allocate memory
     zt->i=i;                                       //   store data
     zt->p=newSVsv(p);                              //   CORRECT
     zt->q=SvREFCNT_inc(q);                         //   INCORRECT
     return perl_obj(zt,class);                     //   create perl object
   }

   void DESTROY(ZTest* zt) {                        // destructor
     SvREFCNT_dec(zt->p); SvREFCNT_dec(zt->q);      //   release references
     free(zt);                                      //   free memory
   }

   int i(ZTest* zt) { return zt->i; }               // accessor: i
   SV* p(ZTest* zt) { return SvREFCNT_inc(zt->p); } // accessor: p
   SV* q(ZTest* zt) { return SvREFCNT_inc(zt->q); } // accessor: q

   void set_i(ZTest* zt, int i) { zt->i=i; }
   void set_p(ZTest* zt, SV* p) { SvREFCNT_dec(zt->p); zt->p=newSVsv(p); }
   void set_q(ZTest* zt, SV* q) { SvREFCNT_dec(zt->q); zt->q=newSVsv(q); }

   void add_i_to (ZTest* zt, SV* arg) {
     sv_setnv(arg, SvNV(arg)+zt->i);
   }

END

   sub ZTest::show {my($zt)[EMAIL PROTECTED];
     print "i=",$zt->i," p=",$zt->p," q=",$zt->q,"\n";
   }


   my $zt=ZTest->new(1,"a","b"); # this creates a ZTest object with values
   print $zt->i,"\n";                 # this prints "1".
   print $zt->p,"\n";                 # this prints "a".
   print $zt->q,"\n";                 # this prints "b".
   $zt->show;                         # this prints "i=1 p=a q=b".

   $zt->set_i(2); $zt->show;          # this prints "i=2 p=a q=b".

   $zt=ZTest->new(10,10,10);  # We know that. Now, zt->i is 10.
   my $x=5;                   # Now, $x is 5.
   $zt->add_i_to($x);         # Call our method...
   print $x,"\n";             # This prints "15".

   $x=10;  $zt=ZTest->new(1,2,$x);  # we are interested in zt->q only
   print $zt->q,"\n";               # this prints "10" -- ok until now.
   $x=20; print $zt->q,"\n";        # this prints "20".
   $x=30; print $zt->q,"\n";        # this prints "30".

   $x=10;  $zt=ZTest->new(1,$x,2);  # Now, we are interested in zt->p
   print $zt->p,"\n";               # this prints "10" -- ok until now.
   $x=20; print $zt->p,"\n";        # this prints "10" -- still ok.
   $x=30; print $zt->p,"\n";        # this prints "10" -- ok.

Reply via email to