lc = localeconv();
if (lc && lc->decimal_point) {
if (lc->decimal_point[0] == '.' && lc->decimal_point[1] == 0) {
- SvREFCNT_dec(PL_numeric_radix);
- PL_numeric_radix = 0;
+ SvREFCNT_dec(PL_numeric_radix_sv);
+ PL_numeric_radix_sv = Nullsv;
}
else {
- if (PL_numeric_radix)
- sv_setpv(PL_numeric_radix, lc->decimal_point);
+ if (PL_numeric_radix_sv)
+ sv_setpv(PL_numeric_radix_sv, lc->decimal_point);
else
- PL_numeric_radix = newSVpv(lc->decimal_point, 0);
+ PL_numeric_radix_sv = newSVpv(lc->decimal_point, 0);
}
}
else
- PL_numeric_radix = 0;
+ PL_numeric_radix_sv = Nullsv;
# endif /* HAS_LOCALECONV */
#endif /* USE_LOCALE_NUMERIC */
}
s--, i++;
}
}
- sv_magic(sv, Nullsv, 'B', Nullch, 0); /* deep magic */
+ sv_magic(sv, Nullsv, PERL_MAGIC_bm, Nullch, 0); /* deep magic */
SvVALID_on(sv);
s = (unsigned char*)(SvPVX(sv)); /* deeper magic */
U32
Perl_cast_ulong(pTHX_ NV f)
{
- long along;
-
+ if (f < 0.0)
+ return f < I32_MIN ? (U32) I32_MIN : (U32)(I32) f;
+ if (f < U32_MAX_P1) {
#if CASTFLAGS & 2
-# define BIGDOUBLE 2147483648.0
- if (f >= BIGDOUBLE)
- return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000;
+ if (f < U32_MAX_P1_HALF)
+ return (U32) f;
+ f -= U32_MAX_P1_HALF;
+ return ((U32) f) | (1 + U32_MAX >> 1);
+#else
+ return (U32) f;
#endif
- if (f >= 0.0)
- return (unsigned long)f;
- along = (long)f;
- return (unsigned long)along;
+ }
+ return f > 0 ? U32_MAX : 0 /* NaN */;
}
-# undef BIGDOUBLE
-
-/* Unfortunately, on some systems the cast_uv() function doesn't
- work with the system-supplied definition of ULONG_MAX. The
- comparison (f >= ULONG_MAX) always comes out true. It must be a
- problem with the compiler constant folding.
-
- In any case, this workaround should be fine on any two's complement
- system. If it's not, supply a '-DMY_ULONG_MAX=whatever' in your
- ccflags.
- --Andy Dougherty <doughera@lafcol.lafayette.edu>
-*/
-
-/* Code modified to prefer proper named type ranges, I32, IV, or UV, instead
- of LONG_(MIN/MAX).
- -- Kenneth Albanowski <kjahds@kjahds.com>
-*/
-
-#ifndef MY_UV_MAX
-# define MY_UV_MAX ((UV)IV_MAX * (UV)2 + (UV)1)
-#endif
I32
Perl_cast_i32(pTHX_ NV f)
{
- if (f >= I32_MAX)
- return (I32) I32_MAX;
- if (f <= I32_MIN)
- return (I32) I32_MIN;
- return (I32) f;
+ if (f < I32_MAX_P1)
+ return f < I32_MIN ? I32_MIN : (I32) f;
+ if (f < U32_MAX_P1) {
+#if CASTFLAGS & 2
+ if (f < U32_MAX_P1_HALF)
+ return (I32)(U32) f;
+ f -= U32_MAX_P1_HALF;
+ return (I32)(((U32) f) | (1 + U32_MAX >> 1));
+#else
+ return (I32)(U32) f;
+#endif
+ }
+ return f > 0 ? (I32)U32_MAX : 0 /* NaN */;
}
IV
Perl_cast_iv(pTHX_ NV f)
{
- if (f >= IV_MAX) {
- UV uv;
-
- if (f >= (NV)UV_MAX)
- return (IV) UV_MAX;
- uv = (UV) f;
- return (IV)uv;
- }
- if (f <= IV_MIN)
- return (IV) IV_MIN;
- return (IV) f;
+ if (f < IV_MAX_P1)
+ return f < IV_MIN ? IV_MIN : (IV) f;
+ if (f < UV_MAX_P1) {
+#if CASTFLAGS & 2
+ /* For future flexibility allowing for sizeof(UV) >= sizeof(IV) */
+ if (f < UV_MAX_P1_HALF)
+ return (IV)(UV) f;
+ f -= UV_MAX_P1_HALF;
+ return (IV)(((UV) f) | (1 + UV_MAX >> 1));
+#else
+ return (IV)(UV) f;
+#endif
+ }
+ return f > 0 ? (IV)UV_MAX : 0 /* NaN */;
}
UV
Perl_cast_uv(pTHX_ NV f)
{
- if (f >= MY_UV_MAX)
- return (UV) MY_UV_MAX;
- if (f < 0) {
- IV iv;
-
- if (f < IV_MIN)
- return (UV)IV_MIN;
- iv = (IV) f;
- return (UV) iv;
- }
+ if (f < 0.0)
+ return f < IV_MIN ? (UV) IV_MIN : (UV)(IV) f;
+ if (f < UV_MAX_P1) {
+#if CASTFLAGS & 2
+ if (f < UV_MAX_P1_HALF)
+ return (UV) f;
+ f -= UV_MAX_P1_HALF;
+ return ((UV) f) | (1 + UV_MAX >> 1);
+#else
return (UV) f;
+#endif
+ }
+ return f > 0 ? UV_MAX : 0 /* NaN */;
}
#ifndef HAS_RENAME
Perl_croak_nocontext("panic: pthread_getspecific");
return (void*)t;
# else
-# ifdef I_MACH_CTHREADS
+# ifdef I_MACH_CTHREADS
return (void*)cthread_data(cthread_self());
-# else
- return (void*)pthread_getspecific(PL_thr_key);
-# endif
+# else
+ return (void*)PTHREAD_GETSPECIFIC(PL_thr_key);
+# endif
# endif
#else
return (void*)NULL;
MAGIC *mg;
SvUPGRADE(sv, SVt_PVMG);
- mg = mg_find(sv, 'm');
+ mg = mg_find(sv, PERL_MAGIC_mutex);
if (!mg) {
condpair_t *cp;
COND_INIT(&cp->cond);
cp->owner = 0;
LOCK_CRED_MUTEX; /* XXX need separate mutex? */
- mg = mg_find(sv, 'm');
+ mg = mg_find(sv, PERL_MAGIC_mutex);
if (mg) {
/* someone else beat us to initialising it */
UNLOCK_CRED_MUTEX; /* XXX need separate mutex? */
Safefree(cp);
}
else {
- sv_magic(sv, Nullsv, 'm', 0, 0);
+ sv_magic(sv, Nullsv, PERL_MAGIC_mutex, 0, 0);
mg = SvMAGIC(sv);
mg->mg_ptr = (char *)cp;
mg->mg_len = sizeof(cp);
if (*svp && *svp != &PL_sv_undef) {
SV *sv = newSVsv(*svp);
av_store(thr->threadsv, i, sv);
- sv_magic(sv, 0, 0, &PL_threadsv_names[i], 1);
+ sv_magic(sv, 0, PERL_MAGIC_sv, &PL_threadsv_names[i], 1);
DEBUG_S(PerlIO_printf(Perl_debug_log,
"new_struct_thread: copied threadsv %"IVdf" %p->%p\n",
(IV)i, t, thr));
op == OP_LEAVEWRITE ? "write" : /* "write exit" not nice */
PL_op_desc[op];
char *pars = OP_IS_FILETEST(op) ? "" : "()";
- char *type = OP_IS_SOCKET(op) || (io && IoTYPE(io) == IoTYPE_SOCKET) ?
+ char *type = OP_IS_SOCKET(op) ||
+ (gv && io && IoTYPE(io) == IoTYPE_SOCKET) ?
"socket" : "filehandle";
char *name = NULL;
- if (io && IoTYPE(io) == IoTYPE_CLOSED) {
+ if (gv && io && IoTYPE(io) == IoTYPE_CLOSED) {
vile = "closed";
warn_type = WARN_CLOSED;
}
else {
Perl_warner(aTHX_ warn_type,
"%s%s on %s %s", func, pars, vile, type);
- if (io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP))
+ if (gv && io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP))
Perl_warner(aTHX_ warn_type,
"\t(Are you trying to call %s%s on dirhandle?)\n",
func, pars);
}
#endif
-#ifdef HAS_TZNAME
-# if !defined(WIN32) && !defined(__CYGWIN__)
-extern char *tzname[];
-# endif
-#else
-#if !defined(WIN32) || (defined(__MINGW32__) && !defined(tzname))
-char *tzname[] = { "" , "" };
-#endif
-#endif
-
/* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX)
* fields for which we don't have Configure support yet:
* char *tm_zone; -- abbreviation of timezone name
projects / p5sagit/p5-mst-13.2.git / blobdiff