Merge branch 'bc-padl'

Fixed PADLIST's mostly. tests 9,10,48 still fail
48 needs to fix SvPADSTALE

ByteLoader/bytecode.h

@@ -128,14 +128,14 @@ static int bget_swab = 0;
 #define BGET_PV(arg)	STMT_START {					\
 	BGET_U32(arg);							\
 	if (arg) {							\
-	    New(666, bstate->bs_pv.xpv_pv, (U32)arg, char);		\
-	    bl_read(bstate->bs_fdata, bstate->bs_pv.xpv_pv, (U32)arg, 1); \
-	    bstate->bs_pv.xpv_len = (U32)arg;				\
-	    bstate->bs_pv.xpv_cur = (U32)arg - 1;			\
+	    New(666, bstate->bs_pv.pv, (U32)arg, char);		\
+	    bl_read(bstate->bs_fdata, bstate->bs_pv.pv, (U32)arg, 1); \
+	    bstate->bs_pv.len = (U32)arg;				\
+	    bstate->bs_pv.cur = (U32)arg - 1;			\
 	} else {							\
-	    bstate->bs_pv.xpv_pv = 0;					\
-	    bstate->bs_pv.xpv_len = 0;					\
-	    bstate->bs_pv.xpv_cur = 0;					\
+	    bstate->bs_pv.pv = 0;					\
+	    bstate->bs_pv.len = 0;					\
+	    bstate->bs_pv.cur = 0;					\
 	}								\
     } STMT_END
 
@@ -164,7 +164,7 @@ static int bget_swab = 0;
 	arg = (char *) ary;				\
     } while (0)
 
-#define BGET_pvcontents(arg)	arg = bstate->bs_pv.xpv_pv
+#define BGET_pvcontents(arg)	arg = bstate->bs_pv.pv
 /* read until \0. optionally limit the max stringsize for buffer overflow attempts */
 #define BGET_strconst(arg, maxsize) STMT_START {	\
 	char *end = NULL; 				\
@@ -237,7 +237,7 @@ static int bget_swab = 0;
     } STMT_END
 #define BSET_gv_fetchpvn_flags(sv, arg) STMT_START {	 \
         int flags = (arg & 0xff80) >> 7; int type = arg & 0x7f; \
-	sv = (SV*)gv_fetchpv(savepv(bstate->bs_pv.xpv_pv), flags, type); \
+	sv = (SV*)gv_fetchpv(savepv(bstate->bs_pv.pv), flags, type); \
 	BSET_OBJ_STOREX(sv);				 \
     } STMT_END
 
@@ -249,24 +249,24 @@ static int bget_swab = 0;
 
 #define BSET_sv_magic(sv, arg)	sv_magic(sv, Nullsv, arg, 0, 0)
 /* mg_name was previously called mg_pv. we keep the new name and the old index */
-#define BSET_mg_name(mg, arg)	mg->mg_ptr = arg; mg->mg_len = bstate->bs_pv.xpv_cur
+#define BSET_mg_name(mg, arg)	mg->mg_ptr = arg; mg->mg_len = bstate->bs_pv.cur
 #define BSET_mg_namex(mg, arg)			\
 	(mg->mg_ptr = (char*)SvREFCNT_inc((SV*)arg),	\
 	 mg->mg_len = HEf_SVKEY)
 #define BSET_xmg_stash(sv, arg) *(SV**)&(((XPVMG*)SvANY(sv))->xmg_stash) = (arg)
 #define BSET_sv_upgrade(sv, arg)	(void)SvUPGRADE(sv, arg)
 #define BSET_xrv(sv, arg) SvRV_set(sv, arg)
 #define BSET_xpv(sv)	do {	\
-	SvPV_set(sv, bstate->bs_pv.xpv_pv);	\
-	SvCUR_set(sv, bstate->bs_pv.xpv_cur);	\
-	SvLEN_set(sv, bstate->bs_pv.xpv_len);	\
+	SvPV_set(sv, bstate->bs_pv.pv);	\
+	SvCUR_set(sv, bstate->bs_pv.cur);	\
+	SvLEN_set(sv, bstate->bs_pv.len);	\
     } while (0)
 #if PERL_VERSION > 8
 #define BSET_xpvshared(sv)	do {					\
         U32 hash;							\
-        PERL_HASH(hash, bstate->bs_pv.xpv_pv, bstate->bs_pv.xpv_cur);	\
-        SvPV_set(sv, HEK_KEY(share_hek(bstate->bs_pv.xpv_pv,bstate->bs_pv.xpv_cur,hash))); \
-	SvCUR_set(sv, bstate->bs_pv.xpv_cur);				\
+        PERL_HASH(hash, bstate->bs_pv.pv, bstate->bs_pv.cur);	\
+        SvPV_set(sv, HEK_KEY(share_hek(bstate->bs_pv.pv,bstate->bs_pv.cur,hash))); \
+	SvCUR_set(sv, bstate->bs_pv.cur);				\
 	SvLEN_set(sv, 0);						\
     } while (0)
 #else
@@ -282,8 +282,8 @@ static int bget_swab = 0;
 #define BSET_av_push(sv, arg)	av_push((AV*)sv, arg)
 #define BSET_av_pushx(sv, arg)	(AvARRAY(sv)[++AvFILLp(sv)] = arg)
 #define BSET_hv_store(sv, arg)	\
-	hv_store((HV*)sv, bstate->bs_pv.xpv_pv, bstate->bs_pv.xpv_cur, arg, 0)
-#define BSET_pv_free(pv)	Safefree(pv.xpv_pv)
+	hv_store((HV*)sv, bstate->bs_pv.pv, bstate->bs_pv.cur, arg, 0)
+#define BSET_pv_free(sv)	Safefree(sv.pv)
 
 #if PERL_VERSION > 13 || defined(CvGV_set)
 #define BSET_xcv_gv(sv, arg)	(CvGV_set((CV*)bstate->bs_sv, (GV*)arg))
@@ -350,7 +350,7 @@ static int bget_swab = 0;
     STMT_START {                                \
         SV* repointer;                          \
 	REGEXP* rx = arg                                                \
-	    ? CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.xpv_cur, cPMOPx(o)) \
+	    ? CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.cur, cPMOPx(o)) \
 	    : Null(REGEXP*);                                            \
         if(av_len((AV*)PL_regex_pad[0]) > -1) {                         \
             repointer = av_pop((AV*)PL_regex_pad[0]);                   \
@@ -374,7 +374,7 @@ static int bget_swab = 0;
 #define BSET_pregcomp(o, arg) \
     STMT_START {                        \
 	(((PMOP*)o)->op_pmregexp = (arg \
-            ? CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.xpv_cur, cPMOPx(o)) \
+            ? CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.cur, cPMOPx(o)) \
             : Null(REGEXP*)));          \
     } STMT_END
 #endif
@@ -393,7 +393,7 @@ static int bget_swab = 0;
 #if PERL_VERSION < 8
 #define BSET_pregcomp(o, arg)	    \
     ((PMOP*)o)->op_pmregexp = arg   \
-        ? CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.xpv_cur, ((PMOP*)o)) : 0
+        ? CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.cur, ((PMOP*)o)) : 0
 #endif
 
 
@@ -733,9 +733,7 @@ static int bget_swab = 0;
 #endif
 
 /* old reading new + new reading old */
-#define BSET_op_pmflags(r, arg)	STMT_START {		\
-	r = arg;					\
-	} STMT_END
+#define BSET_op_pmflags(r, arg)		r = arg
 
 /* restore dups for stdin, stdout and stderr */
 #define BSET_xio_ifp(sv,fd)						\
@@ -750,13 +748,14 @@ static int bget_swab = 0;
     } STMT_END
 
 #if PERL_VERSION >= 17
-#define BSET_padl_new(padlist)						\
-    STMT_START {							\
-      bstate->bs_sv = (SV*)Perl_pad_new(0);				\
-    } STMT_END
+#define BSET_newpadlx(padl, arg)  STMT_START {		\
+	    padl = (SV*)Perl_pad_new(arg);		\
+	    BSET_OBJ_STOREX(padl);			\
+	} STMT_END
+#define BSET_padl_name(padl, pad)  PadlistARRAY((PADLIST*)padl)[0] = (PAD*)pad
+#define BSET_padl_sym(padl, pad)   PadlistARRAY((PADLIST*)padl)[1] = (PAD*)pad
 #endif
 
-
 /* NOTE: The bytecode header only sanity-checks the bytecode. If a script cares about
  * what version of Perl it's being called under, it should do a 'use 5.006_001' or
  * equivalent. However, since the header includes checks for a match in

Changes

@@ -3,7 +3,7 @@
 	The Perl compiler was in CORE from alpha4 until Perl 5.9.4
 	and worked quite fine with Perl 5.6 and 5.8
 
-1.43	2012-06-xx rurban
+1.43	2012-10-xx rurban
 	Improved package detection: methods, functions, require, new and bless.
 	Bigger compile sizes. Store all subs of dependent packages.
 	5.16 support
@@ -39,16 +39,22 @@
 	amagic_generation was removed with 5.17
 	Fixed $$ ($PID) to be dynamic, issue 108. Thanks to flexvault for reporting this.
         Fixed double precision to 16 digits. The nbody shootout test passes now
+        Fixed refcounts of *ENV, issue 111.
 	* CC (1.13): added check_entersub, check_bless - bless and new caching.
         Use the B::C integer and double precision logic (ivx, nvx).
         Fixed double precision to 16 digits. The nbody shootout is now 2x faster than perl
 	* Bytecode (1.14): fixed require and op_first, issue 97
-	Fixed regex_pad offset in threaded perls >= 5.11, issue 68
+	Fixed regex_pad offset in threaded perls >= 5.11, issue 68.
+        new type B::PAD isa B::AV (PADLIST for 5.17.5),
+        new bytecodes newpadl, padl_name, padl_sym (PADLIST for 5.17.5)
+        * Assembler (1.11): allow "newpadl 0"
 	* t/perldoc.t: perlcc fails with 5.8 because Cwd disturbs the
 	  fragile method package finder for File::Spec. Use cc_harness.
 	* Stash (1.03): fix compilation for 5.8.8 and below: gv_fetchsv missing
 	* perlcc (2.14): new option --dryrun, -v5 does not -Dsp,-v.
 	new option -f passthru to C and CC
+	* perlcc (2.15): fixed default --spawn: use waitpid which was broken for parallel builds.
+        fixed --no-spawn
 
 1.42	2012-02-01 rurban
 	stable up to 5.14

STATUS

@@ -1,10 +1,11 @@
 5.8, 5.6 and earlier had a good core perl compiler, but we are much better.
 
-Our Bytecode compiler disabled for 5.6, we keep the old. The old core compiler
-fails 50% but in mine is a 5.6 blocker.
+Our Bytecode compiler disabled for 5.6, we keep the old. The old core
+compiler fails 50% but in mine is a 5.6 blocker.
 Bytecode is only stable for >=5.8, non-debugging, threaded.
 
-C is used in production, but a bit unstable, not all methods packages are detected.
+C is used in production, but a bit unstable, not all methods packages
+are detected.
 
 CC is very unstable and slow, work in progress.
 
@@ -95,7 +96,7 @@ t/bytecode 	27,46
 t/c 		-
 t/cc 		14,21,30,46,50,103,105
 
-5.15.7:
+5.16.1:
 t/bytecode 	27,46
 t/c 		-
 t/cc 		14,21,30,46,50,103,105
@@ -114,10 +115,16 @@ generally: pass 100%
 5.10.1     pass 100%
 5.12.4     pass 100%
 5.14.2     pass 100%
-5.15.7     fail 4% (unshare_hek) Moose MooseX::Types DateTime DateTime::TimeZone
+5.16.1     fail 4% (unshare_hek) Moose MooseX::Types DateTime DateTime::TimeZone
+5.17.6     ??
 
 Run-time tests not yet fully done
 
+5.17.x status
+-----------
+PADLIST support not yet stable.
+op_static fixed since 5.17.6, 5.17.2-5.17.5 are unusable without -fno-destruct
+
 5.16 status
 -----------
 new XSLoader:load_file

bytecode.pl

@@ -42,7 +42,7 @@ BEGIN
 /* -*- buffer-read-only: t -*-
  *
  *      Copyright (c) 1996-1999 Malcolm Beattie
- *      Copyright (c) 2008,2009,2010,2011 Reini Urban
+ *      Copyright (c) 2008,2009,2010,2011,2012 Reini Urban
  *
  *      You may distribute under the terms of either the GNU General Public
  *      License or the Artistic License, as specified in the README file.
@@ -462,13 +462,13 @@ package B::Asmdata;
 	} else {
 	    printf BYTERUN_C "\t\tBGET_%s(arg);\n", $fundtype;
 	}
-	printf BYTERUN_C "\t\tDEBUG_v(Perl_deb(aTHX_ \"(insn %%3d) $insn $argtype:%s\\n\", insn, $printarg%s));\n",
+	printf BYTERUN_C "\t\tDEBUG_v(Perl_deb(aTHX_ \"(insn %%3d) $insn $argtype:%s\\n\",\n\t\t\t\tinsn, $printarg%s));\n",
 	  $argfmt, ($argtype =~ /index$/ ? ', (int)ix' : '');
 	if ($insn eq 'newopx' or $insn eq 'newop') {
-	    print BYTERUN_C "\t\tDEBUG_v(Perl_deb(aTHX_ \"\t   [%s]\\n\", PL_op_name[arg>>7]));\n";
+	    print BYTERUN_C "\t\tDEBUG_v(Perl_deb(aTHX_ \"\t   [%s %d]\\n\", PL_op_name[arg>>7], bstate->bs_ix));\n";
 	}
 	if ($fundtype eq 'PV') {
-	    print BYTERUN_C "\t\tDEBUG_v(Perl_deb(aTHX_ \"\t   BGET_PV(arg) => \\\"%s\\\"\\n\", bstate->bs_pv.xpv_pv));\n";
+	    print BYTERUN_C "\t\tDEBUG_v(Perl_deb(aTHX_ \"\t   BGET_PV(arg) => \\\"%s\\\"\\n\", bstate->bs_pv.pv));\n";
 	}
     } else {
 	if ($unsupp and $holes{$insn_num}) {
@@ -481,10 +481,15 @@ package B::Asmdata;
 	# Special setter method named after insn
 	print BYTERUN_C "\t\tif (force)\n\t" if $unsupp;
 	print BYTERUN_C "\t\tBSET_$insn($lvalue$optarg);\n";
-	my $optargcast = $optarg eq ", arg" ? ", $printarg" : '';
+	my $optargcast = $optarg eq ", arg" ? ",\n\t\t\t\t$printarg" : '';
+	$optargcast .= ($insn =~ /x$/ and $optarg eq ", arg" ? ", bstate->bs_ix-1" : '');
 	printf BYTERUN_C "\t\tDEBUG_v(Perl_deb(aTHX_ \"\t   BSET_$insn($lvalue%s)\\n\"$optargcast));\n",
 	  $optarg eq ", arg"
-	    ? ($fundtype =~ /(strconst|pvcontents)/ ? ', \"%s\"' : ", ".($argtype =~ /index$/ ? '0x%'.$UVxf : $argfmt))
+	    ? ($fundtype =~ /(strconst|pvcontents)/
+	       ? ($insn =~ /x$/ ? ', \"%s\" ix:%d' : ', \"%s\"')
+	       : (", " .($argtype =~ /index$/ ? '0x%'.$UVxf : $argfmt)
+	               .($insn =~ /x$/ ? ' ix:%d' : ''))
+	    )
 	      : '';
     } elsif ($flags =~ /s/) {
 	# Store instructions to bytecode_obj_list[arg]. "lvalue" field is rvalue.
@@ -602,9 +607,9 @@ package B::Asmdata;
 
 #if PERL_VERSION > 8
 struct byteloader_xpv {
-    char *xpv_pv;
-    int   xpv_cur;
-    int	  xpv_len;
+    char *pv;
+    int   cur;
+    int	  len;
 };
 #endif
 
@@ -860,7 +865,7 @@ =head1 AUTHOR
 2  0 	ldop		PL_op				opindex
 3  0 	stsv		bstate->bs_sv			U32		s
 4  0 	stop		PL_op				U32		s
-5  6.001 stpv		bstate->bs_pv.xpv_pv		U32		x
+5  6.001 stpv		bstate->bs_pv.pv		U32		x
 6  0 	ldspecsv	bstate->bs_sv			U8		x
 7  8 	ldspecsvx	bstate->bs_sv			U8		x
 8  0 	newsv		bstate->bs_sv			U8		x
@@ -870,7 +875,7 @@ =head1 AUTHOR
 12 8	newopx		PL_op				U16		x
 13 0 	newopn		PL_op				U8		x
 14 0 	newpv		none				U32/PV
-15 0 	pv_cur		bstate->bs_pv.xpv_cur		STRLEN
+15 0 	pv_cur		bstate->bs_pv.cur		STRLEN
 16 0 	pv_free		bstate->bs_pv			none		x
 17 0 	sv_upgrade	bstate->bs_sv			U8		x
 18 0 	sv_refcnt	SvREFCNT(bstate->bs_sv)		U32
@@ -1037,6 +1042,6 @@ =head1 AUTHOR
 # restore dup to stdio handles 0-2
 158 0 	xio_ifp		bstate->bs_sv	  		char		x
 159 10 	xpvshared	bstate->bs_sv			none		x
-160 17.005 padl_new	bstate->bs_sv			none		x
-161 17.005 padl_name	PadlistARRAY((PADLIST*)bstate->bs_sv)[0]  svindex
-162 17.005 padl_set	PadlistARRAY((PADLIST*)bstate->bs_sv)[1]  svindex
+160 17.005 newpadlx	bstate->bs_sv			U8		x
+161 17.005 padl_name	bstate->bs_sv			svindex		x
+162 17.005 padl_sym	bstate->bs_sv			svindex		x

lib/B/Assembler.pm

@@ -1,7 +1,7 @@
 #      Assembler.pm
 #
 #      Copyright (c) 1996 Malcolm Beattie
-#      Copyright (c) 2008,2009,2010,2011 Reini Urban
+#      Copyright (c) 2008,2009,2010,2011,2012 Reini Urban
 #
 #      You may distribute under the terms of either the GNU General Public
 #      License or the Artistic License, as specified in the README file.
@@ -17,7 +17,7 @@ no warnings;           # XXX
 
 @ISA       = qw(Exporter);
 @EXPORT_OK = qw(assemble_fh newasm endasm assemble asm maxopix maxsvix);
-$VERSION   = '1.10';
+$VERSION   = '1.11';
 
 use strict;
 my %opnumber;
@@ -425,7 +425,7 @@ sub asm ($;$$) {
   if ( defined $_[1] ) {
     return
       if $_[1] eq "0"
-        and $_[0] !~ /^(?:ldsv|stsv|newsvx?|av_pushx?|av_extend|xav_flags)$/;
+        and $_[0] !~ /^(?:ldsv|stsv|newsvx?|newpadlx|av_extend|xav_flags)$/;
     return if $_[1] eq "1" and $]>5.007 and $_[0] =~ /^(?:sv_refcnt)$/;
   }
   my ( $insn, $arg, $comment ) = @_;