integrate changes#2120,2168,2218 from maint-5.005;

add new vtbls; s/\bvtbl_/PL_vtbl_/; remove trailing comma in
enum; make regen_headers

p4raw-link: @2218 on //depot/maint-5.005/perl: eadd311f94dcb5fe096743b61371bd2d48466304
p4raw-link: @2168 on //depot/maint-5.005/perl: fb1d2f1891787fe7d6df85205b85f0528294ffa8
p4raw-link: @2120 on //depot/maint-5.005/perl: f9caadc6ad025d4bf993ab5b737b9a99347a59e3

p4raw-id: //depot/perl@2220

10 files changed, 233 insertions, 14 deletions

diff --git a/XSUB.h b/XSUB.h
index dc805d85ac..9111da26fa 100644
--- a/XSUB.h
+++ b/XSUB.h
@@ -79,6 +79,74 @@
 # define XS_VERSION_BOOTCHECK
 #endif
 
+#ifdef PERL_CAPI
+#  define VTBL_sv		get_vtbl(want_vtbl_sv)
+#  define VTBL_env		get_vtbl(want_vtbl_env)
+#  define VTBL_envelem		get_vtbl(want_vtbl_envelem)
+#  define VTBL_sig		get_vtbl(want_vtbl_sig)
+#  define VTBL_sigelem		get_vtbl(want_vtbl_sigelem)
+#  define VTBL_pack		get_vtbl(want_vtbl_pack)
+#  define VTBL_packelem		get_vtbl(want_vtbl_packelem)
+#  define VTBL_dbline		get_vtbl(want_vtbl_dbline)
+#  define VTBL_isa		get_vtbl(want_vtbl_isa)
+#  define VTBL_isaelem		get_vtbl(want_vtbl_isaelem)
+#  define VTBL_arylen		get_vtbl(want_vtbl_arylen)
+#  define VTBL_glob		get_vtbl(want_vtbl_glob)
+#  define VTBL_mglob		get_vtbl(want_vtbl_mglob)
+#  define VTBL_nkeys		get_vtbl(want_vtbl_nkeys)
+#  define VTBL_taint		get_vtbl(want_vtbl_taint)
+#  define VTBL_substr		get_vtbl(want_vtbl_substr)
+#  define VTBL_vec		get_vtbl(want_vtbl_vec)
+#  define VTBL_pos		get_vtbl(want_vtbl_pos)
+#  define VTBL_bm		get_vtbl(want_vtbl_bm)
+#  define VTBL_fm		get_vtbl(want_vtbl_fm)
+#  define VTBL_uvar		get_vtbl(want_vtbl_uvar)
+#  define VTBL_defelem		get_vtbl(want_vtbl_defelem)
+#  define VTBL_regexp		get_vtbl(want_vtbl_regexp)
+#  define VTBL_regdata		get_vtbl(want_vtbl_regdata)
+#  define VTBL_regdatum		get_vtbl(want_vtbl_regdatum)
+#  ifdef USE_LOCALE_COLLATE
+#    define VTBL_collxfrm	get_vtbl(want_vtbl_collxfrm)
+#  endif
+#  ifdef OVERLOAD
+#    define VTBL_amagic		get_vtbl(want_vtbl_amagic)
+#    define VTBL_amagicelem	get_vtbl(want_vtbl_amagicelem)
+#  endif
+#else
+#  define VTBL_sv		&PL_vtbl_sv
+#  define VTBL_env		&PL_vtbl_env
+#  define VTBL_envelem		&PL_vtbl_envelem
+#  define VTBL_sig		&PL_vtbl_sig
+#  define VTBL_sigelem		&PL_vtbl_sigelem
+#  define VTBL_pack		&PL_vtbl_pack
+#  define VTBL_packelem		&PL_vtbl_packelem
+#  define VTBL_dbline		&PL_vtbl_dbline
+#  define VTBL_isa		&PL_vtbl_isa
+#  define VTBL_isaelem		&PL_vtbl_isaelem
+#  define VTBL_arylen		&PL_vtbl_arylen
+#  define VTBL_glob		&PL_vtbl_glob
+#  define VTBL_mglob		&PL_vtbl_mglob
+#  define VTBL_nkeys		&PL_vtbl_nkeys
+#  define VTBL_taint		&PL_vtbl_taint
+#  define VTBL_substr		&PL_vtbl_substr
+#  define VTBL_vec		&PL_vtbl_vec
+#  define VTBL_pos		&PL_vtbl_pos
+#  define VTBL_bm		&PL_vtbl_bm
+#  define VTBL_fm		&PL_vtbl_fm
+#  define VTBL_uvar		&PL_vtbl_uvar
+#  define VTBL_defelem		&PL_vtbl_defelem
+#  define VTBL_regexp		&PL_vtbl_regexp
+#  define VTBL_regdata		&PL_vtbl_regdata
+#  define VTBL_regdatum		&PL_vtbl_regdatum
+#  ifdef USE_LOCALE_COLLATE
+#    define VTBL_collxfrm	&PL_vtbl_collxfrm
+#  endif
+#  ifdef OVERLOAD
+#    define VTBL_amagic		&PL_vtbl_amagic
+#    define VTBL_amagicelem	&PL_vtbl_amagicelem
+#  endif
+#endif
+
 #ifdef PERL_OBJECT
 #include "objXSUB.h"
 #ifndef NO_XSLOCKS
diff --git a/embed.h b/embed.h
index d3b770f9f4..c240a9815a 100644
--- a/embed.h
+++ b/embed.h
@@ -167,6 +167,7 @@
 #define get_op_names		Perl_get_op_names
 #define get_opargs		Perl_get_opargs
 #define get_specialsv_list	Perl_get_specialsv_list
+#define get_vtbl		Perl_get_vtbl
 #define gp_free			Perl_gp_free
 #define gp_ref			Perl_gp_ref
 #define gv_AVadd		Perl_gv_AVadd
@@ -1197,6 +1198,7 @@
 #define get_op_names		CPerlObj::Perl_get_op_names
 #define get_opargs		CPerlObj::Perl_get_opargs
 #define get_specialsv_list	CPerlObj::Perl_get_specialsv_list
+#define get_vtbl		CPerlObj::Perl_get_vtbl
 #define gp_free			CPerlObj::Perl_gp_free
 #define gp_ref			CPerlObj::Perl_gp_ref
 #define gv_AVadd		CPerlObj::Perl_gv_AVadd
diff --git a/ext/IPC/SysV/Msg.pm b/ext/IPC/SysV/Msg.pm
index 93d2ae16ee..a739ca2367 100644
--- a/ext/IPC/SysV/Msg.pm
+++ b/ext/IPC/SysV/Msg.pm
@@ -84,7 +84,7 @@ sub remove {
 }
 
 sub rcv {
-    @_ == 5 || croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )';
+    @_ <= 5 && @_ >= 3 or croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )';
     my $self = shift;
     my $buf = "";
     msgrcv($$self,$buf,$_[1],$_[2] || 0, $_[3] || 0) or
@@ -95,7 +95,7 @@ sub rcv {
 }
 
 sub snd {
-    @_ == 4 || croak '$msg->snd( TYPE, BUF, FLAGS )';
+    @_ <= 4 && @_ >= 3 or  croak '$msg->snd( TYPE, BUF, FLAGS )';
     my $self = shift;
     msgsnd($$self,pack("L a*",$_[0],$_[1]), $_[2] || 0);
 }
diff --git a/global.sym b/global.sym
index 5974a32d71..95c2b0a8c5 100644
--- a/global.sym
+++ b/global.sym
@@ -158,6 +158,7 @@ get_op_names
 get_no_modify
 get_opargs
 get_specialsv_list
+get_vtbl
 gp_free
 gp_ref
 gv_AVadd
diff --git a/objXSUB.h b/objXSUB.h
index 315e710df5..89bdfd9209 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -977,6 +977,8 @@
 #define get_opargs	        pPerl->Perl_get_opargs
 #undef  get_specialsv_list
 #define get_specialsv_list  pPerl->Perl_get_specialsv_list
+#undef  get_vtbl
+#define get_vtbl            pPerl->Perl_get_vtbl
 #undef  gp_free
 #define gp_free             pPerl->Perl_gp_free
 #undef  gp_ref
diff --git a/perl.h b/perl.h
index ba898c49e2..a584148599 100644
--- a/perl.h
+++ b/perl.h
@@ -2144,6 +2144,40 @@ typedef enum {
     XTERMBLOCK
 } expectation;
 
+enum {		/* pass one of these to get_vtbl */
+    want_vtbl_sv,
+    want_vtbl_env,
+    want_vtbl_envelem,
+    want_vtbl_sig,
+    want_vtbl_sigelem,
+    want_vtbl_pack,
+    want_vtbl_packelem,
+    want_vtbl_dbline,
+    want_vtbl_isa,
+    want_vtbl_isaelem,
+    want_vtbl_arylen,
+    want_vtbl_glob,
+    want_vtbl_mglob,
+    want_vtbl_nkeys,
+    want_vtbl_taint,
+    want_vtbl_substr,
+    want_vtbl_vec,
+    want_vtbl_pos,
+    want_vtbl_bm,
+    want_vtbl_fm,
+    want_vtbl_uvar,
+    want_vtbl_defelem,
+    want_vtbl_regexp,
+    want_vtbl_collxfrm,
+    want_vtbl_amagic,
+    want_vtbl_amagicelem,
+#ifdef USE_THREADS
+    want_vtbl_mutex,
+#endif
+    want_vtbl_regdata,
+    want_vtbl_regdatum
+};
+
 
 				/* Note: the lowest 8 bits are reserved for
 				   stuffing into op->op_private */
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 766b060c8a..8e7cf6da28 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -673,7 +673,7 @@ L<perlipc/"Sockets: Client/Server Communication">.
 =item continue BLOCK
 
 Actually a flow control statement rather than a function.  If there is a
-C<continue> BLOCK attached to a BLOCK (typically in a L<(while> or
+C<continue> BLOCK attached to a BLOCK (typically in a L</while> or
 L</foreach>), it is always executed just before the conditional is about to
 be evaluated again, just like the third part of a L</for> loop in C.  Thus
 it can be used to increment a loop variable, even when the loop has been
diff --git a/proto.h b/proto.h
index fab5250dd1..4c20aba846 100644
--- a/proto.h
+++ b/proto.h
@@ -943,6 +943,8 @@ VIRTUAL void	sv_setpvn_mg _((SV *sv, const char *ptr, STRLEN len));
 VIRTUAL void	sv_setsv_mg _((SV *dstr, SV *sstr));
 VIRTUAL void	sv_usepvn_mg _((SV *sv, char *ptr, STRLEN len));
 
+VIRTUAL MGVTBL*	get_vtbl _((int vtbl_id));
+
 /* New virtual functions must be added here to maintain binary
  * compatablity with PERL_OBJECT
  */
diff --git a/util.c b/util.c
index 6dead7a39a..4698e901d0 100644
--- a/util.c
+++ b/util.c
@@ -2970,3 +2970,104 @@ get_specialsv_list(void)
 {
  return PL_specialsv_list;
 }
+
+
+MGVTBL*
+get_vtbl(int vtbl_id)
+{
+    MGVTBL* result = Null(MGVTBL*);
+
+    switch(vtbl_id) {
+    case want_vtbl_sv:
+	result = &PL_vtbl_sv;
+	break;
+    case want_vtbl_env:
+	result = &PL_vtbl_env;
+	break;
+    case want_vtbl_envelem:
+	result = &PL_vtbl_envelem;
+	break;
+    case want_vtbl_sig:
+	result = &PL_vtbl_sig;
+	break;
+    case want_vtbl_sigelem:
+	result = &PL_vtbl_sigelem;
+	break;
+    case want_vtbl_pack:
+	result = &PL_vtbl_pack;
+	break;
+    case want_vtbl_packelem:
+	result = &PL_vtbl_packelem;
+	break;
+    case want_vtbl_dbline:
+	result = &PL_vtbl_dbline;
+	break;
+    case want_vtbl_isa:
+	result = &PL_vtbl_isa;
+	break;
+    case want_vtbl_isaelem:
+	result = &PL_vtbl_isaelem;
+	break;
+    case want_vtbl_arylen:
+	result = &PL_vtbl_arylen;
+	break;
+    case want_vtbl_glob:
+	result = &PL_vtbl_glob;
+	break;
+    case want_vtbl_mglob:
+	result = &PL_vtbl_mglob;
+	break;
+    case want_vtbl_nkeys:
+	result = &PL_vtbl_nkeys;
+	break;
+    case want_vtbl_taint:
+	result = &PL_vtbl_taint;
+	break;
+    case want_vtbl_substr:
+	result = &PL_vtbl_substr;
+	break;
+    case want_vtbl_vec:
+	result = &PL_vtbl_vec;
+	break;
+    case want_vtbl_pos:
+	result = &PL_vtbl_pos;
+	break;
+    case want_vtbl_bm:
+	result = &PL_vtbl_bm;
+	break;
+    case want_vtbl_fm:
+	result = &PL_vtbl_fm;
+	break;
+    case want_vtbl_uvar:
+	result = &PL_vtbl_uvar;
+	break;
+#ifdef USE_THREADS
+    case want_vtbl_mutex:
+	result = &PL_vtbl_mutex;
+	break;
+#endif
+    case want_vtbl_defelem:
+	result = &PL_vtbl_defelem;
+	break;
+    case want_vtbl_regexp:
+	result = &PL_vtbl_regexp;
+	break;
+    case want_vtbl_regdata:
+	result = &PL_vtbl_regdata;
+	break;
+    case want_vtbl_regdatum:
+	result = &PL_vtbl_regdatum;
+	break;
+    case want_vtbl_collxfrm:
+	result = &PL_vtbl_collxfrm;
+	break;
+    case want_vtbl_amagic:
+	result = &PL_vtbl_amagic;
+	break;
+    case want_vtbl_amagicelem:
+	result = &PL_vtbl_amagicelem;
+	break;
+    }
+    return result;
+}
+
diff --git a/win32/win32.c b/win32/win32.c
index 1ce7ad98bc..be5f5e1e0c 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -38,6 +38,8 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+#include "patchlevel.h"
+
 #define NO_XSLOCKS
 #ifdef PERL_OBJECT
 extern CPerlObj* pPerl;
@@ -176,6 +178,7 @@ GetRegStr(const char *lpszValueName, char** ptr, DWORD* lpDataLen)
 static char *
 get_emd_part(char *prev_path, char *trailing_path, ...)
 {
+    char base[10];
     va_list ap;
     char mod_name[MAX_PATH+1];
     char *ptr;
@@ -186,6 +189,8 @@ get_emd_part(char *prev_path, char *trailing_path, ...)
     va_start(ap, trailing_path);
     strip = va_arg(ap, char *);
 
+    sprintf(base, "%5.3f", (double) 5 + ((double) PATCHLEVEL / (double) 1000));
+
     GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE)
 		      ? GetModuleHandle(NULL)
 		      : w32_perldll_handle, mod_name, sizeof(mod_name));
@@ -209,17 +214,21 @@ get_emd_part(char *prev_path, char *trailing_path, ...)
     va_end(ap);
     strcpy(++ptr, trailing_path);
 
-    newsize = strlen(mod_name) + 1;
-    if (prev_path) {
-	oldsize = strlen(prev_path) + 1;
-	newsize += oldsize;			/* includes plus 1 for ';' */
-	Renew(prev_path, newsize, char);
-	prev_path[oldsize-1] = ';';
-	strcpy(&prev_path[oldsize], mod_name);
-    }
-    else {
-	New(1311, prev_path, newsize, char);
-	strcpy(prev_path, mod_name);
+    /* only add directory if it exists */
+    if(GetFileAttributes(mod_name) != (DWORD) -1) {
+	/* directory exists */
+	newsize = strlen(mod_name) + 1;
+	if (prev_path) {
+	    oldsize = strlen(prev_path) + 1;
+	    newsize += oldsize;			/* includes plus 1 for ';' */
+	    Renew(prev_path, newsize, char);
+	    prev_path[oldsize-1] = ';';
+	    strcpy(&prev_path[oldsize], mod_name);
+	}
+	else {
+	    New(1311, prev_path, newsize, char);
+	    strcpy(prev_path, mod_name);
+	}
     }
 
     return prev_path;