const U8 *s;
STRLEN i;
STRLEN len;
- STRLEN rarest = 0;
U32 frequency = 256;
MAGIC *mg;
+ PERL_DEB( STRLEN rarest = 0 );
PERL_ARGS_ASSERT_FBM_COMPILE;
- if (isGV_with_GP(sv))
+ if (isGV_with_GP(sv) || SvROK(sv))
return;
if (SvVALID(sv))
if (mg && mg->mg_len >= 0)
mg->mg_len++;
}
- s = (U8*)SvPV_force_mutable(sv, len);
+ if (!SvPOK(sv) || SvNIOKp(sv) || SvIsCOW(sv))
+ s = (U8*)SvPV_force_mutable(sv, len);
+ else s = (U8 *)SvPV_mutable(sv, len);
if (len == 0) /* TAIL might be on a zero-length string. */
return;
SvUPGRADE(sv, SVt_PVMG);
s = (const unsigned char*)(SvPVX_const(sv)); /* deeper magic */
for (i = 0; i < len; i++) {
if (PL_freq[s[i]] < frequency) {
- rarest = i;
+ PERL_DEB( rarest = i );
frequency = PL_freq[s[i]];
}
}
- BmRARE(sv) = s[rarest];
- BmPREVIOUS(sv) = rarest;
BmUSEFUL(sv) = 100; /* Initial value */
if (flags & FBMcf_TAIL)
SvTAIL_on(sv);
DEBUG_r(PerlIO_printf(Perl_debug_log, "rarest char %c at %"UVuf"\n",
- BmRARE(sv), BmPREVIOUS(sv)));
+ s[rarest], rarest));
}
/* If SvTAIL(littlestr), it has a fake '\n' at end. */
if (PL_stderrgv && SvREFCNT(PL_stderrgv)
&& (io = GvIO(PL_stderrgv))
&& (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
- Perl_magic_methcall(aTHX_ MUTABLE_SV(io), mg, "PRINT",
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(io), mg, SV_CONST(PRINT),
G_SCALAR | G_DISCARD | G_WRITING_TO_STDERR, 1, msv);
else {
#ifdef USE_SFIO
#endif /* HAS_VPRINTF */
-/*
- * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
- * If these functions are defined,
- * the BYTEORDER is neither 0x1234 nor 0x4321.
- * However, this is not assumed.
- * -DWS
- */
-
-#define HTOLE(name,type) \
- type \
- name (type n) \
- { \
- union { \
- type value; \
- char c[sizeof(type)]; \
- } u; \
- U32 i; \
- U32 s = 0; \
- for (i = 0; i < sizeof(u.c); i++, s += 8) { \
- u.c[i] = (n >> s) & 0xFF; \
- } \
- return u.value; \
- }
-
-#define LETOH(name,type) \
- type \
- name (type n) \
- { \
- union { \
- type value; \
- char c[sizeof(type)]; \
- } u; \
- U32 i; \
- U32 s = 0; \
- u.value = n; \
- n = 0; \
- for (i = 0; i < sizeof(u.c); i++, s += 8) { \
- n |= ((type)(u.c[i] & 0xFF)) << s; \
- } \
- return n; \
- }
-
-/*
- * Big-endian byte order functions.
- */
-
-#define HTOBE(name,type) \
- type \
- name (type n) \
- { \
- union { \
- type value; \
- char c[sizeof(type)]; \
- } u; \
- U32 i; \
- U32 s = 8*(sizeof(u.c)-1); \
- for (i = 0; i < sizeof(u.c); i++, s -= 8) { \
- u.c[i] = (n >> s) & 0xFF; \
- } \
- return u.value; \
- }
-
-#define BETOH(name,type) \
- type \
- name (type n) \
- { \
- union { \
- type value; \
- char c[sizeof(type)]; \
- } u; \
- U32 i; \
- U32 s = 8*(sizeof(u.c)-1); \
- u.value = n; \
- n = 0; \
- for (i = 0; i < sizeof(u.c); i++, s -= 8) { \
- n |= ((type)(u.c[i] & 0xFF)) << s; \
- } \
- return n; \
- }
-
-#if !defined(htovs)
-HTOLE(htovs,short)
-#endif
-#if !defined(htovl)
-HTOLE(htovl,long)
-#endif
-#if !defined(vtohs)
-LETOH(vtohs,short)
-#endif
-#if !defined(vtohl)
-LETOH(vtohl,long)
-#endif
-
-void
-Perl_my_swabn(void *ptr, int n)
-{
- char *s = (char *)ptr;
- char *e = s + (n-1);
- char tc;
-
- PERL_ARGS_ASSERT_MY_SWABN;
-
- for (n /= 2; n > 0; s++, e--, n--) {
- tc = *s;
- *s = *e;
- *e = tc;
- }
-}
-
PerlIO *
Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
{
Perl_my_pclose(pTHX_ PerlIO *ptr)
{
dVAR;
- Sigsave_t hstat, istat, qstat;
int status;
SV **svp;
Pid_t pid;
#endif
close_failed = (PerlIO_close(ptr) == EOF);
SAVE_ERRNO;
-#ifndef PERL_MICRO
- rsignal_save(SIGHUP, (Sighandler_t) SIG_IGN, &hstat);
- rsignal_save(SIGINT, (Sighandler_t) SIG_IGN, &istat);
- rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qstat);
-#endif
if (should_wait) do {
pid2 = wait4pid(pid, &status, 0);
} while (pid2 == -1 && errno == EINTR);
-#ifndef PERL_MICRO
- rsignal_restore(SIGHUP, &hstat);
- rsignal_restore(SIGINT, &istat);
- rsignal_restore(SIGQUIT, &qstat);
-#endif
if (close_failed) {
RESTORE_ERRNO;
return -1;
SV *sv = SvNVX(ver) > 10e50 ? newSV(64) : 0;
char *buf;
#ifdef USE_LOCALE_NUMERIC
- char *loc = savepv(setlocale(LC_NUMERIC, NULL));
- setlocale(LC_NUMERIC, "C");
+ char *loc = NULL;
+ if (! PL_numeric_standard) {
+ loc = savepv(setlocale(LC_NUMERIC, NULL));
+ setlocale(LC_NUMERIC, "C");
+ }
#endif
if (sv) {
Perl_sv_setpvf(aTHX_ sv, "%.9"NVff, SvNVX(ver));
buf = tbuf;
}
#ifdef USE_LOCALE_NUMERIC
- setlocale(LC_NUMERIC, loc);
- Safefree(loc);
+ if (loc) {
+ setlocale(LC_NUMERIC, loc);
+ Safefree(loc);
+ }
#endif
while (buf[len-1] == '0' && len > 0) len--;
if ( buf[len-1] == '.' ) len--; /* eat the trailing decimal */