Set up PLPerl trigger data using C code instead of Perl code.

This is an efficiency change, and means we now no longer have to run
"out $_TD; local $_TD = shift;", which was especially pointless in the case of
non-trigger functions where the passed value was always undef anyway.

A tiny open issue is whether we should get rid of the $prolog argument of
mkfunc, and the corresponding pushed value, which is now just a constant "false".

Tim Bunce, reviewed by Alex Hunsaker.

diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index e10560330374863d2b84669dab31f6513ad9f516..ece3931982e5cb0d1d6e73c6f96b213ecc61358e 100644 (file)
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -1422,7 +1422,7 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid)
    EXTEND(SP, 4);
    PUSHs(sv_2mortal(newSVstring(subname)));
    PUSHs(sv_2mortal(newRV_noinc((SV *) pragma_hv)));
-   PUSHs(sv_2mortal(newSVstring("our $_TD; local $_TD=shift;")));
+   PUSHs(&PL_sv_no); /* XXX is $prolog in mkfunc needed any more? */
    PUSHs(sv_2mortal(newSVstring(s)));
    PUTBACK;
 
@@ -1494,9 +1494,7 @@ plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
    SAVETMPS;
 
    PUSHMARK(SP);
-   EXTEND(sp, 1 + desc->nargs);
-
-   PUSHs(&PL_sv_undef);        /* no trigger data */
+   EXTEND(sp, desc->nargs);
 
    for (i = 0; i < desc->nargs; i++)
    {
@@ -1576,21 +1574,22 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
                              SV *td)
 {
    dSP;
-   SV         *retval;
-   Trigger    *tg_trigger;
-   int         i;
-   int         count;
+   SV         *retval, *TDsv;
+   int         i, count;
+   Trigger    *tg_trigger = ((TriggerData *) fcinfo->context)->tg_trigger;
 
    ENTER;
    SAVETMPS;
 
-   PUSHMARK(sp);
+   TDsv = get_sv("_TD", GV_ADD);
+   SAVESPTR(TDsv); /* local $_TD */
+   sv_setsv(TDsv, td);
 
-   XPUSHs(td);
+   PUSHMARK(sp);
+   EXTEND(sp, tg_trigger->tgnargs);
 
-   tg_trigger = ((TriggerData *) fcinfo->context)->tg_trigger;
    for (i = 0; i < tg_trigger->tgnargs; i++)
-       XPUSHs(sv_2mortal(newSVstring(tg_trigger->tgargs[i])));
+       PUSHs(sv_2mortal(newSVstring(tg_trigger->tgargs[i])));
    PUTBACK;
 
    /* Do NOT use G_KEEPERR here */