1 files changed, 29 insertions, 20 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index 4fb3b40ee8..28e258b7ed 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -34,10 +34,6 @@
 #define PERL_IN_PP_CTL_C
 #include "perl.h"
 
-#ifndef WORD_ALIGN
-#define WORD_ALIGN sizeof(U32)
-#endif
-
 #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
 
 #define dopoptosub(plop)	dopoptosub_at(cxstack, (plop))
@@ -548,16 +544,27 @@ PP(pp_formline)
     bool targ_is_utf8 = FALSE;
     SV * nsv = NULL;
     const char *fmt;
+    MAGIC *mg = NULL;
+
+    if (SvTYPE(tmpForm) >= SVt_PVMG) {
+	/* This might, of course, still return NULL.  */
+	mg = mg_find(tmpForm, PERL_MAGIC_fm);
+    } else {
+	sv_upgrade(tmpForm, SVt_PVMG);
+    }
 
-    if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) {
+    if(!mg) {
 	if (SvREADONLY(tmpForm)) {
 	    SvREADONLY_off(tmpForm);
-	    doparseform(tmpForm);
+	    mg = doparseform(tmpForm);
 	    SvREADONLY_on(tmpForm);
 	}
 	else
-	    doparseform(tmpForm);
+	    mg = doparseform(tmpForm);
+	assert(mg);
     }
+    fpc = (U32*)mg->mg_ptr;
+
     SvPV_force(PL_formtarget, len);
     if (SvTAINTED(tmpForm))
 	SvTAINTED_on(PL_formtarget);
@@ -566,8 +573,6 @@ PP(pp_formline)
     t = SvGROW(PL_formtarget, len + fudge + 1);  /* XXX SvCUR bad */
     t += len;
     f = SvPV_const(tmpForm, len);
-    /* need to jump to the next word */
-    fpc = (U32*)(f + len + WORD_ALIGN - SvCUR(tmpForm) % WORD_ALIGN);
 
     for (;;) {
 	DEBUG_f( {
@@ -4914,7 +4919,7 @@ PP(pp_break)
 	RETURNOP(cx->blk_givwhen.leave_op);
 }
 
-static void
+static MAGIC *
 S_doparseform(pTHX_ SV *sv)
 {
     STRLEN len;
@@ -4932,6 +4937,7 @@ S_doparseform(pTHX_ SV *sv)
     bool ischop;
     bool unchopnum = FALSE;
     int maxops = 12; /* FF_LINEMARK + FF_END + 10 (\0 without preceding \n) */
+    MAGIC *mg;
 
     PERL_ARGS_ASSERT_DOPARSEFORM;
 
@@ -5117,19 +5123,22 @@ S_doparseform(pTHX_ SV *sv)
 
     assert (fpc <= fops + maxops); /* ensure our buffer estimate was valid */
     arg = fpc - fops;
-    { /* need to jump to the next word */
-        int z;
-	z = WORD_ALIGN - SvCUR(sv) % WORD_ALIGN;
-	SvGROW(sv, SvCUR(sv) + z + arg * sizeof(U32) + 4);
-	s = SvPVX(sv) + SvCUR(sv) + z;
-    }
-    Copy(fops, s, arg, U32);
-    Safefree(fops);
-    sv_magic(sv, NULL, PERL_MAGIC_fm, NULL, 0);
-    SvCOMPILED_on(sv);
+
+    /* If we pass the length in to sv_magicext() it will copy the buffer for us.
+       We don't need that, so by setting the length on return we "donate" the
+       buffer to the magic, avoiding an allocation. We could realloc() the
+       buffer to the exact size used, but that feels like it's not worth it
+       (particularly if the rumours are true and some realloc() implementations
+       don't shrink blocks). However, set the true length used in mg_len so that
+       mg_dup only allocates and copies what's actually needed.  */
+    mg = sv_magicext(sv, NULL, PERL_MAGIC_fm, &PL_vtbl_fm,
+		     (const char *const) fops, 0);
+    mg->mg_len = arg * sizeof(U32);
 
     if (unchopnum && repeat)
         Perl_die(aTHX_ "Repeated format line will never terminate (~~ and @#)");
+
+    return mg;
 }