El código de _to_ptr

Veamos en mas detalle el código de la función _to_ptr:

 41  rectangular *
 42  _to_ptr(THIS)
 43          rectangular THIS = NO_INIT
 44      PROTOTYPE: $
 45      CODE:
 46          if (sv_derived_from(ST(0), "rectangular")) {
 47              STRLEN len;
 48              char *s = SvPV((SV*)SvRV(ST(0)), len);
 49              if (len != sizeof(THIS))
 50                  croak("Size %d of packed data != expected %d",
 51                          len, sizeof(THIS));
 52              RETVAL = (rectangular *)s;
 53          }
 54          else
 55              croak("THIS is not of type rectangular");
 56      OUTPUT:
 57          RETVAL

El argumento de entrada THIS es de tipo rectangular y por tanto su conversión debería venir gobernada por la entrada INPUT de T_OPAQUE_STRUCT :

 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}\")

La función sv_derived_from (línea 9) es la que implementa el método UNIVERSAL::isa . Trabaja tanto con clases como con objetos. La asignación de la línea 11 extraería la referencia del SV en $arg mediante SvRV y obtendría mediante SvPV la cadena en el SV apuntado por esa referencia. Naturalmente la longitud de dicha cadena debe ser igual al tamaño del tipo rectangular.

La palabra clave NO_INIT en la declaración de THIS es habitualmente usada para indicar que el parámetro será usado sólo como parámetro de salida. El efecto que de hecho tiene es suprimir la conducta habitual de xsubpp de generar el código de conversión de entrada a través del typemap. El código de conversión es -en este caso- proveido directamente en la sección CODE:. Asi pues la entrada del typemap no está siendo usada. La diferencia entre el código de entrada de T_OPAQUE_STRUCT y el generado por h2xs está en las asignaciones de las líneas 52 y 16.

h2xs:    52              RETVAL = (rectangular *)s;
typemap: 16              $var = *($type *)s;

Observe que el código de la línea 16 se traduciría en:

                         THIS = *(rectangular *)s;

De hecho el código de _to_ptr se podría haber reeescrito como:

41 rectangular *
42 _to_ptr(THIS)
43         rectangular THIS
44     PROTOTYPE: $
45     CODE:
46       RETVAL = &THIS;
47     OUTPUT:
48         RETVAL

Dado que la función retorna un rectangular * el código para la interfaz de salida viene dada por la entrada T_PTROBJ del fichero de typemap estandar:

194 OUTPUT
... ........
252 T_PTROBJ
253         sv_setref_pv($arg, \"${ntype}\", (void*)$var);

La función sv_setref_pv tiene el prototipo:

        SV*  sv_setref_pv(SV* rv, const char* classname, void* pv)

Copia el puntero^17.3 apuntado por pv (que se corresponde con RETVAL) en un nuevo SV cuyo contador de referencia se pone a 1. El argumento rv (que es en este caso ST(0)) es actualizado a un RV que referencia el nuevo escalar. Si el puntero fuera NULL el escalar sería iniciado con el valor PL_sv_undef. El escalar es bendecido en classname (En nuestro caso ${ntype} es rectangularPtr). Si se quiere evitar la bendición se puede poner el argumento classname a Nullch .

La traducción resultante del método _to_ptr es:

300 XS(XS_rectangular__to_ptr) # Fichero Coord.c
301 {
302     dXSARGS;
303     if (items != 1)
304         Perl_croak(aTHX_ "Usage: rectangular::_to_ptr(THIS)");
305     {
306         rectangular     THIS;
307         rectangular *   RETVAL;
308 #line 46 "Coord.xs"
309         if (sv_derived_from(ST(0), "rectangular")) {
310             STRLEN len;
311             char *s = SvPV((SV*)SvRV(ST(0)), len);
312             if (len != sizeof(THIS))
313                 croak("Size %d of packed data != expected %d",
314                         len, sizeof(THIS));
315             RETVAL = (rectangular *)s;
316         }
317         else
318             croak("THIS is not of type rectangular");
319 #line 320 "Coord.c"
320         ST(0) = sv_newmortal();
321         sv_setref_pv(ST(0), "rectangularPtr", (void*)RETVAL);
322     }
323     XSRETURN(1);
324 }