Manejando Array Values

Usaremos como ejemplo para esta sección el módulo Math::Factor::XS debido a Steven Schubiger el cual permite calcular los factores de un número. La siguiente sesión muestra el uso de la función 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  187

La 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 $(a, b)$ tales que $a < b$ y $a$ 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          }

1. La directiva PROTOTYPE: (línea 13) le indica al compilador xsubpp que debe generar un prototipo para la interface Perl a la subrutina. El prototipo indica que se espera un único argumento escalar.
2. La directiva INIT: (línea 14) permite insertar declaraciones e inicializaciones dentro de la XSUB.
3. La directiva PPCODE: (línea 16) le indica al compilador 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.
4. Si estamos en la línea 20 es que el número es múltiplo de 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.
5. En la línea 21 usamos la macro PUSHs para empujar el valor escalar en la pila. Hay toda una familia de macros PUSH:
   1. PUSHi Prototipo: void PUSHi(IV iv)

      Empuja un entero en la pila. La pila debe tener espacio para este elemento.

   2. PUSHn Prototipo: void PUSHn(NV nv)

      Empuja un doble en la pila. La pila debe tener espacio para este elemento.

   3. PUSHp Prototipo: 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.

   4. PUSHs Prototipo: void PUSHs(SV* sv)

      Empuja un escalar en la pila. La pila debe tener espacio para este elemento.

   5. PUSHu Prototipo: void PUSHu(UV uv)

      Empuja un entero sin signo en la pila. La pila debe tener espacio para este elemento.

6. En la línea 20 se usan dos funciones de la API de Perl. La función newSViv tiene el prototipo 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          }

1. En la línea 34 declaramos match como un puntero al tipo Perl array value denotado por AV.

2. La línea 36

   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.

3. En las líneas 38-40 se inicializan los arrays 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.

4. En la línea 52 se crea un nuevo array value (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).

5. En las líneas 53 y 54 usamos av_push para apilar los dos factores en el array apuntado por 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.

6. En la línea 56 La macro PUSHs empuja el valor escalar newRV((SV*)match en la pila.