perl
view release on metacpan or search on metacpan
RX_SUBBEG(rx) = INT2PTR(char*,*p++);
RX_SUBLEN(rx) = (SSize_t)(*p++);
RX_SUBOFFSET(rx) = (Size_t)*p++;
RX_SUBCOFFSET(rx) = (SSize_t)*p++;
for (i = 0; i <= RX_NPARENS(rx); ++i) {
RX_OFFSp(rx)[i].start = (SSize_t)(*p++);
RX_OFFSp(rx)[i].end = (SSize_t)(*p++);
}
}
static void
S_rxres_free(pTHX_ void **rsp)
{
UV * const p = (UV*)*rsp;
PERL_ARGS_ASSERT_RXRES_FREE;
PERL_UNUSED_CONTEXT;
if (p) {
void *tmp = INT2PTR(char*,*p);
#ifdef PERL_POISON
#ifdef PERL_ANY_COW
U32 i = 9 + p[1] * 2;
#else
U32 i = 8 + p[1] * 2;
#endif
#endif
#ifdef PERL_ANY_COW
SvREFCNT_dec (INT2PTR(SV*,p[2]));
#endif
#ifdef PERL_POISON
PoisonFree(p, i, sizeof(UV));
#endif
Safefree(tmp);
Safefree(p);
*rsp = NULL;
}
}
#define FORM_NUM_BLANK (1<<30)
#define FORM_NUM_POINT (1<<29)
PP_wrapped(pp_formline, 0, 1)
{
dSP; dMARK; dORIGMARK;
SV * const tmpForm = *++MARK;
SV *formsv; /* contains text of original format */
U32 *fpc; /* format ops program counter */
char *t; /* current append position in target string */
const char *f; /* current position in format string */
I32 arg;
SV *sv = NULL; /* current item */
const char *item = NULL;/* string value of current item */
I32 itemsize = 0; /* length (chars) of item, possibly truncated */
I32 itembytes = 0; /* as itemsize, but length in bytes */
I32 fieldsize = 0; /* width of current field */
I32 lines = 0; /* number of lines that have been output */
bool chopspace = (strchr(PL_chopset, ' ') != NULL); /* does $: have space */
const char *chophere = NULL; /* where to chop current item */
STRLEN linemark = 0; /* pos of start of line in output */
NV value;
bool gotsome = FALSE; /* seen at least one non-blank item on this line */
STRLEN len; /* length of current sv */
STRLEN linemax; /* estimate of output size in bytes */
bool item_is_utf8 = FALSE;
bool targ_is_utf8 = FALSE;
const char *fmt;
MAGIC *mg = NULL;
U8 *source; /* source of bytes to append */
STRLEN to_copy; /* how may bytes to append */
char trans; /* what chars to translate */
bool copied_form = FALSE; /* have we duplicated the form? */
mg = doparseform(tmpForm);
fpc = (U32*)mg->mg_ptr;
/* the actual string the format was compiled from.
* with overload etc, this may not match tmpForm */
formsv = mg->mg_obj;
SvPV_force(PL_formtarget, len);
if (SvTAINTED(tmpForm) || SvTAINTED(formsv))
SvTAINTED_on(PL_formtarget);
if (DO_UTF8(PL_formtarget))
targ_is_utf8 = TRUE;
/* this is an initial estimate of how much output buffer space
* to allocate. It may be exceeded later */
linemax = (SvCUR(formsv) * (IN_BYTES ? 1 : 3) + 1);
t = SvGROW(PL_formtarget, len + linemax + 1);
/* XXX from now onwards, SvCUR(PL_formtarget) is invalid */
t += len;
f = SvPV_const(formsv, len);
for (;;) {
DEBUG_f( {
const char *name = "???";
arg = -1;
switch (*fpc) {
case FF_LITERAL: arg = fpc[1]; name = "LITERAL"; break;
case FF_BLANK: arg = fpc[1]; name = "BLANK"; break;
case FF_SKIP: arg = fpc[1]; name = "SKIP"; break;
case FF_FETCH: arg = fpc[1]; name = "FETCH"; break;
case FF_DECIMAL: arg = fpc[1]; name = "DECIMAL"; break;
case FF_CHECKNL: name = "CHECKNL"; break;
case FF_CHECKCHOP: name = "CHECKCHOP"; break;
case FF_SPACE: name = "SPACE"; break;
case FF_HALFSPACE: name = "HALFSPACE"; break;
case FF_ITEM: name = "ITEM"; break;
case FF_CHOP: name = "CHOP"; break;
case FF_LINEGLOB: name = "LINEGLOB"; break;
case FF_NEWLINE: name = "NEWLINE"; break;
case FF_MORE: name = "MORE"; break;
case FF_LINEMARK: name = "LINEMARK"; break;
case FF_END: name = "END"; break;
case FF_0DECIMAL: name = "0DECIMAL"; break;
case FF_LINESNGL: name = "LINESNGL"; break;
case FF_CHECKNL: /* find max len of item (up to \n) that fits field */
{
const char *s = item = SvPV_const(sv, len);
const char *send = s + len;
itemsize = 0;
item_is_utf8 = DO_UTF8(sv);
while (s < send) {
if (!isCNTRL(*s))
gotsome = TRUE;
else if (*s == '\n')
break;
if (item_is_utf8)
s += UTF8SKIP(s);
else
s++;
itemsize++;
if (itemsize == fieldsize)
break;
}
itembytes = s - item;
chophere = s;
break;
}
case FF_CHECKCHOP: /* like CHECKNL, but up to highest split point */
{
const char *s = item = SvPV_const(sv, len);
const char *send = s + len;
I32 size = 0;
chophere = NULL;
item_is_utf8 = DO_UTF8(sv);
while (s < send) {
/* look for a legal split position */
if (isSPACE(*s)) {
if (*s == '\r') {
chophere = s;
itemsize = size;
break;
}
if (chopspace) {
/* provisional split point */
chophere = s;
itemsize = size;
}
/* we delay testing fieldsize until after we've
* processed the possible split char directly
* following the last field char; so if fieldsize=3
* and item="a b cdef", we consume "a b", not "a".
* Ditto further down.
*/
if (size == fieldsize)
break;
}
else {
if (size == fieldsize)
break;
if (strchr(PL_chopset, *s)) {
/* provisional split point */
/* for a non-space split char, we include
* the split char; hence the '+1' */
chophere = s + 1;
itemsize = size + 1;
}
if (!isCNTRL(*s))
gotsome = TRUE;
}
if (item_is_utf8)
s += UTF8SKIP(s);
else
s++;
size++;
}
if (!chophere || s == send) {
chophere = s;
itemsize = size;
}
itembytes = chophere - item;
break;
}
case FF_SPACE: /* append padding space (diff of field, item size) */
arg = fieldsize - itemsize;
if (arg) {
fieldsize -= arg;
while (arg-- > 0)
*t++ = ' ';
}
break;
case FF_HALFSPACE: /* like FF_SPACE, but only append half as many */
arg = fieldsize - itemsize;
if (arg) {
arg /= 2;
fieldsize -= arg;
while (arg-- > 0)
*t++ = ' ';
}
break;
case FF_ITEM: /* append a text item, while blanking ctrl chars */
to_copy = itembytes;
source = (U8 *)item;
trans = 1;
goto append;
case FF_CHOP: /* (for ^*) chop the current item */
if (sv != &PL_sv_no) {
const char *s = chophere;
if (!copied_form &&
((sv == tmpForm || SvSMAGICAL(sv))
|| (SvGMAGICAL(tmpForm) && !sv_only_taint_gmagic(tmpForm))) ) {
/* sv and tmpForm are either the same SV, or magic might allow modification
of tmpForm when sv is modified, so copy */
SV *newformsv = sv_mortalcopy(formsv);
U32 *new_compiled;
( run in 0.853 second using v1.01-cache-2.11-cpan-71847e10f99 )