Parameters.xs

   1 /*
   2 Copyright 2012 Lukas Mai.
   3
   4 This program is free software; you can redistribute it and/or modify it
   5 under the terms of either: the GNU General Public License as published
   6 by the Free Software Foundation; or the Artistic License.
   7
   8 See http://dev.perl.org/licenses/ for more information.
   9  */
  10
  11 #ifdef __GNUC__
  12  #if (__GNUC__ == 4 && __GNUC_MINOR__ >= 6) || __GNUC__ >= 5
  13   #define PRAGMA_GCC_(X) _Pragma(#X)
  14   #define PRAGMA_GCC(X) PRAGMA_GCC_(GCC X)
  15  #endif
  16 #endif
  17
  18 #ifndef PRAGMA_GCC
  19  #define PRAGMA_GCC(X)
  20 #endif
  21
  22 #ifdef DEVEL
  23  #define WARNINGS_RESET PRAGMA_GCC(diagnostic pop)
  24  #define WARNINGS_ENABLEW(X) PRAGMA_GCC(diagnostic warning #X)
  25  #define WARNINGS_ENABLE \
  26         WARNINGS_ENABLEW(-Wall) \
  27         WARNINGS_ENABLEW(-Wextra) \
  28         WARNINGS_ENABLEW(-Wundef) \
  29         /* WARNINGS_ENABLEW(-Wshadow) :-( */ \
  30         WARNINGS_ENABLEW(-Wbad-function-cast) \
  31         WARNINGS_ENABLEW(-Wcast-align) \
  32         WARNINGS_ENABLEW(-Wwrite-strings) \
  33         /* WARNINGS_ENABLEW(-Wnested-externs) wtf? */ \
  34         WARNINGS_ENABLEW(-Wstrict-prototypes) \
  35         WARNINGS_ENABLEW(-Wmissing-prototypes) \
  36         WARNINGS_ENABLEW(-Winline) \
  37         WARNINGS_ENABLEW(-Wdisabled-optimization)
  38
  39 #else
  40  #define WARNINGS_RESET
  41  #define WARNINGS_ENABLE
  42 #endif
  43
  44
  45 #define PERL_NO_GET_CONTEXT
  46 #include "EXTERN.h"
  47 #include "perl.h"
  48 #include "XSUB.h"
  49
  50 #include <string.h>
  51
  52
  53 WARNINGS_ENABLE
  54
  55
  56 #define HAVE_PERL_VERSION(R, V, S) \
  57         (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
  58
  59 #if HAVE_PERL_VERSION(5, 16, 0)
  60  #define IF_HAVE_PERL_5_16(YES, NO) YES
  61 #else
  62  #define IF_HAVE_PERL_5_16(YES, NO) NO
  63 #endif
  64
  65 #if 0
  66  #if HAVE_PERL_VERSION(5, 17, 6)
  67   #error "internal error: missing definition of KEY_my (your perl is too new)"
  68  #elif HAVE_PERL_VERSION(5, 15, 8)
  69   #define S_KEY_my 134
  70  #elif HAVE_PERL_VERSION(5, 15, 6)
  71   #define S_KEY_my 133
  72  #elif HAVE_PERL_VERSION(5, 15, 5)
  73   #define S_KEY_my 132
  74  #elif HAVE_PERL_VERSION(5, 13, 0)
  75   #define S_KEY_my 131
  76  #else
  77   #error "internal error: missing definition of KEY_my (your perl is too old)"
  78  #endif
  79 #endif
  80
  81
  82 #define MY_PKG "Function::Parameters"
  83
  84 #define HINTK_KEYWORDS MY_PKG "/keywords"
  85 #define HINTK_FLAGS_   MY_PKG "/flags:"
  86 #define HINTK_SHIFT_   MY_PKG "/shift:"
  87 #define HINTK_ATTRS_   MY_PKG "/attrs:"
  88
  89 #define DEFSTRUCT(T) typedef struct T T; struct T
  90
  91 #define UV_BITS (sizeof (UV) * CHAR_BIT)
  92
  93 enum {
  94         FLAG_NAME_OK      = 0x01,
  95         FLAG_ANON_OK      = 0x02,
  96         FLAG_DEFAULT_ARGS = 0x04,
  97         FLAG_CHECK_NARGS  = 0x08,
  98         FLAG_INVOCANT     = 0x10,
  99         FLAG_NAMED_PARAMS = 0x20
 100 };
 101
 102 DEFSTRUCT(KWSpec) {
 103         unsigned flags;
 104         SV *shift;
 105         SV *attrs;
 106 };
 107
 108 static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
 109
 110 static int kw_flags(pTHX_ const char *kw_ptr, STRLEN kw_len, KWSpec *spec) {
 111         HV *hints;
 112         SV *sv, **psv;
 113         const char *p, *kw_active;
 114         STRLEN kw_active_len;
 115
 116         spec->flags = 0;
 117         spec->shift = sv_2mortal(newSVpvs(""));
 118         spec->attrs = sv_2mortal(newSVpvs(""));
 119
 120         if (!(hints = GvHV(PL_hintgv))) {
 121                 return FALSE;
 122         }
 123         if (!(psv = hv_fetchs(hints, HINTK_KEYWORDS, 0))) {
 124                 return FALSE;
 125         }
 126         sv = *psv;
 127         kw_active = SvPV(sv, kw_active_len);
 128         if (kw_active_len <= kw_len) {
 129                 return FALSE;
 130         }
 131         for (
 132                 p = kw_active;
 133                 (p = strchr(p, *kw_ptr)) &&
 134                 p < kw_active + kw_active_len - kw_len;
 135                 p++
 136         ) {
 137                 if (
 138                         (p == kw_active || p[-1] == ' ') &&
 139                         p[kw_len] == ' ' &&
 140                         memcmp(kw_ptr, p, kw_len) == 0
 141                 ) {
 142
 143 #define FETCH_HINTK_INTO(NAME, PTR, LEN, X) STMT_START { \
 144         const char *fk_ptr_; \
 145         STRLEN fk_len_; \
 146         SV *fk_sv_; \
 147         fk_sv_ = sv_2mortal(newSVpvs(HINTK_ ## NAME)); \
 148         sv_catpvn(fk_sv_, PTR, LEN); \
 149         fk_ptr_ = SvPV(fk_sv_, fk_len_); \
 150         if (!((X) = hv_fetch(hints, fk_ptr_, fk_len_, 0))) { \
 151                 croak("%s: internal error: $^H{'%.*s'} not set", MY_PKG, (int)fk_len_, fk_ptr_); \
 152         } \
 153 } STMT_END
 154
 155                         FETCH_HINTK_INTO(FLAGS_, kw_ptr, kw_len, psv);
 156                         spec->flags = SvIV(*psv);
 157
 158                         FETCH_HINTK_INTO(SHIFT_, kw_ptr, kw_len, psv);
 159                         SvSetSV(spec->shift, *psv);
 160
 161                         FETCH_HINTK_INTO(ATTRS_, kw_ptr, kw_len, psv);
 162                         SvSetSV(spec->attrs, *psv);
 163
 164 #undef FETCH_HINTK_INTO
 165                         return TRUE;
 166                 }
 167         }
 168         return FALSE;
 169 }
 170
 171
 172 static void free_ptr_op(pTHX_ void *vp) {
 173         OP **pp = vp;
 174         op_free(*pp);
 175         Safefree(pp);
 176 }
 177
 178 #define sv_eq_pvs(SV, S) my_sv_eq_pvn(aTHX_ SV, "" S "", sizeof (S) - 1)
 179
 180 static int my_sv_eq_pvn(pTHX_ SV *sv, const char *p, STRLEN n) {
 181         STRLEN sv_len;
 182         const char *sv_p = SvPV(sv, sv_len);
 183         return memcmp(sv_p, p, n) == 0;
 184 }
 185
 186
 187 #include "padop_on_crack.c.inc"
 188
 189
 190 enum {
 191         MY_ATTR_LVALUE = 0x01,
 192         MY_ATTR_METHOD = 0x02,
 193         MY_ATTR_SPECIAL = 0x04
 194 };
 195
 196 static void my_sv_cat_c(pTHX_ SV *sv, U32 c) {
 197         char ds[UTF8_MAXBYTES + 1], *d;
 198         d = uvchr_to_utf8(ds, c);
 199         if (d - ds > 1) {
 200                 sv_utf8_upgrade(sv);
 201         }
 202         sv_catpvn(sv, ds, d - ds);
 203 }
 204
 205 static bool my_is_uni_xidfirst(pTHX_ UV c) {
 206         U8 tmpbuf[UTF8_MAXBYTES + 1];
 207         uvchr_to_utf8(tmpbuf, c);
 208         return is_utf8_xidfirst(tmpbuf);
 209 }
 210
 211 static bool my_is_uni_xidcont(pTHX_ UV c) {
 212         U8 tmpbuf[UTF8_MAXBYTES + 1];
 213         uvchr_to_utf8(tmpbuf, c);
 214         return is_utf8_xidcont(tmpbuf);
 215 }
 216
 217 static SV *my_scan_word(pTHX_ bool allow_package) {
 218         bool at_start, at_substart;
 219         I32 c;
 220         SV *sv = sv_2mortal(newSVpvs(""));
 221         if (lex_bufutf8()) {
 222                 SvUTF8_on(sv);
 223         }
 224
 225         at_start = at_substart = TRUE;
 226         c = lex_peek_unichar(0);
 227
 228         while (c != -1) {
 229                 if (at_substart ? my_is_uni_xidfirst(aTHX_ c) : my_is_uni_xidcont(aTHX_ c)) {
 230                         lex_read_unichar(0);
 231                         my_sv_cat_c(aTHX_ sv, c);
 232                         at_substart = FALSE;
 233                         c = lex_peek_unichar(0);
 234                 } else if (allow_package && !at_substart && c == '\'') {
 235                         lex_read_unichar(0);
 236                         c = lex_peek_unichar(0);
 237                         if (!my_is_uni_xidfirst(aTHX_ c)) {
 238                                 lex_stuff_pvs("'", 0);
 239                                 break;
 240                         }
 241                         sv_catpvs(sv, "'");
 242                         at_substart = TRUE;
 243                 } else if (allow_package && (at_start || !at_substart) && c == ':') {
 244                         lex_read_unichar(0);
 245                         if (lex_peek_unichar(0) != ':') {
 246                                 lex_stuff_pvs(":", 0);
 247                                 break;
 248                         }
 249                         lex_read_unichar(0);
 250                         c = lex_peek_unichar(0);
 251                         if (!my_is_uni_xidfirst(aTHX_ c)) {
 252                                 lex_stuff_pvs("::", 0);
 253                                 break;
 254                         }
 255                         sv_catpvs(sv, "::");
 256                         at_substart = TRUE;
 257                 } else {
 258                         break;
 259                 }
 260                 at_start = FALSE;
 261         }
 262
 263         return SvCUR(sv) ? sv : NULL;
 264 }
 265
 266 static SV *my_scan_parens_tail(pTHX_ bool keep_backslash) {
 267         I32 c, nesting;
 268         SV *sv;
 269         line_t start;
 270
 271         start = CopLINE(PL_curcop);
 272
 273         sv = sv_2mortal(newSVpvs(""));
 274         if (lex_bufutf8()) {
 275                 SvUTF8_on(sv);
 276         }
 277
 278         nesting = 0;
 279         for (;;) {
 280                 c = lex_read_unichar(0);
 281                 if (c == EOF) {
 282                         CopLINE_set(PL_curcop, start);
 283                         return NULL;
 284                 }
 285
 286                 if (c == '\\') {
 287                         c = lex_read_unichar(0);
 288                         if (c == EOF) {
 289                                 CopLINE_set(PL_curcop, start);
 290                                 return NULL;
 291                         }
 292                         if (keep_backslash || (c != '(' && c != ')')) {
 293                                 sv_catpvs(sv, "\\");
 294                         }
 295                 } else if (c == '(') {
 296                         nesting++;
 297                 } else if (c == ')') {
 298                         if (!nesting) {
 299                                 break;
 300                         }
 301                         nesting--;
 302                 }
 303
 304                 my_sv_cat_c(aTHX_ sv, c);
 305         }
 306
 307         return sv;
 308 }
 309
 310 static void my_check_prototype(pTHX_ const SV *declarator, SV *proto) {
 311         char *start, *r, *w, *end;
 312         STRLEN len;
 313
 314         /* strip spaces */
 315         start = SvPV(proto, len);
 316         end = start + len;
 317
 318         for (w = r = start; r < end; r++) {
 319                 if (!isSPACE(*r)) {
 320                         *w++ = *r;
 321                 }
 322         }
 323         *w = '\0';
 324         SvCUR_set(proto, w - start);
 325         end = w;
 326         len = end - start;
 327
 328         if (!ckWARN(WARN_ILLEGALPROTO)) {
 329                 return;
 330         }
 331
 332         /* check for bad characters */
 333         if (strspn(start, "$@%*;[]&\\_+") != len) {
 334                 SV *dsv = newSVpvs_flags("", SVs_TEMP);
 335                 warner(
 336                         packWARN(WARN_ILLEGALPROTO),
 337                         "Illegal character in prototype for %"SVf" : %s",
 338                         SVfARG(declarator),
 339                         SvUTF8(proto)
 340                                 ? sv_uni_display(
 341                                         dsv,
 342                                         proto,
 343                                         len,
 344                                         UNI_DISPLAY_ISPRINT
 345                                 )
 346                                 : pv_pretty(dsv, start, len, 60, NULL, NULL,
 347                                         PERL_PV_ESCAPE_NONASCII
 348                                 )
 349                 );
 350                 return;
 351         }
 352
 353         for (r = start; r < end; r++) {
 354                 switch (*r) {
 355                         default:
 356                                 warner(
 357                                         packWARN(WARN_ILLEGALPROTO),
 358                                         "Illegal character in prototype for %"SVf" : %s",
 359                                         SVfARG(declarator), r
 360                                 );
 361                                 return;
 362
 363                         case '_':
 364                                 if (r[1] && !strchr(";@%", *r)) {
 365                                         warner(
 366                                                 packWARN(WARN_ILLEGALPROTO),
 367                                                 "Illegal character after '_' in prototype for %"SVf" : %s",
 368                                                 SVfARG(declarator), r
 369                                         );
 370                                         return;
 371                                 }
 372                                 break;
 373
 374                         case '@':
 375                         case '%':
 376                                 if (r[1]) {
 377                                         warner(
 378                                                 packWARN(WARN_ILLEGALPROTO),
 379                                                 "prototype after '%c' for %"SVf": %s",
 380                                                 *r, SVfARG(declarator), r + 1
 381                                         );
 382                                         return;
 383                                 }
 384                                 break;
 385
 386                         case '\\':
 387                                 r++;
 388                                 if (strchr("$@%&*", *r)) {
 389                                         break;
 390                                 }
 391                                 if (*r == '[') {
 392                                         r++;
 393                                         for (; r < end && *r != ']'; r++) {
 394                                                 if (!strchr("$@%&*", *r)) {
 395                                                         break;
 396                                                 }
 397                                         }
 398                                         if (*r == ']' && r[-1] != '[') {
 399                                                 break;
 400                                         }
 401                                 }
 402                                 warner(
 403                                         packWARN(WARN_ILLEGALPROTO),
 404                                         "Illegal character after '\\' in prototype for %"SVf" : %s",
 405                                         SVfARG(declarator), r
 406                                 );
 407                                 return;
 408
 409                         case '$':
 410                         case '*':
 411                         case '&':
 412                         case ';':
 413                         case '+':
 414                                 break;
 415                 }
 416         }
 417 }
 418
 419
 420 DEFSTRUCT(Param) {
 421         SV *name;
 422         PADOFFSET padoff;
 423 };
 424
 425 DEFSTRUCT(ParamInit) {
 426         Param param;
 427         OP *init;
 428 };
 429
 430 #define VEC(B) B ## _Vec
 431
 432 #define DEFVECTOR(B) DEFSTRUCT(VEC(B)) { \
 433         B (*data); \
 434         size_t used, size; \
 435 }
 436
 437 DEFVECTOR(Param);
 438 DEFVECTOR(ParamInit);
 439
 440 #define DEFVECTOR_INIT(N, B) static void N(VEC(B) *p) { \
 441         p->used = 0; \
 442         p->size = 23; \
 443         Newx(p->data, p->size, B); \
 444 } static void N(VEC(B) *)
 445
 446 DEFSTRUCT(ParamSpec) {
 447         Param invocant;
 448         VEC(Param) positional_required;
 449         VEC(ParamInit) positional_optional;
 450         VEC(Param) named_required;
 451         VEC(ParamInit) named_optional;
 452         Param slurpy;
 453         PADOFFSET rest_hash;
 454 };
 455
 456 DEFVECTOR_INIT(pv_init, Param);
 457 DEFVECTOR_INIT(piv_init, ParamInit);
 458
 459 static void p_init(Param *p) {
 460         p->name = NULL;
 461         p->padoff = NOT_IN_PAD;
 462 }
 463
 464 static void ps_init(ParamSpec *ps) {
 465         p_init(&ps->invocant);
 466         pv_init(&ps->positional_required);
 467         piv_init(&ps->positional_optional);
 468         pv_init(&ps->named_required);
 469         piv_init(&ps->named_optional);
 470         p_init(&ps->slurpy);
 471         ps->rest_hash = NOT_IN_PAD;
 472 }
 473
 474 #define DEFVECTOR_EXTEND(N, B) static B (*N(VEC(B) *p)) { \
 475         assert(p->used <= p->size); \
 476         if (p->used == p->size) { \
 477                 const size_t n = p->size / 2 * 3 + 1; \
 478                 Renew(p->data, n, B); \
 479                 p->size = n; \
 480         } \
 481         return &p->data[p->used]; \
 482 } static B (*N(VEC(B) *))
 483
 484 DEFVECTOR_EXTEND(pv_extend, Param);
 485 DEFVECTOR_EXTEND(piv_extend, ParamInit);
 486
 487 #define DEFVECTOR_CLEAR(N, B, F) static void N(pTHX_ VEC(B) *p) { \
 488         while (p->used) { \
 489                 p->used--; \
 490                 F(aTHX_ &p->data[p->used]); \
 491         } \
 492         Safefree(p->data); \
 493         p->data = NULL; \
 494         p->size = 0; \
 495 } static void N(pTHX_ VEC(B) *)
 496
 497 static void p_clear(pTHX_ Param *p) {
 498         p->name = NULL;
 499         p->padoff = NOT_IN_PAD;
 500 }
 501
 502 static void pi_clear(pTHX_ ParamInit *pi) {
 503         p_clear(aTHX_ &pi->param);
 504         if (pi->init) {
 505                 op_free(pi->init);
 506                 pi->init = NULL;
 507         }
 508 }
 509
 510 DEFVECTOR_CLEAR(pv_clear, Param, p_clear);
 511 DEFVECTOR_CLEAR(piv_clear, ParamInit, pi_clear);
 512
 513 static void ps_clear(pTHX_ ParamSpec *ps) {
 514         p_clear(aTHX_ &ps->invocant);
 515
 516         pv_clear(aTHX_ &ps->positional_required);
 517         piv_clear(aTHX_ &ps->positional_optional);
 518
 519         pv_clear(aTHX_ &ps->named_required);
 520         piv_clear(aTHX_ &ps->named_optional);
 521
 522         p_clear(aTHX_ &ps->slurpy);
 523 }
 524
 525 static int ps_contains(pTHX_ const ParamSpec *ps, SV *sv) {
 526         size_t i, lim;
 527
 528         if (ps->invocant.name && sv_eq(sv, ps->invocant.name)) {
 529                 return 1;
 530         }
 531
 532         for (i = 0, lim = ps->positional_required.used; i < lim; i++) {
 533                 if (sv_eq(sv, ps->positional_required.data[i].name)) {
 534                         return 1;
 535                 }
 536         }
 537
 538         for (i = 0, lim = ps->positional_optional.used; i < lim; i++) {
 539                 if (sv_eq(sv, ps->positional_optional.data[i].param.name)) {
 540                         return 1;
 541                 }
 542         }
 543
 544         for (i = 0, lim = ps->named_required.used; i < lim; i++) {
 545                 if (sv_eq(sv, ps->named_required.data[i].name)) {
 546                         return 1;
 547                 }
 548         }
 549
 550         for (i = 0, lim = ps->named_optional.used; i < lim; i++) {
 551                 if (sv_eq(sv, ps->named_optional.data[i].param.name)) {
 552                         return 1;
 553                 }
 554         }
 555
 556         return 0;
 557 }
 558
 559 static void ps_free_void(pTHX_ void *p) {
 560         ps_clear(aTHX_ p);
 561         Safefree(p);
 562 }
 563
 564 static int args_min(pTHX_ const ParamSpec *ps, const KWSpec *ks) {
 565         int n = 0;
 566         if (!ps) {
 567                 return SvTRUE(ks->shift) ? 1 : 0;
 568         }
 569         if (ps->invocant.name) {
 570                 n++;
 571         }
 572         n += ps->positional_required.used;
 573         n += ps->named_required.used * 2;
 574         return n;
 575 }
 576
 577 static int args_max(const ParamSpec *ps) {
 578         int n = 0;
 579         if (!ps) {
 580                 return -1;
 581         }
 582         if (ps->invocant.name) {
 583                 n++;
 584         }
 585         n += ps->positional_required.used;
 586         n += ps->positional_optional.used;
 587         if (ps->named_required.used || ps->named_optional.used || ps->slurpy.name) {
 588                 n = -1;
 589         }
 590         return n;
 591 }
 592
 593 static size_t count_positional_params(const ParamSpec *ps) {
 594         return ps->positional_required.used + ps->positional_optional.used;
 595 }
 596
 597 static size_t count_named_params(const ParamSpec *ps) {
 598         return ps->named_required.used + ps->named_optional.used;
 599 }
 600
 601 enum {
 602         PARAM_INVOCANT = 0x01,
 603         PARAM_NAMED    = 0x02
 604 };
 605
 606 /* *pinit must be NULL on entry.
 607  * caller must free *pinit on error.
 608  */
 609 static PADOFFSET parse_param(
 610         pTHX_
 611         const SV *declarator, const KWSpec *spec, ParamSpec *param_spec,
 612         int *pflags, SV **pname, OP **pinit
 613 ) {
 614         I32 c;
 615         char sigil;
 616         SV *name;
 617
 618         assert(!*pinit);
 619         *pflags = 0;
 620
 621         c = lex_peek_unichar(0);
 622
 623         if (c == ':') {
 624                 lex_read_unichar(0);
 625                 lex_read_space(0);
 626
 627                 *pflags |= PARAM_NAMED;
 628
 629                 c = lex_peek_unichar(0);
 630         }
 631
 632         if (c == -1) {
 633                 croak("In %"SVf": unterminated parameter list", SVfARG(declarator));
 634         }
 635         if (!(c == '$' || c == '@' || c == '%')) {
 636                 croak("In %"SVf": unexpected '%c' in parameter list (expecting a sigil)", SVfARG(declarator), (int)c);
 637         }
 638
 639         sigil = c;
 640
 641         lex_read_unichar(0);
 642         lex_read_space(0);
 643
 644         if (!(name = my_scan_word(aTHX_ FALSE))) {
 645                 croak("In %"SVf": missing identifier after '%c'", SVfARG(declarator), sigil);
 646         }
 647         sv_insert(name, 0, 0, &sigil, 1);
 648         *pname = name;
 649
 650         lex_read_space(0);
 651         c = lex_peek_unichar(0);
 652
 653         if (c == '=') {
 654                 lex_read_unichar(0);
 655                 lex_read_space(0);
 656
 657
 658                 if (!param_spec->invocant.name && SvTRUE(spec->shift)) {
 659                         param_spec->invocant.name = spec->shift;
 660                         param_spec->invocant.padoff = pad_add_name_sv(param_spec->invocant.name, 0, NULL, NULL);
 661                 }
 662
 663                 *pinit = parse_termexpr(0);
 664
 665                 lex_read_space(0);
 666                 c = lex_peek_unichar(0);
 667         }
 668
 669         if (c == ':') {
 670                 *pflags |= PARAM_INVOCANT;
 671                 lex_read_unichar(0);
 672                 lex_read_space(0);
 673         } else if (c == ',') {
 674                 lex_read_unichar(0);
 675                 lex_read_space(0);
 676         } else if (c != ')') {
 677                 if (c == -1) {
 678                         croak("In %"SVf": unterminated parameter list", SVfARG(declarator));
 679                 }
 680                 croak("In %"SVf": unexpected '%c' in parameter list (expecting ',')", SVfARG(declarator), (int)c);
 681         }
 682
 683         return pad_add_name_sv(*pname, IF_HAVE_PERL_5_16(padadd_NO_DUP_CHECK, 0), NULL, NULL);
 684 }
 685
 686 static OP *my_var_g(pTHX_ I32 type, I32 flags, PADOFFSET padoff) {
 687         OP *var = newOP(type, flags);
 688         var->op_targ = padoff;
 689         return var;
 690 }
 691
 692 static OP *my_var(pTHX_ I32 flags, PADOFFSET padoff) {
 693         return my_var_g(aTHX_ OP_PADSV, flags, padoff);
 694 }
 695
 696 static SV *mkbits1(pTHX_ size_t n) {
 697         size_t bytes = n / 8, bits = n % 8;
 698         SV *sv = newSV(bytes + !!bits);
 699         char *p = SvPVX(sv), *q = p;
 700         while (bytes--) {
 701                 *p++ = '\xff';
 702         }
 703         if (bits) {
 704                 *p++ = (1u << bits) - 1;
 705         }
 706         *p = '\0';
 707         SvCUR_set(sv, p - q);
 708         SvPOK_on(sv);
 709         return sv;
 710 }
 711
 712 static OP *mkvecbits(pTHX_ PADOFFSET padoff, size_t i) {
 713         OP *first, *mid, *last, *vec;
 714
 715         last = newSVOP(OP_CONST, 0, newSViv(1));
 716         first = last;
 717
 718         mid = newSVOP(OP_CONST, 0, newSViv(i));
 719         mid->op_sibling = first;
 720         first = mid;
 721
 722         mid = my_var(aTHX_ 0, padoff);
 723         mid->op_sibling = first;
 724
 725         first = newOP(OP_PUSHMARK, 0);
 726
 727         vec = newLISTOP(OP_VEC, 0, first, mid);
 728         vec->op_targ = pad_alloc(OP_VEC, SVs_PADTMP);
 729         ((LISTOP *)vec)->op_last = last;
 730         op_null(((LISTOP *)vec)->op_first);
 731
 732         return vec;
 733 }
 734
 735 static OP *mkargselem(pTHX_ OP *index) {
 736         OP *args = newAVREF(newGVOP(OP_GV, 0, PL_defgv));
 737         args->op_flags |= OPf_REF;
 738
 739         return newBINOP(OP_AELEM, 0, args, index);
 740 }
 741
 742 static OP *mkargselemv(pTHX_ PADOFFSET v) {
 743         return mkargselem(aTHX_ my_var(aTHX_ 0, v));
 744 }
 745
 746 static OP *mkhvelem(pTHX_ PADOFFSET h, OP *k) {
 747         OP *hv = my_var_g(aTHX_ OP_PADHV, OPf_REF, h);
 748         return newBINOP(OP_HELEM, 0, hv, k);
 749 }
 750
 751 static OP *mkconstsv(pTHX_ SV *sv) {
 752         return newSVOP(OP_CONST, 0, sv);
 753 }
 754
 755 static OP *mkconstiv(pTHX_ IV i) {
 756         return mkconstsv(aTHX_ newSViv(i));
 757 }
 758
 759 static OP *mkconstpv(pTHX_ const char *p, size_t n) {
 760         return mkconstsv(aTHX_ newSVpv(p, n));
 761 }
 762
 763 #define mkconstpvs(S) mkconstpv(aTHX_ "" S "", sizeof S - 1)
 764
 765 static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len, const KWSpec *spec) {
 766         ParamSpec *param_spec;
 767         SV *declarator;
 768         I32 floor_ix;
 769         int save_ix;
 770         SV *saw_name;
 771         OP **prelude_sentinel;
 772         SV *proto;
 773         OP **attrs_sentinel, *body;
 774         unsigned builtin_attrs;
 775         I32 c;
 776
 777         declarator = sv_2mortal(newSVpvn(keyword_ptr, keyword_len));
 778
 779         lex_read_space(0);
 780
 781         builtin_attrs = 0;
 782
 783         /* function name */
 784         saw_name = NULL;
 785         if ((spec->flags & FLAG_NAME_OK) && (saw_name = my_scan_word(aTHX_ TRUE))) {
 786
 787                 if (PL_parser->expect != XSTATE) {
 788                         /* bail out early so we don't predeclare $saw_name */
 789                         croak("In %"SVf": I was expecting a function body, not \"%"SVf"\"", SVfARG(declarator), SVfARG(saw_name));
 790                 }
 791
 792                 sv_catpvs(declarator, " ");
 793                 sv_catsv(declarator, saw_name);
 794
 795                 if (
 796                         sv_eq_pvs(saw_name, "BEGIN") ||
 797                         sv_eq_pvs(saw_name, "END") ||
 798                         sv_eq_pvs(saw_name, "INIT") ||
 799                         sv_eq_pvs(saw_name, "CHECK") ||
 800                         sv_eq_pvs(saw_name, "UNITCHECK")
 801                 ) {
 802                         builtin_attrs |= MY_ATTR_SPECIAL;
 803                 }
 804
 805                 lex_read_space(0);
 806         } else if (!(spec->flags & FLAG_ANON_OK)) {
 807                 croak("I was expecting a function name, not \"%.*s\"", (int)(PL_parser->bufend - PL_parser->bufptr), PL_parser->bufptr);
 808         } else {
 809                 sv_catpvs(declarator, " (anon)");
 810         }
 811
 812         /* we're a subroutine declaration */
 813         floor_ix = start_subparse(FALSE, saw_name ? 0 : CVf_ANON);
 814         SAVEFREESV(PL_compcv);
 815
 816         /* create outer block: '{' */
 817         save_ix = S_block_start(aTHX_ TRUE);
 818
 819         /* initialize synthetic optree */
 820         Newx(prelude_sentinel, 1, OP *);
 821         *prelude_sentinel = NULL;
 822         SAVEDESTRUCTOR_X(free_ptr_op, prelude_sentinel);
 823
 824         /* parameters */
 825         param_spec = NULL;
 826
 827         c = lex_peek_unichar(0);
 828         if (c == '(') {
 829                 OP **init_sentinel;
 830
 831                 Newx(init_sentinel, 1, OP *);
 832                 *init_sentinel = NULL;
 833                 SAVEDESTRUCTOR_X(free_ptr_op, init_sentinel);
 834
 835                 Newx(param_spec, 1, ParamSpec);
 836                 ps_init(param_spec);
 837                 SAVEDESTRUCTOR_X(ps_free_void, param_spec);
 838
 839                 lex_read_unichar(0);
 840                 lex_read_space(0);
 841
 842                 while ((c = lex_peek_unichar(0)) != ')') {
 843                         int flags;
 844                         SV *name;
 845                         char sigil;
 846                         PADOFFSET padoff;
 847
 848                         padoff = parse_param(aTHX_ declarator, spec, param_spec, &flags, &name, init_sentinel);
 849
 850                         S_intro_my(aTHX);
 851
 852                         sigil = SvPV_nolen(name)[0];
 853
 854                         /* internal consistency */
 855                         if (flags & PARAM_NAMED) {
 856                                 if (flags & PARAM_INVOCANT) {
 857                                         croak("In %"SVf": invocant %"SVf" can't be a named parameter", SVfARG(declarator), SVfARG(name));
 858                                 }
 859                                 if (sigil != '$') {
 860                                         croak("In %"SVf": named parameter %"SVf" can't be a%s", SVfARG(declarator), SVfARG(name), sigil == '@' ? "n array" : " hash");
 861                                 }
 862                         } else if (flags & PARAM_INVOCANT) {
 863                                 if (*init_sentinel) {
 864                                         croak("In %"SVf": invocant %"SVf" can't have a default value", SVfARG(declarator), SVfARG(name));
 865                                 }
 866                                 if (sigil != '$') {
 867                                         croak("In %"SVf": invocant %"SVf" can't be a%s", SVfARG(declarator), SVfARG(name), sigil == '@' ? "n array" : " hash");
 868                                 }
 869                         } else if (sigil != '$' && *init_sentinel) {
 870                                 croak("In %"SVf": %s %"SVf" can't have a default value", SVfARG(declarator), sigil == '@' ? "array" : "hash", SVfARG(name));
 871                         }
 872
 873                         /* external constraints */
 874                         if (param_spec->slurpy.name) {
 875                                 croak("In %"SVf": I was expecting \")\" after \"%"SVf"\", not \"%"SVf"\"", SVfARG(declarator), SVfARG(param_spec->slurpy.name), SVfARG(name));
 876                         }
 877                         if (sigil != '$') {
 878                                 assert(!*init_sentinel);
 879                                 param_spec->slurpy.name = name;
 880                                 param_spec->slurpy.padoff = padoff;
 881                                 continue;
 882                         }
 883
 884                         if (!(flags & PARAM_NAMED) && count_named_params(param_spec)) {
 885                                 croak("In %"SVf": positional parameter %"SVf" can't appear after named parameter %"SVf"", SVfARG(declarator), SVfARG(name), SVfARG((param_spec->named_required.used ? param_spec->named_required.data[0] : param_spec->named_optional.data[0].param).name));
 886                         }
 887
 888                         if (flags & PARAM_INVOCANT) {
 889                                 if (param_spec->invocant.name) {
 890                                         croak("In %"SVf": invalid double invocants %"SVf", %"SVf"", SVfARG(declarator), SVfARG(param_spec->invocant.name), SVfARG(name));
 891                                 }
 892                                 if (count_positional_params(param_spec) || count_named_params(param_spec)) {
 893                                         croak("In %"SVf": invocant %"SVf" must be first in parameter list", SVfARG(declarator), SVfARG(name));
 894                                 }
 895                                 if (!(spec->flags & FLAG_INVOCANT)) {
 896                                         croak("In %"SVf": invocant %"SVf" not allowed here", SVfARG(declarator), SVfARG(name));
 897                                 }
 898                                 param_spec->invocant.name = name;
 899                                 param_spec->invocant.padoff = padoff;
 900                                 continue;
 901                         }
 902
 903                         if (*init_sentinel && !(spec->flags & FLAG_DEFAULT_ARGS)) {
 904                                 croak("In %"SVf": default argument for %"SVf" not allowed here", SVfARG(declarator), SVfARG(name));
 905                         }
 906
 907                         if (ps_contains(aTHX_ param_spec, name)) {
 908                                 croak("In %"SVf": %"SVf" can't appear twice in the same parameter list", SVfARG(declarator), SVfARG(name));
 909                         }
 910
 911                         if (flags & PARAM_NAMED) {
 912                                 if (!(spec->flags & FLAG_NAMED_PARAMS)) {
 913                                         croak("In %"SVf": named parameter :%"SVf" not allowed here", SVfARG(declarator), SVfARG(name));
 914                                 }
 915
 916                                 if (*init_sentinel) {
 917                                         ParamInit *pi = piv_extend(&param_spec->named_optional);
 918                                         pi->param.name = name;
 919                                         pi->param.padoff = padoff;
 920                                         pi->init = *init_sentinel;
 921                                         *init_sentinel = NULL;
 922                                         param_spec->named_optional.used++;
 923                                 } else {
 924                                         if (param_spec->positional_optional.used) {
 925                                                 croak("In %"SVf": can't combine optional positional (%"SVf") and required named (%"SVf") parameters", SVfARG(declarator), SVfARG(param_spec->positional_optional.data[0].param.name), SVfARG(name));
 926                                         }
 927
 928                                         Param *p = pv_extend(&param_spec->named_required);
 929                                         p->name = name;
 930                                         p->padoff = padoff;
 931                                         param_spec->named_required.used++;
 932                                 }
 933                         } else {
 934                                 if (*init_sentinel || param_spec->positional_optional.used) {
 935                                         ParamInit *pi = piv_extend(&param_spec->positional_optional);
 936                                         pi->param.name = name;
 937                                         pi->param.padoff = padoff;
 938                                         pi->init = *init_sentinel;
 939                                         *init_sentinel = NULL;
 940                                         param_spec->positional_optional.used++;
 941                                 } else {
 942                                         Param *p = pv_extend(&param_spec->positional_required);
 943                                         p->name = name;
 944                                         p->padoff = padoff;
 945                                         param_spec->positional_required.used++;
 946                                 }
 947                         }
 948
 949                 }
 950                 lex_read_unichar(0);
 951                 lex_read_space(0);
 952                 *init_sentinel = NULL;
 953
 954                 if (!param_spec->invocant.name && SvTRUE(spec->shift)) {
 955                         if (ps_contains(aTHX_ param_spec, spec->shift)) {
 956                                 croak("In %"SVf": %"SVf" can't appear twice in the same parameter list", SVfARG(declarator), SVfARG(spec->shift));
 957                         }
 958
 959                         param_spec->invocant.name = spec->shift;
 960                         param_spec->invocant.padoff = pad_add_name_sv(param_spec->invocant.name, 0, NULL, NULL);
 961                 }
 962         }
 963
 964         /* prototype */
 965         proto = NULL;
 966         c = lex_peek_unichar(0);
 967         if (c == ':') {
 968                 lex_read_unichar(0);
 969                 lex_read_space(0);
 970
 971                 c = lex_peek_unichar(0);
 972                 if (c != '(') {
 973                         lex_stuff_pvs(":", 0);
 974                         c = ':';
 975                 } else {
 976                         lex_read_unichar(0);
 977                         if (!(proto = my_scan_parens_tail(aTHX_ FALSE))) {
 978                                 croak("In %"SVf": prototype not terminated", SVfARG(declarator));
 979                         }
 980                         my_check_prototype(aTHX_ declarator, proto);
 981                         lex_read_space(0);
 982                         c = lex_peek_unichar(0);
 983                 }
 984         }
 985
 986         /* attributes */
 987         Newx(attrs_sentinel, 1, OP *);
 988         *attrs_sentinel = NULL;
 989         SAVEDESTRUCTOR_X(free_ptr_op, attrs_sentinel);
 990
 991         if (c == ':' || c == '{') /* '}' - hi, vim */ {
 992
 993                 /* kludge default attributes in */
 994                 if (SvTRUE(spec->attrs) && SvPV_nolen(spec->attrs)[0] == ':') {
 995                         lex_stuff_sv(spec->attrs, 0);
 996                         c = ':';
 997                 }
 998
 999                 if (c == ':') {
1000                         lex_read_unichar(0);
1001                         lex_read_space(0);
1002                         c = lex_peek_unichar(0);
1003
1004                         for (;;) {
1005                                 SV *attr;
1006
1007                                 if (!(attr = my_scan_word(aTHX_ FALSE))) {
1008                                         break;
1009                                 }
1010
1011                                 lex_read_space(0);
1012                                 c = lex_peek_unichar(0);
1013
1014                                 if (c != '(') {
1015                                         if (sv_eq_pvs(attr, "lvalue")) {
1016                                                 builtin_attrs |= MY_ATTR_LVALUE;
1017                                                 attr = NULL;
1018                                         } else if (sv_eq_pvs(attr, "method")) {
1019                                                 builtin_attrs |= MY_ATTR_METHOD;
1020                                                 attr = NULL;
1021                                         }
1022                                 } else {
1023                                         SV *sv;
1024                                         lex_read_unichar(0);
1025                                         if (!(sv = my_scan_parens_tail(aTHX_ TRUE))) {
1026                                                 croak("In %"SVf": unterminated attribute parameter in attribute list", SVfARG(declarator));
1027                                         }
1028                                         sv_catpvs(attr, "(");
1029                                         sv_catsv(attr, sv);
1030                                         sv_catpvs(attr, ")");
1031
1032                                         lex_read_space(0);
1033                                         c = lex_peek_unichar(0);
1034                                 }
1035
1036                                 if (attr) {
1037                                         *attrs_sentinel = op_append_elem(OP_LIST, *attrs_sentinel, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(attr)));
1038                                 }
1039
1040                                 if (c == ':') {
1041                                         lex_read_unichar(0);
1042                                         lex_read_space(0);
1043                                         c = lex_peek_unichar(0);
1044                                 }
1045                         }
1046                 }
1047         }
1048
1049         /* body */
1050         if (c != '{') /* '}' - hi, vim */ {
1051                 croak("In %"SVf": I was expecting a function body, not \"%c\"", SVfARG(declarator), (int)c);
1052         }
1053
1054         /* surprise predeclaration! */
1055         if (saw_name) {
1056                 /* 'sub NAME (PROTO);' to make name/proto known to perl before it
1057                    starts parsing the body */
1058                 const I32 sub_ix = start_subparse(FALSE, 0);
1059                 SAVEFREESV(PL_compcv);
1060
1061                 SvREFCNT_inc_simple_void(PL_compcv);
1062
1063                 newATTRSUB(
1064                         sub_ix,
1065                         mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(saw_name)),
1066                         proto ? mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(proto)) : NULL,
1067                         NULL,
1068                         NULL
1069                 );
1070         }
1071
1072         if (builtin_attrs & MY_ATTR_LVALUE) {
1073                 CvLVALUE_on(PL_compcv);
1074         }
1075         if (builtin_attrs & MY_ATTR_METHOD) {
1076                 CvMETHOD_on(PL_compcv);
1077         }
1078         if (builtin_attrs & MY_ATTR_SPECIAL) {
1079                 CvSPECIAL_on(PL_compcv);
1080         }
1081
1082         /* check number of arguments */
1083         if (spec->flags & FLAG_CHECK_NARGS) {
1084                 int amin, amax;
1085                 size_t named;
1086
1087                 amin = args_min(aTHX_ param_spec, spec);
1088                 if (amin > 0) {
1089                         OP *chk, *cond, *err, *croak;
1090
1091                         err = mkconstsv(aTHX_ newSVpvf("Not enough arguments for %"SVf" (expected %d, got ", SVfARG(declarator), amin));
1092                         err = newBINOP(
1093                                 OP_CONCAT, 0,
1094                                 err,
1095                                 newAVREF(newGVOP(OP_GV, 0, PL_defgv))
1096                         );
1097                         err = newBINOP(
1098                                 OP_CONCAT, 0,
1099                                 err,
1100                                 mkconstpvs(")")
1101                         );
1102
1103                         croak = newCVREF(OPf_WANT_SCALAR,
1104                                          newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)));
1105                         err = newUNOP(OP_ENTERSUB, OPf_STACKED,
1106                                       op_append_elem(OP_LIST, err, croak));
1107
1108                         cond = newBINOP(OP_LT, 0,
1109                                         newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1110                                         mkconstiv(aTHX_ amin));
1111                         chk = newLOGOP(OP_AND, 0, cond, err);
1112
1113                         *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk));
1114                 }
1115
1116                 amax = args_max(param_spec);
1117                 if (amax >= 0) {
1118                         OP *chk, *cond, *err, *croak;
1119
1120                         err = mkconstsv(aTHX_ newSVpvf("Too many arguments for %"SVf" (expected %d, got ", SVfARG(declarator), amax));
1121                         err = newBINOP(
1122                                 OP_CONCAT, 0,
1123                                 err,
1124                                 newAVREF(newGVOP(OP_GV, 0, PL_defgv))
1125                         );
1126                         err = newBINOP(
1127                                 OP_CONCAT, 0,
1128                                 err,
1129                                 mkconstpvs(")")
1130                         );
1131
1132                         croak = newCVREF(
1133                                 OPf_WANT_SCALAR,
1134                                 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1135                         );
1136                         err = newUNOP(OP_ENTERSUB, OPf_STACKED,
1137                         op_append_elem(OP_LIST, err, croak));
1138
1139                         cond = newBINOP(
1140                                 OP_GT, 0,
1141                                 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1142                                 mkconstiv(aTHX_ amax)
1143                         );
1144                         chk = newLOGOP(OP_AND, 0, cond, err);
1145
1146                         *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk));
1147                 }
1148
1149                 if (param_spec && (count_named_params(param_spec) || (param_spec->slurpy.name && SvPV_nolen(param_spec->slurpy.name)[0] == '%'))) {
1150                         OP *chk, *cond, *err, *croak;
1151                         const UV fixed = count_positional_params(param_spec) + !!param_spec->invocant.name;
1152
1153                         err = mkconstsv(aTHX_ newSVpvf("Odd number of paired arguments for %"SVf"", SVfARG(declarator)));
1154
1155                         croak = newCVREF(
1156                                 OPf_WANT_SCALAR,
1157                                 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1158                         );
1159                         err = newUNOP(OP_ENTERSUB, OPf_STACKED,
1160                         op_append_elem(OP_LIST, err, croak));
1161
1162                         cond = newBINOP(OP_GT, 0,
1163                                         newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1164                                         mkconstiv(aTHX_ fixed));
1165                         cond = newLOGOP(OP_AND, 0,
1166                                         cond,
1167                                         newBINOP(OP_MODULO, 0,
1168                                                  fixed
1169                                                  ? newBINOP(OP_SUBTRACT, 0,
1170                                                             newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1171                                                             mkconstiv(aTHX_ fixed))
1172                                                  : newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1173                                                  mkconstiv(aTHX_ 2)));
1174                         chk = newLOGOP(OP_AND, 0, cond, err);
1175
1176                         *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk));
1177                 }
1178         }
1179
1180         if (!param_spec) {
1181                 /* my $invocant = shift; */
1182                 if (SvTRUE(spec->shift)) {
1183                         OP *var;
1184
1185                         var = my_var(
1186                                 aTHX_
1187                                 OPf_MOD | (OPpLVAL_INTRO << 8),
1188                                 pad_add_name_sv(spec->shift, 0, NULL, NULL)
1189                         );
1190                         var = newASSIGNOP(OPf_STACKED, var, 0, newOP(OP_SHIFT, 0));
1191
1192                         *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
1193                 }
1194         } else {
1195                 /* my $invocant = shift; */
1196                 if (param_spec->invocant.name) {
1197                         OP *var;
1198
1199                         var = my_var(
1200                                 aTHX_
1201                                 OPf_MOD | (OPpLVAL_INTRO << 8),
1202                                 param_spec->invocant.padoff
1203                         );
1204                         var = newASSIGNOP(OPf_STACKED, var, 0, newOP(OP_SHIFT, 0));
1205
1206                         *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
1207                 }
1208
1209                 /* my (...) = @_; */
1210                 {
1211                         OP *lhs;
1212                         size_t i, lim;
1213
1214                         lhs = NULL;
1215
1216                         for (i = 0, lim = param_spec->positional_required.used; i < lim; i++) {
1217                                 OP *const var = my_var(
1218                                         aTHX_
1219                                         OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
1220                                         param_spec->positional_required.data[i].padoff
1221                                 );
1222                                 lhs = op_append_elem(OP_LIST, lhs, var);
1223                         }
1224
1225                         for (i = 0, lim = param_spec->positional_optional.used; i < lim; i++) {
1226                                 OP *const var = my_var(
1227                                         aTHX_
1228                                         OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
1229                                         param_spec->positional_optional.data[i].param.padoff
1230                                 );
1231                                 lhs = op_append_elem(OP_LIST, lhs, var);
1232                         }
1233
1234                         {
1235                                 PADOFFSET padoff;
1236                                 I32 type;
1237                                 bool slurpy_hash;
1238
1239                                 /*
1240                                  * cases:
1241                                  *  1) no named params
1242                                  *   1.1) slurpy
1243                                  *       => put it in
1244                                  *   1.2) no slurpy
1245                                  *       => nop
1246                                  *  2) named params
1247                                  *   2.1) no slurpy
1248                                  *       => synthetic %{rest}
1249                                  *   2.2) slurpy is a hash
1250                                  *       => put it in
1251                                  *   2.3) slurpy is an array
1252                                  *       => synthetic %{rest}
1253                                  *          remember to declare array later
1254                                  */
1255
1256                                 slurpy_hash = param_spec->slurpy.name && SvPV_nolen(param_spec->slurpy.name)[0] == '%';
1257                                 if (!count_named_params(param_spec)) {
1258                                         if (param_spec->slurpy.name) {
1259                                                 padoff = param_spec->slurpy.padoff;
1260                                                 type = slurpy_hash ? OP_PADHV : OP_PADAV;
1261                                         } else {
1262                                                 padoff = NOT_IN_PAD;
1263                                                 type = OP_PADSV;
1264                                         }
1265                                 } else if (slurpy_hash) {
1266                                         padoff = param_spec->slurpy.padoff;
1267                                         type = OP_PADHV;
1268                                 } else {
1269                                         padoff = param_spec->rest_hash = pad_add_name_pvs("%{rest}", 0, NULL, NULL);
1270                                         type = OP_PADHV;
1271                                 }
1272
1273                                 if (padoff != NOT_IN_PAD) {
1274                                         OP *const var = my_var_g(
1275                                                 aTHX_
1276                                                 type,
1277                                                 OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
1278                                                 padoff
1279                                         );
1280
1281                                         lhs = op_append_elem(OP_LIST, lhs, var);
1282
1283                                         if (type == OP_PADHV) {
1284                                                 param_spec->rest_hash = padoff;
1285                                         }
1286                                 }
1287                         }
1288
1289                         if (lhs) {
1290                                 OP *rhs;
1291                                 lhs->op_flags |= OPf_PARENS;
1292                                 rhs = newAVREF(newGVOP(OP_GV, 0, PL_defgv));
1293
1294                                 *prelude_sentinel = op_append_list(
1295                                         OP_LINESEQ, *prelude_sentinel,
1296                                         newSTATEOP(
1297                                                 0, NULL,
1298                                                 newASSIGNOP(OPf_STACKED, lhs, 0, rhs)
1299                                         )
1300                                 );
1301                         }
1302                 }
1303
1304                 /* default positional arguments */
1305                 {
1306                         size_t i, lim, req;
1307                         OP *nest;
1308
1309                         nest = NULL;
1310
1311                         req = param_spec->positional_required.used;
1312                         for (i = 0, lim = param_spec->positional_optional.used; i < lim; i++) {
1313                                 ParamInit *cur = &param_spec->positional_optional.data[i];
1314                                 OP *var, *cond;
1315
1316                                 cond = newBINOP(
1317                                         OP_LT, 0,
1318                                         newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1319                                         mkconstiv(aTHX_ req + i + 1)
1320                                 );
1321
1322                                 var = my_var(aTHX_ 0, cur->param.padoff);
1323
1324                                 nest = op_append_list(
1325                                         OP_LINESEQ, nest,
1326                                         newASSIGNOP(OPf_STACKED, var, 0, cur->init)
1327                                 );
1328                                 cur->init = NULL;
1329                                 nest = newCONDOP(
1330                                         0,
1331                                         cond,
1332                                         nest,
1333                                         NULL
1334                                 );
1335                         }
1336
1337                         *prelude_sentinel = op_append_list(
1338                                 OP_LINESEQ, *prelude_sentinel,
1339                                 nest
1340                         );
1341                 }
1342
1343                 /* named parameters */
1344                 if (count_named_params(param_spec)) {
1345                         size_t i, lim;
1346
1347                         assert(param_spec->rest_hash != NOT_IN_PAD);
1348
1349                         for (i = 0, lim = param_spec->named_required.used; i < lim; i++) {
1350                                 Param *cur = &param_spec->named_required.data[i];
1351                                 size_t n;
1352                                 char *p = SvPV(cur->name, n);
1353                                 OP *var, *cond;
1354
1355                                 cond = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1356
1357                                 if (spec->flags & FLAG_CHECK_NARGS) {
1358                                         OP *croak, *msg;
1359
1360                                         var = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1361                                         var = newUNOP(OP_DELETE, 0, var);
1362
1363                                         msg = mkconstsv(aTHX_ newSVpvf("In %"SVf": missing named parameter: %.*s", SVfARG(declarator), (int)(n - 1), p + 1));
1364                                         croak = newCVREF(
1365                                                 OPf_WANT_SCALAR,
1366                                                 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1367                                         );
1368                                         croak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, croak));
1369
1370                                         cond = newUNOP(OP_EXISTS, 0, cond);
1371
1372                                         cond = newCONDOP(0, cond, var, croak);
1373                                 }
1374
1375                                 var = my_var(
1376                                         aTHX_
1377                                         OPf_MOD | (OPpLVAL_INTRO << 8),
1378                                         cur->padoff
1379                                 );
1380                                 var = newASSIGNOP(OPf_STACKED, var, 0, cond);
1381
1382                                 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
1383                         }
1384
1385                         for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) {
1386                                 ParamInit *cur = &param_spec->named_optional.data[i];
1387                                 size_t n;
1388                                 char *p = SvPV(cur->param.name, n);
1389                                 OP *var, *cond;
1390
1391                                 var = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1392                                 var = newUNOP(OP_DELETE, 0, var);
1393
1394                                 cond = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1395                                 cond = newUNOP(OP_EXISTS, 0, cond);
1396
1397                                 cond = newCONDOP(0, cond, var, cur->init);
1398                                 cur->init = NULL;
1399
1400                                 var = my_var(
1401                                         aTHX_
1402                                         OPf_MOD | (OPpLVAL_INTRO << 8),
1403                                         cur->param.padoff
1404                                 );
1405                                 var = newASSIGNOP(OPf_STACKED, var, 0, cond);
1406
1407                                 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
1408                         }
1409
1410                         if (!param_spec->slurpy.name) {
1411                                 if (spec->flags & FLAG_CHECK_NARGS) {
1412                                         /* croak if %{rest} */
1413                                         OP *croak, *cond, *keys, *msg;
1414
1415                                         keys = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
1416                                         keys = newLISTOP(OP_SORT, 0, newOP(OP_PUSHMARK, 0), keys);
1417                                         {
1418                                                 OP *first, *mid, *last;
1419
1420                                                 last = keys;
1421
1422                                                 mid = mkconstpvs(", ");
1423                                                 mid->op_sibling = last;
1424
1425                                                 first = newOP(OP_PUSHMARK, 0);
1426
1427                                                 keys = newLISTOP(OP_JOIN, 0, first, mid);
1428                                                 keys->op_targ = pad_alloc(OP_JOIN, SVs_PADTMP);
1429                                                 ((LISTOP *)keys)->op_last = last;
1430                                         }
1431
1432                                         msg = mkconstsv(aTHX_ newSVpvf("In %"SVf": no such named parameter: ", SVfARG(declarator)));
1433                                         msg = newBINOP(OP_CONCAT, 0, msg, keys);
1434
1435                                         croak = newCVREF(
1436                                                 OPf_WANT_SCALAR,
1437                                                 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1438                                         );
1439                                         croak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, croak));
1440
1441                                         cond = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
1442                                         croak = newCONDOP(0, cond, croak, NULL);
1443
1444                                         *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, croak));
1445                                 } else {
1446                                         OP *clear;
1447
1448                                         clear = newASSIGNOP(
1449                                                 OPf_STACKED,
1450                                                 my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash),
1451                                                 0,
1452                                                 newNULLLIST()
1453                                         );
1454
1455                                         *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, clear));
1456                                 }
1457                         } else if (param_spec->slurpy.padoff != param_spec->rest_hash) {
1458                                 OP *var, *clear;
1459
1460                                 assert(SvPV_nolen(param_spec->slurpy.name)[0] == '@');
1461
1462                                 var = my_var_g(
1463                                         aTHX_
1464                                         OP_PADAV,
1465                                         OPf_MOD | (OPpLVAL_INTRO << 8),
1466                                         param_spec->slurpy.padoff
1467                                 );
1468
1469                                 var = newASSIGNOP(OPf_STACKED, var, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
1470
1471                                 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
1472
1473                                 clear = newASSIGNOP(
1474                                         OPf_STACKED,
1475                                         my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash),
1476                                         0,
1477                                         newNULLLIST()
1478                                 );
1479
1480                                 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, clear));
1481                         }
1482                 }
1483
1484                 if (count_named_params(param_spec) && 0) {
1485                         int nameblock_ix;
1486                         OP *nameblock;
1487                         PADOFFSET vb, vc, vi, vk;
1488                         int vb_is_str, vc_is_str;
1489
1490                         {
1491                                 OP *lhs;
1492                                 size_t i, lim;
1493
1494                                 lhs = NULL;
1495
1496                                 for (i = 0, lim = param_spec->named_required.used; i < lim; i++) {
1497                                         OP *const var = my_var(
1498                                                 aTHX_
1499                                                 OPf_MOD | OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
1500                                                 param_spec->named_required.data[i].padoff
1501                                         );
1502                                         lhs = op_append_elem(OP_LIST, lhs, var);
1503                                 }
1504
1505                                 for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) {
1506                                         OP *const var = my_var(
1507                                                 aTHX_
1508                                                 OPf_MOD | OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
1509                                                 param_spec->named_optional.data[i].param.padoff
1510                                         );
1511                                         lhs = op_append_elem(OP_LIST, lhs, var);
1512                                 }
1513
1514                                 lhs->op_flags |= OPf_PARENS;
1515                                 *prelude_sentinel = op_append_list(
1516                                         OP_LINESEQ, *prelude_sentinel,
1517                                         lhs
1518                                 );
1519                         }
1520
1521                         nameblock = NULL;
1522                         nameblock_ix = S_block_start(aTHX_ TRUE);
1523
1524                         {
1525                                 OP *decl, *var;
1526
1527                                 decl = NULL;
1528
1529                                 vb_is_str = param_spec->named_required.used > UV_BITS;
1530                                 if (!param_spec->named_required.used || !(spec->flags & FLAG_CHECK_NARGS)) {
1531                                         vb = 0;
1532                                 } else {
1533                                         var = newOP(OP_PADSV, OPf_MOD | (OPpLVAL_INTRO << 8));
1534                                         var->op_targ = vb = pad_add_name_pvs("$__B", 0, NULL, NULL);
1535                                         var = newASSIGNOP(OPf_STACKED, var, 0, newSVOP(OP_CONST, 0, vb_is_str ? newSVpvs("") : newSVuv(0)));
1536                                         decl = op_append_list(OP_LINESEQ, decl, newSTATEOP(0, NULL, var));
1537                                 }
1538
1539                                 vc_is_str = param_spec->named_optional.used > UV_BITS;
1540                                 if (!param_spec->named_optional.used) {
1541                                         vc = 0;
1542                                 } else {
1543                                         var = newOP(OP_PADSV, OPf_MOD | (OPpLVAL_INTRO << 8));
1544                                         var->op_targ = vc = pad_add_name_pvs("$__C", 0, NULL, NULL);
1545                                         var = newASSIGNOP(OPf_STACKED, var, 0, newSVOP(OP_CONST, 0, vc_is_str ? newSVpvs("") : newSVuv(0)));
1546                                         decl = op_append_list(OP_LINESEQ, decl, newSTATEOP(0, NULL, var));
1547                                 }
1548
1549                                 var = newOP(OP_PADSV, OPf_MOD | (OPpLVAL_INTRO << 8));
1550                                 var->op_targ = vk = pad_add_name_pvs("$__K", 0, NULL, NULL);
1551                                 decl = op_append_list(OP_LINESEQ, decl, newSTATEOP(0, NULL, var));
1552
1553                                 var = newOP(OP_PADSV, OPf_MOD | (OPpLVAL_INTRO << 8));
1554                                 var->op_targ = vi = pad_add_name_pvs("$__I", 0, NULL, NULL);
1555                                 var = newASSIGNOP(OPf_STACKED, var, 0, newSVOP(OP_CONST, 0, newSViv(count_positional_params(param_spec))));
1556                                 decl = op_append_list(OP_LINESEQ, decl, newSTATEOP(0, NULL, var));
1557
1558                                 nameblock = op_append_list(OP_LINESEQ, nameblock, decl);
1559                         }
1560
1561                         {
1562                                 OP *loop;
1563
1564                                 loop = NULL;
1565
1566                                 loop = op_append_list(
1567                                         OP_LINESEQ,
1568                                         loop,
1569                                         newSTATEOP(
1570                                                 0, NULL,
1571                                                 newASSIGNOP(
1572                                                         OPf_STACKED,
1573                                                         my_var(aTHX_ 0, vk),
1574                                                         0,
1575                                                         mkargselemv(aTHX_ vi)
1576                                                 )
1577                                         )
1578                                 );
1579
1580                                 {
1581                                         OP *nest;
1582                                         size_t i;
1583
1584                                         if (param_spec->slurpy.name) {
1585                                                 if (SvPV_nolen(param_spec->slurpy.name)[0] == '@') {
1586                                                         OP *first, *mid, *last;
1587
1588                                                         last = mkargselem(
1589                                                                 aTHX_
1590                                                                 newBINOP(
1591                                                                         OP_ADD, 0,
1592                                                                         my_var(aTHX_ 0, vi),
1593                                                                         newSVOP(OP_CONST, 0, newSViv(1))
1594                                                                 )
1595                                                         );
1596                                                         mid = last;
1597
1598                                                         first = my_var(aTHX_ 0, vk);
1599                                                         first->op_sibling = mid;
1600                                                         mid = first;
1601
1602                                                         first = my_var_g(aTHX_ OP_PADAV, 0, param_spec->slurpy.padoff);
1603                                                         first->op_sibling = mid;
1604                                                         mid = first;
1605
1606                                                         first = newOP(OP_PUSHMARK, 0);
1607                                                         nest = newLISTOP(OP_PUSH, 0, first, mid);
1608                                                         nest->op_targ = pad_alloc(OP_PUSH, SVs_PADTMP);
1609                                                         ((LISTOP *)nest)->op_last = last;
1610                                                 } else {
1611                                                         nest = newASSIGNOP(
1612                                                                 OPf_STACKED,
1613                                                                 newBINOP(
1614                                                                         OP_HELEM, 0,
1615                                                                         my_var_g(aTHX_ OP_PADHV, 0, param_spec->slurpy.padoff),
1616                                                                         my_var(aTHX_ 0, vk)
1617                                                                 ),
1618                                                                 0,
1619                                                                 mkargselem(
1620                                                                         aTHX_
1621                                                                         newBINOP(
1622                                                                                 OP_ADD, 0,
1623                                                                                 my_var(aTHX_ 0, vi),
1624                                                                                 newSVOP(OP_CONST, 0, newSViv(1))
1625                                                                         )
1626                                                                 )
1627                                                         );
1628                                                 }
1629                                         } else if (spec->flags & FLAG_CHECK_NARGS) {
1630                                                 OP *err, *croak;
1631
1632                                                 err = newSVOP(OP_CONST, 0,
1633                                                               newSVpvf("In %"SVf": no such named parameter: ", SVfARG(declarator)));
1634                                                 err = newBINOP(
1635                                                         OP_CONCAT, 0,
1636                                                         err,
1637                                                         my_var(aTHX_ 0, vk)
1638                                                 );
1639
1640                                                 croak = newCVREF(OPf_WANT_SCALAR,
1641                                                                  newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)));
1642                                                 nest = newUNOP(OP_ENTERSUB, OPf_STACKED,
1643                                                                op_append_elem(OP_LIST, err, croak));
1644                                         } else {
1645                                                 nest = NULL;
1646                                         }
1647
1648                                         for (i = param_spec->named_optional.used; i--; ) {
1649                                                 Param *cur = &param_spec->named_optional.data[i].param;
1650                                                 size_t dn;
1651                                                 char *dp = SvPV(cur->name, dn);
1652                                                 OP *vec;
1653
1654                                                 if (!(spec->flags & FLAG_CHECK_NARGS)) {
1655                                                         vec = NULL;
1656                                                 } else if (vc_is_str) {
1657                                                         vec = newASSIGNOP(
1658                                                                 OPf_STACKED,
1659                                                                 mkvecbits(aTHX_ vc, i),
1660                                                                 0,
1661                                                                 newSVOP(OP_CONST, 0, newSViv(1))
1662                                                         );
1663                                                 } else {
1664                                                         vec = newASSIGNOP(
1665                                                                 OPf_STACKED,
1666                                                                 my_var(aTHX_ 0, vc),
1667                                                                 OP_BIT_OR,
1668                                                                 newSVOP(OP_CONST, 0, newSVuv((UV)1 << i))
1669                                                         );
1670                                                 }
1671
1672                                                 nest = newCONDOP(
1673                                                         0,
1674                                                         newBINOP(
1675                                                                 OP_SEQ, 0,
1676                                                                 my_var(aTHX_ 0, vk),
1677                                                                 newSVOP(OP_CONST, 0, newSVpvn_utf8(dp + 1, dn - 1, SvUTF8(cur->name)))
1678                                                         ),
1679                                                         op_append_list(
1680                                                                 OP_LINESEQ,
1681                                                                 newASSIGNOP(
1682                                                                         OPf_STACKED,
1683                                                                         my_var(aTHX_ 0, cur->padoff),
1684                                                                         0,
1685                                                                         mkargselem(
1686                                                                                 aTHX_
1687                                                                                 newBINOP(
1688                                                                                         OP_ADD, 0,
1689                                                                                         my_var(aTHX_ 0, vi),
1690                                                                                         newSVOP(OP_CONST, 0, newSViv(1))
1691                                                                                 )
1692                                                                         )
1693                                                                 ),
1694                                                                 vec
1695                                                         ),
1696                                                         nest
1697                                                 );
1698                                         }
1699
1700                                         for (i = param_spec->named_required.used; i--; ) {
1701                                                 Param *cur = &param_spec->named_required.data[i];
1702                                                 size_t dn;
1703                                                 char *dp = SvPV(cur->name, dn);
1704                                                 OP *vec;
1705
1706                                                 if (!(spec->flags & FLAG_CHECK_NARGS)) {
1707                                                         vec = NULL;
1708                                                 } else if (vb_is_str) {
1709                                                         vec = newASSIGNOP(
1710                                                                 OPf_STACKED,
1711                                                                 mkvecbits(aTHX_ vb, i),
1712                                                                 0,
1713                                                                 newSVOP(OP_CONST, 0, newSViv(1))
1714                                                         );
1715                                                 } else {
1716                                                         vec = newASSIGNOP(
1717                                                                 OPf_STACKED,
1718                                                                 my_var(aTHX_ 0, vb),
1719                                                                 OP_BIT_OR,
1720                                                                 newSVOP(OP_CONST, 0, newSVuv((UV)1 << i))
1721                                                         );
1722                                                 }
1723
1724                                                 nest = newCONDOP(
1725                                                         0,
1726                                                         newBINOP(
1727                                                                 OP_SEQ, 0,
1728                                                                 my_var(aTHX_ 0, vk),
1729                                                                 newSVOP(OP_CONST, 0, newSVpvn_utf8(dp + 1, dn - 1, SvUTF8(cur->name)))
1730                                                         ),
1731                                                         op_append_list(
1732                                                                 OP_LINESEQ,
1733                                                                 newASSIGNOP(
1734                                                                         OPf_STACKED,
1735                                                                         my_var(aTHX_ 0, cur->padoff),
1736                                                                         0,
1737                                                                         mkargselem(
1738                                                                                 aTHX_
1739                                                                                 newBINOP(
1740                                                                                         OP_ADD, 0,
1741                                                                                         my_var(aTHX_ 0, vi),
1742                                                                                         newSVOP(OP_CONST, 0, newSViv(1))
1743                                                                                 )
1744                                                                         )
1745                                                                 ),
1746                                                                 vec
1747                                                         ),
1748                                                         nest
1749                                                 );
1750                                         }
1751
1752                                         loop = op_append_elem(OP_LINESEQ, loop, newSTATEOP(0, NULL, nest));
1753                                 }
1754
1755                                 loop = newWHILEOP(
1756                                         0, 1,
1757                                         NULL,
1758                                         newBINOP(
1759                                                 OP_LT, 0,
1760                                                 my_var(aTHX_ 0, vi),
1761                                                 newAVREF(newGVOP(OP_GV, 0, PL_defgv))
1762                                         ),
1763                                         loop,
1764                                         newASSIGNOP(
1765                                                 OPf_STACKED,
1766                                                 my_var(aTHX_ 0, vi),
1767                                                 OP_ADD,
1768                                                 newSVOP(OP_CONST, 0, newSViv(2))
1769                                         ),
1770                                         0
1771                                 );
1772
1773                                 nameblock = op_append_list(OP_LINESEQ, nameblock, newSTATEOP(0, NULL, loop));
1774                         }
1775
1776                         if (param_spec->named_required.used && (spec->flags & FLAG_CHECK_NARGS)) {
1777                                 OP *cond, *err, *croak, *join;
1778
1779                                 {
1780                                         size_t i, lim;
1781                                         OP *first, *mid, *last;
1782
1783                                         last = newNULLLIST();
1784                                         mid = last;
1785
1786                                         for (i = param_spec->named_required.used; i--; ) {
1787                                                 OP *cur;
1788                                                 SV *sv = param_spec->named_required.data[i].name;
1789                                                 size_t n;
1790                                                 char *p = SvPV(sv, n);
1791                                                 cur = newCONDOP(
1792                                                         0,
1793                                                         vb_is_str
1794                                                                 ? mkvecbits(aTHX_ vb, i)
1795                                                                 : newBINOP(OP_BIT_AND, 0, my_var(aTHX_ 0, vb), newSVOP(OP_CONST, 0, newSVuv((UV)1 << i)))
1796                                                         ,
1797                                                         newNULLLIST(),
1798                                                         newSVOP(OP_CONST, 0, newSVpvn_utf8(p + 1, n - 1, SvUTF8(sv)))
1799                                                 );
1800                                                 cur->op_sibling = mid;
1801                                                 mid = cur;
1802                                         }
1803
1804                                         first = newSVOP(OP_CONST, 0, newSVpvs(", "));
1805                                         first->op_sibling = mid;
1806                                         mid = first;
1807
1808                                         first = newOP(OP_PUSHMARK, 0);
1809
1810                                         join = newLISTOP(OP_JOIN, 0, first, mid);
1811                                         join->op_targ = pad_alloc(OP_JOIN, SVs_PADTMP);
1812                                         ((LISTOP *)join)->op_last = last;
1813                                 }
1814
1815                                 err = newSVOP(
1816                                         OP_CONST, 0,
1817                                         newSVpvf("In %"SVf": missing named parameter(s): ", SVfARG(declarator))
1818                                 );
1819                                 err = newBINOP(OP_CONCAT, 0, err, join);
1820                                 croak = newCVREF(
1821                                         OPf_WANT_SCALAR,
1822                                         newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1823                                 );
1824                                 err = newUNOP(
1825                                         OP_ENTERSUB,
1826                                         OPf_STACKED,
1827                                         op_append_elem(OP_LIST, err, croak)
1828                                 );
1829                                 if (vb_is_str) {
1830                                         cond = newBINOP(
1831                                                 OP_SNE, 0,
1832                                                 my_var(aTHX_ 0, vb),
1833                                                 newSVOP(OP_CONST, 0, mkbits1(aTHX_ param_spec->named_required.used))
1834                                         );
1835                                 } else {
1836                                         cond = newBINOP(
1837                                                 OP_NE, 0,
1838                                                 my_var(aTHX_ 0, vb),
1839                                                 newSVOP(
1840                                                         OP_CONST, 0,
1841                                                         newSVuv(
1842                                                                 param_spec->named_required.used == UV_BITS
1843                                                                 ? ~(UV)0
1844                                                                 : ((UV)1 << param_spec->named_required.used) - 1
1845                                                         )
1846                                                 )
1847                                         );
1848                                 }
1849                                 err = newCONDOP(
1850                                         0,
1851                                         cond,
1852                                         err,
1853                                         NULL
1854                                 );
1855
1856                                 nameblock = op_append_list(OP_LINESEQ, nameblock, err);
1857                         }
1858
1859                         if (param_spec->named_optional.used) {
1860                                 size_t i, lim;
1861
1862                                 for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) {
1863                                         ParamInit *const cur = &param_spec->named_optional.data[i];
1864                                         OP *init, *cond;
1865
1866                                         init = newASSIGNOP(
1867                                                 OPf_STACKED,
1868                                                 my_var(aTHX_ 0, cur->param.padoff),
1869                                                 0,
1870                                                 cur->init
1871                                         );
1872                                         cur->init = NULL;
1873
1874                                         cond = vc_is_str
1875                                                 ? mkvecbits(aTHX_ vc, i)
1876                                                 : newBINOP(OP_BIT_AND, 0, my_var(aTHX_ 0, vc), newSVOP(OP_CONST, 0, newSVuv((UV)1 << i)))
1877                                         ;
1878
1879                                         init = newCONDOP(0, cond, NULL, init);
1880
1881                                         nameblock = op_append_list(OP_LINESEQ, nameblock, newSTATEOP(0, NULL, init));
1882                                 }
1883                         }
1884
1885                         nameblock = S_block_end(aTHX_ nameblock_ix, nameblock);
1886                         nameblock = op_scope(nameblock);
1887
1888                         *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, nameblock);
1889                 }
1890         }
1891
1892         /* finally let perl parse the actual subroutine body */
1893         body = parse_block(0);
1894
1895         /* add '();' to make function return nothing by default */
1896         /* (otherwise the invisible parameter initialization can "leak" into
1897            the return value: fun ($x) {}->("asdf", 0) == 2) */
1898         if (*prelude_sentinel) {
1899                 body = newSTATEOP(0, NULL, body);
1900         }
1901
1902         body = op_append_list(OP_LINESEQ, *prelude_sentinel, body);
1903         *prelude_sentinel = NULL;
1904
1905         /* it's go time. */
1906         {
1907                 OP *const attrs = *attrs_sentinel;
1908                 *attrs_sentinel = NULL;
1909                 SvREFCNT_inc_simple_void(PL_compcv);
1910
1911                 /* close outer block: '}' */
1912                 S_block_end(aTHX_ save_ix, body);
1913
1914                 if (!saw_name) {
1915                         *pop = newANONATTRSUB(
1916                                 floor_ix,
1917                                 proto ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(proto)) : NULL,
1918                                 attrs,
1919                                 body
1920                         );
1921                         return KEYWORD_PLUGIN_EXPR;
1922                 }
1923
1924                 newATTRSUB(
1925                         floor_ix,
1926                         newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(saw_name)),
1927                         proto ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(proto)) : NULL,
1928                         attrs,
1929                         body
1930                 );
1931                 *pop = newOP(OP_NULL, 0);
1932                 return KEYWORD_PLUGIN_STMT;
1933         }
1934 }
1935
1936 static int my_keyword_plugin(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) {
1937         KWSpec spec;
1938         int ret;
1939
1940         SAVETMPS;
1941
1942         if (kw_flags(aTHX_ keyword_ptr, keyword_len, &spec)) {
1943                 ret = parse_fun(aTHX_ op_ptr, keyword_ptr, keyword_len, &spec);
1944         } else {
1945                 ret = next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
1946         }
1947
1948         FREETMPS;
1949
1950         return ret;
1951 }
1952
1953 WARNINGS_RESET
1954
1955 MODULE = Function::Parameters   PACKAGE = Function::Parameters
1956 PROTOTYPES: ENABLE
1957
1958 BOOT:
1959 WARNINGS_ENABLE {
1960         HV *const stash = gv_stashpvs(MY_PKG, GV_ADD);
1961         /**/
1962         newCONSTSUB(stash, "FLAG_NAME_OK",      newSViv(FLAG_NAME_OK));
1963         newCONSTSUB(stash, "FLAG_ANON_OK",      newSViv(FLAG_ANON_OK));
1964         newCONSTSUB(stash, "FLAG_DEFAULT_ARGS", newSViv(FLAG_DEFAULT_ARGS));
1965         newCONSTSUB(stash, "FLAG_CHECK_NARGS",  newSViv(FLAG_CHECK_NARGS));
1966         newCONSTSUB(stash, "FLAG_INVOCANT",     newSViv(FLAG_INVOCANT));
1967         newCONSTSUB(stash, "FLAG_NAMED_PARAMS", newSViv(FLAG_NAMED_PARAMS));
1968         newCONSTSUB(stash, "HINTK_KEYWORDS", newSVpvs(HINTK_KEYWORDS));
1969         newCONSTSUB(stash, "HINTK_FLAGS_",   newSVpvs(HINTK_FLAGS_));
1970         newCONSTSUB(stash, "HINTK_SHIFT_",   newSVpvs(HINTK_SHIFT_));
1971         newCONSTSUB(stash, "HINTK_ATTRS_",   newSVpvs(HINTK_ATTRS_));
1972         /**/
1973         next_keyword_plugin = PL_keyword_plugin;
1974         PL_keyword_plugin = my_keyword_plugin;
1975 } WARNINGS_RESET