/* Must be defined before including Perl header files or we slow down by 2x! */
#define PERL_NO_GET_CONTEXT

#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#define NEED_newSV_type
#define NEED_newSVpvn_flags
#include "ppport.h"
#ifdef __cplusplus
}
#endif

#ifndef PERL_VERSION
#    include <patchlevel.h>
#    if !(defined(PERL_VERSION) || (PERL_SUBVERSION > 0 && defined(PATCHLEVEL)))
#        include <could_not_find_Perl_patchlevel.h>
#    endif
#    define PERL_REVISION       5
#    define PERL_VERSION        PATCHLEVEL
#    define PERL_SUBVERSION     PERL_SUBVERSION
#endif
#if PERL_VERSION < 8
#   define PERL_MAGIC_qr                  'r' /* precompiled qr// regex */
#   define BFD_Svs_SMG_OR_RMG SVs_RMG
#elif ((PERL_VERSION==8) && (PERL_SUBVERSION >= 1) || (PERL_VERSION>8))
#   define BFD_Svs_SMG_OR_RMG SVs_SMG
#   define MY_PLACEHOLDER PL_sv_placeholder
#else
#   define BFD_Svs_SMG_OR_RMG SVs_RMG
#   define MY_PLACEHOLDER PL_sv_undef
#endif
#if (((PERL_VERSION == 9) && (PERL_SUBVERSION >= 4)) || (PERL_VERSION > 9))
#   define NEW_REGEX_ENGINE 1
#endif
#if (((PERL_VERSION == 8) && (PERL_SUBVERSION >= 1)) || (PERL_VERSION > 8))
#define MY_CAN_FIND_PLACEHOLDERS
#define HAS_SV2OBJ
#endif
#if (PERL_VERSION < 10)
#   define FIXUP_RITER 1
#endif
#if (PERL_VERSION >= 10)
#   define FAST_IV 1
#endif

#define DEFAULT_MAX_RECUR_DEPTH 10000

#if !defined(HAVE_CSNAPPY)
# include "snappy/csnappy_decompress.c"
#endif

#include "srl_decoder.h"

#include "srl_common.h"
#include "ptable.h"
#include "srl_reader.h"
#include "srl_reader_error.h"
#include "srl_reader_varint.h"
#include "srl_reader_misc.h"
#include "srl_reader_decompress.h"
#include "srl_protocol.h"
#include "srl_taginfo.h"

/* 5.8.8 and earlier have a nasty bug in their handling of overloading:
 * The overload-flag is set on the referer of the blessed object instead of
 * the referent. That means that our late-bless logic breaks for
 * multiply-occurring objects.
 * So for 5.8.8 and earlier, the easiest workaround is to bless as we go
 * instead of blessing at the end of a decode run. Additionally, on repeatedly
 * encountered objects (REFP), we have to check the stash of the referent for
 * overloadedness and set the OVERLOAD flag (AMAGIC_on) on the NEW referer.
 *
 * Details on the perl bug in perl589delta.pod,
 * see "Reblessing overloaded objects now works".
 *
 * This is potentially a security problem (destructors!), but we really need
 * this to work on 5.8.5 for now, so let's make it work.
 * Another way of making it work might be to keep track of all occurrences
 * of objects and fix them up afterwards. That seems even more intrusive.
 * Please prove us wrong, though, since it's semantically a better fix.
 *
 * --Eric and Steffen
 */
#if ((PERL_VERSION == 8) && (PERL_SUBVERSION >= 9) || (PERL_VERSION > 8))
#  define USE_588_WORKAROUND 0
#else
#  define USE_588_WORKAROUND 1
#endif

/* predeclare all our subs so we have one definitive authority for their signatures */
SRL_STATIC_INLINE SV *srl_fetch_item(pTHX_ srl_decoder_t *dec, UV item, const char * const tag_name);

/* these three are "Public" */
srl_decoder_t *srl_build_decoder_struct(pTHX_ HV *opt, sv_with_hash *options);  /* constructor - called from ->new() */
void srl_destroy_decoder(pTHX_ srl_decoder_t *dec);                 /* destructor  - called from ->DESTROY() */
void srl_decoder_destructor_hook(pTHX_ void *p);                    /* destructor hook - called automagically */

/* the top level components of the decode process - called by srl_decode_into() */
/* srl_begin_decoding: set up the decoder to handle a given var */
SRL_STATIC_INLINE srl_decoder_t *srl_begin_decoding(pTHX_ srl_decoder_t *dec, SV *src, UV start_offset);
SRL_STATIC_INLINE void srl_read_header(pTHX_ srl_decoder_t *dec, SV *header_user_data); /* read/validate header */
SRL_STATIC_INLINE void srl_read_single_value(pTHX_ srl_decoder_t *dec, SV* into, SV** container); /* main recursive dump routine */
SRL_STATIC_INLINE void srl_finalize_structure(pTHX_ srl_decoder_t *dec);             /* optional finalize structure logic */
SRL_STATIC_INLINE void srl_clear_decoder(pTHX_ srl_decoder_t *dec);                 /* clean up decoder after a dump */

/* the internal routines to handle each kind of object we have to deserialize */
SRL_STATIC_INLINE void srl_read_copy(pTHX_ srl_decoder_t *dec, SV* into);

SRL_STATIC_INLINE void srl_read_hash(pTHX_ srl_decoder_t *dec, SV* into, U8 tag);
SRL_STATIC_INLINE void srl_read_array(pTHX_ srl_decoder_t *dec, SV* into, U8 tag);
SRL_STATIC_INLINE void srl_read_regexp(pTHX_ srl_decoder_t *dec, SV* into);

SRL_STATIC_INLINE void srl_read_refp(pTHX_ srl_decoder_t *dec, SV* into);
SRL_STATIC_INLINE void srl_read_refn(pTHX_ srl_decoder_t *dec, SV* into);
SRL_STATIC_INLINE void srl_read_weaken(pTHX_ srl_decoder_t *dec, SV* into);
SRL_STATIC_INLINE void srl_read_long_double(pTHX_ srl_decoder_t *dec, SV* into);
SRL_STATIC_INLINE void srl_read_double(pTHX_ srl_decoder_t *dec, SV* into);
SRL_STATIC_INLINE void srl_read_float(pTHX_ srl_decoder_t *dec, SV* into);
SRL_STATIC_INLINE void srl_read_float_128(pTHX_ srl_decoder_t *dec, SV* into);
SRL_STATIC_INLINE void srl_read_string(pTHX_ srl_decoder_t *dec, int is_utf8, SV* into);
SRL_STATIC_INLINE void srl_read_varint_into(pTHX_ srl_decoder_t *dec, SV* into, SV** container, const U8 *track_it);
SRL_STATIC_INLINE void srl_read_zigzag_into(pTHX_ srl_decoder_t *dec, SV* into, SV** container, const U8 *track_it);
SRL_STATIC_INLINE void srl_read_reserved(pTHX_ srl_decoder_t *dec, U8 tag, SV* into);
SRL_STATIC_INLINE void srl_read_object(pTHX_ srl_decoder_t *dec, SV* into, U8 obj_tag, int read_class_name_only);
SRL_STATIC_INLINE void srl_read_objectv(pTHX_ srl_decoder_t *dec, SV* into, U8 obj_tag);

SRL_STATIC_INLINE void srl_track_sv(pTHX_ srl_decoder_t *dec, const U8 *track_pos, SV *sv);
SRL_STATIC_INLINE void srl_read_frozen_object(pTHX_ srl_decoder_t *dec, HV *class_stash, SV *into);
SRL_STATIC_INLINE SV * srl_follow_refp_alias_reference(pTHX_ srl_decoder_t *dec, UV offset);
SRL_STATIC_INLINE AV * srl_follow_objectv_reference(pTHX_ srl_decoder_t *dec, UV offset);
SRL_STATIC_INLINE void srl_thaw_object(pTHX_ srl_decoder_t *dec, HV *class_stash, SV *sv);

/* FIXME unimplemented!!! */
SRL_STATIC_INLINE SV *srl_read_extend(pTHX_ srl_decoder_t *dec, SV* into);

#define DEPTH_INCREMENT(dec) STMT_START {                                           \
    if (expect_false(++dec->recursion_depth > dec->max_recursion_depth)) {                        \
            SRL_RDR_ERRORf1(dec->pbuf, "Reached recursion limit (%"UVuf") during deserialization",     \
            (UV)dec->max_recursion_depth);                               \
    }                                                                               \
} STMT_END

#define DEPTH_DECREMENT(dec) dec->recursion_depth--

#define IS_SRL_HDR_ARRAYREF(tag) (((tag) & SRL_HDR_ARRAYREF) == SRL_HDR_ARRAYREF)
#define IS_SRL_HDR_HASHREF(tag) (((tag) & SRL_HDR_HASHREF) == SRL_HDR_HASHREF)
#define IS_SRL_HDR_SHORT_BINARY(tag) (((tag) & SRL_HDR_SHORT_BINARY_LOW) == SRL_HDR_SHORT_BINARY_LOW)
#define SRL_HDR_SHORT_BINARY_LEN_FROM_TAG(tag) ((tag) & SRL_MASK_SHORT_BINARY_LEN)


#define SRL_ASSERT_REF_PTR_TABLES(dec) STMT_START {     \
            if (expect_false( !(dec)->ref_stashes )) {  \
                (dec)->ref_stashes = PTABLE_new();      \
                (dec)->ref_bless_av = PTABLE_new();     \
            }                                           \
        } STMT_END

#define SRL_sv_set_rv_to(into,referent)             \
    STMT_START {                                    \
        SRL_prepare_SV_for_RV(into);                \
        SvTEMP_off(referent);                       \
        SvRV_set(into, referent);                   \
        SvROK_on(into);                             \
    } STMT_END

STATIC void
srl_ptable_debug_callback(PTABLE_ENTRY_t *e)
{
    dTHX;
    printf("KEY=%"UVuf"\nVALUE:\n", (UV)e->key);
    sv_dump((SV *)e->value);
    printf("\n");
}

SRL_STATIC_INLINE void
srl_ptable_debug_dump(pTHX_ PTABLE_t *tbl)
{
    PTABLE_debug_dump(tbl, srl_ptable_debug_callback);
}

#define my_hv_fetchs(he,val,opt,idx) STMT_START {                   \
    he = hv_fetch_ent(opt, options[idx].sv, 0, options[idx].hash);  \
    if (he)                                                         \
        val= HeVAL(he);                                             \
    else                                                            \
        val= NULL;                                                  \
} STMT_END

/* Multiple places in this file that want to use srl_read_varint_uv_length
 * but don't have a buffer struct handy. */
SRL_STATIC_INLINE UV
S_read_varint_uv_length_char_ptr(pTHX_ const unsigned char **from, const unsigned char *end, const char * const errstr)
{
    UV rv;
    srl_reader_buffer_t buf;
    buf.pos = *from;
    buf.end = end;
    buf.start = NULL; /* meh */
    rv = srl_read_varint_uv_length(aTHX_ &buf, errstr);
    *from = buf.pos;
    return rv;
}


/* PUBLIC ROUTINES */

/* Builds the C-level configuration and state struct.
 * Automatically freed at scope boundary. */
srl_decoder_t *
srl_build_decoder_struct(pTHX_ HV *opt, sv_with_hash *options)
{
    srl_decoder_t *dec;
    SV *val;
    HE *he;

    Newxz(dec, 1, srl_decoder_t);

    dec->ref_seenhash = PTABLE_new();
    dec->max_recursion_depth = DEFAULT_MAX_RECUR_DEPTH;
     /* 0 == any number for array, hash & string */
    dec->max_num_hash_entries = 0;
    dec->max_num_array_entries = 0;
    dec->max_string_length = 0;
    dec->max_uncompressed_size = 0;

    SRL_RDR_CLEAR(&dec->buf);
    dec->pbuf = &dec->buf;

    /* load options */
    if (opt != NULL) {
        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_REFUSE_SNAPPY);
        if ( val && SvTRUE(val) )
            SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_REFUSE_SNAPPY);

        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_REFUSE_ZLIB);
        if ( val && SvTRUE(val) )
            SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_REFUSE_ZLIB);

        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_REFUSE_ZSTD);
        if ( val && SvTRUE(val) )
            SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_REFUSE_ZSTD);

        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_REFUSE_OBJECTS);
        if ( val && SvTRUE(val) )
            SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_REFUSE_OBJECTS);

        {
            int thaw_set = 0;
            my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_NO_THAW_OBJECTS);
            if ( val ) {
                thaw_set= 1;
                if (SvTRUE(val))
                    SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_NO_THAW_OBJECTS);
            }

            my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_NO_BLESS_OBJECTS);
            if ( val && SvTRUE(val) ) {
                SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_NO_BLESS_OBJECTS);
                if (!thaw_set)
                    SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_NO_THAW_OBJECTS);
            }
        }

        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_VALIDATE_UTF8);
        if ( val && SvTRUE(val) )
            SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_VALIDATE_UTF8);

        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_MAX_RECURSION_DEPTH);
        if ( val && SvTRUE(val) )
            dec->max_recursion_depth = SvUV(val);

        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_MAX_NUM_HASH_ENTRIES);
        if ( val && SvTRUE(val) )
            dec->max_num_hash_entries = SvUV(val);

        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_MAX_NUM_ARRAY_ENTRIES);
        if ( val && SvTRUE(val) )
            dec->max_num_array_entries = SvUV(val);

        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_MAX_STRING_LENGTH);
        if ( val && SvTRUE(val) )
            dec->max_string_length = SvUV(val);

        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_MAX_UNCOMPRESSED_SIZE);
        if ( val && SvTRUE(val) )
            dec->max_uncompressed_size = SvUV(val);

        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_DESTRUCTIVE_INCREMENTAL);
        if ( val && SvTRUE(val) )
            SRL_DEC_SET_OPTION(dec,SRL_F_DECODER_DESTRUCTIVE_INCREMENTAL);

        /* see if they want us to alias varints, value is an unsigned integer.
         * setting it to a true value smaller than 16 is the same as
         * using the "alias_smallint" option. Setting it to a true value larger
         * than 15 enables aliasing of smallints, and implies "alias_smallint" as
         * well. */
        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_ALIAS_VARINT_UNDER);
        if ( val && SvTRUE(val)) {
            /* if they use this then they automatically imply doing it for
             * smallint as well */
            SRL_DEC_SET_OPTION(dec,SRL_F_DECODER_ALIAS_SMALLINT);
            SRL_DEC_SET_OPTION(dec,SRL_F_DECODER_ALIAS_VARINT);
            if (SvUV(val) < 16) {
                /* too small, just enable for SMALLINT (POS/NEG)*/
                dec->alias_varint_under= 16;
            } else {
                /* larger than POS/NEG range, also alias some VARINTs */
                /* anything smaller than this number will be aliased */
                dec->alias_varint_under= SvUV(val);
            }
            /* create the alias cache */
            dec->alias_cache= newAV();
        }
        /* they can enable aliasing of SMALLINT's alone */
        if ( !SRL_DEC_HAVE_OPTION(dec,SRL_F_DECODER_ALIAS_SMALLINT) ) {
            my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_ALIAS_SMALLINT);
            if (val && SvTRUE(val))
            {
                /* set the flag */
                SRL_DEC_SET_OPTION(dec,SRL_F_DECODER_ALIAS_SMALLINT);
                /* create the alias cache */
                dec->alias_cache= newAV();
                dec->alias_varint_under=16;
            }
        }

        if (dec->alias_varint_under) {
            /* extend it to the right size 16 for NEG,
             * dec->alias_varint_under is at least 15, and 1 more for zero,
             * so we allocate enough for POS/NEG as well as for the additional varints*/
            av_extend(dec->alias_cache, 16 + dec->alias_varint_under);
            AvFILLp(dec->alias_cache)= 16 + dec->alias_varint_under - 1; /* remove 1 as this is $#ary */
        }

        /* check if they want us to use &PL_sv_undef for SRL_HEADER_UNDEF
         * even if this might break referential integrity. */
        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_USE_UNDEF);
        if ( val && SvTRUE(val))
            SRL_DEC_SET_OPTION(dec,SRL_F_DECODER_USE_UNDEF);

        /* check if they want us to set all SVs readonly. */
        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_SET_READONLY);
        if ( val && SvTRUE(val))
            SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_SET_READONLY);

        /* check if they want us to set normal scalars readonly. */
        my_hv_fetchs(he,val,opt, SRL_DEC_OPT_IDX_SET_READONLY_SCALARS);
        if ( val && SvTRUE(val))
            SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_SET_READONLY_SCALARS);

    }
    dec->flags_readonly= SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_SET_READONLY ) ? 1 :
                         SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_SET_READONLY_SCALARS) ? 2 :
                         0;
    return dec;
}

/* Clone a decoder whilst resetting ephemeral state on the clone. */
SRL_STATIC_INLINE srl_decoder_t *
srl_build_decoder_struct_alike(pTHX_ srl_decoder_t *proto)
{
    srl_decoder_t *dec;

    Newxz(dec, 1, srl_decoder_t);

    dec->ref_seenhash = PTABLE_new();
    dec->max_recursion_depth = proto->max_recursion_depth;
    dec->max_num_hash_entries = proto->max_num_hash_entries;
    dec->max_num_array_entries = proto->max_num_array_entries;
    dec->max_string_length = proto->max_string_length;
    dec->max_uncompressed_size = proto->max_uncompressed_size;

    if (proto->alias_cache) {
        dec->alias_cache = proto->alias_cache;
        SvREFCNT_inc(dec->alias_cache);
    }

    SRL_RDR_CLEAR(&dec->buf);
    dec->pbuf = &dec->buf;
    dec->flags = proto->flags;
    SRL_DEC_RESET_VOLATILE_FLAGS(dec);

    return dec;
}

/* Explicit destructor */
void
srl_destroy_decoder(pTHX_ srl_decoder_t *dec)
{
    PTABLE_free(dec->ref_seenhash);
    if (dec->ref_stashes) {
        PTABLE_free(dec->ref_stashes);
        PTABLE_free(dec->ref_bless_av);
    }
    if (dec->weakref_av) {
        SvREFCNT_dec(dec->weakref_av);
        dec->weakref_av = NULL;
    }
    if (dec->ref_thawhash)
        PTABLE_free(dec->ref_thawhash);
    if (dec->thaw_av) {
        SvREFCNT_dec(dec->thaw_av);
        dec->thaw_av = NULL;
    }
    if (dec->alias_cache)
        SvREFCNT_dec(dec->alias_cache);
    Safefree(dec);
}

/* This is fired when we exit the Perl pseudo-block.
 * It frees our decoder and all. Put decoder-level cleanup
 * logic here so that we can simply use croak/longjmp for
 * exception handling. Makes life vastly easier!
 */
void
srl_decoder_destructor_hook(pTHX_ void *p)
{
    srl_decoder_t *dec = (srl_decoder_t *)p;

    /* Only free decoder if not for reuse */
    if (!SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_REUSE)) {
        srl_destroy_decoder(aTHX_ dec);
    }
    else {
        /* Clear instead - decoder reused */
        srl_clear_decoder(aTHX_ dec);
    }
}

/* Logic shared by the various decoder entry points. */
SRL_STATIC_INLINE void
srl_decode_into_internal(pTHX_ srl_decoder_t *origdec, SV *src, SV *header_into, SV *body_into, UV start_offset)
{
    srl_decoder_t *dec;

    assert(origdec != NULL);
    dec = srl_begin_decoding(aTHX_ origdec, src, start_offset);
    srl_read_header(aTHX_ dec, header_into);
    if (expect_false( SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_DECOMPRESS_SNAPPY) )) {
        dec->bytes_consumed = srl_decompress_body_snappy(aTHX_ dec->pbuf, dec->encoding_flags, NULL, dec->max_uncompressed_size);
        origdec->bytes_consumed = dec->bytes_consumed;
    } else if (expect_false( SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_DECOMPRESS_ZLIB) )) {
        dec->bytes_consumed = srl_decompress_body_zlib(aTHX_ dec->pbuf, NULL, dec->max_uncompressed_size);
        origdec->bytes_consumed = dec->bytes_consumed;
    } else if (expect_false( SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_DECOMPRESS_ZSTD) )) {
        dec->bytes_consumed = srl_decompress_body_zstd(aTHX_ dec->pbuf, NULL, dec->max_uncompressed_size);
        origdec->bytes_consumed = dec->bytes_consumed;
    }

    /* this function *MUST* be called right after srl_decompress* functions */
    SRL_RDR_UPDATE_BODY_POS(dec->pbuf, dec->proto_version);

    /* The actual document body deserialization: */
    srl_read_single_value(aTHX_ dec, body_into, NULL);
    if (expect_false(SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_NEEDS_FINALIZE))) {
        srl_finalize_structure(aTHX_ dec);
    }

    /* If we aren't reading from a decompressed buffer we have to remember the number
     * of bytes used for the user to query. */
    if (dec->bytes_consumed == 0) {
        dec->bytes_consumed = dec->buf.pos - dec->buf.start;
        origdec->bytes_consumed = dec->bytes_consumed;
    }

    if (SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_DESTRUCTIVE_INCREMENTAL)) {
        STRLEN len;
        char *pv= SvPV(src,len);
        /* check the length here? do something different if the string is now exhausted? */
        sv_chop(src, pv + dec->bytes_consumed);
    }

    srl_clear_decoder(aTHX_ dec);
}

/* This is the main routine to deserialize just the header of a document. */
SV *
srl_decode_header_into(pTHX_ srl_decoder_t *origdec, SV *src, SV* header_into, UV start_offset)
{
    srl_decoder_t *dec;
    assert(origdec != NULL);
    dec = srl_begin_decoding(aTHX_ origdec, src, start_offset);
    if (header_into == NULL)
        header_into = sv_newmortal();
    srl_read_header(aTHX_ dec, header_into);
    return header_into;
}

/* this SHOULD be newSV_type(SVt_NULL) but newSV(0) is faster :-( */
#if 1
#define FRESH_SV() newSV(0)
#else
#define FRESH_SV() newSV_type(SVt_NULL);
#endif

/* This is the main routine to deserialize a Sereal document
 * w/o data in header. */
SV *
srl_decode_into(pTHX_ srl_decoder_t *dec, SV *src, SV* body_into, UV start_offset)
{
    if (expect_true(!body_into))
        body_into= sv_2mortal(FRESH_SV());
    srl_decode_into_internal(aTHX_ dec, src, NULL, body_into, start_offset);
    return body_into;
}

/* This is the main routine to deserialize Sereal document body
 * and header all at once. */
void
srl_decode_all_into(pTHX_ srl_decoder_t *dec, SV *src, SV *header_into, SV *body_into, UV start_offset)
{
    assert(header_into != NULL);
    assert(body_into != NULL);
    (void)srl_decode_into_internal(aTHX_ dec, src, header_into, body_into, start_offset);
}


/* TOP LEVEL PRIVATE ROUTINES */

SRL_STATIC_INLINE void
srl_clear_decoder(pTHX_ srl_decoder_t *dec)
{
    if (dec->buf.start == dec->buf.end)
        return;

    srl_clear_decoder_body_state(aTHX_ dec);
    SRL_DEC_RESET_VOLATILE_FLAGS(dec);
    dec->buf.body_pos = dec->buf.start = dec->buf.end = dec->buf.pos = dec->save_pos = NULL;
}

void
srl_clear_decoder_body_state(pTHX_ srl_decoder_t *dec)
{
    SRL_DEC_UNSET_OPTION(dec, SRL_F_DECODER_NEEDS_FINALIZE);

    if (dec->weakref_av)
        av_clear(dec->weakref_av);

    PTABLE_clear(dec->ref_seenhash);
    if (dec->ref_stashes) {
        PTABLE_clear(dec->ref_stashes);
        PTABLE_clear(dec->ref_bless_av);
    }

    dec->recursion_depth = 0;
}

SRL_STATIC_INLINE srl_decoder_t *
srl_begin_decoding(pTHX_ srl_decoder_t *dec, SV *src, UV start_offset)
{
    STRLEN len;
    unsigned char *tmp;

    /* Check whether decoder is in use and create a new one on the
     * fly if necessary. Should only happen in edge cases such as
     * a THAW hook calling back into the same decoder. */
    if (SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_DIRTY)) {
        srl_decoder_t * const proto = dec;
        dec = srl_build_decoder_struct_alike(aTHX_ proto);
        SRL_DEC_UNSET_OPTION(dec, SRL_F_DECODER_REUSE);
    }

    /* Needs to be before setting DIRTY because DIRTY is volatile. */
    SRL_DEC_RESET_VOLATILE_FLAGS(dec);

    /* Set to being in use. */;
    SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_DIRTY);

    /* Register our structure for destruction on scope exit */
    SAVEDESTRUCTOR_X(&srl_decoder_destructor_hook, (void *)dec);

    if (SvUTF8(src)) {
        /* If we are being asked to decode a utf8-on string then we
         * make a mortal copy, and then try to downgrade the copy.
         * The downgrade will croak if it cannot successfully downgrade
         * the buffer. If it is sucessful then decode the downgraded
         * copy.
         * Note, we do not make the copy when we are in destructive parsing mode
         * as we then are expected to modify the original string.
         */
        if ( ! SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_DESTRUCTIVE_INCREMENTAL) ) {
            src= sv_mortalcopy(src);
        }
        sv_utf8_downgrade(src, 0);
    }

    tmp = (unsigned char*)SvPV(src, len);
    if (expect_false( start_offset > len )) {
        SRL_RDR_ERROR(dec->pbuf, "Start offset is beyond input string length");
    }
    dec->buf.start= dec->buf.pos= tmp + start_offset;
    dec->buf.end= dec->buf.start + len - start_offset;
    SRL_RDR_SET_BODY_POS(dec->pbuf, dec->buf.start);
    dec->bytes_consumed = 0;

    return dec;
}

IV
srl_validate_header_version_pv_len(pTHX_ char *strdata, STRLEN len)
{
    return srl_validate_header_version(aTHX_ (srl_reader_char_ptr) strdata, len);
}

SRL_STATIC_INLINE void
srl_read_header(pTHX_ srl_decoder_t *dec, SV *header_user_data)
{
    UV header_len;
    IV proto_version_and_encoding_flags_int= srl_validate_header_version(aTHX_ dec->buf.pos, SRL_RDR_SPACE_LEFT(dec->pbuf));

    if ( expect_false(proto_version_and_encoding_flags_int < 1) ) {
        if (proto_version_and_encoding_flags_int == 0)
            SRL_RDR_ERROR(dec->pbuf, "Bad Sereal header: It seems your document was accidentally UTF-8 encoded");
        else
            SRL_RDR_ERROR(dec->pbuf, "Bad Sereal header: Not a valid Sereal document.");
    }
    else {
        dec->buf.pos += 5;

        dec->proto_version  = (U8)(proto_version_and_encoding_flags_int & SRL_PROTOCOL_VERSION_MASK);
        dec->encoding_flags = (U8)(proto_version_and_encoding_flags_int & SRL_PROTOCOL_ENCODING_MASK);

        if (expect_false( dec->proto_version == 1 ))
            SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_PROTOCOL_V1); /* compat mode */
        else if (expect_false( dec->proto_version > SRL_PROTOCOL_VERSION || dec->proto_version < 1 ))
            SRL_RDR_ERRORf1(dec->pbuf, "Unsupported Sereal protocol version %u", dec->proto_version);

        if (dec->encoding_flags == SRL_PROTOCOL_ENCODING_RAW) {
            /* no op */
        }
        else
        if (   dec->encoding_flags == SRL_PROTOCOL_ENCODING_SNAPPY
            || dec->encoding_flags == SRL_PROTOCOL_ENCODING_SNAPPY_INCREMENTAL)
        {
            if (expect_false( SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_REFUSE_SNAPPY) )) {
                SRL_RDR_ERROR(dec->pbuf, "Sereal document is compressed with Snappy, "
                              "but this decoder is configured to refuse Snappy-compressed input.");
            }
            dec->flags |= SRL_F_DECODER_DECOMPRESS_SNAPPY;
        }
        else
        if (dec->encoding_flags == SRL_PROTOCOL_ENCODING_ZLIB)
        {
            if (expect_false( SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_REFUSE_ZLIB) )) {
                SRL_RDR_ERROR(dec->pbuf, "Sereal document is compressed with ZLIB, "
                              "but this decoder is configured to refuse ZLIB-compressed input.");
            }
            dec->flags |= SRL_F_DECODER_DECOMPRESS_ZLIB;
        }
        else
        if (dec->encoding_flags == SRL_PROTOCOL_ENCODING_ZSTD)
        {
            if (expect_false( SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_REFUSE_ZSTD) )) {
                SRL_RDR_ERROR(dec->pbuf, "Sereal document is compressed with ZSTD, "
                              "but this decoder is configured to refuse ZSTD-compressed input.");
            }
            dec->flags |= SRL_F_DECODER_DECOMPRESS_ZSTD;
        }
        else
        {
            SRL_RDR_ERRORf1(dec->pbuf, "Sereal document encoded in an unknown format '%d'",
                            dec->encoding_flags >> SRL_PROTOCOL_VERSION_BITS);
        }

        /* Must do this via a temporary as it modifes dec->buf.pos itself */
        header_len= srl_read_varint_uv_length(aTHX_ dec->pbuf, " while reading header");

        if (dec->proto_version > 1 && header_len) {
            /* We have a protocol V2+ extensible header:
             *  - 8bit bitfield
             *  - if lowest bit set, we have custom-header-user-data after the bitfield
             *  => Only read header user data if an SV* was passed in to fill. */

            U8 bitfield;

            SRL_RDR_ASSERT_SPACE(dec->pbuf, 1, " while reading header flags");

            bitfield = *(dec->buf.pos++);
            if (bitfield & SRL_PROTOCOL_HDR_USER_DATA && header_user_data != NULL) {
                /* Do an actual document body deserialization for the user data: */
                SRL_RDR_UPDATE_BODY_POS(dec->pbuf, dec->proto_version);
                srl_read_single_value(aTHX_ dec, header_user_data, NULL);
                if (expect_false(SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_NEEDS_FINALIZE))) {
                    srl_finalize_structure(aTHX_ dec);
                }
                srl_clear_decoder_body_state(aTHX_ dec); /* clean up for the main body decode */
            }
            else {
                /* Either off in bitfield or no user data wanted, skip to end of header */
                SRL_RDR_ASSERT_SPACE(dec->pbuf, header_len, " while reading header packet");
                dec->buf.pos += header_len - 1; /* header_len includes bitfield */
            }
        }
        else {
            /* Skip header since we don't have any defined header-content in this
             * protocol version. */
            dec->buf.pos += header_len;
        }
    }
}

#define AV_PUSH(into_av, value_sv) STMT_START {     \
    av_push(into_av, value_sv);                     \
    SvREFCNT_inc(value_sv);                         \
} STMT_END

#define SAFE_NEW_AV(the_av) STMT_START {                            \
    the_av= newAV();                                                \
    if (!the_av)                                                    \
        croak("out of memory at %s line %d.", __FILE__, __LINE__);   \
} STMT_END

#define SAFE_PTABLE_NEW(the_ptr_table) STMT_START {                 \
    the_ptr_table= PTABLE_new();                                    \
    if (!the_ptr_table)                                             \
        croak("out of memory at %s line %d.", __FILE__, __LINE__);   \
} STMT_END



/* Fetch or register a reference to an already seen frozen object.
 * Called during deserialization (push=1) to handle duplicate references
 * to the same frozen object. Called during finalization (push=) to get
 * the data required to THAW the item, in this case the 'push' argument
 * is false.
 *
 * Returns as an SV * either an HV or an AV (NULL is theoretically
 * possibly also but should not occur in the current use). If an HV
 * then it is the class stash for the item looked up, if an AV then it
 * is a mortal array that contains a class stash as the first element,
 * along with the additional items that need to be fixed to point at the
 * unfrozen item. */
SRL_STATIC_INLINE SV *
srl_fetch_register_frozen_object(pTHX_ srl_decoder_t *dec, SV *item, const int push)
{
    if (dec->ref_thawhash) {
        PTABLE_ENTRY_t *tblent = PTABLE_find(dec->ref_thawhash, SvRV(item));
        if (tblent) {
            AV *info_av = (AV*)tblent->value;
            if (push) {
                if (SvTYPE((SV*)info_av) != SVt_PVAV) {
                    /* we have an HV* class_stash in the structure right now.
                     * so we have to upgrade this case to be an AV containing the
                     * class stash. */
                    HV *class_stash= (HV*)info_av;
                    SAFE_NEW_AV(info_av);
                    sv_2mortal((SV*)info_av);
                    AV_PUSH(info_av, (SV*)class_stash); /* push the old value into the array */
                    tblent->value= (void *)info_av; /* point the tblent at this new value */
                }
                /* add the item as a duplicate reference for fixups later */
                AV_PUSH(info_av, item);
            }
            return (SV*)info_av;
        }
    }
    return NULL;
}

SRL_STATIC_INLINE void
srl_finalize_structure(pTHX_ srl_decoder_t *dec)
{
    int nobless = SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_NO_BLESS_OBJECTS);
    int nothaw = SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_NO_THAW_OBJECTS);

    /* At this point the structure should be more or less reconstructed.
     * The main exception is objects that need to be blessed. We defer
     * this to as late as possible to avoid triggering DESTROY methods
     * as part of our deserialization. The blessed objects can be
     * divided into those which are frozen and thus require a call to
     * THAW, and those which only required a call to bless.
     *
     * We handle the simple case first, as the frozen form of an object
     * of one class might contain a simple object. In this case the
     * order we call bless doesn't matter.
     *
     * Once all the simple bless operations have been performed we thaw
     * the frozen items in LIFO order, replacing the referent of the
     * reference to the frozen form with the thawed replacement. We may
     * have to do this replacement operation multiple times if there are
     * multiple references to the same frozen object in the data
     * structure as the thaw operation occurs so late we cant use the
     * normal cache mechanism to handle multiple references.
     */

    if (dec->weakref_av)
        av_clear(dec->weakref_av);
    if (dec->ref_stashes) {
        /* The iterator could be leaked on exceptions if not for PTABLE_FLAG_AUTOCLEAN. */
        PTABLE_ITER_t *it = PTABLE_iter_new_flags(dec->ref_stashes, PTABLE_FLAG_AUTOCLEAN);
        PTABLE_ENTRY_t *ent;

        /* We have gotten here without error, so bless all the objects.
         * We defer to the end like this so that we only bless data structures
         * if the entire deserialization completes. */
        while ( NULL != (ent = PTABLE_iter_next(it)) ) {
            HV *stash = (HV* )ent->value;
            AV *ref_bless_av  = (AV *) PTABLE_fetch(dec->ref_bless_av, ent->key);
            I32 len;
            if (expect_false( !stash || !ref_bless_av )) {
                PTABLE_iter_free(it);
                SRL_RDR_ERROR(dec->pbuf, "missing stash or ref_bless_av!");
            }
            for( len= av_len(ref_bless_av) + 1 ; len > 0 ; len-- ) {
                SV* obj= av_pop(ref_bless_av); /*note that av_pop does NOT refcnt dec the sv*/
                if (SvREFCNT(obj)>1) {
                    /* It is possible that someone handcrafts a hash with a key collision,
                     * which could trick us into effectively blessing an object and then
                     * calling DESTROY on it. So we track the refcount of the objects
                     * popped off the ref_bless_av, and only bless if their refcount *before*
                     * we refcount dec is higher than 1. If it is 1 then we just destroy the 
                     * object.
                     * */
                    if (expect_true( obj )) {
#if USE_588_WORKAROUND
                        /* was blessed early, don't rebless */
#else
                        if (!nobless) {
                            if ( SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_READONLY_FLAGS) && SvREADONLY(SvRV(obj))) {
                                /* the referenced scalar was readonly, temporary 
                                   set it rw to bless its reference */
                                SvREADONLY_off(SvRV(obj));
                                sv_bless(obj, stash);
                                SvREADONLY_on(SvRV(obj));
                            } else {
                                sv_bless(obj, stash);
                            }
                        }
#endif
                    } else {
                        PTABLE_iter_free(it);
                        SRL_RDR_ERROR(dec->pbuf, "object missing from ref_bless_av array?");
                    }
                } else {
                    warn("Not blessing object that would be DESTROYed immediately. Malformed packet?");
                }
                SvREFCNT_dec(obj);
            }
        }
        PTABLE_iter_free(it);
    }
    /* And finally after all the simple blessing is done we need to handle any FROZEN
     * objects by calling their THAW method. We have to do this last as their frozen
     * representation may contain simple objects created during the bless phase above.
     */
    if (dec->thaw_av) {
        IV thaw_av_len= av_len(dec->thaw_av) + 1;
        HV *debug_class= NULL;

        /* Everything should be blessed now, so call thaw on each FROZEN
         * object in LIFO order. Each frozen object will have at least one
         * reference to it that must be fixed, there may be more if the same
         * object was referenced multiple times in the data structure.
         * For each item in thaw_av there should be a corresponding av with
         * the class stash and any additional items that need to be fixed
         * in it.
         */
        for ( ; thaw_av_len > 0 ; thaw_av_len-- ) {
            SV *sv = av_pop(dec->thaw_av);
            HV *class_stash = (HV*)srl_fetch_register_frozen_object(aTHX_ dec, sv, 0);
            AV *additional_refs= NULL;
            IV fixups = 0;
            if (SvTYPE(class_stash) == SVt_PVAV) {
                additional_refs = (AV*)class_stash;
                fixups = av_len(additional_refs); /* no +1 because we do it before the class_stash shift */
                class_stash = (HV *)av_shift((AV*)additional_refs);
                SvREFCNT_dec(class_stash);
            }
            if (nothaw) {
                /* do not actually thaw. In order to make it easier to find these cases in a dump
                 * we push the class name into the AV, and then bless it into a special class
                 * private to the Sereal project. */
                char *classname = HvNAME(class_stash);
                AV *av= (AV*)SvRV(sv);
                if (!debug_class) {
                    debug_class = gv_stashpvs("Sereal::Decoder::THAW_args",1);
                }
                av_push(av,newSVpvn(classname, strlen(classname)));
                sv_bless(sv,debug_class);
            } else {
                /* thaw the first ref. */
                srl_thaw_object(aTHX_ dec, class_stash, sv);
                /* if there are any additional refs then stitch them in */
                for ( ; fixups > 0; fixups--) {
                    SV* into = av_pop(additional_refs);
                    SvREFCNT_dec(SvRV(into));
                    SvRV_set(into, SvRV(sv));
                    SvREFCNT_inc(SvRV(sv));
                    SvREFCNT_dec(into);
                }
            }
            SvREFCNT_dec(sv);
        }
    }
}


/* PRIVATE UTILITY FUNCTIONS */

SRL_STATIC_INLINE void
srl_track_sv(pTHX_ srl_decoder_t *dec, const U8 *track_pos, SV *sv)
{
    PTABLE_store(dec->ref_seenhash, (void *)(track_pos - dec->buf.body_pos), (void *)sv);
}


SRL_STATIC_INLINE SV *
srl_fetch_item(pTHX_ srl_decoder_t *dec, UV item, const char * const tag_name)
{
    SV *sv= (SV *)PTABLE_fetch(dec->ref_seenhash, (void *)item);
#ifndef FOLLOW_REFERENCES_IF_NOT_STASHED
    if (expect_false( !sv )) {
        /*srl_ptable_debug_dump(aTHX_ dec->ref_seenhash);*/
        SRL_RDR_ERRORf2(dec->pbuf, "%s(%"UVuf") references an unknown item", tag_name, item);
    }
#endif
    return sv;
}

/****************************************************************************
 * PRIVATE WORKER SUBS FOR DEPARSING                                        *
 ****************************************************************************/
SRL_STATIC_INLINE void
srl_alias_iv(pTHX_ srl_decoder_t *dec, SV **container, const U8 *track_it, IV iv)
{
    SV *alias;
    SV **av_array= AvARRAY(dec->alias_cache);
    U32 ofs = iv + 16; /* we always cover from -16 up so we add 16 */

    assert( IS_IV_ALIAS(dec,iv) );

    if (!av_array[ofs] || av_array[ofs] == &PL_sv_undef) {
        alias= newSViv(iv);
        /* mark it as readonly so people dont try to modify it */
        SvREADONLY_on(alias);
        /* store it in the alias_cache array */
        av_array[ofs]= alias;
    } else {
        alias= av_array[ofs];
    }

    SvREFCNT_inc(alias);

    if (*container && *container != &PL_sv_undef)
        SvREFCNT_dec(*container);
    *container= alias;
    if (track_it)
        srl_track_sv(aTHX_ dec, track_it, alias);
}



SRL_STATIC_INLINE void
srl_setiv(pTHX_ srl_decoder_t *dec, SV *into, SV **container, const U8 *track_it, IV iv)
{
    if ( expect_false( container && IS_IV_ALIAS(dec,iv) )) {
        srl_alias_iv(aTHX_ dec, container, track_it, iv);
    } else {
        /* unroll sv_setiv() for the SVt_NULL case, which we will
         * see regularly - this wins about 35% speedup for us
         * but involve gratuitious intimacy with the internals.
         * */
#ifdef FAST_IV
        if ( SvTYPE(into) == SVt_NULL ) {
            /* XXX: dont need to do this, we are null already */
            /* SvFLAGS(into) &= ~SVTYPEMASK; */
            assert(
                (SVt_NULL == 0) &&
                ((SvFLAGS(into) & (SVTYPEMASK|SVf_OOK|SVf_OK|SVf_IVisUV|SVf_UTF8)) == 0)
            );
            SvANY(into) = (XPVIV*)((char*)&(into->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
            /* replace this: */
            /* SvIOK_only(into); */
            /* with this: */
            SvFLAGS(into) |= (SVt_IV | SVf_IOK | SVp_IOK);
            SvIV_set(into, iv);
        } else
#endif
        {
            sv_setiv(into, iv);
        }
    }
}

SRL_STATIC_INLINE void
srl_read_varint_into(pTHX_ srl_decoder_t *dec, SV* into, SV **container, const U8 *track_it)
{
    UV uv= srl_read_varint_uv(aTHX_ dec->pbuf);
    if (expect_true(uv <= (UV)IV_MAX)) {
        srl_setiv(aTHX_ dec, into, container, track_it, (IV)uv);
    } else {
        /* grr, this is ridiculous! */
        sv_setiv(into, 0);
        SvIsUV_on(into);
        SvUV_set(into, uv);
    }
}


SRL_STATIC_INLINE IV
srl_read_zigzag_iv(pTHX_ srl_decoder_t *dec)
{
    UV n= srl_read_varint_uv(aTHX_ dec->pbuf);
    IV i= (n >> 1) ^ (-(n & 1));
    return i;
}

SRL_STATIC_INLINE void
srl_read_zigzag_into(pTHX_ srl_decoder_t *dec, SV* into, SV **container, const U8 *track_it)
{
    srl_setiv(aTHX_ dec, into, container, track_it, srl_read_zigzag_iv(aTHX_ dec));
}


SRL_STATIC_INLINE void
srl_read_string(pTHX_ srl_decoder_t *dec, int is_utf8, SV* into)
{
    UV len= srl_read_varint_uv_length(aTHX_ dec->pbuf, " while reading string");
    /* Limit the maximum size of the string that we accept to whatever was configured */
    if (expect_false( dec->max_string_length != 0 && len > dec->max_string_length )) {
        SRL_RDR_ERRORf2(dec->pbuf, "Got input string with %u characters, but the configured maximum is just %u",
                (int)len, (int)dec->max_string_length);
    }
    if (expect_false(is_utf8 && SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_VALIDATE_UTF8))) {
        /* checks for invalid byte sequences. */
        if (expect_false( !is_utf8_string((U8*)dec->buf.pos, len) )) {
            SRL_RDR_ERROR(dec->pbuf, "Invalid UTF8 byte sequence");
        }
    }
    sv_setpvn(into,(char *)dec->buf.pos,len);
    if (is_utf8) {
        SvUTF8_on(into);
    } else {
        SvUTF8_off(into);
    }
    dec->buf.pos+= len;
}

/* declare a union so that we are guaranteed the right alignment
 * rules - this is required for e.g. ARM */
union myfloat {
    U8 c[sizeof(long double)];
    float f;
    double d;
    long double ld;
#ifdef HAS_QUADMATH
    __float128 nv;
#endif
};

/* XXX Most (if not all?) non-x86 platforms are strict in their
 * floating point alignment.  So maybe this logic should be the other
 * way: default to strict, and do sloppy only if x86? */

SRL_STATIC_INLINE void
srl_read_float(pTHX_ srl_decoder_t *dec, SV* into)
{
    union myfloat val;
    SRL_RDR_ASSERT_SPACE(dec->pbuf, sizeof(float), " while reading FLOAT");
#if SRL_USE_ALIGNED_LOADS_AND_STORES
    Copy(dec->buf.pos,val.c,sizeof(float),U8);
#else
    val.f= *((float *)dec->buf.pos);
#endif
    sv_setnv(into, (NV)val.f);
    dec->buf.pos+= sizeof(float);
}

/* XXX Most (if not all?) non-x86 platforms are strict in their
 * floating point alignment.  So maybe this logic should be the other
 * way: default to strict, and do sloppy only if x86? */

SRL_STATIC_INLINE void
srl_read_float_128(pTHX_ srl_decoder_t *dec, SV* into)
{
#ifdef HAS_QUADMATH
    union myfloat val;
    SRL_RDR_ASSERT_SPACE(dec->pbuf, sizeof(NV), " while reading FLOAT");
    Copy(dec->buf.pos,val.c,sizeof(NV),U8);
    sv_setnv(into, (NV)val.nv);
    dec->buf.pos += sizeof(NV);
#else
    SRL_RDR_ERROR(dec->pbuf, "FLOAT_128 not supported. No quadmath support in this perl.");
#endif
}



SRL_STATIC_INLINE void
srl_read_double(pTHX_ srl_decoder_t *dec, SV* into)
{
    union myfloat val;
    SRL_RDR_ASSERT_SPACE(dec->pbuf, sizeof(double), " while reading DOUBLE");
#if SRL_USE_ALIGNED_LOADS_AND_STORES
    Copy(dec->buf.pos,val.c,sizeof(double),U8);
#else
    val.d= *((double *)dec->buf.pos);
#endif
    sv_setnv(into, (NV)val.d);
    dec->buf.pos+= sizeof(double);
}


SRL_STATIC_INLINE void
srl_read_long_double(pTHX_ srl_decoder_t *dec, SV* into)
{
    union myfloat val;
    SRL_RDR_ASSERT_SPACE(dec->pbuf, sizeof(long double), " while reading LONG_DOUBLE");
#if SRL_USE_ALIGNED_LOADS_AND_STORES
    Copy(dec->buf.pos,val.c,sizeof(long double),U8);
#else
    val.ld= *((long double *)dec->buf.pos);
#endif
    sv_setnv(into, (NV)val.ld);
    dec->buf.pos+= sizeof(long double);
}


SRL_STATIC_INLINE void
srl_read_array(pTHX_ srl_decoder_t *dec, SV *into, U8 tag) {
    UV len;
    if (tag) {
        SV *referent= (SV *)newAV();
        len= tag & 15;
        SRL_sv_set_rv_to(into, referent);
        into= referent;
        DEPTH_INCREMENT(dec);
    } else {
        len= srl_read_varint_uv_count(aTHX_ dec->pbuf, " while reading ARRAY");
        (void)SvUPGRADE(into, SVt_PVAV);
    }

    /* Limit the maximum number of elements that we accept to whatever was configured */
    if (expect_false( dec->max_num_array_entries != 0 && len > dec->max_num_array_entries )) {
        SRL_RDR_ERRORf2(dec->pbuf, "Got input array with %u entries, but the configured maximum is just %u",
                (int)len, (int)dec->max_num_array_entries);
    } else if (len) {
        SV **av_array;
        SV **av_end;

        SRL_RDR_ASSERT_SPACE(dec->pbuf,len," while reading array contents, insufficient remaining tags for specified array size");

        /* make sure the array has room */
        av_extend((AV*)into, len-1);
        /* set the size */
        AvFILLp(into)= len - 1;

        av_array= AvARRAY((AV*)into);
        av_end= av_array + len;

        for ( ; av_array < av_end ; av_array++) {
            *av_array = FRESH_SV();
            srl_read_single_value(aTHX_ dec, *av_array, av_array);
        }
    }
    if (tag)
        DEPTH_DECREMENT(dec);
}

#ifndef HV_FETCH_LVALUE
#   define OLDHASH
#   define IS_LVALUE 1
#   define KEYLENTYPE IV
#else
#   define KEYLENTYPE STRLEN
#endif

#ifndef HvRITER_set
#   define HvRITER_set(sv,v) HvRITER(sv) = v
#endif

SRL_STATIC_INLINE void
srl_read_hash(pTHX_ srl_decoder_t *dec, SV* into, U8 tag) {
    UV num_keys;
    if (tag) {
        SV *referent= (SV *)newHV();
        num_keys= tag & 15;
        SRL_sv_set_rv_to(into, referent);
        into= referent;
        DEPTH_INCREMENT(dec);
    } else {
        num_keys= srl_read_varint_uv_count(aTHX_ dec->pbuf, " while reading HASH");
        (void)SvUPGRADE(into, SVt_PVHV);
    }
    /* in some versions of Perl HvRITER() is not properly set on an upgrade SV
     * so we explicitly set it ourselves */
#ifdef FIXUP_RITER
    HvRITER_set(into,-1);
#endif

    /* Limit the maximum number of hash keys that we accept to whetever was configured */
    if (expect_false( dec->max_num_hash_entries != 0 && num_keys > dec->max_num_hash_entries )) {
        SRL_RDR_ERRORf2(dec->pbuf, "Got input hash with %u entries, but the configured maximum is just %u",
                (int)num_keys, (int)dec->max_num_hash_entries);
    }

    SRL_RDR_ASSERT_SPACE(dec->pbuf,num_keys*2," while reading hash contents, insufficient remaining tags for number of keys specified");

    HvSHAREKEYS_on(into); /* apparently required on older perls */

    hv_ksplit((HV *)into, num_keys); /* make sure we have enough room */
    /* NOTE: contents of hash are stored VALUE/KEY, reverse from normal perl
     * storage, this is because it simplifies the hash storage logic somewhat */
    for (; num_keys > 0 ; num_keys--) {
        const U8 *from;
        U8 tag;
        SV **fetched_sv;
#ifndef OLDHASH
        U32 flags= 0;
#endif
        KEYLENTYPE key_len;

        SRL_RDR_ASSERT_SPACE(dec->pbuf,1," while reading key tag byte for HASH");
        tag= (*dec->buf.pos++)&127;
        if (IS_SRL_HDR_SHORT_BINARY(tag)) {
            key_len= (KEYLENTYPE)SRL_HDR_SHORT_BINARY_LEN_FROM_TAG(tag);
            SRL_RDR_ASSERT_SPACE(dec->pbuf,key_len," while reading string/SHORT_BINARY key");
            from= dec->buf.pos;
            dec->buf.pos += key_len;
        } else if (tag == SRL_HDR_BINARY) {
            key_len= (KEYLENTYPE)srl_read_varint_uv_length(aTHX_ dec->pbuf, " while reading string/BINARY key");
            SRL_RDR_ASSERT_SPACE(dec->pbuf,key_len," while reading binary key");
            from= dec->buf.pos;
            dec->buf.pos += key_len;
        } else if (tag == SRL_HDR_STR_UTF8) {
            key_len= (KEYLENTYPE)srl_read_varint_uv_length(aTHX_ dec->pbuf, " while reading UTF8 key");
            SRL_RDR_ASSERT_SPACE(dec->pbuf,key_len," while reading string key");
            from= dec->buf.pos;
            dec->buf.pos += key_len;
#ifdef OLDHASH
            key_len= -key_len;
#else
            flags= HVhek_UTF8;
#endif
        } else if (tag == SRL_HDR_COPY) {
            UV ofs= srl_read_varint_uv_offset(aTHX_ dec->pbuf, " while reading COPY tag");
            from= dec->buf.body_pos + ofs;
            tag= *from++;
            /* note we do NOT validate these items, as we have alread read them
             * and if they were a problem we would not be here to process them! */
            if (IS_SRL_HDR_SHORT_BINARY(tag)) {
                key_len= (KEYLENTYPE)SRL_HDR_SHORT_BINARY_LEN_FROM_TAG(tag);
            }
            else
            if (tag == SRL_HDR_BINARY) {
                key_len = (KEYLENTYPE)S_read_varint_uv_length_char_ptr(
                    aTHX_ &from, dec->buf.end,
                    " while reading (byte) string length (via COPY)"
                );
            }
            else
            if (tag == SRL_HDR_STR_UTF8) {
                key_len = (KEYLENTYPE)S_read_varint_uv_length_char_ptr(
                    aTHX_ &from, dec->buf.end,
                    " while reading UTF8-encoded string length (via COPY)"
                );
#ifdef OLDHASH
                key_len= -key_len;
#else
                flags= HVhek_UTF8;
#endif
            }
            else {
                SRL_RDR_ERROR_BAD_COPY(dec->pbuf, SRL_HDR_HASH);
            }
        } else {
            SRL_RDR_ERROR_UNEXPECTED(dec->pbuf, tag, "a stringish type");
        }
        if (SvREADONLY(into)) {
            SvREADONLY_off(into);
        }
#ifdef OLDHASH
        fetched_sv= hv_fetch((HV *)into, (char *)from, key_len, IS_LVALUE);
#else
        fetched_sv= (SV **) hv_common((HV *)into, NULL, (char *)from, key_len, flags, HV_FETCH_LVALUE|HV_FETCH_JUST_SV, NULL, 0);
#endif
        if (expect_false( !fetched_sv )) {
            SRL_RDR_ERROR_PANIC(dec->pbuf, "failed to hv_store");
        }
        else
        if ( expect_false( SvTYPE(*fetched_sv) != SVt_NULL ) ) {
            /* sv_dump(*fetched_sv); */
            SRL_RDR_ERRORf2(dec->pbuf, "duplicate key '%.*s' in hash", (int) key_len, (char *)from);
        }
        srl_read_single_value(aTHX_ dec, *fetched_sv, fetched_sv );
    }
    if (tag)
        DEPTH_DECREMENT(dec);
}

/* read reference to next thing */
SRL_STATIC_INLINE void
srl_read_refn(pTHX_ srl_decoder_t *dec, SV* into)
{
    SV *referent;
    U8 tag;
    SRL_RDR_ASSERT_SPACE(dec->pbuf, 1, " while reading REFN referent");
    tag= *(dec->buf.pos); /* Look ahead for special vars. */
    if (tag == SRL_HDR_TRUE) {
        dec->buf.pos++;
        referent= &PL_sv_yes;
    }
    else if (tag == SRL_HDR_FALSE) {
        dec->buf.pos++;
        referent= &PL_sv_no;
    }
    /*
     * Note the below is guarded by an option as we have use SRL_HDR_UNDEF
     * also to represent "any SV which is undef", and using to represent
     * true PL_sv_undef will break things.
     *
     * We need a new, different tag for true perl undef.
     *
     */
    else
    if (
        ( tag == SRL_HDR_CANONICAL_UNDEF )
        ||
        ( SRL_DEC_HAVE_OPTION(dec,SRL_F_DECODER_USE_UNDEF) && tag == SRL_HDR_UNDEF )
    ) {
        dec->buf.pos++;
        referent= &PL_sv_undef;
    }
    else {
        referent= FRESH_SV();
        SvTEMP_off(referent);
        tag = 0;
    }
    SRL_sv_set_rv_to(into, referent);
    if (!tag) {
        DEPTH_INCREMENT(dec);
        srl_read_single_value(aTHX_ dec, referent, NULL);
        DEPTH_DECREMENT(dec);
    }
}

SRL_STATIC_INLINE SV *
srl_follow_refp_alias_reference(pTHX_ srl_decoder_t *dec, UV offset)
{
    SV* into = sv_2mortal(FRESH_SV());
    srl_reader_char_ptr orig_pos = dec->buf.pos;
    srl_reader_char_ptr new_pos = dec->buf.body_pos + offset;

    if (new_pos >= orig_pos) {
        SRL_RDR_ERROR(dec->pbuf, "Corrupted packed. Reference offset points forward!");
    }

    dec->buf.pos = new_pos;
    srl_read_single_value(aTHX_ dec, into, NULL);
    dec->buf.pos = orig_pos;
    return into;
}

SRL_STATIC_INLINE AV *
srl_follow_objectv_reference(pTHX_ srl_decoder_t *dec, UV offset)
{
    AV *av= NULL;
    srl_reader_char_ptr orig_pos = dec->buf.pos;
    srl_reader_char_ptr new_pos = dec->buf.body_pos + offset;

    if (new_pos >= orig_pos) {
        SRL_RDR_ERROR(dec->pbuf, "Corrupted packed. Reference offset points forward!");
    }

    SRL_ASSERT_REF_PTR_TABLES(dec); /* init dec->ref_stashes and dec->ref_bless_av */

    dec->buf.pos = new_pos;
    /* call srl_read_object() with read_class_name_only=1 */
    /* into and obj_tag are not used in this case */
    srl_read_object(aTHX_ dec, NULL, 0, 1);
    av= (AV *)PTABLE_fetch(dec->ref_bless_av, (void *)offset);
    dec->buf.pos = orig_pos;
    return av;
}

/* reuse a reference to a previous item */
SRL_STATIC_INLINE void
srl_read_refp(pTHX_ srl_decoder_t *dec, SV* into)
{
    /* something we did before */
    UV ofs= srl_read_varint_uv_offset(aTHX_ dec->pbuf, " while reading REFP tag");
    SV *referent= srl_fetch_item(aTHX_ dec, ofs, "REFP");

#ifdef FOLLOW_REFERENCES_IF_NOT_STASHED
    if (referent == NULL)
        referent = srl_follow_refp_alias_reference(aTHX_ dec, ofs);
#endif

    (void)SvREFCNT_inc(referent);

    SRL_sv_set_rv_to(into, referent);

#if USE_588_WORKAROUND
    /* See 'define USE_588_WORKAROUND' above for a discussion of what this does. */
    if (SvOBJECT(referent)) {
        HV *stash = SvSTASH(referent);
        if (Gv_AMG(stash))
            SvAMAGIC_on(into);
    }
#endif
    srl_fetch_register_frozen_object(aTHX_ dec, into, 1);
}


SRL_STATIC_INLINE void
srl_read_weaken(pTHX_ srl_decoder_t *dec, SV* into)
{
    SV* referent;
    /* TODO This really just wants a subset of the states that srl_read_single_value covers, right?
     *      Optimization opportunity? Or robustness against invalid packets issue? */
    srl_read_single_value(aTHX_ dec, into, NULL);
    if (expect_false( !SvROK(into) ))
        SRL_RDR_ERROR(dec->pbuf, "WEAKEN op");
    referent= SvRV(into);
    /* we have to be careful to not allow the referent's refcount
     * to go to zero in the process of us weakening the ref.
     * For instance this may be aliased or reused later by a non-weakref
     * which will "fix" the refcount, however we need to be able to deserialize
     * in the opposite order, so if the referent's refcount is 1
     * we increment it and stuff it in the weakref_av before we call
     * sv_rvweaken(), right before we exit we clear any items from
     * that array, which does the REFCNT_dec for us, and everything
     * works out ok. */
    if (expect_true( SvREFCNT(referent)==1 )) {
        if (expect_false( !dec->weakref_av ))
            dec->weakref_av= newAV();
        av_push(dec->weakref_av, SvREFCNT_inc(referent));
        SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_NEEDS_FINALIZE);
    }

    /* If read-only reference, set to rw only to weaken it, otherwise "Modification of a read-only value attempted". */
    if ( SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_READONLY_FLAGS) && SvREADONLY(into)) {
        SvREADONLY_off(into);
        sv_rvweaken(into);
        SvREADONLY_on(into);
    } else {
        sv_rvweaken(into);
    }
}

SRL_STATIC_INLINE void
srl_read_objectv(pTHX_ srl_decoder_t *dec, SV* into, U8 obj_tag)
{
    AV *av= NULL;
    STRLEN ofs;

    if (expect_false( SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_REFUSE_OBJECTS) ))
        SRL_RDR_ERROR_REFUSE_OBJECT(dec->pbuf);

    ofs= srl_read_varint_uv_offset(aTHX_ dec->pbuf, " while reading OBJECTV(_FREEZE) classname");

    if (expect_false( !dec->ref_bless_av )) {
#ifdef FOLLOW_REFERENCES_IF_NOT_STASHED
        SRL_ASSERT_REF_PTR_TABLES(dec); /* init dec->ref_stashes and dec->ref_bless_av */
#else
        SRL_RDR_ERROR(dec->pbuf, "Corrupted packet. OBJECTV(_FREEZE) used without "
                      "preceding OBJECT(_FREEZE) to define classname");
#endif
    }

    av= (AV *)PTABLE_fetch(dec->ref_bless_av, (void *)ofs);
    if (expect_false( NULL == av )) {
#ifdef FOLLOW_REFERENCES_IF_NOT_STASHED
        av = srl_follow_objectv_reference(aTHX_ dec, (UV) ofs);
        if (expect_false( NULL == av ))
#endif
            SRL_RDR_ERRORf1(dec->pbuf, "Corrupted packet. OBJECTV(_FREEZE) references unknown classname offset: %"UVuf, (UV)ofs);
    }

    /* checking tag: SRL_HDR_OBJECTV_FREEZE or SRL_HDR_OBJECTV? */
    if (expect_false( obj_tag == SRL_HDR_OBJECTV_FREEZE )) {
        HV *class_stash= (HV *) PTABLE_fetch(dec->ref_stashes, (void *)ofs);
        if (expect_false( class_stash == NULL ))
            SRL_RDR_ERROR(dec->pbuf, "Corrupted packet. OBJECTV(_FREEZE) used without "
                          "preceding OBJECT(_FREEZE) to define classname");
        srl_read_frozen_object(aTHX_ dec, class_stash, into);
    } else {
        /* SRL_HDR_OBJECTV, not SRL_HDR_OBJECTV_FREEZE */
        /* now deparse the thing we are going to bless */
        srl_read_single_value(aTHX_ dec, into, NULL);

        /* and also stuff it into the av - we dont have to do any more book-keeping */
        av_push(av, SvREFCNT_inc(into));

#if USE_588_WORKAROUND
        {
            /* See 'define USE_588_WORKAROUND' above for a discussion of what this does. */
            HV *class_stash= PTABLE_fetch(dec->ref_stashes, (void *)ofs);
            if (expect_false( class_stash == NULL ))
                SRL_RDR_ERROR(dec->pbuf, "Corrupted packet. OBJECTV(_FREEZE) used without "
                              "preceding OBJECT(_FREEZE) to define classname");
            if (!SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_NO_BLESS_OBJECTS))
                sv_bless(into, class_stash);
        }
#endif
    }

}

SRL_STATIC_INLINE void
srl_read_object(pTHX_ srl_decoder_t *dec, SV* into, U8 obj_tag, int read_class_name_only)
{
    HV *class_stash= NULL;
    AV *av= NULL;
    STRLEN storepos= 0;
    UV ofs= 0;
    I32 flags= GV_ADD;
    U8 tag;
    U32 key_len = 0;
    const U8 *from = NULL;

    if (expect_false( SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_REFUSE_OBJECTS) ))
        SRL_RDR_ERROR_REFUSE_OBJECT(dec->pbuf);

    /* Now find the class name - first check if this is a copy op
     * this is bit tricky, as we could have a copy of a raw string.
     * We could also have a copy of a previously mentioned class
     * name. We have to handle both, which leads to some non-linear
     * code flow in the below code. */
    SRL_RDR_ASSERT_SPACE(dec->pbuf,1," while reading classname tag");

    /* Now read the class name and cache it */
    storepos= SRL_RDR_BODY_POS_OFS(dec->pbuf);
    tag= *dec->buf.pos++;

    if (IS_SRL_HDR_SHORT_BINARY(tag)) {
        key_len= SRL_HDR_SHORT_BINARY_LEN_FROM_TAG(tag);
        from= dec->buf.pos;
        SRL_RDR_ASSERT_SPACE(dec->pbuf,key_len," while reading short binary");
        dec->buf.pos += key_len;
    }
    else
    if (tag == SRL_HDR_STR_UTF8) {
        key_len= srl_read_varint_uv_length(aTHX_ dec->pbuf, " while reading UTF8 class name");
        flags = flags | SVf_UTF8;
        from= dec->buf.pos;
        SRL_RDR_ASSERT_SPACE(dec->pbuf,key_len," while reading utf8 string");
        dec->buf.pos += key_len;
    }
    else
    if (tag == SRL_HDR_BINARY) {
        key_len= srl_read_varint_uv_length(aTHX_ dec->pbuf, " while reading string/BINARY class name");
        from= dec->buf.pos;
        SRL_RDR_ASSERT_SPACE(dec->pbuf,key_len," while reading binary");
        dec->buf.pos += key_len;
    }
    else
    if (tag == SRL_HDR_COPY) {
        ofs= srl_read_varint_uv_offset(aTHX_ dec->pbuf, " while reading COPY class name");
        storepos= ofs;
        /* if this string was seen before as part of a classname then we expect
         * a stash available below. However it might have been serialized as a key
         * or something like that, which would mean we dont have an entry in ref_stashes
         * anymore. So first we check if we have a stash. If we do, then we can avoid
         * some work. */
        if (expect_true( dec->ref_stashes != NULL )) {
            class_stash= (HV *) PTABLE_fetch(dec->ref_stashes, (void *)ofs);
        }
        /* Check if we actually got a class_stash back. If we didn't then we need
         * to deserialize the class name */
        if (!class_stash) {
            from= dec->buf.body_pos + ofs;
            tag= *from++;
            /* Note we do NOT validate these items, as we have already read them
             * and if they were a problem we would not be here to process them! */
            if (IS_SRL_HDR_SHORT_BINARY(tag)) {
                key_len= SRL_HDR_SHORT_BINARY_LEN_FROM_TAG(tag);
            }
            else
            if (tag == SRL_HDR_BINARY) {
                key_len = (KEYLENTYPE)S_read_varint_uv_length_char_ptr(
                    aTHX_ &from, dec->buf.end,
                    " while reading (byte) length for class name (via COPY)"
                );
            }
            else
            if (tag == SRL_HDR_STR_UTF8) {
                key_len = (KEYLENTYPE)S_read_varint_uv_length_char_ptr(
                    aTHX_ &from, dec->buf.end,
                    " while reading UTF8 string length for class name (via COPY)"
                );
                flags = flags | SVf_UTF8;
                if (!is_utf8_string(from, key_len)) {
                    SRL_RDR_ERROR_PANIC(dec->pbuf, "utf8 flagged classname is not actually utf8");
                }
            }
            else {
                SRL_RDR_ERROR_BAD_COPY(dec->pbuf, SRL_HDR_OBJECT);
            }
        }
    } else {
        SRL_RDR_ERROR_UNEXPECTED(dec->pbuf, tag, "a class name");
    }

    /* At this point we may or may not have a class stash. If they used a Copy there
     * is a decent chance we do. */
    SRL_ASSERT_REF_PTR_TABLES(dec);
    if (!class_stash) {
        /* no class stash - so we need to look it up and then store it away for future use */
        class_stash= gv_stashpvn((char *)from, key_len, flags);
        PTABLE_store(dec->ref_stashes, (void *)storepos, (void *)class_stash);
        /* Since this is the first time we have seen this stash then it is the first time
         * that we have stored an item in the ref_bless_av hash as well. So create a new one
         * and store it away. */
        av= newAV();
        sv_2mortal((SV*)av);
        PTABLE_store(dec->ref_bless_av, (void *)storepos, (void *)av);
    } else {
        /* we have a class stash so we should have a ref_bless_av as well. */
        av= (AV *)PTABLE_fetch(dec->ref_bless_av, (void *)storepos);
        if ( !av )
            SRL_RDR_ERRORf1(dec->pbuf, "Panic, no ref_bless_av for %"UVuf, (UV)storepos);
    }

#ifdef FOLLOW_REFERENCES_IF_NOT_STASHED
    /* at this point we have class name read and have coressponding records in
     * dec->dec->ref_stashes and dec->ref_bless_av. So, we can simply fetch
     * from hashes outside this function. The code */
    if (read_class_name_only) return;
#else
    assert(into != NULL);
    assert(obj_tag != 0);
#endif

    SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_NEEDS_FINALIZE);
    if (expect_false( obj_tag == SRL_HDR_OBJECT_FREEZE )) {
        srl_read_frozen_object(aTHX_ dec, class_stash, into);
    } else {

        /* We now have a stash so we /could/ bless... except that
         * we don't actually want to do so right now. We want to defer blessing
         * until the full packet has been read. Yes it is more overhead, but
         * we really dont want to trigger DESTROY methods from a partial
         * deparse. So we insert the item into an array to be blessed later. */
        av_push(av, SvREFCNT_inc(into));

        /* now deparse the thing we are going to bless */
        srl_read_single_value(aTHX_ dec, into, NULL);

#if USE_588_WORKAROUND
        /* See 'define USE_588_WORKAROUND' above for a discussion of what this does. */
        if (!SRL_DEC_HAVE_OPTION(dec, SRL_F_DECODER_NO_BLESS_OBJECTS))
            sv_bless(into, class_stash);
#endif
    }
}


SRL_STATIC_INLINE void
srl_read_frozen_object(pTHX_ srl_decoder_t *dec, HV *class_stash, SV *into)
{

    AV *info_av;
    if (!dec->thaw_av)
        SAFE_NEW_AV(dec->thaw_av);

    /* We do this BEFORE we call srl_read_single_value() so that
       thaw_av contains the items in order of us seeing them in the serialized
       dump. We will pop them off the list later on when we do the actual THAW.
       Note that at the time we do this we haven't "filled out" the 'into' var
       with the actual AV that is used for its frozen form. */

    AV_PUSH(dec->thaw_av, into);

    /* now fill out into with the AV that represents the object */
    srl_read_single_value(aTHX_ dec, into, NULL);

    /* validate that we actually deparsed an AV */
    assert(SvROK(into) && SvTYPE(SvRV(into)) == SVt_PVAV);

    if (!dec->ref_thawhash)
        SAFE_PTABLE_NEW(dec->ref_thawhash);

    /* we need to do this *after* we have called srl_read_single_value() as
       we use the address of the AV that into references as the key to find the
       class stash. */
    PTABLE_store(dec->ref_thawhash, (void *)SvRV(into), (void *)class_stash);
}

/* Invoke a THAW callback on the given class. Pass in the next item in the
 * decoder stream. This is implementing the FREEZE/THAW part of
 * SRL_HDR_OBJECT_FREEZE and SRL_HDR_OBJECTV_FREEZE. */
SRL_STATIC_INLINE void
srl_thaw_object(pTHX_ srl_decoder_t *dec, HV *class_stash, SV *into)
{
    GV *method = gv_fetchmethod_autoload(class_stash, "THAW", 0);
    char *classname = HvNAME(class_stash);
    SV *replacement = NULL;
    AV *arg_av;

    if (expect_false( method == NULL ))
        SRL_RDR_ERRORf1(dec->pbuf, "No THAW method defined for class '%s'", classname);

    /* Assert that we got a top level array ref as the spec requires.
     * Not throwing an exception here violates expectations down the line and
     * can lead to segfaults. */
    if (expect_false( !SvROK(into) || SvTYPE(SvRV(into)) != SVt_PVAV ))
        SRL_RDR_ERROR(dec->pbuf, "Corrupted packet. OBJECT(V)_FREEZE used without "
                  "being followed by an array reference");

    arg_av= (AV*)SvRV(into);
    {
        int count;
        int arg_av_len = av_len(arg_av)+1;
        dSP;

        ENTER;
        SAVETMPS;
        PUSHMARK(SP);

        EXTEND(SP, 2+arg_av_len);
        /* TODO Consider more caching for some of this */
        PUSHs(sv_2mortal(newSVpvn(classname, strlen(classname))));
        /* FIXME do not recreate the following SV. That's dumb and wasteful! -
         * So long as it doesnt get modified! */
        PUSHs(sv_2mortal(newSVpvs("Sereal")));
        /* Push the args into the stack */
        for (count=0 ; count < arg_av_len; count++) {
            PUSHs((SV*)*av_fetch(arg_av, count, 0));
        }

        PUTBACK;
        count = call_sv((SV *)GvCV(method), G_SCALAR);
        /* TODO explore method lookup caching */
        SPAGAIN;

        if (expect_true( count == 1 )) {
            replacement = POPs;
            SvREFCNT_inc(replacement);
        }
        /* If count is not 1, then it's 0. Then into is already undef. */

        PUTBACK;
        FREETMPS;
        LEAVE;
    }
    SvREFCNT_dec(arg_av);

    if (SvROK(replacement)) {
        SvRV_set(into,  SvRV(replacement));
        SvREFCNT_inc(SvRV(replacement));
        SvREFCNT_dec(replacement);
    } else {
        SvRV_set(into, newSV(0));
    }
}


SRL_STATIC_INLINE void
srl_read_reserved(pTHX_ srl_decoder_t *dec, U8 tag, SV* into)
{
    const UV len = srl_read_varint_uv_length(aTHX_ dec->pbuf, " while reading reserved");
    (void)tag; /* unused as of now */

    dec->buf.pos += len; /* discard */
    sv_setsv(into, &PL_sv_undef);
}


SRL_STATIC_INLINE void
srl_read_regexp(pTHX_ srl_decoder_t *dec, SV* into)
{
    SV *sv_pat= sv_2mortal(FRESH_SV());
    srl_read_single_value(aTHX_ dec, sv_pat, NULL);
    SRL_RDR_ASSERT_SPACE(dec->pbuf, 1, " while reading regexp modifier tag");
    /* For now we will serialize the flags as ascii strings. Maybe we should use
     * something else but this is easy to debug and understand - since the modifiers
     * are tagged it doesn't matter much, we can add other tags later */
    if ( expect_true( IS_SRL_HDR_SHORT_BINARY(*dec->buf.pos) ) ) {
        U8 mod_len= SRL_HDR_SHORT_BINARY_LEN_FROM_TAG(*dec->buf.pos++);
        U32 flags= 0;
        SRL_RDR_ASSERT_SPACE(dec->pbuf, mod_len, " while reading regexp modifiers");
        while (mod_len > 0) {
            mod_len--;
            switch (*dec->buf.pos++) {
                case 'm':
                    flags= flags | PMf_MULTILINE;
                    break;
                case 's':
                    flags= flags | PMf_SINGLELINE;
                    break;
                case 'i':
                    flags= flags | PMf_FOLD;
                    break;
                case 'x':
                    flags= flags | PMf_EXTENDED;
                    break;
#ifdef REGEXP_HAS_P_MODIFIER
                case 'p':
                    flags = flags | PMf_KEEPCOPY;
                    break;
#endif
                default:
                    SRL_RDR_ERROR(dec->pbuf, "bad modifier");
                    break;
            }
        }
#ifdef MODERN_REGEXP
        {
            SV *referent;
            SV tmp;
            /* This is ugly. We have to swap out the insides of our SV
             * with the one we get back from CALLREGCOMP, as there is no
             * way to get it to fill our SV.
             *
             * As far as I understand this works because of how the SV
             * is laid out. Needs to be verified with someone who knows
             * better.
             */

            /* compile the regex */
            referent= (SV*)CALLREGCOMP(sv_pat, flags);
            if (!referent)
                SRL_RDR_ERROR(dec->pbuf, "bad regexp pattern");

            /* make sure the SV came from us (it should) and
             * is bodyless */
            assert( SvTYPE(into) == SVt_NULL );

#define SWAP_DEBUG 0
            if (SWAP_DEBUG) { warn("before swap:"); sv_dump(into); sv_dump(referent); }

            /* Swap the contents of the two heads. */
            Copy(into, &tmp, 1, SV);
            Copy((SV*)referent, into, 1, SV);
            Copy(&tmp, (SV*)referent, 1, SV);
            SvREFCNT(referent)= SvREFCNT(into);
            SvREFCNT(into)= SvREFCNT(&tmp);

            if (SWAP_DEBUG) { warn("after swap:"); sv_dump(into); sv_dump(referent); }

            /* and now throw away the head we got from the regexp engine. */
            SvREFCNT_dec(referent);
        }
#elif defined( TRANSITION_REGEXP )
        {
            REGEXP *referent = CALLREGCOMP(aTHX_ sv_pat, flags);
            sv_magic( into, (SV*)referent, PERL_MAGIC_qr, 0, 0);
            SvFLAGS( into ) |= SVs_SMG;
        }
#else
        {
            PMOP pm; /* grr */
            STRLEN pat_len;
            REGEXP *re;
            char *pat= SvPV(sv_pat, pat_len);

            Zero(&pm,1,PMOP);
            pm.op_pmdynflags= SvUTF8(sv_pat) ? PMdf_CMP_UTF8 : 0;
            pm.op_pmflags= flags;

            re= CALLREGCOMP(aTHX_ pat, pat + pat_len, &pm);
            sv_magic( into, (SV*)re, PERL_MAGIC_qr, 0, 0);
            SvFLAGS( into ) |= SVs_SMG;
        }
#endif
    }
    else {
        SRL_RDR_ERROR(dec->pbuf, "Expecting SRL_HDR_SHORT_BINARY for modifiers of regexp");
    }
}

SRL_STATIC_INLINE SV *
srl_read_extend(pTHX_ srl_decoder_t *dec, SV* into)
{
    /* FIXME unimplemented!!! */
    SRL_RDR_ERROR_UNIMPLEMENTED(dec->pbuf, SRL_HDR_EXTEND,"EXTEND");
    return into;
}

SRL_STATIC_INLINE void
srl_read_copy(pTHX_ srl_decoder_t *dec, SV* into)
{
    UV item= srl_read_varint_uv_offset(aTHX_ dec->pbuf, " while reading COPY tag");
    if (expect_false( dec->save_pos )) {
        SRL_RDR_ERRORf1(dec->pbuf, "COPY(%d) called during parse", (int)item);
    }
    if (expect_false( (IV)item > dec->buf.end - dec->buf.start )) {
        SRL_RDR_ERRORf1(dec->pbuf, "COPY(%d) points out of packet", (int)item);
    }
    dec->save_pos= dec->buf.pos;
    dec->buf.pos= dec->buf.body_pos + item;
    srl_read_single_value(aTHX_ dec, into, NULL);
    dec->buf.pos= dec->save_pos;
    dec->save_pos= 0;
}



/****************************************************************************
 * MAIN DISPATCH SUB - ALL ROADS LEAD HERE                                  *
 ****************************************************************************/

void
srl_decode_single_value(pTHX_ srl_decoder_t *dec, SV* into, SV** container)
{
    srl_read_single_value(aTHX_ dec, into, container);
}

SRL_STATIC_INLINE void
srl_read_single_value(pTHX_ srl_decoder_t *dec, SV* into, SV** container)
{
    STRLEN len;
    U8 tag;
    int is_ref = 0;
    const U8 *track_it = NULL;

  read_again:
    if (expect_false( SRL_RDR_DONE(dec->pbuf) ))
        SRL_RDR_ERROR(dec->pbuf, "unexpected end of input stream while expecting a single value");

    tag= *dec->buf.pos++;

  read_tag:
    switch (tag) {
        CASE_SRL_HDR_POS:
            srl_setiv(aTHX_ dec, into, container, track_it, (IV)tag);
            break;
        CASE_SRL_HDR_NEG:
            srl_setiv(aTHX_ dec, into, container, track_it, (IV)(tag - 32));
            break;
        CASE_SRL_HDR_SHORT_BINARY:
            len= (STRLEN)SRL_HDR_SHORT_BINARY_LEN_FROM_TAG(tag);
            SRL_RDR_ASSERT_SPACE(dec->pbuf, len, " while reading ascii string");
            sv_setpvn(into,(char*)dec->buf.pos,len);
            dec->buf.pos += len;
            break;
        CASE_SRL_HDR_HASHREF:       srl_read_hash(aTHX_ dec, into, tag);  is_ref = 1; break;
        CASE_SRL_HDR_ARRAYREF:      srl_read_array(aTHX_ dec, into, tag); is_ref = 1; break;
        case SRL_HDR_VARINT:        srl_read_varint_into(aTHX_ dec, into, container, track_it); break;
        case SRL_HDR_ZIGZAG:        srl_read_zigzag_into(aTHX_ dec, into, container, track_it); break;

        case SRL_HDR_FLOAT:         srl_read_float(aTHX_ dec, into);                  break;

        case SRL_HDR_FLOAT_128:     srl_read_float_128(aTHX_ dec, into);              break;

        case SRL_HDR_DOUBLE:        srl_read_double(aTHX_ dec, into);                 break;

        case SRL_HDR_LONG_DOUBLE:   srl_read_long_double(aTHX_ dec, into);            break;

        case SRL_HDR_NO:            /* fallthrough */
        case SRL_HDR_FALSE:         sv_setsv(into, &PL_sv_no);                        break;

        case SRL_HDR_YES:           /* fallthrough */
        case SRL_HDR_TRUE:          sv_setsv(into, &PL_sv_yes);                       break;

        case SRL_HDR_CANONICAL_UNDEF: /* fallthrough (XXX: is this right?)*/
        case SRL_HDR_UNDEF:
        {
            if (container && SRL_DEC_HAVE_OPTION(dec,SRL_F_DECODER_USE_UNDEF)){
                SvREFCNT_dec(into);
                *container= &PL_sv_undef;
                if ( track_it )
                    srl_track_sv(aTHX_ dec, track_it, *container);
            } else {
                sv_setsv(into, &PL_sv_undef);
            }
        }
        break;

        case SRL_HDR_BINARY:        srl_read_string(aTHX_ dec, 0, into);              break;
        case SRL_HDR_STR_UTF8:      srl_read_string(aTHX_ dec, 1, into);              break;

        case SRL_HDR_WEAKEN:        srl_read_weaken(aTHX_ dec, into);       is_ref=1; break;
        case SRL_HDR_REFN:          srl_read_refn(aTHX_ dec, into);         is_ref=1; break;
        case SRL_HDR_REFP:          srl_read_refp(aTHX_ dec, into);         is_ref=1; break;
        case SRL_HDR_OBJECT_FREEZE:
        case SRL_HDR_OBJECT:        srl_read_object(aTHX_ dec, into, tag, 0); is_ref=1; break;
        case SRL_HDR_OBJECTV_FREEZE:
        case SRL_HDR_OBJECTV:       srl_read_objectv(aTHX_ dec, into, tag); is_ref=1; break;
        case SRL_HDR_COPY:          srl_read_copy(aTHX_ dec, into);                   break;
        case SRL_HDR_EXTEND:        srl_read_extend(aTHX_ dec, into);                 break;
        case SRL_HDR_HASH:          srl_read_hash(aTHX_ dec, into, 0);                break;
        case SRL_HDR_ARRAY:         srl_read_array(aTHX_ dec, into, 0);               break;
        case SRL_HDR_REGEXP:        srl_read_regexp(aTHX_ dec, into);                 break;
        case SRL_HDR_ALIAS:
        {
            UV offset;
            SV *alias;
            if (!container)
                SRL_RDR_ERROR(dec->pbuf, "ALIAS tag not inside container, corrupt packet?");
            offset= srl_read_varint_uv_offset(aTHX_ dec->pbuf," while reading ALIAS tag");
            alias= srl_fetch_item(aTHX_ dec, offset, "ALIAS");
#ifdef FOLLOW_REFERENCES_IF_NOT_STASHED
            if (!alias) alias= srl_follow_refp_alias_reference(aTHX_ dec, offset);
#endif
            SvREFCNT_inc(alias);
            SvREFCNT_dec(into);
            *container= alias;
            if (track_it)
                srl_track_sv(aTHX_ dec, track_it, alias);
            return;
        }
        break;
        case SRL_HDR_PAD:           /* no op */
            while (SRL_RDR_NOT_DONE(dec->pbuf) && *dec->buf.pos == SRL_HDR_PAD)
                dec->buf.pos++;
            goto read_again;
        break;
        default:
            if (tag & SRL_HDR_TRACK_FLAG) {
                tag= tag & ~SRL_HDR_TRACK_FLAG;
                track_it = dec->buf.pos-1;
                srl_track_sv(aTHX_ dec, track_it, into);
                goto read_tag;
            } else { 
                SRL_RDR_ERROR_UNEXPECTED(dec->pbuf, tag, " single value");
            }
        break;
    }

    /* they want us to set all SVs readonly, or only the non-ref */
#define SUPPORT_READONLY 1
#if SUPPORT_READONLY
    if ( expect_false(dec->flags_readonly) )
    {
        if (
             dec->flags_readonly == 1 || !is_ref
        ) {
            if (is_ref && !SvREADONLY(SvRV(into)) ) {
                SvREADONLY_on(SvRV(into));
            }
            if (!SvREADONLY(into)) {
                SvREADONLY_on(into);
            }
        }
    }
#endif


    return;
}