}
}
{
- SV *tsv;
+ STRLEN len;
+ char *retval;
+ char *buffer;
MAGIC *mg;
const SV *const referent = (SV*)SvRV(sv);
if (!referent) {
- tsv = sv_2mortal(newSVpvs("NULLREF"));
+ len = 7;
+ retval = buffer = savepvn("NULLREF", len);
} else if (SvTYPE(referent) == SVt_PVMG
&& ((SvFLAGS(referent) &
(SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
return stringify_regexp(sv, mg, lp);
} else {
const char *const typestr = sv_reftype(referent, 0);
+ const STRLEN typelen = strlen(typestr);
+ UV addr = PTR2UV(referent);
+ const char *stashname = NULL;
+ STRLEN stashnamelen = 0; /* hush, gcc */
+ const char *buffer_end;
- tsv = sv_newmortal();
if (SvOBJECT(referent)) {
- const char *const name = HvNAME_get(SvSTASH(referent));
- Perl_sv_setpvf(aTHX_ tsv, "%s=%s(0x%"UVxf")",
- name ? name : "__ANON__" , typestr,
- PTR2UV(referent));
+ const HEK *const name = HvNAME_HEK(SvSTASH(referent));
+
+ if (name) {
+ stashname = HEK_KEY(name);
+ stashnamelen = HEK_LEN(name);
+
+ if (HEK_UTF8(name)) {
+ SvUTF8_on(sv);
+ } else {
+ SvUTF8_off(sv);
+ }
+ } else {
+ stashname = "__ANON__";
+ stashnamelen = 8;
+ }
+ len = stashnamelen + 1 /* = */ + typelen + 3 /* (0x */
+ + 2 * sizeof(UV) + 2 /* )\0 */;
+ } else {
+ len = typelen + 3 /* (0x */
+ + 2 * sizeof(UV) + 2 /* )\0 */;
}
- else
- Perl_sv_setpvf(aTHX_ tsv, "%s(0x%"UVxf")", typestr,
- PTR2UV(referent));
+
+ Newx(buffer, len, char);
+ buffer_end = retval = buffer + len;
+
+ /* Working backwards */
+ *--retval = '\0';
+ *--retval = ')';
+ do {
+ *--retval = PL_hexdigit[addr & 15];
+ } while (addr >>= 4);
+ *--retval = 'x';
+ *--retval = '0';
+ *--retval = '(';
+
+ retval -= typelen;
+ memcpy(retval, typestr, typelen);
+
+ if (stashname) {
+ *--retval = '=';
+ retval -= stashnamelen;
+ memcpy(retval, stashname, stashnamelen);
+ }
+ /* retval may not neccesarily have reached the start of the
+ buffer here. */
+ assert (retval >= buffer);
+
+ len = buffer_end - retval - 1; /* -1 for that \0 */
}
if (lp)
- *lp = SvCUR(tsv);
- return SvPVX(tsv);
+ *lp = len;
+ SAVEFREEPV(buffer);
+ return retval;
}
}
if (SvREADONLY(sv) && !SvOK(sv)) {
if (sstr == dstr)
return;
+
+ if (SvIS_FREED(dstr)) {
+ Perl_croak(aTHX_ "panic: attempt to copy value %" SVf
+ " to a freed scalar %p", sstr, dstr);
+ }
SV_CHECK_THINKFIRST_COW_DROP(dstr);
if (!sstr)
sstr = &PL_sv_undef;
+ if (SvIS_FREED(sstr)) {
+ Perl_croak(aTHX_ "panic: attempt to copy freed scalar %p to %p", sstr,
+ dstr);
+ }
stype = SvTYPE(sstr);
dtype = SvTYPE(dstr);
case PERL_MAGIC_regdata:
vtable = &PL_vtbl_regdata;
break;
+ case PERL_MAGIC_regdata_names:
+ vtable = &PL_vtbl_regdata_names;
+ break;
case PERL_MAGIC_regdatum:
vtable = &PL_vtbl_regdatum;
break;
=cut
*/
-char *
+const char *
Perl_sv_reftype(pTHX_ const SV *sv, int ob)
{
/* The fact that I don't need to downcast to char * everywhere, only in ?:
switch (*q) {
case ' ':
case '+':
- plus = *q++;
+ if (plus == '+' && *q == ' ') /* '+' over ' ' */
+ q++;
+ else
+ plus = *q++;
continue;
case '-':
else
i = (ewix ? ewix <= svmax : svix < svmax)
? SvIVx(svargs[ewix ? ewix-1 : svix++]) : 0;
- precis = (i < 0) ? 0 : i;
+ precis = i;
+ has_precis = !(i < 0);
}
else {
precis = 0;
while (isDIGIT(*q))
precis = precis * 10 + (*q++ - '0');
+ has_precis = TRUE;
}
- has_precis = TRUE;
}
/* SIZE */
else {
eptr = SvPVx_const(argsv, elen);
if (DO_UTF8(argsv)) {
+ I32 old_precis = precis;
if (has_precis && precis < elen) {
I32 p = precis;
sv_pos_u2b(argsv, &p, 0); /* sticks at end */
precis = p;
}
if (width) { /* fudge width (can't fudge elen) */
- width += elen - sv_len_utf8(argsv);
+ if (has_precis && precis < elen)
+ width += precis - old_precis;
+ else
+ width += elen - sv_len_utf8(argsv);
}
is_utf8 = TRUE;
}
base = 10;
goto uns_integer;
+ case 'B':
case 'b':
base = 2;
goto uns_integer;
switch (base) {
unsigned dig;
case 16:
- p = (char*)((c == 'X')
- ? "0123456789ABCDEF" : "0123456789abcdef");
+ p = (char *)((c == 'X') ? PL_hexdigit + 16 : PL_hexdigit);
do {
dig = uv & 15;
*--ptr = p[dig];
} while (uv >>= 1);
if (tempalt) {
esignbuf[esignlen++] = '0';
- esignbuf[esignlen++] = 'b';
+ esignbuf[esignlen++] = c;
}
break;
default: /* it had better be ten or less */
if (has_precis) {
if (precis > elen)
zeros = precis - elen;
- else if (precis == 0 && elen == 1 && *eptr == '0')
+ else if (precis == 0 && elen == 1 && *eptr == '0'
+ && !(base == 8 && alt)) /* "%#.0o" prints "0" */
elen = 0;
+
+ /* a precision nullifies the 0 flag. */
+ if (fill == '0')
+ fill = ' ';
}
}
break;
/* Certain cases in Perl_ss_dup have been merged, by relying on the fact
- that currently av_dup and hv_dup are the same as sv_dup. If this changes,
- please unmerge ss_dup. */
+ that currently av_dup, gv_dup and hv_dup are the same as sv_dup.
+ If this changes, please unmerge ss_dup. */
#define sv_dup_inc(s,t) SvREFCNT_inc(sv_dup(s,t))
#define sv_dup_inc_NN(s,t) SvREFCNT_inc_NN(sv_dup(s,t))
#define av_dup(s,t) (AV*)sv_dup((SV*)s,t)
REGEXP *
Perl_re_dup(pTHX_ const REGEXP *r, CLONE_PARAMS *param)
{
- return CALLREGDUPE(aTHX_ r,param);
+ return CALLREGDUPE(r,param);
}
/* duplicate a file handle */
long longval;
GP *gp;
IV iv;
+ I32 i;
char *c = NULL;
void (*dptr) (void*);
void (*dxptr) (pTHX_ void*);
Newxz(nss, max, ANY);
while (ix > 0) {
- I32 i = POPINT(ss,ix);
- TOPINT(nss,ix) = i;
- switch (i) {
+ const I32 type = POPINT(ss,ix);
+ TOPINT(nss,ix) = type;
+ switch (type) {
+ case SAVEt_HELEM: /* hash element */
+ sv = (SV*)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup_inc(sv, param);
+ /* fall through */
case SAVEt_ITEM: /* normal string */
case SAVEt_SV: /* scalar reference */
sv = (SV*)POPPTR(ss,ix);
TOPPTR(nss,ix) = sv_dup_inc(sv, param);
+ /* fall through */
+ case SAVEt_FREESV:
+ case SAVEt_MORTALIZESV:
sv = (SV*)POPPTR(ss,ix);
TOPPTR(nss,ix) = sv_dup_inc(sv, param);
break;
case SAVEt_AV: /* array reference */
sv = (SV*) POPPTR(ss,ix);
TOPPTR(nss,ix) = sv_dup_inc(sv, param);
- gv = (GV*)POPPTR(ss,ix);
- TOPPTR(nss,ix) = gv_dup(gv, param);
+ /* fall through */
+ case SAVEt_COMPPAD:
+ case SAVEt_NSTAB:
+ sv = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = sv_dup(sv, param);
break;
case SAVEt_INT: /* int reference */
ptr = POPPTR(ss,ix);
case SAVEt_LONG: /* long reference */
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+ /* fall through */
+ case SAVEt_CLEARSV:
longval = (long)POPLONG(ss,ix);
TOPLONG(nss,ix) = longval;
break;
c = (char*)POPPTR(ss,ix);
TOPPTR(nss,ix) = pv_dup(c);
break;
- case SAVEt_NSTAB:
- gv = (GV*)POPPTR(ss,ix);
- TOPPTR(nss,ix) = gv_dup(gv, param);
- break;
case SAVEt_GP: /* scalar reference */
gp = (GP*)POPPTR(ss,ix);
TOPPTR(nss,ix) = gp = gp_dup(gp, param);
(void)GpREFCNT_inc(gp);
gv = (GV*)POPPTR(ss,ix);
TOPPTR(nss,ix) = gv_dup_inc(gv, param);
- c = (char*)POPPTR(ss,ix);
- TOPPTR(nss,ix) = pv_dup(c);
- iv = POPIV(ss,ix);
- TOPIV(nss,ix) = iv;
- iv = POPIV(ss,ix);
- TOPIV(nss,ix) = iv;
break;
- case SAVEt_FREESV:
- case SAVEt_MORTALIZESV:
- sv = (SV*)POPPTR(ss,ix);
- TOPPTR(nss,ix) = sv_dup_inc(sv, param);
- break;
case SAVEt_FREEOP:
ptr = POPPTR(ss,ix);
if (ptr && (((OP*)ptr)->op_private & OPpREFCOUNTED)) {
c = (char*)POPPTR(ss,ix);
TOPPTR(nss,ix) = pv_dup_inc(c);
break;
- case SAVEt_CLEARSV:
- longval = POPLONG(ss,ix);
- TOPLONG(nss,ix) = longval;
- break;
case SAVEt_DELETE:
hv = (HV*)POPPTR(ss,ix);
TOPPTR(nss,ix) = hv_dup_inc(hv, param);
c = (char*)POPPTR(ss,ix);
TOPPTR(nss,ix) = pv_dup_inc(c);
+ /* fall through */
+ case SAVEt_STACK_POS: /* Position on Perl stack */
i = POPINT(ss,ix);
TOPINT(nss,ix) = i;
break;
TOPINT(nss,ix) = i;
ix -= i;
break;
- case SAVEt_STACK_POS: /* Position on Perl stack */
- i = POPINT(ss,ix);
- TOPINT(nss,ix) = i;
- break;
case SAVEt_AELEM: /* array element */
sv = (SV*)POPPTR(ss,ix);
TOPPTR(nss,ix) = sv_dup_inc(sv, param);
av = (AV*)POPPTR(ss,ix);
TOPPTR(nss,ix) = av_dup_inc(av, param);
break;
- case SAVEt_HELEM: /* hash element */
- sv = (SV*)POPPTR(ss,ix);
- TOPPTR(nss,ix) = sv_dup_inc(sv, param);
- sv = (SV*)POPPTR(ss,ix);
- TOPPTR(nss,ix) = sv_dup_inc(sv, param);
- hv = (HV*)POPPTR(ss,ix);
- TOPPTR(nss,ix) = hv_dup_inc(hv, param);
- break;
case SAVEt_OP:
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = ptr;
TOPPTR(nss,ix) = hv_dup_inc(hv, param);
}
break;
- case SAVEt_COMPPAD:
- av = (AV*)POPPTR(ss,ix);
- TOPPTR(nss,ix) = av_dup(av, param);
- break;
case SAVEt_PADSV:
longval = (long)POPLONG(ss,ix);
TOPLONG(nss,ix) = longval;
TOPPTR(nss,ix) = DUP_WARNINGS((STRLEN*)ptr);
break;
default:
- Perl_croak(aTHX_ "panic: ss_dup inconsistency (%"IVdf")", (IV) i);
+ Perl_croak(aTHX_
+ "panic: ss_dup inconsistency (%"IVdf")", (IV) type);
}
}
sv_setpvn(PERL_DEBUG_PAD(2), "", 0); /* even without DEBUGGING. */
- /* RE engine - function pointers -- must initilize these before
- re_dup() is called. dmq. */
- PL_regcompp = proto_perl->Tregcompp;
- PL_regexecp = proto_perl->Tregexecp;
- PL_regint_start = proto_perl->Tregint_start;
- PL_regint_string = proto_perl->Tregint_string;
- PL_regfree = proto_perl->Tregfree;
- PL_regdupe = proto_perl->Tregdupe;
-
+ /* RE engine related */
Zero(&PL_reg_state, 1, struct re_save_state);
PL_reginterp_cnt = 0;
PL_regmatch_slab = NULL;
PL_beginav = av_dup_inc(proto_perl->Ibeginav, param);
PL_beginav_save = av_dup_inc(proto_perl->Ibeginav_save, param);
PL_checkav_save = av_dup_inc(proto_perl->Icheckav_save, param);
+ PL_unitcheckav = av_dup_inc(proto_perl->Iunitcheckav, param);
+ PL_unitcheckav_save = av_dup_inc(proto_perl->Iunitcheckav_save, param);
PL_endav = av_dup_inc(proto_perl->Iendav, param);
PL_checkav = av_dup_inc(proto_perl->Icheckav, param);
PL_initav = av_dup_inc(proto_perl->Iinitav, param);
projects / p5sagit/p5-mst-13.2.git / blobdiff