autovivification.xs

   1 /* This file is part of the autovivification Perl module.
   2  * See http://search.cpan.org/dist/autovivification/ */
   3
   4 #define PERL_NO_GET_CONTEXT
   5 #include "EXTERN.h"
   6 #include "perl.h"
   7 #include "XSUB.h"
   8
   9 /* --- XS helpers ---------------------------------------------------------- */
  10
  11 #define XSH_PACKAGE "autovivification"
  12
  13 #include "xsh/caps.h"
  14 #include "xsh/util.h"
  15 #include "xsh/ops.h"
  16 #include "xsh/peep.h"
  17
  18 /* ... Lexical hints ....................................................... */
  19
  20 /* Used both for hints and op flags */
  21 #define A_HINT_STRICT 1
  22 #define A_HINT_WARN   2
  23 #define A_HINT_FETCH  4
  24 #define A_HINT_STORE  8
  25 #define A_HINT_EXISTS 16
  26 #define A_HINT_DELETE 32
  27 #define A_HINT_NOTIFY (A_HINT_STRICT|A_HINT_WARN)
  28 #define A_HINT_DO     (A_HINT_FETCH|A_HINT_STORE|A_HINT_EXISTS|A_HINT_DELETE)
  29 #define A_HINT_MASK   (A_HINT_NOTIFY|A_HINT_DO)
  30
  31 /* Only used in op flags */
  32 #define A_HINT_ROOT   64
  33 #define A_HINT_DEREF  128
  34
  35 #define XSH_HINTS_TYPE_UV 1
  36
  37 #include "xsh/hints.h"
  38
  39 #define a_hint() xsh_hints_detag(xsh_hints_fetch())
  40
  41 /* ... Thread-local storage ................................................ */
  42
  43 #define XSH_THREADS_COMPILE_TIME_PROTECTION 1
  44 #define XSH_THREADS_USER_CONTEXT            0
  45
  46 #include "xsh/threads.h"
  47
  48 /* --- Compatibility wrappers ---------------------------------------------- */
  49
  50 #ifndef HvNAME_get
  51 # define HvNAME_get(H) HvNAME(H)
  52 #endif
  53
  54 #ifndef HvNAMELEN_get
  55 # define HvNAMELEN_get(H) strlen(HvNAME_get(H))
  56 #endif
  57
  58 #ifndef A_HAS_MULTIDEREF
  59 # define A_HAS_MULTIDEREF XSH_HAS_PERL(5, 21, 7)
  60 #endif
  61
  62 /* ... Our vivify_ref() .................................................... */
  63
  64 /* Perl_vivify_ref() is not exported, so we have to reimplement it. */
  65
  66 #if A_HAS_MULTIDEREF
  67
  68 static SV *a_vivify_ref(pTHX_ SV *sv, int to_hash) {
  69 #define a_vivify_ref(S, TH) a_vivify_ref(aTHX_ (S), (TH))
  70  SvGETMAGIC(sv);
  71
  72  if (!SvOK(sv)) {
  73   SV *val;
  74
  75   if (SvREADONLY(sv))
  76    Perl_croak_no_modify();
  77
  78   /* Inlined prepare_SV_for_RV() */
  79   if (SvTYPE(sv) < SVt_PV && SvTYPE(sv) != SVt_IV) {
  80    sv_upgrade(sv, SVt_IV);
  81   } else if (SvTYPE(sv) >= SVt_PV) {
  82    SvPV_free(sv);
  83    SvLEN_set(sv, 0);
  84    SvCUR_set(sv, 0);
  85   }
  86
  87   val = to_hash ? MUTABLE_SV(newHV()) : MUTABLE_SV(newAV());
  88   SvRV_set(sv, val);
  89   SvROK_on(sv);
  90   SvSETMAGIC(sv);
  91   SvGETMAGIC(sv);
  92  }
  93
  94  if (SvGMAGICAL(sv)) {
  95   SV *msv = sv_newmortal();
  96   sv_setsv_nomg(msv, sv);
  97   return msv;
  98  }
  99
 100  return sv;
 101 }
 102
 103 #endif /* A_HAS_MULTIDEREF */
 104
 105 /* --- op => info map ------------------------------------------------------ */
 106
 107 typedef struct {
 108  OP   *(*old_pp)(pTHX);
 109  void   *next;
 110  UV      flags;
 111 } a_op_info;
 112
 113 #define PTABLE_NAME             ptable_map
 114 #define PTABLE_VAL_FREE(V)      PerlMemShared_free(V)
 115 #define PTABLE_VAL_NEED_CONTEXT 0
 116 #define PTABLE_NEED_DELETE      1
 117 #define PTABLE_NEED_WALK        0
 118
 119 #include "xsh/ptable.h"
 120
 121 #define ptable_map_store(T, K, V) ptable_map_store(aPMS_ (T), (K), (V))
 122 #define ptable_map_delete(T, K)   ptable_map_delete(aPMS_ (T), (K))
 123 #define ptable_map_free(T)        ptable_map_free(aPMS_ (T))
 124
 125 static ptable *a_op_map = NULL;
 126
 127 #ifdef USE_ITHREADS
 128
 129 #define dA_MAP_THX a_op_info a_op_map_tmp_oi
 130
 131 static perl_mutex a_op_map_mutex;
 132
 133 static const a_op_info *a_map_fetch(const OP *o, a_op_info *oi) {
 134  const a_op_info *val;
 135
 136  XSH_LOCK(&a_op_map_mutex);
 137
 138  val = ptable_fetch(a_op_map, o);
 139  if (val) {
 140   *oi = *val;
 141   val = oi;
 142  }
 143
 144  XSH_UNLOCK(&a_op_map_mutex);
 145
 146  return val;
 147 }
 148
 149 #define a_map_fetch(O) a_map_fetch((O), &a_op_map_tmp_oi)
 150
 151 #else /* USE_ITHREADS */
 152
 153 #define dA_MAP_THX dNOOP
 154
 155 #define a_map_fetch(O) ptable_fetch(a_op_map, (O))
 156
 157 #endif /* !USE_ITHREADS */
 158
 159 static const a_op_info *a_map_store_locked(pPMS_ const OP *o, OP *(*old_pp)(pTHX), void *next, UV flags) {
 160 #define a_map_store_locked(O, PP, N, F) a_map_store_locked(aPMS_ (O), (PP), (N), (F))
 161  a_op_info *oi;
 162
 163  if (!(oi = ptable_fetch(a_op_map, o))) {
 164   oi = PerlMemShared_malloc(sizeof *oi);
 165   ptable_map_store(a_op_map, o, oi);
 166  }
 167
 168  oi->old_pp = old_pp;
 169  oi->next   = next;
 170  oi->flags  = flags;
 171
 172  return oi;
 173 }
 174
 175 static void a_map_store(pTHX_ const OP *o, OP *(*old_pp)(pTHX), void *next, UV flags) {
 176 #define a_map_store(O, PP, N, F) a_map_store(aTHX_ (O), (PP), (N), (F))
 177  XSH_LOCK(&a_op_map_mutex);
 178
 179  a_map_store_locked(o, old_pp, next, flags);
 180
 181  XSH_UNLOCK(&a_op_map_mutex);
 182 }
 183
 184 static void a_map_delete(pTHX_ const OP *o) {
 185 #define a_map_delete(O) a_map_delete(aTHX_ (O))
 186  XSH_LOCK(&a_op_map_mutex);
 187
 188  ptable_map_delete(a_op_map, o);
 189
 190  XSH_UNLOCK(&a_op_map_mutex);
 191 }
 192
 193 static const OP *a_map_descend(const OP *o) {
 194  switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
 195   case OA_BASEOP:
 196   case OA_UNOP:
 197   case OA_BINOP:
 198   case OA_BASEOP_OR_UNOP:
 199    return cUNOPo->op_first;
 200   case OA_LIST:
 201   case OA_LISTOP:
 202    return cLISTOPo->op_last;
 203  }
 204
 205  return NULL;
 206 }
 207
 208 static void a_map_store_root(pTHX_ const OP *root, OP *(*old_pp)(pTHX), UV flags) {
 209 #define a_map_store_root(R, PP, F) a_map_store_root(aTHX_ (R), (PP), (F))
 210  const a_op_info *roi;
 211  a_op_info *oi;
 212  const OP *o = root;
 213
 214  XSH_LOCK(&a_op_map_mutex);
 215
 216  roi = a_map_store_locked(o, old_pp, (OP *) root, flags | A_HINT_ROOT);
 217
 218  while (o->op_flags & OPf_KIDS) {
 219   o = a_map_descend(o);
 220   if (!o)
 221    break;
 222   if ((oi = ptable_fetch(a_op_map, o))) {
 223    oi->flags &= ~A_HINT_ROOT;
 224    oi->next   = (a_op_info *) roi;
 225    break;
 226   }
 227  }
 228
 229  XSH_UNLOCK(&a_op_map_mutex);
 230
 231  return;
 232 }
 233
 234 static void a_map_update_flags_topdown(const OP *root, UV flags) {
 235  a_op_info *oi;
 236  const OP *o = root;
 237
 238  XSH_LOCK(&a_op_map_mutex);
 239
 240  flags &= ~A_HINT_ROOT;
 241
 242  do {
 243   if ((oi = ptable_fetch(a_op_map, o)))
 244    oi->flags = (oi->flags & A_HINT_ROOT) | flags;
 245   if (!(o->op_flags & OPf_KIDS))
 246    break;
 247   o = a_map_descend(o);
 248  } while (o);
 249
 250  XSH_UNLOCK(&a_op_map_mutex);
 251
 252  return;
 253 }
 254
 255 #define a_map_cancel(R) a_map_update_flags_topdown((R), 0)
 256
 257 static void a_map_update_flags_bottomup(const OP *o, UV flags, UV rflags) {
 258  a_op_info *oi;
 259
 260  XSH_LOCK(&a_op_map_mutex);
 261
 262  flags  &= ~A_HINT_ROOT;
 263  rflags |=  A_HINT_ROOT;
 264
 265  oi = ptable_fetch(a_op_map, o);
 266  while (!(oi->flags & A_HINT_ROOT)) {
 267   oi->flags = flags;
 268   oi        = oi->next;
 269  }
 270  oi->flags = rflags;
 271
 272  XSH_UNLOCK(&a_op_map_mutex);
 273
 274  return;
 275 }
 276
 277 /* ... Decide whether this expression should be autovivified or not ........ */
 278
 279 static UV a_map_resolve(const OP *o, const a_op_info *oi) {
 280  UV flags = 0, rflags;
 281  const OP *root;
 282  const a_op_info *roi = oi;
 283
 284  while (!(roi->flags & A_HINT_ROOT))
 285   roi = roi->next;
 286  if (!roi)
 287   goto cancel;
 288
 289  rflags = roi->flags & ~A_HINT_ROOT;
 290  if (!rflags)
 291   goto cancel;
 292
 293  root = roi->next;
 294  if (root->op_flags & OPf_MOD) {
 295   if (rflags & A_HINT_STORE)
 296    flags = (A_HINT_STORE|A_HINT_DEREF);
 297  } else if (rflags & A_HINT_FETCH)
 298    flags = (A_HINT_FETCH|A_HINT_DEREF);
 299
 300  if (!flags) {
 301 cancel:
 302   a_map_update_flags_bottomup(o, 0, 0);
 303   return 0;
 304  }
 305
 306  flags |= (rflags & A_HINT_NOTIFY);
 307  a_map_update_flags_bottomup(o, flags, 0);
 308
 309  return oi->flags & A_HINT_ROOT ? 0 : flags;
 310 }
 311
 312 /* ... Inspired from pp_defined() .......................................... */
 313
 314 static int a_undef(pTHX_ SV *sv) {
 315 #define a_undef(S) a_undef(aTHX_ (S))
 316  switch (SvTYPE(sv)) {
 317   case SVt_NULL:
 318    return 1;
 319   case SVt_PVAV:
 320    if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)
 321                       || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
 322     return 0;
 323    break;
 324   case SVt_PVHV:
 325    if (HvARRAY(sv) || SvGMAGICAL(sv)
 326                    || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
 327     return 0;
 328    break;
 329   default:
 330    SvGETMAGIC(sv);
 331    if (SvOK(sv))
 332     return 0;
 333  }
 334
 335  return 1;
 336 }
 337
 338 /* --- PP functions -------------------------------------------------------- */
 339
 340 /* Be aware that we restore PL_op->op_ppaddr from the pointer table old_pp
 341  * value, another extension might have saved our pp replacement as the ppaddr
 342  * for this op, so this doesn't ensure that our function will never be called
 343  * again. That's why we don't remove the op info from our map, so that it can
 344  * still run correctly if required. */
 345
 346 #ifdef DEBUGGING
 347
 348 static UV a_cop_hint(pTHX_ COP *cop) {
 349 #define a_cop_hint(C) a_cop_hint(aTHX_ (C))
 350  SV *hint;
 351
 352  if (!cop)
 353   return 0;
 354
 355  hint = cop_hints_fetch_pvn(cop, XSH_HINTS_KEY, XSH_HINTS_KEY_LEN, xsh_hints_key_hash, 0);
 356
 357  return hint ? xsh_hints_detag(hint) : 0;
 358 }
 359
 360 #endif
 361
 362 /* ... pp_rv2av ............................................................ */
 363
 364 static OP *a_pp_rv2av(pTHX) {
 365  dA_MAP_THX;
 366  const a_op_info *oi;
 367  dSP;
 368
 369  oi = a_map_fetch(PL_op);
 370
 371  XSH_ASSERT(a_cop_hint(PL_curcop));
 372  XSH_ASSERT(oi->flags & A_HINT_DEREF);
 373  XSH_ASSERT(oi->flags & A_HINT_DO);
 374
 375  if (a_undef(TOPs)) {
 376   /* We always need to push an empty array to fool the pp_aelem() that comes
 377    * later. */
 378   SV *av;
 379   (void) POPs;
 380   av = sv_2mortal((SV *) newAV());
 381   PUSHs(av);
 382   RETURN;
 383  }
 384
 385  return oi->old_pp(aTHX);
 386 }
 387
 388 /* ... pp_rv2hv ............................................................ */
 389
 390 static OP *a_pp_rv2hv_simple(pTHX) {
 391  dA_MAP_THX;
 392  const a_op_info *oi;
 393  dSP;
 394
 395  oi = a_map_fetch(PL_op);
 396
 397  XSH_ASSERT(a_cop_hint(PL_curcop));
 398  XSH_ASSERT(oi->flags & A_HINT_DEREF);
 399  XSH_ASSERT(oi->flags & A_HINT_DO);
 400
 401  if (a_undef(TOPs))
 402   RETURN;
 403
 404  return oi->old_pp(aTHX);
 405 }
 406
 407 static OP *a_pp_rv2hv(pTHX) {
 408  dA_MAP_THX;
 409  const a_op_info *oi;
 410  dSP;
 411
 412  oi = a_map_fetch(PL_op);
 413
 414  XSH_ASSERT(a_cop_hint(PL_curcop));
 415  XSH_ASSERT(oi->flags & A_HINT_DEREF);
 416  XSH_ASSERT(oi->flags & (A_HINT_FETCH|A_HINT_STORE));
 417
 418  if (a_undef(TOPs)) {
 419   SV *hv;
 420   (void) POPs;
 421   hv = sv_2mortal((SV *) newHV());
 422   PUSHs(hv);
 423   RETURN;
 424  }
 425
 426  return oi->old_pp(aTHX);
 427 }
 428
 429 /* ... pp_deref (aelem,helem,rv2sv,padsv) .................................. */
 430
 431 static void a_cannot_vivify(pTHX_ UV flags) {
 432 #define a_cannot_vivify(F) a_cannot_vivify(aTHX_ (F))
 433  if (flags & A_HINT_STRICT)
 434   croak("Reference vivification forbidden");
 435  else if (flags & A_HINT_WARN)
 436   warn("Reference was vivified");
 437  else /* A_HINT_STORE */
 438   croak("Can't vivify reference");
 439 }
 440
 441 static OP *a_pp_deref(pTHX) {
 442  dA_MAP_THX;
 443  const a_op_info *oi;
 444  UV flags;
 445  OP *o;
 446  dSP;
 447
 448  oi = a_map_fetch(PL_op);
 449
 450  XSH_ASSERT(a_cop_hint(PL_curcop));
 451  flags = oi->flags;
 452  XSH_ASSERT(oi->flags & A_HINT_DEREF);
 453  XSH_ASSERT(oi->flags & A_HINT_DO);
 454
 455  o = oi->old_pp(aTHX);
 456
 457  if (flags & (A_HINT_NOTIFY|A_HINT_STORE)) {
 458   SPAGAIN;
 459   if (a_undef(TOPs))
 460    a_cannot_vivify(flags);
 461  }
 462
 463  return o;
 464 }
 465
 466 /* ... pp_root (exists,delete,keys,values) ................................. */
 467
 468 static OP *a_pp_root_unop(pTHX) {
 469  dSP;
 470
 471  if (a_undef(TOPs)) {
 472   (void) POPs;
 473   /* Can only be reached by keys or values */
 474   if (GIMME_V == G_SCALAR) {
 475    dTARGET;
 476    PUSHi(0);
 477   }
 478   RETURN;
 479  }
 480
 481  {
 482   dA_MAP_THX;
 483   const a_op_info *oi = a_map_fetch(PL_op);
 484   return oi->old_pp(aTHX);
 485  }
 486 }
 487
 488 static OP *a_pp_root_binop(pTHX) {
 489  dSP;
 490
 491  if (a_undef(TOPm1s)) {
 492   (void) POPs;
 493   (void) POPs;
 494   if (PL_op->op_type == OP_EXISTS)
 495    RETPUSHNO;
 496   else
 497    RETPUSHUNDEF;
 498  }
 499
 500  {
 501   dA_MAP_THX;
 502   const a_op_info *oi = a_map_fetch(PL_op);
 503   return oi->old_pp(aTHX);
 504  }
 505 }
 506
 507 #if A_HAS_MULTIDEREF
 508
 509 /* ... pp_multideref ....................................................... */
 510
 511 /* This pp replacement is actually only called for topmost exists/delete ops,
 512  * because we hijack the [ah]elem check functions and this disables the
 513  * optimization for lvalue and rvalue dereferencing. In particular, the
 514  * OPf_MOD branches should never be covered. In the future, the multideref
 515  * optimization might also be disabled for custom exists/delete check functions,
 516  * which will make this section unnecessary. However, the code tries to be as
 517  * general as possible in case I think of a way to reenable the multideref
 518  * optimization even when this module is in use. */
 519
 520 static UV a_do_multideref(const OP *o, UV flags) {
 521  UV isexdel, other_flags;
 522
 523  XSH_ASSERT(o->op_type == OP_MULTIDEREF);
 524
 525  other_flags = flags & ~A_HINT_DO;
 526
 527  isexdel = o->op_private & (OPpMULTIDEREF_EXISTS|OPpMULTIDEREF_DELETE);
 528  if (isexdel) {
 529   if (isexdel & OPpMULTIDEREF_EXISTS) {
 530    flags &= A_HINT_EXISTS;
 531   } else {
 532    flags &= A_HINT_DELETE;
 533   }
 534  } else {
 535   if (o->op_flags & OPf_MOD) {
 536    flags &= A_HINT_STORE;
 537   } else {
 538    flags &= A_HINT_FETCH;
 539   }
 540  }
 541
 542  return flags ? (flags | other_flags) : 0;
 543 }
 544
 545 static SV *a_do_fake_pp(pTHX_ OP *op) {
 546 #define a_do_fake_pp(O) a_do_fake_pp(aTHX_ (O))
 547  {
 548   OP *o = PL_op;
 549   ENTER;
 550   SAVEOP();
 551   PL_op = op;
 552   PL_op->op_ppaddr(aTHX);
 553   PL_op = o;
 554   LEAVE;
 555  }
 556
 557  {
 558   SV *ret;
 559   dSP;
 560   ret = POPs;
 561   PUTBACK;
 562   return ret;
 563  }
 564 }
 565
 566 static void a_do_fake_pp_unop_init(pTHX_ UNOP *unop, U32 type, U32 flags) {
 567 #define a_do_fake_pp_unop_init(O, T, F) a_do_fake_pp_unop_init(aTHX_ (O), (T), (F))
 568  unop->op_type    = type;
 569  unop->op_flags   = OPf_WANT_SCALAR | (~OPf_WANT & flags);
 570  unop->op_private = 0;
 571  unop->op_first   = NULL;
 572  unop->op_ppaddr  = PL_ppaddr[type];
 573 }
 574
 575 static SV *a_do_fake_pp_unop_arg1(pTHX_ U32 type, U32 flags, SV *arg) {
 576 #define a_do_fake_pp_unop_arg1(T, F, A) a_do_fake_pp_unop_arg1(aTHX_ (T), (F), (A))
 577  UNOP unop;
 578  dSP;
 579
 580  a_do_fake_pp_unop_init(&unop, type, flags);
 581
 582  EXTEND(SP, 1);
 583  PUSHs(arg);
 584  PUTBACK;
 585
 586  return a_do_fake_pp((OP *) &unop);
 587 }
 588
 589 static SV *a_do_fake_pp_unop_arg2(pTHX_ U32 type, U32 flags, SV *arg1, SV *arg2) {
 590 #define a_do_fake_pp_unop_arg2(T, F, A1, A2) a_do_fake_pp_unop_arg2(aTHX_ (T), (F), (A1), (A2))
 591  UNOP unop;
 592  dSP;
 593
 594  a_do_fake_pp_unop_init(&unop, type, flags);
 595
 596  EXTEND(SP, 2);
 597  PUSHs(arg1);
 598  PUSHs(arg2);
 599  PUTBACK;
 600
 601  return a_do_fake_pp((OP *) &unop);
 602 }
 603
 604 #define a_do_pp_rv2av(R)        a_do_fake_pp_unop_arg1(OP_RV2AV,  OPf_REF,     (R))
 605 #define a_do_pp_afetch(A, I)    a_do_fake_pp_unop_arg2(OP_AELEM,  0,           (A), (I))
 606 #define a_do_pp_afetch_lv(A, I) a_do_fake_pp_unop_arg2(OP_AELEM,  OPf_MOD,     (A), (I))
 607 #define a_do_pp_aexists(A, I)   a_do_fake_pp_unop_arg2(OP_EXISTS, OPf_SPECIAL, (A), (I))
 608 #define a_do_pp_adelete(A, I)   a_do_fake_pp_unop_arg2(OP_DELETE, OPf_SPECIAL, (A), (I))
 609
 610 #define a_do_pp_rv2hv(R)        a_do_fake_pp_unop_arg1(OP_RV2HV,  OPf_REF, (R))
 611 #define a_do_pp_hfetch(H, K)    a_do_fake_pp_unop_arg2(OP_HELEM,  0,       (H), (K))
 612 #define a_do_pp_hfetch_lv(H, K) a_do_fake_pp_unop_arg2(OP_HELEM,  OPf_MOD, (H), (K))
 613 #define a_do_pp_hexists(H, K)   a_do_fake_pp_unop_arg2(OP_EXISTS, 0,  (H), (K))
 614 #define a_do_pp_hdelete(H, K)   a_do_fake_pp_unop_arg2(OP_DELETE, 0,  (H), (K))
 615
 616 static OP *a_pp_multideref(pTHX) {
 617  UNOP_AUX_item *items;
 618  UV  actions;
 619  UV  flags = 0;
 620  SV *sv    = NULL;
 621  dSP;
 622
 623  XSH_ASSERT(a_cop_hint(PL_curcop));
 624
 625  {
 626   dA_MAP_THX;
 627   const a_op_info *oi = a_map_fetch(PL_op);
 628   XSH_ASSERT(oi);
 629   flags = a_do_multideref(PL_op, oi->flags);
 630   XSH_ASSERT(flags & A_HINT_DO);
 631  }
 632
 633  items   = cUNOP_AUXx(PL_op)->op_aux;
 634  actions = items->uv;
 635
 636  PL_multideref_pc = items;
 637
 638  while (1) {
 639   switch (actions & MDEREF_ACTION_MASK) {
 640    case MDEREF_reload:
 641     actions = (++items)->uv;
 642     continue;
 643    case MDEREF_AV_padav_aelem: /* $lex[...] */
 644     sv = PAD_SVl((++items)->pad_offset);
 645     if (a_undef(sv))
 646      goto ret_undef;
 647     goto do_AV_aelem;
 648    case MDEREF_AV_gvav_aelem: /* $pkg[...] */
 649     sv = UNOP_AUX_item_sv(++items);
 650     XSH_ASSERT(isGV_with_GP(sv));
 651     sv = (SV *) GvAVn((GV *) sv);
 652     if (a_undef(sv))
 653      goto ret_undef;
 654     goto do_AV_aelem;
 655    case MDEREF_AV_pop_rv2av_aelem: /* expr->[...] */
 656     sv = POPs;
 657     if (a_undef(sv))
 658      goto ret_undef;
 659     goto do_AV_rv2av_aelem;
 660    case MDEREF_AV_gvsv_vivify_rv2av_aelem: /* $pkg->[...] */
 661     sv = UNOP_AUX_item_sv(++items);
 662     XSH_ASSERT(isGV_with_GP(sv));
 663     sv = GvSVn((GV *) sv);
 664     if (a_undef(sv))
 665      goto ret_undef;
 666     goto do_AV_vivify_rv2av_aelem;
 667    case MDEREF_AV_padsv_vivify_rv2av_aelem: /* $lex->[...] */
 668     sv = PAD_SVl((++items)->pad_offset);
 669     /* FALLTHROUGH */
 670    case MDEREF_AV_vivify_rv2av_aelem: /* vivify, ->[...] */
 671     if (a_undef(sv))
 672      goto ret_undef;
 673 do_AV_vivify_rv2av_aelem:
 674     sv = a_vivify_ref(sv, 0);
 675 do_AV_rv2av_aelem:
 676     sv = a_do_pp_rv2av(sv);
 677 do_AV_aelem:
 678     {
 679      SV *esv;
 680      XSH_ASSERT(SvTYPE(sv) == SVt_PVAV);
 681      switch (actions & MDEREF_INDEX_MASK) {
 682       case MDEREF_INDEX_none:
 683        goto finish;
 684       case MDEREF_INDEX_const:
 685        esv = sv_2mortal(newSViv((++items)->iv));
 686        break;
 687       case MDEREF_INDEX_padsv:
 688        esv = PAD_SVl((++items)->pad_offset);
 689        goto check_elem;
 690       case MDEREF_INDEX_gvsv:
 691        esv = UNOP_AUX_item_sv(++items);
 692        XSH_ASSERT(isGV_with_GP(esv));
 693        esv = GvSVn((GV *) esv);
 694 check_elem:
 695        if (UNLIKELY(SvROK(esv) && !SvGAMAGIC(esv) && ckWARN(WARN_MISC)))
 696         Perl_warner(aTHX_ packWARN(WARN_MISC),
 697                           "Use of reference \"%"SVf"\" as array index",
 698                           SVfARG(esv));
 699        break;
 700      }
 701      PL_multideref_pc = items;
 702      if (actions & MDEREF_FLAG_last) {
 703       switch (flags & A_HINT_DO) {
 704        case A_HINT_FETCH:
 705         sv = a_do_pp_afetch(sv, esv);
 706         break;
 707        case A_HINT_STORE:
 708         sv = a_do_pp_afetch_lv(sv, esv);
 709         break;
 710        case A_HINT_EXISTS:
 711         sv = a_do_pp_aexists(sv, esv);
 712         break;
 713        case A_HINT_DELETE:
 714         sv = a_do_pp_adelete(sv, esv);
 715         break;
 716       }
 717       goto finish;
 718      }
 719      sv = a_do_pp_afetch(sv, esv);
 720      break;
 721     }
 722    case MDEREF_HV_padhv_helem: /* $lex{...} */
 723     sv = PAD_SVl((++items)->pad_offset);
 724     if (a_undef(sv))
 725      goto ret_undef;
 726     goto do_HV_helem;
 727    case MDEREF_HV_gvhv_helem: /* $pkg{...} */
 728     sv = UNOP_AUX_item_sv(++items);
 729     XSH_ASSERT(isGV_with_GP(sv));
 730     sv = (SV *) GvHVn((GV *) sv);
 731     if (a_undef(sv))
 732      goto ret_undef;
 733     goto do_HV_helem;
 734    case MDEREF_HV_pop_rv2hv_helem: /* expr->{...} */
 735     sv = POPs;
 736     if (a_undef(sv))
 737      goto ret_undef;
 738     goto do_HV_rv2hv_helem;
 739    case MDEREF_HV_gvsv_vivify_rv2hv_helem: /* $pkg->{...} */
 740     sv = UNOP_AUX_item_sv(++items);
 741     XSH_ASSERT(isGV_with_GP(sv));
 742     sv = GvSVn((GV *) sv);
 743     if (a_undef(sv))
 744      goto ret_undef;
 745     goto do_HV_vivify_rv2hv_helem;
 746    case MDEREF_HV_padsv_vivify_rv2hv_helem: /* $lex->{...} */
 747     sv = PAD_SVl((++items)->pad_offset);
 748     /* FALLTHROUGH */
 749    case MDEREF_HV_vivify_rv2hv_helem: /* vivify, ->{...} */
 750     if (a_undef(sv))
 751      goto ret_undef;
 752 do_HV_vivify_rv2hv_helem:
 753     sv = a_vivify_ref(sv, 1);
 754 do_HV_rv2hv_helem:
 755     sv = a_do_pp_rv2hv(sv);
 756 do_HV_helem:
 757     {
 758      SV *key;
 759      XSH_ASSERT(SvTYPE(sv) == SVt_PVHV);
 760      switch (actions & MDEREF_INDEX_MASK) {
 761       case MDEREF_INDEX_none:
 762        goto finish;
 763       case MDEREF_INDEX_const:
 764        key = UNOP_AUX_item_sv(++items);
 765        break;
 766       case MDEREF_INDEX_padsv:
 767        key = PAD_SVl((++items)->pad_offset);
 768        break;
 769       case MDEREF_INDEX_gvsv:
 770        key = UNOP_AUX_item_sv(++items);
 771        XSH_ASSERT(isGV_with_GP(key));
 772        key = GvSVn((GV *) key);
 773        break;
 774      }
 775      PL_multideref_pc = items;
 776      if (actions & MDEREF_FLAG_last) {
 777       switch (flags & A_HINT_DO) {
 778        case A_HINT_FETCH:
 779         sv = a_do_pp_hfetch(sv, key);
 780         break;
 781        case A_HINT_STORE:
 782         sv = a_do_pp_hfetch_lv(sv, key);
 783         break;
 784        case A_HINT_EXISTS:
 785         sv = a_do_pp_hexists(sv, key);
 786         break;
 787        case A_HINT_DELETE:
 788         sv = a_do_pp_hdelete(sv, key);
 789         break;
 790        default:
 791         break;
 792       }
 793       goto finish;
 794      }
 795      sv = a_do_pp_hfetch(sv, key);
 796      break;
 797     }
 798   }
 799
 800   actions >>= MDEREF_SHIFT;
 801  }
 802
 803 ret_undef:
 804  if (flags & (A_HINT_NOTIFY|A_HINT_STORE))
 805   a_cannot_vivify(flags);
 806  if (flags & A_HINT_EXISTS)
 807   sv = &PL_sv_no;
 808  else
 809   sv = &PL_sv_undef;
 810 finish:
 811  XPUSHs(sv);
 812  RETURN;
 813 }
 814
 815 #endif /* A_HAS_MULTIDEREF */
 816
 817 /* --- Check functions ----------------------------------------------------- */
 818
 819 static void a_recheck_rv2xv(pTHX_ OP *o, OPCODE type, OP *(*new_pp)(pTHX)) {
 820 #define a_recheck_rv2xv(O, T, PP) a_recheck_rv2xv(aTHX_ (O), (T), (PP))
 821
 822  if (o->op_type == type && o->op_ppaddr != new_pp
 823                         && cUNOPo->op_first->op_type != OP_GV) {
 824   dA_MAP_THX;
 825   const a_op_info *oi = a_map_fetch(o);
 826   if (oi) {
 827    a_map_store(o, o->op_ppaddr, oi->next, oi->flags);
 828    o->op_ppaddr = new_pp;
 829   }
 830  }
 831
 832  return;
 833 }
 834
 835 /* ... ck_pad{any,sv} ...................................................... */
 836
 837 /* Sadly, the padsv OPs we are interested in don't trigger the padsv check
 838  * function, but are instead manually mutated from a padany. So we store
 839  * the op entry in the op map in the padany check function, and we set their
 840  * op_ppaddr member in our peephole optimizer replacement below. */
 841
 842 static OP *(*a_old_ck_padany)(pTHX_ OP *) = 0;
 843
 844 static OP *a_ck_padany(pTHX_ OP *o) {
 845  UV hint;
 846
 847  o = a_old_ck_padany(aTHX_ o);
 848
 849  hint = a_hint();
 850  if (hint & A_HINT_DO)
 851   a_map_store_root(o, o->op_ppaddr, hint);
 852  else
 853   a_map_delete(o);
 854
 855  return o;
 856 }
 857
 858 static OP *(*a_old_ck_padsv)(pTHX_ OP *) = 0;
 859
 860 static OP *a_ck_padsv(pTHX_ OP *o) {
 861  UV hint;
 862
 863  o = a_old_ck_padsv(aTHX_ o);
 864
 865  hint = a_hint();
 866  if (hint & A_HINT_DO) {
 867   a_map_store_root(o, o->op_ppaddr, hint);
 868   o->op_ppaddr = a_pp_deref;
 869  } else
 870   a_map_delete(o);
 871
 872  return o;
 873 }
 874
 875 /* ... ck_deref (aelem,helem,rv2sv) ........................................ */
 876
 877 /* Those ops appear both at the root and inside an expression but there's no
 878  * way to distinguish both situations. Worse, we can't even know if we are in a
 879  * modifying context, so the expression can't be resolved yet. It will be at the
 880  * first invocation of a_pp_deref() for this expression. */
 881
 882 static OP *(*a_old_ck_aelem)(pTHX_ OP *) = 0;
 883 static OP *(*a_old_ck_helem)(pTHX_ OP *) = 0;
 884 static OP *(*a_old_ck_rv2sv)(pTHX_ OP *) = 0;
 885
 886 static OP *a_ck_deref(pTHX_ OP *o) {
 887  OP * (*old_ck)(pTHX_ OP *o) = 0;
 888  UV hint = a_hint();
 889
 890  switch (o->op_type) {
 891   case OP_AELEM:
 892    old_ck = a_old_ck_aelem;
 893    if ((hint & A_HINT_DO) && !(hint & A_HINT_STRICT))
 894     a_recheck_rv2xv(cUNOPo->op_first, OP_RV2AV, a_pp_rv2av);
 895    break;
 896   case OP_HELEM:
 897    old_ck = a_old_ck_helem;
 898    if ((hint & A_HINT_DO) && !(hint & A_HINT_STRICT))
 899     a_recheck_rv2xv(cUNOPo->op_first, OP_RV2HV, a_pp_rv2hv_simple);
 900    break;
 901   case OP_RV2SV:
 902    old_ck = a_old_ck_rv2sv;
 903    break;
 904  }
 905  o = old_ck(aTHX_ o);
 906
 907 #if A_HAS_MULTIDEREF
 908  if (old_ck == a_old_ck_rv2sv && o->op_flags & OPf_KIDS) {
 909   OP *kid = cUNOPo->op_first;
 910   if (kid && kid->op_type == OP_GV) {
 911    if (hint & A_HINT_DO)
 912     a_map_store(kid, kid->op_ppaddr, NULL, hint);
 913    else
 914     a_map_delete(kid);
 915   }
 916  }
 917 #endif
 918
 919  if (hint & A_HINT_DO) {
 920   a_map_store_root(o, o->op_ppaddr, hint);
 921   o->op_ppaddr = a_pp_deref;
 922  } else
 923   a_map_delete(o);
 924
 925  return o;
 926 }
 927
 928 /* ... ck_rv2xv (rv2av,rv2hv) .............................................. */
 929
 930 /* Those ops also appear both inisde and at the root, hence the caveats for
 931  * a_ck_deref() still apply here. Since a padsv/rv2sv must appear before a
 932  * rv2[ah]v, resolution is handled by the first call to a_pp_deref() in the
 933  * expression. */
 934
 935 static OP *(*a_old_ck_rv2av)(pTHX_ OP *) = 0;
 936 static OP *(*a_old_ck_rv2hv)(pTHX_ OP *) = 0;
 937
 938 static OP *a_ck_rv2xv(pTHX_ OP *o) {
 939  OP * (*old_ck)(pTHX_ OP *o) = 0;
 940  OP * (*new_pp)(pTHX)        = 0;
 941  UV hint;
 942
 943  switch (o->op_type) {
 944   case OP_RV2AV: old_ck = a_old_ck_rv2av; new_pp = a_pp_rv2av; break;
 945   case OP_RV2HV: old_ck = a_old_ck_rv2hv; new_pp = a_pp_rv2hv_simple; break;
 946  }
 947  o = old_ck(aTHX_ o);
 948
 949  if (cUNOPo->op_first->op_type == OP_GV)
 950   return o;
 951
 952  hint = a_hint();
 953  if (hint & A_HINT_DO && !(hint & A_HINT_STRICT)) {
 954   a_map_store_root(o, o->op_ppaddr, hint);
 955   o->op_ppaddr = new_pp;
 956  } else
 957   a_map_delete(o);
 958
 959  return o;
 960 }
 961
 962 /* ... ck_xslice (aslice,hslice) ........................................... */
 963
 964 /* I think those are only found at the root, but there's nothing that really
 965  * prevent them to be inside the expression too. We only need to update the
 966  * root so that the rest of the expression will see the right context when
 967  * resolving. That's why we don't replace the ppaddr. */
 968
 969 static OP *(*a_old_ck_aslice)(pTHX_ OP *) = 0;
 970 static OP *(*a_old_ck_hslice)(pTHX_ OP *) = 0;
 971
 972 static OP *a_ck_xslice(pTHX_ OP *o) {
 973  OP * (*old_ck)(pTHX_ OP *o) = 0;
 974  UV hint = a_hint();
 975
 976  switch (o->op_type) {
 977   case OP_ASLICE:
 978    old_ck = a_old_ck_aslice;
 979    break;
 980   case OP_HSLICE:
 981    old_ck = a_old_ck_hslice;
 982    if (hint & A_HINT_DO)
 983     a_recheck_rv2xv(OpSIBLING(cUNOPo->op_first), OP_RV2HV, a_pp_rv2hv);
 984    break;
 985  }
 986  o = old_ck(aTHX_ o);
 987
 988  if (hint & A_HINT_DO) {
 989   a_map_store_root(o, 0, hint);
 990  } else
 991   a_map_delete(o);
 992
 993  return o;
 994 }
 995
 996 /* ... ck_root (exists,delete,keys,values) ................................. */
 997
 998 /* Those ops are only found at the root of a dereferencing expression. We can
 999  * then resolve at compile time if vivification must take place or not. */
1000
1001 static OP *(*a_old_ck_exists)(pTHX_ OP *) = 0;
1002 static OP *(*a_old_ck_delete)(pTHX_ OP *) = 0;
1003 static OP *(*a_old_ck_keys)  (pTHX_ OP *) = 0;
1004 static OP *(*a_old_ck_values)(pTHX_ OP *) = 0;
1005
1006 static OP *a_ck_root(pTHX_ OP *o) {
1007  OP * (*old_ck)(pTHX_ OP *o) = 0;
1008  OP * (*new_pp)(pTHX)        = 0;
1009  bool enabled = FALSE;
1010  UV hint = a_hint();
1011
1012  switch (o->op_type) {
1013   case OP_EXISTS:
1014    old_ck  = a_old_ck_exists;
1015    new_pp  = a_pp_root_binop;
1016    enabled = hint & A_HINT_EXISTS;
1017    break;
1018   case OP_DELETE:
1019    old_ck  = a_old_ck_delete;
1020    new_pp  = a_pp_root_binop;
1021    enabled = hint & A_HINT_DELETE;
1022    break;
1023   case OP_KEYS:
1024    old_ck  = a_old_ck_keys;
1025    new_pp  = a_pp_root_unop;
1026    enabled = hint & A_HINT_FETCH;
1027    break;
1028   case OP_VALUES:
1029    old_ck  = a_old_ck_values;
1030    new_pp  = a_pp_root_unop;
1031    enabled = hint & A_HINT_FETCH;
1032    break;
1033  }
1034  o = old_ck(aTHX_ o);
1035
1036  if (hint & A_HINT_DO) {
1037   if (enabled) {
1038    a_map_update_flags_topdown(o, hint | A_HINT_DEREF);
1039    a_map_store_root(o, o->op_ppaddr, hint);
1040    o->op_ppaddr = new_pp;
1041   } else {
1042    a_map_cancel(o);
1043   }
1044  } else
1045   a_map_delete(o);
1046
1047  return o;
1048 }
1049
1050 /* --- Our peephole optimizer ---------------------------------------------- */
1051
1052 static void xsh_peep_rec(pTHX_ OP *o, ptable *seen) {
1053 #ifdef DEBUGGING
1054  COP *last_cop = NULL;
1055 #endif
1056
1057  for (; o; o = o->op_next) {
1058   dA_MAP_THX;
1059   const a_op_info *oi = NULL;
1060   UV flags = 0;
1061
1062   if (xsh_peep_seen(o, seen))
1063    break;
1064
1065   switch (o->op_type) {
1066 #ifdef DEBUGGING
1067    case OP_NEXTSTATE:
1068    case OP_DBSTATE:
1069     last_cop = o;
1070     break;
1071 #endif
1072    case OP_PADSV:
1073     if (o->op_ppaddr != a_pp_deref) {
1074      oi = a_map_fetch(o);
1075      if (oi && (oi->flags & A_HINT_DO)) {
1076       a_map_store(o, o->op_ppaddr, oi->next, oi->flags);
1077 #ifdef DEBUGGING
1078       XSH_ASSERT(!last_cop || a_cop_hint(last_cop));
1079 #endif
1080       o->op_ppaddr = a_pp_deref;
1081      }
1082     }
1083     /* FALLTHROUGH */
1084    case OP_AELEM:
1085    case OP_AELEMFAST:
1086    case OP_HELEM:
1087    case OP_RV2SV:
1088     if (o->op_ppaddr != a_pp_deref)
1089      break;
1090     oi = a_map_fetch(o);
1091     if (!oi)
1092      break;
1093     flags = oi->flags;
1094     if (!(flags & A_HINT_DEREF)
1095         && (flags & A_HINT_DO)
1096         && (o->op_private & OPpDEREF || flags & A_HINT_ROOT)) {
1097      /* Decide if the expression must autovivify or not. */
1098      flags = a_map_resolve(o, oi);
1099     }
1100     if (flags & A_HINT_DEREF)
1101      o->op_private = ((o->op_private & ~OPpDEREF) | OPpLVAL_DEFER);
1102     else
1103      o->op_ppaddr  = oi->old_pp;
1104     break;
1105    case OP_RV2AV:
1106    case OP_RV2HV:
1107     if (   o->op_ppaddr != a_pp_rv2av
1108         && o->op_ppaddr != a_pp_rv2hv
1109         && o->op_ppaddr != a_pp_rv2hv_simple)
1110      break;
1111     oi = a_map_fetch(o);
1112     if (!oi)
1113      break;
1114     if (!(oi->flags & A_HINT_DEREF))
1115      o->op_ppaddr  = oi->old_pp;
1116     break;
1117 #if A_HAS_MULTIDEREF
1118    case OP_MULTIDEREF:
1119     if (o->op_ppaddr != a_pp_multideref) {
1120      oi = a_map_fetch(cUNOPo->op_first);
1121      if (!oi)
1122       break;
1123      flags = oi->flags;
1124      if (a_do_multideref(o, flags)) {
1125       a_map_store_root(o, o->op_ppaddr, flags & ~A_HINT_DEREF);
1126       o->op_ppaddr = a_pp_multideref;
1127      }
1128     }
1129     break;
1130 #endif
1131    default:
1132     xsh_peep_maybe_recurse(o, seen);
1133     break;
1134   }
1135  }
1136 }
1137
1138 /* --- Module setup/teardown ----------------------------------------------- */
1139
1140 static void xsh_user_global_setup(pTHX) {
1141  a_op_map = ptable_new(32);
1142
1143 #ifdef USE_ITHREADS
1144  MUTEX_INIT(&a_op_map_mutex);
1145 #endif
1146
1147  xsh_ck_replace(OP_PADANY, a_ck_padany, &a_old_ck_padany);
1148  xsh_ck_replace(OP_PADSV,  a_ck_padsv,  &a_old_ck_padsv);
1149
1150  xsh_ck_replace(OP_AELEM,  a_ck_deref,  &a_old_ck_aelem);
1151  xsh_ck_replace(OP_HELEM,  a_ck_deref,  &a_old_ck_helem);
1152  xsh_ck_replace(OP_RV2SV,  a_ck_deref,  &a_old_ck_rv2sv);
1153
1154  xsh_ck_replace(OP_RV2AV,  a_ck_rv2xv,  &a_old_ck_rv2av);
1155  xsh_ck_replace(OP_RV2HV,  a_ck_rv2xv,  &a_old_ck_rv2hv);
1156
1157  xsh_ck_replace(OP_ASLICE, a_ck_xslice, &a_old_ck_aslice);
1158  xsh_ck_replace(OP_HSLICE, a_ck_xslice, &a_old_ck_hslice);
1159
1160  xsh_ck_replace(OP_EXISTS, a_ck_root,   &a_old_ck_exists);
1161  xsh_ck_replace(OP_DELETE, a_ck_root,   &a_old_ck_delete);
1162  xsh_ck_replace(OP_KEYS,   a_ck_root,   &a_old_ck_keys);
1163  xsh_ck_replace(OP_VALUES, a_ck_root,   &a_old_ck_values);
1164
1165  return;
1166 }
1167
1168 static void xsh_user_local_setup(pTHX) {
1169  HV *stash;
1170
1171  stash = gv_stashpvn(XSH_PACKAGE, XSH_PACKAGE_LEN, 1);
1172  newCONSTSUB(stash, "A_HINT_STRICT", newSVuv(A_HINT_STRICT));
1173  newCONSTSUB(stash, "A_HINT_WARN",   newSVuv(A_HINT_WARN));
1174  newCONSTSUB(stash, "A_HINT_FETCH",  newSVuv(A_HINT_FETCH));
1175  newCONSTSUB(stash, "A_HINT_STORE",  newSVuv(A_HINT_STORE));
1176  newCONSTSUB(stash, "A_HINT_EXISTS", newSVuv(A_HINT_EXISTS));
1177  newCONSTSUB(stash, "A_HINT_DELETE", newSVuv(A_HINT_DELETE));
1178  newCONSTSUB(stash, "A_HINT_MASK",   newSVuv(A_HINT_MASK));
1179  newCONSTSUB(stash, "A_THREADSAFE",  newSVuv(XSH_THREADSAFE));
1180  newCONSTSUB(stash, "A_FORKSAFE",    newSVuv(XSH_FORKSAFE));
1181
1182  return;
1183 }
1184
1185 static void xsh_user_local_teardown(pTHX) {
1186  return;
1187 }
1188
1189 static void xsh_user_global_teardown(pTHX) {
1190  xsh_ck_restore(OP_PADANY, &a_old_ck_padany);
1191  xsh_ck_restore(OP_PADSV,  &a_old_ck_padsv);
1192
1193  xsh_ck_restore(OP_AELEM,  &a_old_ck_aelem);
1194  xsh_ck_restore(OP_HELEM,  &a_old_ck_helem);
1195  xsh_ck_restore(OP_RV2SV,  &a_old_ck_rv2sv);
1196
1197  xsh_ck_restore(OP_RV2AV,  &a_old_ck_rv2av);
1198  xsh_ck_restore(OP_RV2HV,  &a_old_ck_rv2hv);
1199
1200  xsh_ck_restore(OP_ASLICE, &a_old_ck_aslice);
1201  xsh_ck_restore(OP_HSLICE, &a_old_ck_hslice);
1202
1203  xsh_ck_restore(OP_EXISTS, &a_old_ck_exists);
1204  xsh_ck_restore(OP_DELETE, &a_old_ck_delete);
1205  xsh_ck_restore(OP_KEYS,   &a_old_ck_keys);
1206  xsh_ck_restore(OP_VALUES, &a_old_ck_values);
1207
1208  ptable_map_free(a_op_map);
1209  a_op_map = NULL;
1210
1211 #ifdef USE_ITHREADS
1212  MUTEX_DESTROY(&a_op_map_mutex);
1213 #endif
1214
1215  return;
1216 }
1217
1218 /* --- XS ------------------------------------------------------------------ */
1219
1220 MODULE = autovivification      PACKAGE = autovivification
1221
1222 PROTOTYPES: ENABLE
1223
1224 BOOT:
1225 {
1226  xsh_setup();
1227 }
1228
1229 #if XSH_THREADSAFE
1230
1231 void
1232 CLONE(...)
1233 PROTOTYPE: DISABLE
1234 PPCODE:
1235  xsh_clone();
1236  XSRETURN(0);
1237
1238 #endif /* XSH_THREADSAFE */
1239
1240 SV *
1241 _tag(SV *hint)
1242 PROTOTYPE: $
1243 CODE:
1244  RETVAL = xsh_hints_tag(SvOK(hint) ? SvUV(hint) : 0);
1245 OUTPUT:
1246  RETVAL
1247
1248 SV *
1249 _detag(SV *tag)
1250 PROTOTYPE: $
1251 CODE:
1252  if (!SvOK(tag))
1253   XSRETURN_UNDEF;
1254  RETVAL = newSVuv(xsh_hints_detag(tag));
1255 OUTPUT:
1256  RETVAL