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 RETVALRecuerde 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