#endif
-#ifndef MYMALLOC
-
-/* paranoid version of malloc */
+/* paranoid version of system's malloc() */
/* NOTE: Do not call the next three routines directly. Use the macros
* in handy.h, so that we can easily redefine everything to do tracking of
*/
Malloc_t
-safemalloc(MEM_SIZE size)
+safesysmalloc(MEM_SIZE size)
{
Malloc_t ptr;
#ifdef HAS_64K_LIMIT
else if (PL_nomemok)
return Nullch;
else {
- PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH;
+ PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
my_exit(1);
return Nullch;
}
/*NOTREACHED*/
}
-/* paranoid version of realloc */
+/* paranoid version of system's realloc() */
Malloc_t
-saferealloc(Malloc_t where,MEM_SIZE size)
+safesysrealloc(Malloc_t where,MEM_SIZE size)
{
Malloc_t ptr;
#if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE)
}
#endif /* HAS_64K_LIMIT */
if (!size) {
- safefree(where);
+ safesysfree(where);
return NULL;
}
if (!where)
- return safemalloc(size);
+ return safesysmalloc(size);
#ifdef DEBUGGING
if ((long)size < 0)
croak("panic: realloc");
else if (PL_nomemok)
return Nullch;
else {
- PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH;
+ PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
my_exit(1);
return Nullch;
}
/*NOTREACHED*/
}
-/* safe version of free */
+/* safe version of system's free() */
Free_t
-safefree(Malloc_t where)
+safesysfree(Malloc_t where)
{
#if !(defined(I286) || defined(atarist))
DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%x: (%05d) free\n",(char *) where,PL_an++));
}
}
-/* safe version of calloc */
+/* safe version of system's calloc() */
Malloc_t
-safecalloc(MEM_SIZE count, MEM_SIZE size)
+safesyscalloc(MEM_SIZE count, MEM_SIZE size)
{
Malloc_t ptr;
else if (PL_nomemok)
return Nullch;
else {
- PerlIO_puts(PerlIO_stderr(),no_mem) FLUSH;
+ PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH;
my_exit(1);
return Nullch;
}
/*NOTREACHED*/
}
-#endif /* !MYMALLOC */
-
#ifdef LEAKTEST
struct mem_test_strut {
for (i = 0; i < 256; i++) {
if (isUPPER_LC(i))
- fold_locale[i] = toLOWER_LC(i);
+ PL_fold_locale[i] = toLOWER_LC(i);
else if (isLOWER_LC(i))
- fold_locale[i] = toUPPER_LC(i);
+ PL_fold_locale[i] = toUPPER_LC(i);
else
- fold_locale[i] = i;
+ PL_fold_locale[i] = i;
}
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_NUMERIC
char *curnum = NULL;
#endif /* USE_LOCALE_NUMERIC */
+#ifdef __GLIBC__
+ char *language = PerlEnv_getenv("LANGUAGE");
+#endif
char *lc_all = PerlEnv_getenv("LC_ALL");
char *lang = PerlEnv_getenv("LANG");
bool setlocale_failure = FALSE;
else
setlocale_failure = TRUE;
}
- if (!setlocale_failure)
-#endif /* LC_ALL */
- {
+ if (!setlocale_failure) {
#ifdef USE_LOCALE_CTYPE
- if (! (curctype = setlocale(LC_CTYPE,
- (!done && (lang || PerlEnv_getenv("LC_CTYPE")))
+ if (! (curctype =
+ setlocale(LC_CTYPE,
+ (!done && (lang || PerlEnv_getenv("LC_CTYPE")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
- if (! (curcoll = setlocale(LC_COLLATE,
- (!done && (lang || PerlEnv_getenv("LC_COLLATE")))
+ if (! (curcoll =
+ setlocale(LC_COLLATE,
+ (!done && (lang || PerlEnv_getenv("LC_COLLATE")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
- if (! (curnum = setlocale(LC_NUMERIC,
- (!done && (lang || PerlEnv_getenv("LC_NUMERIC")))
+ if (! (curnum =
+ setlocale(LC_NUMERIC,
+ (!done && (lang || PerlEnv_getenv("LC_NUMERIC")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_NUMERIC */
}
-#else /* !LOCALE_ENVIRON_REQUIRED */
+#endif /* LC_ALL */
-#ifdef LC_ALL
+#endif /* !LOCALE_ENVIRON_REQUIRED */
+#ifdef LC_ALL
if (! setlocale(LC_ALL, ""))
setlocale_failure = TRUE;
- else {
-#ifdef USE_LOCALE_CTYPE
- curctype = setlocale(LC_CTYPE, Nullch);
-#endif /* USE_LOCALE_CTYPE */
-#ifdef USE_LOCALE_COLLATE
- curcoll = setlocale(LC_COLLATE, Nullch);
-#endif /* USE_LOCALE_COLLATE */
-#ifdef USE_LOCALE_NUMERIC
- curnum = setlocale(LC_NUMERIC, Nullch);
-#endif /* USE_LOCALE_NUMERIC */
- }
-
-#else /* !LC_ALL */
+#endif /* LC_ALL */
+ if (!setlocale_failure) {
#ifdef USE_LOCALE_CTYPE
- if (! (curctype = setlocale(LC_CTYPE, "")))
- setlocale_failure = TRUE;
+ if (! (curctype = setlocale(LC_CTYPE, "")))
+ setlocale_failure = TRUE;
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
- if (! (curcoll = setlocale(LC_COLLATE, "")))
- setlocale_failure = TRUE;
+ if (! (curcoll = setlocale(LC_COLLATE, "")))
+ setlocale_failure = TRUE;
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
- if (! (curnum = setlocale(LC_NUMERIC, "")))
- setlocale_failure = TRUE;
+ if (! (curnum = setlocale(LC_NUMERIC, "")))
+ setlocale_failure = TRUE;
#endif /* USE_LOCALE_NUMERIC */
-
-#endif /* LC_ALL */
-
-#endif /* !LOCALE_ENVIRON_REQUIRED */
+ }
if (setlocale_failure) {
char *p;
PerlIO_printf(PerlIO_stderr(),
"perl: warning: Please check that your locale settings:\n");
+#ifdef __GLIBC__
+ PerlIO_printf(PerlIO_stderr(),
+ "\tLANGUAGE = %c%s%c,\n",
+ language ? '"' : '(',
+ language ? language : "unset",
+ language ? '"' : ')');
+#endif
+
PerlIO_printf(PerlIO_stderr(),
"\tLC_ALL = %c%s%c,\n",
lc_all ? '"' : '(',
void
fbm_compile(SV *sv, U32 flags /* not used yet */)
{
- register unsigned char *s;
- register unsigned char *table;
+ register U8 *s;
+ register U8 *table;
register U32 i;
- register U32 len = SvCUR(sv);
+ STRLEN len;
I32 rarest = 0;
U32 frequency = 256;
- sv_upgrade(sv, SVt_PVBM);
+ s = (U8*)SvPV_force(sv, len);
+ (void)SvUPGRADE(sv, SVt_PVBM);
if (len > 255 || len == 0) /* TAIL might be on on a zero-length string. */
return; /* can't have offsets that big */
if (len > 2) {
s = (unsigned char*)(SvPVX(sv)); /* deeper magic */
for (i = 0; i < len; i++) {
- if (freq[s[i]] < frequency) {
+ if (PL_freq[s[i]] < frequency) {
rarest = i;
- frequency = freq[s[i]];
+ frequency = PL_freq[s[i]];
}
}
BmRARE(sv) = s[rarest];
register U8 *a = (U8 *)s1;
register U8 *b = (U8 *)s2;
while (len--) {
- if (*a != *b && *a != fold[*b])
+ if (*a != *b && *a != PL_fold[*b])
return 1;
a++,b++;
}
register U8 *a = (U8 *)s1;
register U8 *b = (U8 *)s2;
while (len--) {
- if (*a != *b && *a != fold_locale[*b])
+ if (*a != *b && *a != PL_fold_locale[*b])
return 1;
a++,b++;
}
STATIC SV *
mess_alloc(void)
{
+ dTHR;
SV *sv;
XPVMG *any;
+ if (!PL_dirty)
+ return sv_2mortal(newSVpvn("",0));
+
+ if (PL_mess_sv)
+ return PL_mess_sv;
+
/* Create as PVMG now, to avoid any upgrading later */
New(905, sv, 1, SV);
Newz(905, any, 1, XPVMG);
SvFLAGS(sv) = SVt_PVMG;
SvANY(sv) = (void*)any;
SvREFCNT(sv) = 1 << 30; /* practically infinite */
+ PL_mess_sv = sv;
return sv;
}
char *
form(const char* pat, ...)
{
+ SV *sv = mess_alloc();
va_list args;
va_start(args, pat);
- if (!PL_mess_sv)
- PL_mess_sv = mess_alloc();
- sv_vsetpvfn(PL_mess_sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
va_end(args);
- return SvPVX(PL_mess_sv);
+ return SvPVX(sv);
}
char *
mess(const char *pat, va_list *args)
{
- SV *sv;
+ SV *sv = mess_alloc();
static char dgd[] = " during global destruction.\n";
- if (!PL_mess_sv)
- PL_mess_sv = mess_alloc();
- sv = PL_mess_sv;
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
dTHR;
void
my_setenv(char *nam, char *val)
{
+#ifndef PERL_USE_SAFE_PUTENV
+ /* most putenv()s leak, so we manipulate environ directly */
register I32 i=setenv_getix(nam); /* where does it go? */
if (environ == PL_origenviron) { /* need we copy environment? */
/*SUPPRESS 530*/
for (max = i; environ[max]; max++) ;
- New(901,tmpenv, max+2, char*);
- for (j=0; j<max; j++) /* copy environment */
- tmpenv[j] = savepv(environ[j]);
+ tmpenv = (char**)safesysmalloc((max+2) * sizeof(char*));
+ for (j=0; j<max; j++) { /* copy environment */
+ tmpenv[j] = (char*)safesysmalloc((strlen(environ[j])+1)*sizeof(char));
+ strcpy(tmpenv[j], environ[j]);
+ }
tmpenv[max] = Nullch;
environ = tmpenv; /* tell exec where it is now */
}
if (!val) {
- Safefree(environ[i]);
+ safesysfree(environ[i]);
while (environ[i]) {
environ[i] = environ[i+1];
i++;
return;
}
if (!environ[i]) { /* does not exist yet */
- Renew(environ, i+2, char*); /* just expand it a bit */
+ environ = (char**)safesysrealloc(environ, (i+2) * sizeof(char*));
environ[i+1] = Nullch; /* make sure it's null terminated */
}
else
- Safefree(environ[i]);
- New(904, environ[i], strlen(nam) + strlen(val) + 2, char);
+ safesysfree(environ[i]);
+ environ[i] = (char*)safesysmalloc((strlen(nam)+strlen(val)+2) * sizeof(char));
+
#ifndef MSDOS
(void)sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
#else
strcpy(environ[i],nam); strupr(environ[i]);
(void)sprintf(environ[i] + strlen(nam),"=%s",val);
#endif /* MSDOS */
+
+#else /* PERL_USE_SAFE_PUTENV */
+ char *new_env;
+
+ new_env = (char*)safesysmalloc((strlen(nam) + strlen(val) + 2) * sizeof(char));
+#ifndef MSDOS
+ (void)sprintf(new_env,"%s=%s",nam,val);/* all that work just for this */
+#else
+ strcpy(new_env,nam); strupr(new_env);
+ (void)sprintf(new_env + strlen(nam),"=%s",val);
+#endif
+ (void)putenv(new_env);
+#endif /* PERL_USE_SAFE_PUTENV */
}
#else /* if WIN32 */
}
else
vallen = strlen(val);
- New(904, envstr, namlen + vallen + 3, char);
+ envstr = (char*)safesysmalloc((namlen + vallen + 3) * sizeof(char));
(void)sprintf(envstr,"%s=%s",nam,val);
(void)PerlEnv_putenv(envstr);
if (oldstr)
- Safefree(oldstr);
+ safesysfree(oldstr);
#ifdef _MSC_VER
- Safefree(envstr); /* MSVCRT leaks without this */
+ safesysfree(envstr); /* MSVCRT leaks without this */
#endif
#else /* !USE_WIN32_RTL_ENV */
#endif
/* VMS' my_popen() is in VMS.c, same with OS/2. */
-#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS)
+#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM)
PerlIO *
my_popen(char *cmd, char *mode)
{
#endif /* !HAS_SIGACTION */
/* VMS' my_pclose() is in VMS.c; same with OS/2 */
-#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS)
+#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM)
I32
my_pclose(PerlIO *ptr)
{
register char *frombase = from;
if (len == 1) {
- todo = *from;
+ register char c = *from;
while (count-- > 0)
- *to++ = todo;
+ *to++ = c;
return;
}
while (count-- > 0) {
}
}
-#ifndef CASTNEGFLOAT
U32
-cast_ulong(f)
-double f;
+cast_ulong(double f)
{
long along;
return (unsigned long)along;
}
# undef BIGDOUBLE
-#endif
-
-#ifndef CASTI32
/* Unfortunately, on some systems the cast_uv() function doesn't
work with the system-supplied definition of ULONG_MAX. The
#endif
I32
-cast_i32(f)
-double f;
+cast_i32(double f)
{
if (f >= I32_MAX)
return (I32) I32_MAX;
}
IV
-cast_iv(f)
-double f;
+cast_iv(double f)
{
if (f >= IV_MAX)
return (IV) IV_MAX;
}
UV
-cast_uv(f)
-double f;
+cast_uv(double f)
{
if (f >= MY_UV_MAX)
return (UV) MY_UV_MAX;
return (UV) f;
}
-#endif
-
#ifndef HAS_RENAME
I32
-same_dirent(a,b)
-char *a;
-char *b;
+same_dirent(char *a, char *b)
{
char *fa = strrchr(a,'/');
char *fb = strrchr(b,'/');
#endif /* !HAS_RENAME */
UV
+scan_bin(char *start, I32 len, I32 *retlen)
+{
+ register char *s = start;
+ register UV retval = 0;
+ bool overflowed = FALSE;
+ while (len && *s >= '0' && *s <= '1') {
+ register UV n = retval << 1;
+ if (!overflowed && (n >> 1) != retval) {
+ warn("Integer overflow in binary number");
+ overflowed = TRUE;
+ }
+ retval = n | (*s++ - '0');
+ len--;
+ }
+ if (len && (*s >= '2' || *s <= '9')) {
+ dTHR;
+ if (ckWARN(WARN_UNSAFE))
+ warner(WARN_UNSAFE, "Illegal binary digit ignored");
+ }
+ *retlen = s - start;
+ return retval;
+}
+UV
scan_oct(char *start, I32 len, I32 *retlen)
{
register char *s = start;
while (len-- && *s) {
tmp = strchr((char *) PL_hexdigit, *s++);
if (!tmp) {
- if (*s == '_')
+ if (*(s-1) == '_' || (*(s-1) == 'x' && retval == 0))
continue;
else {
dTHR;
dTHR;
char *xfound = Nullch;
char *xfailed = Nullch;
- char tmpbuf[512];
+ char tmpbuf[MAXPATHLEN];
register char *s;
I32 len;
int retval;
#endif
DEBUG_p(PerlIO_printf(Perl_debug_log,
"Looking for %s\n",cur));
- if (PerlLIO_stat(cur,&PL_statbuf) >= 0) {
+ if (PerlLIO_stat(cur,&PL_statbuf) >= 0
+ && !S_ISDIR(PL_statbuf.st_mode)) {
dosearch = 0;
scriptname = cur;
#ifdef SEARCH_EXTS
if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tmpbuf)
continue; /* don't search dir with too-long name */
if (len
-#if defined(atarist) || defined(DOSISH)
+#if defined(atarist) || defined(__MINT__) || defined(DOSISH)
&& tmpbuf[len - 1] != '/'
&& tmpbuf[len - 1] != '\\'
#endif
#endif
DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tmpbuf));
retval = PerlLIO_stat(tmpbuf,&PL_statbuf);
+ if (S_ISDIR(PL_statbuf.st_mode)) {
+ retval = -1;
+ }
#ifdef SEARCH_EXTS
} while ( retval < 0 /* not there */
&& extidx>=0 && ext[extidx] /* try an extension? */
xfailed = savepv(tmpbuf);
}
#ifndef DOSISH
- if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&PL_statbuf) < 0))
+ if (!xfound && !seen_dot && !xfailed &&
+ (PerlLIO_stat(scriptname,&PL_statbuf) < 0
+ || S_ISDIR(PL_statbuf.st_mode)))
#endif
seen_dot = 1; /* Disable message. */
if (!xfound) {
}
void
-perl_cond_init(cp)
-perl_cond *cp;
+perl_cond_init(perl_cond *cp)
{
*cp = 0;
}
void
-perl_cond_signal(cp)
-perl_cond *cp;
+perl_cond_signal(perl_cond *cp)
{
perl_os_thread t;
perl_cond cond = *cp;
}
void
-perl_cond_broadcast(cp)
-perl_cond *cp;
+perl_cond_broadcast(perl_cond *cp)
{
perl_os_thread t;
perl_cond cond, cond_next;
}
void
-perl_cond_wait(cp)
-perl_cond *cp;
+perl_cond_wait(perl_cond *cp)
{
perl_cond cond;
}
#endif /* FAKE_THREADS */
-#ifdef OLD_PTHREADS_API
+#ifdef PTHREAD_GETSPECIFIC_INT
struct perl_thread *
getTHR _((void))
{
croak("panic: pthread_getspecific");
return (struct perl_thread *) t;
}
-#endif /* OLD_PTHREADS_API */
+#endif
MAGIC *
condpair_magic(SV *sv)
SvGROW(sv, sizeof(struct perl_thread) + 1);
SvCUR_set(sv, sizeof(struct perl_thread));
thr = (Thread) SvPVX(sv);
- /* debug */
+#ifdef DEBUGGING
memset(thr, 0xab, sizeof(struct perl_thread));
PL_markstack = 0;
PL_scopestack = 0;
PL_retstack = 0;
PL_dirty = 0;
PL_localizing = 0;
- /* end debug */
+ Zero(&PL_hv_fetch_ent_mh, 1, HE);
+#else
+ Zero(thr, 1, struct perl_thread);
+#endif
thr->oursv = sv;
init_stacks(ARGS);
thr->flags = THRf_R_JOINABLE;
MUTEX_INIT(&thr->mutex);
- 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? */
-
-
/* 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
PL_in_eval = FALSE;
PL_restartop = 0;
+ PL_statname = NEWSV(66,0);
+ PL_maxscream = -1;
+ PL_regcompp = FUNC_NAME_TO_PTR(pregcomp);
+ PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags);
+ PL_regindent = 0;
+ PL_reginterp_cnt = 0;
+ PL_lastscream = Nullsv;
+ PL_screamfirst = 0;
+ PL_screamnext = 0;
+ PL_reg_start_tmp = 0;
+ PL_reg_start_tmpl = 0;
+
+ /* parent thread's data needs to be locked while we make copy */
+ MUTEX_LOCK(&t->mutex);
+
+ 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? */
+
PL_tainted = t->Ttainted;
PL_curpm = t->Tcurpm; /* XXX No PMOP ref count */
PL_nrs = newSVsv(t->Tnrs);
PL_bodytarget = newSVsv(t->Tbodytarget);
PL_toptarget = newSVsv(t->Ttoptarget);
- PL_statname = NEWSV(66,0);
- PL_maxscream = -1;
- PL_regcompp = FUNC_NAME_TO_PTR(pregcomp);
- PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags);
- PL_regindent = 0;
- PL_reginterp_cnt = 0;
- PL_lastscream = Nullsv;
- PL_screamfirst = 0;
- PL_screamnext = 0;
- PL_reg_start_tmp = 0;
- PL_reg_start_tmpl = 0;
-
/* Initialise all per-thread SVs that the template thread used */
svp = AvARRAY(t->threadsv);
for (i = 0; i <= AvFILLp(t->threadsv); i++, svp++) {
thr->next->prev = thr;
MUTEX_UNLOCK(&PL_threads_mutex);
+ /* done copying parent's state */
+ MUTEX_UNLOCK(&t->mutex);
+
#ifdef HAVE_THREAD_INTERN
init_thread_intern(thr);
#endif /* HAVE_THREAD_INTERN */
char **
get_op_names(void)
{
- return op_name;
+ return PL_op_name;
}
char **
get_op_descs(void)
{
- return op_desc;
+ return PL_op_desc;
}
char *
get_no_modify(void)
{
- return (char*)no_modify;
+ return (char*)PL_no_modify;
}
U32 *
get_opargs(void)
{
- return opargs;
+ return PL_opargs;
}
-
SV **
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;
+#ifdef USE_LOCALE_COLLATE
+ case want_vtbl_collxfrm:
+ result = &PL_vtbl_collxfrm;
+ break;
+#endif
+ case want_vtbl_amagic:
+ result = &PL_vtbl_amagic;
+ break;
+ case want_vtbl_amagicelem:
+ result = &PL_vtbl_amagicelem;
+ break;
+ }
+ return result;
+}
+
https://perl5.git.perl.org / perl5.git / blobdiff