Los Métodos de Acceso

Recuérdese que la traducción de la interfaz para rectangular * viene dada por la entrada T_PTROBJ del fichero typemap de la instalación. La entrada y la salida para esta interfaz son:
lhp@nereida:~/Lperl/src/XSUB/h2xsexample/Coord$ cat -n /usr/share/perl/5.8/ExtUtils/typemap
     1  # basic C types
     2  int                     T_IV
....................................
    50  FileHandle              T_PTROBJ
....................................
    56  #############################################################################
    57  INPUT
    58  T_SV
    59          $var = $arg
....................................
   137  T_PTROBJ
   138          if (sv_derived_from($arg, \"${ntype}\")) {
   139              IV tmp = SvIV((SV*)SvRV($arg));
   140              $var = INT2PTR($type,tmp);
   141          }
   142          else
   143              Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
....................................
   193  #############################################################################
   194  OUTPUT
   195  T_SV
   196          $arg = $var;
   197  T_SVREF
   198          $arg = newRV((SV*)$var);
....................................
   252  T_PTROBJ
   253          sv_setref_pv($arg, \"${ntype}\", (void*)$var);

Tenemos un método por cada campo. El método x recibe la referencia THIS a la estructura rectangular y -opcionalmente- el valor __value a almacenar en la componente.

 68  MODULE = Coord          PACKAGE = rectangularPtr
 69
 70  double
 71  x(THIS, __value = NO_INIT)
 72          rectangular * THIS
 73          double __value
 74      PROTOTYPE: $;$
 75      CODE:
 76          if (items > 1)
 77              THIS->x = __value;
 78          RETVAL = THIS->x;
 79      OUTPUT:
 80          RETVAL

Es posible especificar valores por defecto para los argumentos de una XSUB. Esto se hace especificandolos mediante asignaciones en la parte de la lista de parámetros. El valor por defecto puede ser un número, una cadena o -como es el caso del ejemplo - la cadena especial NO_INIT . Sólo es posible especificar valores por defecto para los parámetros mas a la derecha. Obervese que la semántica de NO_INIT aqui es diferente de la que tenía en el ejemplo anterior

 41  rectangular *
 42  _to_ptr(THIS)
 43          rectangular THIS = NO_INIT
mientras que su colocación en la segunda parte - después de la lista de parámetros - inhibe la acción del typemap, su uso en la lista de argumentos de la XSUB en un argumento opcional indica que no es necesario asignarle un valor por defecto. Las líneas 368-370 del código generado para la XSUB muestran la conversión correspondiente:
350 XS(XS_rectangularPtr_x)
351 {
352     dXSARGS;
353     if (items < 1 || items > 2)
354         Perl_croak(aTHX_ "Usage: rectangularPtr::x(THIS, __value = NO_INIT)");
355     {
356         rectangular *   THIS;
357         double  __value;
358         double  RETVAL;
359         dXSTARG;
360
361         if (sv_derived_from(ST(0), "rectangularPtr")) {
362             IV tmp = SvIV((SV*)SvRV(ST(0)));
363             THIS = INT2PTR(rectangular *,tmp);
364         }
365         else
366             Perl_croak(aTHX_ "THIS is not of type rectangularPtr");
367
368         if (items >= 2) {
369             __value = (double)SvNV(ST(1));
370         }
371 #line 67 "Coord.xs"
372         if (items > 1)
373             THIS->x = __value;
374         RETVAL = THIS->x;
375 #line 376 "Coord.c"
376         XSprePUSH; PUSHn((double)RETVAL);
377     }
378     XSRETURN(1);
379 }

La conversión mediante T_PTROBJ para rectangular * da lugar a que la referencia Perl sea convertida en un entero mediante SvIV y el entero en un puntero C mediante INT2PTR (líneas 362-363). Perl usa las macros PTR2INT y INT2PTR para convertir entre punteros e IVs. El tipo entero de Perl IV no es necesariamente igual al tipo int de C; La diferencia está en que Perl garantiza que el tipo entero tiene tamaño suficiente para guardar un puntero. Esta condición garantiza la corrección del código del typemap T_PTROBJ:



INPUT T_PTROBJ Traducción
if (sv_derived_from($arg, \"${ntype}\")) {
  IV tmp = SvIV((SV*)SvRV($arg));
  $var = INT2PTR($type,tmp);
}
else
  Perl_croak(aTHX_ 
   \"$var is not of type ${ntype}\")
if (sv_derived_from(ST(0), "rectangularPtr")) {
  IV tmp = SvIV((SV*)SvRV(ST(0)));
  THIS = INT2PTR(rectangular *,tmp);
}
else
  Perl_croak(aTHX_ 
    "THIS is not of type rectangularPtr");

El código para el campo y es similar al generado para x:

 82  double
 83  y(THIS, __value = NO_INIT)
 84          rectangular * THIS
 85          double __value
 86      PROTOTYPE: $;$
 87      CODE:
 88          if (items > 1)
 89              THIS->y = __value;
 90          RETVAL = THIS->y;
 91      OUTPUT:
 92          RETVAL
 93
 .. ............... identica estructura para polar
La siguiente sesión con el depurador muestra como la estructura permanece almacenada en el formato nativo en un valor escalar de tipo cadena:

lhp@nereida:~/Lperl/src/XSUB/h2xsexample/Coord/script$ perl -Mblib -MCoord -de 0
main::(-e:1):   0
  DB<1> $r=rectangular->new(); $rp = $r->_to_ptr()
  DB<2> $rp->x(4.5); $rp->y(3.2)
  DB<3> x $r
0  rectangular=SCALAR(0x8494068)
   -> "\c@\c@\c@\c@\c@\c@\cR\@\cI\@"
  DB<4> x pack("dd", (4.5, 3.2))
0  "\c@\c@\c@\c@\c@\c@\cR\@\cI\@"
  DB<5> x unpack("dd", $$r)
0  4.5
1  3.2

Casiano Rodríguez León
Licencia de Creative Commons
Programación Distribuida y Mejora del Rendimiento
por Casiano Rodríguez León is licensed under a Creative Commons Reconocimiento 3.0 Unported License.

Permissions beyond the scope of this license may be available at http://campusvirtual.ull.es/ocw/course/view.php?id=44.
2012-06-19