# 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
#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
#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
}
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
}
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);
}
get_no_modify
get_opargs
get_specialsv_list
+get_vtbl
gp_free
gp_ref
gv_AVadd
#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
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 */
=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
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
*/
{
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;
+}
+
#include "EXTERN.h"
#include "perl.h"
+#include "patchlevel.h"
+
#define NO_XSLOCKS
#ifdef PERL_OBJECT
extern CPerlObj* pPerl;
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;
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));
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;
projects / platform / upstream / perl.git / commitdiff