From 87933686d5402745c6bbd6d45b5b45008da47d4e Mon Sep 17 00:00:00 2001
From: Michael Paquier <michael@otacoo.com>
Date: Wed, 31 Aug 2016 16:54:34 +0900
Subject: [PATCH 2/2] PL-Perl: Replace use of malloc by an internal memory
 context

This makes the code more flexible by using the internal memory context
infrastructure instead of a system-level memory call.
---
 src/pl/plperl/plperl.c | 74 ++++++++++++++++++--------------------------------
 1 file changed, 27 insertions(+), 47 deletions(-)

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 2cd7614..1c6d1e7 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -109,6 +109,7 @@ typedef struct plperl_proc_desc
 	TransactionId fn_xmin;		/* xmin/TID of procedure's pg_proc tuple */
 	ItemPointerData fn_tid;
 	int			refcount;		/* reference count of this struct */
+	MemoryContext memcxt;		/* memory context where this lives */
 	SV		   *reference;		/* CODE reference for Perl sub */
 	plperl_interp_desc *interp; /* interpreter it's created in */
 	bool		fn_readonly;	/* is function readonly (not volatile)? */
@@ -353,23 +354,6 @@ hek2cstr(HE *he)
 	return ret;
 }
 
-/*
- * This routine is a crock, and so is everyplace that calls it.  The problem
- * is that the cached form of plperl functions/queries is allocated permanently
- * (mostly via malloc()) and never released until backend exit.  Subsidiary
- * data structures such as fmgr info records therefore must live forever
- * as well.  A better implementation would store all this stuff in a per-
- * function memory context that could be reclaimed at need.  In the meantime,
- * fmgr_info_cxt must be called specifying TopMemoryContext so that whatever
- * it might allocate, and whatever the eventual function might allocate using
- * fn_mcxt, will live forever too.
- */
-static void
-perm_fmgr_info(Oid functionId, FmgrInfo *finfo)
-{
-	fmgr_info_cxt(functionId, finfo, TopMemoryContext);
-}
-
 
 /*
  * _PG_init()			- library load-time initialization
@@ -1441,9 +1425,9 @@ plperl_ref_from_pg_array(Datum arg, Oid typid)
 					 &typdelim, &typioparam, &typoutputfunc);
 
 	if ((transform_funcid = get_transform_fromsql(elementtype, current_call_data->prodesc->lang_oid, current_call_data->prodesc->trftypes)))
-		perm_fmgr_info(transform_funcid, &info->transform_proc);
+		fmgr_info(transform_funcid, &info->transform_proc);
 	else
-		perm_fmgr_info(typoutputfunc, &info->proc);
+		fmgr_info(typoutputfunc, &info->proc);
 
 	info->elem_is_rowtype = type_is_rowtype(elementtype);
 
@@ -2626,18 +2610,16 @@ free_plperl_function(plperl_proc_desc *prodesc)
 		SvREFCNT_dec(prodesc->reference);
 		activate_interpreter(oldinterp);
 	}
-	/* Get rid of what we conveniently can of our own structs */
-	/* (FmgrInfo subsidiary info will get leaked ...) */
-	if (prodesc->proname)
-		free(prodesc->proname);
-	list_free(prodesc->trftypes);
-	free(prodesc);
+
+	/* Finish destroying this data */
+	MemoryContextDelete(prodesc->memcxt);
 }
 
 
 static plperl_proc_desc *
 compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
 {
+	volatile MemoryContext plan_cxt = NULL;
 	HeapTuple	procTup;
 	Form_pg_proc procStruct;
 	plperl_proc_key proc_key;
@@ -2646,6 +2628,7 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
 	int			i;
 	plperl_interp_desc *oldinterp = plperl_active_interp;
 	ErrorContextCallback plperl_error_context;
+	MemoryContext oldcontext = CurrentMemoryContext;
 
 	/* We'll need the pg_proc tuple in any case... */
 	procTup = SearchSysCache1(PROCOID, ObjectIdGetDatum(fn_oid));
@@ -2700,23 +2683,19 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
 
 		/************************************************************
 		 * Allocate a new procedure description block
+		 *
+		 * struct prodesc and subsidiary data all live in plan_cxt.
 		 ************************************************************/
-		prodesc = (plperl_proc_desc *) malloc(sizeof(plperl_proc_desc));
-		if (prodesc == NULL)
-			ereport(ERROR,
-					(errcode(ERRCODE_OUT_OF_MEMORY),
-					 errmsg("out of memory")));
-		/* Initialize all fields to 0 so free_plperl_function is safe */
-		MemSet(prodesc, 0, sizeof(plperl_proc_desc));
-
+		plan_cxt = AllocSetContextCreate(TopMemoryContext,
+										 "PL/Perl compile",
+										 ALLOCSET_SMALL_MINSIZE,
+										 ALLOCSET_SMALL_INITSIZE,
+										 ALLOCSET_SMALL_MAXSIZE);
+		MemoryContextSwitchTo(plan_cxt);
+		prodesc = (plperl_proc_desc *) palloc0(sizeof(plperl_proc_desc));
 		prodesc->proname = strdup(NameStr(procStruct->proname));
-		if (prodesc->proname == NULL)
-		{
-			free_plperl_function(prodesc);
-			ereport(ERROR,
-					(errcode(ERRCODE_OUT_OF_MEMORY),
-					 errmsg("out of memory")));
-		}
+		MemoryContextSwitchTo(oldcontext);
+		prodesc->memcxt = plan_cxt;
 		prodesc->fn_xmin = HeapTupleHeaderGetRawXmin(procTup->t_data);
 		prodesc->fn_tid = procTup->t_self;
 
@@ -2725,13 +2704,11 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
 			(procStruct->provolatile != PROVOLATILE_VOLATILE);
 
 		{
-			MemoryContext oldcxt;
-
 			protrftypes_datum = SysCacheGetAttr(PROCOID, procTup,
 										  Anum_pg_proc_protrftypes, &isnull);
-			oldcxt = MemoryContextSwitchTo(TopMemoryContext);
+			MemoryContextSwitchTo(plan_cxt);
 			prodesc->trftypes = isnull ? NIL : oid_array_to_list(protrftypes_datum);
-			MemoryContextSwitchTo(oldcxt);
+			MemoryContextSwitchTo(oldcontext);
 		}
 
 		/************************************************************
@@ -2800,7 +2777,9 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
 			prodesc->fn_retisarray =
 				(typeStruct->typlen == -1 && typeStruct->typelem);
 
-			perm_fmgr_info(typeStruct->typinput, &(prodesc->result_in_func));
+			fmgr_info_cxt(typeStruct->typinput,
+						  &(prodesc->result_in_func),
+						  plan_cxt);
 			prodesc->result_typioparam = getTypeIOParam(typeTup);
 
 			ReleaseSysCache(typeTup);
@@ -2842,8 +2821,9 @@ compile_plperl_function(Oid fn_oid, bool is_trigger, bool is_event_trigger)
 				else
 				{
 					prodesc->arg_is_rowtype[i] = false;
-					perm_fmgr_info(typeStruct->typoutput,
-								   &(prodesc->arg_out_func[i]));
+					fmgr_info_cxt(typeStruct->typoutput,
+								  &(prodesc->arg_out_func[i]),
+								  plan_cxt);
 				}
 
 				/* Identify array attributes */
-- 
2.9.3

