padop_on_crack.c.inc

   1 /*
   2  * This code was copied from perl/pad.c and perl/op.c and subsequently
   3  * butchered by Lukas Mai (2012).
   4  */
   5 /* vi: set ft=c inde=: */
   6
   7 #define COP_SEQ_RANGE_LOW_set(SV, VAL) \
   8         STMT_START { ((XPVNV*)SvANY(SV))->xnv_u.xpad_cop_seq.xlow = (VAL); } STMT_END
   9 #define COP_SEQ_RANGE_HIGH_set(SV, VAL) \
  10         STMT_START { ((XPVNV*)SvANY(SV))->xnv_u.xpad_cop_seq.xhigh = (VAL); } STMT_END
  11
  12 static void S_pad_block_start(pTHX_ int full) {
  13         dVAR;
  14         ASSERT_CURPAD_ACTIVE("pad_block_start");
  15         SAVEI32(PL_comppad_name_floor);
  16         PL_comppad_name_floor = AvFILLp(PL_comppad_name);
  17         if (full)
  18                 PL_comppad_name_fill = PL_comppad_name_floor;
  19         if (PL_comppad_name_floor < 0)
  20                 PL_comppad_name_floor = 0;
  21         SAVEI32(PL_min_intro_pending);
  22         SAVEI32(PL_max_intro_pending);
  23         PL_min_intro_pending = 0;
  24         SAVEI32(PL_comppad_name_fill);
  25         SAVEI32(PL_padix_floor);
  26         PL_padix_floor = PL_padix;
  27         PL_pad_reset_pending = FALSE;
  28 }
  29
  30 static int S_block_start(pTHX_ int full) {
  31         dVAR;
  32         const int retval = PL_savestack_ix;
  33
  34         S_pad_block_start(aTHX_ full);
  35         SAVEHINTS();
  36         PL_hints &= ~HINT_BLOCK_SCOPE;
  37         SAVECOMPILEWARNINGS();
  38         PL_compiling.cop_warnings = DUP_WARNINGS(PL_compiling.cop_warnings);
  39
  40         CALL_BLOCK_HOOKS(bhk_start, full);
  41
  42         return retval;
  43 }
  44
  45 /* Check for in place reverse and sort assignments like "@a = reverse @a"
  46    and modify the optree to make them work inplace */
  47
  48 static void S_inplace_aassign(pTHX_ OP *o) {
  49         OP *modop, *modop_pushmark;
  50         OP *oright;
  51         OP *oleft, *oleft_pushmark;
  52
  53         assert((o->op_flags & OPf_WANT) == OPf_WANT_VOID);
  54
  55         assert(cUNOPo->op_first->op_type == OP_NULL);
  56         modop_pushmark = cUNOPx(cUNOPo->op_first)->op_first;
  57         assert(modop_pushmark->op_type == OP_PUSHMARK);
  58         modop = modop_pushmark->op_sibling;
  59
  60         if (modop->op_type != OP_SORT && modop->op_type != OP_REVERSE)
  61                 return;
  62
  63         /* no other operation except sort/reverse */
  64         if (modop->op_sibling)
  65                 return;
  66
  67         assert(cUNOPx(modop)->op_first->op_type == OP_PUSHMARK);
  68         if (!(oright = cUNOPx(modop)->op_first->op_sibling)) return;
  69
  70         if (modop->op_flags & OPf_STACKED) {
  71                 /* skip sort subroutine/block */
  72                 assert(oright->op_type == OP_NULL);
  73                 oright = oright->op_sibling;
  74         }
  75
  76         assert(cUNOPo->op_first->op_sibling->op_type == OP_NULL);
  77         oleft_pushmark = cUNOPx(cUNOPo->op_first->op_sibling)->op_first;
  78         assert(oleft_pushmark->op_type == OP_PUSHMARK);
  79         oleft = oleft_pushmark->op_sibling;
  80
  81         /* Check the lhs is an array */
  82         if (!oleft ||
  83                 (oleft->op_type != OP_RV2AV && oleft->op_type != OP_PADAV)
  84                 || oleft->op_sibling
  85                 || (oleft->op_private & OPpLVAL_INTRO)
  86         )
  87                 return;
  88
  89         /* Only one thing on the rhs */
  90         if (oright->op_sibling)
  91                 return;
  92
  93         /* check the array is the same on both sides */
  94         if (oleft->op_type == OP_RV2AV) {
  95                 if (oright->op_type != OP_RV2AV
  96                         || !cUNOPx(oright)->op_first
  97                         || cUNOPx(oright)->op_first->op_type != OP_GV
  98                         || cUNOPx(oleft )->op_first->op_type != OP_GV
  99                         || cGVOPx_gv(cUNOPx(oleft)->op_first) !=
 100                         cGVOPx_gv(cUNOPx(oright)->op_first)
 101                 )
 102                         return;
 103         }
 104         else if (oright->op_type != OP_PADAV
 105                          || oright->op_targ != oleft->op_targ
 106         )
 107                 return;
 108
 109         /* This actually is an inplace assignment */
 110
 111         modop->op_private |= OPpSORT_INPLACE;
 112
 113         /* transfer MODishness etc from LHS arg to RHS arg */
 114         oright->op_flags = oleft->op_flags;
 115
 116         /* remove the aassign op and the lhs */
 117         op_null(o);
 118         op_null(oleft_pushmark);
 119         if (oleft->op_type == OP_RV2AV && cUNOPx(oleft)->op_first)
 120                 op_null(cUNOPx(oleft)->op_first);
 121         op_null(oleft);
 122 }
 123
 124 static OP *S_scalarvoid(pTHX_ OP *);
 125
 126 static OP *S_scalar(pTHX_ OP *o) {
 127         dVAR;
 128         OP *kid;
 129
 130         /* assumes no premature commitment */
 131         if (!o || (PL_parser && PL_parser->error_count)
 132                 || (o->op_flags & OPf_WANT)
 133                 || o->op_type == OP_RETURN)
 134         {
 135                 return o;
 136         }
 137
 138         o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
 139
 140         switch (o->op_type) {
 141                 case OP_REPEAT:
 142                         S_scalar(aTHX_ cBINOPo->op_first);
 143                         break;
 144                 case OP_OR:
 145                 case OP_AND:
 146                 case OP_COND_EXPR:
 147                         for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
 148                                 S_scalar(aTHX_ kid);
 149                         break;
 150                         /* FALL THROUGH */
 151                 case OP_SPLIT:
 152                 case OP_MATCH:
 153                 case OP_QR:
 154                 case OP_SUBST:
 155                 case OP_NULL:
 156                 default:
 157                         if (o->op_flags & OPf_KIDS) {
 158                                 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
 159                                         S_scalar(aTHX_ kid);
 160                         }
 161                         break;
 162                 case OP_LEAVE:
 163                 case OP_LEAVETRY:
 164                         kid = cLISTOPo->op_first;
 165                         S_scalar(aTHX_ kid);
 166                         kid = kid->op_sibling;
 167 do_kids:
 168                         while (kid) {
 169                                 OP *sib = kid->op_sibling;
 170                                 if (sib && kid->op_type != OP_LEAVEWHEN)
 171                                         S_scalarvoid(aTHX_ kid);
 172                                 else
 173                                         S_scalar(aTHX_ kid);
 174                                 kid = sib;
 175                         }
 176                         PL_curcop = &PL_compiling;
 177                         break;
 178                 case OP_SCOPE:
 179                 case OP_LINESEQ:
 180                 case OP_LIST:
 181                         kid = cLISTOPo->op_first;
 182                         goto do_kids;
 183                 case OP_SORT:
 184                         Perl_ck_warner(aTHX_ packWARN(WARN_VOID), "Useless use of sort in scalar context");
 185                         break;
 186         }
 187         return o;
 188 }
 189
 190 static OP *S_scalarkids(pTHX_ OP *o) {
 191     if (o && o->op_flags & OPf_KIDS) {
 192         OP *kid;
 193         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
 194             S_scalar(aTHX_ kid);
 195     }
 196     return o;
 197 }
 198
 199 static OP *S_scalarvoid(pTHX_ OP *o) {
 200         dVAR;
 201         OP *kid;
 202         const char *useless = NULL;
 203         U32 useless_is_utf8 = 0;
 204         SV *sv;
 205         U8 want;
 206
 207         PERL_ARGS_ASSERT_SCALARVOID;
 208
 209         if (
 210                 o->op_type == OP_NEXTSTATE ||
 211                 o->op_type == OP_DBSTATE || (
 212                         o->op_type == OP_NULL && (
 213                                 o->op_targ == OP_NEXTSTATE ||
 214                                 o->op_targ == OP_DBSTATE
 215                         )
 216                 )
 217         ) {
 218                 PL_curcop = (COP*)o;            /* for warning below */
 219         }
 220
 221         /* assumes no premature commitment */
 222         want = o->op_flags & OPf_WANT;
 223         if (
 224                 (want && want != OPf_WANT_SCALAR) ||
 225                 (PL_parser && PL_parser->error_count) ||
 226                 o->op_type == OP_RETURN ||
 227                 o->op_type == OP_REQUIRE ||
 228                 o->op_type == OP_LEAVEWHEN
 229         ) {
 230                 return o;
 231         }
 232
 233         if (
 234                 (o->op_private & OPpTARGET_MY) &&
 235                 (PL_opargs[o->op_type] & OA_TARGLEX)
 236                 /* OPp share the meaning */
 237         ) {
 238                 return S_scalar(aTHX_ o);                       /* As if inside SASSIGN */
 239         }
 240
 241         o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
 242
 243         switch (o->op_type) {
 244                 default:
 245                         if (!(PL_opargs[o->op_type] & OA_FOLDCONST))
 246                                 break;
 247                         /* FALL THROUGH */
 248                 case OP_REPEAT:
 249                         if (o->op_flags & OPf_STACKED)
 250                                 break;
 251                         goto func_ops;
 252                 case OP_SUBSTR:
 253                         if (o->op_private == 4)
 254                                 break;
 255                         /* FALL THROUGH */
 256                 case OP_GVSV:
 257                 case OP_WANTARRAY:
 258                 case OP_GV:
 259                 case OP_SMARTMATCH:
 260                 case OP_PADSV:
 261                 case OP_PADAV:
 262                 case OP_PADHV:
 263                 case OP_PADANY:
 264                 case OP_AV2ARYLEN:
 265                 case OP_REF:
 266                 case OP_REFGEN:
 267                 case OP_SREFGEN:
 268                 case OP_DEFINED:
 269                 case OP_HEX:
 270                 case OP_OCT:
 271                 case OP_LENGTH:
 272                 case OP_VEC:
 273                 case OP_INDEX:
 274                 case OP_RINDEX:
 275                 case OP_SPRINTF:
 276                 case OP_AELEM:
 277                 case OP_AELEMFAST:
 278                 IF_HAVE_PERL_5_16(case OP_AELEMFAST_LEX:, )
 279                 case OP_ASLICE:
 280                 case OP_HELEM:
 281                 case OP_HSLICE:
 282                 case OP_UNPACK:
 283                 case OP_PACK:
 284                 case OP_JOIN:
 285                 case OP_LSLICE:
 286                 case OP_ANONLIST:
 287                 case OP_ANONHASH:
 288                 case OP_SORT:
 289                 case OP_REVERSE:
 290                 case OP_RANGE:
 291                 case OP_FLIP:
 292                 case OP_FLOP:
 293                 case OP_CALLER:
 294                 case OP_FILENO:
 295                 case OP_EOF:
 296                 case OP_TELL:
 297                 case OP_GETSOCKNAME:
 298                 case OP_GETPEERNAME:
 299                 case OP_READLINK:
 300                 case OP_TELLDIR:
 301                 case OP_GETPPID:
 302                 case OP_GETPGRP:
 303                 case OP_GETPRIORITY:
 304                 case OP_TIME:
 305                 case OP_TMS:
 306                 case OP_LOCALTIME:
 307                 case OP_GMTIME:
 308                 case OP_GHBYNAME:
 309                 case OP_GHBYADDR:
 310                 case OP_GHOSTENT:
 311                 case OP_GNBYNAME:
 312                 case OP_GNBYADDR:
 313                 case OP_GNETENT:
 314                 case OP_GPBYNAME:
 315                 case OP_GPBYNUMBER:
 316                 case OP_GPROTOENT:
 317                 case OP_GSBYNAME:
 318                 case OP_GSBYPORT:
 319                 case OP_GSERVENT:
 320                 case OP_GPWNAM:
 321                 case OP_GPWUID:
 322                 case OP_GGRNAM:
 323                 case OP_GGRGID:
 324                 case OP_GETLOGIN:
 325                 case OP_PROTOTYPE:
 326                 IF_HAVE_PERL_5_16(case OP_RUNCV:, )
 327 func_ops:
 328                         if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)))
 329                                 /* Otherwise it's "Useless use of grep iterator" */
 330                                 useless = OP_DESC(o);
 331                         break;
 332
 333                 case OP_SPLIT:
 334                         kid = cLISTOPo->op_first;
 335                         if (kid && kid->op_type == OP_PUSHRE
 336 #ifdef USE_ITHREADS
 337                                 && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetoff)
 338 #else
 339                                 && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetgv)
 340 #endif
 341                                         useless = OP_DESC(o);
 342                         break;
 343
 344                 case OP_NOT:
 345                         kid = cUNOPo->op_first;
 346                         if (kid->op_type != OP_MATCH && kid->op_type != OP_SUBST &&
 347                                 kid->op_type != OP_TRANS && kid->op_type != OP_TRANSR) {
 348                                 goto func_ops;
 349                         }
 350                         useless = "negative pattern binding (!~)";
 351                         break;
 352
 353                 case OP_SUBST:
 354                         if (cPMOPo->op_pmflags & PMf_NONDESTRUCT)
 355                                 useless = "non-destructive substitution (s///r)";
 356                         break;
 357
 358                 case OP_TRANSR:
 359                         useless = "non-destructive transliteration (tr///r)";
 360                         break;
 361
 362                 case OP_RV2GV:
 363                 case OP_RV2SV:
 364                 case OP_RV2AV:
 365                 case OP_RV2HV:
 366                         if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)) &&
 367                                 (!o->op_sibling || o->op_sibling->op_type != OP_READLINE))
 368                                 useless = "a variable";
 369                         break;
 370
 371                 case OP_CONST:
 372                         sv = cSVOPo_sv;
 373                         if (cSVOPo->op_private & OPpCONST_STRICT) {
 374                                 //no_bareword_allowed(o);
 375                                 *((int *)NULL) += 1;
 376                         } else {
 377                                 if (ckWARN(WARN_VOID)) {
 378                                         /* don't warn on optimised away booleans, eg
 379                                          * use constant Foo, 5; Foo || print; */
 380                                         if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT)
 381                                                 useless = NULL;
 382                                         /* the constants 0 and 1 are permitted as they are
 383                                            conventionally used as dummies in constructs like
 384                                            1 while some_condition_with_side_effects;  */
 385                                         else if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
 386                                                 useless = NULL;
 387                                         else if (SvPOK(sv)) {
 388                                                 /* perl4's way of mixing documentation and code
 389                                                    (before the invention of POD) was based on a
 390                                                    trick to mix nroff and perl code. The trick was
 391                                                    built upon these three nroff macros being used in
 392                                                    void context. The pink camel has the details in
 393                                                    the script wrapman near page 319. */
 394                                                 const char * const maybe_macro = SvPVX_const(sv);
 395                                                 if (strnEQ(maybe_macro, "di", 2) ||
 396                                                         strnEQ(maybe_macro, "ds", 2) ||
 397                                                         strnEQ(maybe_macro, "ig", 2))
 398                                                         useless = NULL;
 399                                                 else {
 400                                                         SV * const dsv = newSVpvs("");
 401                                                         SV* msv = sv_2mortal(Perl_newSVpvf(aTHX_
 402                                                                                                                            "a constant (%s)",
 403                                                                                                                            pv_pretty(dsv, maybe_macro, SvCUR(sv), 32, NULL, NULL,
 404                                                                                                                                                  PERL_PV_PRETTY_DUMP | PERL_PV_ESCAPE_NOCLEAR | PERL_PV_ESCAPE_UNI_DETECT )));
 405                                                         SvREFCNT_dec(dsv);
 406                                                         useless = SvPV_nolen(msv);
 407                                                         useless_is_utf8 = SvUTF8(msv);
 408                                                 }
 409                                         }
 410                                         else if (SvOK(sv)) {
 411                                                 SV* msv = sv_2mortal(Perl_newSVpvf(aTHX_
 412                                                                                                                    "a constant (%"SVf")", sv));
 413                                                 useless = SvPV_nolen(msv);
 414                                         }
 415                                         else
 416                                                 useless = "a constant (undef)";
 417                                 }
 418                         }
 419                         op_null(o);             /* don't execute or even remember it */
 420                         break;
 421
 422                 case OP_POSTINC:
 423                         o->op_type = OP_PREINC;         /* pre-increment is faster */
 424                         o->op_ppaddr = PL_ppaddr[OP_PREINC];
 425                         break;
 426
 427                 case OP_POSTDEC:
 428                         o->op_type = OP_PREDEC;         /* pre-decrement is faster */
 429                         o->op_ppaddr = PL_ppaddr[OP_PREDEC];
 430                         break;
 431
 432                 case OP_I_POSTINC:
 433                         o->op_type = OP_I_PREINC;       /* pre-increment is faster */
 434                         o->op_ppaddr = PL_ppaddr[OP_I_PREINC];
 435                         break;
 436
 437                 case OP_I_POSTDEC:
 438                         o->op_type = OP_I_PREDEC;       /* pre-decrement is faster */
 439                         o->op_ppaddr = PL_ppaddr[OP_I_PREDEC];
 440                         break;
 441
 442                 case OP_SASSIGN: {
 443                         OP *rv2gv;
 444                         UNOP *refgen, *rv2cv;
 445                         LISTOP *exlist;
 446
 447                         if ((o->op_private & ~OPpASSIGN_BACKWARDS) != 2)
 448                                 break;
 449
 450                         rv2gv = ((BINOP *)o)->op_last;
 451                         if (!rv2gv || rv2gv->op_type != OP_RV2GV)
 452                                 break;
 453
 454                         refgen = (UNOP *)((BINOP *)o)->op_first;
 455
 456                         if (!refgen || refgen->op_type != OP_REFGEN)
 457                                 break;
 458
 459                         exlist = (LISTOP *)refgen->op_first;
 460                         if (!exlist || exlist->op_type != OP_NULL
 461                                 || exlist->op_targ != OP_LIST)
 462                                 break;
 463
 464                         if (exlist->op_first->op_type != OP_PUSHMARK)
 465                                 break;
 466
 467                         rv2cv = (UNOP*)exlist->op_last;
 468
 469                         if (rv2cv->op_type != OP_RV2CV)
 470                                 break;
 471
 472                         assert ((rv2gv->op_private & OPpDONT_INIT_GV) == 0);
 473                         assert ((o->op_private & OPpASSIGN_CV_TO_GV) == 0);
 474                         assert ((rv2cv->op_private & OPpMAY_RETURN_CONSTANT) == 0);
 475
 476                         o->op_private |= OPpASSIGN_CV_TO_GV;
 477                         rv2gv->op_private |= OPpDONT_INIT_GV;
 478                         rv2cv->op_private |= OPpMAY_RETURN_CONSTANT;
 479
 480                         break;
 481                 }
 482
 483                 case OP_AASSIGN: {
 484                         S_inplace_aassign(aTHX_ o);
 485                         break;
 486                 }
 487
 488                 case OP_OR:
 489                 case OP_AND:
 490                         kid = cLOGOPo->op_first;
 491                         if (kid->op_type == OP_NOT
 492                                 && (kid->op_flags & OPf_KIDS)
 493                                 && !PL_madskills) {
 494                                 if (o->op_type == OP_AND) {
 495                                         o->op_type = OP_OR;
 496                                         o->op_ppaddr = PL_ppaddr[OP_OR];
 497                                 } else {
 498                                         o->op_type = OP_AND;
 499                                         o->op_ppaddr = PL_ppaddr[OP_AND];
 500                                 }
 501                                 op_null(kid);
 502                         }
 503
 504                 case OP_DOR:
 505                 case OP_COND_EXPR:
 506                 case OP_ENTERGIVEN:
 507                 case OP_ENTERWHEN:
 508                         for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
 509                                 S_scalarvoid(aTHX_ kid);
 510                         break;
 511
 512                 case OP_NULL:
 513                         if (o->op_flags & OPf_STACKED)
 514                                 break;
 515                         /* FALL THROUGH */
 516                 case OP_NEXTSTATE:
 517                 case OP_DBSTATE:
 518                 case OP_ENTERTRY:
 519                 case OP_ENTER:
 520                         if (!(o->op_flags & OPf_KIDS))
 521                                 break;
 522                         /* FALL THROUGH */
 523                 case OP_SCOPE:
 524                 case OP_LEAVE:
 525                 case OP_LEAVETRY:
 526                 case OP_LEAVELOOP:
 527                 case OP_LINESEQ:
 528                 case OP_LIST:
 529                 case OP_LEAVEGIVEN:
 530                 case OP_LEAVEWHEN:
 531                         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
 532                                 S_scalarvoid(aTHX_ kid);
 533                         break;
 534                 case OP_ENTEREVAL:
 535                         S_scalarkids(aTHX_ o);
 536                         break;
 537                 case OP_SCALAR:
 538                         return S_scalar(aTHX_ o);
 539         }
 540         if (useless)
 541                 Perl_ck_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %"SVf" in void context",
 542                                            newSVpvn_flags(useless, strlen(useless),
 543                                                                           SVs_TEMP | ( useless_is_utf8 ? SVf_UTF8 : 0 )));
 544         return o;
 545 }
 546
 547 static OP *S_scalarseq(pTHX_ OP *o) {
 548         dVAR;
 549         if (o) {
 550                 const OPCODE type = o->op_type;
 551
 552                 if (type == OP_LINESEQ || type == OP_SCOPE ||
 553                     type == OP_LEAVE || type == OP_LEAVETRY)
 554                 {
 555                         OP *kid;
 556                         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
 557                                 if (kid->op_sibling) {
 558                                         S_scalarvoid(aTHX_ kid);
 559                                 }
 560                         }
 561                         PL_curcop = &PL_compiling;
 562                 }
 563                 o->op_flags &= ~OPf_PARENS;
 564                 if (PL_hints & HINT_BLOCK_SCOPE)
 565                         o->op_flags |= OPf_PARENS;
 566         }
 567         else
 568                 o = newOP(OP_STUB, 0);
 569         return o;
 570 }
 571
 572 static void S_pad_leavemy(pTHX) {
 573         dVAR;
 574         I32 off;
 575         SV * const * const svp = AvARRAY(PL_comppad_name);
 576
 577         PL_pad_reset_pending = FALSE;
 578
 579         ASSERT_CURPAD_ACTIVE("pad_leavemy");
 580         if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
 581                 for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
 582                         const SV * const sv = svp[off];
 583                         if (sv && sv != &PL_sv_undef && !SvFAKE(sv))
 584                                 Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
 585                                                                  "%"SVf" never introduced",
 586                                                                  SVfARG(sv));
 587                 }
 588         }
 589         /* "Deintroduce" my variables that are leaving with this scope. */
 590         for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
 591                 const SV * const sv = svp[off];
 592                 if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
 593                         && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
 594                 {
 595                         COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);
 596                         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 597                                                                    "Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
 598                                                                    (long)off, SvPVX_const(sv),
 599                                                                    (unsigned long)COP_SEQ_RANGE_LOW(sv),
 600                                                                    (unsigned long)COP_SEQ_RANGE_HIGH(sv))
 601                         );
 602                 }
 603         }
 604         PL_cop_seqmax++;
 605         if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
 606                 PL_cop_seqmax++;
 607         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 608                                                    "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
 609 }
 610
 611 static OP *S_block_end(pTHX_ I32 floor, OP *seq) {
 612         dVAR;
 613         const int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
 614         OP *retval = S_scalarseq(aTHX_ seq);
 615
 616         CALL_BLOCK_HOOKS(bhk_pre_end, &retval);
 617
 618         LEAVE_SCOPE(floor);
 619         CopHINTS_set(&PL_compiling, PL_hints);
 620         if (needblockscope)
 621                 PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
 622         S_pad_leavemy(aTHX);
 623
 624         CALL_BLOCK_HOOKS(bhk_post_end, &retval);
 625
 626         return retval;
 627 }
 628
 629
 630 #ifndef pad_alloc
 631
 632 #define pad_alloc(OPTYPE, TMPTYPE) \
 633         S_pad_alloc(aTHX_ OPTYPE, TMPTYPE)
 634
 635 static PADOFFSET S_pad_alloc(pTHX_ I32 optype, U32 tmptype) {
 636         dVAR;
 637         SV *sv;
 638         I32 retval;
 639
 640         PERL_UNUSED_ARG(optype);
 641         ASSERT_CURPAD_ACTIVE("pad_alloc");
 642
 643         if (AvARRAY(PL_comppad) != PL_curpad)
 644                 Perl_croak(aTHX_ "panic: pad_alloc");
 645         PL_pad_reset_pending = FALSE;
 646         if (tmptype & SVs_PADMY) {
 647                 sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
 648                 retval = AvFILLp(PL_comppad);
 649         }
 650         else {
 651                 SV * const * const names = AvARRAY(PL_comppad_name);
 652                 const SSize_t names_fill = AvFILLp(PL_comppad_name);
 653                 for (;;) {
 654                         /*
 655                          * "foreach" index vars temporarily become aliases to non-"my"
 656                          * values.  Thus we must skip, not just pad values that are
 657                          * marked as current pad values, but also those with names.
 658                          */
 659                         /* HVDS why copy to sv here? we don't seem to use it */
 660                         if (++PL_padix <= names_fill &&
 661                                 (sv = names[PL_padix]) && sv != &PL_sv_undef)
 662                                 continue;
 663                         sv = *av_fetch(PL_comppad, PL_padix, TRUE);
 664                         if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
 665                                 !IS_PADGV(sv) && !IS_PADCONST(sv))
 666                                 break;
 667                 }
 668                 retval = PL_padix;
 669         }
 670         SvFLAGS(sv) |= tmptype;
 671         PL_curpad = AvARRAY(PL_comppad);
 672
 673         DEBUG_X(PerlIO_printf(Perl_debug_log,
 674                                                   "Pad 0x%"UVxf"[0x%"UVxf"] alloc:   %ld for %s\n",
 675                                                   PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
 676                                                   PL_op_name[optype]));
 677 #ifdef DEBUG_LEAKING_SCALARS
 678         sv->sv_debug_optype = optype;
 679         sv->sv_debug_inpad = 1;
 680 #endif
 681         return (PADOFFSET)retval;
 682 }
 683
 684 #endif
 685
 686
 687 #ifndef pad_add_name_pvs
 688 #define pad_add_name_pvs(NAME, FLAGS, TYPESTASH, OURSTASH) S_pad_add_name_pvn(aTHX_ "" NAME "", sizeof NAME - 1, FLAGS, TYPESTASH, OURSTASH)
 689 #endif
 690
 691 #ifndef pad_add_name_sv
 692
 693 #define pad_add_name_sv(NAMESV, FLAGS, TYPESTASH, OURSTASH) \
 694         S_pad_add_name_sv(aTHX_ NAMESV, FLAGS, TYPESTASH, OURSTASH)
 695
 696 static PADOFFSET S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash) {
 697         dVAR;
 698         const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
 699
 700         assert(flags == 0);
 701
 702         ASSERT_CURPAD_ACTIVE("pad_alloc_name");
 703
 704         if (typestash) {
 705                 assert(SvTYPE(namesv) == SVt_PVMG);
 706                 SvPAD_TYPED_on(namesv);
 707                 SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
 708         }
 709         if (ourstash) {
 710                 SvPAD_OUR_on(namesv);
 711                 SvOURSTASH_set(namesv, ourstash);
 712                 SvREFCNT_inc_simple_void_NN(ourstash);
 713         }
 714
 715         av_store(PL_comppad_name, offset, namesv);
 716         return offset;
 717 }
 718
 719 static PADOFFSET S_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags, HV *typestash, HV *ourstash) {
 720         dVAR;
 721         PADOFFSET offset;
 722         SV *namesv;
 723
 724         assert(flags == 0);
 725
 726         namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
 727
 728         sv_setpvn(namesv, namepv, namelen);
 729
 730         offset = S_pad_alloc_name(aTHX_ namesv, flags, typestash, ourstash);
 731
 732         /* not yet introduced */
 733         COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
 734         COP_SEQ_RANGE_HIGH_set(namesv, 0);
 735
 736         if (!PL_min_intro_pending)
 737                 PL_min_intro_pending = offset;
 738         PL_max_intro_pending = offset;
 739         /* if it's not a simple scalar, replace with an AV or HV */
 740         assert(SvTYPE(PL_curpad[offset]) == SVt_NULL);
 741         assert(SvREFCNT(PL_curpad[offset]) == 1);
 742         if (namelen != 0 && *namepv == '@')
 743                 sv_upgrade(PL_curpad[offset], SVt_PVAV);
 744         else if (namelen != 0 && *namepv == '%')
 745                 sv_upgrade(PL_curpad[offset], SVt_PVHV);
 746         assert(SvPADMY(PL_curpad[offset]));
 747         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 748                                                    "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
 749                                                    (long)offset, SvPVX(namesv),
 750                                                    PTR2UV(PL_curpad[offset])));
 751
 752         return offset;
 753 }
 754
 755 static PADOFFSET S_pad_add_name_sv(pTHX_ SV *name, U32 flags, HV *typestash, HV *ourstash) {
 756         char *namepv;
 757         STRLEN namelen;
 758         assert(flags == 0);
 759         namepv = SvPV(name, namelen);
 760         return S_pad_add_name_pvn(aTHX_ namepv, namelen, flags, typestash, ourstash);
 761 }
 762
 763 #endif
 764
 765 #ifndef pad_findmy_sv
 766
 767 #define pad_findmy_sv(SV, FLAGS) \
 768         S_pad_findmy(aTHX_ SvPV_nolen(SV), FLAGS)
 769
 770 #define PARENT_PAD_INDEX_set(SV, VAL) \
 771         STMT_START { ((XPVNV*)SvANY(SV))->xnv_u.xpad_cop_seq.xlow = (VAL); } STMT_END
 772 #define PARENT_FAKELEX_FLAGS_set(SV, VAL) \
 773         STMT_START { ((XPVNV*)SvANY(SV))->xnv_u.xpad_cop_seq.xhigh = (VAL); } STMT_END
 774
 775 static PADOFFSET S_pad_findlex(pTHX_ const char *name, const CV *cv, U32 seq, int warn, SV **out_capture, SV **out_name_sv, int *out_flags) {
 776 #define CvCOMPILED(CV) CvROOT(CV)
 777 #define CvLATE(CV) (CvANON(CV) || SvTYPE(CV) == SVt_PVFM)
 778         dVAR;
 779         I32 offset, new_offset;
 780         SV *new_capture;
 781         SV **new_capturep;
 782         const AV *const padlist = CvPADLIST(cv);
 783
 784         *out_flags = 0;
 785
 786         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 787                                                    "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
 788                                                    PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
 789
 790         /* first, search this pad */
 791
 792         if (padlist) { /* not an undef CV */
 793                 I32 fake_offset = 0;
 794                 const AV * const nameav = MUTABLE_AV(AvARRAY(padlist)[0]);
 795                 SV * const * const name_svp = AvARRAY(nameav);
 796
 797                 for (offset = AvFILLp(nameav); offset > 0; offset--) {
 798                         const SV * const namesv = name_svp[offset];
 799                         if (namesv && namesv != &PL_sv_undef
 800                                 && strEQ(SvPVX_const(namesv), name))
 801                         {
 802                                 if (SvFAKE(namesv)) {
 803                                         fake_offset = offset; /* in case we don't find a real one */
 804                                         continue;
 805                                 }
 806                                 /* is seq within the range _LOW to _HIGH ?
 807                                  * This is complicated by the fact that PL_cop_seqmax
 808                                  * may have wrapped around at some point */
 809                                 if (COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO)
 810                                         continue; /* not yet introduced */
 811
 812                                 if (COP_SEQ_RANGE_HIGH(namesv) == PERL_PADSEQ_INTRO) {
 813                                         /* in compiling scope */
 814                                         if (
 815                                                 (seq >  COP_SEQ_RANGE_LOW(namesv))
 816                                                 ? (seq - COP_SEQ_RANGE_LOW(namesv) < (U32_MAX >> 1))
 817                                                 : (COP_SEQ_RANGE_LOW(namesv) - seq > (U32_MAX >> 1))
 818                                         )
 819                                                 break;
 820                                 }
 821                                 else if (
 822                                         (COP_SEQ_RANGE_LOW(namesv) > COP_SEQ_RANGE_HIGH(namesv))
 823                                         ?
 824                                         (  seq >  COP_SEQ_RANGE_LOW(namesv)
 825                                            || seq <= COP_SEQ_RANGE_HIGH(namesv))
 826
 827                                         :    (  seq >  COP_SEQ_RANGE_LOW(namesv)
 828                                                         && seq <= COP_SEQ_RANGE_HIGH(namesv))
 829                                 )
 830                                         break;
 831                         }
 832                 }
 833
 834                 if (offset > 0 || fake_offset > 0 ) { /* a match! */
 835                         if (offset > 0) { /* not fake */
 836                                 fake_offset = 0;
 837                                 *out_name_sv = name_svp[offset]; /* return the namesv */
 838
 839                                 /* set PAD_FAKELEX_MULTI if this lex can have multiple
 840                                  * instances. For now, we just test !CvUNIQUE(cv), but
 841                                  * ideally, we should detect my's declared within loops
 842                                  * etc - this would allow a wider range of 'not stayed
 843                                  * shared' warnings. We also treated already-compiled
 844                                  * lexes as not multi as viewed from evals. */
 845
 846                                 *out_flags = CvANON(cv) ?
 847                                         PAD_FAKELEX_ANON :
 848                                         (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
 849                                         ? PAD_FAKELEX_MULTI : 0;
 850
 851                                 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 852                                                                            "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n",
 853                                                                            PTR2UV(cv), (long)offset,
 854                                                                            (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv),
 855                                                                            (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv)));
 856                         }
 857                         else { /* fake match */
 858                                 offset = fake_offset;
 859                                 *out_name_sv = name_svp[offset]; /* return the namesv */
 860                                 *out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv);
 861                                 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 862                                                                            "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
 863                                                                            PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
 864                                                                            (unsigned long) PARENT_PAD_INDEX(*out_name_sv)
 865                                 ));
 866                         }
 867
 868                         /* return the lex? */
 869
 870                         if (out_capture) {
 871
 872                                 /* our ? */
 873                                 if (SvPAD_OUR(*out_name_sv)) {
 874                                         *out_capture = NULL;
 875                                         return offset;
 876                                 }
 877
 878                                 /* trying to capture from an anon prototype? */
 879                                 if (CvCOMPILED(cv)
 880                                         ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
 881                                         : *out_flags & PAD_FAKELEX_ANON)
 882                                 {
 883                                         if (warn)
 884                                                 Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
 885                                                                            "Variable \"%s\" is not available", name);
 886                                         *out_capture = NULL;
 887                                 }
 888
 889                                 /* real value */
 890                                 else {
 891                                         int newwarn = warn;
 892                                         if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
 893                                                 && !SvPAD_STATE(name_svp[offset])
 894                                                 && warn && ckWARN(WARN_CLOSURE)) {
 895                                                 newwarn = 0;
 896                                                 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
 897                                                                         "Variable \"%s\" will not stay shared", name);
 898                                         }
 899
 900                                         if (fake_offset && CvANON(cv)
 901                                                 && CvCLONE(cv) &&!CvCLONED(cv))
 902                                         {
 903                                                 SV *n;
 904                                                 /* not yet caught - look further up */
 905                                                 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 906                                                                                            "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
 907                                                                                            PTR2UV(cv)));
 908                                                 n = *out_name_sv;
 909                                                 (void)S_pad_findlex(aTHX_ name, CvOUTSIDE(cv),
 910                                                                                         CvOUTSIDE_SEQ(cv),
 911                                                                                         newwarn, out_capture, out_name_sv, out_flags);
 912                                                 *out_name_sv = n;
 913                                                 return offset;
 914                                         }
 915
 916                                         *out_capture = AvARRAY(MUTABLE_AV(AvARRAY(padlist)[
 917                                                                                                           CvDEPTH(cv) ? CvDEPTH(cv) : 1]))[offset];
 918                                         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 919                                                                                    "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
 920                                                                                    PTR2UV(cv), PTR2UV(*out_capture)));
 921
 922                                         if (SvPADSTALE(*out_capture)
 923                                                 && !SvPAD_STATE(name_svp[offset]))
 924                                         {
 925                                                 Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
 926                                                                            "Variable \"%s\" is not available", name);
 927                                                 *out_capture = NULL;
 928                                         }
 929                                 }
 930                                 if (!*out_capture) {
 931                                         if (*name == '@')
 932                                                 *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
 933                                         else if (*name == '%')
 934                                                 *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
 935                                         else
 936                                                 *out_capture = sv_newmortal();
 937                                 }
 938                         }
 939
 940                         return offset;
 941                 }
 942         }
 943
 944         /* it's not in this pad - try above */
 945
 946         if (!CvOUTSIDE(cv))
 947                 return NOT_IN_PAD;
 948
 949         /* out_capture non-null means caller wants us to capture lex; in
 950          * addition we capture ourselves unless it's an ANON/format */
 951         new_capturep = out_capture ? out_capture :
 952                 CvLATE(cv) ? NULL : &new_capture;
 953
 954         offset = S_pad_findlex(aTHX_ name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
 955                                                    new_capturep, out_name_sv, out_flags);
 956         if ((PADOFFSET)offset == NOT_IN_PAD)
 957                 return NOT_IN_PAD;
 958
 959         /* found in an outer CV. Add appropriate fake entry to this pad */
 960
 961         /* don't add new fake entries (via eval) to CVs that we have already
 962          * finished compiling, or to undef CVs */
 963         if (CvCOMPILED(cv) || !padlist)
 964                 return 0; /* this dummy (and invalid) value isnt used by the caller */
 965
 966         {
 967                 /* This relies on sv_setsv_flags() upgrading the destination to the same
 968                    type as the source, independent of the flags set, and on it being
 969                    "good" and only copying flag bits and pointers that it understands.
 970                    */
 971                 SV *new_namesv = newSVsv(*out_name_sv);
 972                 AV *  const ocomppad_name = PL_comppad_name;
 973                 PAD * const ocomppad = PL_comppad;
 974                 PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
 975                 PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
 976                 PL_curpad = AvARRAY(PL_comppad);
 977
 978                 new_offset
 979                         = pad_add_name_sv(new_namesv,
 980                                                           0,
 981                                                           SvPAD_TYPED(*out_name_sv)
 982                                                           ? SvSTASH(*out_name_sv) : NULL,
 983                                                           SvOURSTASH(*out_name_sv)
 984                         );
 985
 986                 SvFAKE_on(new_namesv);
 987                 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 988                                                            "Pad addname: %ld \"%.*s\" FAKE\n",
 989                                                            (long)new_offset,
 990                                                            (int) SvCUR(new_namesv), SvPVX(new_namesv)));
 991                 PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
 992
 993                 PARENT_PAD_INDEX_set(new_namesv, 0);
 994                 if (SvPAD_OUR(new_namesv)) {
 995                         NOOP;   /* do nothing */
 996                 }
 997                 else if (CvLATE(cv)) {
 998                         /* delayed creation - just note the offset within parent pad */
 999                         PARENT_PAD_INDEX_set(new_namesv, offset);
1000                         CvCLONE_on(cv);
1001                 }
1002                 else {
1003                         /* immediate creation - capture outer value right now */
1004                         av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
1005                         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1006                                                                    "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
1007                                                                    PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
1008                 }
1009                 *out_name_sv = new_namesv;
1010                 *out_flags = PARENT_FAKELEX_FLAGS(new_namesv);
1011
1012                 PL_comppad_name = ocomppad_name;
1013                 PL_comppad = ocomppad;
1014                 PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;
1015         }
1016         return new_offset;
1017 #undef CvLATE
1018 #undef CvCOMPILED
1019 }
1020
1021 static PADOFFSET S_pad_findmy(pTHX_ const char *name, U32 flags) {
1022         dVAR;
1023         SV *out_sv;
1024         int out_flags;
1025         I32 offset;
1026         const AV *nameav;
1027         SV **name_svp;
1028
1029         offset = S_pad_findlex(aTHX_ name, PL_compcv, PL_cop_seqmax, 1,
1030                                                    NULL, &out_sv, &out_flags);
1031         if ((PADOFFSET)offset != NOT_IN_PAD)
1032                 return offset;
1033
1034         /* look for an our that's being introduced; this allows
1035          *    our $foo = 0 unless defined $foo;
1036          * to not give a warning. (Yes, this is a hack) */
1037
1038         nameav = MUTABLE_AV(AvARRAY(CvPADLIST(PL_compcv))[0]);
1039         name_svp = AvARRAY(nameav);
1040         for (offset = AvFILLp(nameav); offset > 0; offset--) {
1041                 const SV * const namesv = name_svp[offset];
1042                 if (namesv && namesv != &PL_sv_undef
1043                         && !SvFAKE(namesv)
1044                         && (SvPAD_OUR(namesv))
1045                         && strEQ(SvPVX_const(namesv), name)
1046                         && COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO
1047                 )
1048                         return offset;
1049         }
1050         return NOT_IN_PAD;
1051 }
1052
1053 #endif
1054
1055 #ifndef pad_findmy_pvs
1056   #define pad_findmy_pvs(S, FLAGS) S_pad_findmy(aTHX_ "" S "", FLAGS)
1057 #endif
1058
1059 static OP *S_newDEFSVOP(pTHX) {
1060         dVAR;
1061         const PADOFFSET offset = pad_findmy_pvs("$_", 0);
1062         if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
1063                 return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
1064         }
1065         else {
1066                 OP * const o = newOP(OP_PADSV, 0);
1067                 o->op_targ = offset;
1068                 return o;
1069         }
1070 }
1071
1072 static U32 S_intro_my(pTHX) {
1073         dVAR;
1074         SV **svp;
1075         I32 i;
1076         U32 seq;
1077
1078         ASSERT_CURPAD_ACTIVE("intro_my");
1079         if (!PL_min_intro_pending)
1080                 return PL_cop_seqmax;
1081
1082         svp = AvARRAY(PL_comppad_name);
1083         for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
1084                 SV *const sv = svp[i];
1085
1086                 if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
1087                     && COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO)
1088                 {
1089                         COP_SEQ_RANGE_HIGH_set(sv, PERL_PADSEQ_INTRO); /* Don't know scope end yet. */
1090                         COP_SEQ_RANGE_LOW_set(sv, PL_cop_seqmax);
1091                         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1092                                                "Pad intromy: %ld \"%s\", (%lu,%lu)\n",
1093                                                (long)i, SvPVX_const(sv),
1094                                                (unsigned long)COP_SEQ_RANGE_LOW(sv),
1095                                                (unsigned long)COP_SEQ_RANGE_HIGH(sv))
1096                         );
1097                 }
1098         }
1099         seq = PL_cop_seqmax;
1100         PL_cop_seqmax++;
1101         if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
1102                 PL_cop_seqmax++;
1103         PL_min_intro_pending = 0;
1104         PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
1105         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1106                                "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax)));
1107
1108         return seq;
1109 }