Integrate from mainperl.

p4raw-id: //depot/cfgperl@3077

17 files changed, 225 insertions, 62 deletions

diff --git a/MANIFEST b/MANIFEST
index 5f4d59792d..4e3d504562 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -36,7 +36,7 @@ README.amiga		Notes about AmigaOS port
 README.beos		Notes about BeOS port
 README.cygwin32		Notes about Cygwin32 port
 README.dos		Notes about dos/djgpp port
-README.hpux		Notes about HP/UX port
+README.hpux		Notes about HP-UX port
 README.lexwarn		Notes about lexical warnings
 README.mint		Notes about Atari MiNT port
 README.mpeix		Notes about MPE/iX port
@@ -170,6 +170,7 @@ ext/B/B/Disassembler.pm	Compiler Disassembler backend
 ext/B/B/Lint.pm		Compiler Lint backend
 ext/B/B/Showlex.pm	Compiler Showlex backend
 ext/B/B/Stackobj.pm	Compiler stack objects support functions
+ext/B/B/Stash.pm	Compiler module to identify stashes
 ext/B/B/Terse.pm	Compiler Terse backend
 ext/B/B/Xref.pm		Compiler Xref backend
 ext/B/B/assemble	Assemble compiler bytecode
diff --git a/README.hpux b/README.hpux
index 1fda51a76d..4cdcf58d9b 100644
--- a/README.hpux
+++ b/README.hpux
@@ -4,7 +4,7 @@ specially designed to be readable as is.
 
 =head1 NAME
 
-perlhpux - Perl version 5 on Hewlett-Packard Unix (HP-UX) systems
+README.hpux - Perl version 5 on Hewlett-Packard Unix (HP-UX) systems
 
 =head1 DESCRIPTION
 
@@ -65,20 +65,29 @@ The following systems contain with PA-RISC 1.1 chips:
 The most recent upgrade to the PA-RISC design, it added support for 64-bit
 integer data.
 
-The following systems contain PA-RISC 2.0 chips:
+The following systems contain PA-RISC 2.0 chips (this is very likely to be
+out of date):
 
     D270, D280, D370, D380, K250, K260, K370, K380, K450, K460, K570, K580,
     T600, V2200
 
+A complete list of models at the time the OS was built is in the file
+/opt/langtools/lib/sched.models.
+The first column corresponds to the output of the "uname -m" command
+(without the leading "9000/").
+The second column is the PA-RISC version
+and the third column is the exact chip type used.
+
 =head2 Portability Between PA-RISC Versions
 
 An executable compiled on a PA-RISC 2.0 platform will not execute on a
 PA-RISC 1.1 platform, even if they are running the same version of HP-UX.
 If you are building Perl on a PA-RISC 2.0 platform and want that Perl to
-to also run on a PA-RISC 1.1, the compiler flag +DAportable should be used.
+to also run on a PA-RISC 1.1, the compiler flags +DAportable and +DS32
+should be used.
 
 It is no longer possible to compile PA-RISC 1.0 executables on either the
-PA-RISC 1.1 and 2.0 platforms.
+PA-RISC 1.1 or 2.0 platforms.
 
 =head2 Building Dynamic Extensions on HP-UX
 
@@ -131,10 +140,11 @@ config.sh file.
 
 =head2 Using Large Files with Perl
 
-Beginning with HP-UX version 10.10, files larger than 2GB (2^31) may be
+Beginning with HP-UX version 10.20, files larger than 2GB (2^31) may be
 created and manipulated.
 Three separate methods of doing this are available.
-The best method is to compile Perl using the -D_FILE_OFFSET_BITS=64
+Of these methods,
+the best method for Perl is to compile using the -D_FILE_OFFSET_BITS=64
 compiler flag.
 This causes Perl to be compiled using structures and functions in which
 these are 64 bits wide, rather than 32 bits wide.
@@ -143,9 +153,19 @@ There are only two drawbacks to this approach:
 the first is that the seek and tell functions (both the builtin version
 and the POSIX module's version) will not correctly
 function for these large files
-(POSIX declared the offset arguments in seek and tell as being of type long).
+(the offset arguments in seek and tell are implemented as type long).
 The second is that any extension which calls any file-manipulating C function
-will need to be recompiled.
+will need to be recompiled using the above-mentioned -D_FILE_OFFSET_BITS=64
+flag.
+The list of functions that will need to recompiled is:
+creat,		fgetpos,	fopen,
+freopen,	fsetpos,	fstat,
+fstatvfs,	fstatvfsdev,	ftruncate,
+ftw,		lockf,		lseek,
+lstat,		mmap,		nftw,
+open,		prealloc,	stat,
+statvfs,	statvfsdev,	tmpfile,
+truncate,	getrlimit,	setrlimit
 
 =head2 Threaded Perl
 
@@ -180,6 +200,19 @@ now located at /lib/pa20_64/libc.sl.
 On the brighter side, the large file problem goes away, as longs are now
 64 bits wide.
 
+=head2 GDBM and Threads
+
+If you attempt to compile Perl with threads on an 11.X system and also link
+in the GDBM library, then Perl will immediately core dump when it starts up.
+The only workaround at this point is to relink the GDBM library under 11.X,
+then relink it into Perl.
+
+=head2 NFS filesystems and utime(2)
+
+If you are compiling Perl on a remotely-mounted NFS filesystem, the test
+io/fs.t may fail on test #18.
+This appears to be a bug in HP-UX and no fix is currently available.
+
 =head1 AUTHOR
 
 Jeff Okamoto <okamoto@corp.hp.com>
@@ -188,6 +221,6 @@ With much assistance regarding shared libraries from Marc Sabatella.
 
 =head1 DATE
 
-Version 0.1: 1999/2/22
+Version 0.2: 1999/03/01
 
 =cut
diff --git a/cc_runtime.h b/cc_runtime.h
index 9a01ff8335..5b6d2c7287 100644
--- a/cc_runtime.h
+++ b/cc_runtime.h
@@ -59,13 +59,39 @@
 	SPAGAIN;				\
     } while (0)
 
-#define PP_ENTERTRY(jmpbuf,label) do {		\
-	dJMPENV;				\
+#define B_JMPENV_PUSH(cur_env,v) \
+    STMT_START {                                        \
+        cur_env.je_prev = PL_top_env;                   \
+        OP_REG_TO_MEM;                                  \
+        cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, 1);    \
+        OP_MEM_TO_REG;                                  \
+        PL_top_env = &cur_env;                          \
+        cur_env.je_mustcatch = FALSE;                   \
+        (v) = cur_env.je_ret;                           \
+    } STMT_END
+#define B_JMPENV_POP(cur_env) \
+    STMT_START { PL_top_env = cur_env.je_prev; } STMT_END
+
+#define B_JMPENV_JUMP(cur_env,v) \
+    STMT_START {                                                \
+        OP_REG_TO_MEM;                                          \
+        if (PL_top_env->je_prev)                                        \
+            PerlProc_longjmp(PL_top_env->je_buf, (v));                  \
+        if ((v) == 2)                                           \
+            PerlProc_exit(STATUS_NATIVE_EXPORT);                                \
+        PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");     \
+        PerlProc_exit(1);                                               \
+    } STMT_END    
+
+
+#define PP_ENTERTRY(jmpbuf,label)  {		\
 	int ret;				\
-	JMPENV_PUSH(ret);			\
+	B_JMPENV_PUSH(jmpbuf,ret);			\
 	switch (ret) {				\
-	case 1: JMPENV_POP; JMPENV_JUMP(1);	\
-	case 2: JMPENV_POP; JMPENV_JUMP(2);	\
-	case 3: JMPENV_POP; SPAGAIN; goto label;\
-	}					\
+	case 1: B_JMPENV_POP(jmpbuf); B_JMPENV_JUMP(jmpbuf,1);	\
+	case 2: B_JMPENV_POP(jmpbuf); B_JMPENV_JUMP(jmpbuf,2);	\
+	case 3: B_JMPENV_POP(jmpbuf); SPAGAIN; goto label;\
+	}                                       \
     } while (0)
+
+#define PP_LEAVETRY PL_top_env=PL_top_env->je_prev
diff --git a/config_h.SH b/config_h.SH
index 06b7c8c688..ba2a558995 100644
--- a/config_h.SH
+++ b/config_h.SH
@@ -1092,6 +1092,22 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
 #define MEM_ALIGNBYTES $alignbytes
 #endif
 
+/* INTSIZE:
+ *	This symbol contains the value of sizeof(int) so that the C
+ *	preprocessor can make decisions based on it.
+ */
+/* LONGSIZE:
+ *	This symbol contains the value of sizeof(long) so that the C
+ *	preprocessor can make decisions based on it.
+ */
+/* SHORTSIZE:
+ *	This symbol contains the value of sizeof(short) so that the C
+ *	preprocessor can make decisions based on it.
+ */
+#define INTSIZE $intsize		/**/
+#define LONGSIZE $longsize		/**/
+#define SHORTSIZE $shortsize		/**/
+
 /* BYTEORDER:
  *	This symbol holds the hexadecimal constant defined in byteorder,
  *	i.e. 0x1234 or 0x4321, etc...
diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index 67b20b965a..759b9cd8a7 100644
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -1301,12 +1301,6 @@ sub descend_marked_unused {
     }
 }
 
-sub descend_marked_unused {
-    foreach my $pack (keys %unused_sub_packages)
-    {
-    	mark_package($pack);
-    }
-}
  
 sub save_main {
     warn "Starting compile\n";
diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index 08429cb0a7..d44a119222 100644
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -8,10 +8,10 @@
 package B::CC;
 use strict;
 use B qw(main_start main_root class comppadlist peekop svref_2object
-	timing_info init_av  
+	timing_info init_av  sv_undef
 	OPf_WANT_LIST OPf_WANT OPf_MOD OPf_STACKED OPf_SPECIAL
 	OPpASSIGN_BACKWARDS OPpLVAL_INTRO OPpDEREF_AV OPpDEREF_HV
-	OPpDEREF OPpFLIP_LINENUM G_ARRAY     
+	OPpDEREF OPpFLIP_LINENUM G_ARRAY G_SCALAR    
 	CXt_NULL CXt_SUB CXt_EVAL CXt_LOOP CXt_SUBST CXt_BLOCK
 	);
 use B::C qw(save_unused_subs objsym init_sections mark_unused
@@ -444,7 +444,7 @@ sub doop {
 sub gimme {
     my $op = shift;
     my $flags = $op->flags;
-    return (($flags & OPf_WANT) ? ($flags & OPf_WANT_LIST) : "dowantarray()");
+    return (($flags & OPf_WANT) ? (($flags & OPf_WANT)== OPf_WANT_LIST? G_ARRAY:G_SCALAR) : "dowantarray()");
 }
 
 #
@@ -459,10 +459,12 @@ sub pp_null {
 sub pp_stub {
     my $op = shift;
     my $gimme = gimme($op);
-    if ($gimme != 1) {
+    if ($gimme != G_ARRAY) {
+	my $obj= new B::Stackobj::Const(sv_undef);
+    	push(@stack, $obj);
 	# XXX Change to push a constant sv_undef Stackobj onto @stack
-	write_back_stack();
-	runtime("if ($gimme != G_ARRAY) XPUSHs(&PL_sv_undef);");
+	#write_back_stack();
+	#runtime("if ($gimme != G_ARRAY) XPUSHs(&PL_sv_undef);");
     }
     return $op->next;
 }
@@ -921,7 +923,7 @@ sub pp_list {
     my $op = shift;
     write_back_stack();
     my $gimme = gimme($op);
-    if ($gimme == 1) { # sic
+    if ($gimme == G_ARRAY) { # sic
 	runtime("POPMARK;"); # need this even though not a "full" pp_list
     } else {
 	runtime("PP_LIST($gimme);");
@@ -941,6 +943,20 @@ sub pp_entersub {
     invalidate_lexicals(REGISTER|TEMPORARY);
     return $op->next;
 }
+sub pp_formline {
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    write_label($op);
+    write_back_lexicals() unless $skip_lexicals{$ppname};
+    write_back_stack() unless $skip_stack{$ppname};
+    my $sym=doop($op);
+    # See comment in pp_grepwhile to see why!
+    $init->add("((LISTOP*)$sym)->op_first = $sym;");    
+    runtime("if  (PL_op != ($sym)->op_next && PL_op != (OP*)0 ){");
+    runtime( sprintf("goto %s;",label($op)));
+    runtime("}");
+    return $op->next;
+}
 
 sub pp_goto{
 
@@ -996,12 +1012,19 @@ sub pp_entertry {
     write_back_stack();
     my $sym = doop($op);
     my $jmpbuf = sprintf("jmpbuf%d", $jmpbuf_ix++);
-    declare("Sigjmp_buf", $jmpbuf);
+    declare("JMPENV", $jmpbuf);
     runtime(sprintf("PP_ENTERTRY(%s,%s);", $jmpbuf, label($op->other->next)));
     invalidate_lexicals(REGISTER|TEMPORARY);
     return $op->next;
 }
 
+sub pp_leavetry{
+	my $op=shift;
+	default_pp($op);
+	runtime("PP_LEAVETRY;");
+    	return $op->next;
+}
+
 sub pp_grepstart {
     my $op = shift;
     if ($need_freetmps && $freetmps_each_loop) {
diff --git a/ext/B/B/Stash.pm b/ext/B/B/Stash.pm
new file mode 100644
index 0000000000..42c8bc0fd3
--- /dev/null
+++ b/ext/B/B/Stash.pm
@@ -0,0 +1,29 @@
+# Stash.pm -- show what stashes are loaded
+# vishalb@hotmail.com 
+package B::Stash;
+
+BEGIN { %Seen = %INC }
+
+END {
+	my @arr=scan($main::{"main::"});
+	@arr=map{s/\:\:$//;$_;}  @arr;
+	print "-umain,-u", join (",-u",@arr) ,"\n";
+}
+sub scan{
+	my $start=shift;
+	my @return;
+	foreach my $key ( keys %{$start}){
+		if ($key =~ /::$/){
+			unless ($start  eq ${$start}{$key} or $key eq "B::" ){
+		 		push @return, $key ;
+				foreach my $subscan ( scan(${$start}{$key})){
+		 			push @return, "$key".$subscan; 	
+				}
+			}
+		}
+	}
+	return @return;
+}
+1;
+
+
diff --git a/gv.c b/gv.c
index ff278ccc08..ae77d280e5 100644
--- a/gv.c
+++ b/gv.c
@@ -621,12 +621,6 @@ gv_fetchpv(const char *nambeg, I32 add, I32 sv_type)
 	    IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
 	}
 	break;
-
-    case 'a':
-    case 'b':
-	if (len == 1)
-	    GvMULTI_on(gv);
-	break;
     case 'E':
 	if (strnEQ(name, "EXPORT", 6))
 	    GvMULTI_on(gv);
diff --git a/lib/File/Compare.pm b/lib/File/Compare.pm
index 0ee84bdba5..dce78e28ab 100644
--- a/lib/File/Compare.pm
+++ b/lib/File/Compare.pm
@@ -23,7 +23,7 @@ sub compare {
       unless(@_ == 2 || @_ == 3);
 
     my ($from,$to,$size) = @_;
-    my $text_mode = defined($size) && $size < 0;
+    my $text_mode = defined($size) && (ref($size) eq 'CODE' || $size < 0);
 
     my ($fromsize,$closefrom,$closeto);
     local (*FROM, *TO);
@@ -65,8 +65,12 @@ sub compare {
 	local $/ = "\n";
 	my ($fline,$tline);
 	while (defined($fline = <FROM>)) {
-	    unless (defined($tline = <TO>) && $fline eq $tline) {
-		goto fail_inner;
+	    goto fail_inner unless defined($tline = <TO>);
+	    if (ref $size) {
+		# $size contains ref to comparison function
+		goto fail_inner if &$size($fline, $tline);
+	    } else {
+		goto fail_inner if $fline ne $tline;
 	    }
 	}
 	goto fail_inner if defined($tline = <TO>);
@@ -113,8 +117,17 @@ sub compare {
 
 *cmp = \&compare;
 
-# Using a negative buffer size puts compare into text_mode
-sub compare_text { compare(@_[0..1], -1) }
+sub compare_text {
+    my ($from,$to,$cmp) = @_;
+    croak("Usage: compare_text( file1, file2 [, cmp-function])")
+	unless @_ == 2 || @_ == 3;
+    croak("Third arg to compare_text() function must be a code reference")
+	if @_ == 3 && ref($cmp) ne 'CODE';
+
+    # Using a negative buffer size puts compare into text_mode too
+    $cmp = -1 unless defined $cmp;
+    compare($from, $to, $cmp);
+}
 
 1;
 
@@ -142,7 +155,16 @@ File::Compare::cmp is a synonym for File::Compare::compare.  It is
 exported from File::Compare only by request.
 
 File::Compare::compare_text does a line by line comparison of the two
-files. It stops as soon as a difference is detected.
+files. It stops as soon as a difference is detected. compare_text()
+accepts an optional third argument: This must be a CODE reference to
+a line comparison function, which returns 0 when both lines are considered
+equal. For example:
+
+    compare_text($file1, $file2)
+
+is basically equivalent to
+
+    compare_text($file1, $file2, sub {$_[0] ne $_[1]} )
 
 =head1 RETURN
 
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 738f36d4fc..71c0c1c1ce 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -82,7 +82,7 @@ sub runtests {
 	$s .= q[ "-T"] if $first =~ /^#!.*\bperl.*-\w*T/;
 	$fh->close or print "can't close $test. $!\n";
 	my $cmd = ($ENV{'COMPILE_TEST'})? 
-"./perl -I../lib ../utils/perlcc $test -run -verbose dcf -log ./compilelog |" 
+"./perl -I../lib ../utils/perlcc $test -run 2>> ./compilelog |" 
 															:  "$^X $s $test|";
 	$cmd = "MCR $cmd" if $^O eq 'VMS';
 	$fh->open($cmd) or print "can't run $test. $!\n";
diff --git a/op.c b/op.c
index fae524eb71..560a50ed2d 100644
--- a/op.c
+++ b/op.c
@@ -5110,6 +5110,11 @@ ck_sort(OP *o)
 	o->op_private |= OPpLOCALE;
 #endif
 
+    if (o->op_type == OP_SORT) {
+        GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV)); 
+        GvMULTI_on(gv_fetchpv("b", TRUE, SVt_PV)); 
+    }
+
     if (o->op_flags & OPf_STACKED)
 	simplify_sort(o);
     if (o->op_flags & OPf_STACKED) {		     /* may have been cleared */
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 3d9c532f52..15e62f4c22 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -156,7 +156,7 @@ now correctly prints "3|a", instead of "2|a".
 The new format type 'Z' is useful for packing and unpacking null-terminated
 strings.  See L<perlfunc/"pack">.
 
-=head2 pack() format modifier '_' supported
+=head2 pack() format modifier '!' supported
 
 The new format type modifer '!' is useful for packing and unpacking
 native shorts, ints, and longs.  See L<perlfunc/"pack">.
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index a193d672f6..b8580eddd4 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -2598,7 +2598,7 @@ follows:
 
     i	A signed integer value.
     I	An unsigned integer value.
-	  (This 'integer' is _at_least_ 32 bits wide.  Its exact
+	  (This 'integer' is _at least_ 32 bits wide.  Its exact
            size depends on what a local C compiler calls 'int',
            and may even be larger than the 'long' described in
            the next item.)
@@ -2679,16 +2679,16 @@ C<"P"> is C<undef>.
 =item *
 
 The integer types C<"s">, C<"S">, C<"l">, and C<"L"> may be
-immediately followed by a C<"_"> to signify native shorts or longs--as
+immediately followed by a C<"!"> to signify native shorts or longs--as
 you can see from above for example a bare C<"l"> does mean exactly 32
 bits, the native C<long> (as seen by the local C compiler) may be
 larger.  This is an issue mainly in 64-bit platforms.  You can see
-whether using C<"_"> makes any difference by
+whether using C<"!"> makes any difference by
 
-	print length(pack("s")), " ", length(pack("s_")), "\n";
-	print length(pack("l")), " ", length(pack("l_")), "\n";
+	print length(pack("s")), " ", length(pack("s!")), "\n";
+	print length(pack("l")), " ", length(pack("l!")), "\n";
 
-C<"i_"> and C<"I_"> also work but only because of completeness;
+C<"i!"> and C<"I!"> also work but only because of completeness;
 they are identical to C<"i"> and C<"I">.
 
 The actual sizes (in bytes) of native shorts, ints, and longs on
diff --git a/pod/pod2man.PL b/pod/pod2man.PL
index 11bb74bd67..61b6129ed9 100644
--- a/pod/pod2man.PL
+++ b/pod/pod2man.PL
@@ -678,8 +678,24 @@ $indent = 0;
 
 $begun = "";
 
-# Unrolling [^-=A-Z>]|[A-Z](?!<)|[-=][\x00-\xFF] gives:    // MRE pp 165.
-my $nonest = '(?:[^-=A-Z>]*(?:(?:[-=][\x00-\xFF]|[A-Z](?!<))[^-=A-Z>]*)*)';
+# Unrolling [^-=A-Z>]|[A-Z](?!<)|[-=](?![A-Z]<)[\x00-\xFF] gives: // MRE pp 165.
+my $nonest = '(?x)              # Turn on /x mode.
+              (?:               # Group
+                [^-=A-Z>]*      # Anything that isn't a dash, equal sign or
+                                # closing hook isn't special. Eat as much as
+                                # we can.
+                (?:             # Group.
+                  (?:           # Group.
+                    [-=]        # We want to recognize -> and =>.
+                    (?![A-Z]<)  # So, as long as it isn't followed by markup
+                    [\x00-\xFF] # anything may follow - and =
+                    |
+                    [A-Z]       # Capitals are fine too,
+                    (?!<)       # But not if they start markup.
+                  )             # End of special sequences.
+                  [^-=A-Z>]*    # Followed by zero or more non-special chars. 
+                )*              # And we can repeat this as often as we can.
+              )';               # That's all folks.
 
 while (<>) {
     if ($cutting) {
diff --git a/t/lib/bigfloatpm.t b/t/lib/bigfloatpm.t
index a0f0f40054..cf7d09b097 100755
--- a/t/lib/bigfloatpm.t
+++ b/t/lib/bigfloatpm.t
@@ -445,10 +445,10 @@ $Math::BigFloat::div_scale = 20
 $Math::BigFloat::div_scale = 40
 &fsqrt
 +0:0
--1:/^(?i:0|NaNQ?)$
--2:/^(?i:0|NaNQ?)$
--16:/^(?i:0|NaNQ?)$
--123.456:/^(?i:0|NaNQ?)$
+-1:/^(?i:0|\?|NaNQ?)$
+-2:/^(?i:0|\?|NaNQ?)$
+-16:/^(?i:0|\?|NaNQ?)$
+-123.456:/^(?i:0|\?|NaNQ?)$
 +1:1.
 +1.44:1.2
 +2:1.41421356237309504880168872420969807857
diff --git a/t/lib/io_sock.t b/t/lib/io_sock.t
index 79be190d87..edd327e70c 100755
--- a/t/lib/io_sock.t
+++ b/t/lib/io_sock.t
@@ -44,7 +44,7 @@ $port = $listen->sockport;
 
 if($pid = fork()) {
 
-    $sock = $listen->accept();
+    $sock = $listen->accept() or die "accept failed: $!";
     print "ok 2\n";
 
     $sock->autoflush(1);
diff --git a/utils/perlcc.PL b/utils/perlcc.PL
index b214645ad9..2ea822b2b4 100644
--- a/utils/perlcc.PL
+++ b/utils/perlcc.PL
@@ -223,8 +223,11 @@ sub _createCode
 
     if (@_ == 2)                                   # compiling a program   
     {
-        _print( "$^X -I@INC -MO=CC,-o$generated_cfile $file\n", 36);
-        $return =  _run("$ -I@INC -MO=CC,-o$generated_cfile $file", 9);
+        _print( "$^X -I@INC -MB::Stash -c  $file\n", 36);
+        my $stash=`$^X -I@INC -MB::Stash -c  $file 2>/dev/null|tail -1`;
+	chomp $stash;
+        _print( "$^X -I@INC -MO=CC,$stash,-o$generated_cfile $file\n", 36);
+        $return =  _run("$ -I@INC -MO=CC,$stash,-o$generated_cfile $file", 9);
         $return;
     }
     else                                           # compiling a shared object
@@ -311,9 +314,10 @@ sub _ccharness
     }
 
     my @sharedobjects = _getSharedObjects($sourceprog); 
+    my $dynaloader="$Config{'installarchlib'}/auto/DynaLoader/DynaLoader.a";
 
     my $cccmd = 
-        "$Config{cc} @Config{qw(ccflags optimize)} $incdir @sharedobjects @args $linkargs";
+        "$Config{cc} @Config{qw(ccflags optimize)} $incdir @sharedobjects @args $dynaloader $linkargs";
 
 
     _print ("$cccmd\n", 36);
@@ -558,7 +562,7 @@ sub _checkopts
                                                     && $options->{'gen'})
     {
         push(@errors, 
-"ERROR: The options '-regex', '-run', and '-o' are incompatible with '-gen'. 
+"ERROR: The options '-regex', ' -c -run', and '-o' are incompatible with '-gen'. 
        '-gen' says to stop at C generation, and the other three modify the 
        compilation and/or running process!\n");
     }