From: Gurusamy Sarathy Date: Sun, 8 Nov 1998 21:13:07 +0000 (+0000) Subject: integrate changes#2120,2168,2218 from maint-5.005; X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dc9e4912b3381e3548a35c5aba633cc37261d318;p=p5sagit%2Fp5-mst-13.2.git 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 --- diff --git a/XSUB.h b/XSUB.h index dc805d8..9111da2 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 d3b770f..c240a98 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 93d2ae1..a739ca2 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 5974a32..95c2b0a 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 315e710..89bdfd9 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 ba898c4..a584148 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 766b060..8e7cf6d 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -673,7 +673,7 @@ L. =item continue BLOCK Actually a flow control statement rather than a function. If there is a -C BLOCK attached to a BLOCK (typically in a L<(while> or +C BLOCK attached to a BLOCK (typically in a L or L), it is always executed just before the conditional is about to be evaluated again, just like the third part of a L 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 fab5250..4c20aba 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 6dead7a..4698e90 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 1ce7ad9..be5f5e1 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;