Resync with mainline post RC1

p4raw-id: //depot/vmsperl@5690

11 files changed, 56 insertions, 52 deletions

diff --git a/ext/B/B/Asmdata.pm b/ext/B/B/Asmdata.pm
index d62967fe12..bc0eda935b 100644
--- a/ext/B/B/Asmdata.pm
+++ b/ext/B/B/Asmdata.pm
@@ -72,7 +72,7 @@ $insn_data{xcv_file} = [48, \&PUT_pvcontents, "GET_pvcontents"];
 $insn_data{xcv_depth} = [49, \&PUT_I32, "GET_I32"];
 $insn_data{xcv_padlist} = [50, \&PUT_svindex, "GET_svindex"];
 $insn_data{xcv_outside} = [51, \&PUT_svindex, "GET_svindex"];
-$insn_data{xcv_flags} = [52, \&PUT_U8, "GET_U8"];
+$insn_data{xcv_flags} = [52, \&PUT_U16, "GET_U16"];
 $insn_data{av_extend} = [53, \&PUT_I32, "GET_I32"];
 $insn_data{av_push} = [54, \&PUT_svindex, "GET_svindex"];
 $insn_data{xav_fill} = [55, \&PUT_I32, "GET_I32"];
diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm
index cb061f3038..27003b6bd0 100644
--- a/ext/B/B/Bytecode.pm
+++ b/ext/B/B/Bytecode.pm
@@ -463,20 +463,23 @@ sub B::GV::bytecode {
     return if saved($gv);
     my $ix = $gv->objix;
     mark_saved($gv);
-    my $gvname = $gv->NAME;
-    my $name = cstring($gv->STASH->NAME . "::" . $gvname);
-    my $egv = $gv->EGV;
-    my $egvix = $egv->objix;
     ldsv($ix);
-    printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS, $gv->LINE, pvstring($gv->FILE);
+    printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS;
 sv_flags 0x%x
 xgv_flags 0x%x
+EOT
+    my $refcnt = $gv->REFCNT;
+    printf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1;
+    return if $gv->is_empty;
+    printf <<"EOT", $gv->LINE, pvstring($gv->FILE);
 gp_line %d
 newpv %s
 gp_file
 EOT
-    my $refcnt = $gv->REFCNT;
-    printf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1;
+    my $gvname = $gv->NAME;
+    my $name = cstring($gv->STASH->NAME . "::" . $gvname);
+    my $egv = $gv->EGV;
+    my $egvix = $egv->objix;
     my $gvrefcnt = $gv->GvREFCNT;
     printf("gp_refcnt_add %d\n", $gvrefcnt - 1) if $gvrefcnt > 1;
     if ($gvrefcnt > 1 &&  $ix != $egvix) {
@@ -580,7 +583,7 @@ sub B::CV::bytecode {
     for ($i = 0; $i < @ixes; $i++) {
 	printf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
     }
-    printf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->FLAGS;
+    printf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->CvFLAGS;
     printf "newpv %s\nxcv_file\n", pvstring($cv->FILE);
     # Now save all the subfields (except for CvROOT which was handled
     # above) and CvSTART (now the initial element of @subfields).
@@ -650,7 +653,7 @@ sub bytecompile_main {
     walkoptree(main_root, "bytecode");
     warn "done main program, now walking symbol table\n" if $debug_bc;
     my ($pack, %exclude);
-    foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS strict vars
+    foreach $pack (qw(B O AutoLoader DynaLoader XSLoader Config DB VMS strict vars
 		      FileHandle Exporter Carp UNIVERSAL IO Fcntl Symbol
 		      SelectSaver blib Cwd))
     {
diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index dafef33bb1..d0c8159d9f 100644
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -1068,7 +1068,7 @@ typedef struct {
     perl_mutex *xcv_mutexp;
     struct perl_thread *xcv_owner;	/* current owner thread */
 #endif /* USE_THREADS */
-    U8		xcv_flags;
+    cv_flags_t	xcv_flags;
 } XPVCV_or_similar;
 #define ANYINIT(i) i
 #else
diff --git a/ext/B/B/Stash.pm b/ext/B/B/Stash.pm
index fca3443c13..0a3543eed4 100644
--- a/ext/B/B/Stash.pm
+++ b/ext/B/B/Stash.pm
@@ -29,7 +29,7 @@ sub scan{
 }
 sub omit{
 	my $module = shift;
-	my %omit=("DynaLoader::" => 1 , "CORE::" => 1 ,
+	my %omit=("DynaLoader::" => 1 , "XSLoader::" => 1, "CORE::" => 1 ,
 		"CORE::GLOBAL::" => 1, "UNIVERSAL::" => 1 );
 	return 1 if $omit{$module};
 	if ($module eq "IO::" or $module eq "IO::Handle::"){
diff --git a/ext/B/B/Xref.pm b/ext/B/B/Xref.pm
index 0a5ceabda1..b4078b8bd3 100644
--- a/ext/B/B/Xref.pm
+++ b/ext/B/B/Xref.pm
@@ -324,7 +324,7 @@ sub xref_definitions {
     my ($pack, %exclude);
     return if $nodefs;
     $subname = "(definitions)";
-    foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS
+    foreach $pack (qw(B O AutoLoader DynaLoader XSLoader Config DB VMS
 		      strict vars FileHandle Exporter Carp)) {
         $exclude{$pack."::"} = 1;
     }
diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h
index 6e19e129df..1621fed4eb 100644
--- a/ext/ByteLoader/bytecode.h
+++ b/ext/ByteLoader/bytecode.h
@@ -30,8 +30,22 @@ typedef IV IV64;
 	}				\
     } STMT_END
 
-#define BGET_comment_t(arg) \
+#ifdef BYTELOADER_LOG_COMMENTS
+#  define BGET_comment_t(arg) \
+    STMT_START {							\
+	char buf[1024];							\
+	int i = 0;							\
+	do {								\
+	    arg = BGET_FGETC();						\
+	    buf[i++] = (char)arg;					\
+	} while (arg != '\n' && arg != EOF);				\
+	buf[i] = '\0';							\
+	PerlIO_printf(PerlIO_stderr(), "%s", buf);			\
+    } STMT_END
+#else
+#  define BGET_comment_t(arg) \
 	do { arg = BGET_FGETC(); } while (arg != '\n' && arg != EOF)
+#endif
 
 /*
  * In the following, sizeof(IV)*4 is just a way of encoding 32 on 64-bit-IV
@@ -113,7 +127,8 @@ typedef IV IV64;
 	((PMOP*)o)->op_pmregexp = arg ? \
 		CALLREGCOMP(aTHX_ arg, arg + bytecode_pv.xpv_cur, ((PMOP*)o)) : 0
 #define BSET_newsv(sv, arg)	sv = NEWSV(666,0); SvUPGRADE(sv, arg)
-#define BSET_newop(o, arg)	o = (OP*)safemalloc(optype_size[arg])
+#define BSET_newop(o, arg)	((o = (OP*)safemalloc(optype_size[arg])), \
+				 memzero((char*)o,optype_size[arg]))
 #define BSET_newopn(o, arg) STMT_START {	\
 	OP *oldop = o;				\
 	BSET_newop(o, arg);			\
diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c
index 595fd4e18d..a1044ab2c0 100644
--- a/ext/ByteLoader/byterun.c
+++ b/ext/ByteLoader/byterun.c
@@ -431,8 +431,8 @@ byterun(pTHXo_ struct bytestream bs)
 	    }
 	  case INSN_XCV_FLAGS:		/* 52 */
 	    {
-		U8 arg;
-		BGET_U8(arg);
+		U16 arg;
+		BGET_U16(arg);
 		CvFLAGS(bytecode_sv) = arg;
 		break;
 	    }
diff --git a/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm
index c86299c619..93b87f9aba 100644
--- a/ext/Data/Dumper/Dumper.pm
+++ b/ext/Data/Dumper/Dumper.pm
@@ -146,11 +146,17 @@ sub Names {
 
 sub DESTROY {}
 
+sub Dump {
+    return &Dumpxs
+	unless $Data::Dumper::Useqq || (ref($_[0]) && $_[0]->{useqq});
+    return &Dumpperl;
+}
+
 #
 # dump the refs in the current dumper object.
 # expects same args as new() if called via package name.
 #
-sub Dump {
+sub Dumpperl {
   my($s) = shift;
   my(@out, $val, $name);
   my($i) = 0;
@@ -440,9 +446,7 @@ sub Dumper {
   return Data::Dumper->Dump([@_]);
 }
 
-#
-# same, only calls the XS version
-#
+# compat stub
 sub DumperX {
   return Data::Dumper->Dumpxs([@_], []);
 }
@@ -687,12 +691,6 @@ of strings corresponding to the supplied values.
 The second form, for convenience, simply calls the C<new> method on its
 arguments before dumping the object immediately.
 
-=item I<$OBJ>->Dumpxs  I<or>  I<PACKAGE>->Dumpxs(I<ARRAYREF [>, I<ARRAYREF]>)
-
-This method is available if you were able to compile and install the XSUB
-extension to C<Data::Dumper>. It is exactly identical to the C<Dump> method 
-above, only about 4 to 5 times faster, since it is written entirely in C.
-
 =item I<$OBJ>->Seen(I<[HASHREF]>)
 
 Queries or adds to the internal table of already encountered references.
@@ -736,12 +734,6 @@ configuration options below.  The values will be named C<$VAR>I<n> in the
 output, where I<n> is a numeric suffix.  Will return a list of strings
 in an array context.
 
-=item DumperX(I<LIST>)
-
-Identical to the C<Dumper()> function above, but this calls the XSUB 
-implementation.  Only available if you were able to compile and install
-the XSUB extensions in C<Data::Dumper>.
-
 =back
 
 =head2 Configuration Variables or Methods
@@ -797,8 +789,8 @@ When set, enables the use of double quotes for representing string values.
 Whitespace other than space will be represented as C<[\n\t\r]>, "unsafe"
 characters will be backslashed, and unprintable characters will be output as
 quoted octal integers.  Since setting this variable imposes a performance
-penalty, the default is 0.  The C<Dumpxs()> method does not honor this
-flag yet.
+penalty, the default is 0.  C<Dump()> will run slower if this flag is set,
+since the fast XSUB implementation doesn't support it yet.
 
 =item $Data::Dumper::Terse  I<or>  I<$OBJ>->Terse(I<[NEWVAL]>)
 
@@ -1031,8 +1023,8 @@ to have, you can use the C<Seen> method to pre-seed the internal reference
 table and make the dumped output point to them, instead.  See L<EXAMPLES>
 above.
 
-The C<Useqq> flag is not honored by C<Dumpxs()> (it always outputs
-strings in single quotes).
+The C<Useqq> flag makes Dump() run slower, since the XSUB implementation
+does not support it.
 
 SCALAR objects have the weirdest looking C<bless> workaround.
 
diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs
index 6394a63b28..990ea74699 100644
--- a/ext/Data/Dumper/Dumper.xs
+++ b/ext/Data/Dumper/Dumper.xs
@@ -711,23 +711,17 @@ Data_Dumper_Dumpxs(href, ...)
 	    I32 gimme = GIMME;
 
 	    if (!SvROK(href)) {		/* call new to get an object first */
-		SV *valarray;
-		SV *namearray;
-
-		if (items == 3) {
-		    valarray = ST(1);
-		    namearray = ST(2);
-		}
-		else
-		    croak("Usage: Data::Dumper::Dumpxs(PACKAGE, VAL_ARY_REF, NAME_ARY_REF)");
+		if (items < 2)
+		    croak("Usage: Data::Dumper::Dumpxs(PACKAGE, VAL_ARY_REF, [NAME_ARY_REF])");
 		
 		ENTER;
 		SAVETMPS;
 		
 		PUSHMARK(sp);
 		XPUSHs(href);
-		XPUSHs(sv_2mortal(newSVsv(valarray)));
-		XPUSHs(sv_2mortal(newSVsv(namearray)));
+		XPUSHs(sv_2mortal(newSVsv(ST(1))));
+		if (items >= 3)
+		    XPUSHs(sv_2mortal(newSVsv(ST(2))));
 		PUTBACK;
 		i = perl_call_method("new", G_SCALAR);
 		SPAGAIN;
diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL
index 0e0f79263d..e0eb604c73 100644
--- a/ext/DynaLoader/DynaLoader_pm.PL
+++ b/ext/DynaLoader/DynaLoader_pm.PL
@@ -77,8 +77,8 @@ $Is_MacOS  = $^O eq 'MacOS';
 @dl_require_symbols = ();       # names of symbols we need
 @dl_resolve_using   = ();       # names of files to link with
 @dl_library_path    = ();       # path to look for files
-@dl_librefs         = ();       # things we have loaded
-@dl_modules         = ();       # Modules we have loaded
+#@dl_librefs         = ();       # things we have loaded
+#@dl_modules         = ();       # Modules we have loaded
 
 # This is a fix to support DLD's unfortunate desire to relink -lc
 @dl_resolve_using = dl_findfile('-lc') if $dlsrc eq "dl_dld.xs";
diff --git a/ext/File/Glob/Glob.xs b/ext/File/Glob/Glob.xs
index 1805f68a96..e01ae7e85a 100644
--- a/ext/File/Glob/Glob.xs
+++ b/ext/File/Glob/Glob.xs
@@ -170,7 +170,7 @@ MODULE = File::Glob		PACKAGE = File::Glob
 void
 doglob(pattern,...)
     char *pattern
-PROTOTYPE:
+PROTOTYPE: $;$
 PREINIT:
     glob_t pglob;
     int i;
@@ -206,4 +206,4 @@ double
 constant(name,arg)
     char *name
     int   arg
-PROTOTYPE:
+PROTOTYPE: $$