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 #define __PACKAGE__     "autovivification"
  10 #define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1)
  11
  12 /* --- Compatibility wrappers ---------------------------------------------- */
  13
  14 #define A_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
  15
  16 #ifndef A_WORKAROUND_REQUIRE_PROPAGATION
  17 # define A_WORKAROUND_REQUIRE_PROPAGATION !A_HAS_PERL(5, 10, 1)
  18 #endif
  19
  20 /* --- Helpers ------------------------------------------------------------- */
  21
  22 #if A_WORKAROUND_REQUIRE_PROPAGATION
  23
  24 typedef struct {
  25  UV  bits;
  26  I32 requires;
  27 } a_hint_t;
  28
  29 STATIC SV *a_tag(pTHX_ UV bits) {
  30 #define a_tag(B) a_tag(aTHX_ (B))
  31  SV *tag;
  32  a_hint_t h;
  33
  34  h.bits = bits;
  35
  36  {
  37   const PERL_SI *si;
  38   I32            requires = 0;
  39
  40   for (si = PL_curstackinfo; si; si = si->si_prev) {
  41    I32 cxix;
  42
  43    for (cxix = si->si_cxix; cxix >= 0; --cxix) {
  44     const PERL_CONTEXT *cx = si->si_cxstack + cxix;
  45
  46     if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE)
  47      ++requires;
  48    }
  49   }
  50
  51   h.requires = requires;
  52  }
  53
  54  return newSVpvn((const char *) &h, sizeof h);
  55 }
  56
  57 STATIC UV a_detag(pTHX_ const SV *hint) {
  58 #define a_detag(H) a_detag(aTHX_ (H))
  59  const a_hint_t *h;
  60
  61  if (!(hint && SvOK(hint)))
  62   return 0;
  63
  64  h = (const a_hint_t *) SvPVX(hint);
  65
  66  {
  67   const PERL_SI *si;
  68   I32            requires = 0;
  69
  70   for (si = PL_curstackinfo; si; si = si->si_prev) {
  71    I32 cxix;
  72
  73    for (cxix = si->si_cxix; cxix >= 0; --cxix) {
  74     const PERL_CONTEXT *cx = si->si_cxstack + cxix;
  75
  76     if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE
  77                                && ++requires > h->requires)
  78      return 0;
  79    }
  80   }
  81  }
  82
  83  return h->bits;
  84 }
  85
  86 #else /* A_WORKAROUND_REQUIRE_PROPAGATION */
  87
  88 #define a_tag(B)   newSVuv(B)
  89 #define a_detag(H) (((H) && SvOK(H)) ? SvUVX(H) : 0)
  90
  91 #endif /* !A_WORKAROUND_REQUIRE_PROPAGATION */
  92
  93 /* Used both for hints and op flags */
  94 #define A_HINT_STRICT 1
  95 #define A_HINT_WARN   2
  96 #define A_HINT_FETCH  4
  97 #define A_HINT_STORE  8
  98 #define A_HINT_EXISTS 16
  99 #define A_HINT_DELETE 32
 100 #define A_HINT_NOTIFY (A_HINT_STRICT|A_HINT_WARN)
 101 #define A_HINT_DO     (A_HINT_FETCH|A_HINT_STORE|A_HINT_EXISTS|A_HINT_DELETE)
 102 #define A_HINT_MASK   (A_HINT_NOTIFY|A_HINT_DO)
 103
 104 /* Only used in op flags */
 105 #define A_HINT_DEREF  64
 106
 107 STATIC U32 a_hash = 0;
 108
 109 STATIC UV a_hint(pTHX) {
 110 #define a_hint() a_hint(aTHX)
 111  const SV *hint;
 112 #if A_HAS_PERL(5, 9, 5)
 113  hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
 114                                        NULL,
 115                                        __PACKAGE__, __PACKAGE_LEN__,
 116                                        0,
 117                                        a_hash);
 118 #else
 119  SV **val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__, a_hash);
 120  if (!val)
 121   return 0;
 122  hint = *val;
 123 #endif
 124  return a_detag(hint);
 125 }
 126
 127 /* ... op => info map ...................................................... */
 128
 129 typedef struct {
 130  OP *(*old_pp)(pTHX);
 131  const OP *root;
 132  UV flags;
 133 } a_op_info;
 134
 135 #define PTABLE_NAME        ptable_map
 136 #define PTABLE_VAL_FREE(V) PerlMemShared_free(V)
 137
 138 #include "ptable.h"
 139
 140 /* PerlMemShared_free() needs the [ap]PTBLMS_? default values */
 141 #define ptable_map_store(T, K, V) ptable_map_store(aPTBLMS_ (T), (K), (V))
 142
 143 STATIC ptable *a_op_map = NULL;
 144
 145 #ifdef USE_ITHREADS
 146 STATIC perl_mutex a_op_map_mutex;
 147 #endif
 148
 149 STATIC void a_map_store(pPTBLMS_ const OP *o, OP *(*old_pp)(pTHX), UV flags) {
 150 #define a_map_store(O, PP, F) a_map_store(aPTBLMS_ (O), (PP), (F))
 151  a_op_info *oi;
 152
 153 #ifdef USE_ITHREADS
 154  MUTEX_LOCK(&a_op_map_mutex);
 155 #endif
 156
 157  if (!(oi = ptable_fetch(a_op_map, o))) {
 158   oi = PerlMemShared_malloc(sizeof *oi);
 159   ptable_map_store(a_op_map, o, oi);
 160  }
 161
 162  oi->old_pp = old_pp;
 163  oi->root   = NULL;
 164  oi->flags  = flags;
 165
 166 #ifdef USE_ITHREADS
 167  MUTEX_UNLOCK(&a_op_map_mutex);
 168 #endif
 169 }
 170
 171 STATIC const a_op_info *a_map_fetch(const OP *o, a_op_info *oi) {
 172  const a_op_info *val;
 173
 174 #ifdef USE_ITHREADS
 175  MUTEX_LOCK(&a_op_map_mutex);
 176 #endif
 177
 178  val = ptable_fetch(a_op_map, o);
 179  *oi = *val;
 180
 181 #ifdef USE_ITHREADS
 182  MUTEX_UNLOCK(&a_op_map_mutex);
 183 #endif
 184
 185  return val;
 186 }
 187
 188 STATIC void a_map_delete(pTHX_ const OP *o) {
 189 #define a_map_delete(O) a_map_delete(aTHX_ (O))
 190 #ifdef USE_ITHREADS
 191  MUTEX_LOCK(&a_op_map_mutex);
 192 #endif
 193
 194  ptable_map_store(a_op_map, o, NULL);
 195
 196 #ifdef USE_ITHREADS
 197  MUTEX_UNLOCK(&a_op_map_mutex);
 198 #endif
 199 }
 200
 201 STATIC void a_map_set_root(const OP *root, UV flags) {
 202  a_op_info *oi;
 203  const OP *o = root;
 204
 205 #ifdef USE_ITHREADS
 206  MUTEX_LOCK(&a_op_map_mutex);
 207 #endif
 208
 209  while (o) {
 210   if (oi = ptable_fetch(a_op_map, o)) {
 211    oi->root  = root;
 212    oi->flags = flags;
 213   }
 214   if (!(o->op_flags & OPf_KIDS))
 215    break;
 216   switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
 217    case OA_BASEOP:
 218    case OA_UNOP:
 219    case OA_BINOP:
 220    case OA_BASEOP_OR_UNOP:
 221     o = cUNOPo->op_first;
 222     break;
 223    case OA_LIST:
 224    case OA_LISTOP:
 225     o = cLISTOPo->op_last;
 226     break;
 227    default:
 228     goto done;
 229   }
 230  }
 231
 232 done:
 233 #ifdef USE_ITHREADS
 234  MUTEX_UNLOCK(&a_op_map_mutex);
 235 #endif
 236
 237  return;
 238 }
 239
 240 /* ... Lightweight pp_defined() ............................................ */
 241
 242 STATIC bool a_defined(pTHX_ SV *sv) {
 243 #define a_defined(S) a_defined(aTHX_ (S))
 244  bool defined = FALSE;
 245
 246  switch (SvTYPE(sv)) {
 247   case SVt_PVAV:
 248    if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)
 249                       || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
 250     defined = TRUE;
 251    break;
 252   case SVt_PVHV:
 253    if (HvARRAY(sv) || SvGMAGICAL(sv)
 254                    || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
 255     defined = TRUE;
 256    break;
 257   default:
 258    defined = SvOK(sv);
 259  }
 260
 261  return defined;
 262 }
 263
 264 /* --- PP functions -------------------------------------------------------- */
 265
 266 /* ... pp_rv2av ............................................................ */
 267
 268 STATIC OP *a_pp_rv2av(pTHX) {
 269  a_op_info oi;
 270  UV hint;
 271  dSP;
 272
 273  a_map_fetch(PL_op, &oi);
 274
 275  if (PL_op == oi.root) { /* This means "@$arrayref" */
 276   PL_op->op_ppaddr = oi.old_pp;
 277  } else if (!SvOK(TOPs)) {
 278   /* We always need to push an empty array to fool the pp_aelem() that comes
 279    * later. */
 280   SV *av;
 281   POPs;
 282   av = sv_2mortal((SV *) newAV());
 283   PUSHs(av);
 284   RETURN;
 285  }
 286
 287  return CALL_FPTR(oi.old_pp)(aTHX);
 288 }
 289
 290 /* ... pp_rv2hv ............................................................ */
 291
 292 STATIC OP *a_pp_rv2hv(pTHX) {
 293  a_op_info oi;
 294  UV hint;
 295  dSP;
 296
 297  a_map_fetch(PL_op, &oi);
 298
 299  if (PL_op == oi.root) { /* This means "%$hashref" */
 300   PL_op->op_ppaddr = oi.old_pp;
 301  } else if (!SvOK(TOPs)) {
 302   if (oi.root->op_flags & OPf_MOD) {
 303    SV *hv;
 304    POPs;
 305    hv = sv_2mortal((SV *) newHV());
 306    PUSHs(hv);
 307   }
 308   RETURN;
 309  }
 310
 311  return CALL_FPTR(oi.old_pp)(aTHX);
 312 }
 313
 314 /* ... pp_deref (aelem,helem,rv2sv,padsv) .................................. */
 315
 316 STATIC OP *a_pp_deref(pTHX) {
 317  a_op_info oi;
 318  UV flags;
 319  dSP;
 320
 321  a_map_fetch(PL_op, &oi);
 322  flags = oi.flags;
 323
 324  if (flags & A_HINT_DEREF) {
 325   OP *o;
 326   U8 old_private;
 327
 328 deref:
 329   old_private       = PL_op->op_private;
 330   PL_op->op_private = ((old_private & ~OPpDEREF) | OPpLVAL_DEFER);
 331   o = CALL_FPTR(oi.old_pp)(aTHX);
 332   PL_op->op_private = old_private;
 333
 334   if (flags & (A_HINT_NOTIFY|A_HINT_STORE)) {
 335    SPAGAIN;
 336    if (!SvOK(TOPs)) {
 337     if (flags & A_HINT_STRICT)
 338      croak("Reference vivification forbidden");
 339     else if (flags & A_HINT_WARN)
 340       warn("Reference was vivified");
 341     else /* A_HINT_STORE */
 342      croak("Can't vivify reference");
 343    }
 344   }
 345
 346   return o;
 347  } else if (flags && (PL_op->op_private & OPpDEREF || PL_op == oi.root)) {
 348   oi.flags = flags & A_HINT_NOTIFY;
 349
 350   if ((oi.root->op_flags & (OPf_MOD|OPf_REF)) != (OPf_MOD|OPf_REF)) {
 351    if (flags & A_HINT_FETCH)
 352     oi.flags |= (A_HINT_FETCH|A_HINT_DEREF);
 353   } else if (flags & A_HINT_STORE)
 354     oi.flags |= (A_HINT_STORE|A_HINT_DEREF);
 355
 356   if (PL_op == oi.root)
 357    oi.flags &= ~A_HINT_DEREF;
 358
 359   /* We will need the updated flags value in the deref part */
 360   flags = oi.flags;
 361
 362   if (flags & A_HINT_DEREF)
 363    goto deref;
 364
 365   /* This op doesn't need to skip autovivification, so restore the original
 366    * state. Be aware that another extension might have saved a_pp_deref as the
 367    * ppaddr for this op, so restoring PL_op->op_ppaddr doesn't ensure that this
 368    * function will never be called again. That's why we don't remove the op info
 369    * from our map and we reset oi.flags to 0, so that it can still run correctly
 370    * if required. */
 371   oi.flags = 0;
 372   PL_op->op_ppaddr = oi.old_pp;
 373  }
 374
 375  return CALL_FPTR(oi.old_pp)(aTHX);
 376 }
 377
 378 /* ... pp_root (exists,delete,keys,values) ................................. */
 379
 380 STATIC OP *a_pp_root_unop(pTHX) {
 381  a_op_info oi;
 382  dSP;
 383
 384  if (!a_defined(TOPs)) {
 385   POPs;
 386   /* Can only be reached by keys or values */
 387   if (GIMME_V == G_SCALAR) {
 388    dTARGET;
 389    PUSHi(0);
 390   }
 391   RETURN;
 392  }
 393
 394  a_map_fetch(PL_op, &oi);
 395
 396  return CALL_FPTR(oi.old_pp)(aTHX);
 397 }
 398
 399 STATIC OP *a_pp_root_binop(pTHX) {
 400  a_op_info oi;
 401  dSP;
 402
 403  if (!a_defined(TOPm1s)) {
 404   POPs;
 405   POPs;
 406   if (PL_op->op_type == OP_EXISTS)
 407    RETPUSHNO;
 408   else
 409    RETPUSHUNDEF;
 410  }
 411
 412  a_map_fetch(PL_op, &oi);
 413
 414  return CALL_FPTR(oi.old_pp)(aTHX);
 415 }
 416
 417 /* --- Check functions ----------------------------------------------------- */
 418
 419 /* ... ck_pad{any,sv} ...................................................... */
 420
 421 /* Sadly, the PADSV OPs we are interested in don't trigger the padsv check
 422  * function, but are instead manually mutated from a PADANY. This is why we set
 423  * PL_ppaddr[OP_PADSV] in the padany check function so that PADSV OPs will have
 424  * their op_ppaddr set to our pp_padsv. PL_ppaddr[OP_PADSV] is then reset at the
 425  * beginning of every ck_pad{any,sv}. Some unwanted OPs can still call our
 426  * pp_padsv, but much less than if we would have set PL_ppaddr[OP_PADSV]
 427  * globally. */
 428
 429 STATIC OP *(*a_pp_padsv_saved)(pTHX) = 0;
 430
 431 STATIC void a_pp_padsv_save(void) {
 432  if (a_pp_padsv_saved)
 433   return;
 434
 435  a_pp_padsv_saved    = PL_ppaddr[OP_PADSV];
 436  PL_ppaddr[OP_PADSV] = a_pp_deref;
 437 }
 438
 439 STATIC void a_pp_padsv_restore(OP *o) {
 440  if (!a_pp_padsv_saved)
 441   return;
 442
 443  if (o->op_ppaddr == a_pp_deref)
 444   o->op_ppaddr = a_pp_padsv_saved;
 445
 446  PL_ppaddr[OP_PADSV] = a_pp_padsv_saved;
 447  a_pp_padsv_saved    = 0;
 448 }
 449
 450 STATIC OP *(*a_old_ck_padany)(pTHX_ OP *) = 0;
 451
 452 STATIC OP *a_ck_padany(pTHX_ OP *o) {
 453  UV hint;
 454
 455  a_pp_padsv_restore(o);
 456
 457  o = CALL_FPTR(a_old_ck_padany)(aTHX_ o);
 458
 459  hint = a_hint();
 460  if (hint & A_HINT_DO) {
 461   a_pp_padsv_save();
 462   a_map_store(o, a_pp_padsv_saved, hint);
 463  } else
 464   a_map_delete(o);
 465
 466  return o;
 467 }
 468
 469 STATIC OP *(*a_old_ck_padsv)(pTHX_ OP *) = 0;
 470
 471 STATIC OP *a_ck_padsv(pTHX_ OP *o) {
 472  UV hint;
 473
 474  a_pp_padsv_restore(o);
 475
 476  o = CALL_FPTR(a_old_ck_padsv)(aTHX_ o);
 477
 478  hint = a_hint();
 479  if (hint & A_HINT_DO) {
 480   a_map_store(o, o->op_ppaddr, hint);
 481   o->op_ppaddr = a_pp_deref;
 482  } else
 483   a_map_delete(o);
 484
 485  return o;
 486 }
 487
 488 /* ... ck_deref (aelem,helem,rv2sv) ........................................ */
 489
 490 STATIC OP *(*a_old_ck_aelem)(pTHX_ OP *) = 0;
 491 STATIC OP *(*a_old_ck_helem)(pTHX_ OP *) = 0;
 492 STATIC OP *(*a_old_ck_rv2sv)(pTHX_ OP *) = 0;
 493
 494 STATIC OP *a_ck_deref(pTHX_ OP *o) {
 495  OP * (*old_ck)(pTHX_ OP *o) = 0;
 496  UV hint;
 497
 498  switch (o->op_type) {
 499   case OP_AELEM: old_ck = a_old_ck_aelem; break;
 500   case OP_HELEM: old_ck = a_old_ck_helem; break;
 501   case OP_RV2SV: old_ck = a_old_ck_rv2sv; break;
 502  }
 503  o = CALL_FPTR(old_ck)(aTHX_ o);
 504
 505  hint = a_hint();
 506  if (hint & A_HINT_DO) {
 507   a_map_store(o, o->op_ppaddr, hint);
 508   o->op_ppaddr = a_pp_deref;
 509   a_map_set_root(o, hint);
 510  } else
 511   a_map_delete(o);
 512
 513  return o;
 514 }
 515
 516 /* ... ck_rv2xv (rv2av,rv2hv) .............................................. */
 517
 518 STATIC OP *(*a_old_ck_rv2av)(pTHX_ OP *) = 0;
 519 STATIC OP *(*a_old_ck_rv2hv)(pTHX_ OP *) = 0;
 520
 521 STATIC OP *a_ck_rv2xv(pTHX_ OP *o) {
 522  OP * (*old_ck)(pTHX_ OP *o) = 0;
 523  OP * (*new_pp)(pTHX)        = 0;
 524  UV hint;
 525
 526  switch (o->op_type) {
 527   case OP_RV2AV: old_ck = a_old_ck_rv2av; new_pp = a_pp_rv2av; break;
 528   case OP_RV2HV: old_ck = a_old_ck_rv2hv; new_pp = a_pp_rv2hv; break;
 529  }
 530  o = CALL_FPTR(old_ck)(aTHX_ o);
 531
 532  if (cUNOPo->op_first->op_type == OP_GV)
 533   return o;
 534
 535  hint = a_hint();
 536  if (hint & A_HINT_DO) {
 537   if (!(hint & A_HINT_STRICT)) {
 538    a_map_store(o, o->op_ppaddr, hint);
 539    o->op_ppaddr = new_pp;
 540   }
 541   a_map_set_root(o, hint);
 542  } else
 543   a_map_delete(o);
 544
 545  return o;
 546 }
 547
 548 /* ... ck_root (exists,delete,keys,values) ................................. */
 549
 550 STATIC OP *(*a_old_ck_exists)(pTHX_ OP *) = 0;
 551 STATIC OP *(*a_old_ck_delete)(pTHX_ OP *) = 0;
 552 STATIC OP *(*a_old_ck_keys)  (pTHX_ OP *) = 0;
 553 STATIC OP *(*a_old_ck_values)(pTHX_ OP *) = 0;
 554
 555 STATIC OP *a_ck_root(pTHX_ OP *o) {
 556  OP * (*old_ck)(pTHX_ OP *o) = 0;
 557  OP * (*new_pp)(pTHX)        = 0;
 558  bool enabled = FALSE;
 559  UV hint = a_hint();
 560
 561  switch (o->op_type) {
 562   case OP_EXISTS:
 563    old_ck  = a_old_ck_exists;
 564    new_pp  = a_pp_root_binop;
 565    enabled = hint & A_HINT_EXISTS;
 566    break;
 567   case OP_DELETE:
 568    old_ck  = a_old_ck_delete;
 569    new_pp  = a_pp_root_binop;
 570    enabled = hint & A_HINT_DELETE;
 571    break;
 572   case OP_KEYS:
 573    old_ck  = a_old_ck_keys;
 574    new_pp  = a_pp_root_unop;
 575    enabled = hint & A_HINT_FETCH;
 576    break;
 577   case OP_VALUES:
 578    old_ck  = a_old_ck_values;
 579    new_pp  = a_pp_root_unop;
 580    enabled = hint & A_HINT_FETCH;
 581    break;
 582  }
 583  o = CALL_FPTR(old_ck)(aTHX_ o);
 584
 585  if (hint & A_HINT_DO) {
 586   if (enabled) {
 587    a_map_set_root(o, hint | A_HINT_DEREF);
 588    a_map_store(o, o->op_ppaddr, hint);
 589    o->op_ppaddr = new_pp;
 590   } else {
 591    a_map_set_root(o, 0);
 592   }
 593  } else
 594   a_map_delete(o);
 595
 596  return o;
 597 }
 598
 599 STATIC U32 a_initialized = 0;
 600
 601 /* --- XS ------------------------------------------------------------------ */
 602
 603 MODULE = autovivification      PACKAGE = autovivification
 604
 605 PROTOTYPES: ENABLE
 606
 607 BOOT:
 608 {
 609  if (!a_initialized++) {
 610   HV *stash;
 611
 612   a_op_map = ptable_new();
 613 #ifdef USE_ITHREADS
 614   MUTEX_INIT(&a_op_map_mutex);
 615 #endif
 616
 617   PERL_HASH(a_hash, __PACKAGE__, __PACKAGE_LEN__);
 618
 619   a_old_ck_padany     = PL_check[OP_PADANY];
 620   PL_check[OP_PADANY] = MEMBER_TO_FPTR(a_ck_padany);
 621   a_old_ck_padsv      = PL_check[OP_PADSV];
 622   PL_check[OP_PADSV]  = MEMBER_TO_FPTR(a_ck_padsv);
 623
 624   a_old_ck_aelem      = PL_check[OP_AELEM];
 625   PL_check[OP_AELEM]  = MEMBER_TO_FPTR(a_ck_deref);
 626   a_old_ck_helem      = PL_check[OP_HELEM];
 627   PL_check[OP_HELEM]  = MEMBER_TO_FPTR(a_ck_deref);
 628   a_old_ck_rv2sv      = PL_check[OP_RV2SV];
 629   PL_check[OP_RV2SV]  = MEMBER_TO_FPTR(a_ck_deref);
 630
 631   a_old_ck_rv2av      = PL_check[OP_RV2AV];
 632   PL_check[OP_RV2AV]  = MEMBER_TO_FPTR(a_ck_rv2xv);
 633   a_old_ck_rv2hv      = PL_check[OP_RV2HV];
 634   PL_check[OP_RV2HV]  = MEMBER_TO_FPTR(a_ck_rv2xv);
 635
 636   a_old_ck_exists     = PL_check[OP_EXISTS];
 637   PL_check[OP_EXISTS] = MEMBER_TO_FPTR(a_ck_root);
 638   a_old_ck_delete     = PL_check[OP_DELETE];
 639   PL_check[OP_DELETE] = MEMBER_TO_FPTR(a_ck_root);
 640   a_old_ck_keys       = PL_check[OP_KEYS];
 641   PL_check[OP_KEYS]   = MEMBER_TO_FPTR(a_ck_root);
 642   a_old_ck_values     = PL_check[OP_VALUES];
 643   PL_check[OP_VALUES] = MEMBER_TO_FPTR(a_ck_root);
 644
 645   stash = gv_stashpvn(__PACKAGE__, __PACKAGE_LEN__, 1);
 646   newCONSTSUB(stash, "A_HINT_STRICT", newSVuv(A_HINT_STRICT));
 647   newCONSTSUB(stash, "A_HINT_WARN",   newSVuv(A_HINT_WARN));
 648   newCONSTSUB(stash, "A_HINT_FETCH",  newSVuv(A_HINT_FETCH));
 649   newCONSTSUB(stash, "A_HINT_STORE",  newSVuv(A_HINT_STORE));
 650   newCONSTSUB(stash, "A_HINT_EXISTS", newSVuv(A_HINT_EXISTS));
 651   newCONSTSUB(stash, "A_HINT_DELETE", newSVuv(A_HINT_DELETE));
 652   newCONSTSUB(stash, "A_HINT_MASK",   newSVuv(A_HINT_MASK));
 653  }
 654 }
 655
 656 SV *
 657 _tag(SV *hint)
 658 PROTOTYPE: $
 659 CODE:
 660  RETVAL = a_tag(SvOK(hint) ? SvUV(hint) : 0);
 661 OUTPUT:
 662  RETVAL
 663
 664 SV *
 665 _detag(SV *tag)
 666 PROTOTYPE: $
 667 CODE:
 668  if (!SvOK(tag))
 669   XSRETURN_UNDEF;
 670  RETVAL = newSVuv(a_detag(tag));
 671 OUTPUT:
 672  RETVAL