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;
}
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;
}
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;
}
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 */
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;
STRLEN len;
I32 rarest = 0;
U32 frequency = 256;
- s = SvPV_force(sv, len);
- 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++;
}
#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)
{
}
}
-#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,'/');
while (len-- && *s) {
tmp = strchr((char *) PL_hexdigit, *s++);
if (!tmp) {
- if (*s == '_')
+ if (*(s-1) == '_' || (*(s-1) == 'x' && retval == 0))
continue;
else {
dTHR;
#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
#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);
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;
+ 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;
+}
+
projects / p5sagit/p5-mst-13.2.git / blobdiff