view release on metacpan or  search on metacpan

AM.xs  view on Meta::CPAN

      } else {
        class = subcontext_class[*intersection_list_top];
      }
    } else {
      /* Do the classes not match? */
      if (class != subcontext_class[*intersection_list_top]) {
        length = 0;
        break;
      }
    }
    --intersection_list_top;
    --subcontext_list_top;
  }
  return length;
}

/* clear out the supracontexts */
void clear_supras(AM_SUPRA **supra_list, int supras_length)
{
  AM_SUPRA *p;
  for (int i = 0; i < supras_length; i++)
  {
    for (iter_supras(p, supra_list[i]))
    {
      Safefree(p->data);
    }
  }
}

MODULE = Algorithm::AM PACKAGE = Algorithm::AM

PROTOTYPES: DISABLE

BOOT:
  {
    AM_LONG ten = 10;
    AM_LONG one = 1;
    AM_LONG *tensptr = &tens[0];
    AM_LONG *onesptr = &ones[0];
    unsigned int i;
    for (i = 16; i; i--) {
      *tensptr = ten;
      *onesptr = one;
      ++tensptr;
      ++onesptr;
      ten <<= 1;
      one <<= 1;
    }
  }

 /*
  * This function is called by from AM.pm right after creating
  * a blessed reference to Algorithm::AM. It stores the necessary
  * pointers in the AM_GUTS structure and attaches it to the magic
  * part of the reference.
  *
  */

void
_xs_initialize(...)
 PPCODE:
  /* NOT A POINTER THIS TIME! (let memory allocate automatically) */
  AM_GUTS guts;
  /* 9 arguments are passed to the _xs_initialize method: */
  /* $self, the AM object */
  HV *self = hash_pointer_from_stack(0);
  /* For explanations on these, see the comments on AM_guts */
  SV **lattice_sizes = array_pointer_from_stack(1);
  guts.classes = array_pointer_from_stack(2);
  guts.itemcontextchain = array_pointer_from_stack(3);
  guts.itemcontextchainhead = hash_pointer_from_stack(4);
  guts.context_to_class = hash_pointer_from_stack(5);
  guts.context_size = hash_pointer_from_stack(6);
  guts.pointers = hash_pointer_from_stack(7);
  guts.raw_gang = hash_pointer_from_stack(8);
  guts.sum = array_pointer_from_stack(9);
  /* Length of guts.sum */
  guts.num_classes = av_len((AV *) SvRV(ST(9)));

  /*
   * Since the sublattices are small, we just take a chunk of memory
   * here that will be large enough for our purposes and do the actual
   * memory allocation within the code; this reduces the overhead of
   * repeated system calls.
   *
   */

  for (int i = 0; i < NUM_LATTICES; ++i) {
    UV v = SvUVX(lattice_sizes[i]);
    Newxz(guts.lattice_list[i], 1 << v, AM_SHORT);
    Newxz(guts.supra_list[i], 1 << (v + 1), AM_SUPRA); /* CHANGED */ /* TODO: what changed? */
    Newxz(guts.supra_list[i][0].data, 2, AM_SHORT);
  }

  /* Perl magic invoked here */

  SV *svguts = newSVpv((char *)&guts, sizeof(AM_GUTS));
  sv_magic((SV *) self, svguts, PERL_MAGIC_ext, NULL, 0);
  SvRMAGICAL_off((SV *) self);
  MAGIC *magic = mg_find((SV *)self, PERL_MAGIC_ext);
  magic->mg_virtual = &AMguts_vtab;
  mg_magical((SV *) self);

void
_fillandcount(...)
 PPCODE:
  /* Input args are the AM object ($self), number of features in each
   * lattice, and a flag to indicate whether to count occurrences
   * (true) or pointers (false), also known as linear/quadratic.
   */
  HV *self = hash_pointer_from_stack(0);
  SV **lattice_sizes_input = array_pointer_from_stack(1);
  UV linear_flag = unsigned_int_from_stack(2);
  MAGIC *magic = mg_find((SV *)self, PERL_MAGIC_ext);
  AM_GUTS *guts = (AM_GUTS *)SvPVX(magic->mg_obj);

  /*
   * We initialize the memory for the sublattices, including setting up the
   * linked lists.
   */

  AM_SHORT **lattice_list = guts->lattice_list;
  AM_SUPRA **supra_list = guts->supra_list;
  /* this helps us manage the free list in supra_list[i] */
  AM_SHORT nptr[NUM_LATTICES];
  AM_SHORT lattice_sizes[NUM_LATTICES];
  for (int sublattice_index = 0; sublattice_index < NUM_LATTICES; ++sublattice_index) {
    /* Extract numeric values for the specified lattice_sizes */
    lattice_sizes[sublattice_index] = (AM_SHORT) SvUVX(lattice_sizes_input[sublattice_index]);
    /* TODO: explain the lines below */
    Zero(lattice_list[sublattice_index], 1 << lattice_sizes[sublattice_index], AM_SHORT);
    supra_list[sublattice_index][0].next = 0;
    nptr[sublattice_index] = 1;
    for (int i = 1; i < 1 << (lattice_sizes[sublattice_index] + 1); ++i) {/* CHANGED (TODO: changed what?) */
      supra_list[sublattice_index][i].next = (AM_SHORT) i + 1;
    }
  }

  /*
   * Instead of adding subcontext labels directly to the supracontexts,
   * we store all of these labels in an array called subcontext.  We
   * then store the array indices of the subcontext labels in the
   * supracontexts.  That means the list of subcontexts in the
   * supracontexts is an increasing sequence of positive integers, handy
   * for taking intersections (see lattice.pod).
   *
   * The index into the array is called subcontextnumber.
   *
   * The array of matching classes is called subcontext_class.
   *
   */

  HV *context_to_class = guts->context_to_class;
  AM_SHORT subcontextnumber = (AM_SHORT)HvUSEDKEYS(context_to_class);
  AM_SHORT *subcontext;
  Newxz(subcontext, NUM_LATTICES *(subcontextnumber + 1), AM_SHORT);
  subcontext += NUM_LATTICES * subcontextnumber;
  AM_SHORT *subcontext_class;
  Newxz(subcontext_class, subcontextnumber + 1, AM_SHORT);
  subcontext_class += subcontextnumber;

  AM_SHORT *intersectlist, *intersectlist2, *intersectlist3;
  AM_SHORT *ilist2top, *ilist3top;
  Newxz(intersectlist, subcontextnumber + 1, AM_SHORT);
  Newxz(intersectlist2, subcontextnumber + 1, AM_SHORT);
  ilist2top = intersectlist2 + subcontextnumber;