#define PERL_SLAB_SIZE 2048
#endif
-#define NewOp(m,var,c,type) \
- STMT_START { var = (type *) Slab_Alloc(m,c*sizeof(type)); } STMT_END
-
-#define FreeOp(p) Slab_Free(p)
-
-STATIC void *
-S_Slab_Alloc(pTHX_ int m, size_t sz)
+void *
+Perl_Slab_Alloc(pTHX_ int m, size_t sz)
{
/*
* To make incrementing use count easy PL_OpSlab is an I32 *
return (void *)(PL_OpPtr + 1);
}
-STATIC void
-S_Slab_Free(pTHX_ void *op)
+void
+Perl_Slab_Free(pTHX_ void *op)
{
I32 **ptr = (I32 **) op;
I32 *slab = ptr[-1];
assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) );
assert( *slab > 0 );
if (--(*slab) == 0) {
- #ifdef NETWARE
- #define PerlMemShared PerlMem
- #endif
+# ifdef NETWARE
+# define PerlMemShared PerlMem
+# endif
PerlMemShared_free(slab);
if (slab == PL_OpSlab) {
}
}
}
-
-#else
-#define NewOp(m, var, c, type) Newz(m, var, c, type)
-#define FreeOp(p) Safefree(p)
#endif
/*
* In the following definition, the ", Nullop" is just to make the compiler
CALL_PEEP(PL_eval_start);
}
else {
- if (o->op_type == OP_STUB)
+ if (o->op_type == OP_STUB) {
+ PL_comppad_name = 0;
+ PL_compcv = 0;
return;
+ }
PL_main_root = scope(sawparens(scalarvoid(o)));
PL_curcop = &PL_compiling;
PL_main_start = LINKLIST(PL_main_root);
listop->op_last = pushop;
}
- return (OP*)listop;
+ return CHECKOP(type, listop);
}
OP *
PmopSTASH_set(pmop,PL_curstash);
}
- return (OP*)pmop;
+ return CHECKOP(type, pmop);
}
OP *
PL_hints |= HINT_BLOCK_SCOPE;
PL_copline = NOLINE;
PL_expect = XSTATE;
+ PL_cop_seqmax++; /* Purely for B::*'s benefit */
}
/*
return first;
}
}
- else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS)) {
+ else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS) &&
+ type != OP_DOR) /* [#24076] Don't warn for <FH> err FOO. */
+ {
OP *k1 = ((UNOP*)first)->op_first;
OP *k2 = k1->op_sibling;
OPCODE warnop = 0;
first->op_next = (OP*)logop;
first->op_sibling = other;
+ CHECKOP(type,logop);
+
o = newUNOP(OP_NULL, 0, (OP*)logop);
other->op_next = o;
logop->op_other = LINKLIST(trueop);
logop->op_next = LINKLIST(falseop);
+ CHECKOP(OP_COND_EXPR, /* that's logop->op_type */
+ logop);
/* establish postfix order */
start = LINKLIST(first);
append_elem(OP_LIST, expr, scalar(sv))));
assert(!loop->op_next);
/* for my $x () sets OPpLVAL_INTRO;
- * for our $x () sets OPpOUR_INTRO; both only used by Deparse.pm */
+ * for our $x () sets OPpOUR_INTRO */
loop->op_private = (U8)iterpflags;
#ifdef PL_OP_SLAB_ALLOC
{
op_free(label);
}
else {
- if (label->op_type == OP_ENTERSUB)
+ /* Check whether it's going to be a goto &function */
+ if (label->op_type == OP_ENTERSUB
+ && !(label->op_flags & OPf_STACKED))
label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
o = newUNOP(type, OPf_STACKED, label);
}
CvCONST_on(cv);
sv_setpv((SV*)cv, ""); /* prototype is "" */
+ if (stash)
+ CopSTASH_free(PL_curcop);
+
LEAVE;
return cv;
(op) == OP_NE || (op) == OP_I_NE || \
(op) == OP_NCMP || (op) == OP_I_NCMP)
o->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
- if (o->op_type == OP_BIT_OR
- || o->op_type == OP_BIT_AND
- || o->op_type == OP_BIT_XOR)
+ if (!(o->op_flags & OPf_STACKED) /* Not an assignment */
+ && (o->op_type == OP_BIT_OR
+ || o->op_type == OP_BIT_AND
+ || o->op_type == OP_BIT_XOR))
{
OP * left = cBINOPo->op_first;
OP * right = left->op_sibling;
#if !defined(PERL_EXTERNAL_GLOB)
/* XXX this can be tightened up and made more failsafe. */
- if (!gv) {
+ if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {
GV *glob_gv;
ENTER;
Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
o->op_seq = PL_op_seqmax++;
break;
case OP_STUB:
+ /* XXX This makes sub {}; work as expected.
+ ie {return;} not {return @_;}
+ When optimiser is properly split into fixups and
+ optimisations, this needs to stay in the fixups. */
+ if(!oldop &&
+ o->op_next &&
+ o->op_next->op_type == OP_LEAVESUB) {
+ OP* newop = newSTATEOP(0, Nullch, 0);
+ newop->op_next = o->op_next;
+ o->op_next = 0;
+ op_free(o);
+ o = newop;
+ ((UNOP*)o->op_next)->op_first = newop;
+ CvSTART(PL_compcv) = newop;
+ }
if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
o->op_seq = PL_op_seqmax++;
break; /* Scalar stub must produce undef. List stub is noop */