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