Per a bug report from Theo Schlossnagle, plperl_return_next() leaks
memory in the executor's per-query memory context. It also inefficient:
it invokes get_call_result_type() and TupleDescGetAttInMetadata() for
every call to return_next, rather than invoking them once (per PL/Perl
function call) and memoizing the result.
This patch makes the following changes:
- refactor the code to include all the "per PL/Perl function call" data
inside a single struct, "current_call_data". This means we don't need to
save and restore N pointers for every recursive call into PL/Perl, we
can just save and restore one.
- lookup the return type metadata needed by plperl_return_next() once,
and then stash it in "current_call_data", so avoid doing the lookup for
every call to return_next.
- create a temporary memory context in which to evaluate the return
type's input functions. This memory context is reset for each call to
return_next.
The patch appears to fix the memory leak, and substantially improves the
performance of return_next (~140 ms vs. ~90 ms, in my simple trivial
test -- perhaps less of an improvement for more realistic functions).
The patch isn't minimally invasive -- I was thinking about developing a
more limited patch for REL8_1_STABLE, but I'm not sure if it is worth
the trouble.
Barring any objections, I'll apply this patch to HEAD and possibly
REL8_1_STABLE tomorrow.
-Neil
============================================================
*** src/pl/plperl/plperl.c a4ba9c99e0d5d19ee7fcf9fb6762594a43fd2fae
--- src/pl/plperl/plperl.c 9353d541fb99b966b150480e5ebe390bd155f2e5
***************
*** 84,94 ****
SV *reference;
} plperl_proc_desc;
/**********************************************************************
* Global data
**********************************************************************/
! static int plperl_firstcall = 1;
static bool plperl_safe_init_done = false;
static PerlInterpreter *plperl_interp = NULL;
static HV *plperl_proc_hash = NULL;
--- 84,108 ----
SV *reference;
} plperl_proc_desc;
+ /*
+ * The information we cache for the duration of a single call to a
+ * function.
+ */
+ typedef struct plperl_call_data
+ {
+ plperl_proc_desc *prodesc;
+ FunctionCallInfo fcinfo;
+ Tuplestorestate *tuple_store;
+ TupleDesc ret_tdesc;
+ AttInMetadata *attinmeta;
+ MemoryContext tmp_cxt;
+ } plperl_call_data;
+
/**********************************************************************
* Global data
**********************************************************************/
! static bool plperl_firstcall = true;
static bool plperl_safe_init_done = false;
static PerlInterpreter *plperl_interp = NULL;
static HV *plperl_proc_hash = NULL;
***************
*** 95,105 ****
static bool plperl_use_strict = false;
! /* these are saved and restored by plperl_call_handler */
! static plperl_proc_desc *plperl_current_prodesc = NULL;
! static FunctionCallInfo plperl_current_caller_info;
! static Tuplestorestate *plperl_current_tuple_store;
! static TupleDesc plperl_current_tuple_desc;
/**********************************************************************
* Forward declarations
--- 109,116 ----
static bool plperl_use_strict = false;
! /* this is saved and restored by plperl_call_handler */
! static plperl_call_data *current_call_data = NULL;
/**********************************************************************
* Forward declarations
***************
*** 157,163 ****
EmitWarningsOnPlaceholders("plperl");
plperl_init_interp();
! plperl_firstcall = 0;
}
--- 168,174 ----
EmitWarningsOnPlaceholders("plperl");
plperl_init_interp();
! plperl_firstcall = false;
}
***************
*** 292,298 ****
plperl_safe_init_done = true;
}
-
/*
* Perl likes to put a newline after its error messages; clean up such
*/
--- 303,308 ----
***************
*** 565,574 ****
plperl_call_handler(PG_FUNCTION_ARGS)
{
Datum retval;
! plperl_proc_desc *save_prodesc;
! FunctionCallInfo save_caller_info;
! Tuplestorestate *save_tuple_store;
! TupleDesc save_tuple_desc;
plperl_init_all();
--- 575,581 ----
plperl_call_handler(PG_FUNCTION_ARGS)
{
Datum retval;
! plperl_call_data *save_call_data;
plperl_init_all();
***************
*** 572,582 ****
plperl_init_all();
! save_prodesc = plperl_current_prodesc;
! save_caller_info = plperl_current_caller_info;
! save_tuple_store = plperl_current_tuple_store;
! save_tuple_desc = plperl_current_tuple_desc;
!
PG_TRY();
{
if (CALLED_AS_TRIGGER(fcinfo))
--- 579,585 ----
plperl_init_all();
! save_call_data = current_call_data;
PG_TRY();
{
if (CALLED_AS_TRIGGER(fcinfo))
***************
*** 586,595 ****
}
PG_CATCH();
{
! plperl_current_prodesc = save_prodesc;
! plperl_current_caller_info = save_caller_info;
! plperl_current_tuple_store = save_tuple_store;
! plperl_current_tuple_desc = save_tuple_desc;
PG_RE_THROW();
}
PG_END_TRY();
--- 589,595 ----
}
PG_CATCH();
{
! current_call_data = save_call_data;
PG_RE_THROW();
}
PG_END_TRY();
***************
*** 594,604 ****
}
PG_END_TRY();
! plperl_current_prodesc = save_prodesc;
! plperl_current_caller_info = save_caller_info;
! plperl_current_tuple_store = save_tuple_store;
! plperl_current_tuple_desc = save_tuple_desc;
!
return retval;
}
--- 594,600 ----
}
PG_END_TRY();
! current_call_data = save_call_data;
return retval;
}
***************
*** 947,962 ****
ReturnSetInfo *rsi;
SV *array_ret = NULL;
if (SPI_connect() != SPI_OK_CONNECT)
elog(ERROR, "could not connect to SPI manager");
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);
- plperl_current_prodesc = prodesc;
- plperl_current_caller_info = fcinfo;
- plperl_current_tuple_store = 0;
- plperl_current_tuple_desc = 0;
-
rsi = (ReturnSetInfo *) fcinfo->resultinfo;
if (prodesc->fn_retisset)
--- 943,961 ----
ReturnSetInfo *rsi;
SV *array_ret = NULL;
+ /*
+ * Create the call_data beforing connecting to SPI, so that it is
+ * not allocated in the SPI memory context
+ */
+ current_call_data = (plperl_call_data *) palloc0(sizeof(plperl_call_data));
+ current_call_data->fcinfo = fcinfo;
+
if (SPI_connect() != SPI_OK_CONNECT)
elog(ERROR, "could not connect to SPI manager");
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);
+ current_call_data->prodesc = prodesc;
rsi = (ReturnSetInfo *) fcinfo->resultinfo;
if (prodesc->fn_retisset)
***************
*** 1012,1021 ****
}
rsi->returnMode = SFRM_Materialize;
! if (plperl_current_tuple_store)
{
! rsi->setResult = plperl_current_tuple_store;
! rsi->setDesc = plperl_current_tuple_desc;
}
retval = (Datum) 0;
}
--- 1011,1020 ----
}
rsi->returnMode = SFRM_Materialize;
! if (current_call_data->tuple_store)
{
! rsi->setResult = current_call_data->tuple_store;
! rsi->setDesc = current_call_data->ret_tdesc;
}
retval = (Datum) 0;
}
***************
*** 1080,1085 ****
--- 1079,1085 ----
if (array_ret == NULL)
SvREFCNT_dec(perlret);
+ current_call_data = NULL;
return retval;
}
***************
*** 1093,1107 ****
SV *svTD;
HV *hvTD;
/* Connect to SPI manager */
if (SPI_connect() != SPI_OK_CONNECT)
elog(ERROR, "could not connect to SPI manager");
/* Find or compile the function */
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, true);
- plperl_current_prodesc = prodesc;
-
svTD = plperl_trigger_build_args(fcinfo);
perlret = plperl_call_perl_trigger_func(prodesc, fcinfo, svTD);
hvTD = (HV *) SvRV(svTD);
--- 1093,1113 ----
SV *svTD;
HV *hvTD;
+ /*
+ * Create the call_data beforing connecting to SPI, so that it is
+ * not allocated in the SPI memory context
+ */
+ current_call_data = (plperl_call_data *) palloc0(sizeof(plperl_call_data));
+ current_call_data->fcinfo = fcinfo;
+
/* Connect to SPI manager */
if (SPI_connect() != SPI_OK_CONNECT)
elog(ERROR, "could not connect to SPI manager");
/* Find or compile the function */
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, true);
+ current_call_data->prodesc = prodesc;
svTD = plperl_trigger_build_args(fcinfo);
perlret = plperl_call_perl_trigger_func(prodesc, fcinfo, svTD);
hvTD = (HV *) SvRV(svTD);
***************
*** 1171,1176 ****
--- 1177,1183 ----
if (perlret)
SvREFCNT_dec(perlret);
+ current_call_data = NULL;
return retval;
}
***************
*** 1495,1501 ****
{
int spi_rv;
! spi_rv = SPI_execute(query, plperl_current_prodesc->fn_readonly,
limit);
ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed,
spi_rv);
--- 1502,1508 ----
{
int spi_rv;
! spi_rv = SPI_execute(query, current_call_data->prodesc->fn_readonly,
limit);
ret_hv = plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed,
spi_rv);
***************
*** 1590,1605 ****
void
plperl_return_next(SV *sv)
{
! plperl_proc_desc *prodesc = plperl_current_prodesc;
! FunctionCallInfo fcinfo = plperl_current_caller_info;
! ReturnSetInfo *rsi = (ReturnSetInfo *) fcinfo->resultinfo;
! MemoryContext cxt;
HeapTuple tuple;
- TupleDesc tupdesc;
if (!sv)
return;
if (!prodesc->fn_retisset)
ereport(ERROR,
(errcode(ERRCODE_SYNTAX_ERROR),
--- 1597,1615 ----
void
plperl_return_next(SV *sv)
{
! plperl_proc_desc *prodesc;
! FunctionCallInfo fcinfo;
! ReturnSetInfo *rsi;
! MemoryContext old_cxt;
HeapTuple tuple;
if (!sv)
return;
+ prodesc = current_call_data->prodesc;
+ fcinfo = current_call_data->fcinfo;
+ rsi = (ReturnSetInfo *) fcinfo->resultinfo;
+
if (!prodesc->fn_retisset)
ereport(ERROR,
(errcode(ERRCODE_SYNTAX_ERROR),
***************
*** 1612,1632 ****
errmsg("setof-composite-returning Perl function "
"must call return_next with reference to hash")));
! cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory);
! if (!plperl_current_tuple_store)
! plperl_current_tuple_store =
tuplestore_begin_heap(true, false, work_mem);
! if (prodesc->fn_retistuple)
{
! TypeFuncClass rettype;
! AttInMetadata *attinmeta;
! rettype = get_call_result_type(fcinfo, NULL, &tupdesc);
! tupdesc = CreateTupleDescCopy(tupdesc);
! attinmeta = TupleDescGetAttInMetadata(tupdesc);
! tuple = plperl_build_tuple_result((HV *) SvRV(sv), attinmeta);
}
else
{
--- 1622,1684 ----
errmsg("setof-composite-returning Perl function "
"must call return_next with reference to hash")));
! if (!current_call_data->ret_tdesc)
! {
! TupleDesc tupdesc;
! Assert(!current_call_data->tuple_store);
! Assert(!current_call_data->attinmeta);
!
! /*
! * This is the first call to return_next in the current
! * PL/Perl function call, so memoize some lookups
! */
! if (prodesc->fn_retistuple)
! (void) get_call_result_type(fcinfo, NULL, &tupdesc);
! else
! tupdesc = rsi->expectedDesc;
!
! /*
! * Make sure the tuple_store and ret_tdesc are sufficiently
! * long-lived.
! */
! old_cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory);
!
! current_call_data->ret_tdesc = CreateTupleDescCopy(tupdesc);
! current_call_data->tuple_store =
tuplestore_begin_heap(true, false, work_mem);
+ if (prodesc->fn_retistuple)
+ {
+ current_call_data->attinmeta =
+ TupleDescGetAttInMetadata(current_call_data->ret_tdesc);
+ }
! MemoryContextSwitchTo(old_cxt);
! }
!
! /*
! * Producing the tuple we want to return requires making plenty of
! * palloc() allocations that are not cleaned up. Since this
! * function can be called many times before the current memory
! * context is reset, we need to do those allocations in a
! * temporary context.
! */
! if (!current_call_data->tmp_cxt)
{
! current_call_data->tmp_cxt =
! AllocSetContextCreate(rsi->econtext->ecxt_per_tuple_memory,
! "PL/Perl return_next temporary cxt",
! ALLOCSET_DEFAULT_MINSIZE,
! ALLOCSET_DEFAULT_INITSIZE,
! ALLOCSET_DEFAULT_MAXSIZE);
! }
! old_cxt = MemoryContextSwitchTo(current_call_data->tmp_cxt);
!
! if (prodesc->fn_retistuple)
! {
! tuple = plperl_build_tuple_result((HV *) SvRV(sv),
! current_call_data->attinmeta);
}
else
{
***************
*** 1630,1640 ****
}
else
{
! Datum ret;
! bool isNull;
- tupdesc = CreateTupleDescCopy(rsi->expectedDesc);
-
if (SvOK(sv) && SvTYPE(sv) != SVt_NULL)
{
char *val = SvPV(sv, PL_na);
--- 1682,1690 ----
}
else
{
! Datum ret = (Datum) 0;
! bool isNull = true;
if (SvOK(sv) && SvTYPE(sv) != SVt_NULL)
{
char *val = SvPV(sv, PL_na);
***************
*** 1645,1665 ****
Int32GetDatum(-1));
isNull = false;
}
- else
- {
- ret = (Datum) 0;
- isNull = true;
- }
! tuple = heap_form_tuple(tupdesc, &ret, &isNull);
}
! if (!plperl_current_tuple_desc)
! plperl_current_tuple_desc = tupdesc;
! tuplestore_puttuple(plperl_current_tuple_store, tuple);
! heap_freetuple(tuple);
! MemoryContextSwitchTo(cxt);
}
--- 1695,1710 ----
Int32GetDatum(-1));
isNull = false;
}
! tuple = heap_form_tuple(current_call_data->ret_tdesc, &ret, &isNull);
}
! /* Make sure to store the tuple in a long-lived memory context */
! MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory);
! tuplestore_puttuple(current_call_data->tuple_store, tuple);
! MemoryContextSwitchTo(old_cxt);
! MemoryContextReset(current_call_data->tmp_cxt);
}
---------------------------(end of broadcast)---------------------------
TIP 6: explain analyze is your friend
