(I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset,
(void*)head_slab));
- while (o && DIFF(OpSLOT(o), OpSLOT(o)->opslot_next) < sz) {
+ while (o && OpSLOT(o)->opslot_size < sz) {
DEBUG_S_warn((aTHX_ "Alas! too small"));
o = *(too = &o->op_next);
if (o) { DEBUG_S_warn((aTHX_ "found another free op at %p", (void*)o)); }
}
if (o) {
+ DEBUG_S_warn((aTHX_ "realloced op at %p, slab %p, head slab %p",
+ (void*)o,
+ (I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset,
+ (void*)head_slab));
*too = o->op_next;
Zero(o, opsz, I32 *);
o->op_slabbed = 1;
#define INIT_OPSLOT(s) \
slot->opslot_offset = DIFF(slab2, slot) ; \
- slot->opslot_next = ((OPSLOT*)( (I32**)slot + s )); \
+ slot->opslot_size = s; \
slab2->opslab_free_space -= s; \
o = &slot->opslot_op; \
o->op_slabbed = 1
((I32**)&slab2->opslab_slots + slab2->opslab_free_space);
OPSLOT *end = (OPSLOT*)
((I32**)slab2 + slab2->opslab_size);
- for (; slot <= end -1; slot = slot->opslot_next) {
+ for (; slot < end;
+ slot = (OPSLOT*) ((I32**)slot + slot->opslot_size) )
+ {
if (slot->opslot_op.op_type != OP_FREED
&& !(slot->opslot_op.op_savefree
#ifdef DEBUGGING
&& isIDFIRST_utf8_safe((U8 *)name+1, name + len))
|| (name[1] == '_' && len > 2)))
{
+ const char * const type =
+ PL_parser->in_my == KEY_sigvar ? "subroutine signature" :
+ PL_parser->in_my == KEY_state ? "\"state\"" : "\"my\"";
+
if (!(flags & SVf_UTF8 && UTF8_IS_START(name[1]))
&& isASCII(name[1])
&& (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1]))) {
- /* diag_listed_as: Can't use global %s in "%s" */
- yyerror(Perl_form(aTHX_ "Can't use global %c^%c%.*s in \"%s\"",
- name[0], toCTRL(name[1]), (int)(len - 2), name + 2,
- PL_parser->in_my == KEY_state ? "state" : "my"));
+ /* diag_listed_as: Can't use global %s in %s */
+ yyerror(Perl_form(aTHX_ "Can't use global %c^%c%.*s in %s",
+ name[0], toCTRL(name[1]),
+ (int)(len - 2), name + 2,
+ type));
} else {
- yyerror_pv(Perl_form(aTHX_ "Can't use global %.*s in \"%s\"", (int) len, name,
- PL_parser->in_my == KEY_state ? "state" : "my"), flags & SVf_UTF8);
+ yyerror_pv(Perl_form(aTHX_ "Can't use global %.*s in %s",
+ (int) len, name,
+ type), flags & SVf_UTF8);
}
}
dVAR;
if (o) {
if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || TAINTING_get) {
- o = op_prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
+ o = op_prepend_elem(OP_LINESEQ,
+ newOP(OP_ENTER, (o->op_flags & OPf_WANT)), o);
OpTYPE_set(o, OP_LEAVE);
}
else if (o->op_type == OP_LINESEQ) {
/* for my $x () sets OPpLVAL_INTRO;
* for our $x () sets OPpOUR_INTRO */
loop->op_private = (U8)iterpflags;
+
+ /* upgrade loop from a LISTOP to a LOOPOP;
+ * keep it in-place if there's space */
if (loop->op_slabbed
- && DIFF(loop, OpSLOT(loop)->opslot_next)
- < SIZE_TO_PSIZE(sizeof(LOOP)))
+ && OpSLOT(loop)->opslot_size
+ < SIZE_TO_PSIZE(sizeof(LOOP)) + OPSLOT_HEADER_P)
{
+ /* no space; allocate new op */
LOOP *tmp;
NewOp(1234,tmp,1,LOOP);
Copy(loop,tmp,1,LISTOP);
}
else if (!loop->op_slabbed)
{
+ /* loop was malloc()ed */
loop = (LOOP*)PerlMemShared_realloc(loop, sizeof(LOOP));
OpLASTSIB_set(loop->op_last, (OP*)loop);
}
this optimisation if the first NEXTSTATE has a label. */
if (!CopLABEL((COP*)o) && !PERLDB_NOOPT) {
OP *nextop = o->op_next;
- while (nextop && nextop->op_type == OP_NULL)
- nextop = nextop->op_next;
+ while (nextop) {
+ switch (nextop->op_type) {
+ case OP_NULL:
+ case OP_SCALAR:
+ case OP_LINESEQ:
+ case OP_SCOPE:
+ nextop = nextop->op_next;
+ continue;
+ }
+ break;
+ }
if (nextop && (nextop->op_type == OP_NEXTSTATE)) {
op_null(o);
/*
=head1 Custom Operators
-=for apidoc custom_op_xop
+=for apidoc Perl_custom_op_xop
Return the XOP structure for a given custom op. This macro should be
considered internal to C<OP_NAME> and the other access macros: use them instead.
This macro does call a function. Prior