Hi,

    I have a problem with memory management when using a Perl
interpreter embeded in my application as described in perlembed. I'm not
sure if this is the right mailing list for this kind of question, but I
could not find a better one.

    Anyway, my problem lies in the function perl_match that I give
below. If this function is called many times, the memory comsumption of
my program gets very high, so there must be a leak somewhere. However,
the only thing that I'm sure gets created there (the command SV) has its
reference count decreased. So, is there anything else that must be
free()'d, that must have its reference count decreased, etc?

    I'm attaching a simple program that calls that function many times
for test purposes. A couple of notes: the function has some extra
features (such as requesting a PerlInterpreter to be passed, setting
$string to be UTF-8, etc) because I've taken the function directly from
my program, which can have several perl interpreters at the same time
among other things. Also, it probably is not the best to create the
command SV each run, since the contents do not change between runs.
However, I've already tried making command a static variable created
only once, and this did not solve the problem. So I guess I'm doing
something wrong somewhere else.

Here's the function, along with support functions to see the problem:
#include <stdlib.h>
#include <stdio.h>
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>

int
perl_match(PerlInterpreter *interpreter,
           const char      *line,
           SV              *pattern_re)
{
  SV *string;
  SV *re;
  SV *command = NULL;
  SV *retval;
  dSP;

  PERL_SET_CONTEXT(interpreter);

  /* Set the string in a variable */
  string = get_sv("triggerline", TRUE);
  sv_setpv(string, (char *) line);
  SvUTF8_on(string);
  /* Set the regexp in a variable */
  re = get_sv("_re", TRUE);
  sv_setsv(re, pattern_re);
  /* Create the command to run */
  command = newSVpvf("$triggerline =~ tr/\\n\\r//d;"
                     "my @__M = ($triggerline =~ m<$_re>);"
                     "my $match = scalar @__M;"
                     "if ($match) {"
                     "  @_ = @__M;"
                     "  unshift(@_, $triggerline);"
                     "}"
                     "$match;");

  /* Run the command */
  PUSHMARK(SP);
  eval_sv(command, G_SCALAR);
  SPAGAIN;
  retval = POPs;
  PUTBACK;

  SvREFCNT_dec(command);

  return SvIV(retval);
}


SV *
precompute_re(PerlInterpreter *interpreter,
              const char      *re_string)
{
  SV *re_int;
  SV *re_new;
  SV *command;
  dSP;

  PERL_SET_CONTEXT(interpreter);

  command = newSVpvf("$_re = qr<%s>;", re_string);
  PUSHMARK(SP);
  eval_sv(command, G_SCALAR);
  SPAGAIN;
  re_int = POPs;
  PUTBACK;

  SvREFCNT_dec(command);

  re_new = newSVsv(re_int);
  return re_new;
}


int
main(int argc, char *argv[])
{
  char            *line = "Just some line to match.";
  PerlInterpreter *perl_interpreter;
  SV              *re;
  char            *my_argv[] = { "test", "-e", "0" };
  int              i;

  PERL_SYS_INIT3(&argc, &argv, NULL);
  perl_interpreter = perl_alloc();
  perl_construct(perl_interpreter);
  PERL_SET_CONTEXT(perl_interpreter);
  perl_parse(perl_interpreter, NULL, 3, my_argv, (char **)NULL);

  re = precompute_re(perl_interpreter, "regexp");

  printf("Starting...\n");
  for (i = 0; i < 100000; ++i) {
    perl_match(perl_interpreter, line, re);
    if ((i % 10000) == 0) {
      printf("%d\n", i);
    }
  }
  printf("Done, destructing...\n");

  perl_destruct(perl_interpreter);
  perl_free(perl_interpreter);
  PERL_SYS_TERM();

  printf("Exiting.\n");
  return 0;
}

-- 
The advertisement is the most truthful part of a newspaper.
                -- Thomas Jefferson

Eduardo M KALINOWSKI
[EMAIL PROTECTED]
http://move.to/hpkb

Reply via email to