help with a memory leak

[Bob Clodius]

I have been trying to track down a memory leak off and on for sometime
now.
If anyone can see what I am doing wrong I would greatly appreciate the
help.

We have embedded a perl interpreter into our C code.  Whenever I call
the
"PerlCallFctn" routine,  I end up with a 4k memory leak.  This may not
seem
like a big leak but this function may get called thousands of time.  I
have deleted section
of code that never gets called.  This was built using perl 5.6.1 .

Thanks for any help.

Bob




/************************************************************************************/

/*  Function:  PerlCallFctn             */
/************************************************************************************/

static int
PerlCallFctn( PerlInterpreter *my_perl, const char *pczFuncName,
     DISPPARAMS *pDispParms, VARIANTARG *ps_Result )
{
 /* Note: The following macros assume that there is a perl interpreter
named
     my_perl in the scope... */

 /*
  * pre_Push_Declare
  */

    dSP ;
    SV *pVal;
 /*
  * declare other vars here
  */

 long iIsOk = 0;

    int iCount;
    int i;

 VariantClear ( ps_Result );



 if(my_perl)
 {
  /*
   * pre_push
   */

  ENTER ;
  SAVETMPS;
  PUSHMARK(SP) ;

  iIsOk = 1;

  if ( pDispParms && pDispParms->cArgs )
  {
   /* push inputs to perl function being called onto perl stack*/
   for( i=0; i < pDispParms->cArgs; ++i )
   {
    VARIANTARG *ps_vArg = &pDispParms->rgvarg[i];
    enum VARENUM eType = (enum VARENUM) V_VT(ps_vArg);

    if ( eType & VT_ARRAY )
    {
     XPUSHs( sv_2mortal(newRV_noinc( PerlCreateCallArray ( my_perl,
ps_vArg, &iIsOk ) ) ) );
    }

   } /* End for */
  }

  if( !iIsOk )
  {
   **** never enters here
   PUTBACK ;
   SPAGAIN ;
   PUTBACK ;
   FREETMPS ;
    LEAVE ;

   return( iIsOk );
  }

  /*
   * post_Push
   */

  /* From code in artical CUJ Jan/2002,A stream class for calling Perl
from C++*/
  sv_setsv(ERRSV, &PL_sv_undef);
  PUTBACK ;

  /*
   * call Perl fctn : do NOT use G_DISCARD which ends up removing any
returned values from the stack
   */

  iCount = call_pv     ( pczFuncName, G_SCALAR | G_EVAL );

  /*
   * post_call
   */

  SPAGAIN ;

  /*
   *  Check error code
   */

  /* From code in artical CUJ Jan/2002,A stream class for calling Perl
from C++*/
  if ( SvTRUE(ERRSV) )
  {
             does not enter here
  }

  else
  {
   /*
    * process returned data from Perl Function call
    */

   if( iCount )
   {
    pVal = POPs;

    iIsOk = PerlProcessReturnValue ( my_perl, pVal, ps_Result );
   }
  }

  /*
   * post_process
   */

  PUTBACK ;
  FREETMPS ;
  LEAVE ;

 }

 return ( iIsOk );
}


/************************************************************************************/

/*  Function:  PerlCreateCallArray           */
/************************************************************************************/

static SV*
PerlCreateCallArray ( PerlInterpreter *my_perl, const VARIANTARG
*ps_InVariant, long *piIsOk )
{
 long  iUbound,
    iLbound,
    i1,
    iIsOk = 1;

 SAFEARRAY  *ps_SafeArray = V_ARRAY(ps_InVariant);
 VARIANTARG *ps_Variants;

 AV     *pPerlArray = newAV();

 SafeArrayGetUBound ( ps_SafeArray, 1, &iUbound );
 SafeArrayGetLBound ( ps_SafeArray, 1, &iLbound );
 SafeArrayAccessData ( ps_SafeArray, (void**)&ps_Variants );

 for ( i1 = iLbound; i1 <= iUbound; ++i1 )
 {
  VARIANTARG    *ps_CurrVariant = &ps_Variants[i1];
  enum VARENUM  eCurrType       = (enum VARENUM) V_VT(ps_CurrVariant);

  if(eCurrType & VT_ARRAY)
  {
   av_push
    ( pPerlArray,
     newRV_noinc
     (
      PerlCreateCallArray
      ( my_perl, ps_CurrVariant, &iIsOk
      )
     )
    );
  }
  else
  {
   switch(eCurrType)
   {
   case VT_EMPTY:
   case VT_NULL:
    av_push( pPerlArray, newSVsv(&PL_sv_undef) );
    break;

   case VT_R8:
    av_push( pPerlArray, newSVnv(V_R8(ps_CurrVariant)) );
    break;

   }
  }

 } /* End for */

 *piIsOk = iIsOk;

 return (SV*) pPerlArray;
}



/
/************************************************************************************/

/*  Function:  PerlProcessReturnValue          */
/************************************************************************************/

static int
PerlProcessReturnValue ( PerlInterpreter *my_perl, SV *pVal, VARIANTARG
*ps_Result )
{
 int iIsOk = 1;
 svtype eValType = (svtype) SvTYPE(pVal);

 VariantClear( ps_Result );

 switch( eValType )
 {

 case SVt_NV:
 case SVt_PVNV:
  if ( SvNOK(pVal) )
  {
   V_VT(ps_Result) = VT_R8;
   V_R8(ps_Result) = SvNV(pVal);
  }
  else
  {
   ***never enters here
  }
  break;

 case SVt_PVAV:
  {
   AV    *pArrayVal = (AV*) pVal;
   long    iLength = av_len ( pArrayVal ),
     i;
   SAFEARRAY  *pSafeArray = NULL;
   SAFEARRAYBOUND dim[1];
   dim[0].lLbound = 0;
   dim[0].cElements = iLength+1;

   pSafeArray = SafeArrayCreate(VT_VARIANT, 1, dim);

   {
    SV     **ppElementValue;

    VARIANTARG s_VariantValue;

    VariantInit ( &s_VariantValue );

    for ( i = 0; i <= iLength; ++i )
    {
     VariantClear ( &s_VariantValue );
     (ppElementValue) = av_fetch( pArrayVal, i, 0 );

     iIsOk = PerlProcessReturnValue ( my_perl, *ppElementValue,
&s_VariantValue );

     if ( iIsOk )
     {
      SafeArrayPutElement( pSafeArray, &i, (void*) &s_VariantValue );
     }
     else
     {
      ****never enter here
      break;
     }
    }

    VariantClear ( &s_VariantValue );

    if ( iIsOk )
    {
     V_VT(ps_Result)    = VT_ARRAY | VT_VARIANT;
     V_ARRAY(ps_Result) = pSafeArray;
    }
    else
    {
     ****never enters here
    }
   }
  }
  break;

 case SVt_RV:

  {
   SV *pDerefVal =  SvRV( pVal );
   iIsOk = PerlProcessReturnValue ( my_perl, pDerefVal, ps_Result );
  }
  break;

 }

 return iIsOk;
}