view release on metacpan or  search on metacpan

XS.xs  view on Meta::CPAN

    {
      RITER_T i, count = hv_iterinit (hv);
      HE *hes_stack [STACK_HES];
      HE **hes = hes_stack;
      int is_tied = 0;

      if (SvMAGICAL (hv))
        {
          if (SvTIED_mg((SV*)hv, PERL_MAGIC_tied))
            is_tied = 1;
          /* really should be calling magic_scalarpack(hv, mg) here, but I doubt it will be correct */
          /* TODO For tied hashes we should check if the iterator is already canonical (same sort order)
             as it would be with a DB tree e.g. and skip our slow sorting. */

          /* need to count by iterating. could improve by dynamically building the vector below */
          /* but I don't care for the speed of this special case. */
          count = 0;
          while (hv_iternext (hv))
            ++count;

          (void)hv_iterinit (hv);
        }

      /* one key does not need to be sorted */
      if (count > 0)
        {
          int has_utf8 = 0;

          /* allocate larger arrays on the heap */
          if (count > STACK_HES)
            {
              SV *sv = sv_2mortal (NEWSV (0, count * sizeof (*hes)));
              hes = (HE **)SvPVX (sv);
            }

          i = 0;
          /* fill the HE vector and check if SVKEY or UTF8 */
          while ((he = hv_iternext (hv)))
            {
              if (UNLIKELY(is_tied))
                { // tied entries are completely freed in the next iteration
                  HE *he1;
                  Newz(0,he1,1,HE);
                  he1->hent_hek = (HEK*)safecalloc (1, sizeof (struct hek) + sizeof (SV*) + 2);
                  HeVAL(he1) = hv_iterval(hv, he);
                  HeSVKEY_set (he1, hv_iterkeysv(he));
                  hes[i++] = he1;
                }
              else
                hes[i++] = he;
              /* check the SV for UTF8 and seperate use bytes handling */
              if (!has_utf8)
                {
                  if (He_IS_SVKEY(he))
                    has_utf8 = SvUTF8(HeSVKEY(he));
                  else
                    has_utf8 = HeKUTF8(he);
                }
            }

          /* Undefined behaviour when the two iterations do not result in the same count.
             With threads::shared or broken tie. The last HEs might be NULL then or we'll
             miss some. */
          if (i != count)
            croak ("Unstable %shash key counts %d vs %d in subsequent runs",
                   is_tied ? "tied " : "", (int)count, (int)i);
          assert (i == count);

          /* one key does not need to be sorted */
          if (count > 1)
            {

              if (!has_utf8)
                {
                  /* TODO With threads::shared check for qsort_r */
                  qsort (hes, count, sizeof (HE *), is_tied ? he_cmp_tied : he_cmp_fast);
                }
              else
                {
                  /* hack to forcefully disable "use bytes".
                     Changed in 5.9.4 a98fe34d09e2476f1a21bfb9dc730dc9ab02b0b4 */
                  COP cop = *PL_curcop;
#if PERL_VERSION < 10
                  cop.op_private &= ~HINT_BYTES;
#else
                  cop.cop_hints &= ~HINT_BYTES;
#endif

                  ENTER; SAVETMPS;

                  SAVEVPTR (PL_curcop);
                  PL_curcop = &cop;

                  /* TODO With threads::shared check for qsort_r */
                  qsort (hes, count, sizeof (HE *), is_tied ? he_cmp_tied : he_cmp_slow);

                  FREETMPS;
                  LEAVE;
                }
            }

          encode_nl (aTHX_ enc); ++enc->indent;

          while (count--)
            {
              char *key;
              I32 klen;

              encode_indent (aTHX_ enc);
              he = hes[count];
              retrieve_hk (aTHX_ he, &key, &klen);
              encode_hk (aTHX_ enc, key, klen);

              if (UNLIKELY (PTR2UV (typehv)))
                {
                  SV **typesv_ref = hv_fetch (typehv, key, klen, 0);
                  if (UNLIKELY (!typesv_ref))
                    croak ("no type was specified for hash key '%s'", key);

                  typesv = *typesv_ref;
                }