return NULL;
}
-#define FBM_TABLE_OFFSET 2 /* Number of bytes between EOS and table*/
-
/* As a space optimization, we do not compile tables for strings of length
0 and 1, and for strings of length 2 unless FBMcf_TAIL. These are
special-cased in fbm_instr().
mg->mg_len++;
}
s = (U8*)SvPV_force_mutable(sv, len);
- SvUPGRADE(sv, SVt_PVBM);
if (len == 0) /* TAIL might be on a zero-length string. */
return;
+ SvUPGRADE(sv, SVt_PVGV);
+ SvIOK_off(sv);
if (len > 2) {
const unsigned char *sb;
const U8 mlen = (len>255) ? 255 : (U8)len;
register U8 *table;
- Sv_Grow(sv, len + 256 + FBM_TABLE_OFFSET);
- table = (unsigned char*)(SvPVX_mutable(sv) + len + FBM_TABLE_OFFSET);
- s = table - 1 - FBM_TABLE_OFFSET; /* last char */
+ Sv_Grow(sv, len + 256 + PERL_FBM_TABLE_OFFSET);
+ table
+ = (unsigned char*)(SvPVX_mutable(sv) + len + PERL_FBM_TABLE_OFFSET);
+ s = table - 1 - PERL_FBM_TABLE_OFFSET; /* last char */
memset((void*)table, mlen, 256);
- table[-1] = (U8)flags;
+ table[PERL_FBM_FLAGS_OFFSET_FROM_TABLE] = (U8)flags;
i = 0;
sb = s - mlen + 1; /* first char (maybe) */
while (s >= sb) {
table[*s] = (U8)i;
s--, i++;
}
+ } else {
+ Sv_Grow(sv, len + PERL_FBM_TABLE_OFFSET);
}
sv_magic(sv, NULL, PERL_MAGIC_bm, NULL, 0); /* deep magic */
SvVALID_on(sv);
}
}
BmRARE(sv) = s[rarest];
- BmPREVIOUS(sv) = (U16)rarest;
+ BmPREVIOUS_set(sv, rarest);
BmUSEFUL(sv) = 100; /* Initial value */
if (flags & FBMcf_TAIL)
SvTAIL_on(sv);
}
return NULL;
}
- if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
+ if (!SvVALID(littlestr)) {
char * const b = ninstr((char*)big,(char*)bigend,
(char*)little, (char*)little + littlelen);
return b;
}
- { /* Do actual FBM. */
- register const unsigned char * const table = little + littlelen + FBM_TABLE_OFFSET;
+ /* Do actual FBM. */
+ if (littlelen > (STRLEN)(bigend - big))
+ return NULL;
+
+ {
+ register const unsigned char * const table
+ = little + littlelen + PERL_FBM_TABLE_OFFSET;
register const unsigned char *oldlittle;
- if (littlelen > (STRLEN)(bigend - big))
- return NULL;
--littlelen; /* Last char found by table lookup */
s = big + littlelen;
}
}
check_end:
- if ( s == bigend && (table[-1] & FBMcf_TAIL)
+ if ( s == bigend
+ && (table[PERL_FBM_FLAGS_OFFSET_FROM_TABLE] & FBMcf_TAIL)
&& memEQ((char *)(bigend - littlelen),
(char *)(oldlittle - littlelen), littlelen) )
return (char*)bigend - littlelen;
register const unsigned char *littleend;
I32 found = 0;
+ assert(SvTYPE(littlestr) == SVt_PVGV);
+ assert(SvVALID(littlestr));
+
if (*old_posp == -1
? (pos = PL_screamfirst[BmRARE(littlestr)]) < 0
: (((pos = *old_posp), pos += PL_screamnext[pos]) == 0)) {
cant_find:
if ( BmRARE(littlestr) == '\n'
- && BmPREVIOUS(littlestr) == SvCUR(littlestr) - 1) {
+ && BmPREVIOUS(littlestr) == (U8)SvCUR(littlestr) - 1) {
little = (const unsigned char *)(SvPVX_const(littlestr));
littleend = little + SvCUR(littlestr);
first = *little++;
PerlLIO_close(pp[0]);
return PerlIO_fdopen(p[This], mode);
#else
+# ifdef OS2 /* Same, without fork()ing and all extra overhead... */
+ return my_syspopen4(aTHX_ Nullch, mode, n, args);
+# else
Perl_croak(aTHX_ "List form of piped open not implemented");
return (PerlIO *) NULL;
+# endif
#endif
}
PerlProc__exit(1);
}
#endif /* defined OS2 */
+
+#ifdef PERLIO_USING_CRLF
+ /* Since we circumvent IO layers when we manipulate low-level
+ filedescriptors directly, need to manually switch to the
+ default, binary, low-level mode; see PerlIOBuf_open(). */
+ PerlLIO_setmode((*mode == 'r'), O_BINARY);
+#endif
+
if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) {
SvREADONLY_off(GvSV(tmpgv));
sv_setiv(GvSV(tmpgv), PerlProc_getpid());
#if defined(atarist) || defined(EPOC)
FILE *popen();
PerlIO *
-Perl_my_popen(pTHX_ char *cmd, char *mode)
+Perl_my_popen((pTHX_ const char *cmd, const char *mode)
{
PERL_FLUSHALL_FOR_CHILD;
/* Call system's popen() to get a FILE *, then import it.
#if defined(DJGPP)
FILE *djgpp_popen();
PerlIO *
-Perl_my_popen(pTHX_ char *cmd, char *mode)
+Perl_my_popen((pTHX_ const char *cmd, const char *mode)
{
PERL_FLUSHALL_FOR_CHILD;
/* Call system's popen() to get a FILE *, then import it.
else {
/* Possibly buf overflowed - try again with a bigger buf */
const int fmtlen = strlen(fmt);
- const int bufsize = fmtlen + buflen;
+ int bufsize = fmtlen + buflen;
Newx(buf, bufsize, char);
while (buf) {
buf = NULL;
break;
}
- Renew(buf, bufsize*2, char);
+ bufsize *= 2;
+ Renew(buf, bufsize, char);
}
return buf;
}
}
#endif
+void
+Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
+{
+ dVAR;
+ SV * const dbsv = GvSVn(PL_DBsub);
+ /* We do not care about using sv to call CV;
+ * it's for informational purposes only.
+ */
+
+ save_item(dbsv);
+ if (!PERLDB_SUB_NN) {
+ GV * const gv = CvGV(cv);
+
+ if ( svp && ((CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
+ || strEQ(GvNAME(gv), "END")
+ || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
+ !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) )))) {
+ /* Use GV from the stack as a fallback. */
+ /* GV is potentially non-unique, or contain different CV. */
+ SV * const tmp = newRV((SV*)cv);
+ sv_setsv(dbsv, tmp);
+ SvREFCNT_dec(tmp);
+ }
+ else {
+ gv_efullname3(dbsv, gv, NULL);
+ }
+ }
+ else {
+ const int type = SvTYPE(dbsv);
+ if (type < SVt_PVIV && type != SVt_IV)
+ sv_upgrade(dbsv, SVt_PVIV);
+ (void)SvIOK_on(dbsv);
+ SvIV_set(dbsv, PTR2IV(cv)); /* Do it the quickest way */
+ }
+}
+
/*
* Local variables:
* c-indentation-style: bsd