Integrate from mainperl.

p4raw-id: //depot/cfgperl@3393
author: Jarkko Hietaniemi <jhi@iki.fi> 1999-05-11 21:44:59 +0000
committer: Jarkko Hietaniemi <jhi@iki.fi> 1999-05-11 21:44:59 +0000
commit: 27130c9a98b24c6442a9f796599b1927247c27ab (patch)
tree: 7d06fb4f09cc65d1ed91420c66fadd7a0d5d35ee
parent: e3159d07eae19a2ad4bc7e5f2e54e307a931528b (diff)
parent: e0284a306d2de082f33ef0d8787355c6d4e646d8 (diff)
download: perl-27130c9a98b24c6442a9f796599b1927247c27ab.tar.gz
55 files changed, 803 insertions, 313 deletions
diff --git a/Changes b/Changes
index dd39e11e6c..a19392fb2a 100644
--- a/Changes
+++ b/Changes
@@ -79,6 +79,41 @@ Version 5.005_57        Development release working toward 5.006
 ----------------
 
 ____________________________________________________________________________
+[  3385] By: gsar                                  on 1999/05/10  19:33:36
+        Log: "weak" references internals, still needs perlguts documentation
+             (somewhat modified version of patch suggested by Tuomas J. Lukka
+             <lukka@fas.harvard.edu>)
+     Branch: perl
+	   ! dump.c embed.h embed.pl global.sym mg.c objXSUB.h perl.h
+           ! pod/perldiag.pod proto.h sv.c sv.h util.c
+____________________________________________________________________________
+[  3384] By: jhi                                   on 1999/05/10  18:21:43
+        Log: Circumnavigate Digital UNIX 4.0D miniperl core dump
+             (due to QAR 56761) (the bug has been fixed in 4.0E or better)
+     Branch: cfgperl
+           ! INSTALL hints/dec_osf.sh
+____________________________________________________________________________
+[  3381] By: jhi                                   on 1999/05/10  14:39:28
+        Log: Integrate from mainperl.
+     Branch: cfgperl
+	  +> cygwin32/Makefile.SHs cygwin32/build-instructions.READFIRST
+	  +> cygwin32/build-instructions.charles-wilson
+	  +> cygwin32/build-instructions.sebastien-barre
+	  +> cygwin32/build-instructions.steven-morlock
+	  +> cygwin32/build-instructions.steven-morlock2
+	  +> cygwin32/impure_ptr.c cygwin32/ld2.in cygwin32/perlld.in
+	  +> ext/ByteLoader/ByteLoader.pm ext/ByteLoader/ByteLoader.xs
+	  +> ext/ByteLoader/Makefile.PL pod/Win32.pod t/lib/io_linenum.t
+          +> t/op/numconvert.t utils/perlbc.PL
+	   - cygwin32/cw32imp.h cygwin32/gcc2 cygwin32/ld2 cygwin32/perlgcc
+           - cygwin32/perlld
+          !> (integrate 105 files)
+____________________________________________________________________________
+[  3380] By: gsar                                  on 1999/05/10  12:27:14
+        Log: regen regnodes.h
+     Branch: perl
+           ! Changes regnodes.h
+____________________________________________________________________________
 [  3379] By: gsar                                  on 1999/05/10  12:17:26
         Log: From: jan.dubois@ibm.net (Jan Dubois)
              Date: Sat, 01 May 1999 22:55:36 +0200
diff --git a/bytecode.pl b/bytecode.pl
index c61b7aa04e..f53b0cef4b 100644
--- a/bytecode.pl
+++ b/bytecode.pl
@@ -169,8 +169,6 @@ struct bytestream {
 };
 #endif /* INDIRECT_BGET_MACROS */
 
-void *bset_obj_store _((void *, I32));
-
 enum {
 EOT
 
diff --git a/byterun.c b/byterun.c
index f6c523220c..f8c07f9725 100644
--- a/byterun.c
+++ b/byterun.c
@@ -1,5 +1,5 @@
 /*
- *      Copyright (c) 1996-1998 Malcolm Beattie
+ *      Copyright (c) 1996-1999 Malcolm Beattie
  *
  *      You may distribute under the terms of either the GNU General Public
  *      License or the Artistic License, as specified in the README file.
diff --git a/byterun.h b/byterun.h
index 430de55e43..3aac6fa9b9 100644
--- a/byterun.h
+++ b/byterun.h
@@ -1,5 +1,5 @@
 /*
- *      Copyright (c) 1996-1998 Malcolm Beattie
+ *      Copyright (c) 1996-1999 Malcolm Beattie
  *
  *      You may distribute under the terms of either the GNU General Public
  *      License or the Artistic License, as specified in the README file.
@@ -17,8 +17,6 @@ struct bytestream {
 };
 #endif /* INDIRECT_BGET_MACROS */
 
-void *bset_obj_store _((void *, I32));
-
 enum {
     INSN_RET,			/* 0 */
     INSN_LDSV,			/* 1 */
diff --git a/configpm b/configpm
index 4c9eb121aa..dd9e85803d 100755
--- a/configpm
+++ b/configpm
@@ -81,11 +81,11 @@ print CONFIG "\n",
     join("", @v_fast, sort @v_others),
     "!END!\n\n";
 
-# copy config summary format from the myconfig script
+# copy config summary format from the myconfig.SH script
 
 print CONFIG "my \$summary = <<'!END!';\n";
 
-open(MYCONFIG,"<myconfig") || die "open myconfig failed: $!";
+open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
 close(MYCONFIG);
diff --git a/dump.c b/dump.c
index 811fe7886b..cb3a643b03 100644
--- a/dump.c
+++ b/dump.c
@@ -638,6 +638,7 @@ do_magic_dump(I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool du
 #endif
 	    else if (v == &PL_vtbl_amagic)     s = "amagic";
 	    else if (v == &PL_vtbl_amagicelem) s = "amagicelem";
+	    else if (v == &PL_vtbl_backref)    s = "backref";
 	    if (s)
 	        dump_indent(level, file, "    MG_VIRTUAL = &PL_vtbl_%s\n", s);
 	    else
@@ -766,7 +767,10 @@ do_sv_dump(I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops,
     if (flags & SVf_IOK)	sv_catpv(d, "IOK,");
     if (flags & SVf_NOK)	sv_catpv(d, "NOK,");
     if (flags & SVf_POK)	sv_catpv(d, "POK,");
-    if (flags & SVf_ROK)	sv_catpv(d, "ROK,");
+    if (flags & SVf_ROK)  {	
+    				sv_catpv(d, "ROK,");
+	if (SvWEAKREF(sv))	sv_catpv(d, "WEAKREF,");
+    }
     if (flags & SVf_OOK)	sv_catpv(d, "OOK,");
     if (flags & SVf_FAKE)	sv_catpv(d, "FAKE,");
     if (flags & SVf_READONLY)	sv_catpv(d, "READONLY,");
diff --git a/embed.h b/embed.h
index 011cc68a32..aba2f59129 100644
--- a/embed.h
+++ b/embed.h
@@ -96,6 +96,7 @@
 #define debprofdump		Perl_debprofdump
 #define debstack		Perl_debstack
 #define debstackptrs		Perl_debstackptrs
+#define default_protect		Perl_default_protect
 #define delimcpy		Perl_delimcpy
 #define deprecate		Perl_deprecate
 #define die			Perl_die
@@ -136,8 +137,6 @@
 #define do_vecset		Perl_do_vecset
 #define do_vop			Perl_do_vop
 #define dofile			Perl_dofile
-#define dofindlabel		Perl_dofindlabel
-#define dopoptoeval		Perl_dopoptoeval
 #define dounwind		Perl_dounwind
 #define dowantarray		Perl_dowantarray
 #define dump_all		Perl_dump_all
@@ -204,7 +203,6 @@
 #define hv_iterval		Perl_hv_iterval
 #define hv_ksplit		Perl_hv_ksplit
 #define hv_magic		Perl_hv_magic
-#define hv_stashpv		Perl_hv_stashpv
 #define hv_store		Perl_hv_store
 #define hv_store_ent		Perl_hv_store_ent
 #define hv_undef		Perl_hv_undef
@@ -271,6 +269,7 @@
 #define magic_gettaint		Perl_magic_gettaint
 #define magic_getuvar		Perl_magic_getuvar
 #define magic_getvec		Perl_magic_getvec
+#define magic_killbackrefs	Perl_magic_killbackrefs
 #define magic_len		Perl_magic_len
 #define magic_mutexfree		Perl_magic_mutexfree
 #define magic_nextpack		Perl_magic_nextpack
@@ -896,6 +895,7 @@
 #define sv_replace		Perl_sv_replace
 #define sv_report_used		Perl_sv_report_used
 #define sv_reset		Perl_sv_reset
+#define sv_rvweaken		Perl_sv_rvweaken
 #define sv_setiv		Perl_sv_setiv
 #define sv_setiv_mg		Perl_sv_setiv_mg
 #define sv_setnv		Perl_sv_setnv
@@ -1009,10 +1009,10 @@
 #define block_start		CPerlObj::Perl_block_start
 #define boot_core_UNIVERSAL	CPerlObj::Perl_boot_core_UNIVERSAL
 #define bset_obj_store		CPerlObj::Perl_bset_obj_store
-#define bset_obj_store		CPerlObj::Perl_bset_obj_store
 #define byterun			CPerlObj::Perl_byterun
 #define cache_re		CPerlObj::Perl_cache_re
 #define call_list		CPerlObj::Perl_call_list
+#define call_list_body		CPerlObj::Perl_call_list_body
 #define cando			CPerlObj::Perl_cando
 #define cast_i32		CPerlObj::Perl_cast_i32
 #define cast_iv			CPerlObj::Perl_cast_iv
@@ -1070,6 +1070,7 @@
 #define debprofdump		CPerlObj::Perl_debprofdump
 #define debstack		CPerlObj::Perl_debstack
 #define debstackptrs		CPerlObj::Perl_debstackptrs
+#define default_protect		CPerlObj::Perl_default_protect
 #define del_he			CPerlObj::Perl_del_he
 #define del_sv			CPerlObj::Perl_del_sv
 #define del_xiv			CPerlObj::Perl_del_xiv
@@ -1133,16 +1134,15 @@
 #define do_vecset		CPerlObj::Perl_do_vecset
 #define do_vop			CPerlObj::Perl_do_vop
 #define docatch			CPerlObj::Perl_docatch
+#define docatch_body		CPerlObj::Perl_docatch_body
 #define doencodes		CPerlObj::Perl_doencodes
 #define doeval			CPerlObj::Perl_doeval
 #define dofile			CPerlObj::Perl_dofile
 #define dofindlabel		CPerlObj::Perl_dofindlabel
-#define dofindlabel		CPerlObj::Perl_dofindlabel
 #define doform			CPerlObj::Perl_doform
-#define doopen			CPerlObj::Perl_doopen
+#define doopen_pmc		CPerlObj::Perl_doopen_pmc
 #define doparseform		CPerlObj::Perl_doparseform
 #define dopoptoeval		CPerlObj::Perl_dopoptoeval
-#define dopoptoeval		CPerlObj::Perl_dopoptoeval
 #define dopoptolabel		CPerlObj::Perl_dopoptolabel
 #define dopoptoloop		CPerlObj::Perl_dopoptoloop
 #define dopoptosub		CPerlObj::Perl_dopoptosub
@@ -1229,7 +1229,6 @@
 #define hv_iterval		CPerlObj::Perl_hv_iterval
 #define hv_ksplit		CPerlObj::Perl_hv_ksplit
 #define hv_magic		CPerlObj::Perl_hv_magic
-#define hv_stashpv		CPerlObj::Perl_hv_stashpv
 #define hv_store		CPerlObj::Perl_hv_store
 #define hv_store_ent		CPerlObj::Perl_hv_store_ent
 #define hv_undef		CPerlObj::Perl_hv_undef
@@ -1314,6 +1313,7 @@
 #define magic_gettaint		CPerlObj::Perl_magic_gettaint
 #define magic_getuvar		CPerlObj::Perl_magic_getuvar
 #define magic_getvec		CPerlObj::Perl_magic_getvec
+#define magic_killbackrefs	CPerlObj::Perl_magic_killbackrefs
 #define magic_len		CPerlObj::Perl_magic_len
 #define magic_methcall		CPerlObj::Perl_magic_methcall
 #define magic_methcall		CPerlObj::Perl_magic_methcall
@@ -1475,9 +1475,11 @@
 #define peep			CPerlObj::Perl_peep
 #define perl_atexit		CPerlObj::perl_atexit
 #define perl_call_argv		CPerlObj::perl_call_argv
+#define perl_call_body		CPerlObj::perl_call_body
 #define perl_call_method	CPerlObj::perl_call_method
 #define perl_call_pv		CPerlObj::perl_call_pv
 #define perl_call_sv		CPerlObj::perl_call_sv
+#define perl_call_xbody		CPerlObj::perl_call_xbody
 #define perl_construct		CPerlObj::perl_construct
 #define perl_destruct		CPerlObj::perl_destruct
 #define perl_eval_pv		CPerlObj::perl_eval_pv
@@ -1493,8 +1495,10 @@
 #define perl_new_ctype		CPerlObj::perl_new_ctype
 #define perl_new_numeric	CPerlObj::perl_new_numeric
 #define perl_parse		CPerlObj::perl_parse
+#define perl_parse_body		CPerlObj::perl_parse_body
 #define perl_require_pv		CPerlObj::perl_require_pv
 #define perl_run		CPerlObj::perl_run
+#define perl_run_body		CPerlObj::perl_run_body
 #define perl_set_numeric_local	CPerlObj::perl_set_numeric_local
 #define perl_set_numeric_standard	CPerlObj::perl_set_numeric_standard
 #define pidgone			CPerlObj::Perl_pidgone
@@ -2008,6 +2012,7 @@
 #define sv_2pv_nolen		CPerlObj::Perl_sv_2pv_nolen
 #define sv_2uv			CPerlObj::Perl_sv_2uv
 #define sv_add_arena		CPerlObj::Perl_sv_add_arena
+#define sv_add_backref		CPerlObj::Perl_sv_add_backref
 #define sv_backoff		CPerlObj::Perl_sv_backoff
 #define sv_bless		CPerlObj::Perl_sv_bless
 #define sv_catpv		CPerlObj::Perl_sv_catpv
@@ -2027,6 +2032,7 @@
 #define sv_collxfrm		CPerlObj::Perl_sv_collxfrm
 #define sv_compile_2op		CPerlObj::Perl_sv_compile_2op
 #define sv_dec			CPerlObj::Perl_sv_dec
+#define sv_del_backref		CPerlObj::Perl_sv_del_backref
 #define sv_derived_from		CPerlObj::Perl_sv_derived_from
 #define sv_dump			CPerlObj::Perl_sv_dump
 #define sv_eq			CPerlObj::Perl_sv_eq
@@ -2059,6 +2065,7 @@
 #define sv_replace		CPerlObj::Perl_sv_replace
 #define sv_report_used		CPerlObj::Perl_sv_report_used
 #define sv_reset		CPerlObj::Perl_sv_reset
+#define sv_rvweaken		CPerlObj::Perl_sv_rvweaken
 #define sv_setiv		CPerlObj::Perl_sv_setiv
 #define sv_setiv_mg		CPerlObj::Perl_sv_setiv_mg
 #define sv_setnv		CPerlObj::Perl_sv_setnv
diff --git a/embed.pl b/embed.pl
index 32c034fd5b..2fde0dddfb 100755
--- a/embed.pl
+++ b/embed.pl
@@ -245,6 +245,12 @@ my @staticfuncs = qw(
     refto
     seed
     docatch
+    docatch_body
+    perl_parse_body
+    perl_run_body
+    perl_call_body
+    perl_call_xbody
+    call_list_body
     dofindlabel
     doparseform
     dopoptoeval
@@ -254,7 +260,7 @@ my @staticfuncs = qw(
     dopoptosub_at
     save_lines
     doeval
-    doopen
+    doopen_pmc
     sv_ncmp
     sv_i_ncmp
     amagic_ncmp
@@ -372,10 +378,11 @@ my @staticfuncs = qw(
     dump
     do_aspawn
     debprof
-    bset_obj_store
     new_logop
     simplify_sort
     is_handle_constructor
+    sv_add_backref
+    sv_del_backref
     do_trans_CC_simple
     do_trans_CC_count
     do_trans_CC_complex
diff --git a/embedvar.h b/embedvar.h
index 63613efa77..a8d83f5b01 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -53,6 +53,7 @@
 #define PL_ofslen		(PL_curinterp->Tofslen)
 #define PL_op			(PL_curinterp->Top)
 #define PL_opsave		(PL_curinterp->Topsave)
+#define PL_protect		(PL_curinterp->Tprotect)
 #define PL_reg_call_cc		(PL_curinterp->Treg_call_cc)
 #define PL_reg_curpm		(PL_curinterp->Treg_curpm)
 #define PL_reg_eval_set		(PL_curinterp->Treg_eval_set)
@@ -445,6 +446,7 @@
 #define PL_Tofslen		PL_ofslen
 #define PL_Top			PL_op
 #define PL_Topsave		PL_opsave
+#define PL_Tprotect		PL_protect
 #define PL_Treg_call_cc		PL_reg_call_cc
 #define PL_Treg_curpm		PL_reg_curpm
 #define PL_Treg_eval_set	PL_reg_eval_set
@@ -580,6 +582,7 @@
 #define PL_ofslen		(thr->Tofslen)
 #define PL_op			(thr->Top)
 #define PL_opsave		(thr->Topsave)
+#define PL_protect		(thr->Tprotect)
 #define PL_reg_call_cc		(thr->Treg_call_cc)
 #define PL_reg_curpm		(thr->Treg_curpm)
 #define PL_reg_eval_set		(thr->Treg_eval_set)
diff --git a/ext/B/B/Asmdata.pm b/ext/B/B/Asmdata.pm
index ddc391b388..d4128b67ea 100644
--- a/ext/B/B/Asmdata.pm
+++ b/ext/B/B/Asmdata.pm
@@ -1,5 +1,5 @@
 #
-#      Copyright (c) 1996-1998 Malcolm Beattie
+#      Copyright (c) 1996-1999 Malcolm Beattie
 #
 #      You may distribute under the terms of either the GNU General Public
 #      License or the Artistic License, as specified in the README file.
diff --git a/ext/ByteLoader/ByteLoader.pm b/ext/ByteLoader/ByteLoader.pm
index 9faec2e08c..d11d9573c7 100644
--- a/ext/ByteLoader/ByteLoader.pm
+++ b/ext/ByteLoader/ByteLoader.pm
@@ -1,8 +1,5 @@
 package ByteLoader;
 
-use strict;
-use vars qw($VERSION @ISA);
-
 require DynaLoader;
 
 @ISA = qw(DynaLoader);
diff --git a/ext/ByteLoader/ByteLoader.xs b/ext/ByteLoader/ByteLoader.xs
index 98053c7918..24c3ae8492 100644
--- a/ext/ByteLoader/ByteLoader.xs
+++ b/ext/ByteLoader/ByteLoader.xs
@@ -2,7 +2,10 @@
 #include "perl.h"
 #include "XSUB.h"
 
-#include "byterun.c"
+#ifndef WIN32
+/* this is probably not needed manywhere */
+#  include "byterun.c"
+#endif
 
 /* defgv must be accessed differently under threaded perl */
 /* DEFSV et al are in 5.004_56 */
@@ -17,6 +20,7 @@ byteloader_filter(CPerlObj *pPerl, int idx, SV *buf_sv, int maxlen)
 byteloader_filter(int idx, SV *buf_sv, int maxlen)
 #endif
 {
+    dTHR;
     OP *saveroot = PL_main_root;
     OP *savestart = PL_main_start;
 
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index bfa1f78ac0..3bd58ed9b3 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -48,16 +48,18 @@ static void
 SaveError(CPERLarg_ char* pat, ...)
 {
     va_list args;
+    SV *msv;
     char *message;
-    int len;
+    STRLEN len;
 
     /* This code is based on croak/warn, see mess() in util.c */
 
     va_start(args, pat);
-    message = mess(pat, &args);
+    msv = mess(pat, &args);
     va_end(args);
 
-    len = strlen(message) + 1 ;	/* include terminating null char */
+    message = SvPV(msv,len);
+    len++;		/* include terminating null char */
 
     /* Allocate some memory for the error message */
     if (LastError)
diff --git a/ext/Socket/Socket.pm b/ext/Socket/Socket.pm
index 1654b164bb..a0bb95d6e4 100644
--- a/ext/Socket/Socket.pm
+++ b/ext/Socket/Socket.pm
@@ -1,7 +1,7 @@
 package Socket;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-$VERSION = "1.7";
+$VERSION = "1.71";
 
 =head1 NAME
 
@@ -272,7 +272,14 @@ require DynaLoader;
 	UIO_MAXIOV
 );
 
-@EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF);
+@EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF
+
+	       IPPROTO_TCP
+	       TCP_KEEPALIVE
+	       TCP_MAXRT
+	       TCP_MAXSEG
+	       TCP_NODELAY
+	       TCP_STDURG);
 
 %EXPORT_TAGS = (
     crlf    => [qw(CR LF CRLF $CR $LF $CRLF)],
diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs
index 4a8d8765c9..51825871b7 100644
--- a/ext/Socket/Socket.xs
+++ b/ext/Socket/Socket.xs
@@ -26,6 +26,8 @@
 #include "sockadapt.h"
 #endif
 
+#include <netinet/tcp.h>
+
 #ifdef I_SYSUIO
 # include <sys/uio.h>
 #endif
@@ -332,6 +334,12 @@ constant(char *name, int arg)
 #else
 	    goto not_there;
 #endif
+	if (strEQ(name, "IPPROTO_TCP"))
+#ifdef IPPROTO_TCP
+	    return IPPROTO_TCP;
+#else
+	    goto not_there;
+#endif
 	break;
     case 'J':
 	break;
@@ -804,6 +812,36 @@ constant(char *name, int arg)
 #endif
 	break;
     case 'T':
+	if (strEQ(name, "TCP_KEEPALIVE"))
+#ifdef TCP_KEEPALIVE
+	    return TCP_KEEPALIVE;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TCP_MAXRT"))
+#ifdef TCP_MAXRT
+	    return TCP_MAXRT;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TCP_MAXSEG"))
+#ifdef TCP_MAXSEG
+	    return TCP_MAXSEG;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TCP_NODELAY"))
+#ifdef TCP_NODELAY
+	    return TCP_NODELAY;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "TCP_STDURG"))
+#ifdef TCP_STDURG
+	    return TCP_STDURG;
+#else
+	    goto not_there;
+#endif
 	break;
     case 'U':
 	if (strEQ(name, "UIO_MAXIOV"))
diff --git a/global.sym b/global.sym
index 09520a9406..1e739bc773 100644
--- a/global.sym
+++ b/global.sym
@@ -87,6 +87,7 @@ debop
 debprofdump
 debstack
 debstackptrs
+default_protect
 delimcpy
 deprecate
 die
@@ -127,8 +128,6 @@ do_trans
 do_vecset
 do_vop
 dofile
-dofindlabel
-dopoptoeval
 dounwind
 dowantarray
 dump_all
@@ -195,7 +194,6 @@ hv_iternextsv
 hv_iterval
 hv_ksplit
 hv_magic
-hv_stashpv
 hv_store
 hv_store_ent
 hv_undef
@@ -262,6 +260,7 @@ magic_getsubstr
 magic_gettaint
 magic_getuvar
 magic_getvec
+magic_killbackrefs
 magic_len
 magic_mutexfree
 magic_nextpack
@@ -543,6 +542,7 @@ sv_reftype
 sv_replace
 sv_report_used
 sv_reset
+sv_rvweaken
 sv_setiv
 sv_setiv_mg
 sv_setnv
diff --git a/gv.c b/gv.c
index b2941c3a1f..df3e0e173c 100644
--- a/gv.c
+++ b/gv.c
@@ -1075,7 +1075,7 @@ Gv_AMupdate(HV *stash)
               break;
             case SVt_PVGV:
               if (!(cv = GvCVu((GV*)sv)))
-                cv = sv_2cv(sv, &stash, &gv, TRUE);
+                cv = sv_2cv(sv, &stash, &gv, FALSE);
               break;
           }
           if (cv) filled=1;
diff --git a/hv.c b/hv.c
index e7a73ce852..d21af5c4c7 100644
--- a/hv.c
+++ b/hv.c
@@ -150,10 +150,13 @@ hv_fetch(HV *hv, const char *key, U32 klen, I32 lval)
     }
 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
     if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
-      if ((sv = PerlEnv_ENVgetenv_sv(key)) != &PL_sv_undef) {
-        SvTAINTED_on(sv);
-        return hv_store(hv,key,klen,sv,hash);
-      }
+	unsigned long len;
+	char *env = PerlEnv_ENVgetenv_len(key,&len);
+	if (env) {
+	    sv = newSVpvn(env,len);
+	    SvTAINTED_on(sv);
+	    return hv_store(hv,key,klen,sv,hash);
+	}
     }
 #endif
     if (lval) {		/* gonna assign to this, so it better be there */
@@ -238,10 +241,13 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
     }
 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
     if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
-      if ((sv = PerlEnv_ENVgetenv_sv(key)) != &PL_sv_undef) {
-        SvTAINTED_on(sv);
-        return hv_store_ent(hv,keysv,sv,hash);
-      }
+	unsigned long len;
+	char *env = PerlEnv_ENVgetenv_len(key,&len);
+	if (env) {
+	    sv = newSVpvn(env,len);
+	    SvTAINTED_on(sv);
+	    return hv_store_ent(hv,keysv,sv,hash);
+	}
     }
 #endif
     if (lval) {		/* gonna assign to this, so it better be there */
@@ -613,11 +619,15 @@ hv_exists(HV *hv, const char *key, U32 klen)
 	return TRUE;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
-    if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME) &&
-        (sv = PerlEnv_ENVgetenv_sv(key)) != &PL_sv_undef) {
-	SvTAINTED_on(sv);
-	hv_store(hv,key,klen,sv,hash);
-	return TRUE;
+    if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME)) {
+	unsigned long len;
+	char *env = PerlEnv_ENVgetenv_len(key,&len);
+	if (env) {
+	    sv = newSVpvn(env,len);
+	    SvTAINTED_on(sv);
+	    (void)hv_store(hv,key,klen,sv,hash);
+	    return TRUE;
+	}
     }
 #endif
     return FALSE;
@@ -680,11 +690,15 @@ hv_exists_ent(HV *hv, SV *keysv, U32 hash)
 	return TRUE;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
-    if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME) &&
-        (sv = PerlEnv_ENVgetenv_sv(key)) != &PL_sv_undef) {
-	SvTAINTED_on(sv);
-	hv_store_ent(hv,keysv,sv,hash);
-	return TRUE;
+    if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME)) {
+	unsigned long len;
+	char *env = PerlEnv_ENVgetenv_len(key,&len);
+	if (env) {
+	    sv = newSVpvn(env,len);
+	    SvTAINTED_on(sv);
+	    (void)hv_store_ent(hv,keysv,sv,hash);
+	    return TRUE;
+	}
     }
 #endif
     return FALSE;
diff --git a/iperlsys.h b/iperlsys.h
index 7251e8f945..5f0ed0c92a 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -447,24 +447,26 @@ class IPerlEnv
 {
 public:
     virtual char *	Getenv(const char *varname, int &err) = 0;
-#ifdef HAS_ENVGETENV
-    virtual char *	ENVGetenv(const char *varname, int &err) = 0;
-#endif
     virtual int		Putenv(const char *envstring, int &err) = 0;
     virtual char *	LibPath(char *patchlevel) =0;
     virtual char *	SiteLibPath(char *patchlevel) =0;
     virtual int		Uname(struct utsname *name, int &err) =0;
+    virtual char *	Getenv_len(const char *varname, unsigned long *len, int &err) = 0;
+#ifdef HAS_ENVGETENV
+    virtual char *	ENVGetenv(const char *varname, int &err) = 0;
+    virtual char *	ENVGetenv_len(const char *varname, unsigned long *len, int &err) = 0;
+#endif
 };
 
 #define PerlEnv_putenv(str)		PL_piENV->Putenv((str), ErrorNo())
 #define PerlEnv_getenv(str)		PL_piENV->Getenv((str), ErrorNo())
-#define PerlEnv_getenv_sv(str)		PL_piENV->getenv_sv((str))
+#define PerlEnv_getenv_len(str,l)	PL_piENV->Getenv_len((str), (l), ErrorNo())
 #ifdef HAS_ENVGETENV
 #  define PerlEnv_ENVgetenv(str)	PL_piENV->ENVGetenv((str), ErrorNo())
-#  define PerlEnv_ENVgetenv_sv(str)	PL_piENV->ENVgetenv_sv((str))
+#  define PerlEnv_ENVgetenv_len(str,l)	PL_piENV->ENVGetenv_len((str), (l), ErrorNo())
 #else
 #  define PerlEnv_ENVgetenv(str)	PerlEnv_getenv((str))
-#  define PerlEnv_ENVgetenv_sv(str)	PerlEnv_getenv_sv((str))
+#  define PerlEnv_ENVgetenv_len(str,l)	PerlEnv_getenv_len((str),(l))
 #endif
 #define PerlEnv_uname(name)		PL_piENV->Uname((name), ErrorNo())
 #ifdef WIN32
@@ -476,13 +478,13 @@ public:
 
 #define PerlEnv_putenv(str)		putenv((str))
 #define PerlEnv_getenv(str)		getenv((str))
-#define PerlEnv_getenv_sv(str)		getenv_sv((str))
+#define PerlEnv_getenv_len(str,l)	getenv_len((str), (l))
 #ifdef HAS_ENVGETENV
 #  define PerlEnv_ENVgetenv(str)	ENVgetenv((str))
-#  define PerlEnv_ENVgetenv_sv(str)	ENVgetenv_sv((str))
+#  define PerlEnv_ENVgetenv_len(str,l)	ENVgetenv_len((str), (l))
 #else
 #  define PerlEnv_ENVgetenv(str)	PerlEnv_getenv((str))
-#  define PerlEnv_ENVgetenv_sv(str)	PerlEnv_getenv_sv((str))
+#  define PerlEnv_ENVgetenv_len(str,l)	PerlEnv_getenv_len((str), (l))
 #endif
 #define PerlEnv_uname(name)		uname((name))
 
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 71c0c1c1ce..866551328c 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -11,7 +11,7 @@ use vars qw($VERSION $verbose $switches $have_devel_corestack $curtest
 	    @ISA @EXPORT @EXPORT_OK);
 $have_devel_corestack = 0;
 
-$VERSION = "1.1602";
+$VERSION = "1.1604";
 
 $ENV{HARNESS_ACTIVE} = 1;
 
@@ -74,7 +74,10 @@ sub runtests {
 	$te = $test;
 	chop($te);
 	if ($^O eq 'VMS') { $te =~ s/^.*\.t\./[.t./; }
-	print "$te" . '.' x (20 - length($te));
+	my $leader = "$te" . '.' x (20 - length($te));
+	my $ml = "";
+	$ml = "\r$leader" if -t STDOUT and not $ENV{HARNESS_NOTTY};
+	print $leader;
 	my $fh = new FileHandle;
 	$fh->open($test) or print "can't open $test. $!\n";
 	my $first = <$fh>;
@@ -91,6 +94,7 @@ sub runtests {
 	my %todo = ();
         my $bonus = 0;
 	my $skipped = 0;
+	my $skip_reason;
 	while (<$fh>) {
 	    if( $verbose ){
 		print $_;
@@ -110,17 +114,29 @@ sub runtests {
 		my $this = $next;
 		if (/^not ok\s*(\d*)/){
 		    $this = $1 if $1 > 0;
+		    print "${ml}NOK $this   \n" if $ml;
 		    if (!$todo{$this}) {
 			push @failed, $this;
 		    } else {
 			$ok++;
 			$totok++;
 		    }
-		} elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip)?/) {
+		} elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip\S*(?:(?>\s+)(.+))?)?/) {
 		    $this = $1 if $1 > 0;
+		    print "${ml}ok $this   " if $ml;
 		    $ok++;
 		    $totok++;
 		    $skipped++ if defined $2;
+		    my $reason;
+		    $reason = 'unknown reason' if defined $2;
+		    $reason = $3 if defined $3;
+		    if (defined $reason and defined $skip_reason) {
+		      # print "was: '$skip_reason' new '$reason'\n";
+		      $skip_reason = 'various reasons'
+			if $skip_reason ne $reason;
+		    } elsif (defined $reason) {
+		      $skip_reason = $reason;
+		    }
 		    $bonus++, $totbonus++ if $todo{$this};
 		}
 		if ($this > $next) {
@@ -143,7 +159,7 @@ sub runtests {
 		       : $wstatus >> 8);
 	if ($wstatus) {
 	    my ($failed, $canon, $percent) = ('??', '??');
-	    printf "dubious\n\tTest returned status $estatus (wstat %d, 0x%x)\n",
+	    printf "${ml}dubious\n\tTest returned status $estatus (wstat %d, 0x%x)\n",
 		    $wstatus,$wstatus;
 	    print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
 	    if (corestatus($wstatus)) { # until we have a wait module
@@ -175,14 +191,14 @@ sub runtests {
 	} elsif ($ok == $max && $next == $max+1) {
 	    if ($max and $skipped + $bonus) {
 		my @msg;
-		push(@msg, "$skipped/$max subtest".($skipped>1?'s':'')." skipped")
+		push(@msg, "$skipped/$max subtest".($skipped>1?'s':'')." skipped: $skip_reason")
 		    if $skipped;
 		push(@msg, "$bonus subtest".($bonus>1?'s':'').
 		     " unexpectedly succeeded")
 		    if $bonus;
-		print "ok, ".join(', ', @msg)."\n";
+		print "${ml}ok, ".join(', ', @msg)."     \n";
 	    } elsif ($max) {
-		print "ok\n";
+		print "${ml}ok      \n";
 	    } else {
 		print "skipping test on this platform\n";
 		$tests_skipped++;
@@ -450,6 +466,12 @@ above messages.
 Setting C<HARNESS_IGNORE_EXITCODE> makes harness ignore the exit status
 of child processes.
 
+Setting C<HARNESS_NOTTY> to a true value forces it to behave as though
+STDOUT were not a console.  You may need to set this if you don't want
+harness to output more frequent progress messages using carriage returns.
+Some consoles may not handle carriage returns properly (which results
+in a somewhat messy output).
+
 If C<HARNESS_FILELEAK_IN_DIR> is set to the name of a directory, harness
 will check after each test whether new files appeared in that directory,
 and report them as
diff --git a/mg.c b/mg.c
index 3584dbc92d..9183104339 100644
--- a/mg.c
+++ b/mg.c
@@ -1589,6 +1589,27 @@ vivify_defelem(SV *sv)
 }
 
 int
+magic_killbackrefs(SV *sv, MAGIC *mg)
+{
+    AV *av = (AV*)mg->mg_obj;
+    SV **svp = AvARRAY(av);
+    I32 i = AvFILLp(av);
+    while (i >= 0) {
+	if (svp[i] && svp[i] != &PL_sv_undef) {
+	    if (!SvWEAKREF(svp[i]))
+		croak("panic: magic_killbackrefs");
+	    /* XXX Should we check that it hasn't changed? */
+	    SvRV(svp[i]) = 0;
+	    SvOK_off(svp[i]);
+	    SvWEAKREF_off(svp[i]);
+	    svp[i] = &PL_sv_undef;
+	}
+	i--;
+    }
+    return 0;
+}
+
+int
 magic_setmglob(SV *sv, MAGIC *mg)
 {
     mg->mg_len = -1;
diff --git a/objXSUB.h b/objXSUB.h
index 6297e9f7d9..0305bf00cf 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -502,6 +502,8 @@
 #define PL_preprocess		pPerl->PL_preprocess
 #undef  PL_profiledata
 #define PL_profiledata		pPerl->PL_profiledata
+#undef  PL_protect
+#define PL_protect		pPerl->PL_protect
 #undef  PL_reg_call_cc
 #define PL_reg_call_cc		pPerl->PL_reg_call_cc
 #undef  PL_reg_curpm
@@ -879,14 +881,14 @@
 #define boot_core_UNIVERSAL	pPerl->Perl_boot_core_UNIVERSAL
 #undef  bset_obj_store
 #define bset_obj_store		pPerl->Perl_bset_obj_store
-#undef  bset_obj_store
-#define bset_obj_store		pPerl->Perl_bset_obj_store
 #undef  byterun
 #define byterun			pPerl->Perl_byterun
 #undef  cache_re
 #define cache_re		pPerl->Perl_cache_re
 #undef  call_list
 #define call_list		pPerl->Perl_call_list
+#undef  call_list_body
+#define call_list_body		pPerl->Perl_call_list_body
 #undef  cando
 #define cando			pPerl->Perl_cando
 #undef  cast_i32
@@ -1001,6 +1003,8 @@
 #define debstack		pPerl->Perl_debstack
 #undef  debstackptrs
 #define debstackptrs		pPerl->Perl_debstackptrs
+#undef  default_protect
+#define default_protect		pPerl->Perl_default_protect
 #undef  del_he
 #define del_he			pPerl->Perl_del_he
 #undef  del_sv
@@ -1127,6 +1131,8 @@
 #define do_vop			pPerl->Perl_do_vop
 #undef  docatch
 #define docatch			pPerl->Perl_docatch
+#undef  docatch_body
+#define docatch_body		pPerl->Perl_docatch_body
 #undef  doencodes
 #define doencodes		pPerl->Perl_doencodes
 #undef  doeval
@@ -1135,18 +1141,14 @@
 #define dofile			pPerl->Perl_dofile
 #undef  dofindlabel
 #define dofindlabel		pPerl->Perl_dofindlabel
-#undef  dofindlabel
-#define dofindlabel		pPerl->Perl_dofindlabel
 #undef  doform
 #define doform			pPerl->Perl_doform
-#undef  doopen
-#define doopen			pPerl->Perl_doopen
+#undef  doopen_pmc
+#define doopen_pmc		pPerl->Perl_doopen_pmc
 #undef  doparseform
 #define doparseform		pPerl->Perl_doparseform
 #undef  dopoptoeval
 #define dopoptoeval		pPerl->Perl_dopoptoeval
-#undef  dopoptoeval
-#define dopoptoeval		pPerl->Perl_dopoptoeval
 #undef  dopoptolabel
 #define dopoptolabel		pPerl->Perl_dopoptolabel
 #undef  dopoptoloop
@@ -1319,8 +1321,6 @@
 #define hv_ksplit		pPerl->Perl_hv_ksplit
 #undef  hv_magic
 #define hv_magic		pPerl->Perl_hv_magic
-#undef  hv_stashpv
-#define hv_stashpv		pPerl->Perl_hv_stashpv
 #undef  hv_store
 #define hv_store		pPerl->Perl_hv_store
 #undef  hv_store_ent
@@ -1489,6 +1489,8 @@
 #define magic_getuvar		pPerl->Perl_magic_getuvar
 #undef  magic_getvec
 #define magic_getvec		pPerl->Perl_magic_getvec
+#undef  magic_killbackrefs
+#define magic_killbackrefs	pPerl->Perl_magic_killbackrefs
 #undef  magic_len
 #define magic_len		pPerl->Perl_magic_len
 #undef  magic_methcall
@@ -1811,12 +1813,16 @@
 #define perl_atexit		pPerl->perl_atexit
 #undef  perl_call_argv
 #define perl_call_argv		pPerl->perl_call_argv
+#undef  perl_call_body
+#define perl_call_body		pPerl->perl_call_body
 #undef  perl_call_method
 #define perl_call_method	pPerl->perl_call_method
 #undef  perl_call_pv
 #define perl_call_pv		pPerl->perl_call_pv
 #undef  perl_call_sv
 #define perl_call_sv		pPerl->perl_call_sv
+#undef  perl_call_xbody
+#define perl_call_xbody		pPerl->perl_call_xbody
 #undef  perl_construct
 #define perl_construct		pPerl->perl_construct
 #undef  perl_destruct
@@ -1847,10 +1853,14 @@
 #define perl_new_numeric	pPerl->perl_new_numeric
 #undef  perl_parse
 #define perl_parse		pPerl->perl_parse
+#undef  perl_parse_body
+#define perl_parse_body		pPerl->perl_parse_body
 #undef  perl_require_pv
 #define perl_require_pv		pPerl->perl_require_pv
 #undef  perl_run
 #define perl_run		pPerl->perl_run
+#undef  perl_run_body
+#define perl_run_body		pPerl->perl_run_body
 #undef  perl_set_numeric_local
 #define perl_set_numeric_local	pPerl->perl_set_numeric_local
 #undef  perl_set_numeric_standard
@@ -2877,6 +2887,8 @@
 #define sv_2uv			pPerl->Perl_sv_2uv
 #undef  sv_add_arena
 #define sv_add_arena		pPerl->Perl_sv_add_arena
+#undef  sv_add_backref
+#define sv_add_backref		pPerl->Perl_sv_add_backref
 #undef  sv_backoff
 #define sv_backoff		pPerl->Perl_sv_backoff
 #undef  sv_bless
@@ -2915,6 +2927,8 @@
 #define sv_compile_2op		pPerl->Perl_sv_compile_2op
 #undef  sv_dec
 #define sv_dec			pPerl->Perl_sv_dec
+#undef  sv_del_backref
+#define sv_del_backref		pPerl->Perl_sv_del_backref
 #undef  sv_derived_from
 #define sv_derived_from		pPerl->Perl_sv_derived_from
 #undef  sv_dump
@@ -2979,6 +2993,8 @@
 #define sv_report_used		pPerl->Perl_sv_report_used
 #undef  sv_reset
 #define sv_reset		pPerl->Perl_sv_reset
+#undef  sv_rvweaken
+#define sv_rvweaken		pPerl->Perl_sv_rvweaken
 #undef  sv_setiv
 #define sv_setiv		pPerl->Perl_sv_setiv
 #undef  sv_setiv_mg
diff --git a/op.c b/op.c
index 13f2a1595c..919d9d8170 100644
--- a/op.c
+++ b/op.c
@@ -4782,7 +4782,7 @@ ck_fun(OP *o)
 		    }
 		    else {
 			I32 flags = OPf_SPECIAL;
-			I32 private = 0;
+			I32 priv = 0;
 			/* is this op a FH constructor? */
 			if (is_handle_constructor(o,numargs)) {
 			    flags   = 0;                         
@@ -4790,7 +4790,7 @@ ck_fun(OP *o)
 			     * need to "prove" flag does not mean something
 			     * else already - NI-S 1999/05/07
 			     */ 
-			    private = OPpDEREF; 
+			    priv = OPpDEREF; 
 #if 0
 			    /* Helps with open($array[$n],...) 
 			       but is too simplistic - need to do selectively
@@ -4800,8 +4800,8 @@ ck_fun(OP *o)
 			}
 			kid->op_sibling = 0;
 			kid = newUNOP(OP_RV2GV, flags, scalar(kid));
-			if (private) {
-			    kid->op_private |= private;
+			if (priv) {
+			    kid->op_private |= priv;
 			}
 		    }
 		    kid->op_sibling = sibl;
diff --git a/perl.c b/perl.c
index 7c784fc817..09da6681cb 100644
--- a/perl.c
+++ b/perl.c
@@ -53,6 +53,11 @@ static void init_ids _((void));
 static void init_debugger _((void));
 static void init_lexer _((void));
 static void init_main_stash _((void));
+static void *perl_parse_body _((va_list args));
+static void *perl_run_body _((va_list args));
+static void *perl_call_body _((va_list args));
+static void perl_call_xbody _((OP *myop, int is_eval));
+static void *call_list_body _((va_list args));
 #ifdef USE_THREADS
 static struct perl_thread * init_main_thread _((void));
 #endif /* USE_THREADS */
@@ -145,6 +150,8 @@ perl_construct(register PerlInterpreter *sv_interp)
 	thr = init_main_thread();
 #endif /* USE_THREADS */
 
+	PL_protect = FUNC_NAME_TO_PTR(default_protect); /* for exceptions */
+
 	PL_curcop = &PL_compiling;	/* needed by ckWARN, right away */
 
 	PL_linestr = NEWSV(65,79);
@@ -202,10 +209,7 @@ perl_construct(register PerlInterpreter *sv_interp)
     init_ids();
     PL_lex_state = LEX_NOTPARSING;
 
-    PL_start_env.je_prev = NULL;
-    PL_start_env.je_ret = -1;
-    PL_start_env.je_mustcatch = TRUE;
-    PL_top_env     = &PL_start_env;
+    JMPENV_BOOTSTRAP;
     STATUS_ALL_SUCCESS;
 
     SET_NUMERIC_STANDARD();
@@ -626,24 +630,22 @@ perl_atexit(void (*fn) (void *), void *ptr)
     ++PL_exitlistlen;
 }
 
+#ifdef PERL_OBJECT
+    typedef void (*xs_init_t)(CPerlObj*);
+#else
+    typedef void (*xs_init_t)(void);
+#endif
+
 int
 #ifdef PERL_OBJECT
-perl_parse(void (*xsinit) (CPerlObj*), int argc, char **argv, char **env)
+perl_parse(xs_init_t xsinit, int argc, char **argv, char **env)
 #else
-perl_parse(PerlInterpreter *sv_interp, void (*xsinit) (void), int argc, char **argv, char **env)
+perl_parse(PerlInterpreter *sv_interp, xs_init_t xsinit, int argc, char **argv, char **env)
 #endif
 {
     dTHR;
-    register SV *sv;
-    register char *s;
-    char *scriptname = NULL;
-    VOL bool dosearch = FALSE;
-    char *validarg = "";
     I32 oldscope;
-    AV* comppadlist;
-    dJMPENV;
     int ret;
-    int fdscript = -1;
 
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 #ifdef IAMSUID
@@ -694,8 +696,10 @@ setuid perl scripts securely.\n");
     oldscope = PL_scopestack_ix;
     PL_dowarn = G_WARN_OFF;
 
-    JMPENV_PUSH(ret);
+    CALLPROTECT(&ret, FUNC_NAME_TO_PTR(perl_parse_body), env, xsinit);
     switch (ret) {
+    case 0:
+	return 0;
     case 1:
 	STATUS_ALL_FAILURE;
 	/* FALL THROUGH */
@@ -707,13 +711,30 @@ setuid perl scripts securely.\n");
 	PL_curstash = PL_defstash;
 	if (PL_endav)
 	    call_list(oldscope, PL_endav);
-	JMPENV_POP;
 	return STATUS_NATIVE_EXPORT;
     case 3:
-	JMPENV_POP;
 	PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");
 	return 1;
     }
+    return 0;
+}
+
+STATIC void *
+perl_parse_body(va_list args)
+{
+    dTHR;
+    int argc = PL_origargc;
+    char **argv = PL_origargv;
+    char **env = va_arg(args, char**);
+    char *scriptname = NULL;
+    int fdscript = -1;
+    VOL bool dosearch = FALSE;
+    char *validarg = "";
+    AV* comppadlist;
+    register SV *sv;
+    register char *s;
+
+    xs_init_t xsinit = va_arg(args, xs_init_t);
 
     sv_setpvn(PL_linestr,"",0);
     sv = newSVpvn("",0);		/* first used for -I flags */
@@ -1028,8 +1049,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 
     ENTER;
     PL_restartop = 0;
-    JMPENV_POP;
-    return 0;
+    return NULL;
 }
 
 int
@@ -1041,7 +1061,6 @@ perl_run(PerlInterpreter *sv_interp)
 {
     dTHR;
     I32 oldscope;
-    dJMPENV;
     int ret;
 
 #ifndef PERL_OBJECT
@@ -1051,13 +1070,14 @@ perl_run(PerlInterpreter *sv_interp)
 
     oldscope = PL_scopestack_ix;
 
-    JMPENV_PUSH(ret);
+ redo_body:
+    CALLPROTECT(&ret, FUNC_NAME_TO_PTR(perl_run_body), oldscope);
     switch (ret) {
     case 1:
 	cxstack_ix = -1;		/* start context stack again */
-	break;
-    case 2:
-	/* my_exit() was called */
+	goto redo_body;
+    case 0:  /* normal completion */
+    case 2:  /* my_exit() */
 	while (PL_scopestack_ix > oldscope)
 	    LEAVE;
 	FREETMPS;
@@ -1068,19 +1088,27 @@ perl_run(PerlInterpreter *sv_interp)
 	if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
 	    dump_mstats("after execution:  ");
 #endif
-	JMPENV_POP;
 	return STATUS_NATIVE_EXPORT;
     case 3:
-	if (!PL_restartop) {
-	    PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
-	    FREETMPS;
-	    JMPENV_POP;
-	    return 1;
+	if (PL_restartop) {
+	    POPSTACK_TO(PL_mainstack);
+	    goto redo_body;
 	}
-	POPSTACK_TO(PL_mainstack);
-	break;
+	PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
+	FREETMPS;
+	return 1;
     }
 
+    /* NOTREACHED */
+    return 0;
+}
+
+STATIC void *
+perl_run_body(va_list args)
+{
+    dTHR;
+    I32 oldscope = va_arg(args, I32);
+
     DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n",
                     PL_sawampersand ? "Enabling" : "Omitting"));
 
@@ -1095,7 +1123,7 @@ perl_run(PerlInterpreter *sv_interp)
 	    my_exit(0);
 	}
 	if (PERLDB_SINGLE && PL_DBsingle)
-	   sv_setiv(PL_DBsingle, 1); 
+	    sv_setiv(PL_DBsingle, 1); 
 	if (PL_initav)
 	    call_list(oldscope, PL_initav);
     }
@@ -1113,9 +1141,7 @@ perl_run(PerlInterpreter *sv_interp)
 	CALLRUNOPS();
     }
 
-    my_exit(0);
-    /* NOTREACHED */
-    return 0;
+    return NULL;
 }
 
 SV*
@@ -1164,6 +1190,9 @@ perl_get_cv(const char *name, I32 create)
 {
     GV* gv = gv_fetchpv(name, create, SVt_PVCV);
     /* XXX unsafe for threads if eval_owner isn't held */
+    /* XXX this is probably not what they think they're getting.
+     * It has the same effect as "sub name;", i.e. just a forward
+     * declaration! */
     if (create && !GvCVu(gv))
     	return newSUB(start_subparse(FALSE, 0),
 		      newSVOP(OP_CONST, 0, newSVpv(name,0)),
@@ -1232,7 +1261,6 @@ perl_call_sv(SV *sv, I32 flags)
     I32 retval;
     I32 oldscope;
     bool oldcatch = CATCH_GET;
-    dJMPENV;
     int ret;
     OP* oldop = PL_op;
 
@@ -1265,7 +1293,13 @@ perl_call_sv(SV *sv, I32 flags)
 	  && !(flags & G_NODEBUG))
 	PL_op->op_private |= OPpENTERSUB_DB;
 
-    if (flags & G_EVAL) {
+    if (!(flags & G_EVAL)) {
+	CATCH_SET(TRUE);
+	perl_call_xbody((OP*)&myop, FALSE);
+	retval = PL_stack_sp - (PL_stack_base + oldmark);
+	CATCH_SET(FALSE);
+    }
+    else {
 	cLOGOP->op_other = PL_op;
 	PL_markstack_ptr--;
 	/* we're trying to emulate pp_entertry() here */
@@ -1289,9 +1323,13 @@ perl_call_sv(SV *sv, I32 flags)
 	}
 	PL_markstack_ptr++;
 
-	JMPENV_PUSH(ret);
+  redo_body:
+	CALLPROTECT(&ret, FUNC_NAME_TO_PTR(perl_call_body), (OP*)&myop, FALSE);
 	switch (ret) {
 	case 0:
+	    retval = PL_stack_sp - (PL_stack_base + oldmark);
+	    if (!(flags & G_KEEPERR))
+		sv_setpv(ERRSV,"");
 	    break;
 	case 1:
 	    STATUS_ALL_FAILURE;
@@ -1300,7 +1338,6 @@ perl_call_sv(SV *sv, I32 flags)
 	    /* my_exit() was called */
 	    PL_curstash = PL_defstash;
 	    FREETMPS;
-	    JMPENV_POP;
 	    if (PL_statusvalue)
 		croak("Callback called exit");
 	    my_exit_jump();
@@ -1309,7 +1346,7 @@ perl_call_sv(SV *sv, I32 flags)
 	    if (PL_restartop) {
 		PL_op = PL_restartop;
 		PL_restartop = 0;
-		break;
+		goto redo_body;
 	    }
 	    PL_stack_sp = PL_stack_base + oldmark;
 	    if (flags & G_ARRAY)
@@ -1318,22 +1355,9 @@ perl_call_sv(SV *sv, I32 flags)
 		retval = 1;
 		*++PL_stack_sp = &PL_sv_undef;
 	    }
-	    goto cleanup;
+	    break;
 	}
-    }
-    else
-	CATCH_SET(TRUE);
-
-    if (PL_op == (OP*)&myop)
-	PL_op = pp_entersub(ARGS);
-    if (PL_op)
-	CALLRUNOPS();
-    retval = PL_stack_sp - (PL_stack_base + oldmark);
-    if ((flags & G_EVAL) && !(flags & G_KEEPERR))
-	sv_setpv(ERRSV,"");
 
-  cleanup:
-    if (flags & G_EVAL) {
 	if (PL_scopestack_ix > oldscope) {
 	    SV **newsp;
 	    PMOP *newpm;
@@ -1347,10 +1371,7 @@ perl_call_sv(SV *sv, I32 flags)
 	    PL_curpm = newpm;
 	    LEAVE;
 	}
-	JMPENV_POP;
     }
-    else
-	CATCH_SET(oldcatch);
 
     if (flags & G_DISCARD) {
 	PL_stack_sp = PL_stack_base + oldmark;
@@ -1362,6 +1383,31 @@ perl_call_sv(SV *sv, I32 flags)
     return retval;
 }
 
+STATIC void *
+perl_call_body(va_list args)
+{
+    OP *myop = va_arg(args, OP*);
+    int is_eval = va_arg(args, int);
+
+    perl_call_xbody(myop, is_eval);
+    return NULL;
+}
+
+STATIC void
+perl_call_xbody(OP *myop, int is_eval)
+{
+    dTHR;
+
+    if (PL_op == myop) {
+	if (is_eval)
+	    PL_op = pp_entereval(ARGS);
+	else
+	    PL_op = pp_entersub(ARGS);
+    }
+    if (PL_op)
+	CALLRUNOPS();
+}
+
 /* Eval a string. The G_EVAL flag is always assumed. */
 
 I32
@@ -1374,7 +1420,6 @@ perl_eval_sv(SV *sv, I32 flags)
     I32 oldmark = SP - PL_stack_base;
     I32 retval;
     I32 oldscope;
-    dJMPENV;
     int ret;
     OP* oldop = PL_op;
 
@@ -1400,9 +1445,13 @@ perl_eval_sv(SV *sv, I32 flags)
     if (flags & G_KEEPERR)
 	myop.op_flags |= OPf_SPECIAL;
 
-    JMPENV_PUSH(ret);
+ redo_body:
+    CALLPROTECT(&ret, FUNC_NAME_TO_PTR(perl_call_body), (OP*)&myop, TRUE);
     switch (ret) {
     case 0:
+	retval = PL_stack_sp - (PL_stack_base + oldmark);
+	if (!(flags & G_KEEPERR))
+	    sv_setpv(ERRSV,"");
 	break;
     case 1:
 	STATUS_ALL_FAILURE;
@@ -1411,7 +1460,6 @@ perl_eval_sv(SV *sv, I32 flags)
 	/* my_exit() was called */
 	PL_curstash = PL_defstash;
 	FREETMPS;
-	JMPENV_POP;
 	if (PL_statusvalue)
 	    croak("Callback called exit");
 	my_exit_jump();
@@ -1420,7 +1468,7 @@ perl_eval_sv(SV *sv, I32 flags)
 	if (PL_restartop) {
 	    PL_op = PL_restartop;
 	    PL_restartop = 0;
-	    break;
+	    goto redo_body;
 	}
 	PL_stack_sp = PL_stack_base + oldmark;
 	if (flags & G_ARRAY)
@@ -1429,19 +1477,9 @@ perl_eval_sv(SV *sv, I32 flags)
 	    retval = 1;
 	    *++PL_stack_sp = &PL_sv_undef;
 	}
-	goto cleanup;
+	break;
     }
 
-    if (PL_op == (OP*)&myop)
-	PL_op = pp_entereval(ARGS);
-    if (PL_op)
-	CALLRUNOPS();
-    retval = PL_stack_sp - (PL_stack_base + oldmark);
-    if (!(flags & G_KEEPERR))
-	sv_setpv(ERRSV,"");
-
-  cleanup:
-    JMPENV_POP;
     if (flags & G_DISCARD) {
 	PL_stack_sp = PL_stack_base + oldmark;
 	retval = 0;
@@ -2961,35 +2999,29 @@ void
 call_list(I32 oldscope, AV *paramList)
 {
     dTHR;
+    SV *atsv = ERRSV;
     line_t oldline = PL_curcop->cop_line;
+    CV *cv;
     STRLEN len;
-    dJMPENV;
     int ret;
 
     while (AvFILL(paramList) >= 0) {
-	CV *cv = (CV*)av_shift(paramList);
-
+	cv = (CV*)av_shift(paramList);
 	SAVEFREESV(cv);
-
-	JMPENV_PUSH(ret);
+	CALLPROTECT(&ret, FUNC_NAME_TO_PTR(call_list_body), cv);
 	switch (ret) {
-	case 0: {
-		SV* atsv = ERRSV;
-		PUSHMARK(PL_stack_sp);
-		perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
-		(void)SvPV(atsv, len);
-		if (len) {
-		    JMPENV_POP;
-		    PL_curcop = &PL_compiling;
-		    PL_curcop->cop_line = oldline;
-		    if (paramList == PL_beginav)
-			sv_catpv(atsv, "BEGIN failed--compilation aborted");
-		    else
-			sv_catpv(atsv, "END failed--cleanup aborted");
-		    while (PL_scopestack_ix > oldscope)
-			LEAVE;
-		    croak("%s", SvPVX(atsv));
-		}
+	case 0:
+	    (void)SvPV(atsv, len);
+	    if (len) {
+		PL_curcop = &PL_compiling;
+		PL_curcop->cop_line = oldline;
+		if (paramList == PL_beginav)
+		    sv_catpv(atsv, "BEGIN failed--compilation aborted");
+		else
+		    sv_catpv(atsv, "END failed--cleanup aborted");
+		while (PL_scopestack_ix > oldscope)
+		    LEAVE;
+		croak("%s", SvPVX(atsv));
 	    }
 	    break;
 	case 1:
@@ -3003,7 +3035,6 @@ call_list(I32 oldscope, AV *paramList)
 	    PL_curstash = PL_defstash;
 	    if (PL_endav)
 		call_list(oldscope, PL_endav);
-	    JMPENV_POP;
 	    PL_curcop = &PL_compiling;
 	    PL_curcop->cop_line = oldline;
 	    if (PL_statusvalue) {
@@ -3015,20 +3046,29 @@ call_list(I32 oldscope, AV *paramList)
 	    my_exit_jump();
 	    /* NOTREACHED */
 	case 3:
-	    if (!PL_restartop) {
-		PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
-		FREETMPS;
-		break;
+	    if (PL_restartop) {
+		PL_curcop = &PL_compiling;
+		PL_curcop->cop_line = oldline;
+		JMPENV_JUMP(3);
 	    }
-	    JMPENV_POP;
-	    PL_curcop = &PL_compiling;
-	    PL_curcop->cop_line = oldline;
-	    JMPENV_JUMP(3);
+	    PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
+	    FREETMPS;
+	    break;
 	}
-	JMPENV_POP;
     }
 }
 
+STATIC void *
+call_list_body(va_list args)
+{
+    dTHR;
+    CV *cv = va_arg(args, CV*);
+
+    PUSHMARK(PL_stack_sp);
+    perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
+    return NULL;
+}
+
 void
 my_exit(U32 status)
 {
diff --git a/perl.h b/perl.h
index e77e58588b..5cbecd2380 100644
--- a/perl.h
+++ b/perl.h
@@ -107,9 +107,7 @@ class CPerlObj;
 #define PERL_OBJECT_THIS this
 #define _PERL_OBJECT_THIS ,this
 #define PERL_OBJECT_THIS_ this,
-#define CALLRUNOPS (this->*PL_runops)
-#define CALLREGCOMP (this->*PL_regcompp)
-#define CALLREGEXEC (this->*PL_regexecp)
+#define CALL_FPTR(fptr) (this->*fptr)
 
 #else /* !PERL_OBJECT */
 
@@ -123,12 +121,15 @@ class CPerlObj;
 #define PERL_OBJECT_THIS
 #define _PERL_OBJECT_THIS
 #define PERL_OBJECT_THIS_
-#define CALLRUNOPS (*PL_runops)
-#define CALLREGCOMP (*PL_regcompp)
-#define CALLREGEXEC (*PL_regexecp)
+#define CALL_FPTR(fptr) (*fptr)
 
 #endif /* PERL_OBJECT */
 
+#define CALLRUNOPS  CALL_FPTR(PL_runops)
+#define CALLREGCOMP CALL_FPTR(PL_regcompp)
+#define CALLREGEXEC CALL_FPTR(PL_regexecp)
+#define CALLPROTECT CALL_FPTR(PL_protect)
+
 #define VOIDUSED 1
 #include "config.h"
 
@@ -1902,12 +1903,13 @@ EXT char *** environ_pointer;
 #  endif
 #else
    /* VMS and some other platforms don't use the environ array */
-#  if !defined(VMS) || \
-      !defined(DONT_DECLARE_STD) || \
-      (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
-      defined(__sgi) || \
-      defined(__DGUX)
+#  if !defined(VMS)
+#    if !defined(DONT_DECLARE_STD) || \
+        (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
+        defined(__sgi) || \
+        defined(__DGUX)
 extern char **	environ;	/* environment variables supplied via exec */
+#    endif
 #  endif
 #endif
 
@@ -2218,7 +2220,8 @@ enum {		/* pass one of these to get_vtbl */
     want_vtbl_mutex,
 #endif
     want_vtbl_regdata,
-    want_vtbl_regdatum
+    want_vtbl_regdatum,
+    want_vtbl_backref
 };
 
 				/* Note: the lowest 8 bits are reserved for
@@ -2512,6 +2515,9 @@ EXT MGVTBL PL_vtbl_amagic =       {0,     magic_setamagic,
 EXT MGVTBL PL_vtbl_amagicelem =   {0,     magic_setamagic,
                                         0,      0,      magic_setamagic};
 
+EXT MGVTBL PL_vtbl_backref = 	  {0,	0,
+					0,	0,	magic_killbackrefs};
+
 #else /* !DOINIT */
 
 EXT MGVTBL PL_vtbl_sv;
@@ -2552,6 +2558,8 @@ EXT MGVTBL PL_vtbl_collxfrm;
 EXT MGVTBL PL_vtbl_amagic;
 EXT MGVTBL PL_vtbl_amagicelem;
 
+EXT MGVTBL PL_vtbl_backref;
+
 #endif /* !DOINIT */
 
 enum {
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index d2ef10daa0..5114ce1731 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -225,7 +225,7 @@ been fixed.
 
 fork(), exec(), system(), qx// and pipe open()s now flush the buffers
 of all files that were opened for output at the time the operation
-was attempted.  The mostly eliminates the often confusing effects of
+was attempted.  This mostly eliminates the often confusing effects of
 buffering mishaps suffered by users unaware of how Perl internally
 handled I/O.
 
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 4b18882b28..b83b577b03 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -971,6 +971,11 @@ weren't.
 subscript.  But to the left of the brackets was an expression that
 didn't look like an array reference, or anything else subscriptable.
 
+=item Can't weaken a nonreference
+
+(F) You attempted to weaken something that was not a reference.  Only
+references can be weakened.
+
 =item Can't x= to read-only value
 
 (F) You tried to repeat a constant value (often the undefined value) with
@@ -1983,6 +1988,11 @@ See L<perlform>.
 (P) The savestack was requested to restore more localized values than there
 are in the savestack.
 
+=item panic: del_backref
+
+(P) Failed an internal consistency check while trying to reset a weak
+reference.
+
 =item panic: die %s
 
 (P) We popped the context stack to an eval context, and then discovered
@@ -2043,6 +2053,11 @@ invalid enum on the top of it.
 
 (P) Something requested a negative number of bytes of malloc.
 
+=item panic: magic_killbackrefs
+
+(P) Failed an internal consistency check while trying to reset all weak
+references to an object.
+
 =item panic: mapstart
 
 (P) The compiler is screwed up with respect to the map() function.
@@ -2285,6 +2300,11 @@ to use parens. In any case, a hash requires key/value B<pairs>.
     %hash = ( one => 1, two => 2, );	# right
     %hash = qw( one 1 two 2 );			# also fine
 
+=item Reference is already weak
+
+(W) You have attempted to weaken a reference that is already weak.
+Doing so has no effect.
+
 =item Reference miscount in sv_replace()
 
 (W) The internal sv_replace() function was handed a new SV with a
diff --git a/pod/perlguts.pod b/pod/perlguts.pod
index b71337c137..ad4c702b07 100644
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -2426,9 +2426,10 @@ set and the variable does not exist then NULL is returned.
 
 =item perl_get_cv
 
-Returns the CV of the specified Perl sub.  If C<create> is set and the Perl
-variable does not exist then it will be created.  If C<create> is not
-set and the variable does not exist then NULL is returned.
+Returns the CV of the specified Perl subroutine.  If C<create> is set and
+the Perl subroutine does not exist then it will be declared (which has
+the same effect as saying C<sub name;>).  If C<create> is not
+set and the subroutine does not exist then NULL is returned.
 
 	CV*	perl_get_cv (const char* name, I32 create)
 
diff --git a/pp.c b/pp.c
index 34fffefc67..431dc9ac7b 100644
--- a/pp.c
+++ b/pp.c
@@ -531,7 +531,7 @@ refto(SV *sv)
 	if (!(sv = LvTARG(sv)))
 	    sv = &PL_sv_undef;
 	else
-	    SvREFCNT_inc(sv);
+	    (void)SvREFCNT_inc(sv);
     }
     else if (SvPADTMP(sv))
 	sv = newSVsv(sv);
diff --git a/pp_ctl.c b/pp_ctl.c
index ec9823334a..621024a97d 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -29,6 +29,7 @@
 #define CALLOP this->*PL_op
 #else
 #define CALLOP *PL_op
+static void *docatch_body _((void *o));
 static OP *docatch _((OP *o));
 static OP *dofindlabel _((OP *o, char *label, OP **opstack, OP **oplimit));
 static void doparseform _((SV *sv));
@@ -41,7 +42,7 @@ static void save_lines _((AV *array, SV *sv));
 static I32 sortcv _((SV *a, SV *b));
 static void qsortsv _((SV **array, size_t num_elts, I32 (*fun)(SV *a, SV *b)));
 static OP *doeval _((int gimme, OP** startop));
-static PerlIO *doopen _((const char *name, const char *mode));
+static PerlIO *doopen_pmc _((const char *name, const char *mode));
 static I32 sv_ncmp _((SV *a, SV *b));
 static I32 sv_i_ncmp _((SV *a, SV *b));
 static I32 amagic_ncmp _((SV *a, SV *b));
@@ -2491,38 +2492,41 @@ save_lines(AV *array, SV *sv)
     }
 }
 
+STATIC void *
+docatch_body(va_list args)
+{
+    CALLRUNOPS();
+    return NULL;
+}
+
 STATIC OP *
 docatch(OP *o)
 {
     dTHR;
     int ret;
     OP *oldop = PL_op;
-    dJMPENV;
 
-    PL_op = o;
 #ifdef DEBUGGING
     assert(CATCH_GET == TRUE);
-    DEBUG_l(deb("Setting up local jumplevel %p, was %p\n", &cur_env, PL_top_env));
 #endif
-    JMPENV_PUSH(ret);
+    PL_op = o;
+ redo_body:
+    CALLPROTECT(&ret, FUNC_NAME_TO_PTR(docatch_body));
     switch (ret) {
-    default:				/* topmost level handles it */
-pass_the_buck:
-	JMPENV_POP;
+    case 0:
+	break;
+    case 3:
+	if (PL_restartop) {
+	    PL_op = PL_restartop;
+	    PL_restartop = 0;
+	    goto redo_body;
+	}
+	/* FALL THROUGH */
+    default:
 	PL_op = oldop;
 	JMPENV_JUMP(ret);
 	/* NOTREACHED */
-    case 3:
-	if (!PL_restartop)
-	    goto pass_the_buck;
-	PL_op = PL_restartop;
-	PL_restartop = 0;
-	/* FALL THROUGH */
-    case 0:
-        CALLRUNOPS();
-	break;
     }
-    JMPENV_POP;
     PL_op = oldop;
     return Nullop;
 }
@@ -2772,32 +2776,35 @@ doeval(int gimme, OP** startop)
     RETURNOP(PL_eval_start);
 }
 
-static PerlIO *
-doopen(const char *name, const char *mode)
+STATIC PerlIO *
+doopen_pmc(const char *name, const char *mode)
 {
     STRLEN namelen = strlen(name);
     PerlIO *fp;
 
     if (namelen > 3 && strcmp(name + namelen - 3, ".pm") == 0) {
-        SV *pmcsv = newSVpvf("%s%c", name, 'c');
+	SV *pmcsv = newSVpvf("%s%c", name, 'c');
 	char *pmc = SvPV_nolen(pmcsv);
 	Stat_t pmstat;
-        Stat_t pmcstat;
-        if (PerlLIO_stat(pmc, &pmcstat) < 0) {
+	Stat_t pmcstat;
+	if (PerlLIO_stat(pmc, &pmcstat) < 0) {
 	    fp = PerlIO_open(name, mode);
-	} else {
+	}
+	else {
 	    if (PerlLIO_stat(name, &pmstat) < 0 ||
-	        pmstat.st_mtime < pmcstat.st_mtime) {
-	        fp = PerlIO_open(pmc, mode);
-	  } else {
-	        fp = PerlIO_open(name, mode);
-	  }
+	        pmstat.st_mtime < pmcstat.st_mtime)
+	    {
+		fp = PerlIO_open(pmc, mode);
+	    }
+	    else {
+		fp = PerlIO_open(name, mode);
+	    }
 	}
-        SvREFCNT_dec(pmcsv);
-    } else {
-        fp = PerlIO_open(name, mode);
+	SvREFCNT_dec(pmcsv);
+    }
+    else {
+	fp = PerlIO_open(name, mode);
     }
-
     return fp;
 }
 
@@ -2851,7 +2858,7 @@ PP(pp_require)
     )
     {
 	tryname = name;
-	tryrsfp = doopen(name,PERL_SCRIPT_MODE);
+	tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
     }
     else {
 	AV *ar = GvAVn(PL_incgv);
@@ -2875,7 +2882,7 @@ PP(pp_require)
 #endif
 		TAINT_PROPER("require");
 		tryname = SvPVX(namesv);
-		tryrsfp = doopen(tryname, PERL_SCRIPT_MODE);
+		tryrsfp = doopen_pmc(tryname, PERL_SCRIPT_MODE);
 		if (tryrsfp) {
 		    if (tryname[0] == '.' && tryname[1] == '/')
 			tryname += 2;
diff --git a/pp_hot.c b/pp_hot.c
index deb4985c49..5fa2bef7b9 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2094,10 +2094,13 @@ PP(pp_entersub)
 	break;
     case SVt_PVGV:
 	if (!(cv = GvCVu((GV*)sv)))
-	    cv = sv_2cv(sv, &stash, &gv, TRUE);
-	if (cv)
-	    break;
-	DIE("Not a CODE reference");
+	    cv = sv_2cv(sv, &stash, &gv, FALSE);
+	if (!cv) {
+	    ENTER;
+	    SAVETMPS;
+	    goto try_autoload;
+	}
+	break;
     }
 
     ENTER;
@@ -2117,16 +2120,19 @@ PP(pp_entersub)
 	    cv = GvCV(gv);
 	}
 	/* should call AUTOLOAD now? */
-	else if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
-				   FALSE)))
-	{
-	    cv = GvCV(autogv);
-	}
-	/* sorry */
 	else {
-	    sub_name = sv_newmortal();
-	    gv_efullname3(sub_name, gv, Nullch);
-	    DIE("Undefined subroutine &%s called", SvPVX(sub_name));
+try_autoload:
+	    if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
+				   FALSE)))
+	    {
+		cv = GvCV(autogv);
+	    }
+	    /* sorry */
+	    else {
+		sub_name = sv_newmortal();
+		gv_efullname3(sub_name, gv, Nullch);
+		DIE("Undefined subroutine &%s called", SvPVX(sub_name));
+	    }
 	}
 	if (!cv)
 	    DIE("Not a CODE reference");
diff --git a/proto.h b/proto.h
index ff71c5a2e1..f2f45a7b9c 100644
--- a/proto.h
+++ b/proto.h
@@ -99,7 +99,9 @@ VIRTUAL void    do_chop _((SV* asv, SV* sv));
 VIRTUAL bool	do_close _((GV* gv, bool not_implicit));
 VIRTUAL bool	do_eof _((GV* gv));
 VIRTUAL bool	do_exec _((char* cmd));
+#ifndef WIN32
 VIRTUAL bool	do_exec3 _((char* cmd, int fd, int flag));
+#endif
 VIRTUAL void	do_execfree _((void));
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
 I32	do_ipcctl _((I32 optype, SV** mark, SV** sp));
@@ -155,8 +157,8 @@ VIRTUAL OP*	fold_constants _((OP* arg));
 VIRTUAL char*	form _((const char* pat, ...));
 VIRTUAL void	free_tmps _((void));
 VIRTUAL OP*	gen_constant_list _((OP* o));
-#ifndef HAS_GETENV_SV
-VIRTUAL SV*	getenv_sv _((char* key));
+#ifndef HAS_GETENV_LEN
+VIRTUAL char*	getenv_len _((char* key, unsigned long *len));
 #endif
 VIRTUAL void	gp_free _((GV* gv));
 VIRTUAL GP*	gp_ref _((GP* gp));
@@ -744,6 +746,12 @@ void doencodes _((SV* sv, char* s, I32 len));
 SV* refto _((SV* sv));
 U32 seed _((void));
 OP *docatch _((OP *o));
+void *docatch_body _((va_list args));
+void *perl_parse_body _((va_list args));
+void *perl_run_body _((va_list args));
+void *perl_call_body _((va_list args));
+void perl_call_xbody _((OP *myop, int is_eval));
+void *call_list_body _((va_list args));
 OP *dofindlabel _((OP *o, char *label, OP **opstack, OP **oplimit));
 void doparseform _((SV *sv));
 I32 dopoptoeval _((I32 startingblock));
@@ -753,7 +761,7 @@ I32 dopoptosub _((I32 startingblock));
 I32 dopoptosub_at _((PERL_CONTEXT* cxstk, I32 startingblock));
 void save_lines _((AV *array, SV *sv));
 OP *doeval _((int gimme, OP** startop));
-PerlIO *doopen _((const char *name, const char *mode));
+PerlIO *doopen_pmc _((const char *name, const char *mode));
 I32 sv_ncmp _((SV *a, SV *b));
 I32 sv_i_ncmp _((SV *a, SV *b));
 I32 amagic_ncmp _((SV *a, SV *b));
@@ -890,10 +898,11 @@ void del_sv _((SV *p));
 #endif
 void debprof _((OP *o));
 
-void *bset_obj_store _((void *obj, I32 ix));
 OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
 void simplify_sort _((OP *o));
 bool is_handle_constructor _((OP *o, I32 argnum));
+void sv_add_backref _((SV *tsv, SV *sv));
+void sv_del_backref _((SV *sv));
 
 I32 do_trans_CC_simple _((SV *sv));
 I32 do_trans_CC_count _((SV *sv));
@@ -967,9 +976,13 @@ VIRTUAL void do_op_dump _((I32 level, PerlIO *file, OP *o));
 VIRTUAL void do_pmop_dump _((I32 level, PerlIO *file, PMOP *pm));
 VIRTUAL void do_sv_dump _((I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim));
 VIRTUAL void magic_dump _((MAGIC *mg));
+VIRTUAL void* default_protect _((int *excpt, protect_body_t body, ...));
 VIRTUAL void reginitcolors _((void));
 VIRTUAL char* sv_2pv_nolen _((SV* sv));
 VIRTUAL char* sv_pv _((SV *sv));
 VIRTUAL void sv_force_normal _((SV *sv));
 VIRTUAL void tmps_grow _((I32 n));
+VIRTUAL void *bset_obj_store _((void *obj, I32 ix));
 
+VIRTUAL SV* sv_rvweaken _((SV *sv));
+VIRTUAL int magic_killbackrefs _((SV *sv, MAGIC *mg));
diff --git a/scope.c b/scope.c
index b8d45584e2..ad7fe29c01 100644
--- a/scope.c
+++ b/scope.c
@@ -15,6 +15,30 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+void *
+default_protect(int *excpt, protect_body_t body, ...)
+{
+    dTHR;
+    dJMPENV;
+    va_list args;
+    int ex;
+    void *ret;
+
+    DEBUG_l(deb("Setting up local jumplevel %p, was %p\n",
+		&cur_env, PL_top_env));
+    JMPENV_PUSH(ex);
+    if (ex)
+	ret = NULL;
+    else {
+	va_start(args, body);
+	ret = CALL_FPTR(body)(args);
+	va_end(args);
+    }
+    *excpt = ex;
+    JMPENV_POP;
+    return ret;
+}
+
 SV**
 stack_grow(SV **sp, SV **p, int n)
 {
diff --git a/scope.h b/scope.h
index aa865bf9b4..b217fea6b3 100644
--- a/scope.h
+++ b/scope.h
@@ -147,13 +147,40 @@
 
 struct jmpenv {
     struct jmpenv *	je_prev;
-    Sigjmp_buf		je_buf;		
-    int			je_ret;		/* return value of last setjmp() */
-    bool		je_mustcatch;	/* longjmp()s must be caught locally */
+    Sigjmp_buf		je_buf;		/* only for use if !je_throw */
+    int			je_ret;		/* last exception thrown */
+    bool		je_mustcatch;	/* need to call longjmp()? */
+    void		(*je_throw)(int v); /* last for bincompat */
 };
 
 typedef struct jmpenv JMPENV;
 
+/*
+ * Function that catches/throws, and its callback for the
+ *  body of protected processing.
+ */
+typedef void *(CPERLscope(*protect_body_t)) _((va_list));
+typedef void *(CPERLscope(*protect_proc_t)) _((int *, protect_body_t, ...));
+
+/*
+ * How to build the first jmpenv.
+ *
+ * top_env needs to be non-zero. It points to an area
+ * in which longjmp() stuff is stored, as C callstack
+ * info there at least is thread specific this has to
+ * be per-thread. Otherwise a 'die' in a thread gives
+ * that thread the C stack of last thread to do an eval {}!
+ */
+
+#define JMPENV_BOOTSTRAP \
+    STMT_START {				\
+	PL_start_env.je_prev = NULL;		\
+	PL_start_env.je_throw = NULL;		\
+	PL_start_env.je_ret = -1;		\
+	PL_start_env.je_mustcatch = TRUE;	\
+	PL_top_env = &PL_start_env;		\
+    } STMT_END
+
 #ifdef OP_IN_REGISTER
 #define OP_REG_TO_MEM	PL_opsave = op
 #define OP_MEM_TO_REG	op = PL_opsave
@@ -162,30 +189,82 @@ typedef struct jmpenv JMPENV;
 #define OP_MEM_TO_REG	NOOP
 #endif
 
+/*
+ * These exception-handling macros are split up to
+ * ease integration with C++ exceptions.
+ *
+ * To use C++ try+catch to catch Perl exceptions, an extension author
+ * needs to first write an extern "C" function to throw an appropriate
+ * exception object; typically it will be or contain an integer,
+ * because Perl's internals use integers to track exception types:
+ *    extern "C" { static void thrower(int i) { throw i; } }
+ *
+ * Then (as shown below) the author needs to use, not the simple
+ * JMPENV_PUSH, but several of its constitutent macros, to arrange for
+ * the Perl internals to call thrower() rather than longjmp() to
+ * report exceptions:
+ *
+ *    dJMPENV;
+ *    JMPENV_PUSH_INIT(thrower);
+ *    try {
+ *        ... stuff that may throw exceptions ...
+ *    }
+ *    catch (int why) {  // or whatever matches thrower()
+ *        JMPENV_POST_CATCH;
+ *        EXCEPT_SET(why);
+ *        switch (why) {
+ *          ... // handle various Perl exception codes
+ *        }
+ *    }
+ *    JMPENV_POP;  // don't forget this!
+ */
+
 #define dJMPENV		JMPENV cur_env
-#define JMPENV_PUSH(v) \
+
+#define JMPENV_PUSH_INIT(THROWFUNC) \
     STMT_START {					\
+	cur_env.je_throw = (THROWFUNC);			\
+	cur_env.je_ret = -1;				\
+	cur_env.je_mustcatch = FALSE;			\
 	cur_env.je_prev = PL_top_env;			\
+	PL_top_env = &cur_env;				\
 	OP_REG_TO_MEM;					\
-	cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, 1);	\
+    } STMT_END
+#define JMPENV_POST_CATCH \
+    STMT_START {					\
 	OP_MEM_TO_REG;					\
 	PL_top_env = &cur_env;				\
-	cur_env.je_mustcatch = FALSE;			\
-	(v) = cur_env.je_ret;				\
     } STMT_END
+
+#define JMPENV_PUSH(v) \
+    STMT_START {					\
+	JMPENV_PUSH_INIT(NULL);				\
+	EXCEPT_SET(PerlProc_setjmp(cur_env.je_buf, 1));	\
+	JMPENV_POST_CATCH;				\
+	(v) = EXCEPT_GET;				\
+    } STMT_END
+
 #define JMPENV_POP \
     STMT_START { PL_top_env = cur_env.je_prev; } STMT_END
+
 #define JMPENV_JUMP(v) \
     STMT_START {						\
 	OP_REG_TO_MEM;						\
-	if (PL_top_env->je_prev)					\
-	    PerlProc_longjmp(PL_top_env->je_buf, (v));			\
+	if (PL_top_env->je_prev) {				\
+	    if (PL_top_env->je_throw)				\
+		PL_top_env->je_throw(v);			\
+	    else						\
+		PerlProc_longjmp(PL_top_env->je_buf, (v));	\
+	}							\
 	if ((v) == 2)						\
-	    PerlProc_exit(STATUS_NATIVE_EXPORT);				\
+	    PerlProc_exit(STATUS_NATIVE_EXPORT);		\
 	PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");	\
-	PerlProc_exit(1);						\
+	PerlProc_exit(1);					\
     } STMT_END
-   
+
+#define EXCEPT_GET	(cur_env.je_ret)
+#define EXCEPT_SET(v)	(cur_env.je_ret = (v))
+
 #define CATCH_GET	(PL_top_env->je_mustcatch)
 #define CATCH_SET(v)	(PL_top_env->je_mustcatch = (v))
    
diff --git a/sv.c b/sv.c
index 1fff726b9e..d616b8e42d 100644
--- a/sv.c
+++ b/sv.c
@@ -58,6 +58,8 @@ static void del_xnv _((XPVNV* p));
 static void del_xpv _((XPV* p));
 static void del_xrv _((XRV* p));
 static void sv_unglob _((SV* sv));
+static void sv_add_backref _((SV *tsv, SV *sv));
+static void sv_del_backref _((SV *sv));
 
 #ifndef PURIFY
 static void *my_safemalloc(MEM_SIZE size);
@@ -2769,6 +2771,9 @@ sv_magic(register SV *sv, SV *obj, int how, const char *name, I32 namlen)
     case '.':
 	mg->mg_virtual = &PL_vtbl_pos;
 	break;
+    case '<':
+	mg->mg_virtual = &PL_vtbl_backref;
+	break;
     case '~':	/* Reserved for use by extensions not perl internals.	*/
 	/* Useful for attaching extension internal data to perl vars.	*/
 	/* Note that multiple extensions may clash if magical scalars	*/
@@ -2817,6 +2822,63 @@ sv_unmagic(SV *sv, int type)
     return 0;
 }
 
+SV *
+sv_rvweaken(SV *sv)
+{
+    SV *tsv;
+    if (!SvOK(sv))  /* let undefs pass */
+	return sv;
+    if (!SvROK(sv))
+	croak("Can't weaken a nonreference");
+    else if (SvWEAKREF(sv)) {
+	dTHR;
+	if (ckWARN(WARN_MISC))
+	    warner(WARN_MISC, "Reference is already weak");
+	return sv;
+    }
+    tsv = SvRV(sv);
+    sv_add_backref(tsv, sv);
+    SvWEAKREF_on(sv);
+    SvREFCNT_dec(tsv);              
+    return sv;
+}
+
+STATIC void
+sv_add_backref(SV *tsv, SV *sv)
+{
+    AV *av;
+    MAGIC *mg;
+    if (SvMAGICAL(tsv) && (mg = mg_find(tsv, '<')))
+	av = (AV*)mg->mg_obj;
+    else {
+	av = newAV();
+	sv_magic(tsv, (SV*)av, '<', NULL, 0);
+	SvREFCNT_dec(av);           /* for sv_magic */
+    }
+    av_push(av,sv);
+}
+
+STATIC void 
+sv_del_backref(SV *sv)
+{
+    AV *av;
+    SV **svp;
+    I32 i;
+    SV *tsv = SvRV(sv);
+    MAGIC *mg;
+    if (!SvMAGICAL(tsv) || !(mg = mg_find(tsv, '<')))
+	croak("panic: del_backref");
+    av = (AV *)mg->mg_obj;
+    svp = AvARRAY(av);
+    i = AvFILLp(av);
+    while (i >= 0) {
+	if (svp[i] == sv) {
+	    svp[i] = &PL_sv_undef; /* XXX */
+	}
+	i--;
+    }
+}
+
 void
 sv_insert(SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN littlelen)
 {
@@ -3038,8 +3100,12 @@ sv_clear(register SV *sv)
 	/* FALL THROUGH */
     case SVt_PV:
     case SVt_RV:
-	if (SvROK(sv))
-	    SvREFCNT_dec(SvRV(sv));
+	if (SvROK(sv)) {
+	    if (SvWEAKREF(sv))
+	        sv_del_backref(sv);
+	    else
+	        SvREFCNT_dec(SvRV(sv));
+	}
 	else if (SvPVX(sv) && SvLEN(sv))
 	    Safefree(SvPVX(sv));
 	break;
@@ -4148,6 +4214,9 @@ sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref)
 	    ENTER;
 	    tmpsv = NEWSV(704,0);
 	    gv_efullname3(tmpsv, gv, Nullch);
+	    /* XXX this is probably not what they think they're getting.
+	     * It has the same effect as "sub name;", i.e. just a forward
+	     * declaration! */
 	    newSUB(start_subparse(FALSE, 0),
 		   newSVOP(OP_CONST, 0, tmpsv),
 		   Nullop,
@@ -4452,7 +4521,13 @@ void
 sv_unref(SV *sv)
 {
     SV* rv = SvRV(sv);
-    
+
+    if (SvWEAKREF(sv)) {
+    	sv_del_backref(sv);
+	SvWEAKREF_off(sv);
+	SvRV(sv) = 0;
+	return;
+    }
     SvRV(sv) = 0;
     SvROK_off(sv);
     if (SvREFCNT(rv) != 1 || SvREADONLY(rv))
diff --git a/sv.h b/sv.h
index 533b4c4a46..cc8c6bc936 100644
--- a/sv.h
+++ b/sv.h
@@ -165,6 +165,8 @@ struct io {
 #define SVphv_SHAREKEYS 0x20000000	/* keys live on shared string table */
 #define SVphv_LAZYDEL	0x40000000	/* entry in xhv_eiter must be deleted */
 
+#define SVprv_WEAKREF   0x80000000      /* Weak reference */
+
 struct xrv {
     SV *	xrv_rv;		/* pointer to another SV */
 };
@@ -410,6 +412,11 @@ struct xpvio {
 */
 #define Gv_AMG(stash)           (PL_amagic_generation && Gv_AMupdate(stash))
 
+#define SvWEAKREF(sv)		((SvFLAGS(sv) & (SVf_ROK|SVprv_WEAKREF)) \
+				  == (SVf_ROK|SVprv_WEAKREF))
+#define SvWEAKREF_on(sv)	(SvFLAGS(sv) |=  (SVf_ROK|SVprv_WEAKREF))
+#define SvWEAKREF_off(sv)	(SvFLAGS(sv) &= ~(SVf_ROK|SVprv_WEAKREF))
+
 #define SvTHINKFIRST(sv)	(SvFLAGS(sv) & SVf_THINKFIRST)
 
 #define SvPADBUSY(sv)		(SvFLAGS(sv) & SVs_PADBUSY)
diff --git a/t/io/open.t b/t/io/open.t
index 50ae38dff1..63079c8b77 100755
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -8,9 +8,10 @@ print "1..9\n";
 
 # my $file tests
 
-unlink("afile.new") if -f "afile";     
+unlink("afile") if -f "afile";     
 print "$!\nnot " unless open(my $f,"+>afile");
 print "ok 1\n";
+binmode $f;
 print "not " unless -f "afile";     
 print "ok 2\n";
 print "not " unless print $f "SomeData\n";
diff --git a/t/op/magic.t b/t/op/magic.t
index 8486512b35..17246f6b8a 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -155,9 +155,11 @@ EOF
     s/\.exe//i if $Is_Dos;
     s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
     s{is perl}{is $perl}; # for systems where $^X is only a basename
+    s{\\}{/}g;
     ok 23, ($Is_MSWin32 ? uc($_) eq uc($s1) : $_ eq $s1), ":$_:!=:$s1:";
     $_ = `$perl $script`;
     s/\.exe//i if $Is_Dos;
+    s{\\}{/}g;
     ok 24, ($Is_MSWin32 ? uc($_) eq uc($s1) : $_ eq $s1), ":$_:!=:$s1: after `$perl $script`";
     ok 25, unlink($script), $!;
 }
diff --git a/t/op/method.t b/t/op/method.t
index 0912f1e10a..1c6f3c5d9d 100755
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -4,7 +4,7 @@
 # test method calls and autoloading.
 #
 
-print "1..46\n";
+print "1..49\n";
 
 @A::ISA = 'B';
 @B::ISA = 'C';
@@ -155,3 +155,15 @@ test(A->eee(), "new B: In A::eee, 4");	# Which sticks
 
 # this test added due to bug discovery
 test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined");
+
+# test that failed subroutine calls don't affect method calls
+{
+    package A1;
+    sub foo { "foo" }
+    package A2;
+    @ISA = 'A1';
+    package main;
+    test(A2->foo(), "foo");
+    test(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1);
+    test(A2->foo(), "foo");
+}
diff --git a/thrdvar.h b/thrdvar.h
index 69f17fbc76..7fae131b64 100644
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -93,8 +93,10 @@ PERLVAR(Tlocalizing,	int)		/* are we processing a local() list? */
 PERLVAR(Tcurstack,	AV *)		/* THE STACK */
 PERLVAR(Tcurstackinfo,	PERL_SI *)	/* current stack + context */
 PERLVAR(Tmainstack,	AV *)		/* the stack when nothing funny is happening */
+
 PERLVAR(Ttop_env,	JMPENV *)	/* ptr. to current sigjmp() environment */
 PERLVAR(Tstart_env,	JMPENV)		/* empty startup sigjmp() environment */
+PERLVARI(Tprotect,	protect_proc_t,	FUNC_NAME_TO_PTR(default_protect))
 
 /* statics "owned" by various functions */
 PERLVAR(Tav_fetch_sv,	SV *)		/* owned by av_fetch() */
diff --git a/toke.c b/toke.c
index e9234f61cd..6f846dc37d 100644
--- a/toke.c
+++ b/toke.c
@@ -1487,6 +1487,7 @@ filter_del(filter_t funcp)
 	return;
     /* if filter is on top of stack (usual case) just pop it off */
     if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (DIR*)funcp){
+	IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL;
 	sv_free(av_pop(PL_rsfp_filters));
 
         return;
diff --git a/util.c b/util.c
index 8df5616573..9ea0851204 100644
--- a/util.c
+++ b/util.c
@@ -2932,6 +2932,8 @@ new_struct_thread(struct perl_thread *t)
     Zero(thr, 1, struct perl_thread);
 #endif
 
+    PL_protect = FUNC_NAME_TO_PTR(default_protect);
+
     thr->oursv = sv;
     init_stacks(ARGS);
 
@@ -2975,6 +2977,8 @@ new_struct_thread(struct perl_thread *t)
     /* parent thread's data needs to be locked while we make copy */
     MUTEX_LOCK(&t->mutex);
 
+    PL_protect = t->Tprotect;
+
     PL_curcop = t->Tcurcop;       /* XXX As good a guess as any? */
     PL_defstash = t->Tdefstash;   /* XXX maybe these should */
     PL_curstash = t->Tcurstash;   /* always be set to main? */
@@ -3075,18 +3079,14 @@ get_specialsv_list(void)
  return PL_specialsv_list;
 }
 
-#ifndef HAS_GETENV_SV
-SV *
-getenv_sv(char *env_elem)
+#ifndef HAS_GETENV_LEN
+char *
+getenv_len(char *env_elem, unsigned long *len)
 {
-  char *env_trans;
-  SV *temp_sv;
-  if ((env_trans = PerlEnv_getenv(env_elem)) != Nullch) {
-    temp_sv = newSVpv(env_trans, strlen(env_trans));
-    return temp_sv;
-  } else {
-    return &PL_sv_undef;
-  }
+    char *env_trans = PerlEnv_getenv(env_elem);
+    if (env_trans)
+	*len = strlen(env_trans);
+    return env_trans;
 }
 #endif
 
@@ -3188,6 +3188,9 @@ get_vtbl(int vtbl_id)
     case want_vtbl_amagicelem:
 	result = &PL_vtbl_amagicelem;
 	break;
+    case want_vtbl_backref:
+	result = &PL_vtbl_backref;
+	break;
     }
     return result;
 }
diff --git a/vms/vms.c b/vms/vms.c
index 1212555d04..ebb05a142a 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -207,7 +207,7 @@ int my_trnlnm(const char *lnm, char *eqv, unsigned long int idx)
  * Note: Uses Perl temp to store result so char * can be returned to
  * caller; this pointer will be invalidated at next Perl statement
  * transition.
- * We define this as a function rather than a macro in terms of my_getenv_sv()
+ * We define this as a function rather than a macro in terms of my_getenv_len()
  * so that it'll work when PL_curinterp is undefined (and we therefore can't
  * allocate SVs).
  */
@@ -256,17 +256,18 @@ my_getenv(const char *lnm, bool sys)
 /*}}}*/
 
 
-/*{{{ SV *my_getenv_sv(const char *lnm, bool sys)*/
-SV *
-my_getenv_sv(const char *lnm, bool sys)
+/*{{{ SV *my_getenv_len(const char *lnm, bool sys)*/
+char *
+my_getenv_len(const char *lnm, unsigned long *len, bool sys)
 {
     char buf[LNM$C_NAMLENGTH+1], *cp1, *cp2;
-    unsigned long int len, idx = 0;
+    unsigned long idx = 0;
 
     for (cp1 = (char *)lnm, cp2 = buf; *cp1; cp1++,cp2++) *cp2 = _toupper(*cp1);
     if (cp1 - lnm == 7 && !strncmp(buf,"DEFAULT",7)) {
       getcwd(buf,LNM$C_NAMLENGTH);
-      return newSVpv(buf,0);
+      *len = strlen(buf);
+      return buf;
     }
     else {
       if ((cp2 = strchr(lnm,';')) != NULL) {
@@ -275,18 +276,19 @@ my_getenv_sv(const char *lnm, bool sys)
         idx = strtoul(cp2+1,NULL,0);
         lnm = buf;
       }
-      if ((len = vmstrnenv(lnm,buf,idx,
+      if ((*len = vmstrnenv(lnm,buf,idx,
                            sys ? fildev : NULL,
 #ifdef SECURE_INTERNAL_GETENV
                            sys ? PERL__TRNENV_SECURE : 0
 #else
                                                        0
 #endif
-                                                         ))) return newSVpv(buf,len);
-      else return &PL_sv_undef;
+                                                         )))
+	  return buf;
+      else return Nullch;
     }
 
-}  /* end of my_getenv_sv() */
+}  /* end of my_getenv_len() */
 /*}}}*/
 
 static void create_mbx(unsigned short int *, struct dsc$descriptor_s *);
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 4b45cf4968..5398bcccb0 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -74,7 +74,7 @@
   /* getenv used for regular logical names */
 #  define getenv(v) my_getenv(v,TRUE)
 #endif
-#define getenv_sv(v) my_getenv_sv(v,TRUE)
+#define getenv_len(v,l) my_getenv_len(v,l,TRUE)
 
 /* DECC introduces this routine in the RTL as of VMS 7.0; for now,
  * we'll use ours, since it gives us the full VMS exit status. */
@@ -90,7 +90,7 @@
 #define vmstrnenv		Perl_vmstrnenv
 #define my_trnlnm		Perl_my_trnlnm
 #define my_getenv		Perl_my_getenv
-#define my_getenv_sv		Perl_my_getenv_sv
+#define my_getenv_len		Perl_my_getenv_len
 #define prime_env_iter	Perl_prime_env_iter
 #define vmssetenv		Perl_vmssetenv
 #define my_setenv		Perl_my_setenv
@@ -413,7 +413,7 @@ struct utimbuf {
 #define ENV_HV_NAME "%EnV%VmS%"
   /* Special getenv function for retrieving %ENV elements. */
 #define ENVgetenv(v) my_getenv(v,FALSE)
-#define ENVgetenv_sv(v) my_getenv_sv(v,FALSE)
+#define ENVgetenv_len(v,l) my_getenv_len(v,l,FALSE)
 
 
 /* Thin jacket around cuserid() tomatch Unix' calling sequence */
@@ -581,7 +581,7 @@ typedef char  __VMS_PROTOTYPES__;
 int	vmstrnenv _((const char *, char *, unsigned long int, struct dsc$descriptor_s **, unsigned long int));
 int	my_trnlnm _((const char *, char *, unsigned long int));
 char *	my_getenv _((const char *, bool));
-SV *	my_getenv_sv _((const char *, bool));
+char *	my_getenv_len _((const char *, unsigned long *, bool));
 int	vmssetenv _((char *, char *, struct dsc$descriptor_s **));
 char *	my_crypt _((const char *, const char *));
 Pid_t	my_waitpid _((Pid_t, int *, int));
diff --git a/win32/GenCAPI.pl b/win32/GenCAPI.pl
index 77e7aad8b8..82e0b32fc7 100644
--- a/win32/GenCAPI.pl
+++ b/win32/GenCAPI.pl
@@ -73,6 +73,8 @@ safexrealloc
 safexfree
 Perl_GetVars
 malloced_size
+do_exec3
+getenv_len
 )];
 
 
@@ -155,14 +157,11 @@ while () {
 #undef $name
 extern "C" $type $funcName ($args)
 {
-    char *pstr;
-    char *pmsg;
+    SV *pmsg;
     va_list args;
     va_start(args, $arg);
-    pmsg = pPerl->Perl_mess($arg, &args);
-    New(0, pstr, strlen(pmsg)+1, char);
-    strcpy(pstr, pmsg);
-$return pPerl->Perl_$name($start pstr);
+    pmsg = pPerl->Perl_sv_2mortal(pPerl->Perl_newSVsv(pPerl->Perl_mess($arg, &args)));
+$return pPerl->Perl_$name($start SvPV_nolen(pmsg));
     va_end(args);
 }
 ENDCODE
diff --git a/win32/Makefile b/win32/Makefile
index ffa8c6b1a4..41d88ed042 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -527,7 +527,7 @@ RE		= $(EXTDIR)\re\re
 DUMPER		= $(EXTDIR)\Data\Dumper\Dumper
 ERRNO		= $(EXTDIR)\Errno\Errno
 PEEK		= $(EXTDIR)\Devel\Peek\Peek
-BYTELOADER	= $(EXTDIR)\ByteLoader
+BYTELOADER	= $(EXTDIR)\ByteLoader\ByteLoader
 
 SOCKET_DLL	= $(AUTODIR)\Socket\Socket.dll
 FCNTL_DLL	= $(AUTODIR)\Fcntl\Fcntl.dll
diff --git a/win32/config.bc b/win32/config.bc
index 691dfbbcd4..6936dcc98f 100644
--- a/win32/config.bc
+++ b/win32/config.bc
@@ -1,7 +1,7 @@
 ## Configured by: ~cf_email~
 ## Target system: WIN32 
 Author=''
-CONFIG='true'
+CONFIGDOTSH='true'
 Date='$Date'
 Header=''
 Id='$Id'
diff --git a/win32/config.gc b/win32/config.gc
index 39b77015ae..200b10c33c 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -1,7 +1,7 @@
 ## Configured by: ~cf_email~
 ## Target system: WIN32 
 Author=''
-CONFIG='true'
+CONFIGDOTSH='true'
 Date='$Date'
 Header=''
 Id='$Id'
diff --git a/win32/config.vc b/win32/config.vc
index ea86e5f530..09fa5af202 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -1,7 +1,7 @@
 ## Configured by: ~cf_email~
 ## Target system: WIN32 
 Author=''
-CONFIG='true'
+CONFIGDOTSH='true'
 Date='$Date'
 Header=''
 Id='$Id'
diff --git a/win32/makedef.pl b/win32/makedef.pl
index f13c1da0a7..212f0000fd 100644
--- a/win32/makedef.pl
+++ b/win32/makedef.pl
@@ -79,6 +79,7 @@ PL_pending_ident
 PL_sortcxix
 PL_sublex_info
 PL_timesbuf
+Perl_do_exec3
 Perl_do_ipcctl
 Perl_do_ipcget
 Perl_do_msgrcv
@@ -302,7 +303,6 @@ sub output_symbol {
 __DATA__
 # extra globals not included above.
 perl_init_i18nl10n
-perl_init_ext
 perl_alloc
 perl_atexit
 perl_construct
diff --git a/win32/makefile.mk b/win32/makefile.mk
index bee351ce03..7f2b515024 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -642,7 +642,7 @@ RE		= $(EXTDIR)\re\re
 DUMPER		= $(EXTDIR)\Data\Dumper\Dumper
 ERRNO		= $(EXTDIR)\Errno\Errno
 PEEK		= $(EXTDIR)\Devel\Peek\Peek
-BYTELOADER	= $(EXTDIR)\ByteLoader
+BYTELOADER	= $(EXTDIR)\ByteLoader\ByteLoader
 
 SOCKET_DLL	= $(AUTODIR)\Socket\Socket.dll
 FCNTL_DLL	= $(AUTODIR)\Fcntl\Fcntl.dll
diff --git a/win32/perlhost.h b/win32/perlhost.h
index cc5b5e5cd4..458ff9afc9 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -102,6 +102,13 @@ public:
     {
 	return win32_uname(name);
     };
+    virtual char *Getenv_len(const char *varname, unsigned long *len, int &err)
+    {
+	char *e = win32_getenv(varname);
+	if (e)
+	    *len = strlen(e);
+	return e;
+    };
 };
 
 class CPerlSock : public IPerlSock
diff --git a/win32/runperl.c b/win32/runperl.c
index 1b569d2557..336f2a87a5 100644
--- a/win32/runperl.c
+++ b/win32/runperl.c
@@ -28,9 +28,6 @@ xs_init(CPERLarg)
 
 CPerlObj *pPerl;
 
-#undef PERL_SYS_INIT
-#define PERL_SYS_INIT(a, c)
-
 int
 main(int argc, char **argv, char **env)
 {
@@ -48,6 +45,8 @@ main(int argc, char **argv, char **env)
     argv[0] = szModuleName;
 #endif
 
+    PERL_SYS_INIT(&argc,&argv);
+
     if (!host.PerlCreate())
 	exit(exitstatus);
 
diff --git a/win32/win32.c b/win32/win32.c
index 414e4c5dfc..4988e31648 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -1307,7 +1307,12 @@ win32_uname(struct utsname *name)
 	SYSTEM_INFO info;
 	char *arch;
 	GetSystemInfo(&info);
+
+#ifdef __BORLANDC__
+	switch (info.u.s.wProcessorArchitecture) {
+#else
 	switch (info.wProcessorArchitecture) {
+#endif
 	case PROCESSOR_ARCHITECTURE_INTEL:
 	    arch = "x86"; break;
 	case PROCESSOR_ARCHITECTURE_MIPS:
@@ -2860,8 +2865,8 @@ static
 XS(w32_GetTickCount)
 {
     dXSARGS;
-    EXTEND(SP,1);
     DWORD msec = GetTickCount();
+    EXTEND(SP,1);
     if ((IV)msec > 0)
 	XSRETURN_IV(msec);
     XSRETURN_NV(msec);
diff --git a/win32/win32.h b/win32/win32.h
index a072b875c9..f712928cf0 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -12,6 +12,7 @@
 #ifdef PERL_OBJECT
 #  define DYNAMIC_ENV_FETCH
 #  define ENV_HV_NAME "___ENV_HV_NAME___"
+#  define HAS_GETENV_LEN
 #  define prime_env_iter()
 #  define WIN32IO_IS_STDIO		/* don't pull in custom stdio layer */
 #  ifdef PERL_GLOBAL_STRUCT
@@ -184,6 +185,7 @@ struct utsname {
 
 typedef long		uid_t;
 typedef long		gid_t;
+typedef unsigned short	mode_t;
 #pragma  warning(disable: 4018 4035 4101 4102 4244 4245 4761)
 
 #ifndef PERL_OBJECT
author	Jarkko Hietaniemi <jhi@iki.fi>	1999-05-11 21:44:59 +0000
committer	Jarkko Hietaniemi <jhi@iki.fi>	1999-05-11 21:44:59 +0000
commit	27130c9a98b24c6442a9f796599b1927247c27ab (patch)
tree	7d06fb4f09cc65d1ed91420c66fadd7a0d5d35ee
parent	e3159d07eae19a2ad4bc7e5f2e54e307a931528b (diff)
parent	e0284a306d2de082f33ef0d8787355c6d4e646d8 (diff)
download	perl-27130c9a98b24c6442a9f796599b1927247c27ab.tar.gz