El código de new

El constructor new recibe como argumento CLASS la cadena de caracteres que describe la clase (esto es, 'rectangular').
 59  rectangular
 60  new(CLASS)
 61          char *CLASS = NO_INIT
 62      PROTOTYPE: $
 63      CODE:
 64          Zero((void*)&RETVAL, sizeof(RETVAL), char);
 65      OUTPUT:
 66          RETVAL
Recuerde que la llamada a new tiene la forma:
my $r = rectangular->new();
Puesto que RETVAL es de tipo rectangular lo que esta haciendo el código de la línea 64 es retornar un espacio contiguo de memoria de tamaño el de struct rectangular iniciada con ceros. En ese momento interviene el código OUTPUT del typemap asociado con rectangular. Para ello, h2xs ha generado un fichero typemap con los siguientes contenidos:
lhp@nereida:~/projects/perl/src/XSUB/h2xsexample/Coord$ cat -n typemap
 1  const char *                                    T_PTROBJ
 2  polar                                           T_OPAQUE_STRUCT
 3  polar *                                         T_PTROBJ
 4  rectangular                                     T_OPAQUE_STRUCT
 5  rectangular *                                   T_PTROBJ
 6  #############################################################################
 7  INPUT
 8  T_OPAQUE_STRUCT
 9          if (sv_derived_from($arg, \"${ntype}\")) {
10              STRLEN len;
11              char  *s = SvPV((SV*)SvRV($arg), len);
12
13              if (len != sizeof($var))
14                  croak(\"Size %d of packed data != expected %d\",
15                          len, sizeof($var));
16              $var = *($type *)s;
17          }
18          else
19              croak(\"$var is not of type ${ntype}\")
20  #############################################################################
21  OUTPUT
22  T_OPAQUE_STRUCT
23          sv_setref_pvn($arg, \"${ntype}\", (char *)&$var, sizeof($var));

El valor retornado viene por tanto gobernado por la entrada de la línea 23. La llamada a la función sv_setref_pvn copia sizeof($var) caracteres a partir de la dirección &$var (esto es, en el caso de nuestra llamada, copia la cadena a partir de &RETVAL) y dispone $arg para que referencie dicha zona. El segundo argumento - ${ntype} es rectangular en nuestro caso - indica en que clase se bendecirá $arg. El nuevo SV $arg tendrá un contador de referencia de 1. La traducción realizada por xsubpp del código de new queda asi:

328 XS(XS_rectangular_new)
329 {
330     dXSARGS;
331     if (items != 1)
332         Perl_croak(aTHX_ "Usage: rectangular::new(CLASS)");
333     {
334         char *  CLASS;
335         rectangular     RETVAL;
336 #line 64 "Coord.xs"
337         Zero((void*)&RETVAL, sizeof(RETVAL), char);
338 #line 339 "Coord.c"
339         ST(0) = sv_newmortal();
340         sv_setref_pvn(ST(0), "rectangular", (char *)&RETVAL, sizeof(RETVAL));
341     }
342     XSRETURN(1);
343 }
La línea 340 es el resultado de la traducción del esquema del typemap. La asignación de la línea previa 339 crea un nuevo SV con contador de referencia a 1. Como dijimos, ese escalar sigue teniendo un contador de referencia de 1 después de la línea 340. ¿Que ocurre cuando este código es llamado desde Perl?
my $r = rectangular->new();
El hecho de que $r referencia al valor escalar creado en la línea 339 hace que este incremente su contador de referencia pasando a valer 2 con lo que la memoria asignada al SV nunca es liberada. La llamada a sv_newmortal marca al SV como mortal produciendo el decremento del contador a la salida de la función:
lhp@nereida:~/Lperl/src/XSUB/h2xsexample/Coord/script$ perl -MDevel::Peek -Mblib -MCoord -de 0
main::(-e:1):   0
  DB<1> $r = rectangular->new()
  DB<2> Dump($r)
SV = PVMG(0x850e910) at 0x8494038
  REFCNT = 1
  FLAGS = (ROK)
  IV = 0
  NV = 0
  RV = 0x8494068
  SV = PVMG(0x8465968) at 0x8494068
    REFCNT = 1
    FLAGS = (OBJECT,POK,pPOK)
    IV = 0
    NV = 0
    PV = 0x8479f10 "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"\0
    CUR = 16
    LEN = 20
    STASH = 0x84626c4   "rectangular"
  PV = 0x8494068 ""
  CUR = 0
  LEN = 0

  DB<3> x $r
0  rectangular=SCALAR(0x8494068)
   -> "\c@\c@\c@\c@\c@\c@\c@\c@\c@\c@\c@\c@\c@\c@\c@\c@"
Vemos que tanto $r como el escalar referenciado por $r tienen sus REFCNT a 1. Podemos ver también como $r pertenece a la clase rectangular.

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