lazyparse: #274 WIP

on SUB subname scan the block ahead and store it
as string SV in CvLAZY(PL_compcv).
Don't store any optree, defer it to later when the sub
is actually called.
This is a benefit when there's a lot of dead code (~70% typically)
and the storage to store the string buffers is not too big.
i.e. many ops or 1-3 ops.

Better than storing the block buffer would be just to store just
the mmap'ed bufptr, offset and len of the source file. But we don't
mmap by default yet, even if it's faster.

Note that subs are stored in slabs. As we store almost no slabs at
compile-time (via PL_compcv) it gets tricky.

cv.h

@@ -53,6 +53,13 @@ See L<perlguts/Autoloading with XSUBs>.
 /* Used as temp. library handle :native($lib), and then as ffi_cif handle,
    the signature */
 #define CvFFILIB(sv)	((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_start_u.xcv_ffilib
+#ifdef LAZY_PARSE
+#define CvLAZY(sv)	(!CvROOT(sv) && CvLAZYBUF(sv))
+#define CvLAZYBUF(sv)	((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_start_u.xcv_lazy
+#else
+#define CvLAZY(sv)	0
+#define CvLAZYBUF(sv)	NULL
+#endif
 #define CvGV(sv)	S_CvGV(aTHX_ (CV *)(sv))
 #define CvGV_set(cv,gv)	Perl_cvgv_set(aTHX_ cv, gv)
 #define CvHASGV(cv)	cBOOL(SvANY(cv)->xcv_gv_u.xcv_gv)
@@ -156,10 +163,17 @@ See L<perlguts/Autoloading with XSUBs>.
 #define CVf_PURE	0x100000 /* purely functional, side-effect free */
 #define CVf_STATIC	0x200000 /* statically allocated padlist and proto */
 #define CVf_INLINABLE	0x400000 /* Should be inlined */
+<<<<<<< HEAD
 #define CVf_EXTERN	0x800000 /* ffi declaration. extern or :native */
 #define CVf_MULTI	0x1000000 /* multi dispatch on types (nyi) */
 #define CVf_LAZYPARSE	0x2000000 /* TODO GH #274 */
 #define CVf_FFILIB_HANDLE 0x4000000 /* If is a DynaLoader libhandle */
+||||||| merged common ancestors
+#define CVf_MULTI	0x800000 /* multi dispatch on types */
+=======
+#define CVf_MULTI	0x800000 /* multi dispatch on types */
+#define CVf_LAZYPARSE	0x1000000 /*  */
+>>>>>>> lazyparse: #274 WIP
 
 /* This symbol for optimised communication between toke.c and op.c: */
 #define CVf_BUILTIN_ATTRS	(CVf_METHOD|CVf_LVALUE|CVf_CONST|CVf_ANONCONST \
@@ -263,13 +277,19 @@ See L<perlguts/Autoloading with XSUBs>.
 #define CvPURE(cv)		(CvFLAGS(cv) & CVf_PURE)
 #define CvPURE_on(cv)		(CvFLAGS(cv) |= CVf_PURE)
 #define CvSTATIC(cv)		(CvFLAGS(cv) & CVf_STATIC)
+<<<<<<< HEAD
 #define CvEXTERN(cv)		(CvFLAGS(cv) & CVf_EXTERN)
 #ifdef PERL_CORE
 #define CvEXTERN_on(cv)	        (CvFLAGS(cv) |= (CVf_EXTERN|CVf_ISXSUB), CvSLABBED_off(cv))
 #define CvFFILIB_HANDLE(cv)	(CvFLAGS(cv) & CVf_FFILIB_HANDLE)
 #define CvFFILIB_HANDLE_on(cv)  (CvFLAGS(cv) |= CVf_FFILIB_HANDLE)
 #define CvFFILIB_HANDLE_off(cv) (CvFLAGS(cv) &= ~CVf_FFILIB_HANDLE)
 #endif
+||||||| merged common ancestors
+=======
+#define CvLAZYPARSE(cv)		(CvFLAGS(cv) & CVf_LAZYPARSE)
+#define CvLAZYPARSE_on(cv)	(CvFLAGS(cv) |= CVf_LAZYPARSE)
+>>>>>>> lazyparse: #274 WIP
 
 #define CvMULTI(cv)		(CvFLAGS(cv) & CVf_MULTI)
 #define CvMULTI_on(cv)		(CvFLAGS(cv) |= CVf_MULTI)

embed.fnc

@@ -308,11 +308,12 @@ s	|MAGIC*	|get_aux_mg	|NN AV *av
 #endif
 : Used in perly.y
 pR	|OP*	|bind_match	|I32 type|NN OP *left|NN OP *right
-: Used in perly.y
 ApdR	|OP*	|block_end	|I32 floor|NULLOK OP* seq
+ApdR	|OP*	|block_end_lazy	|I32 floor|NULLOK OP* seq
+ApdR	|int	|block_start	|int full
+
 ApR	|U8	|block_gimme
 : Used in perly.y
-ApdR	|int	|block_start	|int full
 Aodp	|void	|blockhook_register |NN BHK *hk
 : Used in perl.c
 p	|void	|boot_core_UNIVERSAL

embed.h

@@ -72,6 +72,7 @@
 #define av_undef(a)		Perl_av_undef(aTHX_ a)
 #define av_unshift(a,b)		Perl_av_unshift(aTHX_ a,b)
 #define block_end(a,b)		Perl_block_end(aTHX_ a,b)
+#define block_end_lazy(a,b)	Perl_block_end_lazy(aTHX_ a,b)
 #define block_gimme()		Perl_block_gimme(aTHX)
 #define block_start(a)		Perl_block_start(aTHX_ a)
 #define bytes_cmp_utf8(a,b,c,d)	Perl_bytes_cmp_utf8(aTHX_ a,b,c,d)

op.c

@@ -433,7 +433,8 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
        which isn't using the slab allocator, like a block-less ffi decl.
        If our sanity checks aren't met, don't use a slab, but allocate the
        OP directly from the heap. */
-    if (!PL_compcv || CvROOT(PL_compcv) || CvEXTERN(PL_compcv)
+    if (!PL_compcv || CvROOT(PL_compcv)
+        || CvEXTERN(PL_compcv) || CvLAZY(PL_compcv)
         || (CvSTART(PL_compcv) && !CvSLABBED(PL_compcv)))
     {
 	o = (OP*)PerlMemShared_calloc(1, sz);
@@ -6540,16 +6541,20 @@ is the body of the block.
 
 Returns the block, possibly modified.
 
+Note that with lazy parsing the seq block will be empty.
+
 =cut
 */
-
 OP*
 Perl_block_end(pTHX_ I32 floor, OP *seq)
 {
     const int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
     OP* retval = scalarseq(seq);
-    OP *o;
+    OP* o;
 
+#ifdef LAZY_PARSE
+    if (!seq) return retval; /* ok, a stub */
+#endif
     /* XXX Is the null PL_parser check necessary here? */
     assert(PL_parser); /* Let’s find out under debugging builds.  */
     if (PL_parser && PL_parser->parsed_sub) {
@@ -6629,6 +6634,21 @@ Perl_block_end(pTHX_ I32 floor, OP *seq)
     return retval;
 }
 
+/*
+=for apidoc Am|OP *	|block_end_lazy	|I32 floor|OP *seq
+
+(XXX WIP, not sure if needed at all)
+Deferred variant of block_end, only called from sub block.
+Stores all info in PL_compcv to call block_end later.
+
+=cut
+*/
+OP*
+Perl_block_end_lazy(pTHX_ I32 floor, OP *seq)
+{
+    return block_end_lazy(floor, seq);
+}
+
 /*
 =head1 Compile-time scope hooks
 
@@ -6650,6 +6670,8 @@ Perl_blockhook_register(pTHX_ BHK *hk)
 
 /*
 =for apidoc newPROG
+
+Adds an eval block or sub block
 =cut
 */
 void
@@ -6755,8 +6777,8 @@ Perl_localize(pTHX_ OP *o, I32 lex)
     PERL_ARGS_ASSERT_LOCALIZE;
 
     if (OpPARENS(o))
-/* [perl #17376]: this appears to be premature, and results in code such as
-   C< our(%x); > executing in list mode rather than void mode */
+        /* [perl #17376]: this appears to be premature, and results in code such as
+           C< our(%x); > executing in list mode rather than void mode */
 #if 0
 	list(o);
 #else

op.h

@@ -747,8 +747,8 @@ This will assert (under -DDEBUGGING) if the entry doesn't contain a valid
 pointer.
 
 =for apidoc mx|void|CALL_BLOCK_HOOKS|which|arg
-Call all the registered block hooks for type C<which>.  C<which> is a
-preprocessing token; the type of C<arg> depends on C<which>.
+Call all the registered block hooks for type C<which> in reverse order (last first).
+C<which> is a preprocessing token; the type of C<arg> depends on C<which>.
 
 =cut
 */

perl.h

@@ -11,6 +11,8 @@
 #ifndef H_PERL
 #define H_PERL 1
 
+#define LAZY_PARSE
+
 #ifdef PERL_FOR_X2P
 /*
  * This file is being used for x2p stuff.

proto.h

@@ -487,6 +487,10 @@ PERL_CALLCONV OP*	Perl_block_end(pTHX_ I32 floor, OP* seq)
 			__attribute__global__
 			__attribute__warn_unused_result__;
 
+PERL_CALLCONV OP*	Perl_block_end_lazy(pTHX_ I32 floor, OP* seq)
+			__attribute__global__
+			__attribute__warn_unused_result__;
+
 PERL_CALLCONV U8	Perl_block_gimme(pTHX)
 			__attribute__global__
 			__attribute__warn_unused_result__;

sv.h

@@ -674,6 +674,7 @@ typedef U32 cv_flags_t;
     HV *	xcv_stash;							\
     union {									\
 	OP *	xcv_start;							\
+        SV *    xcv_lazy;                                                       \
 	ANY	xcv_xsubany;							\
 	IV      xcv_ffilib;                                               	\
     }		xcv_start_u;					    		\

toke.c

@@ -9569,14 +9569,24 @@ Perl_yylex(pTHX)
                     lex_stuff_pvn(SvPVX(sig), SvCUR(sig), 0);
                     s = PL_bufptr;
                 }
-		if (!have_name) {
-		    if (PL_curstash)
-			sv_setpvs(PL_subname, "__ANON__");
-		    else
-			sv_setpvs(PL_subname, "__ANON__::__ANON__");
-		    TOKEN(ANONSUB);
-		}
-		force_ident_maybe_lex('&');
+                if (!have_name) {
+                    if (PL_curstash)
+                        sv_setpvs(PL_subname, "__ANON__");
+                    else
+                        sv_setpvs(PL_subname, "__ANON__::__ANON__");
+                    TOKEN(ANONSUB);
+                }
+                force_ident_maybe_lex('&');
+#ifdef LAZY_PARSE
+		s = skipspace(s);
+                /* BEGIN{} is KEY_BEGIN not SUB */
+                if (*s == '{' && key != KEY_BEGIN && !PL_minus_c) {
+                    PL_lex_stuff = NULL;
+                    s = scan_str(s,FALSE,TRUE,FALSE,NULL);
+                    CvLAZYBUF(PL_compcv) = PL_lex_stuff;
+                    CvLAZYPARSE_on(PL_compcv);
+                }
+#endif
                 if (is_extern)
                     ITOKEN(CVf_EXTERN|CVf_ISXSUB|cvflags,EXTERNSUB);
                 else if (key == KEY_multi) /* multi sub, multi, multi method */
@@ -9857,9 +9867,7 @@ S_pending_ident(pTHX)
         GV *const gv = gv_fetchpvn_flags(PL_tokenbuf + 1, tokenbuf_len > 0 ? tokenbuf_len - 1 : 0,
                                          ( UTF ? SVf_UTF8 : 0 ) | GV_ADDMG,
                                          SVt_PVAV);
-        if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
-           )
-        {
+        if (!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv))) {
             /* Downgraded from fatal to warning 20000522 mjd */
             Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
                         "Possible unintended interpolation of %" UTF8f
@@ -9869,11 +9877,10 @@ S_pending_ident(pTHX)
     }
 
     /* build ops for a bareword */
-    pl_yylval.opval = newSVOP(OP_CONST, 0,
+    pl_yylval.opval = newSVOP(OP_CONST, OPpCONST_ENTERED << 8,
 				   newSVpvn_flags(PL_tokenbuf + 1,
                                                       tokenbuf_len > 0 ? tokenbuf_len - 1 : 0,
                                                       UTF ? SVf_UTF8 : 0 ));
-    pl_yylval.opval->op_private = OPpCONST_ENTERED;
     if (pit != '&')
         gv_fetchpvn_flags(PL_tokenbuf+1, tokenbuf_len > 0 ? tokenbuf_len - 1 : 0,
 		     (PL_in_eval ? GV_ADDMULTI : GV_ADD)