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