#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
/* check for duplicate declaration */
pad_check_dup(name,
- PL_in_my == KEY_our,
+ (bool)(PL_in_my == KEY_our),
(PL_curstash ? PL_curstash : PL_defstash)
);
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;
+ FreeOp(o);
return;
+ }
PL_main_root = scope(sawparens(scalarvoid(o)));
PL_curcop = &PL_compiling;
PL_main_start = LINKLIST(PL_main_root);
o->op_type = OP_RV2AV;
o->op_ppaddr = PL_ppaddr[OP_RV2AV];
+ o->op_flags &= ~OPf_REF; /* treat \(1..2) like an ordinary list */
+ o->op_flags |= OPf_PARENS; /* and flatten \(1..2,3) */
o->op_seq = 0; /* needs to be revisited in peep() */
curop = ((UNOP*)o)->op_first;
((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
listop->op_last = pushop;
}
- return (OP*)listop;
+ return CHECKOP(type, listop);
}
OP *
U8* tend = t + tlen;
U8* rend = r + rlen;
STRLEN ulen;
- U32 tfirst = 1;
- U32 tlast = 0;
- I32 tdiff;
- U32 rfirst = 1;
- U32 rlast = 0;
- I32 rdiff;
- I32 diff;
+ UV tfirst = 1;
+ UV tlast = 0;
+ IV tdiff;
+ UV rfirst = 1;
+ UV rlast = 0;
+ IV rdiff;
+ IV diff;
I32 none = 0;
U32 max = 0;
I32 bits;
PmopSTASH_set(pmop,PL_curstash);
}
- return (OP*)pmop;
+ return CHECKOP(type, pmop);
}
OP *
OP *curop;
if (pm->op_pmflags & PMf_EVAL) {
curop = 0;
- if (CopLINE(PL_curcop) < PL_multi_end)
+ if (CopLINE(PL_curcop) < (line_t)PL_multi_end)
CopLINE_set(PL_curcop, (line_t)PL_multi_end);
}
else if (repl->op_type == OP_CONST)
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 */
- loop->op_private = iterpflags;
+ * for our $x () sets OPpOUR_INTRO */
+ loop->op_private = (U8)iterpflags;
#ifdef PL_OP_SLAB_ALLOC
{
LOOP *tmp;
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);
}
mod(scalarseq(block), OP_LEAVESUBLV));
}
else {
+ /* This makes sub {}; work as expected. */
+ if (block->op_type == OP_STUB) {
+ op_free(block);
+ block = newSTATEOP(0, Nullch, 0);
+ }
CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
}
CvROOT(cv)->op_private |= OPpREFCOUNTED;
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;
OP *
Perl_ck_concat(pTHX_ OP *o)
{
- if (cUNOPo->op_first->op_type == OP_CONCAT)
- o->op_flags |= OPf_STACKED;
+ OP *kid = cUNOPo->op_first;
+ if (kid->op_type == OP_CONCAT && !(kid->op_private & OPpTARGET_MY) &&
+ !(kUNOP->op_first->op_flags & OPf_MOD))
+ o->op_flags |= OPf_STACKED;
return o;
}
}
if (tmpstr) {
- name = savepv(SvPVX(tmpstr));
- len = strlen(name);
+ name = SvPV(tmpstr, len);
sv_2mortal(tmpstr);
}
}
#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,
}
OP *
+Perl_ck_unpack(pTHX_ OP *o)
+{
+ OP *kid = cLISTOPo->op_first;
+ if (kid->op_sibling) {
+ kid = kid->op_sibling;
+ if (!kid->op_sibling)
+ kid->op_sibling = newDEFSVOP();
+ }
+ return ck_fun(o);
+}
+
+OP *
Perl_ck_substr(pTHX_ OP *o)
{
o = ck_fun(o);
ST(0) = (SV*)XSANY.any_ptr;
XSRETURN(1);
}
-
-PerlIO*
-Perl_my_tmpfp(pTHX)
-{
- PerlIO *f = NULL;
- int fd = -1;
-#ifdef PERL_EXTERNAL_GLOB
- /* File::Temp pulls in Fcntl, which may not be available with
- * e.g. miniperl, use mkstemp() or stdio tmpfile() instead. */
-# if defined(WIN32) || !defined(HAS_MKSTEMP)
- FILE *stdio = PerlSIO_tmpfile();
-
- if (stdio) {
- if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)),
- &PerlIO_stdio, "w+", Nullsv))) {
- PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
-
- if (s)
- s->stdio = stdio;
- }
- }
-# else /* !WIN32 && HAS_MKSTEMP */
- SV *sv = newSVpv("/tmp/PerlIO_XXXXXX", 0);
-
- if (sv) {
- fd = mkstemp(SvPVX(sv));
- if (fd >= 0) {
- f = PerlIO_fdopen(fd, "w+");
- if (f) {
- PerlLIO_unlink(SvPVX(sv));
- SvREFCNT_dec(sv);
- }
- }
- }
-# endif /* WIN32 || !HAS_MKSTEMP */
-#else
- /* We have internal glob, which probably also means that we
- * can also use File::Temp (which uses Fcntl) with impunity. */
- GV *gv = gv_fetchpv("File::Temp::tempfile", FALSE, SVt_PVCV);
-
- if (!gv) {
- ENTER;
- Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
- newSVpvn("File::Temp", 10), Nullsv, Nullsv, Nullsv);
- gv = gv_fetchpv("File::Temp::tempfile", FALSE, SVt_PVCV);
- GvIMPORTED_CV_on(gv);
- LEAVE;
- }
- if (gv && GvCV(gv)) {
- dSP;
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
- PUTBACK;
- if (call_sv((SV*)GvCV(gv), G_SCALAR)) {
- GV *gv = (GV*)SvRV(newSVsv(*PL_stack_sp--));
-
- if (gv) {
- IO *io = GvIO(gv);
-
- if (io) {
- fd = PerlIO_fileno(IoIFP(io));
- if (fd >= 0)
- f = PerlIO_fdopen(fd, "w+");
- }
- }
- }
- SPAGAIN;
- PUTBACK;
- FREETMPS;
- LEAVE;
- }
-#endif
-
- return f;
-}
-