}
else {
char *chunk; /* must use New here to match call to */
- New(704,chunk,PERL_ARENA_SIZE,char); /* Safefree() in sv_free_arenas() */
+ Newx(chunk,PERL_ARENA_SIZE,char); /* Safefree() in sv_free_arenas() */
sv_add_arena(chunk, PERL_ARENA_SIZE, 0);
}
uproot_SV(sv);
char *start;
const char *end;
const size_t count = PERL_ARENA_SIZE/size;
- New(0, start, count*size, char);
+ Newx(start, count*size, char);
*((void **) start) = *arena_root;
*arena_root = (void *)start;
/* grab a new thing from the free list, allocating more if necessary */
+/* 1st, the inline version */
+
+#define new_body_inline(xpv, arena_root, root, size) \
+ STMT_START { \
+ LOCK_SV_MUTEX; \
+ xpv = *((void **)(root)) \
+ ? *((void **)(root)) : S_more_bodies(aTHX_ arena_root, root, size); \
+ *(root) = *(void**)(xpv); \
+ UNLOCK_SV_MUTEX; \
+ } STMT_END
+
+/* now use the inline version in the proper function */
+
STATIC void *
S_new_body(pTHX_ void **arena_root, void **root, size_t size)
{
void *xpv;
- LOCK_SV_MUTEX;
- xpv = *root ? *root : S_more_bodies(aTHX_ arena_root, root, size);
- *root = *(void**)xpv;
- UNLOCK_SV_MUTEX;
+ new_body_inline(xpv, arena_root, root, size);
return xpv;
}
(void**)&(my_perl->Ixpvbm_root), sizeof(XPVBM), 0)
*/
-#define new_body(TYPE,lctype) \
+#define new_body_type(TYPE,lctype) \
S_new_body(aTHX_ (void**)&PL_ ## lctype ## _arenaroot, \
(void**)&PL_ ## lctype ## _root, \
sizeof(TYPE))
#else /* !PURIFY */
-#define new_XNV() new_body(NV, xnv)
+#define new_XNV() new_body_type(NV, xnv)
#define del_XNV(p) del_body_type(p, NV, xnv)
#define new_XPV() new_body_allocated(XPV, xpv, xpv_cur)
#define new_XPVIV() new_body_allocated(XPVIV, xpviv, xpv_cur)
#define del_XPVIV(p) del_body_allocated(p, XPVIV, xpviv, xpv_cur)
-#define new_XPVNV() new_body(XPVNV, xpvnv)
+#define new_XPVNV() new_body_type(XPVNV, xpvnv)
#define del_XPVNV(p) del_body_type(p, XPVNV, xpvnv)
-#define new_XPVCV() new_body(XPVCV, xpvcv)
+#define new_XPVCV() new_body_type(XPVCV, xpvcv)
#define del_XPVCV(p) del_body_type(p, XPVCV, xpvcv)
#define new_XPVAV() new_body_allocated(XPVAV, xpvav, xav_fill)
#define new_XPVHV() new_body_allocated(XPVHV, xpvhv, xhv_fill)
#define del_XPVHV(p) del_body_allocated(p, XPVHV, xpvhv, xhv_fill)
-#define new_XPVMG() new_body(XPVMG, xpvmg)
+#define new_XPVMG() new_body_type(XPVMG, xpvmg)
#define del_XPVMG(p) del_body_type(p, XPVMG, xpvmg)
-#define new_XPVGV() new_body(XPVGV, xpvgv)
+#define new_XPVGV() new_body_type(XPVGV, xpvgv)
#define del_XPVGV(p) del_body_type(p, XPVGV, xpvgv)
-#define new_XPVLV() new_body(XPVLV, xpvlv)
+#define new_XPVLV() new_body_type(XPVLV, xpvlv)
#define del_XPVLV(p) del_body_type(p, XPVLV, xpvlv)
-#define new_XPVBM() new_body(XPVBM, xpvbm)
+#define new_XPVBM() new_body_type(XPVBM, xpvbm)
#define del_XPVBM(p) del_body_type(p, XPVBM, xpvbm)
#endif /* PURIFY */
assert(new_body_length);
#ifndef PURIFY
/* This points to the start of the allocated area. */
- new_body = S_new_body(aTHX_ new_body_arenaroot, new_body_arena,
- new_body_length);
+ new_body_inline(new_body, new_body_arenaroot, new_body_arena,
+ new_body_length);
#else
/* We always allocated the full length item with PURIFY */
new_body_length += new_body_offset;
return asIV(sv);
if (!SvROK(sv)) {
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
- if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+ if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
report_uninit(sv);
}
return 0;
#endif /* NV_PRESERVES_UV */
}
} else {
- if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+ if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
report_uninit(sv);
if (SvTYPE(sv) < SVt_IV)
/* Typically the caller expects that sv_any is not NULL now. */
return asUV(sv);
if (!SvROK(sv)) {
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
- if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+ if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
report_uninit(sv);
}
return 0;
}
else {
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
- if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+ if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
report_uninit(sv);
}
if (SvTYPE(sv) < SVt_IV)
if (SvNOKp(sv))
return SvNVX(sv);
if (SvPOKp(sv) && SvLEN(sv)) {
- if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) &&
+ if (!SvIOKp(sv) && ckWARN(WARN_NUMERIC) &&
!grok_number(SvPVX_const(sv), SvCUR(sv), NULL))
not_a_number(sv);
return Atof(SvPVX_const(sv));
}
if (!SvROK(sv)) {
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
- if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+ if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
report_uninit(sv);
}
return (NV)0;
else if (SvPOKp(sv) && SvLEN(sv)) {
UV value;
const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
- if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !numtype)
+ if (!SvIOKp(sv) && !numtype && ckWARN(WARN_NUMERIC))
not_a_number(sv);
#ifdef NV_PRESERVES_UV
if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
#endif /* NV_PRESERVES_UV */
}
else {
- if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+ if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
report_uninit(sv);
if (SvTYPE(sv) < SVt_NV)
/* Typically the caller expects that sv_any is not NULL now. */
}
if (!SvROK(sv)) {
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
- if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+ if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
report_uninit(sv);
}
if (lp)
}
}
- New(616, mg->mg_ptr, mg->mg_len + 1 + left, char);
+ Newx(mg->mg_ptr, mg->mg_len + 1 + left, char);
Copy("(?", mg->mg_ptr, 2, char);
Copy(reflags, mg->mg_ptr+2, left, char);
Copy(":", mg->mg_ptr+left+2, 1, char);
#endif
}
else {
- if (ckWARN(WARN_UNINITIALIZED)
- && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+ if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
report_uninit(sv);
if (lp)
*lp = 0;
}
SvFAKE_off(sv);
SvREADONLY_off(sv);
- /* This SV doesn't own the buffer, so need to New() a new one: */
+ /* This SV doesn't own the buffer, so need to Newx() a new one: */
SvPV_set(sv, (char*)0);
SvLEN_set(sv, 0);
if (flags & SV_COW_DROP_PV) {
if (SvTYPE(sv) < SVt_PVMG) {
SvUPGRADE(sv, SVt_PVMG);
}
- Newz(702,mg, 1, MAGIC);
+ Newxz(mg, 1, MAGIC);
mg->mg_moremagic = SvMAGIC(sv);
SvMAGIC_set(sv, mg);
if ((*mgp)->mg_ptr)
*cachep = (STRLEN *) (*mgp)->mg_ptr;
else {
- Newz(0, *cachep, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN);
+ Newxz(*cachep, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN);
(*mgp)->mg_ptr = (char *) *cachep;
}
assert(*cachep);
assert(mg);
if (!mg->mg_ptr) {
- Newz(0, cache, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN);
+ Newxz(cache, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN);
mg->mg_ptr = (char *) cache;
}
assert(cache);
/*The big, slow, and stupid way. */
#ifdef USE_HEAP_INSTEAD_OF_STACK /* Even slower way. */
STDCHAR *buf = 0;
- New(0, buf, 8192, STDCHAR);
+ Newx(buf, 8192, STDCHAR);
assert(buf);
#else
STDCHAR buf[8192];
}
else {
(void)SvIOK_only_UV(sv);
- SvUV_set(sv, SvUVX(sv) + 1);
+ SvUV_set(sv, SvUVX(sv) - 1);
}
} else {
if (SvIVX(sv) == IV_MIN)
}
if (!asterisk)
+ {
if( *q == '0' )
fill = *q++;
EXPECT_NUMBER(q, width);
+ }
if (vectorize) {
if (vectorarg) {
if (PL_efloatsize < need) {
Safefree(PL_efloatbuf);
PL_efloatsize = need + 20; /* more fudge */
- New(906, PL_efloatbuf, PL_efloatsize, char);
+ Newx(PL_efloatbuf, PL_efloatsize, char);
PL_efloatbuf[0] = '\0';
}
default:
unknown:
- if (!args && ckWARN(WARN_PRINTF) &&
- (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) {
+ if (!args
+ && (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)
+ && ckWARN(WARN_PRINTF))
+ {
SV *msg = sv_newmortal();
Perl_sv_setpvf(aTHX_ msg, "Invalid conversion in %sprintf: ",
(PL_op->op_type == OP_PRTF) ? "" : "s");
len = r->offsets[0];
npar = r->nparens+1;
- Newc(0, ret, sizeof(regexp) + (len+1)*sizeof(regnode), char, regexp);
+ Newxc(ret, sizeof(regexp) + (len+1)*sizeof(regnode), char, regexp);
Copy(r->program, ret->program, len+1, regnode);
- New(0, ret->startp, npar, I32);
+ Newx(ret->startp, npar, I32);
Copy(r->startp, ret->startp, npar, I32);
- New(0, ret->endp, npar, I32);
+ Newx(ret->endp, npar, I32);
Copy(r->startp, ret->startp, npar, I32);
- New(0, ret->substrs, 1, struct reg_substr_data);
+ Newx(ret->substrs, 1, struct reg_substr_data);
for (s = ret->substrs->data, i = 0; i < 3; i++, s++) {
s->min_offset = r->substrs->data[i].min_offset;
s->max_offset = r->substrs->data[i].max_offset;
const int count = r->data->count;
int i;
- Newc(0, d, sizeof(struct reg_data) + count*sizeof(void *),
+ Newxc(d, sizeof(struct reg_data) + count*sizeof(void *),
char, struct reg_data);
- New(0, d->what, count, U8);
+ Newx(d->what, count, U8);
d->count = count;
for (i = 0; i < count; i++) {
break;
case 'f':
/* This is cheating. */
- New(0, d->data[i], 1, struct regnode_charclass_class);
+ Newx(d->data[i], 1, struct regnode_charclass_class);
StructCopy(r->data->data[i], d->data[i],
struct regnode_charclass_class);
ret->regstclass = (regnode*)d->data[i];
else
ret->data = NULL;
- New(0, ret->offsets, 2*len+1, U32);
+ Newx(ret->offsets, 2*len+1, U32);
Copy(r->offsets, ret->offsets, 2*len+1, U32);
ret->precomp = SAVEPVN(r->precomp, r->prelen);
return ret;
/* create anew and remember what it is */
- Newz(0, ret, 1, GP);
+ Newxz(ret, 1, GP);
ptr_table_store(PL_ptr_table, gp, ret);
/* clone */
for (; mg; mg = mg->mg_moremagic) {
MAGIC *nmg;
- Newz(0, nmg, 1, MAGIC);
+ Newxz(nmg, 1, MAGIC);
if (mgprev)
mgprev->mg_moremagic = nmg;
else
Perl_ptr_table_new(pTHX)
{
PTR_TBL_t *tbl;
- Newz(0, tbl, 1, PTR_TBL_t);
+ Newxz(tbl, 1, PTR_TBL_t);
tbl->tbl_max = 511;
tbl->tbl_items = 0;
- Newz(0, tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
+ Newxz(tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
return tbl;
}
# define PTR_TABLE_HASH(ptr) (PTR2UV(ptr) >> 2)
#endif
-#define new_pte() new_body(struct ptr_tbl_ent, pte)
#define del_pte(p) del_body_type(p, struct ptr_tbl_ent, pte)
/* map an existing pointer using a table */
return;
}
}
- tblent = new_pte();
+ new_body_inline(tblent, (void**)&PL_pte_arenaroot, (void**)&PL_pte_root,
+ sizeof(struct ptr_tbl_ent));
tblent->oldval = oldv;
tblent->newval = newv;
tblent->next = *otblent;
new_body:
assert(new_body_length);
#ifndef PURIFY
- new_body = (void*)((char*)S_new_body(aTHX_ new_body_arenaroot,
- new_body_arena,
- new_body_length)
- - new_body_offset);
+ new_body_inline(new_body, new_body_arenaroot, new_body_arena,
+ new_body_length);
+ new_body = (void*)((char*)new_body - new_body_offset);
#else
/* We always allocated the full length item with PURIFY */
new_body_length += new_body_offset;
SSize_t items = AvFILLp((AV*)sstr) + 1;
src_ary = AvARRAY((AV*)sstr);
- Newz(0, dst_ary, AvMAX((AV*)sstr)+1, SV*);
+ Newxz(dst_ary, AvMAX((AV*)sstr)+1, SV*);
ptr_table_store(PL_ptr_table, src_ary, dst_ary);
SvPV_set(dstr, (char*)dst_ary);
AvALLOC((AV*)dstr) = dst_ary;
XPVHV * const dxhv = (XPVHV*)SvANY(dstr);
XPVHV * const sxhv = (XPVHV*)SvANY(sstr);
char *darray;
- New(0, darray,
- PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1)
+ Newx(darray, PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1)
+ (SvOOK(sstr) ? sizeof(struct xpvhv_aux) : 0),
char);
HvARRAY(dstr) = (HE**)darray;
return ncxs;
/* create anew and remember what it is */
- Newz(56, ncxs, max + 1, PERL_CONTEXT);
+ Newxz(ncxs, max + 1, PERL_CONTEXT);
ptr_table_store(PL_ptr_table, cxs, ncxs);
while (ix >= 0) {
return nsi;
/* create anew and remember what it is */
- Newz(56, nsi, 1, PERL_SI);
+ Newxz(nsi, 1, PERL_SI);
ptr_table_store(PL_ptr_table, si, nsi);
nsi->si_stack = av_dup_inc(si->si_stack, param);
void (*dptr) (void*);
void (*dxptr) (pTHX_ void*);
- Newz(54, nss, max, ANY);
+ Newxz(nss, max, ANY);
while (ix > 0) {
I32 i = POPINT(ss,ix);
param->stashes = newAV(); /* Setup array of objects to call clone on */
+ /* Set tainting stuff before PerlIO_debug can possibly get called */
+ PL_tainting = proto_perl->Itainting;
+ PL_taint_warn = proto_perl->Itaint_warn;
+
#ifdef PERLIO_LAYERS
/* Clone PerlIO tables as soon as we can handle general xx_dup() */
PerlIO_clone(aTHX_ proto_perl, param);
PL_fdpid = av_dup_inc(proto_perl->Ifdpid, param);
/* internal state */
- PL_tainting = proto_perl->Itainting;
- PL_taint_warn = proto_perl->Itaint_warn;
PL_maxo = proto_perl->Imaxo;
if (proto_perl->Iop_mask)
PL_op_mask = SAVEPVN(proto_perl->Iop_mask, PL_maxo);
/* interpreter atexit processing */
PL_exitlistlen = proto_perl->Iexitlistlen;
if (PL_exitlistlen) {
- New(0, PL_exitlist, PL_exitlistlen, PerlExitListEntry);
+ Newx(PL_exitlist, PL_exitlistlen, PerlExitListEntry);
Copy(proto_perl->Iexitlist, PL_exitlist, PL_exitlistlen, PerlExitListEntry);
}
else
PL_bitcount = Nullch; /* reinits on demand */
if (proto_perl->Ipsig_pend) {
- Newz(0, PL_psig_pend, SIG_SIZE, int);
+ Newxz(PL_psig_pend, SIG_SIZE, int);
}
else {
PL_psig_pend = (int*)NULL;
}
if (proto_perl->Ipsig_ptr) {
- Newz(0, PL_psig_ptr, SIG_SIZE, SV*);
- Newz(0, PL_psig_name, SIG_SIZE, SV*);
+ Newxz(PL_psig_ptr, SIG_SIZE, SV*);
+ Newxz(PL_psig_name, SIG_SIZE, SV*);
for (i = 1; i < SIG_SIZE; i++) {
PL_psig_ptr[i] = sv_dup_inc(proto_perl->Ipsig_ptr[i], param);
PL_psig_name[i] = sv_dup_inc(proto_perl->Ipsig_name[i], param);
PL_tmps_ix = proto_perl->Ttmps_ix;
PL_tmps_max = proto_perl->Ttmps_max;
PL_tmps_floor = proto_perl->Ttmps_floor;
- Newz(50, PL_tmps_stack, PL_tmps_max, SV*);
+ Newxz(PL_tmps_stack, PL_tmps_max, SV*);
i = 0;
while (i <= PL_tmps_ix) {
PL_tmps_stack[i] = sv_dup_inc(proto_perl->Ttmps_stack[i], param);
/* next PUSHMARK() sets *(PL_markstack_ptr+1) */
i = proto_perl->Tmarkstack_max - proto_perl->Tmarkstack;
- Newz(54, PL_markstack, i, I32);
+ Newxz(PL_markstack, i, I32);
PL_markstack_max = PL_markstack + (proto_perl->Tmarkstack_max
- proto_perl->Tmarkstack);
PL_markstack_ptr = PL_markstack + (proto_perl->Tmarkstack_ptr
* NOTE: unlike the others! */
PL_scopestack_ix = proto_perl->Tscopestack_ix;
PL_scopestack_max = proto_perl->Tscopestack_max;
- Newz(54, PL_scopestack, PL_scopestack_max, I32);
+ Newxz(PL_scopestack, PL_scopestack_max, I32);
Copy(proto_perl->Tscopestack, PL_scopestack, PL_scopestack_ix, I32);
/* NOTE: si_dup() looks at PL_markstack */
* NOTE: unlike the others! */
PL_savestack_ix = proto_perl->Tsavestack_ix;
PL_savestack_max = proto_perl->Tsavestack_max;
- /*Newz(54, PL_savestack, PL_savestack_max, ANY);*/
+ /*Newxz(PL_savestack, PL_savestack_max, ANY);*/
PL_savestack = ss_dup(proto_perl, param);
}
else {
projects / p5sagit/p5-mst-13.2.git / blobdiff