factors
la cual devuelve una lista con los factores del número:
lhp@nereida:/tmp/Scalar-List-Utils-1.18$ perl -de 0 main::(-e:1): 0 DB<1> use Math::Factor::XS ':all' DB<2> @factors = factors(30107) DB<3> x @factors 0 7 1 11 2 17 3 23 4 77 5 119 6 161 7 187 8 253 9 391 10 1309 11 1771 12 2737 13 4301 DB<4> x matches(30107, @factors) 0 ARRAY(0x85107bc) 0 7 1 4301 1 ARRAY(0x84d5ccc) 0 11 1 2737 2 ARRAY(0x84e1524) 0 17 1 1771 3 ARRAY(0x8382b50) 0 23 1 1309 4 ARRAY(0x85108e8) 0 77 1 391 5 ARRAY(0x8503844) 0 119 1 253 6 ARRAY(0x84faab0) 0 161 1 187La línea 4 muestra el resultado de la función
matches
la cual devuelve
una lista con las parejas de factores.
Existe una variable Skip_multiple
que modifica la conducta de matches
de manera que sólo son listados aquellas parejas de factores
tales que
y
es primo:
DB<5> $Math::Factor::XS::Skip_multiple = 1 DB<6> x matches(30107, @factors) 0 ARRAY(0x84fab94) 0 7 1 4301 1 ARRAY(0x85037a4) 0 11 1 2737 2 ARRAY(0x84fabc4) 0 17 1 1771 3 ARRAY(0x84f0618) 0 23 1 1309
Esta es la estructura de ficheros del módulo:
lhp@nereida:~/Lperl/src/XSUB/cpanexamples/Math-Factor-XS-0.33$ tree . |-- Build.PL |-- Changes |-- INSTALL |-- MANIFEST |-- META.yml |-- Makefile.PL |-- README |-- XS.xs |-- lib | `-- Math | `-- Factor | `-- XS.pm |-- ppport.h |-- scripts | `-- usage-example.pl `-- t |-- 00-load.t |-- calc_factors.t |-- pod-coverage.t `-- pod.t 5 directories, 15 files
Este módulo se construye usando Module::Build el cual es una alternativa
a ExtUtils::MakeMaker
. Por esta razón el fichero para arrancar el proceso
de instalación se llama Build.PL
.
Los contenidos del módulo son:
lhp@nereida:~/Lperl/src/XSUB/cpanexamples/Math-Factor-XS-0.33$ cat -n lib/Math/Factor/XS.pm | head -18 - 1 package Math::Factor::XS; 2 3 use strict; 4 use warnings; 5 use base qw(Exporter); 6 7 our ($VERSION, @EXPORT_OK, %EXPORT_TAGS, $Skip_multiple, @subs); 8 9 $VERSION = '0.33'; 10 @subs = qw(factors matches); 11 @EXPORT_OK = @subs; 12 %EXPORT_TAGS = ('all' => [ @subs ]); 13 $Skip_multiple = 0; 14 15 require XSLoader; 16 XSLoader::load(__PACKAGE__, $VERSION); 17 18 1;
Pasamos a comentar los contenidos del fichero XS.xs
.
En primer lugar tenemos la función factors
:
lhp@nereida:~/Lperl/src/XSUB/cpanexamples/Math-Factor-XS-0.33$ cat -n XS.xs 1 #include "EXTERN.h" 2 #include "perl.h" 3 #include "XSUB.h" 4 5 #include "ppport.h" 6 7 8 MODULE = Math::Factor::XS PACKAGE = Math::Factor::XS 9 10 void 11 factors(number) 12 long number 13 PROTOTYPE: $ 14 INIT: 15 long i; 16 PPCODE: 17 for (i = 2; i <= number; i++) { 18 if (i > (number / 2)) break; 19 if (number % i == 0) { 20 EXTEND(SP,1); 21 PUSHs(sv_2mortal(newSViv(i))); 22 } 23 }
xsubpp
que debe generar
un prototipo para la interface Perl a la subrutina. El prototipo indica que se espera
un único argumento escalar.
xsubpp
que el programador proporciona el código
que controla el manejo de los argumentos y los valores de retorno
en la pila. Tanto en factors
como en matches
queremos
devolver una lista de valores en vez de un único valor.
En casos como estos se debe usar PPCODE:
y empujar explícitamente
la lista de valores calculados en la pila.
i
.
Por tanto i
debe ser agregado a la lista de resultados.
EXTEND
tiene como sintáxis void EXTEND(SP, int nitems)
.
Después de llamada es seguro que la pila tiene espacio para nitems
nuevos items.
PUSH
:
void PUSHi(IV iv)
Empuja un entero en la pila. La pila debe tener espacio para este elemento.
void PUSHn(NV nv)
Empuja un doble en la pila. La pila debe tener espacio para este elemento.
void PUSHp(char* str, STRLEN len)
Empuja una cadena en la pila. La pila debe tener espacio para la misma. len
es la longitud de la cadena.
void PUSHs(SV* sv)
Empuja un escalar en la pila. La pila debe tener espacio para este elemento.
void PUSHu(UV uv)
Empuja un entero sin signo en la pila. La pila debe tener espacio para este elemento.
SV* newSViv(IV i)
.
Crea un nuevo valor escalar y lo inicializa con el entero en i
.
El contador de referencia del nuevo escalar se pone a 1.
La función
sv_2mortal
marca el SV
como mortal: El SV
será destruido cuando termine el
contexto de la subrutina. La función tiene el prototipo SV* sv_2mortal(SV* sv)
.
Si no llamáramos a esta función la memoria alojada nunca sería
liberada y se produciría una pérdida (leak).
Procedamos ahora a estudiar la subrutina matches
.
25 void 26 matches(number, ...) 27 long number 28 PROTOTYPE: $@ 29 INIT: 30 long base[items], cmp[items], prev_base[items]; 31 long b, c, i, p = 0; 32 bool Skip_multiple, skip = 0; 33 SV* skip_multiple; 34 AV* match; 35 PPCODE: 36 skip_multiple = get_sv("Math::Factor::XS::Skip_multiple", FALSE); 37 Skip_multiple = skip_multiple != NULL ? SvIV(skip_multiple) : 0; 38 for (i = 0; i < items; i++) { 39 base[i] = SvIV(ST(i)); 40 cmp[i] = SvIV(ST(i)); 41 } 42 for (b = 0; b < items; b++) { 43 for (c = 0; c < items; c++) { 44 if (cmp[c] >= base[b] && base[b] * cmp[c] == number) { 45 if (Skip_multiple) { 46 skip = 0; 47 for (i = 0; i < p; i++) { 48 if (base[b] % prev_base[i] == 0) skip = 1; 49 } 50 } 51 if (!skip) { 52 match = (AV*)sv_2mortal((SV*)newAV()); 53 av_push(match, newSViv(base[b])); 54 av_push(match, newSViv(cmp[c])); 55 EXTEND(SP,2); 56 PUSHs(sv_2mortal(newRV((SV*)match))); 57 if (Skip_multiple) { 58 prev_base[p++] = base[b]; 59 } 60 } 61 } 62 } 63 }
match
como un puntero al tipo Perl array value denotado por AV
.
skip_multiple = get_sv("Math::Factor::XS::Skip_multiple", FALSE)nos muestra como obtener el valor de una variable escalar de paquete. El formato de llamada de get_sv es
SV* get_sv(const char* name, I32 create)
.
Si la variable Perl no existe y el parámetro create
está a 1
la variable será creada. Si create
está a 0
y la variable Perl no existe se devuelve NULL
.
base
y cmp
con las valores escalares enteros de los
índices del array.
La función IV SvIV(SV* sv)
y NV SvNV(SV* sv)
encorseta el SV
al tipo entero.
AV
) usando
newAV
. Esta función tiene el prototipo AV* newAV()
.
Además de crearlo pone el contador de referencias a 1. Estamos creando
así una referencia a un array. Para darle un ámbito
léxico llamamos a la función
sv_2mortal
, la cual hace que
el SV
sea destruido cuando termine el
contexto de la subrutina.
Si no llamáramos a esta función la memoria alojada nunca sería
liberada y se produciría una pérdida (leak).
match
La función void av_push(AV* ar, SV* val)
además de
apilar el valor apuntado por val
hace que el array ar
crezca automáticamente haciendo espacio para el nuevo
valor.
PUSHs
empuja el valor escalar newRV((SV*)match
en la pila.
Casiano Rodríguez León