view release on metacpan or  search on metacpan

AM.xs  view on Meta::CPAN

    ++length;

     /* is it heterogeneous? */
    if (class == 0) {
      /* is it not deterministic? */
      if (length > 1) {
        length = 0;
        break;
      } 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);