_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 RETVALDado 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 puntero17.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 }
Casiano Rodríguez León