recursive, but it's recursive on basic blocks, not on tree nodes.
*/
+/* To implement user lexical pragmas, there needs to be a way at run time to
+ get the compile time state of %^H for that block. Storing %^H in every
+ block (or even COP) would be very expensive, so a different approach is
+ taken. The (running) state of %^H is serialised into a tree of HE-like
+ structs. Stores into %^H are chained onto the current leaf as a struct
+ refcounted_he * with the key and the value. Deletes from %^H are saved
+ with a value of PL_sv_placeholder. The state of %^H at any point can be
+ turned back into a regular HV by walking back up the tree from that point's
+ leaf, ignoring any key you've already seen (placeholder or not), storing
+ the rest into the HV structure, then removing the placeholders. Hence
+ memory is only used to store the %^H deltas from the enclosing COP, rather
+ than the entire %^H on each COP.
+
+ To cause actions on %^H to write out the serialisation records, it has
+ magic type 'H'. This magic (itself) does nothing, but its presence causes
+ the values to gain magic type 'h', which has entries for set and clear.
+ C<Perl_magic_sethint> updates C<PL_compiling.cop_hints> with a store
+ record, with deletes written by C<Perl_magic_clearhint>. C<SAVE_HINTS>
+ saves the current C<PL_compiling.cop_hints> on the save stack, so that it
+ will be correctly restored when any inner compiling scope is exited.
+*/
+
#include "EXTERN.h"
#define PERL_IN_OP_C
#include "perl.h"
SvREFCNT_dec(cop->cop_io);
#endif
}
+ Perl_refcounted_he_free(aTHX_ cop->cop_hints);
}
void
if (ckWARN(WARN_VOID)) {
useless = "a constant";
if (o->op_private & OPpCONST_ARYBASE)
- useless = 0;
+ useless = NULL;
/* don't warn on optimised away booleans, eg
* use constant Foo, 5; Foo || print; */
if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT)
- useless = 0;
+ useless = NULL;
/* the constants 0 and 1 are permitted as they are
conventionally used as dummies in constructs like
1 while some_condition_with_side_effects; */
else if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
- useless = 0;
+ useless = NULL;
else if (SvPOK(sv)) {
/* perl4's way of mixing documentation and code
(before the invention of POD) was based on a
if (strnEQ(maybe_macro, "di", 2) ||
strnEQ(maybe_macro, "ds", 2) ||
strnEQ(maybe_macro, "ig", 2))
- useless = 0;
+ useless = NULL;
}
}
}
goto nomod;
localize = 0;
if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
- PL_compiling.cop_arybase = (I32)SvIV(cSVOPx(PL_eval_start)->op_sv);
+ CopARYBASE_set(&PL_compiling,
+ (I32)SvIV(cSVOPx(PL_eval_start)->op_sv));
PL_eval_start = 0;
}
else if (!type) {
- SAVEI32(PL_compiling.cop_arybase);
- PL_compiling.cop_arybase = 0;
+ SAVECOPARYBASE(&PL_compiling);
+ CopARYBASE_set(&PL_compiling, 0);
}
else if (type == OP_REFGEN)
goto nomod;
return o;
type = o->op_type;
-
if (PL_madskills && type == OP_NULL && o->op_flags & OPf_KIDS) {
(void)my_kid(cUNOPo->op_first, attrs, imopsp);
return o;
const int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
OP* const retval = scalarseq(seq);
LEAVE_SCOPE(floor);
- PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+ CopHINTS_set(&PL_compiling, PL_hints);
if (needblockscope)
PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
pad_leavemy();
{
if (o->op_type == OP_LIST) {
OP * const o2
- = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD|GV_NOTQUAL,
- SVt_PV)));
+ = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD|GV_NOTQUAL, SVt_PV)));
o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o));
}
return o;
const I32 to_utf = o->op_private & OPpTRANS_TO_UTF;
U8* tsave = NULL;
U8* rsave = NULL;
+ const U32 flags = UTF8_ALLOW_DEFAULT;
if (!from_utf) {
STRLEN len = tlen;
i = 0;
transv = newSVpvs("");
while (t < tend) {
- cp[2*i] = utf8n_to_uvuni(t, tend-t, &ulen, 0);
+ cp[2*i] = utf8n_to_uvuni(t, tend-t, &ulen, flags);
t += ulen;
if (t < tend && NATIVE_TO_UTF(*t) == 0xff) {
t++;
- cp[2*i+1] = utf8n_to_uvuni(t, tend-t, &ulen, 0);
+ cp[2*i+1] = utf8n_to_uvuni(t, tend-t, &ulen, flags);
t += ulen;
}
else {
while (t < tend || tfirst <= tlast) {
/* see if we need more "t" chars */
if (tfirst > tlast) {
- tfirst = (I32)utf8n_to_uvuni(t, tend - t, &ulen, 0);
+ tfirst = (I32)utf8n_to_uvuni(t, tend - t, &ulen, flags);
t += ulen;
if (t < tend && NATIVE_TO_UTF(*t) == 0xff) { /* illegal utf8 val indicates range */
t++;
- tlast = (I32)utf8n_to_uvuni(t, tend - t, &ulen, 0);
+ tlast = (I32)utf8n_to_uvuni(t, tend - t, &ulen, flags);
t += ulen;
}
else
/* now see if we need more "r" chars */
if (rfirst > rlast) {
if (r < rend) {
- rfirst = (I32)utf8n_to_uvuni(r, rend - r, &ulen, 0);
+ rfirst = (I32)utf8n_to_uvuni(r, rend - r, &ulen, flags);
r += ulen;
if (r < rend && NATIVE_TO_UTF(*r) == 0xff) { /* illegal utf8 val indicates range */
r++;
- rlast = (I32)utf8n_to_uvuni(r, rend - r, &ulen, 0);
+ rlast = (I32)utf8n_to_uvuni(r, rend - r, &ulen, flags);
r += ulen;
}
else
doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, term,
scalar(newUNOP(OP_RV2CV, 0,
- newGVOP(OP_GV, 0,
- gv))))));
+ newGVOP(OP_GV, 0, gv))))));
}
else {
doop = newUNOP(OP_DOFILE, 0, scalar(term));
else {
/* FIXME for MAD */
op_free(o);
- o = newSVOP(OP_CONST, 0, newSViv(PL_compiling.cop_arybase));
+ o = newSVOP(OP_CONST, 0, newSViv(CopARYBASE_get(&PL_compiling)));
o->op_private |= OPpCONST_ARYBASE;
}
}
cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ];
}
cop->op_flags = (U8)flags;
- cop->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+ CopHINTS_set(cop, PL_hints);
#ifdef NATIVE_HINTS
cop->op_private |= NATIVE_HINTS;
#endif
- PL_compiling.op_private = cop->op_private;
+ CopHINTS_set(&PL_compiling, CopHINTS_get(cop));
cop->op_next = (OP*)cop;
if (label) {
PL_hints |= HINT_BLOCK_SCOPE;
}
cop->cop_seq = seq;
- cop->cop_arybase = PL_curcop->cop_arybase;
+ CopARYBASE_set(cop, CopARYBASE_get(PL_curcop));
if (specialWARN(PL_curcop->cop_warnings))
cop->cop_warnings = PL_curcop->cop_warnings ;
else
cop->cop_io = PL_curcop->cop_io;
else
cop->cop_io = newSVsv(PL_curcop->cop_io) ;
-
+ cop->cop_hints = PL_curcop->cop_hints;
+ if (cop->cop_hints) {
+ cop->cop_hints->refcounted_he_refcnt++;
+ }
if (PL_copline == NOLINE)
CopLINE_set(cop, CopLINE(PL_curcop));
PADOFFSET padoff = 0;
I32 iterflags = 0;
I32 iterpflags = 0;
- OP *madsv = 0;
+ OP *madsv = NULL;
if (sv) {
if (sv->op_type == OP_RV2SV) { /* symbol table variable */
* set the STACKED flag to indicate that these values are to be
* treated as min/max values by 'pp_iterinit'.
*/
- UNOP* const flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
+ const UNOP* const flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
LOGOP* const range = (LOGOP*) flip->op_first;
OP* const left = range->op_first;
OP* const right = left->op_sibling;
}
}
if (const_sv) {
- SvREFCNT_inc_void_NN(const_sv);
+ SvREFCNT_inc_simple_void_NN(const_sv);
if (cv) {
assert(!CvROOT(cv) && !CvCONST(cv));
sv_setpvn((SV*)cv, "", 0); /* prototype is "" */
call_list(oldscope, PL_beginav);
PL_curcop = &PL_compiling;
- PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+ CopHINTS_set(&PL_compiling, PL_hints);
LEAVE;
}
else if (strEQ(s, "END") && !PL_error_count) {
o->op_targ = (PADOFFSET)PL_hints;
if ((PL_hints & HINT_LOCALIZE_HH) != 0 && GvHV(PL_hintgv)) {
/* Store a copy of %^H that pp_entereval can pick up */
- OP *hhop = newSVOP(OP_CONST, 0, (SV*)newHVhv(GvHV(PL_hintgv)));
+ OP *hhop = newSVOP(OP_CONST, 0,
+ (SV*)Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv)));
cUNOPo->op_first->op_sibling = hhop;
o->op_private |= OPpEVAL_HAS_HH;
}
pop->op_next->op_type == OP_AELEM &&
!(pop->op_next->op_private &
(OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)) &&
- (i = SvIV(((SVOP*)pop)->op_sv) - PL_curcop->cop_arybase)
+ (i = SvIV(((SVOP*)pop)->op_sv) - CopARYBASE_get(PL_curcop))
<= 255 &&
i >= 0)
{
projects / p5sagit/p5-mst-13.2.git / blobdiff