From 04a915e37923a3e0e0d27b2e40df098cf4d2bb69 Mon Sep 17 00:00:00 2001 From: Alexandre Mestiashvili Date: Wed, 29 Apr 2015 11:12:06 +0200 Subject: [PATCH] Imported Upstream version 3.005.001 --- Changes | 22 +- Encoder.xs | 49 +- MANIFEST | 9 +- META.json | 6 +- META.yml | 4 +- Makefile.PL | 35 +- author_tools/bench.pl | 551 +++++---- author_tools/decode.pl | 361 ++++++ author_tools/hobodecoder.pl | 57 +- author_tools/update_from_header.pl | 145 ++- const-c.inc | 1020 ----------------- const-xs.inc | 90 -- inc/Sereal/BuildTools.pm | 1223 +------------------- lib/Sereal/Encoder.pm | 64 +- lib/Sereal/Encoder/Constants.pm | 1680 ++++++++++++++-------------- ptable.h | 161 +-- srl_buffer.h | 258 +++-- srl_buffer_types.h | 9 +- srl_common.h | 2 +- srl_compress.h | 217 ++++ srl_encoder.c | 529 ++++----- srl_encoder.h | 100 +- srl_error.h | 28 + srl_protocol.h | 104 +- srl_taginfo.h | 369 ++++++ t/022_canonical_refs.t | 21 + t/030_canonical_vs_test_deep.t | 51 + t/170_cyclic_weakrefs.t | 127 +++ t/lib/Sereal/TestSet.pm | 46 +- typemap | 5 +- 30 files changed, 3294 insertions(+), 4049 deletions(-) create mode 100644 author_tools/decode.pl delete mode 100644 const-c.inc delete mode 100644 const-xs.inc create mode 100644 srl_compress.h create mode 100644 srl_error.h create mode 100644 srl_taginfo.h create mode 100644 t/022_canonical_refs.t create mode 100644 t/030_canonical_vs_test_deep.t create mode 100644 t/170_cyclic_weakrefs.t diff --git a/Changes b/Changes index c6fb20f..e3288b9 100644 --- a/Changes +++ b/Changes @@ -1,8 +1,24 @@ Revision history for Perl extension Sereal-Encoder -* Warning: For a seamless upgrade, upgrade to version 3 -* of the decoder before upgrading to version 3 of the -* encoder! +**************************************************************** +* Warning: For a seamless upgrade, upgrade to version 3 * +* of the decoder before upgrading to version 3 of the * +* encoder! * +**************************************************************** +3.005_001 Jan 27 2015 + * Win32 fixes + * Build improvements + * Changes to how we generate constants + +3.005 Jan 05 2015 + * Build improvements related to char signedness being platform + dependent. + +3.004 Dec 27 2014 + * Performance optimizations and other miscellaneous changes. + * Build improvements. + * Win32 fixes for weakrefs. + 3.003 Oct 19 2014 * Niko Tyni fixed the 64-bit big endian Sereal bug! (Yay Niko!) * Setup META.yml correctly so that certain dependencies are diff --git a/Encoder.xs b/Encoder.xs index bb2a974..7bc02cd 100644 --- a/Encoder.xs +++ b/Encoder.xs @@ -13,7 +13,6 @@ /* Generated code for exposing C constants to Perl */ #include "srl_protocol.h" -#include "const-c.inc" #include "ptable.h" @@ -134,11 +133,44 @@ THX_xsfunc_sereal_encode_with_object(pTHX_ CV *cv) pp1_sereal_encode_with_object(arity == 3); } +#define MY_CXT_KEY "Sereal::Encoder::_stash" XS_VERSION + + +typedef struct { + sv_with_hash options[SRL_ENC_OPT_COUNT]; +} my_cxt_t; + +START_MY_CXT + MODULE = Sereal::Encoder PACKAGE = Sereal::Encoder PROTOTYPES: DISABLE BOOT: { + { + MY_CXT_INIT; + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_ALIASED_DEDUPE_STRINGS, SRL_ENC_OPT_STR_ALIASED_DEDUPE_STRINGS ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_CANONICAL, SRL_ENC_OPT_STR_CANONICAL ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_CANONICAL_REFS, SRL_ENC_OPT_STR_CANONICAL_REFS ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_COMPRESS, SRL_ENC_OPT_STR_COMPRESS ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_COMPRESS_LEVEL, SRL_ENC_OPT_STR_COMPRESS_LEVEL ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_COMPRESS_THRESHOLD, SRL_ENC_OPT_STR_COMPRESS_THRESHOLD ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_CROAK_ON_BLESS, SRL_ENC_OPT_STR_CROAK_ON_BLESS ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_DEDUPE_STRINGS, SRL_ENC_OPT_STR_DEDUPE_STRINGS ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_FREEZE_CALLBACKS, SRL_ENC_OPT_STR_FREEZE_CALLBACKS ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_MAX_RECURSION_DEPTH, SRL_ENC_OPT_STR_MAX_RECURSION_DEPTH ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_NO_BLESS_OBJECTS, SRL_ENC_OPT_STR_NO_BLESS_OBJECTS ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_NO_SHARED_HASHKEYS, SRL_ENC_OPT_STR_NO_SHARED_HASHKEYS ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_PROTOCOL_VERSION, SRL_ENC_OPT_STR_PROTOCOL_VERSION ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_SNAPPY, SRL_ENC_OPT_STR_SNAPPY ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_SNAPPY_INCR, SRL_ENC_OPT_STR_SNAPPY_INCR ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_SNAPPY_THRESHOLD, SRL_ENC_OPT_STR_SNAPPY_THRESHOLD ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_SORT_KEYS, SRL_ENC_OPT_STR_SORT_KEYS ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_STRINGIFY_UNKNOWN, SRL_ENC_OPT_STR_STRINGIFY_UNKNOWN ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_UNDEF_UNKNOWN, SRL_ENC_OPT_STR_UNDEF_UNKNOWN ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_USE_PROTOCOL_V1, SRL_ENC_OPT_STR_USE_PROTOCOL_V1 ); + SRL_INIT_OPTION( SRL_ENC_OPT_IDX_WARN_UNKNOWN, SRL_ENC_OPT_STR_WARN_UNKNOWN ); + } #if USE_CUSTOM_OPS { XOP *xop; @@ -165,8 +197,10 @@ srl_encoder_t * new(CLASS, opt = NULL) char *CLASS; HV *opt; + PREINIT: + dMY_CXT; CODE: - RETVAL = srl_build_encoder_struct(aTHX_ opt); + RETVAL = srl_build_encoder_struct(aTHX_ opt, MY_CXT.options); RETVAL->flags |= SRL_F_REUSE_ENCODER; OUTPUT: RETVAL @@ -183,8 +217,9 @@ encode_sereal(src, opt = NULL) HV *opt; PREINIT: srl_encoder_t *enc; + dMY_CXT; PPCODE: - enc = srl_build_encoder_struct(aTHX_ opt); + enc = srl_build_encoder_struct(aTHX_ opt, MY_CXT.options); assert(enc != NULL); /* Avoid copy by stealing string buffer if it is not too large. * This makes sense in the functional interface since the string @@ -199,10 +234,11 @@ encode_sereal_with_header_data(src, hdr_user_data_src, opt = NULL) HV *opt; PREINIT: srl_encoder_t *enc; + dMY_CXT; PPCODE: if (!SvOK(hdr_user_data_src)) hdr_user_data_src = NULL; - enc = srl_build_encoder_struct(aTHX_ opt); + enc = srl_build_encoder_struct(aTHX_ opt, MY_CXT.options); assert(enc != NULL); /* Avoid copy by stealing string buffer if it is not too large. * This makes sense in the functional interface since the string @@ -210,11 +246,6 @@ encode_sereal_with_header_data(src, hdr_user_data_src, opt = NULL) ST(0) = srl_dump_data_structure_mortal_sv(aTHX_ enc, src, hdr_user_data_src, SRL_ENC_SV_REUSE_MAYBE); XSRETURN(1); -MODULE = Sereal::Encoder PACKAGE = Sereal::Encoder::Constants -PROTOTYPES: DISABLE - -INCLUDE: const-xs.inc - MODULE = Sereal::Encoder PACKAGE = Sereal::Encoder::_ptabletest void diff --git a/MANIFEST b/MANIFEST index 2732e97..48dade9 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,4 +1,5 @@ author_tools/bench.pl +author_tools/decode.pl author_tools/different_sereal_docs.sh author_tools/freeze_thaw_timing.pl author_tools/hobodecoder.pl @@ -7,8 +8,6 @@ author_tools/stringify_test.c author_tools/update_from_header.pl author_tools/valgrind.supp Changes -const-c.inc -const-xs.inc Encoder.xs inc/Devel/CheckLib.pm inc/Sereal/BuildTools.pm @@ -30,10 +29,13 @@ snappy/csnappy_internal_userspace.h srl_buffer.h srl_buffer_types.h srl_common.h +srl_compress.h srl_encoder.c srl_encoder.h +srl_error.h srl_inline.h srl_protocol.h +srl_taginfo.h t/001_load.t t/002_constants.t t/003_ptable.t @@ -42,10 +44,13 @@ t/010_desperate.t t/011_aliased_dedupe.t t/020_sort_keys.t t/021_sort_keys_option.t +t/022_canonical_refs.t +t/030_canonical_vs_test_deep.t t/110_nobless.t t/120_hdr_data.t t/130_freezethaw.t t/160_recursion.t +t/170_cyclic_weakrefs.t t/200_bulk.t t/300_fail.t t/400_evil.t diff --git a/META.json b/META.json index 287cd25..86bd130 100644 --- a/META.json +++ b/META.json @@ -29,7 +29,7 @@ }, "configure" : { "requires" : { - "ExtUtils::MakeMaker" : "0" + "ExtUtils::MakeMaker" : "7.0" } }, "runtime" : { @@ -50,7 +50,7 @@ } } }, - "release_status" : "stable", + "release_status" : "testing", "resources" : { "bugtracker" : { "web" : "https://github.com/Sereal/Sereal/issues" @@ -60,5 +60,5 @@ "url" : "git://github.com/Sereal/Sereal.git" } }, - "version" : "3.003" + "version" : "3.005_001" } diff --git a/META.yml b/META.yml index 4d1a764..a2928a5 100644 --- a/META.yml +++ b/META.yml @@ -14,7 +14,7 @@ build_requires: Test::More: '0.88' Test::Warn: '0' configure_requires: - ExtUtils::MakeMaker: '0' + ExtUtils::MakeMaker: '7.0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060' license: perl @@ -32,4 +32,4 @@ requires: resources: bugtracker: https://github.com/Sereal/Sereal/issues repository: git://github.com/Sereal/Sereal.git -version: '3.003' +version: 3.005_001 diff --git a/Makefile.PL b/Makefile.PL index a3bf8bd..5624359 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -30,18 +30,36 @@ my $objects = '$(BASEEXT)$(OBJ_EXT) srl_encoder$(OBJ_EXT)'; my $defines = join " ", map "-D$_", grep exists $ENV{$_}, qw(NOINLINE DEBUG MEMDEBUG NDEBUG ENABLE_DANGEROUS_HACKS); +my $moderngccish = 0; +my $clang = 0; if ($Config{gccversion}) { - $OPTIMIZE = '-O3 -Wall -W'; + if ($Config{gccversion} =~ /[Cc]lang/) { # clang. + $clang = 1; + $moderngccish = 1; + } elsif ($Config{gccversion} =~ /^[123]\./) { # Ancient gcc. + $moderngccish = 0; + } else { # Modern gcc. + $moderngccish = 1; + } } elsif ($Config{osname} eq 'MSWin32') { $OPTIMIZE = '-O2 -W4'; } else { $OPTIMIZE = $Config{optimize}; } +# For trapping C++ // comments we would need -std=c89 (aka -ansi) +# but that may be asking too much of different platforms. +if ($moderngccish) { + $OPTIMIZE .= ' -Werror=declaration-after-statement '; +} + if ($ENV{DEBUG}) { $OPTIMIZE .= ' -g'; - $OPTIMIZE .= ' -Wextra' if $ENV{DEBUG} > 1 && $Config{gccversion}; - $OPTIMIZE .= ' -pedantic' if $ENV{DEBUG} > 5 && $Config{gccversion}; # not pretty + if ($ENV{DEBUG} > 0 && $Config{gccversion}) { + $OPTIMIZE .= ' -Wextra' if $ENV{DEBUG} > 1; + $OPTIMIZE .= ' -pedantic' if $ENV{DEBUG} > 5; # not pretty + $OPTIMIZE .= ' -Weverything' if ($ENV{DEBUG} > 6 && $clang); # really not pretty + } } else { $defines .= " -DNDEBUG"; @@ -100,6 +118,9 @@ WriteMakefile1( 'File::Path' => 0, 'ExtUtils::ParseXS' => '2.21', }, + CONFIGURE_REQUIRES => { + 'ExtUtils::MakeMaker' => '7.0', + }, NAME => $module, VERSION_FROM => 'lib/Sereal/Encoder.pm', # finds $VERSION PREREQ_PM => { @@ -119,7 +140,8 @@ WriteMakefile1( ); $ENV{OPTIMIZE} = $OPTIMIZE; -sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.20. Added by eumm-upgrade. +sub WriteMakefile1 { + #Original by Alexandr Ciornii, modified by Yves Orton my %params=@_; my $eumm_version=$ExtUtils::MakeMaker::VERSION; $eumm_version=eval $eumm_version; @@ -134,7 +156,10 @@ sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.20. Added by eumm- $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; delete $params{BUILD_REQUIRES}; } - delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; + if ($params{CONFIGURE_REQUIRES} and $eumm_version < 6.52) { + $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}}, %{$params{CONFIGURE_REQUIRES}} }; + delete $params{CONFIGURE_REQUIRES}; + } delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; delete $params{META_MERGE} if $eumm_version < 6.46; delete $params{META_ADD} if $eumm_version < 6.46; diff --git a/author_tools/bench.pl b/author_tools/bench.pl index dace57e..5277223 100644 --- a/author_tools/bench.pl +++ b/author_tools/bench.pl @@ -2,168 +2,263 @@ use strict; use warnings; use blib; use Benchmark qw(cmpthese :hireswallclock); -use Sereal::Decoder qw(decode_sereal); -use Sereal::Encoder qw(encode_sereal); -use JSON::XS qw(decode_json encode_json); +use Sereal::Decoder qw(decode_sereal sereal_decode_with_object); +use Sereal::Encoder qw(encode_sereal sereal_encode_with_object); use Storable qw(nfreeze thaw); -use Data::Undump qw(undump); use Data::Dumper qw(Dumper); -use Data::Dumper::Limited qw(DumpLimited); -use Data::MessagePack; -use CBOR::XS qw(encode_cbor decode_cbor); + + use Getopt::Long qw(GetOptions); +require bytes; -my ( - $duration, - $encoder, - $decoder, - $dump, - $tiny_data, - $small_data, - $medium_data, - $large_data, - $very_large_data, - $nobless, - $diagrams, - $diagram_output_dir, -); -BEGIN { - my $sereal_only = 0; - GetOptions( - 'duration=f' => \($duration=-3), - 'encoder' => \$encoder, - 'decoder' => \$decoder, - 'dump|d' => \$dump, - 'tiny' => \$tiny_data, - 'small' => \$small_data, - 'medium' => \$medium_data, - 'large' => \$large_data, - 'very_large|very-large|verylarge' => \$very_large_data, - 'no_bless|no-bless|nobless' => \$nobless, - 'sereal_only|sereal-only|serealonly' => \$sereal_only, - 'diagrams' => \$diagrams, - 'diagram_output=s' => \$diagram_output_dir, - ); - eval "sub SEREAL_ONLY () { $sereal_only }"; -} +GetOptions( + 'secs|duration=f' => \( my $duration = -5 ), + 'encoder' => \( my $encoder = 0 ), + 'decoder' => \( my $decoder = 0 ), + 'dump|d' => \( my $dump = 0 ), + 'only=s@' => \( my $only = undef ), + 'exclude=s@' => \( my $exclude = undef ), + 'tiny' => \( my $tiny_data = 0 ), + 'small' => \( my $small_data = 0 ), + 'medium' => \( my $medium_data = 0 ), + 'large' => \( my $large_data = 0 ), + 'very_large|very-large|verylarge' => \( my $very_large_data = 0 ), + 'no_bless|no-bless|nobless' => \( my $nobless = 0 ), + 'sereal_only|sereal-only|serealonly' => \( my $sereal_only = 0 ), + 'diagrams' => \( my $diagrams = 0 ), + 'diagram_output=s' => \( my $diagram_output_dir = "" ), +) or die "Bad option"; -my $fail = do {no warnings; $tiny_data + $small_data + $medium_data + $very_large_data + $large_data - 1}; -if ($fail and $fail > 0) { +my $fail = + $tiny_data + $small_data + $medium_data + $very_large_data + $large_data - 1; +if ( $fail and $fail > 0 ) { die "Only one of --tiny, --small, --medium, --large, --very-large allowed!"; } $encoder = 1 if not $encoder and not $decoder; -our %opt = @ARGV; - -our $mpo = Data::MessagePack->new(); +#our %opt = @ARGV; +our %opt; my $data_set_name; srand(0); -my $chars = join("", "a".."z", "A".."Z") x 2; +my $chars = join( "", "a" .. "z", "A" .. "Z" ) x 2; my @str; -push @str, substr($chars, int(rand(int(length($chars)/2+1))), 10) for 1..1000; -my @rand = map rand, 1..1000; -our %data; +push @str, substr( $chars, int( rand( int( length($chars) / 2 + 1 ) ) ), 10 ) + for 1 .. 1000; +my @rand = map rand, 1 .. 1000; -$data{$_}= make_data() for qw(sereal sereal_func dd1 dd2 ddl mp json_xs storable sereal_snappy sereal_zlib_fast sereal_zlib_small cbor); +our ( + $enc, $dec, + $enc_snappy, $dec_snappy, + $enc_zlib_fast, $dec_zlib_fast, + $enc_zlib_small, $dec_zlib_small, + $jsonxs, $msgpack, $dd_noindent, $dd_indent, $cbor +); +my $storable_tag= "strbl"; +my $sereal_tag= "srl"; +my %meta = ( + jxs => { + enc => '$::jsonxs->encode($data);', + dec => '$::jsonxs->decode($encoded);', + name => 'JSON::XS OO', + init => sub { + $jsonxs = JSON::XS->new()->allow_nonref(); + }, + use => 'use JSON::XS qw(decode_json encode_json);', + }, + ddl => { + enc => 'DumpLimited($data);', + dec => 'Data::Undump::undump($encoded);', + name => 'Data::Dump::Limited', + use => [ + 'use Data::Undump qw(undump);', + 'use Data::Dumper::Limited qw(DumpLimited);', + ], + }, + mp => { + enc => '$::msgpack->pack($data);', + dec => '$::msgpack->unpack($encoded);', + name => 'Data::MsgPack', + use => 'use Data::MessagePack;', + init => sub { + $msgpack = Data::MessagePack->new(); + }, + }, + cbor => { + enc => '$::cbor->encode($data);', + dec => '$::cbor->decode($encoded);', + name => 'CBOR::XS', + use => 'use CBOR::XS qw(encode_cbor decode_cbor);', + init => sub { + $cbor= CBOR::XS->new(); + }, + }, + dd_noind => { + enc => 'Data::Dumper->new([$data])->Indent(0)->Dump();', + dec => 'eval $encoded;', + name => 'Data::Dumper no-indent', + }, + dd => { + enc => 'Dumper($data);', + dec => 'eval $encoded;', + name => 'Data::Dumper indented', + }, + $storable_tag => { + enc => 'nfreeze($data);', + dec => 'thaw($encoded);', + name => 'Storable', + }, + srl_func => { + enc => 'encode_sereal($data, $opt);', + dec => 'decode_sereal($encoded, $opt);', + name => 'Sereal functional', + }, + srl_fwo => { + enc => 'sereal_encode_with_object($::enc,$data);', + dec => 'sereal_decode_with_object($::dec,$encoded);', + name => 'Sereal functional with object', + }, + $sereal_tag => { + enc => '$::enc->encode($data);', + dec => '$::dec->decode($encoded);', + name => 'Sereal OO', + init => sub { + $enc = Sereal::Encoder->new( %opt ? \%opt : () ); + $dec = Sereal::Decoder->new( \%opt ? \%opt : () ); + }, + }, + srl_snpy => { + enc => '$::enc_snappy->encode($data);', + dec => '$::dec_snappy->decode($encoded);', + name => 'Sereal OO snappy', + init => sub { + $enc_snappy = Sereal::Encoder->new( + { + %opt, + compress => Sereal::Encoder::SRL_SNAPPY + } + ); + $dec_snappy = Sereal::Decoder->new( %opt ? \%opt : () ); + }, + }, + srl_zfast => { + enc => '$::enc_zlib_fast->encode($data);', + dec => '$::dec_zlib_fast->decode($encoded);', + name => 'Sereal OO zlib fast', + init => sub { + $enc_zlib_fast = Sereal::Encoder->new( + { + %opt, + compress => Sereal::Encoder::SRL_ZLIB, + compress_level => 1, + compress_threshold => 0, + } + ); + $dec_zlib_fast = Sereal::Decoder->new( %opt ? \%opt : () ); + }, + }, + srl_zbest => { + enc => '$::enc_zlib_small->encode($data);', + dec => '$::dec_zlib_small->decode($encoded);', + name => 'Sereal OO zib best', + init => sub { + $enc_zlib_small = Sereal::Encoder->new( + { + %opt, + compress => Sereal::Encoder::SRL_ZLIB, + compress_level => 10, + compress_threshold => 0, + } + ); + $dec_zlib_small = Sereal::Decoder->new( %opt ? \%opt : () ); + }, + }, +); +if ($only) { + my @pat= map { split /\s*,\s*/, $_ } @$only; + $only = {}; + foreach my $key (keys %meta) { + $key=~/$_/ and $only->{$key}= 1 + for @pat; + } + die "Only [@pat] produced no matches!" unless keys %$only; +} +if ($exclude) { + my @pat= map { split /\s*,\s*/, $_ } @$exclude; + $exclude = {}; + foreach my $key (keys %meta) { + $key=~/$_/ and $exclude->{$key}= 1 + for @pat; + } + die "Exclude [@pat] produced no matches!" unless keys %$exclude; +} -our $enc = Sereal::Encoder->new(\%opt); -our $enc_snappy = Sereal::Encoder->new({%opt, compress => Sereal::Encoder::SRL_SNAPPY}); -our $enc_zlib_fast = Sereal::Encoder->new({%opt, compress => Sereal::Encoder::SRL_ZLIB, compress_level => 1, compress_threshold => 0}); -our $enc_zlib_small = Sereal::Encoder->new({%opt, compress => Sereal::Encoder::SRL_ZLIB, compress_level => 10, compress_threshold => 0}); -our $dec = Sereal::Decoder->new(\%opt); +our %data; +our %encoded; +our %decoded; +our %enc_bench; +our %dec_bench; +foreach my $key ( sort keys %meta ) { + my $info = $meta{$key}; + $info->{tag}= $key; + next if $only and not $only->{$key} and $key ne $storable_tag; + next if $exclude and $exclude->{$key} and $key ne $storable_tag; + if (my $use= $info->{use}) { + $use= [$use] unless ref $use; + $use= join ";\n", @$use, 1; + unless (eval $use) { + warn "Can't load dependencies for $info->{name}, skipping\n"; + next; + } + } + $info->{enc}=~s/\$data/\$::data{$key}/g; + $info->{dec}=~s/\$encoded/\$::encoded{$key}/g; + $info->{enc}=~s/\$opt/%opt ? "\\%::opt" : ""/ge; + $info->{dec}=~s/\$opt/%opt ? "\\%::opt" : ""/ge; -our ($json_xs, $dd1, $dd2, $ddl, $sereal, $storable, $mp, $sereal_snappy, $sereal_zlib_fast, $sereal_zlib_small, $cbor); -# do this first before any of the other dumpers "contaminate" the iv/pv issue -$sereal = $enc->encode($data{sereal}); -$sereal_snappy = $enc_snappy->encode($data{sereal_snappy}); -$sereal_zlib_fast = $enc_zlib_fast->encode($data{sereal_zlib_fast}); -$sereal_zlib_small = $enc_zlib_small->encode($data{sereal_zlib_small}); -if (!SEREAL_ONLY) { - $json_xs = encode_json($data{json_xs}) if !$medium_data or $nobless; - $dd1 = Data::Dumper->new([$data{dd1}])->Indent(0)->Dump(); - $dd2 = Dumper($data{dd2}); - $ddl = DumpLimited($data{ddl}) if !$medium_data or $nobless; - $mp = $mpo->pack($data{mp}) if !$medium_data or $nobless; - $cbor = encode_cbor($data{cbor}) if !$medium_data or $nobless; - $storable = nfreeze($data{storable}); + $data{$key} = make_data(); + $info->{init}->() if $info->{init}; + $encoded{$key} = eval $info->{enc} + or die "Failed to eval $info->{enc}: $@"; + $decoded{$key} = eval '$::x = ' . $info->{dec} . '; 1' + or die "Failed to eval $info->{dec}: $@\n$encoded{$key}\n"; + $info->{size} = bytes::length( $encoded{$key} ); + next if $only and not $only->{$key}; + next if $exclude and $exclude->{$key}; + $enc_bench{$key} = '$::x_' . $key . ' = ' . $info->{enc}; + $dec_bench{$key} = '$::x_' . $key . ' = ' . $info->{dec}; } + +my $sereal = $encoded{$sereal_tag}; print($sereal), exit if $dump; -my $sereal_len= bytes::length($sereal); -require bytes; -my @size_datasets; -if (!SEREAL_ONLY) { - @size_datasets = ( - (($medium_data && !$nobless) ? () : ( - ["JSON::XS", bytes::length($json_xs)], - ["Data::Dumper::Limited", bytes::length($ddl)], - ["Data::MessagePack", bytes::length($mp)], - ["CBOR", bytes::length($cbor)], - )), - ["Data::Dumper (1)", bytes::length($dd1)], - ["Data::Dumper (2)", bytes::length($dd2)], - ["Storable", bytes::length($storable)], - ["Sereal::Encoder", bytes::length($sereal)], - ["Sereal::Encoder, Snappy", bytes::length($sereal_snappy)], - ["Sereal::Encoder, Zlib (fast)", bytes::length($sereal_zlib_fast)], - ["Sereal::Encoder, Zlib (small)", bytes::length($sereal_zlib_small)], - ); - for my $tuple (@size_datasets) { - my ($name, $size) = @$tuple; - printf "%-40s %12d bytes %.2f%% of sereal\n", $name, $size, $size/$sereal_len *100; +my $storable_len = bytes::length($encoded{$storable_tag}); +foreach my $info ( + sort { $a->{size} <=> $b->{size} || $a->{name} cmp $b->{name} } + grep { defined $_->{size} } + values %meta +) { + next unless $info->{size}; + if ($info->{tag} eq $storable_tag) { + printf "%-40s %12d bytes\n", + $info->{name} . " ($info->{tag})", $info->{size}; + } else { + printf "%-40s %12d bytes %6.2f%% of $storable_tag\n", + $info->{name} . " ($info->{tag})", $info->{size}, + $info->{size} / $storable_len * 100; } } our $x; -my ($encoder_result, $decoder_result); +my ( $encoder_result, $decoder_result ); if ($encoder) { - $encoder_result = cmpthese( - $duration, - { - (!SEREAL_ONLY - ? ( - ($medium_data && !$nobless ? () : ( - json_xs => '$::x = encode_json($::data{json_xs});', - ddl => '$::x = DumpLimited($::data{ddl});', - msgpack => '$::x = $::mpo->pack($::data{mp});', - cbor => '$::x = encode_cbor($::data{cbor});', - )), - dd_noindent => '$::x = Data::Dumper->new([$::data{dd1}])->Indent(0)->Dump();', - dd => '$::x = Dumper($::data{dd2});', - storable => '$::x = nfreeze($::data{storable});', - ) : ()), - sereal_func => '$::x = encode_sereal($::data{sereal_func}, \%::opt);', - sereal => '$::x = $::enc->encode($::data{sereal});', - sereal_snappy => '$::x = $::enc_snappy->encode($::data{sereal_snappy});', - sereal_zlib_fast => '$::x = $::enc_zlib_fast->encode($::data{sereal_zlib_fast});', - sereal_zlib_small => '$::x = $::enc_zlib_small->encode($::data{sereal_zlib_small});', - } - ); + print "\n* Timing encoders\n"; + $encoder_result = cmpthese( $duration, \%enc_bench ); } if ($decoder) { - $decoder_result = cmpthese( - $duration, - { - (!SEREAL_ONLY - ? ( - ($medium_data && !$nobless ? () : ( - json_xs => '$::x = decode_json($::json_xs);', - undump_ddl => '$::x = Data::Undump::undump($::ddl);', - msgpack => '$::x = $::mpo->unpack($::mp);', - cbor => '$::x = decode_cbor($::cbor);', - )), - eval_dd => '$::x = eval $::dd1;', - storable => '$::x = thaw($::storable);', - ) : ()), - sereal_func => '$::x = decode_sereal($::sereal, \%::opt);', - sereal => '$::x = $::dec->decode($::sereal);', - sereal_snappy => '$::x = $::dec->decode($::sereal_snappy);', - sereal_zlib_fast => '$::x = $::dec->decode($::sereal_zlib_fast);', - sereal_zlib_small => '$::x = $::dec->decode($::sereal_zlib_small);', - } - ); + print "\n* Timing decoders\n"; + $decoder_result = cmpthese( $duration, \%dec_bench ); } sub make_data { @@ -173,52 +268,116 @@ sub make_data { } elsif ($small_data) { $data_set_name = "small hash"; - return { foo=> 1, bar => [100,101,102], str => "this is a \x{df} string which has to be serialized" }; + return { + foo => 1, + bar => [ 100, 101, 102 ], + str => "this is a \x{df} string which has to be serialized" + }; } elsif ($medium_data) { my @obj = ( - { foo => 1, bar => [100,101,102], str => "this is a \x{df} string which has to be serialized" }, - { foo => 2, bar => [103,103,106,999], str2 => "this is a \x{df} aaaaaastring which has to be serialized" }, - { foozle => 3, bar => [100], str3 => "this is a \x{df} string which haaaaadsadas to be serialized" }, - { foozle => 3, bar => [], st4r => "this is a \x{df} string which has to be sdassdaerialized" }, - { foo => 1, bar => [100,101,102], s5tr => "this is a \x{df} string which has to be serialized" }, - { foo => 2, bar => [103,103,106,999], str => "this is a \x{df} aaaaaastring which has to be serialized" }, - { foozle => 3, bar => [100], str => "this is a \x{df} string which haaaaadsadas to be serialized" }, - { foozle => 3, bar => [], str2 => "this is a \x{df} string which has to be sdassdaerialized" }, - { foo2 => -99999, bar => [100,101,102], str2 => "this is a \x{df} string which has to be serialized" }, - { foo2 => 213, bar => [103,103,106,999], str => "this is a \x{df} aaaaaastring which has to be serialized" }, - { foozle2 => undef, bar => [100], str => "this is a \x{df} string which haaaaadsadas to be serialized" }, - { foozle2 => undef, bar => [1..20], str => "this is a \x{df} string which has to be sdassdaerialized" }, + { + foo => 1, + bar => [ 100, 101, 102 ], + str => "this is a \x{df} string which has to be serialized" + }, + { + foo => 2, + bar => [ 103, 103, 106, 999 ], + str2 => + "this is a \x{df} aaaaaastring which has to be serialized" + }, + { + foozle => 3, + bar => [100], + str3 => + "this is a \x{df} string which haaaaadsadas to be serialized" + }, + { + foozle => 3, + bar => [], + st4r => + "this is a \x{df} string which has to be sdassdaerialized" + }, + { + foo => 1, + bar => [ 100, 101, 102 ], + s5tr => "this is a \x{df} string which has to be serialized" + }, + { + foo => 2, + bar => [ 103, 103, 106, 999 ], + str => + "this is a \x{df} aaaaaastring which has to be serialized" + }, + { + foozle => 3, + bar => [100], + str => + "this is a \x{df} string which haaaaadsadas to be serialized" + }, + { + foozle => 3, + bar => [], + str2 => + "this is a \x{df} string which has to be sdassdaerialized" + }, + { + foo2 => -99999, + bar => [ 100, 101, 102 ], + str2 => "this is a \x{df} string which has to be serialized" + }, + { + foo2 => 213, + bar => [ 103, 103, 106, 999 ], + str => + "this is a \x{df} aaaaaastring which has to be serialized" + }, + { + foozle2 => undef, + bar => [100], + str => + "this is a \x{df} string which haaaaadsadas to be serialized" + }, + { + foozle2 => undef, + bar => [ 1 .. 20 ], + str => + "this is a \x{df} string which has to be sdassdaerialized" + }, ); my @classes = qw(Baz Baz Baz3 Baz2 Baz Baz Baz3 Baz2 Baz Baz Baz3 Baz2); - if (!$nobless) { - bless($obj[$_], $classes[$_]) for 0..$#obj; - $data_set_name = "array of small objects with relations"; + if ( $nobless ) { + $data_set_name = "array of small hashes with relations"; } else { - $data_set_name = "array of small hashes with relations"; + bless( $obj[$_], $classes[$_] ) for 0 .. $#obj; + $data_set_name = "array of small objects with relations"; } - foreach my $i (1..$#obj) { - $obj[$i]->{parent} = $obj[$i-1]; + foreach my $i ( 1 .. $#obj ) { + $obj[$i]->{parent} = $obj[ $i - 1 ]; } return \@obj; } - elsif ($very_large_data) { # "large data" + elsif ($very_large_data) { # "large data" $data_set_name = "really rather large data structure"; my @refs = ( - [1..10000], {@str}, {@str}, [1..10000], + [ 1 .. 10000 ], + {@str}, {@str}, [ 1 .. 10000 ], {@str}, [@rand], {@str}, {@str}, ); return [ - \@refs, \@refs, [map {[reverse 1..100]} (0..1000)], [map {+{foo => "bar", baz => "buz"}} 1..2000] - ] + \@refs, \@refs, + [ map { [ reverse 1 .. 100 ] } ( 0 .. 1000 ) ], + [ map { +{ foo => "bar", baz => "buz" } } 1 .. 2000 ] + ]; } - else { # "large data" + else { # "large data" $data_set_name = "large data structure"; return [ - [1..10000], {@str}, {@str}, [1..10000], + [ 1 .. 10000 ], {@str}, {@str}, [ 1 .. 10000 ], {@str}, [@rand], {@str}, {@str}, - ] + ]; } } @@ -227,49 +386,52 @@ if ($diagrams) { SOOT::Init(0); SOOT->import(":all"); - my ($enc_data, $dec_data); + my ( $enc_data, $dec_data ); $enc_data = cmpthese_to_sanity($encoder_result) if $encoder_result; $dec_data = cmpthese_to_sanity($decoder_result) if $decoder_result; - foreach my $dia (["Encoder performance [1/s]", $enc_data], - ["Decoder performance [1/s]", $dec_data],) + foreach my $dia ( + [ "Encoder performance [1/s]", $enc_data ], + [ "Decoder performance [1/s]", $dec_data ], + ) { - my ($title, $d) = @$dia; + my ( $title, $d ) = @$dia; next if not $d; $_->[0] =~ s/_/ /g, $_->[0] =~ s/sereal /sereal, / for @$d; make_bar_chart( - substr($title, 0, 3), + substr( $title, 0, 3 ), $d, { - title => $title, + title => $title, filename => do { my $x = $title; $x =~ s/\[1\/s\]/per second/; - $data_set_name . " - " . $x + $data_set_name . " - " . $x; }, } ); } my %names = ( - "JSON::XS" => 'json xs', - "Data::Dumper::Limited" => 'ddl', - "Data::MessagePack" => "msgpack", - "Data::Dumper (1)" => "dd noindent", - "Data::Dumper (2)" => "dd", - "Storable" => 'storable', - "Sereal::Encoder" => 'sereal', + "JSON::XS" => 'json xs', + "Data::Dumper::Limited" => 'ddl', + "Data::MessagePack" => "msgpack", + "Data::Dumper (1)" => "dd noindent", + "Data::Dumper (2)" => "dd", + "Storable" => 'storable', + "Sereal::Encoder" => 'sereal', "Sereal::Encoder, Snappy" => 'sereal, snappy', ); make_bar_chart( "size", [ - sort {$b->[1] <=> $a->[1]} map [ $names{$_->[0]}||die, $_->[1] ], @size_datasets + sort { $b->[1] <=> $a->[1] } + map { $_->{size} ? [ $_->{name}, $_->{size} ] : () } values %meta ], { - title => "Encoded output sizes [bytes]", - color => kRed(), + title => "Encoded output sizes [bytes]", + color => kRed(), filename => $data_set_name . " - Encoded output sizes in bytes", }, ); @@ -277,21 +439,23 @@ if ($diagrams) { } sub make_bar_chart { - my ($name, $data, $opts) = @_; - my $h = TH1D->new($name, ($opts->{title}||$name), scalar(@$data), -0.5, scalar(@$data)-0.5); + my ( $name, $data, $opts ) = @_; + my $h = TH1D->new( $name, ( $opts->{title} || $name ), + scalar(@$data), -0.5, scalar(@$data) - 0.5 ); $h->keep; - $h->SetFillColor($opts->{color} || kBlue()); + $h->SetFillColor( $opts->{color} || kBlue() ); $h->SetBarOffset(0.12); $h->SetBarWidth(0.74); $h->SetStats(0); $h->GetXaxis()->SetLabelSize(0.06); $h->GetXaxis()->SetLabelOffset(0.009); - $h->GetYaxis()->SetTitle($opts->{title}) if defined $opts->{title}; + $h->GetYaxis()->SetTitle( $opts->{title} ) if defined $opts->{title}; $h->GetYaxis()->SetTitleSize(0.045); - for my $i (1..@$data) { - my ($label, $rate) = @{ $data->[$i-1] }; - $h->GetXaxis()->SetBinLabel($i, $label); - $h->SetBinContent($i, 0+$rate); + + for my $i ( 1 .. @$data ) { + my ( $label, $rate ) = @{ $data->[ $i - 1 ] }; + $h->GetXaxis()->SetBinLabel( $i, $label ); + $h->SetBinContent( $i, 0 + $rate ); } my $c = TCanvas->new->keep; $c->GetPad(0)->SetBottomMargin(0.175); @@ -302,20 +466,21 @@ sub make_bar_chart { if ($diagram_output_dir) { require File::Path; File::Path::mkpath($diagram_output_dir); - my $file = $opts->{filename} || do {my $f = $opts->{title}; $f =~ s/[^a-zA-Z0-9_\ ]/_/g; $f}; + my $file = $opts->{filename} + || do { my $f = $opts->{title}; $f =~ s/[^a-zA-Z0-9_\ ]/_/g; $f }; $c->SaveAs("$diagram_output_dir/$file.png"); } } sub cmpthese_to_sanity { - my $res = shift; + my $res = shift; my @rows = map { my $rate = $_->[1]; - if (not $rate =~ s/\s*\/\s*s$//) { - $rate = 1/$rate; + if ( not $rate =~ s/\s*\/\s*s$// ) { + $rate = 1 / $rate; } - [$_->[0], $rate] - } grep {defined $_->[0] and $_->[0] =~ /\S/} @$res; + [ $_->[0], $rate ] + } grep { defined $_->[0] and $_->[0] =~ /\S/ } @$res; return \@rows; } - +print "\n"; diff --git a/author_tools/decode.pl b/author_tools/decode.pl new file mode 100644 index 0000000..5e6349f --- /dev/null +++ b/author_tools/decode.pl @@ -0,0 +1,361 @@ +#!/usr/bin/perl -w + +# This script is for testing Sereal decode speeds, with various +# generated test inputs (which are first encoded). Sample usages: +# +# decode.pl --build --output=data.srl +# +# will (1) build a "graph" (a hash of small strings, really, +# which can be seen as an adjacency list representation of +# a graph, the vertex and its neighbors) of 1e5 vertices +# (2) decode the encoded blob 5 times (the 'graph', 1e5, and 5 +# being the defaults). +# +# Other inputs types (--type=T) are +# aoi (array of int) (value == key) +# aoir (array of int) (value == randomly shuffled key) +# aof (array of float) (rand()) +# aos (array of string) (value eq key) +# hoi (hash of int) +# hof (hash of float) +# hos (hash of string) +# +# The 'base' number of elements in each case is controlled by --elem=N. +# For the array and hash the number of elements is trivial, for the graph +# the total number of elements (in its hash-of-hashes) is O(N log N). +# +# The number decode repeats is controlled by --repeat_decode=N and --repeat_decode=N. +# +# The encode input needs to be built only once, the --output tells +# where to save the encoded blob. The encode blob can be read back +# from the save file with --input, much faster, especially in the case +# of the graph input. + +use strict; + +use Time::HiRes; +use Sereal::Encoder; +use Sereal::Decoder; +use Getopt::Long; +use Fcntl qw[O_RDONLY O_WRONLY O_CREAT O_TRUNC]; +use List::Util qw[shuffle]; + +sub MB () { 2 ** 20 } + +my %Opt; +my @Opt = ('input=s', 'output=s', 'type=s', 'elem=f', 'build', + 'repeat_encode=i', 'repeat_decode=i', + + # If non-zero, will drop the minimum and maximum + # values before computing statistics IF the number + # of measurements is at least this limit. So with + # a value of 5 will leave 3 measurements. Lowers + # the stddev, should not affect avg/median (much). + # Helpful in reducing cache effects. + 'min_max_drop_limit=i', + + 'size'); +my %OptO = map { my ($n) = /^(\w+)/; $_ => \$Opt{$n} } @Opt; +my @OptU = map { "--$_" } @Opt; + +GetOptions(%OptO) or die "GetOptions: @OptU\n"; + +my $data; +my $blob; +my $size; +my $data_size; +my $blob_size; +my $dt; + +if (defined $Opt{size}) { + eval 'use Devel::Size qw[total_size]'; + if ($@) { + die "$0: --size but Devel::Size=total_size not found\n"; + } +} + +if (defined $Opt{build}) { + die "$0: --input with --build makes no sense\n" if defined $Opt{input}; + $Opt{elem} //= 1e5; +} else { + die "$0: --output without --build makes no sense\n" if defined $Opt{output}; + die "$0: --elem without --build makes no sense\n" if defined $Opt{elem}; + die "$0: Must specify either --build or --input\n" unless defined $Opt{input}; +} +if (defined ($Opt{output})) { + die "$0: --input with --output makes no sense\n" if defined $Opt{input}; +} + +$Opt{type} //= 'graph'; +$Opt{repeat_encode} //= 1; +$Opt{repeat_decode} //= 5; +$Opt{min_max_drop_limit} //= 0; + +my %TYPE = map { $_ => 1 } qw[aoi aoir aof aos hoi hof hos graph]; + +die "$0: Unexpected --type=$Opt{type}\n$0: Expected --type=@{[join('|', sort keys %TYPE)]}\n" + unless exists $TYPE{$Opt{type}}; + +sub Times::new { + my $t = Time::HiRes::time(); + my ($u, $s, $cu, $cs) = times(); + bless { + wall => $t, + usr => $u, + sys => $s, + cpu => $u + $s, + cusr => $cu, + csys => $cs, + }, $_[0]; +} +sub Times::diff { + die "Unexpected diff(@_)\n" unless ref $_[0] eq ref $_[1]; + bless { map { $_ => ($_[0]->{$_} - $_[1]->{$_}) } keys %{$_[0]} }, ref $_[0]; +} +sub Times::wall { $_[0]->{wall} } +sub Times::usr { $_[0]->{usr} } +sub Times::sys { $_[0]->{sys} } +sub Times::cpu { $_[0]->{cpu} } +# times() can often sum just a tad higher than wallclock. +sub Times::pct { 100 * ($_[0]->cpu > $_[0]->wall ? 1 : $_[0]->cpu / $_[0]->wall) } + +sub timeit { + my $code = shift; + my $t0 = Times->new(); + my @res = $code->(@_); + my $t1 = Times->new(); + my $dt = $t1->diff($t0); + return $dt; +} + +sub __stats { + # The caller is supposed to have done this sorting + # already, but let's be wasteful and paranoid. + my @v = sort { $a <=> $b } @_; + my $min = $v[0]; + my $max = $v[-1]; + my $med = @v % 2 ? $v[@v/2] : ($v[@v/2-1] + $v[@v/2]) / 2; + my $sum = 0; + for my $t (@_) { + $sum += $t; + } + my $avg = $sum / @_; + my $sqsum = 0; + for my $t (@_) { + $sqsum += ($avg - $t) ** 2; + } + my $stddev = sqrt($sqsum / @_); + return ( avg => $avg, + stddev => $stddev, + rstddev => $avg ? $stddev / $avg : undef, + min => $min, med => $med, max => $max ); +} + +sub stats { + my %stats; + for my $k (qw(wall cpu)) { + my @v = sort { $a <=> $b } map { $_->{$k} } @_; + if ($Opt{min_max_drop_limit} > 0 && + @v >= $Opt{min_max_drop_limit}) { + print "$k: dropping min and max ($v[0] and $v[-1])\n"; + shift @v; + pop @v; + } + $stats{$k} = { __stats(@v) }; + } + return %stats; +} + +if (defined $Opt{build}) { + print "building data\n"; + my $E; + if ($Opt{type} eq 'graph') { + print "building graph\n"; + my $V = $Opt{elem}; + $E = int($V * log($V)/log(2)); + printf("data of %d (%.1fM) vertices %d (%.1fM) edges\n", + $V, $V / MB, $E, $E / MB); + $dt = timeit( + sub { + for my $i (1..$E) { + my $a = int(rand($V)); + my $b = int(rand($V)); + $data->{$a}{$b}++; + } + }); + } elsif ($Opt{type} eq 'aoi') { + print "building aoi\n"; + $E = $Opt{elem}; + $dt = timeit( + sub { + for my $i (1..$E) { + push @$data, $i; + } + }); + } elsif ($Opt{type} eq 'aoir') { + print "building aoir\n"; + $E = $Opt{elem}; + $dt = timeit( + sub { + for my $i (shuffle 1..$E) { + push @$data, $i; + } + }); + } elsif ($Opt{type} eq 'aof') { + print "building aof\n"; + $E = $Opt{elem}; + $dt = timeit( + sub { + for my $i (1..$E) { + push @$data, rand(); + } + }); + } elsif ($Opt{type} eq 'aos') { + print "building aos\n"; + $E = $Opt{elem}; + $dt = timeit( + sub { + for my $i (1..$E) { + push @$data, rand() . $$; + } + }); + } elsif ($Opt{type} eq 'hoi') { + print "building hoi\n"; + $E = $Opt{elem}; + $dt = timeit( + sub { + for my $i (1..$E) { + $data->{$i} = $i; + } + }); + } elsif ($Opt{type} eq 'hof') { + print "building hof\n"; + $E = $Opt{elem}; + $dt = timeit( + sub { + for my $i (1..$E) { + $data->{$i} = rand(); + } + }); + } elsif ($Opt{type} eq 'hos') { + print "building hos\n"; + $E = $Opt{elem}; + $dt = timeit( + sub { + for my $i (1..$E) { + $data->{$i} = "$i"; + } + }); + } else { + die "$0: Unexpected type '$Opt{type}'\n"; + } + printf("build %.2f sec %.2f usr %.2f sys %.2f cpu %3d%% (%.1f elements/sec)\n", + $dt->wall, $dt->usr, $dt->sys, $dt->cpu, $dt->pct, $E / $dt->wall); + if ($Opt{size}) { + $dt = timeit(sub { $data_size = total_size($data);}); + printf("data size %d bytes (%.1fMB) %.1f sec\n", + $data_size, $data_size / MB, $dt->wall); + } + + my $encoder = Sereal::Encoder->new; + + { + print "encoding data\n"; + my @dt; + for my $i (1..$Opt{repeat_encode}) { + $dt = timeit(sub { $blob = $encoder->encode($data); }); + $blob_size = length($blob); + printf("%d/%d: encode to %d bytes (%.1fMB) %.2f sec %.2f usr %.2f sys %.2f cpu %3d%% (%.1f MB/sec)\n", + $i, $Opt{repeat_encode}, $blob_size, $blob_size / MB, $dt->wall, $dt->usr, $dt->sys, $dt->cpu, $dt->pct, + $blob_size / (MB * $dt->wall)); + push @dt, $dt; + } + if (@dt) { + my %stats = stats(@dt); + for my $k (qw(wall cpu)) { + my $avg = $stats{$k}{avg}; + printf("encode %-4s avg %.2f sec (%.1f MB/sec) stddev %.2f sec (%.2f) min %.2f med %.2f max %.2f\n", + $k, + $avg, $avg ? $blob_size / (MB * $avg) : 0, $stats{$k}{stddev}, $avg ? $stats{$k}{rstddev} : 0, + $stats{$k}{min}, $stats{$k}{med}, $stats{$k}{max}); + } + } + } + + if (defined $Opt{output}) { + print "opening output\n"; + my $fh; + sysopen($fh, $Opt{output}, O_WRONLY|O_CREAT|O_TRUNC) + or die qq[sysopen "$Opt{output}": $!\n]; + print "writing blob\n"; + $dt = timeit( + sub { + syswrite($fh, $blob) + or die qq[syswrite "$Opt{otput}": $!\n] }); + $blob_size = length($blob); + printf("wrote %d bytes (%.1f MB) %.2f sec %.2f usr %.2f sys %.2f cpu %3d%% (%.1f MB/sec)\n", + $blob_size, $blob_size / MB, $dt->wall, $dt->usr, $dt->sys, $dt->cpu, $dt->pct, + $blob_size / (MB * $dt->wall)); + } +} elsif (defined $Opt{input}) { + print "opening input\n"; + my $fh; + sysopen($fh, $Opt{input}, O_RDONLY) or die qq[sysopen "$Opt{input}": $!\n]; + print "reading blob\n"; + $dt = timeit( + sub { + sysread($fh, $blob, -s $fh) + or die qq[sysread "$Opt{input}": $!\n]; + }); + $blob_size = length($blob); + printf("read %d bytes (%.1f MB) %.2f sec %.2f usr %.2f sys %.2f cpu %3d%% (%.1f MB/sec)\n", + $blob_size, $blob_size / MB, $dt->wall, $dt->usr, $dt->sys, $dt->cpu, $dt->pct, + $blob_size / (MB * $dt->wall)); +} + +my $decoder = Sereal::Decoder->new; + +{ + print "decoding blob\n"; + $blob_size = length($blob); + my @dt; + for my $i (1..$Opt{repeat_decode}) { + $dt = timeit(sub { $data = $decoder->decode($blob); }); + printf("%d/%d: decode from %d bytes (%.1fM) %.2f sec %.2f usr %.2f sys %.2f cpu %3d%% (%.1f MB/sec)\n", + $i, $Opt{repeat_decode}, $blob_size, $blob_size / MB, + $dt->wall, $dt->usr, $dt->sys, $dt->cpu, $dt->pct, $blob_size / (MB * $dt->wall)); + push @dt, $dt; + } + if (ref $data eq 'HASH') { + printf("data is hashref of %d elements\n", scalar keys %{$data}); + } elsif (ref $data eq 'ARRAY') { + printf("data is hashref of %d elements\n", scalar @{$data}); + } elsif (ref $data) { + printf("data is ref of %s\n", ref $data); + } else { + printf("data is of unexpected type\n"); + } + if (@dt) { + my %stats = stats(@dt); + for my $k (qw(wall cpu)) { + my $avg = $stats{$k}{avg}; + printf("decode %-4s avg %.2f sec (%.1f MB/sec) stddev %.2f sec (%.2f) min %.2f med %.2f max %.2f\n", + $k, + $avg, $avg ? $blob_size / (MB * $stats{$k}{avg}) : 0, $stats{$k}{stddev}, $avg ? $stats{$k}{rstddev} : 0, + $stats{$k}{min}, $stats{$k}{med}, $stats{$k}{max}); + } + } + if ($Opt{size}) { + $dt = timeit(sub { $data_size = total_size($data); }); + printf("data size %d bytes (%.1fMB) %.1f sec\n", + $data_size, $data_size / MB, $dt->wall); + } +} + +if ($Opt{size}) { + if ($blob_size && $data_size) { + printf("data size / blob size %.2f\n", $data_size / $blob_size); + } +} + +exit(0); diff --git a/author_tools/hobodecoder.pl b/author_tools/hobodecoder.pl index f0e6f06..540ae99 100644 --- a/author_tools/hobodecoder.pl +++ b/author_tools/hobodecoder.pl @@ -6,18 +6,35 @@ use Data::Dumper; use Getopt::Long qw(GetOptions); our @constants; BEGIN { - my $err; - eval ' - use Sereal::Encoder::Constants qw(:all); - @constants= @Sereal::Encoder::Constants::EXPORT_OK; - print "Loaded constants from $INC{q(Sereal/Encoder/Constants.pm)}\n"; - 1; - ' or do { $err= $@; eval ' - use Sereal::Decoder::Constants qw(:all); - @constants= @Sereal::Decoder::Constants::EXPORT_OK; - print "Loaded constants from $INC{q(Sereal/Decoder/Constants.pm)}\n"; - 1; - ' } or die "No encoder/decoder constants: $err\n$@"; + my $add_use_blib= ""; + my $use= ""; + my @check; + for my $type ("Decoder","Encoder") { + if (-e "blib/lib/Sereal/$type/Constants.pm") { + $add_use_blib="use blib;"; + @check= ($type); + last; + } + push @check, $type; + } + + my @err; + foreach my $check (@check) { + if (eval(my $code= sprintf ' + %s + use Sereal::%s::Constants qw(:all); + @constants= @Sereal::%s::Constants::EXPORT_OK; + print "Loaded constants from $INC{q(Sereal/%s/Constants.pm)}\n"; + 1; + ', $add_use_blib, ($check) x 3)) + { + @err= (); + last; + } else { + push @err, "Error:",$@ || "Zombie Error","\nCode:\n$code"; + } + } + die @err if @err; } my $done; @@ -246,9 +263,7 @@ sub parse_av { printf "(%u)\n", $len; $ind .= " "; while ($len--) { - my $t = substr($data, 0, 1); - my $o = ord($t); - parse_sv($ind); + parse_sv($ind,\$len); } } @@ -259,8 +274,6 @@ sub parse_hv { $ind .= " "; my $flipflop = 0; while ($len--) { - my $t = substr($data, 0, 1); - my $o = ord($t); printf "$fmt2%s:\n",("") x $lead_items, $ind, ($flipflop++ %2 == 1 ? "VALUE" : "KEY"); parse_sv($ind." "); } @@ -288,12 +301,12 @@ sub varint { return $x; } -BEGIN{ -my $_shift= length(pack"j",0) * 8 - 1; -sub zigzag { - my $n= varint(); - return ($n >> 1) ^ (-($n & 1)); +sub _zigzag { + my $n= $_[0]; + return $n & 1 ? -(($n >> 1)+1) : ($n >> 1); } +sub zigzag { + return _zigzag(varint()); } GetOptions( diff --git a/author_tools/update_from_header.pl b/author_tools/update_from_header.pl index 4f009d2..0ac002a 100644 --- a/author_tools/update_from_header.pl +++ b/author_tools/update_from_header.pl @@ -4,14 +4,17 @@ use warnings; use Data::Dumper; my ( @meta, + %range, # base types. %name_to_value, # just the names in the srl_protocol.h %name_to_value_expanded, # names from srl_protocol, but with the LOW/HIGH data expanded %value_to_name_expanded, # values from srl_protocol_expanded, mapping back, note value points at FIRST name %value_to_comment_expanded # values from srl_protocol_expanded, with comments from file. ); my $max_name_length= 0; +my %define; +my %define_is_str; -sub fill_ranges { +sub fill_range { my $pfx= shift; $pfx=~s/_LOW//; defined(my $ofs= $name_to_value_expanded{$pfx}) @@ -27,12 +30,15 @@ sub fill_ranges { $meta[$value]{value}= $value; $meta[$value]{type_name}= $pfx; $meta[$value]{type_value}= $ofs; + + push @{$range{$pfx}}, $meta[$value]; #$meta[$value]{comment}= $value_to_comment_expanded{ $ofs } # if exists $value_to_comment_expanded{ $ofs }; $meta[$value]{masked_val}= $n; $meta[$value]{masked}= 1; + #$define{"SRL_HDR_".$name}= $value; } $value_to_comment_expanded{ $name_to_value_expanded{$pfx . "_HIGH"} } = $value_to_comment_expanded{ $ofs }; } @@ -42,8 +48,10 @@ sub read_protocol { my @fill; while (<$fh>) { - if(m!^#define\s+SRL_HDR_(\S+)\s+\(\(char\)(\d+)\)\s*(?:/\*\s*(.*?)\s*\*/)?\s*\z!i) { - my ($name, $value, $comment)= ($1, $2, $3); + chomp; + my $orig= $_; + if(m!^#define\s+(SRL_HDR_(\S+))\s+\(\(U8\)(\d+)\)\s*(?:/\*\s*(.*?)\s*\*/)?\s*\z!i) { + my ($full_name, $name, $value, $comment)= ($1, $2, $3, $4); $value= 0+$value; $name_to_value{$name}= $value; $name_to_value_expanded{$name}= $value; @@ -51,20 +59,36 @@ sub read_protocol { $value_to_comment_expanded{$value} ||= $comment; push @fill, $name if substr($name, -4) eq '_LOW'; - if ( $value < 128 ) { + if ( $value < 128 && !($name=~/_LOW/ or $name=~/_HIGH/)) { $meta[$value]{name}= $name; $meta[$value]{value}= $value; $meta[$value]{type_name}= $name; $meta[$value]{type_value}= $value; $meta[$value]{comment}= $comment if defined $comment; } + $define{$full_name}= $value; + } elsif (s!^#define (SRL_\w+)\s+!!) { + my $def= $1; + s!/\*.*?(?:\*/|$)!!m; + s!\(U8\)!!g; + s!(SRL_\w+)! + $define{$1} // die "Unknown define '$1'"; + !ge; + s!\A\s+!!; + s!\s+\z!!; + my $val; + my $code= "\$val= $_; 1"; + eval $code or die "Failed to eval $code (from $orig): $@"; + $define{$def}= $val; + $define_is_str{$def}= 1 if /[""]/; } } close $fh; - fill_ranges($_) for @fill; + fill_range($_) for @fill; foreach my $pfx (keys %name_to_value_expanded) { $max_name_length= length($pfx) if $max_name_length < length($pfx); } + #print Data::Dumper->new([\%define, \%define_is_str])->Useqq(1)->Sortkeys(1)->Dump(); } sub open_swap { @@ -81,41 +105,75 @@ sub open_swap { sub replace_block { my ($file,$blob)= @_; my ($in,$out)= open_swap($file); - while (<$in>) { - print $out $_; - last if /^=for autoupdater start/ || /^# start autoupdated section/; - } - $blob=~s/\s+$//mg; - print $out "\n$blob\n\n"; - while (<$in>) { - if (/^=for autoupdater stop/ || /^# stop autoupdated section/) { + my $gotit; + READ: { + + while (<$in>) { + print $out $_; + last if $gotit= (/^=for autoupdater start/ || /^# start autoupdated section/); + } + + unless ($gotit) { + warn "didnt find autoupdater start!\n"; + last READ; + } + + $blob =~ s/[ \t]+$//mg; + $blob =~ s/\s+\z//; + + print $out "\n$blob\n\n"; + + while (<$in>) { + if (/^=for autoupdater stop/ || /^# stop autoupdated section/) { + print $out $_; + $gotit= 0; + last; + } + } + + if ($gotit) { + warn "didnt find autoupdater start!\n"; + last READ; + } + + while (<$in>) { print $out $_; - last; } - } - while (<$in>) { - print $out $_; } close $out; close $in; + return; } -sub update_buildtools { - my $dump= Data::Dumper->new([\@meta],['*TAG_INFO_ARRAY'])->Indent(1)->Dump(); + +sub update_constants { + my $dump= Data::Dumper->new([\@meta],['*TAG_INFO_ARRAY'])->Sortkeys(1)->Useqq(1)->Indent(1)->Dump(); $dump =~ s/^(\s*)\{/$1# autoupdated by $0 do not modify directly!\n$1\{/mg; - return replace_block( - "Perl/shared/inc/Sereal/BuildTools.pm", - join "\n", - "our (%TAG_INFO_HASH, \@TAG_INFO_ARRAY);", - $dump, - "\$TAG_INFO_HASH{chr \$_}= \$TAG_INFO_ARRAY[\$_] for 0 .. 127;", - "push \@EXPORT_OK, qw(%TAG_INFO_HASH \@TAG_INFO_ARRAY);", - ) + my $defines= Data::Dumper->new([\%define],['*DEFINE'])->Sortkeys(1)->Useqq(1)->Indent(1)->Dump; + $defines=~s/^/ /mg; + + foreach my $mod_suffix (qw(Encoder Decoder)) { + replace_block( + "Perl/$mod_suffix/lib/Sereal/$mod_suffix/Constants.pm", + join "\n", + "BEGIN {", + $defines, + "}", + "", + "use constant \\%DEFINE;", + "push \@EXPORT_OK, keys %DEFINE;", + $dump, + "\$TAG_INFO_HASH{chr \$_}= \$TAG_INFO_ARRAY[\$_] for 0 .. 127;", + "push \@EXPORT_OK, qw(%TAG_INFO_HASH \@TAG_INFO_ARRAY);", + ) + } } -sub update_srl_decoder_h { - replace_block("Perl/Decoder/srl_decoder.h", + +sub update_srl_taginfo_h { + replace_block("Perl/shared/srl_taginfo.h", join("\n", "* NOTE this section is autoupdated by $0", "*/", + "", "static const char * const tag_name[] = {", ( map { my $str= Data::Dumper::qquote(chr($_)); @@ -124,16 +182,37 @@ sub update_srl_decoder_h { $max_name_length+3, qq("$value_to_name_expanded{$_}") . ($_==127 ? " " : ","), $str, $_, $_, $_ } 0 .. 127 ), "};", + "", + ( + map { + sprintf "#define SRL_HDR_%-*s %3d", + $max_name_length+3, $_->{name}, $_->{value} + } grep { $_->{masked} } @meta + ), + "", + ( map { + my $n = $_; + my $v = $range{$n}; + my $c = + join " \\\n ", + "#define CASE_SRL_HDR_$n", + join ": \\\n ", + map { "case SRL_HDR_$_->{name}" } @$v; + + $c."\n\n"; + } sort keys %range ), + "", "/*", "* NOTE the above section is auto-updated by $0", ) - ) + ); } + sub update_JavaSerealHeader { my $declarations = "* NOTE this section is autoupdated by $0 */\n"; - for my $name (sort { $name_to_value{$a} <=> $name_to_value{$b} } keys %name_to_value) { + for my $name (sort { $name_to_value{$a} <=> $name_to_value{$b} || $a cmp $b } keys %name_to_value) { my $byte = $name_to_value{$name}; my $decl = sprintf("static final byte SRL_HDR_%-*s = (byte) %3d;", $max_name_length, $name, $byte); $declarations .= sprintf("\t%s /* %3d 0x%02x 0b%08b %s */\n", @@ -172,8 +251,8 @@ chomp($git_dir); chdir "$git_dir/.." or die "Failed to chdir to root of repo '$git_dir/..': $!"; read_protocol(); -update_buildtools(); -update_srl_decoder_h(); +update_constants(); +update_srl_taginfo_h(); update_table("sereal_spec.pod"); update_table("Perl/shared/srl_protocol.h"); update_JavaSerealHeader(); diff --git a/const-c.inc b/const-c.inc deleted file mode 100644 index 1c8e830..0000000 --- a/const-c.inc +++ /dev/null @@ -1,1020 +0,0 @@ -#define PERL_constant_NOTFOUND 1 -#define PERL_constant_NOTDEF 2 -#define PERL_constant_ISIV 3 -#define PERL_constant_ISNO 4 -#define PERL_constant_ISNV 5 -#define PERL_constant_ISPV 6 -#define PERL_constant_ISPVN 7 -#define PERL_constant_ISSV 8 -#define PERL_constant_ISUNDEF 9 -#define PERL_constant_ISUV 10 -#define PERL_constant_ISYES 11 - -#ifndef NVTYPE -typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */ -#endif -#ifndef aTHX_ -#define aTHX_ /* 5.6 or later define this for threading support. */ -#endif -#ifndef pTHX_ -#define pTHX_ /* 5.6 or later define this for threading support. */ -#endif - -static int -constant_11 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - SRL_HDR_NEG SRL_HDR_PAD SRL_HDR_POS */ - /* Offset 9 gives the best switch position. */ - switch (name[9]) { - case 'A': - if (memEQ(name, "SRL_HDR_PAD", 11)) { - /* ^ */ -#ifdef SRL_HDR_PAD - *iv_return = SRL_HDR_PAD; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'E': - if (memEQ(name, "SRL_HDR_NEG", 11)) { - /* ^ */ -#ifdef SRL_HDR_NEG - *iv_return = SRL_HDR_NEG; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "SRL_HDR_POS", 11)) { - /* ^ */ -#ifdef SRL_HDR_POS - *iv_return = SRL_HDR_POS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_12 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - SRL_HDR_COPY SRL_HDR_HASH SRL_HDR_MANY SRL_HDR_REFN SRL_HDR_REFP - SRL_HDR_TRUE */ - /* Offset 10 gives the best switch position. */ - switch (name[10]) { - case 'F': - if (memEQ(name, "SRL_HDR_REFN", 12)) { - /* ^ */ -#ifdef SRL_HDR_REFN - *iv_return = SRL_HDR_REFN; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "SRL_HDR_REFP", 12)) { - /* ^ */ -#ifdef SRL_HDR_REFP - *iv_return = SRL_HDR_REFP; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'N': - if (memEQ(name, "SRL_HDR_MANY", 12)) { - /* ^ */ -#ifdef SRL_HDR_MANY - *iv_return = SRL_HDR_MANY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'P': - if (memEQ(name, "SRL_HDR_COPY", 12)) { - /* ^ */ -#ifdef SRL_HDR_COPY - *iv_return = SRL_HDR_COPY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'S': - if (memEQ(name, "SRL_HDR_HASH", 12)) { - /* ^ */ -#ifdef SRL_HDR_HASH - *iv_return = SRL_HDR_HASH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'U': - if (memEQ(name, "SRL_HDR_TRUE", 12)) { - /* ^ */ -#ifdef SRL_HDR_TRUE - *iv_return = SRL_HDR_TRUE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_13 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - SRL_HDR_ALIAS SRL_HDR_ARRAY SRL_HDR_FALSE SRL_HDR_FLOAT SRL_HDR_UNDEF */ - /* Offset 10 gives the best switch position. */ - switch (name[10]) { - case 'D': - if (memEQ(name, "SRL_HDR_UNDEF", 13)) { - /* ^ */ -#ifdef SRL_HDR_UNDEF - *iv_return = SRL_HDR_UNDEF; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'I': - if (memEQ(name, "SRL_HDR_ALIAS", 13)) { - /* ^ */ -#ifdef SRL_HDR_ALIAS - *iv_return = SRL_HDR_ALIAS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'L': - if (memEQ(name, "SRL_HDR_FALSE", 13)) { - /* ^ */ -#ifdef SRL_HDR_FALSE - *iv_return = SRL_HDR_FALSE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "SRL_HDR_FLOAT", 13)) { - /* ^ */ -#ifdef SRL_HDR_FLOAT - *iv_return = SRL_HDR_FLOAT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'R': - if (memEQ(name, "SRL_HDR_ARRAY", 13)) { - /* ^ */ -#ifdef SRL_HDR_ARRAY - *iv_return = SRL_HDR_ARRAY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_14 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - SRL_HDR_BINARY SRL_HDR_DOUBLE SRL_HDR_EXTEND SRL_HDR_OBJECT SRL_HDR_REGEXP - SRL_HDR_VARINT SRL_HDR_WEAKEN SRL_HDR_ZIGZAG */ - /* Offset 8 gives the best switch position. */ - switch (name[8]) { - case 'B': - if (memEQ(name, "SRL_HDR_BINARY", 14)) { - /* ^ */ -#ifdef SRL_HDR_BINARY - *iv_return = SRL_HDR_BINARY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'D': - if (memEQ(name, "SRL_HDR_DOUBLE", 14)) { - /* ^ */ -#ifdef SRL_HDR_DOUBLE - *iv_return = SRL_HDR_DOUBLE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'E': - if (memEQ(name, "SRL_HDR_EXTEND", 14)) { - /* ^ */ -#ifdef SRL_HDR_EXTEND - *iv_return = SRL_HDR_EXTEND; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "SRL_HDR_OBJECT", 14)) { - /* ^ */ -#ifdef SRL_HDR_OBJECT - *iv_return = SRL_HDR_OBJECT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'R': - if (memEQ(name, "SRL_HDR_REGEXP", 14)) { - /* ^ */ -#ifdef SRL_HDR_REGEXP - *iv_return = SRL_HDR_REGEXP; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'V': - if (memEQ(name, "SRL_HDR_VARINT", 14)) { - /* ^ */ -#ifdef SRL_HDR_VARINT - *iv_return = SRL_HDR_VARINT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'W': - if (memEQ(name, "SRL_HDR_WEAKEN", 14)) { - /* ^ */ -#ifdef SRL_HDR_WEAKEN - *iv_return = SRL_HDR_WEAKEN; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'Z': - if (memEQ(name, "SRL_HDR_ZIGZAG", 14)) { - /* ^ */ -#ifdef SRL_HDR_ZIGZAG - *iv_return = SRL_HDR_ZIGZAG; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_15 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - SRL_HDR_HASHREF SRL_HDR_NEG_LOW SRL_HDR_OBJECTV SRL_HDR_POS_LOW */ - /* Offset 8 gives the best switch position. */ - switch (name[8]) { - case 'H': - if (memEQ(name, "SRL_HDR_HASHREF", 15)) { - /* ^ */ -#ifdef SRL_HDR_HASHREF - *iv_return = SRL_HDR_HASHREF; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'N': - if (memEQ(name, "SRL_HDR_NEG_LOW", 15)) { - /* ^ */ -#ifdef SRL_HDR_NEG_LOW - *iv_return = SRL_HDR_NEG_LOW; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "SRL_HDR_OBJECTV", 15)) { - /* ^ */ -#ifdef SRL_HDR_OBJECTV - *iv_return = SRL_HDR_OBJECTV; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'P': - if (memEQ(name, "SRL_HDR_POS_LOW", 15)) { - /* ^ */ -#ifdef SRL_HDR_POS_LOW - *iv_return = SRL_HDR_POS_LOW; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_16 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - SRL_HDR_ARRAYREF SRL_HDR_NEG_HIGH SRL_HDR_POS_HIGH SRL_HDR_RESERVED - SRL_HDR_STR_UTF8 SRL_MAGIC_STRLEN SRL_NEG_MIN_SIZE SRL_POS_MAX_SIZE */ - /* Offset 8 gives the best switch position. */ - switch (name[8]) { - case 'A': - if (memEQ(name, "SRL_HDR_ARRAYREF", 16)) { - /* ^ */ -#ifdef SRL_HDR_ARRAYREF - *iv_return = SRL_HDR_ARRAYREF; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'C': - if (memEQ(name, "SRL_MAGIC_STRLEN", 16)) { - /* ^ */ -#ifdef SRL_MAGIC_STRLEN - *iv_return = SRL_MAGIC_STRLEN; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'M': - if (memEQ(name, "SRL_NEG_MIN_SIZE", 16)) { - /* ^ */ -#ifdef SRL_NEG_MIN_SIZE - *iv_return = SRL_NEG_MIN_SIZE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - if (memEQ(name, "SRL_POS_MAX_SIZE", 16)) { - /* ^ */ -#ifdef SRL_POS_MAX_SIZE - *iv_return = SRL_POS_MAX_SIZE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'N': - if (memEQ(name, "SRL_HDR_NEG_HIGH", 16)) { - /* ^ */ -#ifdef SRL_HDR_NEG_HIGH - *iv_return = SRL_HDR_NEG_HIGH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'P': - if (memEQ(name, "SRL_HDR_POS_HIGH", 16)) { - /* ^ */ -#ifdef SRL_HDR_POS_HIGH - *iv_return = SRL_HDR_POS_HIGH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'R': - if (memEQ(name, "SRL_HDR_RESERVED", 16)) { - /* ^ */ -#ifdef SRL_HDR_RESERVED - *iv_return = SRL_HDR_RESERVED; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'S': - if (memEQ(name, "SRL_HDR_STR_UTF8", 16)) { - /* ^ */ -#ifdef SRL_HDR_STR_UTF8 - *iv_return = SRL_HDR_STR_UTF8; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_20 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - SRL_HDR_ARRAYREF_LOW SRL_HDR_HASHREF_HIGH SRL_HDR_PACKET_START - SRL_HDR_RESERVED_LOW SRL_HDR_SHORT_BINARY SRL_PROTOCOL_VERSION */ - /* Offset 11 gives the best switch position. */ - switch (name[11]) { - case 'A': - if (memEQ(name, "SRL_HDR_ARRAYREF_LOW", 20)) { - /* ^ */ -#ifdef SRL_HDR_ARRAYREF_LOW - *iv_return = SRL_HDR_ARRAYREF_LOW; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'E': - if (memEQ(name, "SRL_HDR_RESERVED_LOW", 20)) { - /* ^ */ -#ifdef SRL_HDR_RESERVED_LOW - *iv_return = SRL_HDR_RESERVED_LOW; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'H': - if (memEQ(name, "SRL_HDR_HASHREF_HIGH", 20)) { - /* ^ */ -#ifdef SRL_HDR_HASHREF_HIGH - *iv_return = SRL_HDR_HASHREF_HIGH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'K': - if (memEQ(name, "SRL_HDR_PACKET_START", 20)) { - /* ^ */ -#ifdef SRL_HDR_PACKET_START - *iv_return = SRL_HDR_PACKET_START; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'L': - if (memEQ(name, "SRL_PROTOCOL_VERSION", 20)) { - /* ^ */ -#ifdef SRL_PROTOCOL_VERSION - *iv_return = SRL_PROTOCOL_VERSION; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'R': - if (memEQ(name, "SRL_HDR_SHORT_BINARY", 20)) { - /* ^ */ -#ifdef SRL_HDR_SHORT_BINARY - *iv_return = SRL_HDR_SHORT_BINARY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_21 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - SRL_HDR_ARRAYREF_HIGH SRL_HDR_OBJECT_FREEZE SRL_HDR_RESERVED_HIGH */ - /* Offset 13 gives the best switch position. */ - switch (name[13]) { - case 'R': - if (memEQ(name, "SRL_HDR_ARRAYREF_HIGH", 21)) { - /* ^ */ -#ifdef SRL_HDR_ARRAYREF_HIGH - *iv_return = SRL_HDR_ARRAYREF_HIGH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'T': - if (memEQ(name, "SRL_HDR_OBJECT_FREEZE", 21)) { - /* ^ */ -#ifdef SRL_HDR_OBJECT_FREEZE - *iv_return = SRL_HDR_OBJECT_FREEZE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'V': - if (memEQ(name, "SRL_HDR_RESERVED_HIGH", 21)) { - /* ^ */ -#ifdef SRL_HDR_RESERVED_HIGH - *iv_return = SRL_HDR_RESERVED_HIGH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_24 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - SRL_HDR_SHORT_BINARY_LOW SRL_MAGIC_STRING_UINT_BE SRL_MAGIC_STRING_UINT_LE - */ - /* Offset 22 gives the best switch position. */ - switch (name[22]) { - case 'B': - if (memEQ(name, "SRL_MAGIC_STRING_UINT_BE", 24)) { - /* ^ */ -#ifdef SRL_MAGIC_STRING_UINT_BE - *iv_return = SRL_MAGIC_STRING_UINT_BE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'L': - if (memEQ(name, "SRL_MAGIC_STRING_UINT_LE", 24)) { - /* ^ */ -#ifdef SRL_MAGIC_STRING_UINT_LE - *iv_return = SRL_MAGIC_STRING_UINT_LE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'O': - if (memEQ(name, "SRL_HDR_SHORT_BINARY_LOW", 24)) { - /* ^ */ -#ifdef SRL_HDR_SHORT_BINARY_LOW - *iv_return = SRL_HDR_SHORT_BINARY_LOW; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_25 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - SRL_HDR_SHORT_BINARY_HIGH SRL_MASK_SHORT_BINARY_LEN - SRL_PROTOCOL_ENCODING_RAW SRL_PROTOCOL_HDR_CONTINUE - SRL_PROTOCOL_VERSION_BITS SRL_PROTOCOL_VERSION_MASK */ - /* Offset 24 gives the best switch position. */ - switch (name[24]) { - case 'E': - if (memEQ(name, "SRL_PROTOCOL_HDR_CONTINU", 24)) { - /* E */ -#ifdef SRL_PROTOCOL_HDR_CONTINUE - *iv_return = SRL_PROTOCOL_HDR_CONTINUE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'H': - if (memEQ(name, "SRL_HDR_SHORT_BINARY_HIG", 24)) { - /* H */ -#ifdef SRL_HDR_SHORT_BINARY_HIGH - *iv_return = SRL_HDR_SHORT_BINARY_HIGH; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'K': - if (memEQ(name, "SRL_PROTOCOL_VERSION_MAS", 24)) { - /* K */ -#ifdef SRL_PROTOCOL_VERSION_MASK - *iv_return = SRL_PROTOCOL_VERSION_MASK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'N': - if (memEQ(name, "SRL_MASK_SHORT_BINARY_LE", 24)) { - /* N */ -#ifdef SRL_MASK_SHORT_BINARY_LEN - *iv_return = SRL_MASK_SHORT_BINARY_LEN; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'S': - if (memEQ(name, "SRL_PROTOCOL_VERSION_BIT", 24)) { - /* S */ -#ifdef SRL_PROTOCOL_VERSION_BITS - *iv_return = SRL_PROTOCOL_VERSION_BITS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'W': - if (memEQ(name, "SRL_PROTOCOL_ENCODING_RA", 24)) { - /* W */ -#ifdef SRL_PROTOCOL_ENCODING_RAW - *iv_return = SRL_PROTOCOL_ENCODING_RAW; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant_26 (pTHX_ const char *name, IV *iv_return) { - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - SRL_PROTOCOL_ENCODING_MASK SRL_PROTOCOL_ENCODING_ZLIB - SRL_PROTOCOL_HDR_USER_DATA */ - /* Offset 25 gives the best switch position. */ - switch (name[25]) { - case 'A': - if (memEQ(name, "SRL_PROTOCOL_HDR_USER_DAT", 25)) { - /* A */ -#ifdef SRL_PROTOCOL_HDR_USER_DATA - *iv_return = SRL_PROTOCOL_HDR_USER_DATA; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'B': - if (memEQ(name, "SRL_PROTOCOL_ENCODING_ZLI", 25)) { - /* B */ -#ifdef SRL_PROTOCOL_ENCODING_ZLIB - *iv_return = SRL_PROTOCOL_ENCODING_ZLIB; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'K': - if (memEQ(name, "SRL_PROTOCOL_ENCODING_MAS", 25)) { - /* K */ -#ifdef SRL_PROTOCOL_ENCODING_MASK - *iv_return = SRL_PROTOCOL_ENCODING_MASK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant (pTHX_ const char *name, STRLEN len, IV *iv_return) { - /* Initially switch on the length of the name. */ - /* When generated this function returned values for the list of names given - in this section of perl code. Rather than manually editing these functions - to add or remove constants, which would result in this comment and section - of code becoming inaccurate, we recommend that you edit this section of - code, and use it to regenerate a new set of constant functions which you - then use to replace the originals. - - Regenerate these constant functions by feeding this entire source file to - perl -x - -#!/usr/bin/perl -w -use ExtUtils::Constant qw (constant_types C_constant XS_constant); - -my $types = {map {($_, 1)} qw(IV)}; -my @names = (qw(SRL_HDR_ALIAS SRL_HDR_ARRAY SRL_HDR_ARRAYREF - SRL_HDR_ARRAYREF_HIGH SRL_HDR_ARRAYREF_LOW SRL_HDR_BINARY - SRL_HDR_CANONICAL_UNDEF SRL_HDR_COPY SRL_HDR_DOUBLE - SRL_HDR_EXTEND SRL_HDR_FALSE SRL_HDR_FLOAT SRL_HDR_HASH - SRL_HDR_HASHREF SRL_HDR_HASHREF_HIGH SRL_HDR_HASHREF_LOW - SRL_HDR_LONG_DOUBLE SRL_HDR_MANY SRL_HDR_NEG SRL_HDR_NEG_HIGH - SRL_HDR_NEG_LOW SRL_HDR_OBJECT SRL_HDR_OBJECTV - SRL_HDR_OBJECTV_FREEZE SRL_HDR_OBJECT_FREEZE - SRL_HDR_PACKET_START SRL_HDR_PAD SRL_HDR_POS SRL_HDR_POS_HIGH - SRL_HDR_POS_LOW SRL_HDR_REFN SRL_HDR_REFP SRL_HDR_REGEXP - SRL_HDR_RESERVED SRL_HDR_RESERVED_HIGH SRL_HDR_RESERVED_LOW - SRL_HDR_SHORT_BINARY SRL_HDR_SHORT_BINARY_HIGH - SRL_HDR_SHORT_BINARY_LOW SRL_HDR_STR_UTF8 SRL_HDR_TRACK_FLAG - SRL_HDR_TRUE SRL_HDR_UNDEF SRL_HDR_VARINT SRL_HDR_WEAKEN - SRL_HDR_ZIGZAG SRL_MAGIC_STRING_HIGHBIT_UINT_BE - SRL_MAGIC_STRING_HIGHBIT_UINT_LE - SRL_MAGIC_STRING_HIGHBIT_UTF8_UINT_BE - SRL_MAGIC_STRING_HIGHBIT_UTF8_UINT_LE SRL_MAGIC_STRING_UINT_BE - SRL_MAGIC_STRING_UINT_LE SRL_MAGIC_STRLEN - SRL_MASK_ARRAYREF_COUNT SRL_MASK_HASHREF_COUNT - SRL_MASK_SHORT_BINARY_LEN SRL_NEG_MIN_SIZE SRL_POS_MAX_SIZE - SRL_PROTOCOL_ENCODING_MASK SRL_PROTOCOL_ENCODING_RAW - SRL_PROTOCOL_ENCODING_SNAPPY - SRL_PROTOCOL_ENCODING_SNAPPY_INCREMENTAL - SRL_PROTOCOL_ENCODING_ZLIB SRL_PROTOCOL_HDR_CONTINUE - SRL_PROTOCOL_HDR_USER_DATA SRL_PROTOCOL_VERSION - SRL_PROTOCOL_VERSION_BITS SRL_PROTOCOL_VERSION_MASK)); - -print constant_types(), "\n"; # macro defs -foreach (C_constant ("Sereal::Encoder::Constants", 'constant', 'IV', $types, undef, 3, @names) ) { - print $_, "\n"; # C constant subs -} -print "\n#### XS Section:\n"; -print XS_constant ("Sereal::Encoder::Constants", $types); -__END__ - */ - - switch (len) { - case 11: - return constant_11 (aTHX_ name, iv_return); - break; - case 12: - return constant_12 (aTHX_ name, iv_return); - break; - case 13: - return constant_13 (aTHX_ name, iv_return); - break; - case 14: - return constant_14 (aTHX_ name, iv_return); - break; - case 15: - return constant_15 (aTHX_ name, iv_return); - break; - case 16: - return constant_16 (aTHX_ name, iv_return); - break; - case 18: - if (memEQ(name, "SRL_HDR_TRACK_FLAG", 18)) { -#ifdef SRL_HDR_TRACK_FLAG - *iv_return = SRL_HDR_TRACK_FLAG; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 19: - /* Names all of length 19. */ - /* SRL_HDR_HASHREF_LOW SRL_HDR_LONG_DOUBLE */ - /* Offset 11 gives the best switch position. */ - switch (name[11]) { - case 'G': - if (memEQ(name, "SRL_HDR_LONG_DOUBLE", 19)) { - /* ^ */ -#ifdef SRL_HDR_LONG_DOUBLE - *iv_return = SRL_HDR_LONG_DOUBLE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'H': - if (memEQ(name, "SRL_HDR_HASHREF_LOW", 19)) { - /* ^ */ -#ifdef SRL_HDR_HASHREF_LOW - *iv_return = SRL_HDR_HASHREF_LOW; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - break; - case 20: - return constant_20 (aTHX_ name, iv_return); - break; - case 21: - return constant_21 (aTHX_ name, iv_return); - break; - case 22: - /* Names all of length 22. */ - /* SRL_HDR_OBJECTV_FREEZE SRL_MASK_HASHREF_COUNT */ - /* Offset 6 gives the best switch position. */ - switch (name[6]) { - case 'R': - if (memEQ(name, "SRL_HDR_OBJECTV_FREEZE", 22)) { - /* ^ */ -#ifdef SRL_HDR_OBJECTV_FREEZE - *iv_return = SRL_HDR_OBJECTV_FREEZE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'S': - if (memEQ(name, "SRL_MASK_HASHREF_COUNT", 22)) { - /* ^ */ -#ifdef SRL_MASK_HASHREF_COUNT - *iv_return = SRL_MASK_HASHREF_COUNT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - break; - case 23: - /* Names all of length 23. */ - /* SRL_HDR_CANONICAL_UNDEF SRL_MASK_ARRAYREF_COUNT */ - /* Offset 6 gives the best switch position. */ - switch (name[6]) { - case 'R': - if (memEQ(name, "SRL_HDR_CANONICAL_UNDEF", 23)) { - /* ^ */ -#ifdef SRL_HDR_CANONICAL_UNDEF - *iv_return = SRL_HDR_CANONICAL_UNDEF; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'S': - if (memEQ(name, "SRL_MASK_ARRAYREF_COUNT", 23)) { - /* ^ */ -#ifdef SRL_MASK_ARRAYREF_COUNT - *iv_return = SRL_MASK_ARRAYREF_COUNT; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - break; - case 24: - return constant_24 (aTHX_ name, iv_return); - break; - case 25: - return constant_25 (aTHX_ name, iv_return); - break; - case 26: - return constant_26 (aTHX_ name, iv_return); - break; - case 28: - if (memEQ(name, "SRL_PROTOCOL_ENCODING_SNAPPY", 28)) { -#ifdef SRL_PROTOCOL_ENCODING_SNAPPY - *iv_return = SRL_PROTOCOL_ENCODING_SNAPPY; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 32: - /* Names all of length 32. */ - /* SRL_MAGIC_STRING_HIGHBIT_UINT_BE SRL_MAGIC_STRING_HIGHBIT_UINT_LE */ - /* Offset 30 gives the best switch position. */ - switch (name[30]) { - case 'B': - if (memEQ(name, "SRL_MAGIC_STRING_HIGHBIT_UINT_BE", 32)) { - /* ^ */ -#ifdef SRL_MAGIC_STRING_HIGHBIT_UINT_BE - *iv_return = SRL_MAGIC_STRING_HIGHBIT_UINT_BE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'L': - if (memEQ(name, "SRL_MAGIC_STRING_HIGHBIT_UINT_LE", 32)) { - /* ^ */ -#ifdef SRL_MAGIC_STRING_HIGHBIT_UINT_LE - *iv_return = SRL_MAGIC_STRING_HIGHBIT_UINT_LE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - break; - case 37: - /* Names all of length 37. */ - /* SRL_MAGIC_STRING_HIGHBIT_UTF8_UINT_BE - SRL_MAGIC_STRING_HIGHBIT_UTF8_UINT_LE */ - /* Offset 35 gives the best switch position. */ - switch (name[35]) { - case 'B': - if (memEQ(name, "SRL_MAGIC_STRING_HIGHBIT_UTF8_UINT_BE", 37)) { - /* ^ */ -#ifdef SRL_MAGIC_STRING_HIGHBIT_UTF8_UINT_BE - *iv_return = SRL_MAGIC_STRING_HIGHBIT_UTF8_UINT_BE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'L': - if (memEQ(name, "SRL_MAGIC_STRING_HIGHBIT_UTF8_UINT_LE", 37)) { - /* ^ */ -#ifdef SRL_MAGIC_STRING_HIGHBIT_UTF8_UINT_LE - *iv_return = SRL_MAGIC_STRING_HIGHBIT_UTF8_UINT_LE; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - break; - case 40: - if (memEQ(name, "SRL_PROTOCOL_ENCODING_SNAPPY_INCREMENTAL", 40)) { -#ifdef SRL_PROTOCOL_ENCODING_SNAPPY_INCREMENTAL - *iv_return = SRL_PROTOCOL_ENCODING_SNAPPY_INCREMENTAL; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - diff --git a/const-xs.inc b/const-xs.inc deleted file mode 100644 index ef80d32..0000000 --- a/const-xs.inc +++ /dev/null @@ -1,90 +0,0 @@ -void -constant(sv) - PREINIT: -#ifdef dXSTARG - dXSTARG; /* Faster if we have it. */ -#else - dTARGET; -#endif - STRLEN len; - int type; - IV iv; - /* NV nv; Uncomment this if you need to return NVs */ - /* const char *pv; Uncomment this if you need to return PVs */ - INPUT: - SV * sv; - const char * s = SvPV(sv, len); - PPCODE: - /* Change this to constant(aTHX_ s, len, &iv, &nv); - if you need to return both NVs and IVs */ - type = constant(aTHX_ s, len, &iv); - /* Return 1 or 2 items. First is error message, or undef if no error. - Second, if present, is found value */ - switch (type) { - case PERL_constant_NOTFOUND: - sv = - sv_2mortal(newSVpvf("%s is not a valid Sereal::Encoder::Constants macro", s)); - PUSHs(sv); - break; - case PERL_constant_NOTDEF: - sv = sv_2mortal(newSVpvf( - "Your vendor has not defined Sereal::Encoder::Constants macro %s, used", - s)); - PUSHs(sv); - break; - case PERL_constant_ISIV: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHi(iv); - break; - /* Uncomment this if you need to return NOs - case PERL_constant_ISNO: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHs(&PL_sv_no); - break; */ - /* Uncomment this if you need to return NVs - case PERL_constant_ISNV: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHn(nv); - break; */ - /* Uncomment this if you need to return PVs - case PERL_constant_ISPV: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHp(pv, strlen(pv)); - break; */ - /* Uncomment this if you need to return PVNs - case PERL_constant_ISPVN: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHp(pv, iv); - break; */ - /* Uncomment this if you need to return SVs - case PERL_constant_ISSV: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHs(sv); - break; */ - /* Uncomment this if you need to return UNDEFs - case PERL_constant_ISUNDEF: - break; */ - /* Uncomment this if you need to return UVs - case PERL_constant_ISUV: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHu((UV)iv); - break; */ - /* Uncomment this if you need to return YESs - case PERL_constant_ISYES: - EXTEND(SP, 1); - PUSHs(&PL_sv_undef); - PUSHs(&PL_sv_yes); - break; */ - default: - sv = sv_2mortal(newSVpvf( - "Unexpected return type %d while processing Sereal::Encoder::Constants macro %s, used", - type, s)); - PUSHs(sv); - } diff --git a/inc/Sereal/BuildTools.pm b/inc/Sereal/BuildTools.pm index f5eb15d..41a15aa 100644 --- a/inc/Sereal/BuildTools.pm +++ b/inc/Sereal/BuildTools.pm @@ -40,1228 +40,8 @@ sub link_files { } or warn $@; } -# This section deals with extracting constants from the protocol -# definition and including them as Perl constants. Not pretty, I know. -# Regenerate constants if module available. sub generate_constant_includes { - my $namespace = shift; - my $constant_namespace = $namespace . "::Constants"; - my $file = $constant_namespace; - $file =~ s/::/\//g; - $file = "lib/$file"; - my $dir = $file; - $file .= '.pm'; - - if (eval { use ExtUtils::Constant qw(WriteConstants); 1 }) { - require File::Path; - my $fragment = $dir; - $fragment =~ s/(?:En|De)coder\/?$//; - File::Path::mkpath($fragment); - print "Generating constant exports for Perl...\n"; - open my $fh, "<", "srl_protocol.h" or die $!; - my (@string_const, @int_const); - while (<$fh>) { - if (/^#\s*define\s*(SRL_\w+)\s*(.*?)(?:\/\*|$)/) { - my ($name, $value) = ($1, $2); - next if $name =~ /_H_$/ or $name =~ /SET/ or $value =~ /"/; - push @int_const, $name; - } - } - close $fh; - WriteConstants( - NAME => $constant_namespace, - NAMES => \@int_const, - ); - open my $ofh, ">", $file or die $!; - print $ofh < 'POS', - 'masked' => 1, - 'comment' => 'small positive integer - value in low 4 bits (identity)', - 'value' => 0, - 'name' => 'POS_0', - 'masked_val' => 0, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 1, - 'name' => 'POS_1', - 'masked_val' => 1, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 2, - 'name' => 'POS_2', - 'masked_val' => 2, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 3, - 'name' => 'POS_3', - 'masked_val' => 3, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 4, - 'name' => 'POS_4', - 'masked_val' => 4, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 5, - 'name' => 'POS_5', - 'masked_val' => 5, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 6, - 'name' => 'POS_6', - 'masked_val' => 6, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 7, - 'name' => 'POS_7', - 'masked_val' => 7, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 8, - 'name' => 'POS_8', - 'masked_val' => 8, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 9, - 'name' => 'POS_9', - 'masked_val' => 9, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 10, - 'name' => 'POS_10', - 'masked_val' => 10, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 11, - 'name' => 'POS_11', - 'masked_val' => 11, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 12, - 'name' => 'POS_12', - 'masked_val' => 12, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 13, - 'name' => 'POS_13', - 'masked_val' => 13, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 14, - 'name' => 'POS_14', - 'masked_val' => 14, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'POS', - 'masked' => 1, - 'comment' => 'small positive integer - value in low 4 bits (identity)', - 'value' => 15, - 'name' => 'POS_15', - 'masked_val' => 15, - 'type_value' => 0 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'comment' => 'small negative integer - value in low 4 bits (k+32)', - 'value' => 16, - 'name' => 'NEG_16', - 'masked_val' => 16, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 17, - 'name' => 'NEG_15', - 'masked_val' => 15, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 18, - 'name' => 'NEG_14', - 'masked_val' => 14, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 19, - 'name' => 'NEG_13', - 'masked_val' => 13, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 20, - 'name' => 'NEG_12', - 'masked_val' => 12, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 21, - 'name' => 'NEG_11', - 'masked_val' => 11, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 22, - 'name' => 'NEG_10', - 'masked_val' => 10, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 23, - 'name' => 'NEG_9', - 'masked_val' => 9, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 24, - 'name' => 'NEG_8', - 'masked_val' => 8, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 25, - 'name' => 'NEG_7', - 'masked_val' => 7, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 26, - 'name' => 'NEG_6', - 'masked_val' => 6, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 27, - 'name' => 'NEG_5', - 'masked_val' => 5, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 28, - 'name' => 'NEG_4', - 'masked_val' => 4, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 29, - 'name' => 'NEG_3', - 'masked_val' => 3, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 30, - 'name' => 'NEG_2', - 'masked_val' => 2, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'NEG', - 'masked' => 1, - 'comment' => 'small negative integer - value in low 4 bits (k+32)', - 'value' => 31, - 'name' => 'NEG_1', - 'masked_val' => 1, - 'type_value' => 16 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'VARINT', - 'comment' => ' - Varint variable length integer', - 'value' => 32, - 'name' => 'VARINT', - 'type_value' => 32 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ZIGZAG', - 'comment' => ' - Zigzag variable length integer', - 'value' => 33, - 'name' => 'ZIGZAG', - 'type_value' => 33 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'FLOAT', - 'comment' => '', - 'value' => 34, - 'name' => 'FLOAT', - 'type_value' => 34 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'DOUBLE', - 'comment' => '', - 'value' => 35, - 'name' => 'DOUBLE', - 'type_value' => 35 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'LONG_DOUBLE', - 'comment' => '', - 'value' => 36, - 'name' => 'LONG_DOUBLE', - 'type_value' => 36 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'UNDEF', - 'comment' => 'None - Perl undef var; eg my $var= undef;', - 'value' => 37, - 'name' => 'UNDEF', - 'type_value' => 37 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'BINARY', - 'comment' => ' - binary/(latin1) string', - 'value' => 38, - 'name' => 'BINARY', - 'type_value' => 38 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'STR_UTF8', - 'comment' => ' - utf8 string', - 'value' => 39, - 'name' => 'STR_UTF8', - 'type_value' => 39 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'REFN', - 'comment' => ' - ref to next item', - 'value' => 40, - 'name' => 'REFN', - 'type_value' => 40 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'REFP', - 'comment' => ' - ref to previous item stored at offset', - 'value' => 41, - 'name' => 'REFP', - 'type_value' => 41 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASH', - 'comment' => ' [ ...] - count followed by key/value pairs', - 'value' => 42, - 'name' => 'HASH', - 'type_value' => 42 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAY', - 'comment' => ' [ ...] - count followed by items', - 'value' => 43, - 'name' => 'ARRAY', - 'type_value' => 43 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'OBJECT', - 'comment' => ' - class, object-item', - 'value' => 44, - 'name' => 'OBJECT', - 'type_value' => 44 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'OBJECTV', - 'comment' => ' - offset of previously used classname tag - object-item', - 'value' => 45, - 'name' => 'OBJECTV', - 'type_value' => 45 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ALIAS', - 'comment' => ' - alias to item defined at offset', - 'value' => 46, - 'name' => 'ALIAS', - 'type_value' => 46 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'COPY', - 'comment' => ' - copy of item defined at offset', - 'value' => 47, - 'name' => 'COPY', - 'type_value' => 47 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'WEAKEN', - 'comment' => ' - Weaken the following reference', - 'value' => 48, - 'name' => 'WEAKEN', - 'type_value' => 48 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'REGEXP', - 'comment' => ' ', - 'value' => 49, - 'name' => 'REGEXP', - 'type_value' => 49 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'OBJECT_FREEZE', - 'comment' => ' - class, object-item. Need to call "THAW" method on class after decoding', - 'value' => 50, - 'name' => 'OBJECT_FREEZE', - 'type_value' => 50 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'OBJECTV_FREEZE', - 'comment' => ' - (OBJECTV_FREEZE is to OBJECT_FREEZE as OBJECTV is to OBJECT)', - 'value' => 51, - 'name' => 'OBJECTV_FREEZE', - 'type_value' => 51 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'RESERVED', - 'masked' => 1, - 'comment' => 'reserved', - 'value' => 52, - 'name' => 'RESERVED_0', - 'masked_val' => 0, - 'type_value' => 52 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'RESERVED', - 'masked' => 1, - 'value' => 53, - 'name' => 'RESERVED_1', - 'masked_val' => 1, - 'type_value' => 52 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'RESERVED', - 'masked' => 1, - 'value' => 54, - 'name' => 'RESERVED_2', - 'masked_val' => 2, - 'type_value' => 52 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'RESERVED', - 'masked' => 1, - 'value' => 55, - 'name' => 'RESERVED_3', - 'masked_val' => 3, - 'type_value' => 52 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'RESERVED', - 'masked' => 1, - 'value' => 56, - 'name' => 'RESERVED_4', - 'masked_val' => 4, - 'type_value' => 52 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'CANONICAL_UNDEF', - 'comment' => 'undef (PL_sv_undef) - "the" Perl undef (see notes)', - 'value' => 57, - 'name' => 'CANONICAL_UNDEF', - 'type_value' => 57 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'FALSE', - 'comment' => 'false (PL_sv_no)', - 'value' => 58, - 'name' => 'FALSE', - 'type_value' => 58 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'TRUE', - 'comment' => 'true (PL_sv_yes)', - 'value' => 59, - 'name' => 'TRUE', - 'type_value' => 59 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'MANY', - 'comment' => ' - repeated tag (not done yet, will be implemented in version 3)', - 'value' => 60, - 'name' => 'MANY', - 'type_value' => 60 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'PACKET_START', - 'comment' => '(first byte of magic string in header)', - 'value' => 61, - 'name' => 'PACKET_START', - 'type_value' => 61 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'EXTEND', - 'comment' => ' - for additional tags', - 'value' => 62, - 'name' => 'EXTEND', - 'type_value' => 62 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'PAD', - 'comment' => '(ignored tag, skip to next byte)', - 'value' => 63, - 'name' => 'PAD', - 'type_value' => 63 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'comment' => '[ ...] - count of items in low 4 bits (ARRAY must be refcnt=1)', - 'value' => 64, - 'name' => 'ARRAYREF_0', - 'masked_val' => 0, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 65, - 'name' => 'ARRAYREF_1', - 'masked_val' => 1, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 66, - 'name' => 'ARRAYREF_2', - 'masked_val' => 2, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 67, - 'name' => 'ARRAYREF_3', - 'masked_val' => 3, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 68, - 'name' => 'ARRAYREF_4', - 'masked_val' => 4, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 69, - 'name' => 'ARRAYREF_5', - 'masked_val' => 5, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 70, - 'name' => 'ARRAYREF_6', - 'masked_val' => 6, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 71, - 'name' => 'ARRAYREF_7', - 'masked_val' => 7, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 72, - 'name' => 'ARRAYREF_8', - 'masked_val' => 8, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 73, - 'name' => 'ARRAYREF_9', - 'masked_val' => 9, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 74, - 'name' => 'ARRAYREF_10', - 'masked_val' => 10, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 75, - 'name' => 'ARRAYREF_11', - 'masked_val' => 11, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 76, - 'name' => 'ARRAYREF_12', - 'masked_val' => 12, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 77, - 'name' => 'ARRAYREF_13', - 'masked_val' => 13, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 78, - 'name' => 'ARRAYREF_14', - 'masked_val' => 14, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 79, - 'name' => 'ARRAYREF_15', - 'masked_val' => 15, - 'type_value' => 64 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'comment' => '[ ...] - count in low 4 bits, key/value pairs (HASH must be refcnt=1)', - 'value' => 80, - 'name' => 'HASHREF_0', - 'masked_val' => 0, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 81, - 'name' => 'HASHREF_1', - 'masked_val' => 1, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 82, - 'name' => 'HASHREF_2', - 'masked_val' => 2, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 83, - 'name' => 'HASHREF_3', - 'masked_val' => 3, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 84, - 'name' => 'HASHREF_4', - 'masked_val' => 4, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 85, - 'name' => 'HASHREF_5', - 'masked_val' => 5, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 86, - 'name' => 'HASHREF_6', - 'masked_val' => 6, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 87, - 'name' => 'HASHREF_7', - 'masked_val' => 7, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 88, - 'name' => 'HASHREF_8', - 'masked_val' => 8, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 89, - 'name' => 'HASHREF_9', - 'masked_val' => 9, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 90, - 'name' => 'HASHREF_10', - 'masked_val' => 10, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 91, - 'name' => 'HASHREF_11', - 'masked_val' => 11, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 92, - 'name' => 'HASHREF_12', - 'masked_val' => 12, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 93, - 'name' => 'HASHREF_13', - 'masked_val' => 13, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 94, - 'name' => 'HASHREF_14', - 'masked_val' => 14, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 95, - 'name' => 'HASHREF_15', - 'masked_val' => 15, - 'type_value' => 80 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'comment' => ' - binary/latin1 string, length encoded in low 5 bits of tag', - 'value' => 96, - 'name' => 'SHORT_BINARY_0', - 'masked_val' => 0, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 97, - 'name' => 'SHORT_BINARY_1', - 'masked_val' => 1, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 98, - 'name' => 'SHORT_BINARY_2', - 'masked_val' => 2, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 99, - 'name' => 'SHORT_BINARY_3', - 'masked_val' => 3, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 100, - 'name' => 'SHORT_BINARY_4', - 'masked_val' => 4, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 101, - 'name' => 'SHORT_BINARY_5', - 'masked_val' => 5, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 102, - 'name' => 'SHORT_BINARY_6', - 'masked_val' => 6, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 103, - 'name' => 'SHORT_BINARY_7', - 'masked_val' => 7, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 104, - 'name' => 'SHORT_BINARY_8', - 'masked_val' => 8, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 105, - 'name' => 'SHORT_BINARY_9', - 'masked_val' => 9, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 106, - 'name' => 'SHORT_BINARY_10', - 'masked_val' => 10, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 107, - 'name' => 'SHORT_BINARY_11', - 'masked_val' => 11, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 108, - 'name' => 'SHORT_BINARY_12', - 'masked_val' => 12, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 109, - 'name' => 'SHORT_BINARY_13', - 'masked_val' => 13, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 110, - 'name' => 'SHORT_BINARY_14', - 'masked_val' => 14, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 111, - 'name' => 'SHORT_BINARY_15', - 'masked_val' => 15, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 112, - 'name' => 'SHORT_BINARY_16', - 'masked_val' => 16, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 113, - 'name' => 'SHORT_BINARY_17', - 'masked_val' => 17, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 114, - 'name' => 'SHORT_BINARY_18', - 'masked_val' => 18, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 115, - 'name' => 'SHORT_BINARY_19', - 'masked_val' => 19, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 116, - 'name' => 'SHORT_BINARY_20', - 'masked_val' => 20, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 117, - 'name' => 'SHORT_BINARY_21', - 'masked_val' => 21, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 118, - 'name' => 'SHORT_BINARY_22', - 'masked_val' => 22, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 119, - 'name' => 'SHORT_BINARY_23', - 'masked_val' => 23, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 120, - 'name' => 'SHORT_BINARY_24', - 'masked_val' => 24, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 121, - 'name' => 'SHORT_BINARY_25', - 'masked_val' => 25, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 122, - 'name' => 'SHORT_BINARY_26', - 'masked_val' => 26, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 123, - 'name' => 'SHORT_BINARY_27', - 'masked_val' => 27, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 124, - 'name' => 'SHORT_BINARY_28', - 'masked_val' => 28, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 125, - 'name' => 'SHORT_BINARY_29', - 'masked_val' => 29, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 126, - 'name' => 'SHORT_BINARY_30', - 'masked_val' => 30, - 'type_value' => 96 - }, - # autoupdated by author_tools/update_from_header.pl do not modify directly! - { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 127, - 'name' => 'SHORT_BINARY_31', - 'masked_val' => 31, - 'type_value' => 96 - } -); -$TAG_INFO_HASH{chr $_}= $TAG_INFO_ARRAY[$_] for 0 .. 127; -push @EXPORT_OK, qw(%TAG_INFO_HASH @TAG_INFO_ARRAY); - -# stop autoupdated section - do not modify directly! - - -our %EXPORT_TAGS=(all => \@EXPORT_OK); -HERE - close $ofh; - } - else { - warn "Please install ExtUtils::Constant since you appear to be running out of the source repository.\n"; - } + # no-op } # Prefer external csnappy and miniz libraries over the bundled ones. @@ -1300,4 +80,3 @@ sub check_external_libraries { } 1; - diff --git a/lib/Sereal/Encoder.pm b/lib/Sereal/Encoder.pm index c87655d..6d39807 100644 --- a/lib/Sereal/Encoder.pm +++ b/lib/Sereal/Encoder.pm @@ -5,7 +5,7 @@ use warnings; use Carp qw/croak/; use XSLoader; -our $VERSION = '3.003'; # Don't forget to update the TestCompat set for testing against installed decoders! +our $VERSION = '3.005_001'; # Don't forget to update the TestCompat set for testing against installed decoders! our $XS_VERSION = $VERSION; $VERSION= eval $VERSION; # not for public consumption, just for testing. @@ -257,6 +257,9 @@ less than 16 items, and and is not referenced more than once. This flag will override this optimization and use a standard REFN ARRAY style tag output. This is primarily useful for producing canoncial output and for testing Sereal itself. +See L for why you might want to use this, and +for the various caveats involved. + =head3 sort_keys Normally C will output hashes in whatever order is convenient, @@ -620,6 +623,65 @@ compact that can represent your floating point number correctly. =back +There's also a few cases where Sereal will produce different documents +for values that you might think are the same thing, because if you +e.g. compared them with C or C<==> in perl itself would think they +were equivalent. However for the purposes of serialization they're not +the same value. + +A good example of these cases is where L and Sereal's +canonical mode differ. We have tests for some of these cases in +F. Here's the issues we've noticed so +far: + +=over 4 + +=item Sereal considers ASCII strings with the UTF-8 flag to be different from the same string without the UTF-8 flag + +Consider: + + my $language_code = "en"; + +v.s.: + + my $language_code = "en"; + utf8::upgrade($en); + +Sereal's canonical mode will encode these strings differently, as it +should, since the UTF-8 flag will be passed along on interpolation. + +But this can be confusing if you're just getting some user-supplied +ASCII strings that you may inadvertently toggle the UTF-8 flag on, +e.g. because you're comparing an ASCII value in a database to a value +submitted in a UTF-8 web form. + +=item Sereal will encode strings that look like numbers as strings, unless they've been used in numeric context + +I.e. these values will be encoded differently, respectively: + + my $IV_x = "12345"; + my $IV_y = "12345" + 0; + my $NV_x = "12.345"; + my $NV_y = "12.345" + 0; + +But as noted above something like Test::Deep will consider these to be +the same thing. + +=back + +We might produce certain aggressive flags to the canonical mode in the +future to deal with this. For the cases noted above some combination +of turning the UTF-8 flag on on all strings, or stripping it from +strings that have it but are ASCII-only would "work", similarly we +could scan strings to see if they match C and if +so numify them. + +This would produce output that either would be a lot bigger (having to +encode all numbers as strings), or would be more expensive to generate +(having to scan strings for numeric or non-ASCII context), and for +some cases like the UTF-8 flag munging wouldn't be suitable for +general use outside of canonicialization. + =back Often, people don't actually care about "canonical" in the strict sense diff --git a/lib/Sereal/Encoder/Constants.pm b/lib/Sereal/Encoder/Constants.pm index 9138baa..9e891d1 100644 --- a/lib/Sereal/Encoder/Constants.pm +++ b/lib/Sereal/Encoder/Constants.pm @@ -1,1247 +1,1231 @@ -# Genereated code! Do not modify! See inc/Sereal/BuildTools.pm instead - package Sereal::Encoder::Constants; use strict; use warnings; -use Carp qw(croak); -use Sereal::Encoder; our $VERSION= $Sereal::Encoder::VERSION; # for XSLoading -our @ISA = qw(Exporter); require Exporter; -our @EXPORT_OK; -BEGIN { @EXPORT_OK = qw( - SRL_MAGIC_STRLEN - SRL_MAGIC_STRING_UINT_LE - SRL_MAGIC_STRING_UINT_BE - SRL_MAGIC_STRING_HIGHBIT_UINT_LE - SRL_MAGIC_STRING_HIGHBIT_UINT_BE - SRL_MAGIC_STRING_HIGHBIT_UTF8_UINT_LE - SRL_MAGIC_STRING_HIGHBIT_UTF8_UINT_BE - SRL_PROTOCOL_VERSION - SRL_PROTOCOL_VERSION_BITS - SRL_PROTOCOL_VERSION_MASK - SRL_PROTOCOL_ENCODING_MASK - SRL_PROTOCOL_ENCODING_RAW - SRL_PROTOCOL_ENCODING_SNAPPY - SRL_PROTOCOL_ENCODING_SNAPPY_INCREMENTAL - SRL_PROTOCOL_ENCODING_ZLIB - SRL_PROTOCOL_HDR_USER_DATA - SRL_PROTOCOL_HDR_CONTINUE - SRL_POS_MAX_SIZE - SRL_NEG_MIN_SIZE - SRL_HDR_POS - SRL_HDR_POS_LOW - SRL_HDR_POS_HIGH - SRL_HDR_NEG - SRL_HDR_NEG_LOW - SRL_HDR_NEG_HIGH - SRL_HDR_VARINT - SRL_HDR_ZIGZAG - SRL_HDR_FLOAT - SRL_HDR_DOUBLE - SRL_HDR_LONG_DOUBLE - SRL_HDR_UNDEF - SRL_HDR_BINARY - SRL_HDR_STR_UTF8 - SRL_HDR_REFN - SRL_HDR_REFP - SRL_HDR_HASH - SRL_HDR_ARRAY - SRL_HDR_OBJECT - SRL_HDR_OBJECTV - SRL_HDR_ALIAS - SRL_HDR_COPY - SRL_HDR_WEAKEN - SRL_HDR_REGEXP - SRL_HDR_OBJECT_FREEZE - SRL_HDR_OBJECTV_FREEZE - SRL_HDR_RESERVED - SRL_HDR_RESERVED_LOW - SRL_HDR_RESERVED_HIGH - SRL_HDR_CANONICAL_UNDEF - SRL_HDR_FALSE - SRL_HDR_TRUE - SRL_HDR_MANY - SRL_HDR_PACKET_START - SRL_HDR_EXTEND - SRL_HDR_PAD - SRL_HDR_ARRAYREF - SRL_MASK_ARRAYREF_COUNT - SRL_HDR_ARRAYREF_LOW - SRL_HDR_ARRAYREF_HIGH - SRL_HDR_HASHREF - SRL_MASK_HASHREF_COUNT - SRL_HDR_HASHREF_LOW - SRL_HDR_HASHREF_HIGH - SRL_HDR_SHORT_BINARY - SRL_HDR_SHORT_BINARY_LOW - SRL_HDR_SHORT_BINARY_HIGH - SRL_MASK_SHORT_BINARY_LEN - SRL_HDR_TRACK_FLAG - ); - my $code; - foreach my $constname (@EXPORT_OK) { - my ($error, $val) = constant($constname); - if ($error) { croak($error); } - $code .= "sub $constname () {$val}\n"; - } - eval "$code\n1;" or do { - my $err = $@ || 'Zombie error'; - die "Failed to generate constant subs: $err\n Code was:\n$code\n"; - }; -} +our @ISA= qw(Exporter); -sub SRL_MAGIC_STRING () { "=srl" } -sub SRL_MAGIC_STRING_HIGHBIT () { "=\xF3rl" } -sub SRL_MAGIC_STRING_HIGHBIT_UTF8 () { "=\xC3\xB3rl" } +our $VERSION = '3.005_001'; # Don't forget to update the TestCompat set for testing against installed encoders! -push @EXPORT_OK, qw( - SRL_MAGIC_STRING - SRL_MAGIC_STRING_HIGHBIT - SRL_MAGIC_STRING_HIGHBIT_UTF8 -); +our (@EXPORT_OK, %DEFINE, %TAG_INFO_HASH, @TAG_INFO_ARRAY); +our %EXPORT_TAGS= ( all => \@EXPORT_OK ); # start autoupdated section - do not modify directly -our (%TAG_INFO_HASH, @TAG_INFO_ARRAY); +BEGIN { + %DEFINE = ( + "SRL_HDR_ALIAS" => 46, + "SRL_HDR_ARRAY" => 43, + "SRL_HDR_ARRAYREF" => 64, + "SRL_HDR_ARRAYREF_HIGH" => 79, + "SRL_HDR_ARRAYREF_LOW" => 64, + "SRL_HDR_BINARY" => 38, + "SRL_HDR_CANONICAL_UNDEF" => 57, + "SRL_HDR_COPY" => 47, + "SRL_HDR_DOUBLE" => 35, + "SRL_HDR_EXTEND" => 62, + "SRL_HDR_FALSE" => 58, + "SRL_HDR_FLOAT" => 34, + "SRL_HDR_HASH" => 42, + "SRL_HDR_HASHREF" => 80, + "SRL_HDR_HASHREF_HIGH" => 95, + "SRL_HDR_HASHREF_LOW" => 80, + "SRL_HDR_LONG_DOUBLE" => 36, + "SRL_HDR_MANY" => 60, + "SRL_HDR_NEG" => 16, + "SRL_HDR_NEG_HIGH" => 31, + "SRL_HDR_NEG_LOW" => 16, + "SRL_HDR_OBJECT" => 44, + "SRL_HDR_OBJECTV" => 45, + "SRL_HDR_OBJECTV_FREEZE" => 51, + "SRL_HDR_OBJECT_FREEZE" => 50, + "SRL_HDR_PACKET_START" => 61, + "SRL_HDR_PAD" => 63, + "SRL_HDR_POS" => 0, + "SRL_HDR_POS_HIGH" => 15, + "SRL_HDR_POS_LOW" => 0, + "SRL_HDR_REFN" => 40, + "SRL_HDR_REFP" => 41, + "SRL_HDR_REGEXP" => 49, + "SRL_HDR_RESERVED" => 52, + "SRL_HDR_RESERVED_HIGH" => 56, + "SRL_HDR_RESERVED_LOW" => 52, + "SRL_HDR_SHORT_BINARY" => 96, + "SRL_HDR_SHORT_BINARY_HIGH" => 127, + "SRL_HDR_SHORT_BINARY_LOW" => 96, + "SRL_HDR_STR_UTF8" => 39, + "SRL_HDR_TRACK_FLAG" => 128, + "SRL_HDR_TRUE" => 59, + "SRL_HDR_UNDEF" => 37, + "SRL_HDR_VARINT" => 32, + "SRL_HDR_WEAKEN" => 48, + "SRL_HDR_ZIGZAG" => 33, + "SRL_MAGIC_STRING" => "=srl", + "SRL_MAGIC_STRING_HIGHBIT" => "=\363rl", + "SRL_MAGIC_STRING_HIGHBIT_UINT_BE" => "1039364716", + "SRL_MAGIC_STRING_HIGHBIT_UINT_LE" => "1819472701", + "SRL_MAGIC_STRING_HIGHBIT_UTF8" => "=\303\263rl", + "SRL_MAGIC_STRING_HIGHBIT_UTF8_UINT_BE" => "1036235634", + "SRL_MAGIC_STRING_HIGHBIT_UTF8_UINT_LE" => "1924383549", + "SRL_MAGIC_STRING_UINT_BE" => "1030976108", + "SRL_MAGIC_STRING_UINT_LE" => "1819439933", + "SRL_MAGIC_STRLEN" => 4, + "SRL_MASK_ARRAYREF_COUNT" => 15, + "SRL_MASK_HASHREF_COUNT" => 15, + "SRL_MASK_SHORT_BINARY_LEN" => 31, + "SRL_NEG_MIN_SIZE" => 16, + "SRL_POS_MAX_SIZE" => 15, + "SRL_PROTOCOL_ENCODING_MASK" => 240, + "SRL_PROTOCOL_ENCODING_RAW" => 0, + "SRL_PROTOCOL_ENCODING_SNAPPY" => 16, + "SRL_PROTOCOL_ENCODING_SNAPPY_INCREMENTAL" => 32, + "SRL_PROTOCOL_ENCODING_ZLIB" => 48, + "SRL_PROTOCOL_HDR_CONTINUE" => 8, + "SRL_PROTOCOL_HDR_USER_DATA" => 1, + "SRL_PROTOCOL_VERSION" => 3, + "SRL_PROTOCOL_VERSION_BITS" => 4, + "SRL_PROTOCOL_VERSION_MASK" => 15 + ); + +} + +use constant \%DEFINE; +push @EXPORT_OK, keys %DEFINE; @TAG_INFO_ARRAY = ( # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'comment' => 'small positive integer - value in low 4 bits (identity)', - 'value' => 0, - 'name' => 'POS_0', - 'masked_val' => 0, - 'type_value' => 0 + "comment" => "small positive integer - value in low 4 bits (identity)", + "masked" => 1, + "masked_val" => 0, + "name" => "POS_0", + "type_name" => "POS", + "type_value" => 0, + "value" => 0 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 1, - 'name' => 'POS_1', - 'masked_val' => 1, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 1, + "name" => "POS_1", + "type_name" => "POS", + "type_value" => 0, + "value" => 1 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 2, - 'name' => 'POS_2', - 'masked_val' => 2, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 2, + "name" => "POS_2", + "type_name" => "POS", + "type_value" => 0, + "value" => 2 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 3, - 'name' => 'POS_3', - 'masked_val' => 3, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 3, + "name" => "POS_3", + "type_name" => "POS", + "type_value" => 0, + "value" => 3 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 4, - 'name' => 'POS_4', - 'masked_val' => 4, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 4, + "name" => "POS_4", + "type_name" => "POS", + "type_value" => 0, + "value" => 4 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 5, - 'name' => 'POS_5', - 'masked_val' => 5, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 5, + "name" => "POS_5", + "type_name" => "POS", + "type_value" => 0, + "value" => 5 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 6, - 'name' => 'POS_6', - 'masked_val' => 6, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 6, + "name" => "POS_6", + "type_name" => "POS", + "type_value" => 0, + "value" => 6 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 7, - 'name' => 'POS_7', - 'masked_val' => 7, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 7, + "name" => "POS_7", + "type_name" => "POS", + "type_value" => 0, + "value" => 7 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 8, - 'name' => 'POS_8', - 'masked_val' => 8, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 8, + "name" => "POS_8", + "type_name" => "POS", + "type_value" => 0, + "value" => 8 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 9, - 'name' => 'POS_9', - 'masked_val' => 9, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 9, + "name" => "POS_9", + "type_name" => "POS", + "type_value" => 0, + "value" => 9 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 10, - 'name' => 'POS_10', - 'masked_val' => 10, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 10, + "name" => "POS_10", + "type_name" => "POS", + "type_value" => 0, + "value" => 10 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 11, - 'name' => 'POS_11', - 'masked_val' => 11, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 11, + "name" => "POS_11", + "type_name" => "POS", + "type_value" => 0, + "value" => 11 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 12, - 'name' => 'POS_12', - 'masked_val' => 12, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 12, + "name" => "POS_12", + "type_name" => "POS", + "type_value" => 0, + "value" => 12 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 13, - 'name' => 'POS_13', - 'masked_val' => 13, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 13, + "name" => "POS_13", + "type_name" => "POS", + "type_value" => 0, + "value" => 13 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'value' => 14, - 'name' => 'POS_14', - 'masked_val' => 14, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 14, + "name" => "POS_14", + "type_name" => "POS", + "type_value" => 0, + "value" => 14 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'POS', - 'masked' => 1, - 'comment' => 'small positive integer - value in low 4 bits (identity)', - 'value' => 15, - 'name' => 'POS_15', - 'masked_val' => 15, - 'type_value' => 0 + "masked" => 1, + "masked_val" => 15, + "name" => "POS_15", + "type_name" => "POS", + "type_value" => 0, + "value" => 15 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'comment' => 'small negative integer - value in low 4 bits (k+32)', - 'value' => 16, - 'name' => 'NEG_16', - 'masked_val' => 16, - 'type_value' => 16 + "comment" => "small negative integer - value in low 4 bits (k+32)", + "masked" => 1, + "masked_val" => 16, + "name" => "NEG_16", + "type_name" => "NEG", + "type_value" => 16, + "value" => 16 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 17, - 'name' => 'NEG_15', - 'masked_val' => 15, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 15, + "name" => "NEG_15", + "type_name" => "NEG", + "type_value" => 16, + "value" => 17 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 18, - 'name' => 'NEG_14', - 'masked_val' => 14, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 14, + "name" => "NEG_14", + "type_name" => "NEG", + "type_value" => 16, + "value" => 18 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 19, - 'name' => 'NEG_13', - 'masked_val' => 13, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 13, + "name" => "NEG_13", + "type_name" => "NEG", + "type_value" => 16, + "value" => 19 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 20, - 'name' => 'NEG_12', - 'masked_val' => 12, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 12, + "name" => "NEG_12", + "type_name" => "NEG", + "type_value" => 16, + "value" => 20 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 21, - 'name' => 'NEG_11', - 'masked_val' => 11, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 11, + "name" => "NEG_11", + "type_name" => "NEG", + "type_value" => 16, + "value" => 21 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 22, - 'name' => 'NEG_10', - 'masked_val' => 10, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 10, + "name" => "NEG_10", + "type_name" => "NEG", + "type_value" => 16, + "value" => 22 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 23, - 'name' => 'NEG_9', - 'masked_val' => 9, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 9, + "name" => "NEG_9", + "type_name" => "NEG", + "type_value" => 16, + "value" => 23 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 24, - 'name' => 'NEG_8', - 'masked_val' => 8, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 8, + "name" => "NEG_8", + "type_name" => "NEG", + "type_value" => 16, + "value" => 24 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 25, - 'name' => 'NEG_7', - 'masked_val' => 7, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 7, + "name" => "NEG_7", + "type_name" => "NEG", + "type_value" => 16, + "value" => 25 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 26, - 'name' => 'NEG_6', - 'masked_val' => 6, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 6, + "name" => "NEG_6", + "type_name" => "NEG", + "type_value" => 16, + "value" => 26 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 27, - 'name' => 'NEG_5', - 'masked_val' => 5, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 5, + "name" => "NEG_5", + "type_name" => "NEG", + "type_value" => 16, + "value" => 27 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 28, - 'name' => 'NEG_4', - 'masked_val' => 4, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 4, + "name" => "NEG_4", + "type_name" => "NEG", + "type_value" => 16, + "value" => 28 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 29, - 'name' => 'NEG_3', - 'masked_val' => 3, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 3, + "name" => "NEG_3", + "type_name" => "NEG", + "type_value" => 16, + "value" => 29 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'value' => 30, - 'name' => 'NEG_2', - 'masked_val' => 2, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 2, + "name" => "NEG_2", + "type_name" => "NEG", + "type_value" => 16, + "value" => 30 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'NEG', - 'masked' => 1, - 'comment' => 'small negative integer - value in low 4 bits (k+32)', - 'value' => 31, - 'name' => 'NEG_1', - 'masked_val' => 1, - 'type_value' => 16 + "masked" => 1, + "masked_val" => 1, + "name" => "NEG_1", + "type_name" => "NEG", + "type_value" => 16, + "value" => 31 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'VARINT', - 'comment' => ' - Varint variable length integer', - 'value' => 32, - 'name' => 'VARINT', - 'type_value' => 32 + "comment" => " - Varint variable length integer", + "name" => "VARINT", + "type_name" => "VARINT", + "type_value" => 32, + "value" => 32 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ZIGZAG', - 'comment' => ' - Zigzag variable length integer', - 'value' => 33, - 'name' => 'ZIGZAG', - 'type_value' => 33 + "comment" => " - Zigzag variable length integer", + "name" => "ZIGZAG", + "type_name" => "ZIGZAG", + "type_value" => 33, + "value" => 33 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'FLOAT', - 'comment' => '', - 'value' => 34, - 'name' => 'FLOAT', - 'type_value' => 34 + "comment" => "", + "name" => "FLOAT", + "type_name" => "FLOAT", + "type_value" => 34, + "value" => 34 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'DOUBLE', - 'comment' => '', - 'value' => 35, - 'name' => 'DOUBLE', - 'type_value' => 35 + "comment" => "", + "name" => "DOUBLE", + "type_name" => "DOUBLE", + "type_value" => 35, + "value" => 35 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'LONG_DOUBLE', - 'comment' => '', - 'value' => 36, - 'name' => 'LONG_DOUBLE', - 'type_value' => 36 + "comment" => "", + "name" => "LONG_DOUBLE", + "type_name" => "LONG_DOUBLE", + "type_value" => 36, + "value" => 36 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'UNDEF', - 'comment' => 'None - Perl undef var; eg my $var= undef;', - 'value' => 37, - 'name' => 'UNDEF', - 'type_value' => 37 + "comment" => "None - Perl undef var; eg my \$var= undef;", + "name" => "UNDEF", + "type_name" => "UNDEF", + "type_value" => 37, + "value" => 37 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'BINARY', - 'comment' => ' - binary/(latin1) string', - 'value' => 38, - 'name' => 'BINARY', - 'type_value' => 38 + "comment" => " - binary/(latin1) string", + "name" => "BINARY", + "type_name" => "BINARY", + "type_value" => 38, + "value" => 38 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'STR_UTF8', - 'comment' => ' - utf8 string', - 'value' => 39, - 'name' => 'STR_UTF8', - 'type_value' => 39 + "comment" => " - utf8 string", + "name" => "STR_UTF8", + "type_name" => "STR_UTF8", + "type_value" => 39, + "value" => 39 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'REFN', - 'comment' => ' - ref to next item', - 'value' => 40, - 'name' => 'REFN', - 'type_value' => 40 + "comment" => " - ref to next item", + "name" => "REFN", + "type_name" => "REFN", + "type_value" => 40, + "value" => 40 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'REFP', - 'comment' => ' - ref to previous item stored at offset', - 'value' => 41, - 'name' => 'REFP', - 'type_value' => 41 + "comment" => " - ref to previous item stored at offset", + "name" => "REFP", + "type_name" => "REFP", + "type_value" => 41, + "value" => 41 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASH', - 'comment' => ' [ ...] - count followed by key/value pairs', - 'value' => 42, - 'name' => 'HASH', - 'type_value' => 42 + "comment" => " [ ...] - count followed by key/value pairs", + "name" => "HASH", + "type_name" => "HASH", + "type_value" => 42, + "value" => 42 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAY', - 'comment' => ' [ ...] - count followed by items', - 'value' => 43, - 'name' => 'ARRAY', - 'type_value' => 43 + "comment" => " [ ...] - count followed by items", + "name" => "ARRAY", + "type_name" => "ARRAY", + "type_value" => 43, + "value" => 43 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'OBJECT', - 'comment' => ' - class, object-item', - 'value' => 44, - 'name' => 'OBJECT', - 'type_value' => 44 + "comment" => " - class, object-item", + "name" => "OBJECT", + "type_name" => "OBJECT", + "type_value" => 44, + "value" => 44 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'OBJECTV', - 'comment' => ' - offset of previously used classname tag - object-item', - 'value' => 45, - 'name' => 'OBJECTV', - 'type_value' => 45 + "comment" => " - offset of previously used classname tag - object-item", + "name" => "OBJECTV", + "type_name" => "OBJECTV", + "type_value" => 45, + "value" => 45 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ALIAS', - 'comment' => ' - alias to item defined at offset', - 'value' => 46, - 'name' => 'ALIAS', - 'type_value' => 46 + "comment" => " - alias to item defined at offset", + "name" => "ALIAS", + "type_name" => "ALIAS", + "type_value" => 46, + "value" => 46 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'COPY', - 'comment' => ' - copy of item defined at offset', - 'value' => 47, - 'name' => 'COPY', - 'type_value' => 47 + "comment" => " - copy of item defined at offset", + "name" => "COPY", + "type_name" => "COPY", + "type_value" => 47, + "value" => 47 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'WEAKEN', - 'comment' => ' - Weaken the following reference', - 'value' => 48, - 'name' => 'WEAKEN', - 'type_value' => 48 + "comment" => " - Weaken the following reference", + "name" => "WEAKEN", + "type_name" => "WEAKEN", + "type_value" => 48, + "value" => 48 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'REGEXP', - 'comment' => ' ', - 'value' => 49, - 'name' => 'REGEXP', - 'type_value' => 49 + "comment" => " ", + "name" => "REGEXP", + "type_name" => "REGEXP", + "type_value" => 49, + "value" => 49 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'OBJECT_FREEZE', - 'comment' => ' - class, object-item. Need to call "THAW" method on class after decoding', - 'value' => 50, - 'name' => 'OBJECT_FREEZE', - 'type_value' => 50 + "comment" => " - class, object-item. Need to call \"THAW\" method on class after decoding", + "name" => "OBJECT_FREEZE", + "type_name" => "OBJECT_FREEZE", + "type_value" => 50, + "value" => 50 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'OBJECTV_FREEZE', - 'comment' => ' - (OBJECTV_FREEZE is to OBJECT_FREEZE as OBJECTV is to OBJECT)', - 'value' => 51, - 'name' => 'OBJECTV_FREEZE', - 'type_value' => 51 + "comment" => " - (OBJECTV_FREEZE is to OBJECT_FREEZE as OBJECTV is to OBJECT)", + "name" => "OBJECTV_FREEZE", + "type_name" => "OBJECTV_FREEZE", + "type_value" => 51, + "value" => 51 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'RESERVED', - 'masked' => 1, - 'comment' => 'reserved', - 'value' => 52, - 'name' => 'RESERVED_0', - 'masked_val' => 0, - 'type_value' => 52 + "comment" => "reserved", + "masked" => 1, + "masked_val" => 0, + "name" => "RESERVED_0", + "type_name" => "RESERVED", + "type_value" => 52, + "value" => 52 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'RESERVED', - 'masked' => 1, - 'value' => 53, - 'name' => 'RESERVED_1', - 'masked_val' => 1, - 'type_value' => 52 + "masked" => 1, + "masked_val" => 1, + "name" => "RESERVED_1", + "type_name" => "RESERVED", + "type_value" => 52, + "value" => 53 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'RESERVED', - 'masked' => 1, - 'value' => 54, - 'name' => 'RESERVED_2', - 'masked_val' => 2, - 'type_value' => 52 + "masked" => 1, + "masked_val" => 2, + "name" => "RESERVED_2", + "type_name" => "RESERVED", + "type_value" => 52, + "value" => 54 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'RESERVED', - 'masked' => 1, - 'value' => 55, - 'name' => 'RESERVED_3', - 'masked_val' => 3, - 'type_value' => 52 + "masked" => 1, + "masked_val" => 3, + "name" => "RESERVED_3", + "type_name" => "RESERVED", + "type_value" => 52, + "value" => 55 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'RESERVED', - 'masked' => 1, - 'value' => 56, - 'name' => 'RESERVED_4', - 'masked_val' => 4, - 'type_value' => 52 + "masked" => 1, + "masked_val" => 4, + "name" => "RESERVED_4", + "type_name" => "RESERVED", + "type_value" => 52, + "value" => 56 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'CANONICAL_UNDEF', - 'comment' => 'undef (PL_sv_undef) - "the" Perl undef (see notes)', - 'value' => 57, - 'name' => 'CANONICAL_UNDEF', - 'type_value' => 57 + "comment" => "undef (PL_sv_undef) - \"the\" Perl undef (see notes)", + "name" => "CANONICAL_UNDEF", + "type_name" => "CANONICAL_UNDEF", + "type_value" => 57, + "value" => 57 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'FALSE', - 'comment' => 'false (PL_sv_no)', - 'value' => 58, - 'name' => 'FALSE', - 'type_value' => 58 + "comment" => "false (PL_sv_no)", + "name" => "FALSE", + "type_name" => "FALSE", + "type_value" => 58, + "value" => 58 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'TRUE', - 'comment' => 'true (PL_sv_yes)', - 'value' => 59, - 'name' => 'TRUE', - 'type_value' => 59 + "comment" => "true (PL_sv_yes)", + "name" => "TRUE", + "type_name" => "TRUE", + "type_value" => 59, + "value" => 59 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'MANY', - 'comment' => ' - repeated tag (not done yet, will be implemented in version 3)', - 'value' => 60, - 'name' => 'MANY', - 'type_value' => 60 + "comment" => " - repeated tag (not done yet, will be implemented in version 3)", + "name" => "MANY", + "type_name" => "MANY", + "type_value" => 60, + "value" => 60 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'PACKET_START', - 'comment' => '(first byte of magic string in header)', - 'value' => 61, - 'name' => 'PACKET_START', - 'type_value' => 61 + "comment" => "(first byte of magic string in header)", + "name" => "PACKET_START", + "type_name" => "PACKET_START", + "type_value" => 61, + "value" => 61 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'EXTEND', - 'comment' => ' - for additional tags', - 'value' => 62, - 'name' => 'EXTEND', - 'type_value' => 62 + "comment" => " - for additional tags", + "name" => "EXTEND", + "type_name" => "EXTEND", + "type_value" => 62, + "value" => 62 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'PAD', - 'comment' => '(ignored tag, skip to next byte)', - 'value' => 63, - 'name' => 'PAD', - 'type_value' => 63 + "comment" => "(ignored tag, skip to next byte)", + "name" => "PAD", + "type_name" => "PAD", + "type_value" => 63, + "value" => 63 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'comment' => '[ ...] - count of items in low 4 bits (ARRAY must be refcnt=1)', - 'value' => 64, - 'name' => 'ARRAYREF_0', - 'masked_val' => 0, - 'type_value' => 64 + "comment" => "[ ...] - count of items in low 4 bits (ARRAY must be refcnt=1)", + "masked" => 1, + "masked_val" => 0, + "name" => "ARRAYREF_0", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 64 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 65, - 'name' => 'ARRAYREF_1', - 'masked_val' => 1, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 1, + "name" => "ARRAYREF_1", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 65 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 66, - 'name' => 'ARRAYREF_2', - 'masked_val' => 2, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 2, + "name" => "ARRAYREF_2", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 66 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 67, - 'name' => 'ARRAYREF_3', - 'masked_val' => 3, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 3, + "name" => "ARRAYREF_3", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 67 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 68, - 'name' => 'ARRAYREF_4', - 'masked_val' => 4, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 4, + "name" => "ARRAYREF_4", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 68 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 69, - 'name' => 'ARRAYREF_5', - 'masked_val' => 5, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 5, + "name" => "ARRAYREF_5", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 69 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 70, - 'name' => 'ARRAYREF_6', - 'masked_val' => 6, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 6, + "name" => "ARRAYREF_6", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 70 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 71, - 'name' => 'ARRAYREF_7', - 'masked_val' => 7, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 7, + "name" => "ARRAYREF_7", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 71 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 72, - 'name' => 'ARRAYREF_8', - 'masked_val' => 8, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 8, + "name" => "ARRAYREF_8", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 72 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 73, - 'name' => 'ARRAYREF_9', - 'masked_val' => 9, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 9, + "name" => "ARRAYREF_9", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 73 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 74, - 'name' => 'ARRAYREF_10', - 'masked_val' => 10, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 10, + "name" => "ARRAYREF_10", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 74 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 75, - 'name' => 'ARRAYREF_11', - 'masked_val' => 11, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 11, + "name" => "ARRAYREF_11", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 75 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 76, - 'name' => 'ARRAYREF_12', - 'masked_val' => 12, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 12, + "name" => "ARRAYREF_12", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 76 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 77, - 'name' => 'ARRAYREF_13', - 'masked_val' => 13, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 13, + "name" => "ARRAYREF_13", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 77 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 78, - 'name' => 'ARRAYREF_14', - 'masked_val' => 14, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 14, + "name" => "ARRAYREF_14", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 78 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'ARRAYREF', - 'masked' => 1, - 'value' => 79, - 'name' => 'ARRAYREF_15', - 'masked_val' => 15, - 'type_value' => 64 + "masked" => 1, + "masked_val" => 15, + "name" => "ARRAYREF_15", + "type_name" => "ARRAYREF", + "type_value" => 64, + "value" => 79 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'comment' => '[ ...] - count in low 4 bits, key/value pairs (HASH must be refcnt=1)', - 'value' => 80, - 'name' => 'HASHREF_0', - 'masked_val' => 0, - 'type_value' => 80 + "comment" => "[ ...] - count in low 4 bits, key/value pairs (HASH must be refcnt=1)", + "masked" => 1, + "masked_val" => 0, + "name" => "HASHREF_0", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 80 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 81, - 'name' => 'HASHREF_1', - 'masked_val' => 1, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 1, + "name" => "HASHREF_1", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 81 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 82, - 'name' => 'HASHREF_2', - 'masked_val' => 2, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 2, + "name" => "HASHREF_2", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 82 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 83, - 'name' => 'HASHREF_3', - 'masked_val' => 3, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 3, + "name" => "HASHREF_3", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 83 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 84, - 'name' => 'HASHREF_4', - 'masked_val' => 4, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 4, + "name" => "HASHREF_4", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 84 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 85, - 'name' => 'HASHREF_5', - 'masked_val' => 5, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 5, + "name" => "HASHREF_5", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 85 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 86, - 'name' => 'HASHREF_6', - 'masked_val' => 6, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 6, + "name" => "HASHREF_6", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 86 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 87, - 'name' => 'HASHREF_7', - 'masked_val' => 7, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 7, + "name" => "HASHREF_7", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 87 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 88, - 'name' => 'HASHREF_8', - 'masked_val' => 8, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 8, + "name" => "HASHREF_8", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 88 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 89, - 'name' => 'HASHREF_9', - 'masked_val' => 9, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 9, + "name" => "HASHREF_9", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 89 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 90, - 'name' => 'HASHREF_10', - 'masked_val' => 10, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 10, + "name" => "HASHREF_10", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 90 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 91, - 'name' => 'HASHREF_11', - 'masked_val' => 11, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 11, + "name" => "HASHREF_11", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 91 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 92, - 'name' => 'HASHREF_12', - 'masked_val' => 12, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 12, + "name" => "HASHREF_12", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 92 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 93, - 'name' => 'HASHREF_13', - 'masked_val' => 13, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 13, + "name" => "HASHREF_13", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 93 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 94, - 'name' => 'HASHREF_14', - 'masked_val' => 14, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 14, + "name" => "HASHREF_14", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 94 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'HASHREF', - 'masked' => 1, - 'value' => 95, - 'name' => 'HASHREF_15', - 'masked_val' => 15, - 'type_value' => 80 + "masked" => 1, + "masked_val" => 15, + "name" => "HASHREF_15", + "type_name" => "HASHREF", + "type_value" => 80, + "value" => 95 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'comment' => ' - binary/latin1 string, length encoded in low 5 bits of tag', - 'value' => 96, - 'name' => 'SHORT_BINARY_0', - 'masked_val' => 0, - 'type_value' => 96 + "comment" => " - binary/latin1 string, length encoded in low 5 bits of tag", + "masked" => 1, + "masked_val" => 0, + "name" => "SHORT_BINARY_0", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 96 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 97, - 'name' => 'SHORT_BINARY_1', - 'masked_val' => 1, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 1, + "name" => "SHORT_BINARY_1", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 97 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 98, - 'name' => 'SHORT_BINARY_2', - 'masked_val' => 2, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 2, + "name" => "SHORT_BINARY_2", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 98 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 99, - 'name' => 'SHORT_BINARY_3', - 'masked_val' => 3, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 3, + "name" => "SHORT_BINARY_3", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 99 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 100, - 'name' => 'SHORT_BINARY_4', - 'masked_val' => 4, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 4, + "name" => "SHORT_BINARY_4", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 100 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 101, - 'name' => 'SHORT_BINARY_5', - 'masked_val' => 5, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 5, + "name" => "SHORT_BINARY_5", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 101 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 102, - 'name' => 'SHORT_BINARY_6', - 'masked_val' => 6, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 6, + "name" => "SHORT_BINARY_6", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 102 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 103, - 'name' => 'SHORT_BINARY_7', - 'masked_val' => 7, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 7, + "name" => "SHORT_BINARY_7", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 103 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 104, - 'name' => 'SHORT_BINARY_8', - 'masked_val' => 8, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 8, + "name" => "SHORT_BINARY_8", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 104 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 105, - 'name' => 'SHORT_BINARY_9', - 'masked_val' => 9, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 9, + "name" => "SHORT_BINARY_9", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 105 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 106, - 'name' => 'SHORT_BINARY_10', - 'masked_val' => 10, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 10, + "name" => "SHORT_BINARY_10", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 106 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 107, - 'name' => 'SHORT_BINARY_11', - 'masked_val' => 11, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 11, + "name" => "SHORT_BINARY_11", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 107 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 108, - 'name' => 'SHORT_BINARY_12', - 'masked_val' => 12, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 12, + "name" => "SHORT_BINARY_12", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 108 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 109, - 'name' => 'SHORT_BINARY_13', - 'masked_val' => 13, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 13, + "name" => "SHORT_BINARY_13", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 109 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 110, - 'name' => 'SHORT_BINARY_14', - 'masked_val' => 14, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 14, + "name" => "SHORT_BINARY_14", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 110 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 111, - 'name' => 'SHORT_BINARY_15', - 'masked_val' => 15, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 15, + "name" => "SHORT_BINARY_15", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 111 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 112, - 'name' => 'SHORT_BINARY_16', - 'masked_val' => 16, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 16, + "name" => "SHORT_BINARY_16", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 112 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 113, - 'name' => 'SHORT_BINARY_17', - 'masked_val' => 17, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 17, + "name" => "SHORT_BINARY_17", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 113 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 114, - 'name' => 'SHORT_BINARY_18', - 'masked_val' => 18, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 18, + "name" => "SHORT_BINARY_18", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 114 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 115, - 'name' => 'SHORT_BINARY_19', - 'masked_val' => 19, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 19, + "name" => "SHORT_BINARY_19", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 115 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 116, - 'name' => 'SHORT_BINARY_20', - 'masked_val' => 20, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 20, + "name" => "SHORT_BINARY_20", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 116 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 117, - 'name' => 'SHORT_BINARY_21', - 'masked_val' => 21, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 21, + "name" => "SHORT_BINARY_21", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 117 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 118, - 'name' => 'SHORT_BINARY_22', - 'masked_val' => 22, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 22, + "name" => "SHORT_BINARY_22", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 118 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 119, - 'name' => 'SHORT_BINARY_23', - 'masked_val' => 23, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 23, + "name" => "SHORT_BINARY_23", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 119 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 120, - 'name' => 'SHORT_BINARY_24', - 'masked_val' => 24, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 24, + "name" => "SHORT_BINARY_24", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 120 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 121, - 'name' => 'SHORT_BINARY_25', - 'masked_val' => 25, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 25, + "name" => "SHORT_BINARY_25", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 121 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 122, - 'name' => 'SHORT_BINARY_26', - 'masked_val' => 26, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 26, + "name" => "SHORT_BINARY_26", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 122 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 123, - 'name' => 'SHORT_BINARY_27', - 'masked_val' => 27, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 27, + "name" => "SHORT_BINARY_27", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 123 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 124, - 'name' => 'SHORT_BINARY_28', - 'masked_val' => 28, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 28, + "name" => "SHORT_BINARY_28", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 124 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 125, - 'name' => 'SHORT_BINARY_29', - 'masked_val' => 29, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 29, + "name" => "SHORT_BINARY_29", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 125 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 126, - 'name' => 'SHORT_BINARY_30', - 'masked_val' => 30, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 30, + "name" => "SHORT_BINARY_30", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 126 }, # autoupdated by author_tools/update_from_header.pl do not modify directly! { - 'type_name' => 'SHORT_BINARY', - 'masked' => 1, - 'value' => 127, - 'name' => 'SHORT_BINARY_31', - 'masked_val' => 31, - 'type_value' => 96 + "masked" => 1, + "masked_val" => 31, + "name" => "SHORT_BINARY_31", + "type_name" => "SHORT_BINARY", + "type_value" => 96, + "value" => 127 } ); + $TAG_INFO_HASH{chr $_}= $TAG_INFO_ARRAY[$_] for 0 .. 127; push @EXPORT_OK, qw(%TAG_INFO_HASH @TAG_INFO_ARRAY); # stop autoupdated section - do not modify directly! - - -our %EXPORT_TAGS=(all => \@EXPORT_OK); +1; diff --git a/ptable.h b/ptable.h index 5536b33..14525a4 100644 --- a/ptable.h +++ b/ptable.h @@ -70,31 +70,26 @@ struct PTABLE_iter { struct PTABLE_entry *cur_entry; }; - -STATIC PTABLE_t * PTABLE_new(void); -STATIC PTABLE_t * PTABLE_new_size(const U8 size_base2_exponent); -STATIC PTABLE_ENTRY_t * PTABLE_find(PTABLE_t *tbl, const void *key); -STATIC void * PTABLE_fetch(PTABLE_t *tbl, const void *key); -STATIC void PTABLE_store(PTABLE_t *tbl, void *key, void *value); -STATIC void PTABLE_delete(PTABLE_t *tbl, void *key); -STATIC void PTABLE_grow(PTABLE_t *tbl); -STATIC void PTABLE_clear(PTABLE_t *tbl); -STATIC void PTABLE_clear_dec(pTHX_ PTABLE_t *tbl); -STATIC void PTABLE_free(PTABLE_t *tbl); - -STATIC PTABLE_ITER_t * PTABLE_iter_new(PTABLE_t *tbl); -STATIC PTABLE_ITER_t * PTABLE_iter_new_flags(PTABLE_t *tbl, int flags); -STATIC PTABLE_ENTRY_t * PTABLE_iter_next(PTABLE_ITER_t *iter); -STATIC void PTABLE_iter_free(PTABLE_ITER_t *iter); +/* +SRL_STATIC_INLINE PTABLE_t * PTABLE_new(void); +SRL_STATIC_INLINE PTABLE_t * PTABLE_new_size(const U8 size_base2_exponent); +SRL_STATIC_INLINE PTABLE_ENTRY_t * PTABLE_find(PTABLE_t *tbl, const void *key); +SRL_STATIC_INLINE void * PTABLE_fetch(PTABLE_t *tbl, const void *key); +SRL_STATIC_INLINE PTABLE_ENTRY_t * PTABLE_store(PTABLE_t *tbl, void *key, void *value); +SRL_STATIC_INLINE void PTABLE_delete(PTABLE_t *tbl, void *key); +SRL_STATIC_INLINE void PTABLE_grow(PTABLE_t *tbl); +SRL_STATIC_INLINE void PTABLE_clear(PTABLE_t *tbl); +SRL_STATIC_INLINE void PTABLE_clear_dec(pTHX_ PTABLE_t *tbl); +SRL_STATIC_INLINE void PTABLE_free(PTABLE_t *tbl); + +SRL_STATIC_INLINE PTABLE_ITER_t * PTABLE_iter_new(PTABLE_t *tbl); +SRL_STATIC_INLINE PTABLE_ITER_t * PTABLE_iter_new_flags(PTABLE_t *tbl, int flags); +SRL_STATIC_INLINE PTABLE_ENTRY_t * PTABLE_iter_next(PTABLE_ITER_t *iter); +SRL_STATIC_INLINE void PTABLE_iter_free(PTABLE_ITER_t *iter); +*/ /* create a new pointer => pointer table */ SRL_STATIC_INLINE PTABLE_t * -PTABLE_new(void) -{ - return PTABLE_new_size(9); -} - -STATIC PTABLE_t * PTABLE_new_size(const U8 size_base2_exponent) { PTABLE_t *tbl; @@ -106,8 +101,14 @@ PTABLE_new_size(const U8 size_base2_exponent) return tbl; } +SRL_STATIC_INLINE PTABLE_t * +PTABLE_new(void) +{ + return PTABLE_new_size(9); +} + /* map an existing pointer using a table */ -STATIC PTABLE_ENTRY_t * +SRL_STATIC_INLINE PTABLE_ENTRY_t * PTABLE_find(PTABLE_t *tbl, const void *key) { PTABLE_ENTRY_t *tblent; const UV hash = PTABLE_HASH(key); @@ -126,33 +127,9 @@ PTABLE_fetch(PTABLE_t *tbl, const void *key) return tblent ? tblent->value : NULL; } -/* add a new entry to a pointer => pointer table */ - -STATIC void -PTABLE_store(PTABLE_t *tbl, void *key, void *value) -{ - PTABLE_ENTRY_t *tblent = PTABLE_find(tbl, key); - - if (tblent) { - tblent->value = value; - } else { - const UV entry = PTABLE_HASH(key) & tbl->tbl_max; - Newx(tblent, 1, PTABLE_ENTRY_t); - - tblent->key = key; - tblent->value = value; - tblent->next = tbl->tbl_ary[entry]; - tbl->tbl_ary[entry] = tblent; - tbl->tbl_items++; - if (tblent->next && (tbl->tbl_items > tbl->tbl_max)) - PTABLE_grow(tbl); - } - -} - /* double the hash bucket size of an existing ptr table */ -STATIC void +SRL_STATIC_INLINE void PTABLE_grow(PTABLE_t *tbl) { PTABLE_ENTRY_t **ary = tbl->tbl_ary; @@ -183,9 +160,35 @@ PTABLE_grow(PTABLE_t *tbl) } } +/* add a new entry to a pointer => pointer table */ + +SRL_STATIC_INLINE PTABLE_ENTRY_t * +PTABLE_store(PTABLE_t *tbl, void *key, void *value) +{ + PTABLE_ENTRY_t *tblent = PTABLE_find(tbl, key); + + if (tblent) { + tblent->value = value; + } else { + const UV entry = PTABLE_HASH(key) & tbl->tbl_max; + Newx(tblent, 1, PTABLE_ENTRY_t); + + tblent->key = key; + tblent->value = value; + tblent->next = tbl->tbl_ary[entry]; + tbl->tbl_ary[entry] = tblent; + tbl->tbl_items++; + if (tblent->next && (tbl->tbl_items > tbl->tbl_max)) + PTABLE_grow(tbl); + } + + return tblent; +} + + /* remove all the entries from a ptr table */ -STATIC void +SRL_STATIC_INLINE void PTABLE_clear(PTABLE_t *tbl) { if (tbl && tbl->tbl_items) { @@ -213,7 +216,7 @@ PTABLE_clear(PTABLE_t *tbl) } } -STATIC void +SRL_STATIC_INLINE void PTABLE_clear_dec(pTHX_ PTABLE_t *tbl) { if (tbl && tbl->tbl_items) { @@ -245,7 +248,7 @@ PTABLE_clear_dec(pTHX_ PTABLE_t *tbl) /* remove one entry from a ptr table */ -STATIC void +SRL_STATIC_INLINE void PTABLE_delete(PTABLE_t *tbl, void *key) { PTABLE_ENTRY_t *tblent; @@ -274,23 +277,6 @@ PTABLE_delete(PTABLE_t *tbl, void *key) } } -/* clear and free a ptr table */ - -STATIC void -PTABLE_free(PTABLE_t *tbl) -{ - if (!tbl) - return; - - PTABLE_clear(tbl); - if (tbl->cur_iter) { - PTABLE_ITER_t *it = tbl->cur_iter; - tbl->cur_iter = NULL; /* avoid circular checks */ - PTABLE_iter_free(it); - } - Safefree(tbl->tbl_ary); - Safefree(tbl); -} #define PTABLE_ITER_NEXT_ELEM(iter, tbl) \ @@ -310,13 +296,7 @@ PTABLE_free(PTABLE_t *tbl) } STMT_END /* Create new iterator object */ -STATIC PTABLE_ITER_t * -PTABLE_iter_new(PTABLE_t *tbl) -{ - return PTABLE_iter_new_flags(tbl, 0); -} - -STATIC PTABLE_ITER_t * +SRL_STATIC_INLINE PTABLE_ITER_t * PTABLE_iter_new_flags(PTABLE_t *tbl, int flags) { PTABLE_ITER_t *iter; @@ -338,8 +318,15 @@ PTABLE_iter_new_flags(PTABLE_t *tbl, int flags) return iter; } +SRL_STATIC_INLINE PTABLE_ITER_t * +PTABLE_iter_new(PTABLE_t *tbl) +{ + return PTABLE_iter_new_flags(tbl, 0); +} + + /* Return next item from hash, NULL if at end */ -STATIC PTABLE_ENTRY_t * +SRL_STATIC_INLINE PTABLE_ENTRY_t * PTABLE_iter_next(PTABLE_ITER_t *iter) { PTABLE_ENTRY_t *retval = iter->cur_entry; @@ -349,7 +336,7 @@ PTABLE_iter_next(PTABLE_ITER_t *iter) } /* Free iterator object */ -STATIC void +SRL_STATIC_INLINE void PTABLE_iter_free(PTABLE_ITER_t *iter) { /* If we're the iterator that can be auto-cleaned by the PTABLE, @@ -360,7 +347,7 @@ PTABLE_iter_free(PTABLE_ITER_t *iter) Safefree(iter); } -STATIC void +SRL_STATIC_INLINE void PTABLE_debug_dump(PTABLE_t *tbl, void (*func)(PTABLE_ENTRY_t *e)) { PTABLE_ENTRY_t *e; @@ -371,4 +358,22 @@ PTABLE_debug_dump(PTABLE_t *tbl, void (*func)(PTABLE_ENTRY_t *e)) PTABLE_iter_free(iter); } +/* clear and free a ptr table */ + +SRL_STATIC_INLINE void +PTABLE_free(PTABLE_t *tbl) +{ + if (!tbl) + return; + + PTABLE_clear(tbl); + if (tbl->cur_iter) { + PTABLE_ITER_t *it = tbl->cur_iter; + tbl->cur_iter = NULL; /* avoid circular checks */ + PTABLE_iter_free(it); + } + Safefree(tbl->tbl_ary); + Safefree(tbl); +} + #endif diff --git a/srl_buffer.h b/srl_buffer.h index 39622f0..f310013 100644 --- a/srl_buffer.h +++ b/srl_buffer.h @@ -5,8 +5,6 @@ #include "srl_inline.h" #include "srl_common.h" -#include "srl_encoder.h" - #include "srl_buffer_types.h" #ifdef MEMDEBUG @@ -20,62 +18,62 @@ * For now, potentially smaller code wins. */ /* buffer operations */ -#define BUF_POS_OFS(buf) (((buf).pos) - ((buf).start)) -#define BUF_SPACE(buf) (((buf).end) - ((buf).pos)) -#define BUF_SIZE(buf) (((buf).end) - ((buf).start)) +#define BUF_POS_OFS(buf) (((buf)->pos) - ((buf)->start)) +#define BUF_SPACE(buf) (((buf)->end) - ((buf)->pos)) +#define BUF_SIZE(buf) (((buf)->end) - ((buf)->start)) #define BUF_NEED_GROW(buf, minlen) ((size_t)BUF_SPACE(buf) <= minlen) #define BUF_NEED_GROW_TOTAL(buf, minlen) ((size_t)BUF_SIZE(buf) <= minlen) - +#define BUF_NOT_DONE(buf) ((buf)->pos < (buf)->end) +#define BUF_DONE(buf) ((buf)->pos >= (buf)->end) /* body-position/size related operations */ -#define BODY_POS_OFS(buf) (((buf).pos) - ((buf).body_pos)) +#define BODY_POS_OFS(buf) (((buf)->pos) - ((buf)->body_pos)) /* these are mostly for right between (de)serializing the header and the body */ -#define SRL_SET_BODY_POS(enc, pos_ptr) ((enc)->buf.body_pos = pos_ptr) -#define SRL_UPDATE_BODY_POS(enc) \ +#define SRL_SET_BODY_POS(buf, pos_ptr) ((buf)->body_pos = pos_ptr) +#define SRL_UPDATE_BODY_POS(buf, protocol_version) \ STMT_START { \ - if (expect_false((enc)->protocol_version == 1)) { \ - SRL_SET_BODY_POS(enc, (enc)->buf.start); \ + if (expect_false((protocol_version) == 1)) { \ + SRL_SET_BODY_POS((buf), (buf)->start); \ } else { \ - SRL_SET_BODY_POS(enc, (enc)->buf.pos-1); \ + SRL_SET_BODY_POS((buf), (buf)->pos-1); \ } \ } STMT_END - /* Internal debugging macros, used only in DEBUG mode */ #ifndef NDEBUG -#define DEBUG_ASSERT_BUF_SPACE(enc, len) STMT_START { \ - if((BUF_SPACE(enc->buf) < (ptrdiff_t)(len))) { \ +#define DEBUG_ASSERT_BUF_SPACE(buf, len) STMT_START { \ + if((BUF_SPACE(buf) < (ptrdiff_t)(len))) { \ warn("failed assertion check - pos: %ld [%p %p %p] %ld < %ld", \ - (long)BUF_POS_OFS(enc->buf), (enc)->buf.start, \ - (enc)->buf.pos, (enc)->buf.end, \ - (long)BUF_SPACE(enc->buf),(long)(len)); \ + (long)BUF_POS_OFS(buf), (buf)->start, \ + (buf)->pos, (buf)->end, \ + (long)BUF_SPACE(buf),(long)(len)); \ } \ - assert(BUF_SPACE(enc->buf) >= (ptrdiff_t)(len)); \ + assert(BUF_SPACE(buf) >= (ptrdiff_t)(len)); \ } STMT_END #else -#define DEBUG_ASSERT_BUF_SPACE(enc, len) ((void)0) +#define DEBUG_ASSERT_BUF_SPACE(buf, len) ((void)0) #endif #ifndef NDEBUG -#define DEBUG_ASSERT_BUF_SANE(enc) STMT_START { \ - if(!(((enc)->buf.start <= (enc)->buf.pos) && ((enc)->buf.pos <= (enc)->buf.end))){ \ - warn("failed sanity assertion check - pos: %ld [%p %p %p] %ld", \ - (long)BUF_POS_OFS(enc->buf), (enc)->buf.start, \ - (enc)->buf.pos, (enc)->buf.end, (long)BUF_SPACE(enc->buf)); \ - } \ - assert(((enc)->buf.start <= (enc)->buf.pos) && ((enc)->buf.pos <= (enc)->buf.end)); \ +#define DEBUG_ASSERT_BUF_SANE(buf) STMT_START { \ + if(!(((buf)->start <= (buf)->pos) && ((buf)->pos <= (buf)->end))){ \ + warn("failed sanity assertion check - pos: %ld [%p %p %p] %ld", \ + (long)BUF_POS_OFS(buf), (buf)->start, \ + (buf)->pos, (buf)->end, (long)BUF_SPACE(buf)); \ + } \ + assert(((buf)->start <= (buf)->pos) && ((buf)->pos <= (buf)->end)); \ } STMT_END #else -#define DEBUG_ASSERT_BUF_SANE(enc) \ - assert(((enc)->buf.start <= (enc)->buf.pos) && ((enc)->buf.pos <= (enc)->buf.end)) +#define DEBUG_ASSERT_BUF_SANE(buf) \ + assert(((buf)->start <= (buf)->pos) && ((buf)->pos <= (buf)->end)) #endif /* Allocate a virgin buffer (but not the buffer struct) */ SRL_STATIC_INLINE int srl_buf_init_buffer(pTHX_ srl_buffer_t *buf, const STRLEN init_size) { - Newx(buf->start, init_size, char); + Newx(buf->start, init_size, srl_buffer_char); if (expect_false( buf->start == NULL )) return 1; buf->end = buf->start + init_size - 1; @@ -108,147 +106,179 @@ srl_buf_swap_buffer(pTHX_ srl_buffer_t *buf1, srl_buffer_t *buf2) Copy(&tmp, buf2, 1, srl_buffer_t); } - SRL_STATIC_INLINE void -srl_buf_grow_nocheck(pTHX_ srl_encoder_t *enc, size_t minlen) +srl_buf_grow_nocheck(pTHX_ srl_buffer_t *buf, size_t minlen) { - const size_t pos_ofs= BUF_POS_OFS(enc->buf); /* have to store the offset of pos */ - const size_t body_ofs= enc->buf.body_pos - enc->buf.start; /* have to store the offset of the body */ + const size_t pos_ofs= BUF_POS_OFS(buf); /* have to store the offset of pos */ + const size_t body_ofs= buf->body_pos - buf->start; /* have to store the offset of the body */ #ifdef MEMDEBUG const size_t new_size = minlen; #else - const size_t cur_size = BUF_SIZE(enc->buf); + const size_t cur_size = BUF_SIZE(buf); const size_t grown_len = (size_t)(cur_size * BUFFER_GROWTH_FACTOR); const size_t new_size = 100 + (minlen > grown_len ? minlen : grown_len); #endif - DEBUG_ASSERT_BUF_SANE(enc); + DEBUG_ASSERT_BUF_SANE(buf); /* assert that Renew means GROWING the buffer */ - assert(enc->buf.start + new_size > enc->buf.end); + assert(buf->start + new_size > buf->end); - Renew(enc->buf.start, new_size, char); - if (enc->buf.start == NULL) + Renew(buf->start, new_size, srl_buffer_char); + if (buf->start == NULL) croak("Out of memory!"); - enc->buf.end = (char *)(enc->buf.start + new_size); - enc->buf.pos= enc->buf.start + pos_ofs; - SRL_SET_BODY_POS(enc, enc->buf.start + body_ofs); - DEBUG_ASSERT_BUF_SANE(enc); - assert(enc->buf.end - enc->buf.start > (ptrdiff_t)0); - assert(enc->buf.pos - enc->buf.start >= (ptrdiff_t)0); + buf->end = (srl_buffer_char*) (buf->start + new_size); + buf->pos = buf->start + pos_ofs; + SRL_SET_BODY_POS(buf, buf->start + body_ofs); + + DEBUG_ASSERT_BUF_SANE(buf); + assert(buf->end - buf->start > (ptrdiff_t)0); + assert(buf->pos - buf->start >= (ptrdiff_t)0); /* The following is checking against -1 because SRL_UPDATE_BODY_POS * will actually set the body_pos to pos-1, where pos can be 0. * This works out fine in the end, but is admittedly a bit shady. * FIXME */ - assert(enc->buf.body_pos - enc->buf.start >= (ptrdiff_t)-1); + assert(buf->body_pos - buf->start >= (ptrdiff_t)-1); } -#define BUF_SIZE_ASSERT(enc, minlen) \ +#define BUF_SIZE_ASSERT(buf, minlen) \ STMT_START { \ - DEBUG_ASSERT_BUF_SANE(enc); \ - if (BUF_NEED_GROW(enc->buf, minlen)) \ - srl_buf_grow_nocheck(aTHX_ (enc), (BUF_SIZE(enc->buf) + minlen)); \ - DEBUG_ASSERT_BUF_SANE(enc); \ + DEBUG_ASSERT_BUF_SANE(buf); \ + if (BUF_NEED_GROW(buf, minlen)) \ + srl_buf_grow_nocheck(aTHX_ (buf), (BUF_SIZE(buf) + minlen)); \ + DEBUG_ASSERT_BUF_SANE(buf); \ } STMT_END -#define BUF_SIZE_ASSERT_TOTAL(enc, minlen) \ +#define BUF_SIZE_ASSERT_TOTAL(buf, minlen) \ STMT_START { \ - DEBUG_ASSERT_BUF_SANE(enc); \ - if (BUF_NEED_GROW_TOTAL(enc->buf, minlen)) \ - srl_buf_grow_nocheck(aTHX_ (enc), (minlen)); \ - DEBUG_ASSERT_BUF_SANE(enc); \ + DEBUG_ASSERT_BUF_SANE(buf); \ + if (BUF_NEED_GROW_TOTAL(buf, minlen)) \ + srl_buf_grow_nocheck(aTHX_ (buf), (minlen)); \ + DEBUG_ASSERT_BUF_SANE(buf); \ } STMT_END SRL_STATIC_INLINE void -srl_buf_cat_str_int(pTHX_ srl_encoder_t *enc, const char *str, size_t len) +srl_buf_cat_str_int(pTHX_ srl_buffer_t *buf, const char *str, size_t len) { - BUF_SIZE_ASSERT(enc, len); - Copy(str, enc->buf.pos, len, char); - enc->buf.pos += len; - DEBUG_ASSERT_BUF_SANE(enc); + BUF_SIZE_ASSERT(buf, len); + Copy(str, buf->pos, len, char); + buf->pos += len; + DEBUG_ASSERT_BUF_SANE(buf); } -#define srl_buf_cat_str(enc, str, len) srl_buf_cat_str_int(aTHX_ enc, str, len) +#define srl_buf_cat_str(buf, str, len) srl_buf_cat_str_int(aTHX_ buf, str, len) /* see perl.git:handy.h STR_WITH_LEN macro for explanation of the below code */ -#define srl_buf_cat_str_s(enc, str) srl_buf_cat_str(enc, ("" str ""), sizeof(str)-1) +#define srl_buf_cat_str_s(buf, str) srl_buf_cat_str(buf, ("" str ""), sizeof(str)-1) SRL_STATIC_INLINE void -srl_buf_cat_str_nocheck_int(pTHX_ srl_encoder_t *enc, const char *str, size_t len) +srl_buf_cat_str_nocheck_int(pTHX_ srl_buffer_t *buf, const char *str, size_t len) { - DEBUG_ASSERT_BUF_SANE(enc); - DEBUG_ASSERT_BUF_SPACE(enc, len); - Copy(str, enc->buf.pos, len, char); - enc->buf.pos += len; - DEBUG_ASSERT_BUF_SANE(enc); + DEBUG_ASSERT_BUF_SANE(buf); + DEBUG_ASSERT_BUF_SPACE(buf, len); + Copy(str, buf->pos, len, char); + buf->pos += len; + DEBUG_ASSERT_BUF_SANE(buf); } -#define srl_buf_cat_str_nocheck(enc, str, len) srl_buf_cat_str_nocheck_int(aTHX_ enc, str, len) +#define srl_buf_cat_str_nocheck(buf, str, len) srl_buf_cat_str_nocheck_int(aTHX_ buf, str, len) /* see perl.git:handy.h STR_WITH_LEN macro for explanation of the below code */ -#define srl_buf_cat_str_s_nocheck(enc, str) srl_buf_cat_str_nocheck(enc, ("" str ""), sizeof(str)-1) +#define srl_buf_cat_str_s_nocheck(buf, str) srl_buf_cat_str_nocheck(buf, ("" str ""), sizeof(str)-1) SRL_STATIC_INLINE void -srl_buf_cat_char_int(pTHX_ srl_encoder_t *enc, const char c) +srl_buf_cat_char_int(pTHX_ srl_buffer_t *buf, const char c) { - DEBUG_ASSERT_BUF_SANE(enc); - BUF_SIZE_ASSERT(enc, 1); - DEBUG_ASSERT_BUF_SPACE(enc, 1); - *enc->buf.pos++ = c; - DEBUG_ASSERT_BUF_SANE(enc); + DEBUG_ASSERT_BUF_SANE(buf); + BUF_SIZE_ASSERT(buf, 1); + DEBUG_ASSERT_BUF_SPACE(buf, 1); + *buf->pos++ = c; + DEBUG_ASSERT_BUF_SANE(buf); } -#define srl_buf_cat_char(enc, c) srl_buf_cat_char_int(aTHX_ enc, c) +#define srl_buf_cat_char(buf, c) srl_buf_cat_char_int(aTHX_ buf, c) SRL_STATIC_INLINE void -srl_buf_cat_char_nocheck_int(pTHX_ srl_encoder_t *enc, const char c) +srl_buf_cat_char_nocheck_int(pTHX_ srl_buffer_t *buf, const char c) { - DEBUG_ASSERT_BUF_SANE(enc); - DEBUG_ASSERT_BUF_SPACE(enc, 1); - *enc->buf.pos++ = c; - DEBUG_ASSERT_BUF_SANE(enc); + DEBUG_ASSERT_BUF_SANE(buf); + DEBUG_ASSERT_BUF_SPACE(buf, 1); + *buf->pos++ = c; + DEBUG_ASSERT_BUF_SANE(buf); } -#define srl_buf_cat_char_nocheck(enc, c) srl_buf_cat_char_nocheck_int(aTHX_ enc, c) +#define srl_buf_cat_char_nocheck(buf, c) srl_buf_cat_char_nocheck_int(aTHX_ buf, c) /* define constant for other code to use in preallocations */ #define SRL_MAX_VARINT_LENGTH 11 +/* + * This implements "varint" and "zigzag varint" types as used in protobufs, etc. + * + * varint is a variable length encoding of unsigned integers, where the low + * 7 bits of the input value are encoded into each byte of output, with the high bit + * used as a flag to indicate there is another byte worth of bits to be read. + * + * zigzag is a way of encoding signed integers as an unsigned integer in such a way + * that positive and negative numbers are interleaved, so that z0=0, z1=-1, z2=1, + * z3=-2, z4=2, etc. When the zigzag form is represented as a varint, the result is + * that both negative and positive number take space proportional to their distance + * from zero. + * + * see: https://developers.google.com/protocol-buffers/docs/encoding#types + * + */ +#define srl_varint_size(x) ( \ + z <= (1UL << 7) ? 1 : \ + z <= (1UL << 14) ? 2 : \ + z <= (1UL << 21) ? 3 : \ + z <= (1UL << 28) ? 4 : \ + z <= (1UL << 35) ? 5 : \ + z <= (1UL << 42) ? 6 : \ + z <= (1UL << 49) ? 7 : \ + z <= (1UL << 56) ? 8 : \ + z <= (1UL << 63) ? 9 : \ + 10 ) + SRL_STATIC_INLINE void -srl_buf_cat_varint_nocheck(pTHX_ srl_encoder_t *enc, const char tag, UV n) { - DEBUG_ASSERT_BUF_SANE(enc); - DEBUG_ASSERT_BUF_SPACE(enc, (tag==0 ? 0 : 1) + SRL_MAX_VARINT_LENGTH); - if (expect_true( tag )) - *enc->buf.pos++ = tag; - while (n >= 0x80) { /* while we are larger than 7 bits long */ - *enc->buf.pos++ = (n & 0x7f) | 0x80; /* write out the least significant 7 bits, set the high bit */ - n = n >> 7; /* shift off the 7 least significant bits */ +srl_buf_cat_varint_raw_nocheck(pTHX_ srl_buffer_t *buf, UV value) { + DEBUG_ASSERT_BUF_SANE(buf); + DEBUG_ASSERT_BUF_SPACE(buf, SRL_MAX_VARINT_LENGTH); + while (value >= 0x80) { /* while we are larger than 7 bits long */ + *buf->pos++ = (value & 0x7f) | 0x80; /* write out the least significant 7 bits, set the high bit */ + value >>= 7; /* shift off the 7 least significant bits */ } - *enc->buf.pos++ = n; /* encode the last 7 bits without the high bit being set */ - DEBUG_ASSERT_BUF_SANE(enc); + *buf->pos++ = (U8)value; /* encode the last 7 bits without the high bit being set */ + DEBUG_ASSERT_BUF_SANE(buf); +} + +SRL_STATIC_INLINE UV +srl_zigzag_iv(IV value) { + return (UV)((value << 1) ^ (value >> (sizeof(IV) * 8 - 1))); } SRL_STATIC_INLINE void -srl_buf_cat_varint(pTHX_ srl_encoder_t *enc, const char tag, const UV n) { - /* this implements "varint" from google protocol buffers */ - DEBUG_ASSERT_BUF_SANE(enc); - BUF_SIZE_ASSERT(enc, SRL_MAX_VARINT_LENGTH + 1); /* always allocate space for the tag, overalloc is harmless */ - srl_buf_cat_varint_nocheck(aTHX_ enc, tag, n); +srl_buf_cat_zigzag_raw_nocheck(pTHX_ srl_buffer_t *buf, const IV value) { + srl_buf_cat_varint_raw_nocheck(aTHX_ buf, srl_zigzag_iv(value)); +} + +SRL_STATIC_INLINE void +srl_buf_cat_varint_nocheck(pTHX_ srl_buffer_t *buf, const char tag, UV value) { + DEBUG_ASSERT_BUF_SPACE(buf, 1); + if (expect_true( tag )) + *buf->pos++ = tag; + srl_buf_cat_varint_raw_nocheck(aTHX_ buf, value); } SRL_STATIC_INLINE void -srl_buf_cat_zigzag_nocheck(pTHX_ srl_encoder_t *enc, const char tag, const IV n) { - const UV z= (n << 1) ^ (n >> (sizeof(IV) * 8 - 1)); - srl_buf_cat_varint_nocheck(aTHX_ enc, tag, z); +srl_buf_cat_zigzag_nocheck(pTHX_ srl_buffer_t *buf, const char tag, const IV value) { + srl_buf_cat_varint_nocheck(aTHX_ buf, tag, srl_zigzag_iv(value)); +} + +SRL_STATIC_INLINE void +srl_buf_cat_varint(pTHX_ srl_buffer_t *buf, const char tag, const UV value) { + /* this implements "varint" from google protocol buffers */ + BUF_SIZE_ASSERT(buf, SRL_MAX_VARINT_LENGTH + 1); /* always allocate space for the tag, overalloc is harmless */ + srl_buf_cat_varint_nocheck(aTHX_ buf, tag, value); } SRL_STATIC_INLINE void -srl_buf_cat_zigzag(pTHX_ srl_encoder_t *enc, const char tag, const IV n) { - /* - * This implements googles "zigzag varints" which effectively interleave negative - * and positive numbers. - * - * see: https://developers.google.com/protocol-buffers/docs/encoding#types - * - * Note: maybe for negative numbers we should just invert and then treat as a positive? - * - */ - const UV z= (n << 1) ^ (n >> (sizeof(IV) * 8 - 1)); - srl_buf_cat_varint(aTHX_ enc, tag, z); +srl_buf_cat_zigzag(pTHX_ srl_buffer_t *buf, const char tag, const IV value) { + srl_buf_cat_varint(aTHX_ buf, tag, srl_zigzag_iv(value)); } #endif diff --git a/srl_buffer_types.h b/srl_buffer_types.h index 66ad25a..8668f96 100644 --- a/srl_buffer_types.h +++ b/srl_buffer_types.h @@ -1,11 +1,12 @@ #ifndef SRL_BUFFER_TYPES_H_ #define SRL_BUFFER_TYPES_H_ +typedef unsigned char srl_buffer_char; typedef struct { - char *start; /* ptr to "physical" start of output buffer */ - char *end; /* ptr to end of output buffer */ - char *pos; /* ptr to current position within output buffer */ - char *body_pos; /* ptr to start of body within output buffer for protocol V2 encoding */ + srl_buffer_char *start; /* ptr to "physical" start of output buffer */ + srl_buffer_char *end; /* ptr to end of output buffer */ + srl_buffer_char *pos; /* ptr to current position within output buffer */ + srl_buffer_char *body_pos; /* ptr to start of body within output buffer for protocol V2 encoding */ } srl_buffer_t; #endif diff --git a/srl_common.h b/srl_common.h index dd25bc2..1a65038 100644 --- a/srl_common.h +++ b/srl_common.h @@ -53,7 +53,7 @@ * traps (silently) do not happen. * * The Linux kernel and the Solarix x86 set the "AM". The Windows and - * OX X do not. The *BSD behavior is unknown, though suspecting they do. + * OS X do not. The *BSD behavior is unknown, though suspecting they do. * * http://en.wikipedia.org/wiki/Control_register * http://en.wikipedia.org/wiki/FLAGS_register_(computing) diff --git a/srl_compress.h b/srl_compress.h new file mode 100644 index 0000000..123d472 --- /dev/null +++ b/srl_compress.h @@ -0,0 +1,217 @@ +#ifndef SRL_COMPRESS_H_ +#define SRL_COMPRESS_H_ + +#include "srl_buffer.h" +#include "srl_inline.h" +#include "srl_protocol.h" +#include "srl_buffer_types.h" + +/* WARNING: This is different from the protocol bit SRL_PROTOCOL_ENCODING_SNAPPY + * and SRL_PROTOCOL_ENCODING_ZLIB in that it's a flag indicating that + * we want to use Snappy or Zlib. + * + * DO NOT CHANGE THIS WITHOUT REVIEWING THE BITS IN srl_encoder.h and etc. + */ + +#define SRL_F_COMPRESS_SNAPPY 0x00040UL +#define SRL_F_COMPRESS_SNAPPY_INCREMENTAL 0x00080UL +#define SRL_F_COMPRESS_ZLIB 0x00100UL +#define SRL_F_COMPRESS_FLAGS_MASK (SRL_F_COMPRESS_SNAPPY | \ + SRL_F_COMPRESS_SNAPPY_INCREMENTAL | \ + SRL_F_COMPRESS_ZLIB ) +const U8 SRL_F_COMPRESS_FLAGS_TO_PROTOCOL_ENCODING[8]= { + SRL_PROTOCOL_ENCODING_RAW, /* 0 */ + SRL_PROTOCOL_ENCODING_SNAPPY, /* 1 */ + SRL_PROTOCOL_ENCODING_SNAPPY_INCREMENTAL, /* 2 */ + SRL_PROTOCOL_ENCODING_SNAPPY_INCREMENTAL, /* 3 */ + SRL_PROTOCOL_ENCODING_ZLIB, /* 4 */ + SRL_PROTOCOL_ENCODING_ZLIB, /* 5 */ + SRL_PROTOCOL_ENCODING_ZLIB, /* 6 */ + SRL_PROTOCOL_ENCODING_ZLIB /* 7 */ + }; +/* currently SRL_F_COMPRESS_MASK is 0x001c0UL, which shift right 6 bits turns into 0x07 UL + * which means we can skips some conditionals. */ +#define SRL_F_COMPRESS_FLAGS_SHIFT 6 + +#if defined(HAVE_CSNAPPY) +#include +#else +#include "snappy/csnappy_compress.c" +#endif + +#if defined(HAVE_MINIZ) +#include +#else +#include "miniz.h" +#endif + +/* Update a varint anywhere in the output stream with defined start and end + * positions. This can produce non-canonical varints and is useful for filling + * pre-allocated varints. */ +SRL_STATIC_INLINE void +srl_update_varint_from_to(pTHX_ unsigned char *varint_start, unsigned char *varint_end, UV number) +{ + while (number >= 0x80) { /* while we are larger than 7 bits long */ + *varint_start++ = (number & 0x7f) | 0x80; /* write out the least significant 7 bits, set the high bit */ + number = number >> 7; /* shift off the 7 least significant bits */ + } + + /* if it is the same size we can use a canonical varint */ + if ( varint_start == varint_end ) { + *varint_start = number; /* encode the last 7 bits without the high bit being set */ + } else { + /* if not we produce a non-canonical varint, basically we stuff + * 0 bits (via 0x80) into the "tail" of the varint, until we can + * stick in a null to terminate the sequence. This means that the + * varint is effectively "self-padding", and we only need special + * logic in the encoder - a decoder will happily process a non-canonical + * varint with no problem */ + *varint_start++ = (number & 0x7f) | 0x80; + while ( varint_start < varint_end ) + *varint_start++ = 0x80; + *varint_start= 0; + } +} + +/* Lazy working buffer alloc */ +SRL_STATIC_INLINE void +srl_init_snappy_workmem(pTHX_ void **workmem) +{ + /* Lazy working buffer alloc */ + if (expect_false(*workmem == NULL)) { + /* Cleaned up automatically by the cleanup handler */ + Newx(*workmem, CSNAPPY_WORKMEM_BYTES, char); + if (*workmem == NULL) + croak("Out of memory!"); + } +} + +/* Destroy working buffer */ +SRL_STATIC_INLINE void +srl_destroy_snappy_workmem(pTHX_ void *workmem) +{ + Safefree(workmem); +} + +/* Sets the compression header flag */ +SRL_STATIC_INLINE void +srl_set_compression_header_flag(srl_buffer_t *buf, const U32 compress_flags) +{ + /* sizeof(const char *) includes a count of \0 */ + srl_buffer_char *flags_and_version_byte = buf->start + sizeof(SRL_MAGIC_STRING) - 1; + *flags_and_version_byte |= SRL_F_COMPRESS_FLAGS_TO_PROTOCOL_ENCODING[ compress_flags >> 6 ]; +} + +/* Resets the compression header flag to OFF. + * Obviously requires that a Sereal header was already written to the + * encoder's output buffer. */ +SRL_STATIC_INLINE void +srl_reset_compression_header_flag(srl_buffer_t *buf) +{ + /* sizeof(const char *) includes a count of \0 */ + srl_buffer_char *flags_and_version_byte = buf->start + sizeof(SRL_MAGIC_STRING) - 1; + + /* disable snappy flag in header */ + *flags_and_version_byte = SRL_PROTOCOL_ENCODING_RAW | + (*flags_and_version_byte & SRL_PROTOCOL_VERSION_MASK); +} + +/* Compress body with one of available compressors (zlib, snappy). + * The function sets/resets compression bits at version byte. + * The caller has to adjust buf->body_pos by calling SRL_UPDATE_BODY_POS + * right after exiting from srl_compress_body. + */ + +SRL_STATIC_INLINE void +srl_compress_body(pTHX_ srl_buffer_t *buf, STRLEN sereal_header_length, + const U32 compress_flags, const int compress_level, void **workmem) +{ + const int is_traditional_snappy = compress_flags & SRL_F_COMPRESS_SNAPPY; + const int is_snappy = compress_flags & (SRL_F_COMPRESS_SNAPPY | SRL_F_COMPRESS_SNAPPY_INCREMENTAL); + /* !is_snappy is the same as "is zlib" right now */ + + size_t uncompressed_body_length = BUF_POS_OFS(buf) - sereal_header_length; + size_t compressed_body_length; + srl_buffer_char *varint_start = NULL; + srl_buffer_char *varint_end = NULL; + srl_buffer_t old_buf; + + DEBUG_ASSERT_BUF_SANE(buf); + + /* Get estimated compressed payload length */ + compressed_body_length + = (is_snappy ? (size_t) csnappy_max_compressed_length(uncompressed_body_length) + : (size_t) mz_compressBound(uncompressed_body_length) + SRL_MAX_VARINT_LENGTH); + + /* Will have to embed compressed packet length as varint if not + * in traditional Snappy mode. (So needs to be added for any of + * ZLIB, or incremental Snappy.) */ + if (!is_traditional_snappy) + compressed_body_length += SRL_MAX_VARINT_LENGTH; + + /* Back up old buffer and allocate new one with correct size */ + srl_buf_copy_buffer(aTHX_ buf, &old_buf); + srl_buf_init_buffer(aTHX_ buf, sereal_header_length + compressed_body_length + 1); + + /* Copy Sereal header */ + Copy(old_buf.start, buf->pos, sereal_header_length, char); + buf->pos += sereal_header_length; + + /* Embed uncompressed packet length if Zlib */ + if (!is_snappy) + srl_buf_cat_varint_nocheck(aTHX_ buf, 0, uncompressed_body_length); + + /* Embed compressed packet length if incr. Snappy or Zlib*/ + if (expect_true(!is_traditional_snappy)) { + varint_start = buf->pos; + srl_buf_cat_varint_nocheck(aTHX_ buf, 0, compressed_body_length); + varint_end = buf->pos - 1; + } + + if (is_snappy) { + uint32_t len = (uint32_t) compressed_body_length; + srl_init_snappy_workmem(aTHX_ workmem); + + csnappy_compress((char*) old_buf.start + sereal_header_length, (uint32_t) uncompressed_body_length, + (char*) buf->pos, &len, *workmem, CSNAPPY_WORKMEM_BYTES_POWER_OF_TWO); + + compressed_body_length = (size_t) len; + } else { + mz_ulong dl = (mz_ulong) compressed_body_length; + int status = mz_compress2( + buf->pos, + &dl, + old_buf.start + sereal_header_length, + (mz_ulong) uncompressed_body_length, + compress_level + ); + + (void)status; + assert(status == Z_OK); + compressed_body_length = (size_t) dl; + } + + assert(compressed_body_length != 0); + + /* If compression didn't help, swap back to old, uncompressed buffer */ + if (compressed_body_length >= uncompressed_body_length) { + /* swap in old, uncompressed buffer */ + srl_buf_swap_buffer(aTHX_ buf, &old_buf); + /* disable compression flag */ + srl_reset_compression_header_flag(buf); + } else { /* go ahead with Snappy and do final fixups */ + /* overwrite the max size varint with the real size of the compressed data */ + if (varint_start) + srl_update_varint_from_to(aTHX_ varint_start, varint_end, compressed_body_length); + + buf->pos += compressed_body_length; + + /* enable compression flag */ + srl_set_compression_header_flag(buf, compress_flags); + } + + srl_buf_free_buffer(aTHX_ &old_buf); + DEBUG_ASSERT_BUF_SANE(buf); +} + +#endif diff --git a/srl_encoder.c b/srl_encoder.c index 7756b03..ff95924 100644 --- a/srl_encoder.c +++ b/srl_encoder.c @@ -42,7 +42,7 @@ extern "C" { #endif /* hv_backreferences_p is not marked as exported in embed.fnc in any perl */ -#if (PERL_VERSION >= 10 && !defined(WIN32) && !defined(_WIN32)) +#if (PERL_VERSION >= 10) #define HAS_HV_BACKREFS #endif @@ -51,18 +51,7 @@ extern "C" { #include "srl_common.h" #include "ptable.h" #include "srl_buffer.h" - -#if defined(HAVE_CSNAPPY) -#include -#else -#include "snappy/csnappy_compress.c" -#endif - -#if defined(HAVE_MINIZ) -#include -#else -#include "miniz.h" -#endif +#include "srl_compress.h" /* The ENABLE_DANGEROUS_HACKS (passed through from ENV via Makefile.PL) enables * optimizations that may make the code so cozy with a particular version of the @@ -138,6 +127,8 @@ SRL_STATIC_INLINE srl_encoder_t *srl_dump_data_structure(pTHX_ srl_encoder_t *en ? srl_init_freezeobj_svhash(enc) \ : (enc)->freezeobj_svhash ) +#define SRL_ENC_UPDATE_BODY_POS(enc) SRL_UPDATE_BODY_POS(&(enc)->buf, (enc)->protocol_version) + #ifndef MAX_CHARSET_NAME_LENGTH # define MAX_CHARSET_NAME_LENGTH 2 #endif @@ -146,13 +137,23 @@ SRL_STATIC_INLINE srl_encoder_t *srl_dump_data_structure(pTHX_ srl_encoder_t *en /* Apparently regexes in 5.10 are "modern" but with 5.8 internals */ +#ifndef RXf_PMf_STD_PMMOD_SHIFT # define RXf_PMf_STD_PMMOD_SHIFT 12 +#endif +#ifndef RE_EXTFLAGS # define RX_EXTFLAGS(re) ((re)->extflags) +#endif +#ifndef RX_PRECOMP # define RX_PRECOMP(re) ((re)->precomp) +#endif +#ifndef RX_PRELEN # define RX_PRELEN(re) ((re)->prelen) +#endif /* Maybe this is only on OS X, where SvUTF8(sv) exists but looks at flags that don't exist */ +#ifndef RX_UTF8 # define RX_UTF8(re) (RX_EXTFLAGS(re) & RXf_UTF8) +#endif #elif defined(SvRX) # define MODERN_REGEXP @@ -230,12 +231,13 @@ SRL_STATIC_INLINE srl_encoder_t *srl_dump_data_structure(pTHX_ srl_encoder_t *en #define CALL_SRL_DUMP_SV(enc, src) STMT_START { \ if (!(src)) { \ - srl_buf_cat_char((enc), SRL_HDR_CANONICAL_UNDEF); /* is this right? */ \ + srl_buf_cat_char(&(enc)->buf, SRL_HDR_CANONICAL_UNDEF); /* is this right? */\ } \ else \ { \ - SvGETMAGIC(src); \ - svtype svt= SvTYPE((src)); \ + svtype svt; \ + SvGETMAGIC(src); \ + svt= SvTYPE((src)); \ if (svt < SVt_PVMG && \ SvREFCNT((src)) == 1 && \ !SvROK((src)) \ @@ -300,7 +302,7 @@ srl_clear_encoder(pTHX_ srl_encoder_t *enc) /* tmp_buf.start may be NULL for an unused tmp_buf, but so what? */ enc->tmp_buf.pos = enc->tmp_buf.start; - SRL_SET_BODY_POS(enc, enc->buf.start); + SRL_SET_BODY_POS(&enc->buf, enc->buf.start); SRL_ENC_RESET_OPER_FLAG(enc, SRL_OF_ENCODER_DIRTY); } @@ -314,7 +316,8 @@ srl_destroy_encoder(pTHX_ srl_encoder_t *enc) if (enc->tmp_buf.start != NULL) srl_buf_free_buffer(aTHX_ &enc->tmp_buf); - Safefree(enc->snappy_workmem); + srl_destroy_snappy_workmem(aTHX_ enc->snappy_workmem); + if (enc->ref_seenhash != NULL) PTABLE_free(enc->ref_seenhash); if (enc->freezeobj_svhash != NULL) @@ -368,12 +371,21 @@ srl_empty_encoder_struct(pTHX) return enc; } +#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 + /* Builds the C-level configuration and state struct. */ srl_encoder_t * -srl_build_encoder_struct(pTHX_ HV *opt) +srl_build_encoder_struct(pTHX_ HV *opt, sv_with_hash *options) { srl_encoder_t *enc; - SV **svp; + SV *val; + HE *he; enc = srl_empty_encoder_struct(aTHX); enc->flags = 0; @@ -383,39 +395,39 @@ srl_build_encoder_struct(pTHX_ HV *opt) int undef_unknown = 0; int compression_format = 0; /* SRL_F_SHARED_HASHKEYS on by default */ - svp = hv_fetchs(opt, "no_shared_hashkeys", 0); - if ( !svp || !SvTRUE(*svp) ) + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_NO_SHARED_HASHKEYS); + if ( !val || !SvTRUE(val) ) SRL_ENC_SET_OPTION(enc, SRL_F_SHARED_HASHKEYS); /* Needs to be before the snappy options */ /* enc->protocol_version defaults to SRL_PROTOCOL_VERSION. */ - svp = hv_fetchs(opt, "protocol_version", 0); - if (svp && SvOK(*svp)) { - enc->protocol_version = SvUV(*svp); + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_PROTOCOL_VERSION); + if (val && SvOK(val)) { + enc->protocol_version = SvUV(val); if (enc->protocol_version < 1 || enc->protocol_version > SRL_PROTOCOL_VERSION) { - croak("Specified Sereal protocol version ('%lu') is invalid", - (unsigned long)enc->protocol_version); + croak("Specified Sereal protocol version ('%"UVuf") is invalid", + (UV)enc->protocol_version); } } else { /* Compatibility with the old way to specify older protocol version */ - svp = hv_fetchs(opt, "use_protocol_v1", 0); - if ( svp && SvTRUE(*svp) ) + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_USE_PROTOCOL_V1); + if ( val && SvTRUE(val) ) enc->protocol_version = 1; } - svp = hv_fetchs(opt, "croak_on_bless", 0); - if ( svp && SvTRUE(*svp) ) + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_CROAK_ON_BLESS); + if ( val && SvTRUE(val) ) SRL_ENC_SET_OPTION(enc, SRL_F_CROAK_ON_BLESS); - svp = hv_fetchs(opt, "no_bless_objects", 0); - if ( svp && SvTRUE(*svp) ) + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_NO_BLESS_OBJECTS); + if ( val && SvTRUE(val) ) SRL_ENC_SET_OPTION(enc, SRL_F_NO_BLESS_OBJECTS); - svp = hv_fetchs(opt, "freeze_callbacks", 0); - if ( svp && SvTRUE(*svp) ) { + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_FREEZE_CALLBACKS); + if ( val && SvTRUE(val) ) { if (SRL_ENC_HAVE_OPTION(enc, SRL_F_NO_BLESS_OBJECTS)) croak("The no_bless_objects and freeze_callback_support " "options are mutually exclusive"); @@ -423,9 +435,9 @@ srl_build_encoder_struct(pTHX_ HV *opt) enc->sereal_string_sv = newSVpvs("Sereal"); } - svp = hv_fetchs(opt, "compress", 0); - if (svp) { - compression_format = SvIV(*svp); + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_COMPRESS); + if (val) { + compression_format = SvIV(val); /* See also Encoder.pm's constants */ switch (compression_format) { @@ -440,9 +452,9 @@ srl_build_encoder_struct(pTHX_ HV *opt) croak("Zlib compression was introduced in protocol version 3 and you are asking for only version %i", (int)enc->protocol_version); enc->compress_level = MZ_DEFAULT_COMPRESSION; - svp = hv_fetchs(opt, "compress_level", 0); - if ( svp && SvTRUE(*svp) ) { - IV lvl = SvIV(*svp); + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_COMPRESS_LEVEL); + if ( val && SvTRUE(val) ) { + IV lvl = SvIV(val); if (expect_false( lvl < 1 || lvl > 10 )) /* Sekrit: compression lvl 10 is a miniz thing that doesn't exist in normal zlib */ croak("'compress_level' needs to be between 1 and 9"); enc->compress_level = lvl; @@ -455,15 +467,15 @@ srl_build_encoder_struct(pTHX_ HV *opt) else { /* Only bother with old compression options if necessary */ - svp = hv_fetchs(opt, "snappy_incr", 0); - if ( svp && SvTRUE(*svp) ) { + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_SNAPPY_INCR); + if ( val && SvTRUE(val) ) { SRL_ENC_SET_OPTION(enc, SRL_F_COMPRESS_SNAPPY_INCREMENTAL); compression_format = 1; } else { /* snappy_incr >> snappy */ - svp = hv_fetchs(opt, "snappy", 0); - if ( svp && SvTRUE(*svp) ) { + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_SNAPPY); + if ( val && SvTRUE(val) ) { /* incremental is the new black in V2 */ if (expect_true( enc->protocol_version > 1 )) SRL_ENC_SET_OPTION(enc, SRL_F_COMPRESS_SNAPPY_INCREMENTAL); @@ -474,72 +486,71 @@ srl_build_encoder_struct(pTHX_ HV *opt) } } - svp = hv_fetchs(opt, "undef_unknown", 0); - if ( svp && SvTRUE(*svp) ) { + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_UNDEF_UNKNOWN); + if ( val && SvTRUE(val) ) { undef_unknown = 1; SRL_ENC_SET_OPTION(enc, SRL_F_UNDEF_UNKNOWN); } - svp = hv_fetchs(opt, "sort_keys", 0); - if ( !svp ) - svp = hv_fetchs(opt, "canonical",0); - if ( svp && SvTRUE(*svp) ) + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_SORT_KEYS); + if ( !val ) + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_CANONICAL); + if ( val && SvTRUE(val) ) SRL_ENC_SET_OPTION(enc, SRL_F_SORT_KEYS); - svp = hv_fetchs(opt, "canonical_refs", 0); - if ( !svp ) - svp = hv_fetchs(opt, "canonical",0); - if ( svp && SvTRUE(*svp) ) + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_CANONICAL_REFS); + if ( !val ) + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_CANONICAL); + if ( val && SvTRUE(val) ) SRL_ENC_SET_OPTION(enc, SRL_F_CANONICAL_REFS); - svp = hv_fetchs(opt, "aliased_dedupe_strings", 0); - if ( svp && SvTRUE(*svp) ) + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_ALIASED_DEDUPE_STRINGS); + if ( val && SvTRUE(val) ) SRL_ENC_SET_OPTION(enc, SRL_F_ALIASED_DEDUPE_STRINGS | SRL_F_DEDUPE_STRINGS); else { - svp = hv_fetchs(opt, "dedupe_strings", 0); - if ( svp && SvTRUE(*svp) ) + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_DEDUPE_STRINGS); + if ( val && SvTRUE(val) ) SRL_ENC_SET_OPTION(enc, SRL_F_DEDUPE_STRINGS); } - svp = hv_fetchs(opt, "stringify_unknown", 0); - if ( svp && SvTRUE(*svp) ) { + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_STRINGIFY_UNKNOWN); + if ( val && SvTRUE(val) ) { if (expect_false( undef_unknown )) croak("'undef_unknown' and 'stringify_unknown' " "options are mutually exclusive"); SRL_ENC_SET_OPTION(enc, SRL_F_STRINGIFY_UNKNOWN); } - svp = hv_fetchs(opt, "warn_unknown", 0); - if ( svp && SvTRUE(*svp) ) { + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_WARN_UNKNOWN); + if ( val && SvTRUE(val) ) { SRL_ENC_SET_OPTION(enc, SRL_F_WARN_UNKNOWN); - if (SvIV(*svp) < 0) + if (SvIV(val) < 0) SRL_ENC_SET_OPTION(enc, SRL_F_NOWARN_UNKNOWN_OVERLOAD); } - if (compression_format) { enc->compress_threshold = 1024; - svp = hv_fetchs(opt, "compress_threshold", 0); - if ( svp && SvOK(*svp) ) - enc->compress_threshold = SvIV(*svp); + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_COMPRESS_THRESHOLD); + if ( val && SvOK(val) ) + enc->compress_threshold = SvIV(val); else if (compression_format == 1) { /* compression_format==1 is some sort of Snappy */ - svp = hv_fetchs(opt, "snappy_threshold", 0); - if ( svp && SvOK(*svp) ) - enc->compress_threshold = SvIV(*svp); + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_SNAPPY_THRESHOLD); + if ( val && SvOK(val) ) + enc->compress_threshold = SvIV(val); } } - svp = hv_fetchs(opt, "max_recursion_depth", 0); - if ( svp && SvTRUE(*svp)) - enc->max_recursion_depth = SvUV(*svp); + my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_MAX_RECURSION_DEPTH); + if ( val && SvTRUE(val) ) + enc->max_recursion_depth = SvUV(val); } else { /* SRL_F_SHARED_HASHKEYS on by default */ SRL_ENC_SET_OPTION(enc, SRL_F_SHARED_HASHKEYS); } - DEBUG_ASSERT_BUF_SANE(enc); + DEBUG_ASSERT_BUF_SANE(&enc->buf); return enc; } @@ -559,7 +570,7 @@ srl_build_encoder_struct_alike(pTHX_ srl_encoder_t *proto) } enc->protocol_version = proto->protocol_version; - DEBUG_ASSERT_BUF_SANE(enc); + DEBUG_ASSERT_BUF_SANE(&enc->buf); return enc; } @@ -598,46 +609,26 @@ srl_init_string_deduper_hv(pTHX_ srl_encoder_t *enc) return enc->string_deduper_hv; } -/* Lazy working buffer alloc */ -SRL_STATIC_INLINE void -srl_init_snappy_workmem(pTHX_ srl_encoder_t *enc) -{ - /* Lazy working buffer alloc */ - if (expect_false( enc->snappy_workmem == NULL )) { - /* Cleaned up automatically by the cleanup handler */ - Newx(enc->snappy_workmem, CSNAPPY_WORKMEM_BYTES, char); - if (enc->snappy_workmem == NULL) - croak("Out of memory!"); - } -} - void -srl_write_header(pTHX_ srl_encoder_t *enc, SV *user_header_src) +srl_write_header(pTHX_ srl_encoder_t *enc, SV *user_header_src, const U32 compress_flags) { /* 4th to 8th bit are flags. Using 4th for snappy flag. FIXME needs to go in spec. */ - const U8 flags = ( - SRL_ENC_HAVE_OPTION(enc, SRL_F_COMPRESS_SNAPPY) - ? SRL_PROTOCOL_ENCODING_SNAPPY - : SRL_ENC_HAVE_OPTION(enc, SRL_F_COMPRESS_SNAPPY_INCREMENTAL) - ? SRL_PROTOCOL_ENCODING_SNAPPY_INCREMENTAL - : SRL_ENC_HAVE_OPTION(enc, SRL_F_COMPRESS_ZLIB) - ? SRL_PROTOCOL_ENCODING_ZLIB - : SRL_PROTOCOL_ENCODING_RAW - ); + + U8 flags= SRL_F_COMPRESS_FLAGS_TO_PROTOCOL_ENCODING[ compress_flags >> SRL_F_COMPRESS_FLAGS_SHIFT ]; const U8 version_and_flags = (U8)enc->protocol_version | flags; /* 4 byte magic string + proto version * + potentially uncompressed size varint * + 1 byte varint that indicates zero-length header */ - BUF_SIZE_ASSERT(enc, sizeof(SRL_MAGIC_STRING) + 1 + 1); + BUF_SIZE_ASSERT(&enc->buf, sizeof(SRL_MAGIC_STRING) + 1 + 1); if (LIKELY( enc->protocol_version > 2 )) - srl_buf_cat_str_s_nocheck(enc, SRL_MAGIC_STRING_HIGHBIT); + srl_buf_cat_str_s_nocheck(&enc->buf, SRL_MAGIC_STRING_HIGHBIT); else - srl_buf_cat_str_s_nocheck(enc, SRL_MAGIC_STRING); - srl_buf_cat_char_nocheck(enc, version_and_flags); + srl_buf_cat_str_s_nocheck(&enc->buf, SRL_MAGIC_STRING); + srl_buf_cat_char_nocheck(&enc->buf, version_and_flags); if (user_header_src == NULL) { - srl_buf_cat_char_nocheck(enc, '\0'); /* variable header length (0 right now) */ + srl_buf_cat_char_nocheck(&enc->buf, '\0'); /* variable header length (0 right now) */ } else { STRLEN user_data_len; @@ -652,21 +643,21 @@ srl_write_header(pTHX_ srl_encoder_t *enc, SV *user_header_src) /* Write document body (for header) into separate buffer */ srl_buf_swap_buffer(aTHX_ &enc->tmp_buf, &enc->buf); - SRL_UPDATE_BODY_POS(enc); + SRL_ENC_UPDATE_BODY_POS(enc); srl_dump_sv(aTHX_ enc, user_header_src); srl_fixup_weakrefs(aTHX_ enc); /* more bodies to follow */ srl_clear_seen_hashes(aTHX_ enc); /* more bodies to follow */ /* Swap main buffer back in, encode header length&bitfield, copy user header data */ - user_data_len = BUF_POS_OFS(enc->buf); + user_data_len = BUF_POS_OFS(&enc->buf); srl_buf_swap_buffer(aTHX_ &enc->buf, &enc->tmp_buf); - BUF_SIZE_ASSERT(enc, user_data_len + 1 + SRL_MAX_VARINT_LENGTH); /* +1 for bit field, +X for header len */ + BUF_SIZE_ASSERT(&enc->buf, user_data_len + 1 + SRL_MAX_VARINT_LENGTH); /* +1 for bit field, +X for header len */ /* Encode header length */ - srl_buf_cat_varint_nocheck(aTHX_ enc, 0, (UV)(user_data_len + 1)); /* +1 for bit field */ + srl_buf_cat_varint_nocheck(aTHX_ &enc->buf, 0, (UV)(user_data_len + 1)); /* +1 for bit field */ /* Encode bitfield */ - srl_buf_cat_char_nocheck(enc, '\1'); + srl_buf_cat_char_nocheck(&enc->buf, '\1'); /* Copy user header data */ Copy(enc->tmp_buf.start, enc->buf.pos, user_data_len, char); enc->buf.pos += user_data_len; @@ -711,18 +702,18 @@ srl_dump_nv(pTHX_ srl_encoder_t *enc, SV *src) MS_VC6_WORKAROUND_VOLATILE double d= (double)nv; /* TODO: this logic could be reworked to not duplicate so much code, which will help on win32 */ if ( f == nv || nv != nv ) { - BUF_SIZE_ASSERT(enc, 1 + sizeof(f)); /* heuristic: header + string + simple value */ - srl_buf_cat_char_nocheck(enc,SRL_HDR_FLOAT); + BUF_SIZE_ASSERT(&enc->buf, 1 + sizeof(f)); /* heuristic: header + string + simple value */ + srl_buf_cat_char_nocheck(&enc->buf, SRL_HDR_FLOAT); Copy((char *)&f, enc->buf.pos, sizeof(f), char); enc->buf.pos += sizeof(f); } else if (d == nv) { - BUF_SIZE_ASSERT(enc, 1 + sizeof(d)); /* heuristic: header + string + simple value */ - srl_buf_cat_char_nocheck(enc,SRL_HDR_DOUBLE); + BUF_SIZE_ASSERT(&enc->buf, 1 + sizeof(d)); /* heuristic: header + string + simple value */ + srl_buf_cat_char_nocheck(&enc->buf, SRL_HDR_DOUBLE); Copy((char *)&d, enc->buf.pos, sizeof(d), char); enc->buf.pos += sizeof(d); } else { - BUF_SIZE_ASSERT(enc, 1 + sizeof(nv)); /* heuristic: header + string + simple value */ - srl_buf_cat_char_nocheck(enc,SRL_HDR_LONG_DOUBLE); + BUF_SIZE_ASSERT(&enc->buf, 1 + sizeof(nv)); /* heuristic: header + string + simple value */ + srl_buf_cat_char_nocheck(&enc->buf, SRL_HDR_LONG_DOUBLE); Copy((char *)&nv, enc->buf.pos, sizeof(nv), char); #if SRL_EXTENDED_PRECISION_LONG_DOUBLE /* x86 uses an 80 bit extended precision. on 64 bit machines @@ -753,10 +744,10 @@ srl_dump_ivuv(pTHX_ srl_encoder_t *enc, SV *src) if (num <= 15) { /* encodable as POS */ hdr = SRL_HDR_POS_LOW | (unsigned char)num; - srl_buf_cat_char(enc, hdr); + srl_buf_cat_char(&enc->buf, hdr); } else { - srl_buf_cat_varint(aTHX_ enc, SRL_HDR_VARINT, num); + srl_buf_cat_varint(aTHX_ &enc->buf, SRL_HDR_VARINT, num); } } else { @@ -764,11 +755,11 @@ srl_dump_ivuv(pTHX_ srl_encoder_t *enc, SV *src) if (num >= -16) { /* encodable as NEG */ hdr = SRL_HDR_NEG_LOW | ((unsigned char)num + 32); - srl_buf_cat_char(enc, hdr); + srl_buf_cat_char(&enc->buf, hdr); } else { /* Needs ZIGZAG */ - srl_buf_cat_zigzag(aTHX_ enc, SRL_HDR_ZIGZAG, num); + srl_buf_cat_zigzag(aTHX_ &enc->buf, SRL_HDR_ZIGZAG, num); } } } @@ -795,7 +786,7 @@ srl_get_frozen_object(pTHX_ srl_encoder_t *enc, SV *src, SV *referent) SV *replacement= NULL; PTABLE_t *freezeobj_svhash = SRL_GET_FREEZEOBJ_SVHASH(enc); if (SvREFCNT(referent)>1) { - replacement= PTABLE_fetch(freezeobj_svhash, referent); + replacement= (SV *) PTABLE_fetch(freezeobj_svhash, referent); } if (!replacement) { int count; @@ -852,7 +843,7 @@ srl_dump_classname(pTHX_ srl_encoder_t *enc, SV *referent, SV *replacement) if (oldoffset != 0) { /* Issue COPY instead of literal class name string */ - srl_buf_cat_varint(aTHX_ enc, + srl_buf_cat_varint(aTHX_ &enc->buf, expect_false(replacement) ? SRL_HDR_OBJECTV_FREEZE : SRL_HDR_OBJECTV, (UV)oldoffset); } @@ -867,10 +858,10 @@ srl_dump_classname(pTHX_ srl_encoder_t *enc, SV *referent, SV *replacement) * At least, we can safely use the same PTABLE to store the ptrs to hashkeys since * the set of pointers will never collide. * /me bows to Yves for the delightfully evil hack. */ - srl_buf_cat_char(enc, expect_false(replacement) ? SRL_HDR_OBJECT_FREEZE : SRL_HDR_OBJECT); + srl_buf_cat_char(&enc->buf, expect_false(replacement) ? SRL_HDR_OBJECT_FREEZE : SRL_HDR_OBJECT); /* remember current offset before advancing it */ - PTABLE_store(string_seenhash, (void *)stash, INT2PTR(void *, BODY_POS_OFS(enc->buf))); + PTABLE_store(string_seenhash, (void *)stash, INT2PTR(void *, BODY_POS_OFS(&enc->buf))); /* HvNAMEUTF8 not in older perls and it would be 0 for those anyway */ #if PERL_VERSION >= 16 @@ -907,171 +898,49 @@ srl_prepare_encoder(pTHX_ srl_encoder_t *enc) return enc; } - -/* Update a varint anywhere in the output stream with defined start and end - * positions. This can produce non-canonical varints and is useful for filling - * pre-allocated varints. */ -SRL_STATIC_INLINE void -srl_update_varint_from_to(pTHX_ char *varint_start, char *varint_end, UV number) -{ - while (number >= 0x80) { /* while we are larger than 7 bits long */ - *varint_start++ = (number & 0x7f) | 0x80; /* write out the least significant 7 bits, set the high bit */ - number = number >> 7; /* shift off the 7 least significant bits */ - } - /* if it is the same size we can use a canonical varint */ - if ( varint_start == varint_end ) { - *varint_start = number; /* encode the last 7 bits without the high bit being set */ - } else { - /* if not we produce a non-canonical varint, basically we stuff - * 0 bits (via 0x80) into the "tail" of the varint, until we can - * stick in a null to terminate the sequence. This means that the - * varint is effectively "self-padding", and we only need special - * logic in the encoder - a decoder will happily process a non-canonical - * varint with no problem */ - *varint_start++ = (number & 0x7f) | 0x80; - while ( varint_start < varint_end ) - *varint_start++ = 0x80; - *varint_start= 0; - } -} - - -/* Resets the compression header flag to OFF. - * Obviously requires that a Sereal header was already written to the - * encoder's output buffer. */ -SRL_STATIC_INLINE void -srl_reset_compression_header_flag(srl_encoder_t *enc) -{ - /* sizeof(const char *) includes a count of \0 */ - char *flags_and_version_byte = enc->buf.start + sizeof(SRL_MAGIC_STRING) - 1; - /* disable snappy flag in header */ - *flags_and_version_byte = SRL_PROTOCOL_ENCODING_RAW | - (*flags_and_version_byte & SRL_PROTOCOL_VERSION_MASK); -} - SRL_STATIC_INLINE srl_encoder_t * srl_dump_data_structure(pTHX_ srl_encoder_t *enc, SV *src, SV *user_header_src) { + U32 compress_flags; + enc = srl_prepare_encoder(aTHX_ enc); + compress_flags= SRL_ENC_HAVE_OPTION(enc, SRL_F_COMPRESS_FLAGS_MASK); - if (expect_true( - !SRL_ENC_HAVE_OPTION(enc, ( SRL_F_COMPRESS_SNAPPY - | SRL_F_COMPRESS_SNAPPY_INCREMENTAL - | SRL_F_COMPRESS_ZLIB)) - )) - { - srl_write_header(aTHX_ enc, user_header_src); - SRL_UPDATE_BODY_POS(enc); - srl_dump_sv(aTHX_ enc, src); - srl_fixup_weakrefs(aTHX_ enc); - } - else { /* Have some sort of compression */ + if (expect_false(compress_flags)) + { /* Have some sort of compression */ ptrdiff_t sereal_header_len; STRLEN uncompressed_body_length; /* Alas, have to write entire packet first since the header length * will determine offsets. */ - srl_write_header(aTHX_ enc, user_header_src); - sereal_header_len = BUF_POS_OFS(enc->buf); - SRL_UPDATE_BODY_POS(enc); + srl_write_header(aTHX_ enc, user_header_src, compress_flags); + sereal_header_len = BUF_POS_OFS(&enc->buf); + SRL_ENC_UPDATE_BODY_POS(enc); srl_dump_sv(aTHX_ enc, src); srl_fixup_weakrefs(aTHX_ enc); - assert(BUF_POS_OFS(enc->buf) > sereal_header_len); - uncompressed_body_length = BUF_POS_OFS(enc->buf) - sereal_header_len; + assert(BUF_POS_OFS(&enc->buf) > sereal_header_len); + uncompressed_body_length = BUF_POS_OFS(&enc->buf) - sereal_header_len; - if (uncompressed_body_length < (STRLEN)enc->compress_threshold) - { + if (uncompressed_body_length < (STRLEN)enc->compress_threshold) { /* Don't bother with compression at all if we have less than $threshold bytes of payload */ - srl_reset_compression_header_flag(enc); + srl_reset_compression_header_flag(&enc->buf); } else { /* Do Snappy or zlib compression of body */ - const int is_snappy - = SRL_ENC_HAVE_OPTION(enc, ( SRL_F_COMPRESS_SNAPPY - | SRL_F_COMPRESS_SNAPPY_INCREMENTAL)); - /* !is_snappy is the same as "is zlib" right now */ - - const int is_traditional_snappy - = (SRL_ENC_HAVE_OPTION(enc, SRL_F_COMPRESS_SNAPPY)); - - srl_buffer_t old_buf; /* TODO can we use the enc->tmp_buf here to avoid allocations? */ - char *varint_start= NULL; - char *varint_end= NULL; - size_t dest_len; - - /* Get uncompressed payload and total packet output (after compression) lengths */ - dest_len = sereal_header_len + 1 - + ( is_snappy ? (size_t)csnappy_max_compressed_length(uncompressed_body_length) - : (size_t)mz_compressBound(uncompressed_body_length)+SRL_MAX_VARINT_LENGTH ); - - /* Will have to embed compressed packet length as varint if not - * in traditional Snappy mode. (So needs to be added for any of - * ZLIB, or incremental Snappy.) */ - if ( !is_traditional_snappy ) - dest_len += SRL_MAX_VARINT_LENGTH; - - if (is_snappy) - srl_init_snappy_workmem(aTHX_ enc); - - /* Back up old buffer and allocate new one with correct size */ - srl_buf_copy_buffer(aTHX_ &enc->buf, &old_buf); - srl_buf_init_buffer(aTHX_ &enc->buf, dest_len); - - /* Copy Sereal header */ - Copy(old_buf.start, enc->buf.pos, sereal_header_len, char); - enc->buf.pos += sereal_header_len; - SRL_UPDATE_BODY_POS(enc); /* will do the right thing wrt. protocol V1 / V2 */ - - /* Embed compressed packet length if Zlib */ - if (!is_snappy) - srl_buf_cat_varint_nocheck(aTHX_ enc, 0, uncompressed_body_length); - - /* Embed compressed packet length if incr. Snappy or Zlib*/ - if (expect_true( !is_traditional_snappy )) { - varint_start= enc->buf.pos; - srl_buf_cat_varint_nocheck(aTHX_ enc, 0, dest_len); - varint_end= enc->buf.pos - 1; - } - - if (is_snappy) { - uint32_t len = (uint32_t)dest_len; - csnappy_compress(old_buf.start + sereal_header_len, (uint32_t)uncompressed_body_length, enc->buf.pos, &len, - enc->snappy_workmem, CSNAPPY_WORKMEM_BYTES_POWER_OF_TWO); - dest_len = (size_t)len; - } - else { - mz_ulong dl = (mz_ulong)dest_len; - int status = mz_compress2( - (unsigned char *)enc->buf.pos, - &dl, - (const unsigned char *)(old_buf.start + sereal_header_len), - (mz_ulong)uncompressed_body_length, - enc->compress_level - ); - (void)status; - assert(status == Z_OK); - dest_len = (size_t)dl; - } + srl_compress_body(aTHX_ &enc->buf, sereal_header_len, + compress_flags, enc->compress_level, + &enc->snappy_workmem); - assert(dest_len != 0); - - /* If compression didn't help, swap back to old, uncompressed buffer */ - if (dest_len >= uncompressed_body_length) { - /* swap in old, uncompressed buffer */ - srl_buf_swap_buffer(aTHX_ &enc->buf, &old_buf); - /* disable compression flag */ - srl_reset_compression_header_flag(enc); - } - else { /* go ahead with Snappy and do final fixups */ - /* overwrite the max size varint with the real size of the compressed data */ - if (varint_start) - srl_update_varint_from_to(aTHX_ varint_start, varint_end, dest_len); - enc->buf.pos += dest_len; - } - - srl_buf_free_buffer(aTHX_ &old_buf); - assert(enc->buf.pos <= enc->buf.end); - } /* End of "actually do compression" */ + SRL_ENC_UPDATE_BODY_POS(enc); + DEBUG_ASSERT_BUF_SANE(&enc->buf); + } } /* End of "want compression?" */ + else + { + srl_write_header(aTHX_ enc, user_header_src, compress_flags); + SRL_ENC_UPDATE_BODY_POS(enc); + srl_dump_sv(aTHX_ enc, src); + srl_fixup_weakrefs(aTHX_ enc); + } /* NOT doing a * SRL_ENC_RESET_OPER_FLAG(enc, SRL_OF_ENCODER_DIRTY); @@ -1087,19 +956,19 @@ srl_dump_data_structure_mortal_sv(pTHX_ srl_encoder_t *enc, SV *src, SV *user_he assert(enc->buf.start && enc->buf.pos && enc->buf.pos > enc->buf.start); if ( flags && /* for now simpler and equivalent to: flags == SRL_ENC_SV_REUSE_MAYBE */ - (BUF_POS_OFS(enc->buf) > 20 && BUF_SPACE(enc->buf) < BUF_POS_OFS(enc->buf) ) + (BUF_POS_OFS(&enc->buf) > 20 && BUF_SPACE(&enc->buf) < BUF_POS_OFS(&enc->buf) ) ){ /* If not wasting more than 2x memory - FIXME fungible */ SV *sv = sv_2mortal(newSV_type(SVt_PV)); - SvPV_set(sv, enc->buf.start); - SvLEN_set(sv, BUF_SIZE(enc->buf)); - SvCUR_set(sv, BUF_POS_OFS(enc->buf)); + SvPV_set(sv, (char *) enc->buf.start); + SvLEN_set(sv, BUF_SIZE(&enc->buf)); + SvCUR_set(sv, BUF_POS_OFS(&enc->buf)); SvPOK_on(sv); enc->buf.start = enc->buf.pos = NULL; /* no need to free these guys now */ return sv; } - return sv_2mortal(newSVpvn(enc->buf.start, (STRLEN)BUF_POS_OFS(enc->buf))); + return sv_2mortal(newSVpvn((char *)enc->buf.start, (STRLEN)BUF_POS_OFS(&enc->buf))); } SRL_STATIC_INLINE void @@ -1116,9 +985,9 @@ srl_fixup_weakrefs(pTHX_ srl_encoder_t *enc) while ( NULL != (ent = PTABLE_iter_next(it)) ) { const ptrdiff_t offset = (ptrdiff_t)ent->value; if ( offset ) { - char *pos = enc->buf.body_pos + offset; + srl_buffer_char *pos = enc->buf.body_pos + offset; assert(*pos == SRL_HDR_WEAKEN); - if (DEBUGHACK) warn("setting byte at offset %lu to PAD", (long unsigned int)offset); + if (DEBUGHACK) warn("setting byte at offset %"UVuf" to PAD", (UV)offset); *pos = SRL_HDR_PAD; } } @@ -1169,7 +1038,7 @@ srl_dump_regexp(pTHX_ srl_encoder_t *enc, SV *sv) match_flags >>= 1; } - srl_buf_cat_char(enc, SRL_HDR_REGEXP); + srl_buf_cat_char(&enc->buf, SRL_HDR_REGEXP); srl_dump_pv(aTHX_ enc, RX_PRECOMP(re),RX_PRELEN(re), (RX_UTF8(re) ? SVf_UTF8 : 0)); srl_dump_pv(aTHX_ enc, reflags, left, 0); return; @@ -1184,14 +1053,14 @@ srl_dump_av(pTHX_ srl_encoder_t *enc, AV *src, U32 refcount) n = av_len(src)+1; /* heuristic: n is virtually the min. size of any element */ - BUF_SIZE_ASSERT(enc, 2 + SRL_MAX_VARINT_LENGTH + n); + BUF_SIZE_ASSERT(&enc->buf, 2 + SRL_MAX_VARINT_LENGTH + n); if (n < 16 && refcount == 1 && !SRL_ENC_HAVE_OPTION(enc,SRL_F_CANONICAL_REFS)) { enc->buf.pos--; /* backup over previous REFN */ - srl_buf_cat_char_nocheck(enc, SRL_HDR_ARRAYREF + n); + srl_buf_cat_char_nocheck(&enc->buf, SRL_HDR_ARRAYREF + n); } else { /* header and num. elements */ - srl_buf_cat_varint_nocheck(aTHX_ enc, SRL_HDR_ARRAY, n); + srl_buf_cat_varint_nocheck(aTHX_ &enc->buf, SRL_HDR_ARRAY, n); } if (!n) return; @@ -1257,15 +1126,15 @@ srl_dump_hv(pTHX_ srl_encoder_t *enc, HV *src, U32 refcount) n = 0; while ((he = hv_iternext(src))) { ++n; } - /* heuristic: n = ~min size of n values; - * + 2*n = very conservative min size of n hashkeys if all COPY */ - BUF_SIZE_ASSERT(enc, 2 + SRL_MAX_VARINT_LENGTH + 3*n); + /* heuristic: n = ~min size of n values; + * + 3*n = very conservative min size of n hashkeys if all COPY */ + BUF_SIZE_ASSERT(&enc->buf, 2 + SRL_MAX_VARINT_LENGTH + 3 * n); if (n < 16 && refcount == 1 && !SRL_ENC_HAVE_OPTION(enc,SRL_F_CANONICAL_REFS)) { enc->buf.pos--; /* back up over the previous REFN */ - srl_buf_cat_char_nocheck(enc, SRL_HDR_HASHREF + n); + srl_buf_cat_char_nocheck(&enc->buf, SRL_HDR_HASHREF + n); } else { - srl_buf_cat_varint_nocheck(aTHX_ enc, SRL_HDR_HASH, n); + srl_buf_cat_varint_nocheck(aTHX_ &enc->buf, SRL_HDR_HASH, n); } (void)hv_iterinit(src); /* return value not reliable according to API docs */ @@ -1324,14 +1193,14 @@ srl_dump_hv(pTHX_ srl_encoder_t *enc, HV *src, U32 refcount) } } else { n= HvUSEDKEYS(src); - /* heuristic: n = ~min size of n values; - * + 2*n = very conservative min size of n hashkeys if all COPY */ - BUF_SIZE_ASSERT(enc, 2 + SRL_MAX_VARINT_LENGTH + 3*n); + /* heuristic: n = ~min size of n values; + * + 3 * n = very conservative min size of n hashkeys if all COPY */ + BUF_SIZE_ASSERT(&enc->buf, 2 + SRL_MAX_VARINT_LENGTH + 3 * n); if (n < 16 && refcount == 1 && !SRL_ENC_HAVE_OPTION(enc,SRL_F_CANONICAL_REFS)) { enc->buf.pos--; /* backup over the previous REFN */ - srl_buf_cat_char_nocheck(enc, SRL_HDR_HASHREF + n); + srl_buf_cat_char_nocheck(&enc->buf, SRL_HDR_HASHREF + n); } else { - srl_buf_cat_varint_nocheck(aTHX_ enc, SRL_HDR_HASH, n); + srl_buf_cat_varint_nocheck(aTHX_ &enc->buf, SRL_HDR_HASH, n); } if (n) { HE **he_ptr= HvARRAY(src); @@ -1388,12 +1257,12 @@ srl_dump_hk(pTHX_ srl_encoder_t *enc, HE *src, const int share_keys) const ptrdiff_t oldoffset = (ptrdiff_t)PTABLE_fetch(string_seenhash, str); if (oldoffset != 0) { /* Issue COPY instead of literal hash key string */ - srl_buf_cat_varint(aTHX_ enc, SRL_HDR_COPY, (UV)oldoffset); + srl_buf_cat_varint(aTHX_ &enc->buf, SRL_HDR_COPY, (UV)oldoffset); return; } else { /* remember current offset before advancing it */ - const ptrdiff_t newoffset = BODY_POS_OFS(enc->buf); + const ptrdiff_t newoffset = BODY_POS_OFS(&enc->buf); PTABLE_store(string_seenhash, (void *)str, INT2PTR(void *, newoffset)); } } @@ -1428,14 +1297,14 @@ srl_dump_svpv(pTHX_ srl_encoder_t *enc, SV *src) /* emit copy or alias */ if (out_tag == SRL_HDR_ALIAS) SRL_SET_TRACK_FLAG(*(enc->buf.body_pos + SvUV(ofs_sv))); - srl_buf_cat_varint(aTHX_ enc, out_tag, SvIV(ofs_sv)); + srl_buf_cat_varint(aTHX_ &enc->buf, out_tag, SvIV(ofs_sv)); return; } else if (SvUOK(ofs_sv)) { - srl_buf_cat_varint(aTHX_ enc, out_tag, SvUV(ofs_sv)); + srl_buf_cat_varint(aTHX_ &enc->buf, out_tag, SvUV(ofs_sv)); return; } else { /* start tracking this string */ - sv_setuv(ofs_sv, (UV)BODY_POS_OFS(enc->buf)); + sv_setuv(ofs_sv, (UV)BODY_POS_OFS(&enc->buf)); } } } @@ -1445,19 +1314,29 @@ srl_dump_svpv(pTHX_ srl_encoder_t *enc, SV *src) SRL_STATIC_INLINE void srl_dump_pv(pTHX_ srl_encoder_t *enc, const char* src, STRLEN src_len, int is_utf8) { - BUF_SIZE_ASSERT(enc, 1 + SRL_MAX_VARINT_LENGTH + src_len); /* overallocate a bit sometimes */ + BUF_SIZE_ASSERT(&enc->buf, 1 + SRL_MAX_VARINT_LENGTH + src_len); /* overallocate a bit sometimes */ if (is_utf8) { - srl_buf_cat_varint_nocheck(aTHX_ enc, SRL_HDR_STR_UTF8, src_len); + srl_buf_cat_varint_nocheck(aTHX_ &enc->buf, SRL_HDR_STR_UTF8, src_len); } else if (src_len <= SRL_MASK_SHORT_BINARY_LEN) { - srl_buf_cat_char_nocheck(enc, SRL_HDR_SHORT_BINARY_LOW | (char)src_len); + srl_buf_cat_char_nocheck(&enc->buf, SRL_HDR_SHORT_BINARY_LOW | (char)src_len); } else { - srl_buf_cat_varint_nocheck(aTHX_ enc, SRL_HDR_BINARY, src_len); + srl_buf_cat_varint_nocheck(aTHX_ &enc->buf, SRL_HDR_BINARY, src_len); } Copy(src, enc->buf.pos, src_len, char); enc->buf.pos += src_len; } - +#ifdef HAS_HV_BACKREFS +AV * +srl_hv_backreferences_p_safe(pTHX_ HV *hv) { + if (SvOOK(hv)) { + struct xpvhv_aux * const iter = HvAUX(hv); + return iter->xhv_backreferences; + } else { + return NULL; + } +} +#endif /* Dumps generic SVs and delegates * to more specialized functions for RVs, etc. */ @@ -1482,8 +1361,8 @@ srl_dump_sv(pTHX_ srl_encoder_t *enc, SV *src) assert(src); if (expect_false( ++enc->recursion_depth == enc->max_recursion_depth )) { - croak("Hit maximum recursion depth (%lu), aborting serialization", - (unsigned long)enc->max_recursion_depth); + croak("Hit maximum recursion depth (%"UVuf"), aborting serialization", + (UV)enc->max_recursion_depth); } redo_dump: @@ -1491,7 +1370,7 @@ redo_dump: backrefs= NULL; svt = SvTYPE(src); refcount = SvREFCNT(src); - DEBUG_ASSERT_BUF_SANE(enc); + DEBUG_ASSERT_BUF_SANE(&enc->buf); if ( SvMAGICAL(src) ) { SvGETMAGIC(src); #ifdef HAS_HV_BACKREFS @@ -1501,7 +1380,7 @@ redo_dump: } #ifdef HAS_HV_BACKREFS if (expect_false( svt == SVt_PVHV && SvOOK(src) )) { - backrefs= *Perl_hv_backreferences_p(aTHX_ (HV *)src); + backrefs= srl_hv_backreferences_p_safe(aTHX_ (HV *)src); if (DEBUGHACK) warn("backreferences %p", src); } #endif @@ -1510,11 +1389,11 @@ redo_dump: PTABLE_ENTRY_t *pe= PTABLE_find(weak_seenhash, src); if (!pe) { /* not seen it before */ - if (DEBUGHACK) warn("scalar %p - is weak referent, storing %lu", src, weakref_ofs); + if (DEBUGHACK) warn("scalar %p - is weak referent, storing %"UVuf, src, weakref_ofs); /* if weakref_ofs is false we got here some way that holds a refcount on this item */ PTABLE_store(weak_seenhash, src, INT2PTR(void *, weakref_ofs)); } else { - if (DEBUGHACK) warn("scalar %p - is weak referent, seen before value:%lu weakref_ofs:%lu", + if (DEBUGHACK) warn("scalar %p - is weak referent, seen before value:%"UVuf" weakref_ofs:%"UVuf, src, (UV)pe->value, (UV)weakref_ofs); if (pe->value) pe->value= INT2PTR(void *, weakref_ofs); @@ -1527,19 +1406,19 @@ redo_dump: * if we see it again we recognize it */ if ( expect_false( refcount > 1 ) ) { if (src == &PL_sv_undef && enc->protocol_version >=3 ) { - srl_buf_cat_char(enc, SRL_HDR_CANONICAL_UNDEF); + srl_buf_cat_char(&enc->buf, SRL_HDR_CANONICAL_UNDEF); --enc->recursion_depth; return; } else if (src == &PL_sv_yes) { - srl_buf_cat_char(enc, SRL_HDR_TRUE); + srl_buf_cat_char(&enc->buf, SRL_HDR_TRUE); --enc->recursion_depth; return; } else if (src == &PL_sv_no) { - srl_buf_cat_char(enc, SRL_HDR_FALSE); + srl_buf_cat_char(&enc->buf, SRL_HDR_FALSE); --enc->recursion_depth; return; } @@ -1549,25 +1428,27 @@ redo_dump: if (expect_false(oldoffset)) { /* we have seen it before, so we do not need to bless it again */ if (ref_rewrite_pos) { - if (DEBUGHACK) warn("ref to %p as %lu", src, (long unsigned int)oldoffset); + if (DEBUGHACK) warn("ref to %p as %"UVuf, src, (UV)oldoffset); enc->buf.pos= enc->buf.body_pos + ref_rewrite_pos; - srl_buf_cat_varint(aTHX_ enc, SRL_HDR_REFP, (UV)oldoffset); + srl_buf_cat_varint(aTHX_ &enc->buf, SRL_HDR_REFP, (UV)oldoffset); } else { - if (DEBUGHACK) warn("alias to %p as %lu", src, (long unsigned int)oldoffset); - srl_buf_cat_varint(aTHX_ enc, SRL_HDR_ALIAS, (UV)oldoffset); + if (DEBUGHACK) warn("alias to %p as %"UVuf, src, (UV)oldoffset); + srl_buf_cat_varint(aTHX_ &enc->buf, SRL_HDR_ALIAS, (UV)oldoffset); } SRL_SET_TRACK_FLAG(*(enc->buf.body_pos + oldoffset)); --enc->recursion_depth; return; } - if (DEBUGHACK) warn("storing %p as %lu", src, (long unsigned int)BODY_POS_OFS(enc->buf)); - PTABLE_store(ref_seenhash, src, INT2PTR(void *, BODY_POS_OFS(enc->buf))); + if (DEBUGHACK) warn("storing %p as %"UVuf, src, (UV)BODY_POS_OFS(&enc->buf)); + PTABLE_store(ref_seenhash, src, INT2PTR(void *, BODY_POS_OFS(&enc->buf))); } } + if (expect_false( weakref_ofs != 0 )) { sv_dump(src); - croak("Corrupted weakref? weakref_ofs=0 (this should not happen)"); + croak("Corrupted weakref? weakref_ofs should be 0, but got %"UVuf" (this should not happen)", weakref_ofs); } + if (replacement) { if (SvROK(replacement)) { src= SvRV(replacement); @@ -1606,11 +1487,11 @@ redo_dump: #endif if (expect_false( SvWEAKREF(src) )) { if (DEBUGHACK) warn("Is weakref %p", src); - weakref_ofs= BODY_POS_OFS(enc->buf); - srl_buf_cat_char(enc, SRL_HDR_WEAKEN); + weakref_ofs= BODY_POS_OFS(&enc->buf); + srl_buf_cat_char(&enc->buf, SRL_HDR_WEAKEN); } - ref_rewrite_pos= BODY_POS_OFS(enc->buf); + ref_rewrite_pos= BODY_POS_OFS(&enc->buf); if (expect_false( sv_isobject(src) )) { /* Write bless operator with class name */ @@ -1618,7 +1499,7 @@ redo_dump: srl_dump_classname(aTHX_ enc, referent, replacement); /* 1 == have freeze call */ } - srl_buf_cat_char(enc, SRL_HDR_REFN); + srl_buf_cat_char(&enc->buf, SRL_HDR_REFN); refsv= src; src= referent; @@ -1663,7 +1544,7 @@ redo_dump: PTABLE_delete(ref_seenhash, src); \ enc->buf.pos= enc->buf.body_pos + ref_rewrite_pos; \ } \ - srl_buf_cat_char((enc), SRL_HDR_UNDEF); \ + srl_buf_cat_char(&(enc)->buf, SRL_HDR_UNDEF); \ } \ else if ( SRL_ENC_HAVE_OPTION((enc), SRL_F_STRINGIFY_UNKNOWN) ) { \ STRLEN len; \ @@ -1703,9 +1584,9 @@ redo_dump: SRL_HANDLE_UNSUPPORTED_TYPE(enc, src, svt, refsv, ref_rewrite_pos); } else if (src == &PL_sv_undef && enc->protocol_version >= 3 ) { - srl_buf_cat_char(enc, SRL_HDR_CANONICAL_UNDEF); + srl_buf_cat_char(&enc->buf, SRL_HDR_CANONICAL_UNDEF); } else { - srl_buf_cat_char(enc, SRL_HDR_UNDEF); + srl_buf_cat_char(&enc->buf, SRL_HDR_UNDEF); } } else { diff --git a/srl_encoder.h b/srl_encoder.h index 6297ec1..7d1634b 100644 --- a/srl_encoder.h +++ b/srl_encoder.h @@ -39,8 +39,14 @@ typedef struct { SV *sereal_string_sv; /* SV that says "Sereal" for FREEZE support */ } srl_encoder_t; +typedef struct { + SV *sv; + U32 hash; +} sv_with_hash; + /* constructor from options */ -srl_encoder_t *srl_build_encoder_struct(pTHX_ HV *opt); +srl_encoder_t *srl_build_encoder_struct(pTHX_ HV *opt, sv_with_hash *options); + /* clone; "constructor from prototype" */ srl_encoder_t *srl_build_encoder_struct_alike(pTHX_ srl_encoder_t *proto); @@ -50,7 +56,7 @@ void srl_clear_encoder(pTHX_ srl_encoder_t *enc); void srl_destroy_encoder(pTHX_ srl_encoder_t *enc); /* Write Sereal packet header to output buffer */ -void srl_write_header(pTHX_ srl_encoder_t *enc, SV *user_header_src); +void srl_write_header(pTHX_ srl_encoder_t *enc, SV *user_header_src, const U32 compress_flags); /* Start dumping a top-level SV */ SV *srl_dump_data_structure_mortal_sv(pTHX_ srl_encoder_t *enc, SV *src, SV *user_header_src, const U32 flags); @@ -77,14 +83,10 @@ SV *srl_dump_data_structure_mortal_sv(pTHX_ srl_encoder_t *enc, SV *src, SV *use * set since we otherwise croak. Corresponds to the 'warn_unknown' option. */ #define SRL_F_WARN_UNKNOWN 0x00020UL -/* WARNING: This is different from the protocol bit SRL_PROTOCOL_ENCODING_SNAPPY in that it's - * a flag on the encoder struct indicating that we want to use Snappy. */ -#define SRL_F_COMPRESS_SNAPPY 0x00040UL -#define SRL_F_COMPRESS_SNAPPY_INCREMENTAL 0x00080UL - -/* WARNING: This is different from the protocol bit SRL_PROTOCOL_ENCODING_ZLIB in that it's - * a flag on the encoder struct indicating that we want to use ZLIB. */ -#define SRL_F_COMPRESS_ZLIB 0x00100UL +/* WARNING: SRL_F_COMPRESS_SNAPPY 0x00040UL + * SRL_F_COMPRESS_SNAPPY_INCREMENTAL 0x00080UL + * SRL_F_COMPRESS_ZLIB 0x00100UL + * are moved to srl_compress.h */ /* Only meaningful if SRL_F_WARN_UNKNOWN also set. If this one is set, then we don't warn * if the unsupported item has string overloading. */ @@ -130,4 +132,82 @@ SV *srl_dump_data_structure_mortal_sv(pTHX_ srl_encoder_t *enc, SV *src, SV *use #define SRL_ENC_SV_COPY_ALWAYS 0x00000000UL #define SRL_ENC_SV_REUSE_MAYBE 0x00000001UL +/* by default we do not allow people to build with support for SRL_HDR_LONG_DOUBLE */ +#if defined(SRL_ALLOW_LONG_DOUBLE) && defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) +#define SRL_DO_LONG_DOUBLE 1 +#else +#define SRL_DO_LONG_DOUBLE 0 +#endif + +/* Options Parsing related code */ +#define SRL_INIT_OPTION(idx, str) STMT_START { \ + MY_CXT.options[idx].sv = newSVpvn((str ""), (sizeof(str) - 1)); \ + PERL_HASH(MY_CXT.options[idx].hash, (str ""), (sizeof(str) - 1)); \ +} STMT_END + +#define SRL_ENC_OPT_STR_ALIASED_DEDUPE_STRINGS "aliased_dedupe_strings" +#define SRL_ENC_OPT_IDX_ALIASED_DEDUPE_STRINGS 0 + +#define SRL_ENC_OPT_STR_CANONICAL "canonical" +#define SRL_ENC_OPT_IDX_CANONICAL 1 + +#define SRL_ENC_OPT_STR_CANONICAL_REFS "canonical_refs" +#define SRL_ENC_OPT_IDX_CANONICAL_REFS 2 + +#define SRL_ENC_OPT_STR_COMPRESS "compress" +#define SRL_ENC_OPT_IDX_COMPRESS 3 + +#define SRL_ENC_OPT_STR_COMPRESS_LEVEL "compress_level" +#define SRL_ENC_OPT_IDX_COMPRESS_LEVEL 4 + +#define SRL_ENC_OPT_STR_COMPRESS_THRESHOLD "compress_threshold" +#define SRL_ENC_OPT_IDX_COMPRESS_THRESHOLD 5 + +#define SRL_ENC_OPT_STR_CROAK_ON_BLESS "croak_on_bless" +#define SRL_ENC_OPT_IDX_CROAK_ON_BLESS 6 + +#define SRL_ENC_OPT_STR_DEDUPE_STRINGS "dedupe_strings" +#define SRL_ENC_OPT_IDX_DEDUPE_STRINGS 7 + +#define SRL_ENC_OPT_STR_FREEZE_CALLBACKS "freeze_callbacks" +#define SRL_ENC_OPT_IDX_FREEZE_CALLBACKS 8 + +#define SRL_ENC_OPT_STR_MAX_RECURSION_DEPTH "max_recursion_depth" +#define SRL_ENC_OPT_IDX_MAX_RECURSION_DEPTH 9 + +#define SRL_ENC_OPT_STR_NO_BLESS_OBJECTS "no_bless_objects" +#define SRL_ENC_OPT_IDX_NO_BLESS_OBJECTS 10 + +#define SRL_ENC_OPT_STR_NO_SHARED_HASHKEYS "no_shared_hashkeys" +#define SRL_ENC_OPT_IDX_NO_SHARED_HASHKEYS 11 + +#define SRL_ENC_OPT_STR_PROTOCOL_VERSION "protocol_version" +#define SRL_ENC_OPT_IDX_PROTOCOL_VERSION 12 + +#define SRL_ENC_OPT_STR_SNAPPY "snappy" +#define SRL_ENC_OPT_IDX_SNAPPY 13 + +#define SRL_ENC_OPT_STR_SNAPPY_INCR "snappy_incr" +#define SRL_ENC_OPT_IDX_SNAPPY_INCR 14 + +#define SRL_ENC_OPT_STR_SNAPPY_THRESHOLD "snappy_threshold" +#define SRL_ENC_OPT_IDX_SNAPPY_THRESHOLD 15 + +#define SRL_ENC_OPT_STR_SORT_KEYS "sort_keys" +#define SRL_ENC_OPT_IDX_SORT_KEYS 16 + +#define SRL_ENC_OPT_STR_STRINGIFY_UNKNOWN "stringify_unknown" +#define SRL_ENC_OPT_IDX_STRINGIFY_UNKNOWN 17 + +#define SRL_ENC_OPT_STR_UNDEF_UNKNOWN "undef_unknown" +#define SRL_ENC_OPT_IDX_UNDEF_UNKNOWN 18 + +#define SRL_ENC_OPT_STR_USE_PROTOCOL_V1 "use_protocol_v1" +#define SRL_ENC_OPT_IDX_USE_PROTOCOL_V1 19 + +#define SRL_ENC_OPT_STR_WARN_UNKNOWN "warn_unknown" +#define SRL_ENC_OPT_IDX_WARN_UNKNOWN 20 + +#define SRL_ENC_OPT_COUNT 21 + #endif diff --git a/srl_error.h b/srl_error.h new file mode 100644 index 0000000..2b13fa2 --- /dev/null +++ b/srl_error.h @@ -0,0 +1,28 @@ +#ifndef SRL_ERROR_H_ +#define SRL_ERROR_H_ +#include "srl_taginfo.h" + +#define SRL_BASE_ERROR_FORMAT "Sereal: Error in %s line %u and char %i of input: " +#define SRL_BASE_ERROR_ARGS __FILE__, __LINE__, (int) (1 + dec->pos - dec->buf_start) + +#define SRL_ERROR(msg) croak(SRL_BASE_ERROR_FORMAT "%s", SRL_BASE_ERROR_ARGS, (msg)) +#define SRL_ERRORf1(fmt,var) croak(SRL_BASE_ERROR_FORMAT fmt, SRL_BASE_ERROR_ARGS, (var)) +#define SRL_ERRORf2(fmt,var1,var2) croak(SRL_BASE_ERROR_FORMAT fmt, SRL_BASE_ERROR_ARGS, (var1), (var2)) +#define SRL_ERRORf3(fmt,var1,var2,var3) croak(SRL_BASE_ERROR_FORMAT fmt, SRL_BASE_ERROR_ARGS, (var1), (var2), (var3)) +#define SRL_ERRORf4(fmt,var1,var2,var3,var4) croak(SRL_BASE_ERROR_FORMAT fmt, SRL_BASE_ERROR_ARGS, (var1), (var2), (var3), (var4)) + +#define SRL_ERROR_UNIMPLEMENTED(dec,tag,str) \ + SRL_ERRORf3("Tag %u %s is unimplemented at ofs: %lu", (tag), (str), (unsigned long) BUF_POS_OFS(dec)) + +#define SRL_ERROR_UNTERMINATED(dec,tag,str) \ + SRL_ERRORf4("Tag SRL_HDR_%s %s was not terminated properly at ofs %lu with %lu to go", \ + tag_name[(tag) & 127], (str), (dec)->pos - (dec)->buf_start, (dec)->buf_end - (dec)->pos) + +#define SRL_ERROR_BAD_COPY(dec, tag) \ + SRL_ERRORf1("While processing tag SRL_HDR_%s encountered a bad COPY tag", tag_name[(tag) & 127]) + +#define SRL_ERROR_UNEXPECTED(dec, tag, msg) SRL_ERRORf2("Unexpected tag %s while expecting %s", tag_name[(tag) & 127], msg) +#define SRL_ERROR_REFUSE_OBJECT() SRL_ERROR("Encountered object in input, but the 'refuse_objects' option is in effect"); +#define SRL_ERROR_PANIC(dec, msg) SRL_ERRORf1("Panic: %s", msg); + +#endif diff --git a/srl_protocol.h b/srl_protocol.h index a297766..2917d2d 100644 --- a/srl_protocol.h +++ b/srl_protocol.h @@ -1,5 +1,5 @@ -#ifndef SRL_PROTOCOL_H_ -#define SRL_PROTOCOL_H_ +#ifndef SEEN_SRL_PROTOCOL_H_ +#define SEEN_SRL_PROTOCOL_H_ /* =for autoupdater start @@ -159,7 +159,7 @@ #define SRL_PROTOCOL_VERSION_BITS ( 4 ) /* how many bits we use for the version, the rest go to the encoding */ #define SRL_PROTOCOL_VERSION_MASK ( ( 1 << SRL_PROTOCOL_VERSION_BITS ) - 1 ) -#define SRL_PROTOCOL_ENCODING_MASK ( ~SRL_PROTOCOL_VERSION_MASK ) +#define SRL_PROTOCOL_ENCODING_MASK ( SRL_PROTOCOL_VERSION_MASK << SRL_PROTOCOL_VERSION_BITS ) #define SRL_PROTOCOL_ENCODING_RAW ( 0 << SRL_PROTOCOL_VERSION_BITS ) #define SRL_PROTOCOL_ENCODING_SNAPPY ( 1 << SRL_PROTOCOL_VERSION_BITS ) #define SRL_PROTOCOL_ENCODING_SNAPPY_INCREMENTAL ( 2 << SRL_PROTOCOL_VERSION_BITS ) @@ -178,71 +178,71 @@ /* _LOW and _HIGH versions refering to INCLUSIVE range boundaries */ -#define SRL_HDR_POS ((char)0) /* small positive integer - value in low 4 bits (identity) */ -#define SRL_HDR_POS_LOW ((char)0) /* small positive integer - value in low 4 bits (identity) */ -#define SRL_HDR_POS_HIGH ((char)15) /* small positive integer - value in low 4 bits (identity) */ +#define SRL_HDR_POS ((U8)0) /* small positive integer - value in low 4 bits (identity) */ +#define SRL_HDR_POS_LOW ((U8)0) /* small positive integer - value in low 4 bits (identity) */ +#define SRL_HDR_POS_HIGH ((U8)15) /* small positive integer - value in low 4 bits (identity) */ -#define SRL_HDR_NEG ((char)16) /* small negative integer - value in low 4 bits (k+32) */ -#define SRL_HDR_NEG_LOW ((char)16) /* small negative integer - value in low 4 bits (k+32) */ -#define SRL_HDR_NEG_HIGH ((char)31) /* small negative integer - value in low 4 bits (k+32) */ +#define SRL_HDR_NEG ((U8)16) /* small negative integer - value in low 4 bits (k+32) */ +#define SRL_HDR_NEG_LOW ((U8)16) /* small negative integer - value in low 4 bits (k+32) */ +#define SRL_HDR_NEG_HIGH ((U8)31) /* small negative integer - value in low 4 bits (k+32) */ -#define SRL_HDR_VARINT ((char)32) /* - Varint variable length integer */ -#define SRL_HDR_ZIGZAG ((char)33) /* - Zigzag variable length integer */ -#define SRL_HDR_FLOAT ((char)34) /* */ -#define SRL_HDR_DOUBLE ((char)35) /* */ -#define SRL_HDR_LONG_DOUBLE ((char)36) /* */ -#define SRL_HDR_UNDEF ((char)37) /* None - Perl undef var; eg my $var= undef; */ -#define SRL_HDR_BINARY ((char)38) /* - binary/(latin1) string */ -#define SRL_HDR_STR_UTF8 ((char)39) /* - utf8 string */ +#define SRL_HDR_VARINT ((U8)32) /* - Varint variable length integer */ +#define SRL_HDR_ZIGZAG ((U8)33) /* - Zigzag variable length integer */ +#define SRL_HDR_FLOAT ((U8)34) /* */ +#define SRL_HDR_DOUBLE ((U8)35) /* */ +#define SRL_HDR_LONG_DOUBLE ((U8)36) /* */ +#define SRL_HDR_UNDEF ((U8)37) /* None - Perl undef var; eg my $var= undef; */ +#define SRL_HDR_BINARY ((U8)38) /* - binary/(latin1) string */ +#define SRL_HDR_STR_UTF8 ((U8)39) /* - utf8 string */ -#define SRL_HDR_REFN ((char)40) /* - ref to next item */ -#define SRL_HDR_REFP ((char)41) /* - ref to previous item stored at offset */ -#define SRL_HDR_HASH ((char)42) /* [ ...] - count followed by key/value pairs */ -#define SRL_HDR_ARRAY ((char)43) /* [ ...] - count followed by items */ -#define SRL_HDR_OBJECT ((char)44) /* - class, object-item */ -#define SRL_HDR_OBJECTV ((char)45) /* - offset of previously used classname tag - object-item */ -#define SRL_HDR_ALIAS ((char)46) /* - alias to item defined at offset */ -#define SRL_HDR_COPY ((char)47) /* - copy of item defined at offset */ +#define SRL_HDR_REFN ((U8)40) /* - ref to next item */ +#define SRL_HDR_REFP ((U8)41) /* - ref to previous item stored at offset */ +#define SRL_HDR_HASH ((U8)42) /* [ ...] - count followed by key/value pairs */ +#define SRL_HDR_ARRAY ((U8)43) /* [ ...] - count followed by items */ +#define SRL_HDR_OBJECT ((U8)44) /* - class, object-item */ +#define SRL_HDR_OBJECTV ((U8)45) /* - offset of previously used classname tag - object-item */ +#define SRL_HDR_ALIAS ((U8)46) /* - alias to item defined at offset */ +#define SRL_HDR_COPY ((U8)47) /* - copy of item defined at offset */ -#define SRL_HDR_WEAKEN ((char)48) /* - Weaken the following reference */ -#define SRL_HDR_REGEXP ((char)49) /* */ +#define SRL_HDR_WEAKEN ((U8)48) /* - Weaken the following reference */ +#define SRL_HDR_REGEXP ((U8)49) /* */ -#define SRL_HDR_OBJECT_FREEZE ((char)50) /* - class, object-item. Need to call "THAW" method on class after decoding */ -#define SRL_HDR_OBJECTV_FREEZE ((char)51) /* - (OBJECTV_FREEZE is to OBJECT_FREEZE as OBJECTV is to OBJECT) */ +#define SRL_HDR_OBJECT_FREEZE ((U8)50) /* - class, object-item. Need to call "THAW" method on class after decoding */ +#define SRL_HDR_OBJECTV_FREEZE ((U8)51) /* - (OBJECTV_FREEZE is to OBJECT_FREEZE as OBJECTV is to OBJECT) */ /* Note: Can do reserved check with a range now, but as we start using * them, might have to explicit == check later. */ -#define SRL_HDR_RESERVED ((char)52) /* reserved */ -#define SRL_HDR_RESERVED_LOW ((char)52) -#define SRL_HDR_RESERVED_HIGH ((char)56) +#define SRL_HDR_RESERVED ((U8)52) /* reserved */ +#define SRL_HDR_RESERVED_LOW ((U8)52) +#define SRL_HDR_RESERVED_HIGH ((U8)56) -#define SRL_HDR_CANONICAL_UNDEF ((char)57) /* undef (PL_sv_undef) - "the" Perl undef (see notes) */ -#define SRL_HDR_FALSE ((char)58) /* false (PL_sv_no) */ -#define SRL_HDR_TRUE ((char)59) /* true (PL_sv_yes) */ +#define SRL_HDR_CANONICAL_UNDEF ((U8)57) /* undef (PL_sv_undef) - "the" Perl undef (see notes) */ +#define SRL_HDR_FALSE ((U8)58) /* false (PL_sv_no) */ +#define SRL_HDR_TRUE ((U8)59) /* true (PL_sv_yes) */ -#define SRL_HDR_MANY ((char)60) /* - repeated tag (not done yet, will be implemented in version 3) */ -#define SRL_HDR_PACKET_START ((char)61) /* (first byte of magic string in header) */ +#define SRL_HDR_MANY ((U8)60) /* - repeated tag (not done yet, will be implemented in version 3) */ +#define SRL_HDR_PACKET_START ((U8)61) /* (first byte of magic string in header) */ -#define SRL_HDR_EXTEND ((char)62) /* - for additional tags */ -#define SRL_HDR_PAD ((char)63) /* (ignored tag, skip to next byte) */ -#define SRL_HDR_ARRAYREF ((char)64) /* [ ...] - count of items in low 4 bits (ARRAY must be refcnt=1)*/ -#define SRL_MASK_ARRAYREF_COUNT ((char)15) /* mask to get low bits from tag */ -#define SRL_HDR_ARRAYREF_LOW ((char)64) -#define SRL_HDR_ARRAYREF_HIGH ((char)79) +#define SRL_HDR_EXTEND ((U8)62) /* - for additional tags */ +#define SRL_HDR_PAD ((U8)63) /* (ignored tag, skip to next byte) */ +#define SRL_HDR_ARRAYREF ((U8)64) /* [ ...] - count of items in low 4 bits (ARRAY must be refcnt=1)*/ +#define SRL_MASK_ARRAYREF_COUNT ((U8)15) /* mask to get low bits from tag */ +#define SRL_HDR_ARRAYREF_LOW ((U8)64) +#define SRL_HDR_ARRAYREF_HIGH ((U8)79) -#define SRL_HDR_HASHREF ((char)80) /* [ ...] - count in low 4 bits, key/value pairs (HASH must be refcnt=1)*/ -#define SRL_MASK_HASHREF_COUNT ((char)15) /* mask to get low bits from tag */ -#define SRL_HDR_HASHREF_LOW ((char)80) -#define SRL_HDR_HASHREF_HIGH ((char)95) +#define SRL_HDR_HASHREF ((U8)80) /* [ ...] - count in low 4 bits, key/value pairs (HASH must be refcnt=1)*/ +#define SRL_MASK_HASHREF_COUNT ((U8)15) /* mask to get low bits from tag */ +#define SRL_HDR_HASHREF_LOW ((U8)80) +#define SRL_HDR_HASHREF_HIGH ((U8)95) -#define SRL_HDR_SHORT_BINARY ((char)96) /* - binary/latin1 string, length encoded in low 5 bits of tag */ -#define SRL_HDR_SHORT_BINARY_LOW ((char)96) -#define SRL_HDR_SHORT_BINARY_HIGH ((char)127) -#define SRL_MASK_SHORT_BINARY_LEN ((char)31) /* mask to get length of SRL_HDR_SHORT_BINARY type tags */ +#define SRL_HDR_SHORT_BINARY ((U8)96) /* - binary/latin1 string, length encoded in low 5 bits of tag */ +#define SRL_HDR_SHORT_BINARY_LOW ((U8)96) +#define SRL_HDR_SHORT_BINARY_HIGH ((U8)127) +#define SRL_MASK_SHORT_BINARY_LEN ((U8)31) /* mask to get length of SRL_HDR_SHORT_BINARY type tags */ -#define SRL_HDR_TRACK_FLAG ((char)128) /* if this bit is set track the item */ +#define SRL_HDR_TRACK_FLAG ((U8)128) /* if this bit is set track the item */ /* TODO */ diff --git a/srl_taginfo.h b/srl_taginfo.h new file mode 100644 index 0000000..9c130ed --- /dev/null +++ b/srl_taginfo.h @@ -0,0 +1,369 @@ +#ifndef SRL_TAGINFO_H +#define SRL_TAGINFO_H +/* + +=for autoupdater start + +* NOTE this section is autoupdated by author_tools/update_from_header.pl +*/ + +static const char * const tag_name[] = { + "POS_0", /* 0 0x00 0b00000000 */ + "POS_1", /* 1 0x01 0b00000001 */ + "POS_2", /* 2 0x02 0b00000010 */ + "POS_3", /* 3 0x03 0b00000011 */ + "POS_4", /* 4 0x04 0b00000100 */ + "POS_5", /* 5 0x05 0b00000101 */ + "POS_6", /* 6 0x06 0b00000110 */ + "POS_7", /* "\a" 7 0x07 0b00000111 */ + "POS_8", /* "\b" 8 0x08 0b00001000 */ + "POS_9", /* "\t" 9 0x09 0b00001001 */ + "POS_10", /* "\n" 10 0x0a 0b00001010 */ + "POS_11", /* 11 0x0b 0b00001011 */ + "POS_12", /* "\f" 12 0x0c 0b00001100 */ + "POS_13", /* "\r" 13 0x0d 0b00001101 */ + "POS_14", /* 14 0x0e 0b00001110 */ + "POS_15", /* 15 0x0f 0b00001111 */ + "NEG_16", /* 16 0x10 0b00010000 */ + "NEG_15", /* 17 0x11 0b00010001 */ + "NEG_14", /* 18 0x12 0b00010010 */ + "NEG_13", /* 19 0x13 0b00010011 */ + "NEG_12", /* 20 0x14 0b00010100 */ + "NEG_11", /* 21 0x15 0b00010101 */ + "NEG_10", /* 22 0x16 0b00010110 */ + "NEG_9", /* 23 0x17 0b00010111 */ + "NEG_8", /* 24 0x18 0b00011000 */ + "NEG_7", /* 25 0x19 0b00011001 */ + "NEG_6", /* 26 0x1a 0b00011010 */ + "NEG_5", /* "\e" 27 0x1b 0b00011011 */ + "NEG_4", /* 28 0x1c 0b00011100 */ + "NEG_3", /* 29 0x1d 0b00011101 */ + "NEG_2", /* 30 0x1e 0b00011110 */ + "NEG_1", /* 31 0x1f 0b00011111 */ + "VARINT", /* " " 32 0x20 0b00100000 */ + "ZIGZAG", /* "!" 33 0x21 0b00100001 */ + "FLOAT", /* "\"" 34 0x22 0b00100010 */ + "DOUBLE", /* "#" 35 0x23 0b00100011 */ + "LONG_DOUBLE", /* "\$" 36 0x24 0b00100100 */ + "UNDEF", /* "%" 37 0x25 0b00100101 */ + "BINARY", /* "&" 38 0x26 0b00100110 */ + "STR_UTF8", /* "'" 39 0x27 0b00100111 */ + "REFN", /* "(" 40 0x28 0b00101000 */ + "REFP", /* ")" 41 0x29 0b00101001 */ + "HASH", /* "*" 42 0x2a 0b00101010 */ + "ARRAY", /* "+" 43 0x2b 0b00101011 */ + "OBJECT", /* "," 44 0x2c 0b00101100 */ + "OBJECTV", /* "-" 45 0x2d 0b00101101 */ + "ALIAS", /* "." 46 0x2e 0b00101110 */ + "COPY", /* "/" 47 0x2f 0b00101111 */ + "WEAKEN", /* "0" 48 0x30 0b00110000 */ + "REGEXP", /* "1" 49 0x31 0b00110001 */ + "OBJECT_FREEZE", /* "2" 50 0x32 0b00110010 */ + "OBJECTV_FREEZE", /* "3" 51 0x33 0b00110011 */ + "RESERVED_0", /* "4" 52 0x34 0b00110100 */ + "RESERVED_1", /* "5" 53 0x35 0b00110101 */ + "RESERVED_2", /* "6" 54 0x36 0b00110110 */ + "RESERVED_3", /* "7" 55 0x37 0b00110111 */ + "RESERVED_4", /* "8" 56 0x38 0b00111000 */ + "CANONICAL_UNDEF", /* "9" 57 0x39 0b00111001 */ + "FALSE", /* ":" 58 0x3a 0b00111010 */ + "TRUE", /* ";" 59 0x3b 0b00111011 */ + "MANY", /* "<" 60 0x3c 0b00111100 */ + "PACKET_START", /* "=" 61 0x3d 0b00111101 */ + "EXTEND", /* ">" 62 0x3e 0b00111110 */ + "PAD", /* "?" 63 0x3f 0b00111111 */ + "ARRAYREF_0", /* "\@" 64 0x40 0b01000000 */ + "ARRAYREF_1", /* "A" 65 0x41 0b01000001 */ + "ARRAYREF_2", /* "B" 66 0x42 0b01000010 */ + "ARRAYREF_3", /* "C" 67 0x43 0b01000011 */ + "ARRAYREF_4", /* "D" 68 0x44 0b01000100 */ + "ARRAYREF_5", /* "E" 69 0x45 0b01000101 */ + "ARRAYREF_6", /* "F" 70 0x46 0b01000110 */ + "ARRAYREF_7", /* "G" 71 0x47 0b01000111 */ + "ARRAYREF_8", /* "H" 72 0x48 0b01001000 */ + "ARRAYREF_9", /* "I" 73 0x49 0b01001001 */ + "ARRAYREF_10", /* "J" 74 0x4a 0b01001010 */ + "ARRAYREF_11", /* "K" 75 0x4b 0b01001011 */ + "ARRAYREF_12", /* "L" 76 0x4c 0b01001100 */ + "ARRAYREF_13", /* "M" 77 0x4d 0b01001101 */ + "ARRAYREF_14", /* "N" 78 0x4e 0b01001110 */ + "ARRAYREF_15", /* "O" 79 0x4f 0b01001111 */ + "HASHREF_0", /* "P" 80 0x50 0b01010000 */ + "HASHREF_1", /* "Q" 81 0x51 0b01010001 */ + "HASHREF_2", /* "R" 82 0x52 0b01010010 */ + "HASHREF_3", /* "S" 83 0x53 0b01010011 */ + "HASHREF_4", /* "T" 84 0x54 0b01010100 */ + "HASHREF_5", /* "U" 85 0x55 0b01010101 */ + "HASHREF_6", /* "V" 86 0x56 0b01010110 */ + "HASHREF_7", /* "W" 87 0x57 0b01010111 */ + "HASHREF_8", /* "X" 88 0x58 0b01011000 */ + "HASHREF_9", /* "Y" 89 0x59 0b01011001 */ + "HASHREF_10", /* "Z" 90 0x5a 0b01011010 */ + "HASHREF_11", /* "[" 91 0x5b 0b01011011 */ + "HASHREF_12", /* "\\" 92 0x5c 0b01011100 */ + "HASHREF_13", /* "]" 93 0x5d 0b01011101 */ + "HASHREF_14", /* "^" 94 0x5e 0b01011110 */ + "HASHREF_15", /* "_" 95 0x5f 0b01011111 */ + "SHORT_BINARY_0", /* "`" 96 0x60 0b01100000 */ + "SHORT_BINARY_1", /* "a" 97 0x61 0b01100001 */ + "SHORT_BINARY_2", /* "b" 98 0x62 0b01100010 */ + "SHORT_BINARY_3", /* "c" 99 0x63 0b01100011 */ + "SHORT_BINARY_4", /* "d" 100 0x64 0b01100100 */ + "SHORT_BINARY_5", /* "e" 101 0x65 0b01100101 */ + "SHORT_BINARY_6", /* "f" 102 0x66 0b01100110 */ + "SHORT_BINARY_7", /* "g" 103 0x67 0b01100111 */ + "SHORT_BINARY_8", /* "h" 104 0x68 0b01101000 */ + "SHORT_BINARY_9", /* "i" 105 0x69 0b01101001 */ + "SHORT_BINARY_10", /* "j" 106 0x6a 0b01101010 */ + "SHORT_BINARY_11", /* "k" 107 0x6b 0b01101011 */ + "SHORT_BINARY_12", /* "l" 108 0x6c 0b01101100 */ + "SHORT_BINARY_13", /* "m" 109 0x6d 0b01101101 */ + "SHORT_BINARY_14", /* "n" 110 0x6e 0b01101110 */ + "SHORT_BINARY_15", /* "o" 111 0x6f 0b01101111 */ + "SHORT_BINARY_16", /* "p" 112 0x70 0b01110000 */ + "SHORT_BINARY_17", /* "q" 113 0x71 0b01110001 */ + "SHORT_BINARY_18", /* "r" 114 0x72 0b01110010 */ + "SHORT_BINARY_19", /* "s" 115 0x73 0b01110011 */ + "SHORT_BINARY_20", /* "t" 116 0x74 0b01110100 */ + "SHORT_BINARY_21", /* "u" 117 0x75 0b01110101 */ + "SHORT_BINARY_22", /* "v" 118 0x76 0b01110110 */ + "SHORT_BINARY_23", /* "w" 119 0x77 0b01110111 */ + "SHORT_BINARY_24", /* "x" 120 0x78 0b01111000 */ + "SHORT_BINARY_25", /* "y" 121 0x79 0b01111001 */ + "SHORT_BINARY_26", /* "z" 122 0x7a 0b01111010 */ + "SHORT_BINARY_27", /* "{" 123 0x7b 0b01111011 */ + "SHORT_BINARY_28", /* "|" 124 0x7c 0b01111100 */ + "SHORT_BINARY_29", /* "}" 125 0x7d 0b01111101 */ + "SHORT_BINARY_30", /* "~" 126 0x7e 0b01111110 */ + "SHORT_BINARY_31" /* 127 0x7f 0b01111111 */ +}; + +#define SRL_HDR_POS_0 0 +#define SRL_HDR_POS_1 1 +#define SRL_HDR_POS_2 2 +#define SRL_HDR_POS_3 3 +#define SRL_HDR_POS_4 4 +#define SRL_HDR_POS_5 5 +#define SRL_HDR_POS_6 6 +#define SRL_HDR_POS_7 7 +#define SRL_HDR_POS_8 8 +#define SRL_HDR_POS_9 9 +#define SRL_HDR_POS_10 10 +#define SRL_HDR_POS_11 11 +#define SRL_HDR_POS_12 12 +#define SRL_HDR_POS_13 13 +#define SRL_HDR_POS_14 14 +#define SRL_HDR_POS_15 15 +#define SRL_HDR_NEG_16 16 +#define SRL_HDR_NEG_15 17 +#define SRL_HDR_NEG_14 18 +#define SRL_HDR_NEG_13 19 +#define SRL_HDR_NEG_12 20 +#define SRL_HDR_NEG_11 21 +#define SRL_HDR_NEG_10 22 +#define SRL_HDR_NEG_9 23 +#define SRL_HDR_NEG_8 24 +#define SRL_HDR_NEG_7 25 +#define SRL_HDR_NEG_6 26 +#define SRL_HDR_NEG_5 27 +#define SRL_HDR_NEG_4 28 +#define SRL_HDR_NEG_3 29 +#define SRL_HDR_NEG_2 30 +#define SRL_HDR_NEG_1 31 +#define SRL_HDR_RESERVED_0 52 +#define SRL_HDR_RESERVED_1 53 +#define SRL_HDR_RESERVED_2 54 +#define SRL_HDR_RESERVED_3 55 +#define SRL_HDR_RESERVED_4 56 +#define SRL_HDR_ARRAYREF_0 64 +#define SRL_HDR_ARRAYREF_1 65 +#define SRL_HDR_ARRAYREF_2 66 +#define SRL_HDR_ARRAYREF_3 67 +#define SRL_HDR_ARRAYREF_4 68 +#define SRL_HDR_ARRAYREF_5 69 +#define SRL_HDR_ARRAYREF_6 70 +#define SRL_HDR_ARRAYREF_7 71 +#define SRL_HDR_ARRAYREF_8 72 +#define SRL_HDR_ARRAYREF_9 73 +#define SRL_HDR_ARRAYREF_10 74 +#define SRL_HDR_ARRAYREF_11 75 +#define SRL_HDR_ARRAYREF_12 76 +#define SRL_HDR_ARRAYREF_13 77 +#define SRL_HDR_ARRAYREF_14 78 +#define SRL_HDR_ARRAYREF_15 79 +#define SRL_HDR_HASHREF_0 80 +#define SRL_HDR_HASHREF_1 81 +#define SRL_HDR_HASHREF_2 82 +#define SRL_HDR_HASHREF_3 83 +#define SRL_HDR_HASHREF_4 84 +#define SRL_HDR_HASHREF_5 85 +#define SRL_HDR_HASHREF_6 86 +#define SRL_HDR_HASHREF_7 87 +#define SRL_HDR_HASHREF_8 88 +#define SRL_HDR_HASHREF_9 89 +#define SRL_HDR_HASHREF_10 90 +#define SRL_HDR_HASHREF_11 91 +#define SRL_HDR_HASHREF_12 92 +#define SRL_HDR_HASHREF_13 93 +#define SRL_HDR_HASHREF_14 94 +#define SRL_HDR_HASHREF_15 95 +#define SRL_HDR_SHORT_BINARY_0 96 +#define SRL_HDR_SHORT_BINARY_1 97 +#define SRL_HDR_SHORT_BINARY_2 98 +#define SRL_HDR_SHORT_BINARY_3 99 +#define SRL_HDR_SHORT_BINARY_4 100 +#define SRL_HDR_SHORT_BINARY_5 101 +#define SRL_HDR_SHORT_BINARY_6 102 +#define SRL_HDR_SHORT_BINARY_7 103 +#define SRL_HDR_SHORT_BINARY_8 104 +#define SRL_HDR_SHORT_BINARY_9 105 +#define SRL_HDR_SHORT_BINARY_10 106 +#define SRL_HDR_SHORT_BINARY_11 107 +#define SRL_HDR_SHORT_BINARY_12 108 +#define SRL_HDR_SHORT_BINARY_13 109 +#define SRL_HDR_SHORT_BINARY_14 110 +#define SRL_HDR_SHORT_BINARY_15 111 +#define SRL_HDR_SHORT_BINARY_16 112 +#define SRL_HDR_SHORT_BINARY_17 113 +#define SRL_HDR_SHORT_BINARY_18 114 +#define SRL_HDR_SHORT_BINARY_19 115 +#define SRL_HDR_SHORT_BINARY_20 116 +#define SRL_HDR_SHORT_BINARY_21 117 +#define SRL_HDR_SHORT_BINARY_22 118 +#define SRL_HDR_SHORT_BINARY_23 119 +#define SRL_HDR_SHORT_BINARY_24 120 +#define SRL_HDR_SHORT_BINARY_25 121 +#define SRL_HDR_SHORT_BINARY_26 122 +#define SRL_HDR_SHORT_BINARY_27 123 +#define SRL_HDR_SHORT_BINARY_28 124 +#define SRL_HDR_SHORT_BINARY_29 125 +#define SRL_HDR_SHORT_BINARY_30 126 +#define SRL_HDR_SHORT_BINARY_31 127 + +#define CASE_SRL_HDR_ARRAYREF \ + case SRL_HDR_ARRAYREF_0: \ + case SRL_HDR_ARRAYREF_1: \ + case SRL_HDR_ARRAYREF_2: \ + case SRL_HDR_ARRAYREF_3: \ + case SRL_HDR_ARRAYREF_4: \ + case SRL_HDR_ARRAYREF_5: \ + case SRL_HDR_ARRAYREF_6: \ + case SRL_HDR_ARRAYREF_7: \ + case SRL_HDR_ARRAYREF_8: \ + case SRL_HDR_ARRAYREF_9: \ + case SRL_HDR_ARRAYREF_10: \ + case SRL_HDR_ARRAYREF_11: \ + case SRL_HDR_ARRAYREF_12: \ + case SRL_HDR_ARRAYREF_13: \ + case SRL_HDR_ARRAYREF_14: \ + case SRL_HDR_ARRAYREF_15 + + +#define CASE_SRL_HDR_HASHREF \ + case SRL_HDR_HASHREF_0: \ + case SRL_HDR_HASHREF_1: \ + case SRL_HDR_HASHREF_2: \ + case SRL_HDR_HASHREF_3: \ + case SRL_HDR_HASHREF_4: \ + case SRL_HDR_HASHREF_5: \ + case SRL_HDR_HASHREF_6: \ + case SRL_HDR_HASHREF_7: \ + case SRL_HDR_HASHREF_8: \ + case SRL_HDR_HASHREF_9: \ + case SRL_HDR_HASHREF_10: \ + case SRL_HDR_HASHREF_11: \ + case SRL_HDR_HASHREF_12: \ + case SRL_HDR_HASHREF_13: \ + case SRL_HDR_HASHREF_14: \ + case SRL_HDR_HASHREF_15 + + +#define CASE_SRL_HDR_NEG \ + case SRL_HDR_NEG_16: \ + case SRL_HDR_NEG_15: \ + case SRL_HDR_NEG_14: \ + case SRL_HDR_NEG_13: \ + case SRL_HDR_NEG_12: \ + case SRL_HDR_NEG_11: \ + case SRL_HDR_NEG_10: \ + case SRL_HDR_NEG_9: \ + case SRL_HDR_NEG_8: \ + case SRL_HDR_NEG_7: \ + case SRL_HDR_NEG_6: \ + case SRL_HDR_NEG_5: \ + case SRL_HDR_NEG_4: \ + case SRL_HDR_NEG_3: \ + case SRL_HDR_NEG_2: \ + case SRL_HDR_NEG_1 + + +#define CASE_SRL_HDR_POS \ + case SRL_HDR_POS_0: \ + case SRL_HDR_POS_1: \ + case SRL_HDR_POS_2: \ + case SRL_HDR_POS_3: \ + case SRL_HDR_POS_4: \ + case SRL_HDR_POS_5: \ + case SRL_HDR_POS_6: \ + case SRL_HDR_POS_7: \ + case SRL_HDR_POS_8: \ + case SRL_HDR_POS_9: \ + case SRL_HDR_POS_10: \ + case SRL_HDR_POS_11: \ + case SRL_HDR_POS_12: \ + case SRL_HDR_POS_13: \ + case SRL_HDR_POS_14: \ + case SRL_HDR_POS_15 + + +#define CASE_SRL_HDR_RESERVED \ + case SRL_HDR_RESERVED_0: \ + case SRL_HDR_RESERVED_1: \ + case SRL_HDR_RESERVED_2: \ + case SRL_HDR_RESERVED_3: \ + case SRL_HDR_RESERVED_4 + + +#define CASE_SRL_HDR_SHORT_BINARY \ + case SRL_HDR_SHORT_BINARY_0: \ + case SRL_HDR_SHORT_BINARY_1: \ + case SRL_HDR_SHORT_BINARY_2: \ + case SRL_HDR_SHORT_BINARY_3: \ + case SRL_HDR_SHORT_BINARY_4: \ + case SRL_HDR_SHORT_BINARY_5: \ + case SRL_HDR_SHORT_BINARY_6: \ + case SRL_HDR_SHORT_BINARY_7: \ + case SRL_HDR_SHORT_BINARY_8: \ + case SRL_HDR_SHORT_BINARY_9: \ + case SRL_HDR_SHORT_BINARY_10: \ + case SRL_HDR_SHORT_BINARY_11: \ + case SRL_HDR_SHORT_BINARY_12: \ + case SRL_HDR_SHORT_BINARY_13: \ + case SRL_HDR_SHORT_BINARY_14: \ + case SRL_HDR_SHORT_BINARY_15: \ + case SRL_HDR_SHORT_BINARY_16: \ + case SRL_HDR_SHORT_BINARY_17: \ + case SRL_HDR_SHORT_BINARY_18: \ + case SRL_HDR_SHORT_BINARY_19: \ + case SRL_HDR_SHORT_BINARY_20: \ + case SRL_HDR_SHORT_BINARY_21: \ + case SRL_HDR_SHORT_BINARY_22: \ + case SRL_HDR_SHORT_BINARY_23: \ + case SRL_HDR_SHORT_BINARY_24: \ + case SRL_HDR_SHORT_BINARY_25: \ + case SRL_HDR_SHORT_BINARY_26: \ + case SRL_HDR_SHORT_BINARY_27: \ + case SRL_HDR_SHORT_BINARY_28: \ + case SRL_HDR_SHORT_BINARY_29: \ + case SRL_HDR_SHORT_BINARY_30: \ + case SRL_HDR_SHORT_BINARY_31 + + + +/* +* NOTE the above section is auto-updated by author_tools/update_from_header.pl + +=for autoupdater stop + +*/ +#endif diff --git a/t/022_canonical_refs.t b/t/022_canonical_refs.t new file mode 100644 index 0000000..43e4870 --- /dev/null +++ b/t/022_canonical_refs.t @@ -0,0 +1,21 @@ +#!perl +use strict; +use warnings; +use Sereal::Encoder qw(encode_sereal); +use Test::More tests => 2; + +{ + my $v = [{}]; + my $v_sereal = encode_sereal($v); + my $v2 = [@$v]; + my $v_new_sereal = encode_sereal($v); + cmp_ok($v_sereal, 'ne', $v_new_sereal, "Without canonical_refs we're sensitive to refcount changes"); +} + +{ + my $v = [{}]; + my $v_sereal = encode_sereal($v, {canonical_refs => 1}); + my $v2 = [@$v]; + my $v_new_sereal = encode_sereal($v, {canonical_refs => 1}); + cmp_ok($v_sereal, 'eq', $v_new_sereal, "With canonical_refs we're not sensitive to refcount changes"); +} diff --git a/t/030_canonical_vs_test_deep.t b/t/030_canonical_vs_test_deep.t new file mode 100644 index 0000000..adc3bb8 --- /dev/null +++ b/t/030_canonical_vs_test_deep.t @@ -0,0 +1,51 @@ +#!perl +use strict; +use warnings; +use Sereal::Encoder qw(encode_sereal); +use Test::More; + +my %tests = ( + # IMPORTANT: If you add new types of cases here please update the + # "CANONICAL REPRESENTATION" documentation. + utf8_flag_on_ascii_string => [ + sub { + return "en"; + }, + sub { + my $en = "en"; + utf8::upgrade($en); + return $en; + }, + ], + IV_string_value => [ + sub { "12345" }, + sub { "12345" + 0 }, + ], + NV_string_value => [ + sub { "12.345" }, + sub { "12.345" + 0 }, + ], +); + +eval { + require Test::Deep::NoTest; + die "PANIC: We expect at least Test::Deep 0.110 (and Test::Deep::NoTest doesn't support ->VERSION(...)" + unless version->new(Test::Deep->VERSION) >= version->new('0.110'); + 1; +} or do { + my $error = $@ // "Zombie Error"; + plan skip_all => "We are skipping all our tests because we don't have a suitable Test::Deep here, got error: $error"; +}; +plan tests => keys(%tests) * 2; + +for my $test (keys %tests) { + my ($x, $y) = @{$tests{$test}}; + my $x_value = $x->(); + my $y_value = $y->(); + + my $x_value_sereal = encode_sereal($x_value, {canonical => 1}); + my $y_value_sereal = encode_sereal($y_value, {canonical => 1}); + + cmp_ok($x_value_sereal, 'ne', $y_value_sereal, "The $test values are not the same under Sereal"); + ok(Test::Deep::eq_deeply($x_value, $y_value), "The $test values are the same under Test::Deep though"); +} diff --git a/t/170_cyclic_weakrefs.t b/t/170_cyclic_weakrefs.t new file mode 100644 index 0000000..18ffa5f --- /dev/null +++ b/t/170_cyclic_weakrefs.t @@ -0,0 +1,127 @@ +# Tests for self referential tree save and reload where most refs to the root are weakened. +use strict; +use warnings; +use File::Spec; +use Scalar::Util qw /weaken/; + +#use Sereal (); +use Sereal::Encoder; + +local $| = 1; + +use lib File::Spec->catdir(qw(t lib)); +BEGIN { + lib->import('lib') + if !-d 't'; +} + +use Sereal::TestSet qw(:all); +use Sereal::BulkTest qw(:all); +use Test::More; + + +my $ok = have_encoder_and_decoder(); +if (not $ok) { + plan skip_all => 'Did not find right version of decoder'; +} +else { + run_weakref_tests(); +} + + +sub run_weakref_tests { + # Child to parent refs are weak, root node is stored once in the hash + # Was failing on x64 Strawberry perls 5.16.3, 5.18.4, 5.20.1 + test_save_and_reload (); + + # Child to parent refs are weak, but we store the root node twice in the hash + # (second time is in the "TREE_BY_NAME" subhash) + # Was failing on x64 Strawberry perls 5.16.3, passing on 5.18.4, 5.20.1 + test_save_and_reload (store_root_by_name => 1); + + # child to parent refs are strong + # Should pass + test_save_and_reload (no_weaken_refs => 1); +} + +pass(); +done_testing(); + +exit; + + +sub get_data { + my %args = @_; + + my @children; + + my $root = { + name => 'root', + children => \@children, + }; + + my %hash = ( + TREE => $root, + TREE_BY_NAME => {}, + ); + + if ($args{store_root_by_name}) { + $hash{TREE_BY_NAME}{root} = $root; + } + + foreach my $i (0 .. 1) { + my $child = { + PARENT => $root, + NAME => $i, + }; + + if (!$args{no_weaken_refs}) { + weaken $child->{PARENT}; + } + + push @children, $child; + # store it in the by-name cache + $hash{TREE_BY_NAME}{$i} = $child; + } + + return \%hash; +} + + +sub test_save_and_reload { + my %args = @_; + my $data = get_data (%args); + + #diag '=== ARGS ARE: ' . join ' ', %args; + + my $context_text; + $context_text .= $args{no_weaken} ? 'not weakened' : 'weakened'; + $context_text .= $args{store_root_by_name} + ? ', extra root ref stored' + : ', extra root ref not stored'; + + my $encoder = Sereal::Encoder->new; + my $decoder = Sereal::Decoder->new; + my ($encoded_data, $decoded_data); + + $encoded_data = eval {$encoder->encode($data)}; + my $e = $@; + ok (!$e, "Encoded without exception, $context_text"); + + # no point testing if serialisation failed + if ($encoded_data) { + eval {$decoder->decode ($encoded_data, $decoded_data)}; + my $e = $@; + ok (!$e, "Decoded using Sereal, $context_text"); + + is_deeply ( + $decoded_data, + $data, + "Data structures match, $context_text", + ); + } + +} + + +1; diff --git a/t/lib/Sereal/TestSet.pm b/t/lib/Sereal/TestSet.pm index 4982ff1..032a1d0 100644 --- a/t/lib/Sereal/TestSet.pm +++ b/t/lib/Sereal/TestSet.pm @@ -13,15 +13,22 @@ use Devel::Peek; use Encode qw(encode_utf8 is_utf8); use Scalar::Util qw(reftype blessed refaddr); use Config; +use Carp qw(confess); # Dynamically load constants from whatever is being tested our ($Class, $ConstClass); BEGIN { - if (-e "lib/Sereal/Encoder") { + if (-e "lib/Sereal/Encoder.pm") { $Class = 'Sereal::Encoder'; } - elsif (-e "lib/Sereal/Decoder") { + elsif (-e "lib/Sereal/Decoder.pm") { $Class = 'Sereal::Decoder'; + } + elsif (-e "lib/Sereal/Merger.pm") { + $Class = 'Sereal::Merger'; + } + elsif (-e "lib/Sereal/Splitter.pm") { + $Class = 'Sereal::Splitter'; } else { die "Could not find an applicable Sereal constants location"; } @@ -115,10 +122,21 @@ sub dump_bless { } sub short_string { - die if length($_[0]) > SRL_MASK_SHORT_BINARY_LEN; - my $tag = SRL_HDR_SHORT_BINARY_LOW + length($_[0]); - $tag |= SRL_HDR_TRACK_FLAG if $_[1]; - return pack("c a*",$tag,$_[0]); + my ($str, $alias)= @_; + $alias ||= 0; + my $length= length($str); + if ($length > SRL_MASK_SHORT_BINARY_LEN) { + confess "String too long for short_string(), alias=$alias length=$length"; + } + my $tag = SRL_HDR_SHORT_BINARY_LOW + length($str); + if ($tag > SRL_HDR_SHORT_BINARY_HIGH) { + confess "Tag value larger than SRL_HDR_SHORT_BINARY_HIGH, tag=$tag; alias=$alias; length=$length"; + } + $tag |= SRL_HDR_TRACK_FLAG if $alias; + if ($tag > 255) { + confess "Tag value over 255 in short_string(), tag=$tag; alias=$alias; length=$length; SRL_HDR_TRACK_FLAG=", SRL_HDR_TRACK_FLAG; + } + return chr($tag) . $str; } sub integer { @@ -234,14 +252,13 @@ sub setup_tests { [[], array(), "empty array ref"], [[1,2,3], array(chr(0b0000_0001), chr(0b0000_0010), chr(0b0000_0011)), "array ref"], [1000, chr(SRL_HDR_VARINT).varint(1000), "large int"], - [ [1..1000], + [ [ map { $_, undef } 1..1000 ], array( - (map chr, (1 .. SRL_POS_MAX_SIZE)), - (map chr(SRL_HDR_VARINT) . varint($_), ((SRL_POS_MAX_SIZE+1) .. 1000)) + (map { chr($_) => chr(SRL_HDR_UNDEF) } (1 .. SRL_POS_MAX_SIZE)), + (map { chr(SRL_HDR_VARINT) . varint($_) => chr(SRL_HDR_UNDEF) } ((SRL_POS_MAX_SIZE+1) .. 1000)) ), - "array ref with pos and varints" + "array ref with pos and varints and undef" ], - [{}, hash(), "empty hash ref"], [{foo => "baaaaar"}, hash(short_string("foo"),short_string("baaaaar")), "simple hash ref"], [ @@ -572,7 +589,6 @@ sub have_encoder_and_decoder { # $Class is the already-loaded class, so the one we're testing my $need = $Class =~ /Encoder/ ? "Decoder" : "Encoder"; my $need_class = "Sereal::$need"; - my %compat_versions = map {$_ => 1} $Class->_test_compat(); if (defined(my $top_dir = get_git_top_dir())) { my $blib_dir = File::Spec->catdir($top_dir, 'Perl', $need, "blib"); @@ -581,6 +597,11 @@ sub have_encoder_and_decoder { blib->import($blib_dir); } } + eval "use $Class; 1" + or do { + note("Could not locate $Class for testing" . ($@ ? " (Exception: $@)" : "")); + return(); + }; eval "use $need_class; 1" or do { @@ -595,6 +616,7 @@ sub have_encoder_and_decoder { } $cmp_v =~ s/_//; $cmp_v = sprintf("%.2f", int($cmp_v*100)/100); + my %compat_versions = map {$_ => 1} $Class->_test_compat(); if (not defined $cmp_v or not exists $compat_versions{$cmp_v}) { note("Could not load correct version of $need_class for testing " ."(got: $cmp_v, needed any of ".join(", ", keys %compat_versions).")"); diff --git a/typemap b/typemap index 8aaa7b9..4624d35 100644 --- a/typemap +++ b/typemap @@ -1,6 +1,10 @@ # O_OBJECT -> link an opaque C or C++ object to a blessed Perl object. srl_encoder_t * O_OBJECT srl_decoder_t * O_OBJECT +srl_merger_t * O_OBJECT + +# T_OBJECT +Sereal::Splitter T_PTROBJ ###################################################################### OUTPUT @@ -20,4 +24,3 @@ O_OBJECT warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" ); XSRETURN_UNDEF; } - -- 2.30.2