view release on metacpan or  search on metacpan

AVLTree.xs  view on Meta::CPAN

   See http://perldoc.perl.org/perlguts.html#How-do-I-use-all-this-in-extensions? for ways in which to avoid these
   errors when using the macro.

   One way is to begin each static function that invoke the perl API with the dTHX macro to fetch context. This is
   used in the following static functions.
   Another more efficient approach is to prepend pTHX_ to the argument list in the declaration of each static
   function and aTHX_ when each of these functions are invoked. This is used directly in the AVL tree library
   source code.
*/
#define PERL_NO_GET_CONTEXT
  
#ifdef ENABLE_DEBUG
#define TRACEME(x) do {						\
    if (SvTRUE(perl_get_sv("AVLTree::ENABLE_DEBUG", TRUE)))	\
      { PerlIO_stdoutf (x); PerlIO_stdoutf ("\n"); }		\
  } while (0)
#else
#define TRACEME(x)
#endif
  
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
  
#include "ppport.h"
  
#include "avltree.h"
  
#ifdef __cplusplus
}
#endif

typedef avltree_t AVLTree;
typedef avltrav_t AVLTrav;

/* C-level callbacks required by the AVL tree library */

static SV* callback = (SV*)NULL;

static int svcompare(SV *p1, SV *p2) {
  /*
    This is one way to avoid the above mentioned error when 
    declaring the PERL_NO_GET_CONTEXT macro
  */
  dTHX; 
  
  int cmp;
  
  dSP;
  int count;

  //ENTER;
  //SAVETMPS;
  
  PUSHMARK(SP);
  XPUSHs(sv_2mortal(newSVsv(p1)));
  XPUSHs(sv_2mortal(newSVsv(p2)));
  PUTBACK;
  
  /* Call the Perl sub to process the callback */
  count = call_sv(callback, G_SCALAR);

  SPAGAIN;

  if(count != 1)
    croak("Did not return a value\n");
  
  cmp = POPi;
  PUTBACK;

  //FREETMPS;
  //LEAVE;

  return cmp;
}

static SV* svclone(SV* p) {
  dTHX;       /* fetch context */
  
  return newSVsv(p);
}

void svdestroy(SV* p) {
  dTHX;       /* fetch context */
  
  SvREFCNT_dec(p);
}

/*====================================================================
 * XS SECTION                                                     
 *====================================================================*/

MODULE = AVLTree 	PACKAGE = AVLTree

void
new ( class, cmp_fn )
    char* class
    SV*   cmp_fn
    PROTOTYPE: $$
    PREINIT:
        AVLTree* tree;
        AVLTrav* trav;
    PPCODE:
    {
      SV* self;
      HV* hash = newHV();

      TRACEME("Registering callback for comparison");
      if(callback == (SV*)NULL)
        callback = newSVsv(cmp_fn);
      else
        SvSetSV(callback, cmp_fn);
    
      TRACEME("Allocating AVL tree");      
      tree = avltree_new(svcompare, svclone, svdestroy);
      if(tree == NULL)
	croak("Unable to allocate AVL tree");	
      hv_store(hash, "tree", 4, newSViv(PTR2IV(tree)), 0);

      TRACEME("Allocating AVL tree traversal");