~ubuntu-branches/ubuntu/wily/libsereal-encoder-perl/wily : revision 21

42

#endif

43

44

/* hv_backreferences_p is not marked as exported in embed.fnc in any perl */

45

#if (PERL_VERSION >= 10 && !defined(WIN32) && !defined(_WIN32))

45

#if (PERL_VERSION >= 10)

46

#define HAS_HV_BACKREFS

47

#endif

48

51

#include "srl_common.h"

52

#include "ptable.h"

53

#include "srl_buffer.h"

54

55

#if defined(HAVE_CSNAPPY)

56

#include <csnappy.h>

57

#else

58

#include "snappy/csnappy_compress.c"

59

#endif

60

61

#if defined(HAVE_MINIZ)

62

#include <miniz.h>

63

#else

64

#include "miniz.h"

65

#endif

54

#include "srl_compress.h"

66

55

67

56

/* The ENABLE_DANGEROUS_HACKS (passed through from ENV via Makefile.PL) enables

68

57

* optimizations that may make the code so cozy with a particular version of the

138

127

? srl_init_freezeobj_svhash(enc) \

139

128

: (enc)->freezeobj_svhash )

140

129

130

#define SRL_ENC_UPDATE_BODY_POS(enc) SRL_UPDATE_BODY_POS(&(enc)->buf, (enc)->protocol_version)

131

141

132

#ifndef MAX_CHARSET_NAME_LENGTH

142

133

# define MAX_CHARSET_NAME_LENGTH 2

143

134

#endif

146

137

/*

147

138

Apparently regexes in 5.10 are "modern" but with 5.8 internals

148

139

*/

140

#ifndef RXf_PMf_STD_PMMOD_SHIFT

149

141

# define RXf_PMf_STD_PMMOD_SHIFT 12

142

#endif

143

#ifndef RE_EXTFLAGS

150

144

# define RX_EXTFLAGS(re) ((re)->extflags)

145

#endif

146

#ifndef RX_PRECOMP

151

147

# define RX_PRECOMP(re) ((re)->precomp)

148

#endif

149

#ifndef RX_PRELEN

152

150

# define RX_PRELEN(re) ((re)->prelen)

151

#endif

153

152

154

153

/* Maybe this is only on OS X, where SvUTF8(sv) exists but looks at flags that don't exist */

154

#ifndef RX_UTF8

155

# define RX_UTF8(re) (RX_EXTFLAGS(re) & RXf_UTF8)

156

#endif

156

157

158

#elif defined(SvRX)

158

159

# define MODERN_REGEXP

230

231

232

#define CALL_SRL_DUMP_SV(enc, src) STMT_START { \

232

233

if (!(src)) { \

233

srl_buf_cat_char((enc), SRL_HDR_CANONICAL_UNDEF); /* is this right? */ \

234

srl_buf_cat_char(&(enc)->buf, SRL_HDR_CANONICAL_UNDEF); /* is this right? */\

234

235

} \

235

236

else \

236

237

{ \

237

SvGETMAGIC(src); \

238

svtype svt= SvTYPE((src)); \

238

svtype svt; \

239

SvGETMAGIC(src); \

240

svt= SvTYPE((src)); \

239

241

if (svt < SVt_PVMG && \

240

242

SvREFCNT((src)) == 1 && \

241

243

!SvROK((src)) \

300

302

/* tmp_buf.start may be NULL for an unused tmp_buf, but so what? */

301

303

enc->tmp_buf.pos = enc->tmp_buf.start;

302

304

303

SRL_SET_BODY_POS(enc, enc->buf.start);

305

SRL_SET_BODY_POS(&enc->buf, enc->buf.start);

304

306

305

307

SRL_ENC_RESET_OPER_FLAG(enc, SRL_OF_ENCODER_DIRTY);

306

308

}

314

316

if (enc->tmp_buf.start != NULL)

315

317

srl_buf_free_buffer(aTHX_ &enc->tmp_buf);

316

318

317

Safefree(enc->snappy_workmem);

319

srl_destroy_snappy_workmem(aTHX_ enc->snappy_workmem);

320

318

321

if (enc->ref_seenhash != NULL)

319

322

PTABLE_free(enc->ref_seenhash);

320

323

if (enc->freezeobj_svhash != NULL)

368

371

return enc;

369

372

}

370

373

374

#define my_hv_fetchs(he,val,opt,idx) STMT_START { \

375

he = hv_fetch_ent(opt, options[idx].sv, 0, options[idx].hash); \

376

if (he) \

377

val= HeVAL(he); \

378

else \

379

val= NULL; \

380

} STMT_END

381

371

382

/* Builds the C-level configuration and state struct. */

372

383

srl_encoder_t *

373

srl_build_encoder_struct(pTHX_ HV *opt)

384

srl_build_encoder_struct(pTHX_ HV *opt, sv_with_hash *options)

374

385

{

375

386

srl_encoder_t *enc;

376

SV **svp;

387

SV *val;

388

HE *he;

377

389

378

390

enc = srl_empty_encoder_struct(aTHX);

379

391

enc->flags = 0;

383

395

int undef_unknown = 0;

384

396

int compression_format = 0;

385

397

/* SRL_F_SHARED_HASHKEYS on by default */

386

svp = hv_fetchs(opt, "no_shared_hashkeys", 0);

387

if ( !svp || !SvTRUE(*svp) )

398

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_NO_SHARED_HASHKEYS);

399

if ( !val || !SvTRUE(val) )

388

400

SRL_ENC_SET_OPTION(enc, SRL_F_SHARED_HASHKEYS);

389

401

390

402

/* Needs to be before the snappy options */

391

403

/* enc->protocol_version defaults to SRL_PROTOCOL_VERSION. */

392

svp = hv_fetchs(opt, "protocol_version", 0);

393

if (svp && SvOK(*svp)) {

394

enc->protocol_version = SvUV(*svp);

404

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_PROTOCOL_VERSION);

405

if (val && SvOK(val)) {

406

enc->protocol_version = SvUV(val);

395

407

if (enc->protocol_version < 1

396

408

|| enc->protocol_version > SRL_PROTOCOL_VERSION)

397

409

{

398

croak("Specified Sereal protocol version ('%lu') is invalid",

399

(unsigned long)enc->protocol_version);

410

croak("Specified Sereal protocol version ('%"UVuf") is invalid",

411

(UV)enc->protocol_version);

400

412

}

401

413

}

402

414

else {

403

415

/* Compatibility with the old way to specify older protocol version */

404

svp = hv_fetchs(opt, "use_protocol_v1", 0);

405

if ( svp && SvTRUE(*svp) )

416

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_USE_PROTOCOL_V1);

417

if ( val && SvTRUE(val) )

406

418

enc->protocol_version = 1;

407

419

}

408

420

409

svp = hv_fetchs(opt, "croak_on_bless", 0);

410

if ( svp && SvTRUE(*svp) )

421

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_CROAK_ON_BLESS);

422

if ( val && SvTRUE(val) )

411

423

SRL_ENC_SET_OPTION(enc, SRL_F_CROAK_ON_BLESS);

412

424

413

svp = hv_fetchs(opt, "no_bless_objects", 0);

414

if ( svp && SvTRUE(*svp) )

425

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_NO_BLESS_OBJECTS);

426

if ( val && SvTRUE(val) )

415

427

SRL_ENC_SET_OPTION(enc, SRL_F_NO_BLESS_OBJECTS);

416

428

417

svp = hv_fetchs(opt, "freeze_callbacks", 0);

418

if ( svp && SvTRUE(*svp) ) {

429

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_FREEZE_CALLBACKS);

430

if ( val && SvTRUE(val) ) {

419

431

if (SRL_ENC_HAVE_OPTION(enc, SRL_F_NO_BLESS_OBJECTS))

420

432

croak("The no_bless_objects and freeze_callback_support "

421

433

"options are mutually exclusive");

423

435

enc->sereal_string_sv = newSVpvs("Sereal");

424

436

}

425

437

426

svp = hv_fetchs(opt, "compress", 0);

427

if (svp) {

428

compression_format = SvIV(*svp);

438

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_COMPRESS);

439

if (val) {

440

compression_format = SvIV(val);

429

441

430

442

/* See also Encoder.pm's constants */

431

443

switch (compression_format) {

440

452

croak("Zlib compression was introduced in protocol version 3 and you are asking for only version %i", (int)enc->protocol_version);

441

453

442

454

enc->compress_level = MZ_DEFAULT_COMPRESSION;

443

svp = hv_fetchs(opt, "compress_level", 0);

444

if ( svp && SvTRUE(*svp) ) {

445

IV lvl = SvIV(*svp);

455

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_COMPRESS_LEVEL);

456

if ( val && SvTRUE(val) ) {

457

IV lvl = SvIV(val);

446

458

if (expect_false( lvl < 1 || lvl > 10 )) /* Sekrit: compression lvl 10 is a miniz thing that doesn't exist in normal zlib */

447

459

croak("'compress_level' needs to be between 1 and 9");

448

460

enc->compress_level = lvl;

455

467

else {

456

468

/* Only bother with old compression options if necessary */

457

469

458

svp = hv_fetchs(opt, "snappy_incr", 0);

459

if ( svp && SvTRUE(*svp) ) {

470

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_SNAPPY_INCR);

471

if ( val && SvTRUE(val) ) {

460

472

SRL_ENC_SET_OPTION(enc, SRL_F_COMPRESS_SNAPPY_INCREMENTAL);

461

473

compression_format = 1;

462

474

}

463

475

else {

464

476

/* snappy_incr >> snappy */

465

svp = hv_fetchs(opt, "snappy", 0);

466

if ( svp && SvTRUE(*svp) ) {

477

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_SNAPPY);

478

if ( val && SvTRUE(val) ) {

467

479

/* incremental is the new black in V2 */

468

480

if (expect_true( enc->protocol_version > 1 ))

469

481

SRL_ENC_SET_OPTION(enc, SRL_F_COMPRESS_SNAPPY_INCREMENTAL);

474

486

}

475

487

}

476

488

477

svp = hv_fetchs(opt, "undef_unknown", 0);

478

if ( svp && SvTRUE(*svp) ) {

489

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_UNDEF_UNKNOWN);

490

if ( val && SvTRUE(val) ) {

479

491

undef_unknown = 1;

480

492

SRL_ENC_SET_OPTION(enc, SRL_F_UNDEF_UNKNOWN);

481

493

}

482

494

483

svp = hv_fetchs(opt, "sort_keys", 0);

484

if ( !svp )

485

svp = hv_fetchs(opt, "canonical",0);

486

if ( svp && SvTRUE(*svp) )

495

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_SORT_KEYS);

496

if ( !val )

497

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_CANONICAL);

498

if ( val && SvTRUE(val) )

487

499

SRL_ENC_SET_OPTION(enc, SRL_F_SORT_KEYS);

488

500

489

svp = hv_fetchs(opt, "canonical_refs", 0);

490

if ( !svp )

491

svp = hv_fetchs(opt, "canonical",0);

492

if ( svp && SvTRUE(*svp) )

501

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_CANONICAL_REFS);

502

if ( !val )

503

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_CANONICAL);

504

if ( val && SvTRUE(val) )

493

505

SRL_ENC_SET_OPTION(enc, SRL_F_CANONICAL_REFS);

494

506

495

svp = hv_fetchs(opt, "aliased_dedupe_strings", 0);

496

if ( svp && SvTRUE(*svp) )

507

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_ALIASED_DEDUPE_STRINGS);

508

if ( val && SvTRUE(val) )

497

509

SRL_ENC_SET_OPTION(enc, SRL_F_ALIASED_DEDUPE_STRINGS | SRL_F_DEDUPE_STRINGS);

498

510

else {

499

svp = hv_fetchs(opt, "dedupe_strings", 0);

500

if ( svp && SvTRUE(*svp) )

511

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_DEDUPE_STRINGS);

512

if ( val && SvTRUE(val) )

501

513

SRL_ENC_SET_OPTION(enc, SRL_F_DEDUPE_STRINGS);

502

514

}

503

515

504

svp = hv_fetchs(opt, "stringify_unknown", 0);

505

if ( svp && SvTRUE(*svp) ) {

516

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_STRINGIFY_UNKNOWN);

517

if ( val && SvTRUE(val) ) {

506

518

if (expect_false( undef_unknown ))

507

519

croak("'undef_unknown' and 'stringify_unknown' "

508

520

"options are mutually exclusive");

509

521

SRL_ENC_SET_OPTION(enc, SRL_F_STRINGIFY_UNKNOWN);

510

522

}

511

523

512

svp = hv_fetchs(opt, "warn_unknown", 0);

513

if ( svp && SvTRUE(*svp) ) {

524

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_WARN_UNKNOWN);

525

if ( val && SvTRUE(val) ) {

514

526

SRL_ENC_SET_OPTION(enc, SRL_F_WARN_UNKNOWN);

515

if (SvIV(*svp) < 0)

527

if (SvIV(val) < 0)

516

528

SRL_ENC_SET_OPTION(enc, SRL_F_NOWARN_UNKNOWN_OVERLOAD);

517

529

}

518

530

519

520

531

if (compression_format) {

521

532

enc->compress_threshold = 1024;

522

svp = hv_fetchs(opt, "compress_threshold", 0);

523

if ( svp && SvOK(*svp) )

524

enc->compress_threshold = SvIV(*svp);

533

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_COMPRESS_THRESHOLD);

534

if ( val && SvOK(val) )

535

enc->compress_threshold = SvIV(val);

525

536

else if (compression_format == 1) {

526

537

/* compression_format==1 is some sort of Snappy */

527

svp = hv_fetchs(opt, "snappy_threshold", 0);

528

if ( svp && SvOK(*svp) )

529

enc->compress_threshold = SvIV(*svp);

538

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_SNAPPY_THRESHOLD);

539

if ( val && SvOK(val) )

540

enc->compress_threshold = SvIV(val);

530

541

}

531

542

}

532

543

533

svp = hv_fetchs(opt, "max_recursion_depth", 0);

534

if ( svp && SvTRUE(*svp))

535

enc->max_recursion_depth = SvUV(*svp);

544

my_hv_fetchs(he, val, opt, SRL_ENC_OPT_IDX_MAX_RECURSION_DEPTH);

545

if ( val && SvTRUE(val) )

546

enc->max_recursion_depth = SvUV(val);

536

547

}

537

548

else {

538

549

/* SRL_F_SHARED_HASHKEYS on by default */

539

550

SRL_ENC_SET_OPTION(enc, SRL_F_SHARED_HASHKEYS);

540

551

}

541

552

542

DEBUG_ASSERT_BUF_SANE(enc);

553

DEBUG_ASSERT_BUF_SANE(&enc->buf);

543

554

return enc;

544

555

}

545

556

559

570

}

560

571

enc->protocol_version = proto->protocol_version;

561

572

562

DEBUG_ASSERT_BUF_SANE(enc);

573

DEBUG_ASSERT_BUF_SANE(&enc->buf);

563

574

return enc;

564

575

}

565

576

598

609

return enc->string_deduper_hv;

599

610

}

600

611

601

/* Lazy working buffer alloc */

602

SRL_STATIC_INLINE void

603

srl_init_snappy_workmem(pTHX_ srl_encoder_t *enc)

604

{

605

/* Lazy working buffer alloc */

606

if (expect_false( enc->snappy_workmem == NULL )) {

607

/* Cleaned up automatically by the cleanup handler */

608

Newx(enc->snappy_workmem, CSNAPPY_WORKMEM_BYTES, char);

609

if (enc->snappy_workmem == NULL)

610

croak("Out of memory!");

611

}

612

}

613

614

612

615

613

void

616

srl_write_header(pTHX_ srl_encoder_t *enc, SV *user_header_src)

614

srl_write_header(pTHX_ srl_encoder_t *enc, SV *user_header_src, const U32 compress_flags)

617

615

{

618

616

/* 4th to 8th bit are flags. Using 4th for snappy flag. FIXME needs to go in spec. */

619

const U8 flags = (

620

SRL_ENC_HAVE_OPTION(enc, SRL_F_COMPRESS_SNAPPY)

621

? SRL_PROTOCOL_ENCODING_SNAPPY

622

: SRL_ENC_HAVE_OPTION(enc, SRL_F_COMPRESS_SNAPPY_INCREMENTAL)

623

? SRL_PROTOCOL_ENCODING_SNAPPY_INCREMENTAL

624

: SRL_ENC_HAVE_OPTION(enc, SRL_F_COMPRESS_ZLIB)

625

? SRL_PROTOCOL_ENCODING_ZLIB

626

: SRL_PROTOCOL_ENCODING_RAW

627

);

617

618

U8 flags= SRL_F_COMPRESS_FLAGS_TO_PROTOCOL_ENCODING[ compress_flags >> SRL_F_COMPRESS_FLAGS_SHIFT ];

628

619

const U8 version_and_flags = (U8)enc->protocol_version | flags;

629

620

630

621

/* 4 byte magic string + proto version

631

622

* + potentially uncompressed size varint

632

623

* + 1 byte varint that indicates zero-length header */

633

BUF_SIZE_ASSERT(enc, sizeof(SRL_MAGIC_STRING) + 1 + 1);

624

BUF_SIZE_ASSERT(&enc->buf, sizeof(SRL_MAGIC_STRING) + 1 + 1);

634

625

if (LIKELY( enc->protocol_version > 2 ))

635

srl_buf_cat_str_s_nocheck(enc, SRL_MAGIC_STRING_HIGHBIT);

626

srl_buf_cat_str_s_nocheck(&enc->buf, SRL_MAGIC_STRING_HIGHBIT);

636

627

else

637

srl_buf_cat_str_s_nocheck(enc, SRL_MAGIC_STRING);

638

srl_buf_cat_char_nocheck(enc, version_and_flags);

628

srl_buf_cat_str_s_nocheck(&enc->buf, SRL_MAGIC_STRING);

629

srl_buf_cat_char_nocheck(&enc->buf, version_and_flags);

639

630

if (user_header_src == NULL) {

640

srl_buf_cat_char_nocheck(enc, '\0'); /* variable header length (0 right now) */

631

srl_buf_cat_char_nocheck(&enc->buf, '\0'); /* variable header length (0 right now) */

641

632

}

642

633

else {

643

634

STRLEN user_data_len;

652

643

653

644

/* Write document body (for header) into separate buffer */

654

645

srl_buf_swap_buffer(aTHX_ &enc->tmp_buf, &enc->buf);

655

SRL_UPDATE_BODY_POS(enc);

646

SRL_ENC_UPDATE_BODY_POS(enc);

656

647

srl_dump_sv(aTHX_ enc, user_header_src);

657

648

srl_fixup_weakrefs(aTHX_ enc); /* more bodies to follow */

658

649

srl_clear_seen_hashes(aTHX_ enc); /* more bodies to follow */

659

650

660

651

/* Swap main buffer back in, encode header length&bitfield, copy user header data */

661

user_data_len = BUF_POS_OFS(enc->buf);

652

user_data_len = BUF_POS_OFS(&enc->buf);

662

653

srl_buf_swap_buffer(aTHX_ &enc->buf, &enc->tmp_buf);

663

654

664

BUF_SIZE_ASSERT(enc, user_data_len + 1 + SRL_MAX_VARINT_LENGTH); /* +1 for bit field, +X for header len */

655

BUF_SIZE_ASSERT(&enc->buf, user_data_len + 1 + SRL_MAX_VARINT_LENGTH); /* +1 for bit field, +X for header len */

665

656

666

657

/* Encode header length */

667

srl_buf_cat_varint_nocheck(aTHX_ enc, 0, (UV)(user_data_len + 1)); /* +1 for bit field */

658

srl_buf_cat_varint_nocheck(aTHX_ &enc->buf, 0, (UV)(user_data_len + 1)); /* +1 for bit field */

668

659

/* Encode bitfield */

669

srl_buf_cat_char_nocheck(enc, '\1');

660

srl_buf_cat_char_nocheck(&enc->buf, '\1');

670

661

/* Copy user header data */

671

662

Copy(enc->tmp_buf.start, enc->buf.pos, user_data_len, char);

672

663

enc->buf.pos += user_data_len;

711

702

MS_VC6_WORKAROUND_VOLATILE double d= (double)nv;

712

703

/* TODO: this logic could be reworked to not duplicate so much code, which will help on win32 */

713

704

if ( f == nv || nv != nv ) {

714

BUF_SIZE_ASSERT(enc, 1 + sizeof(f)); /* heuristic: header + string + simple value */

715

srl_buf_cat_char_nocheck(enc,SRL_HDR_FLOAT);

705

BUF_SIZE_ASSERT(&enc->buf, 1 + sizeof(f)); /* heuristic: header + string + simple value */

706

srl_buf_cat_char_nocheck(&enc->buf, SRL_HDR_FLOAT);

716

707

Copy((char *)&f, enc->buf.pos, sizeof(f), char);

717

708

enc->buf.pos += sizeof(f);

718

709

} else if (d == nv) {

719

BUF_SIZE_ASSERT(enc, 1 + sizeof(d)); /* heuristic: header + string + simple value */

720

srl_buf_cat_char_nocheck(enc,SRL_HDR_DOUBLE);

710

BUF_SIZE_ASSERT(&enc->buf, 1 + sizeof(d)); /* heuristic: header + string + simple value */

711

srl_buf_cat_char_nocheck(&enc->buf, SRL_HDR_DOUBLE);

721

712

Copy((char *)&d, enc->buf.pos, sizeof(d), char);

722

713

enc->buf.pos += sizeof(d);

723

714

} else {

724

BUF_SIZE_ASSERT(enc, 1 + sizeof(nv)); /* heuristic: header + string + simple value */

725

srl_buf_cat_char_nocheck(enc,SRL_HDR_LONG_DOUBLE);

715

BUF_SIZE_ASSERT(&enc->buf, 1 + sizeof(nv)); /* heuristic: header + string + simple value */

716

srl_buf_cat_char_nocheck(&enc->buf, SRL_HDR_LONG_DOUBLE);

726

717

Copy((char *)&nv, enc->buf.pos, sizeof(nv), char);

727

718

#if SRL_EXTENDED_PRECISION_LONG_DOUBLE

728

719

/* x86 uses an 80 bit extended precision. on 64 bit machines

753

744

if (num <= 15) {

754

745

/* encodable as POS */

755

746

hdr = SRL_HDR_POS_LOW | (unsigned char)num;

756

srl_buf_cat_char(enc, hdr);

747

srl_buf_cat_char(&enc->buf, hdr);

757

748

}

758

749

else {

759

srl_buf_cat_varint(aTHX_ enc, SRL_HDR_VARINT, num);

750

srl_buf_cat_varint(aTHX_ &enc->buf, SRL_HDR_VARINT, num);

760

751

}

761

752

}

762

753

else {

764

755

if (num >= -16) {

765

756

/* encodable as NEG */

766

757

hdr = SRL_HDR_NEG_LOW | ((unsigned char)num + 32);

767

srl_buf_cat_char(enc, hdr);

758

srl_buf_cat_char(&enc->buf, hdr);

768

759

}

769

760

else {

770

761

/* Needs ZIGZAG */

771

srl_buf_cat_zigzag(aTHX_ enc, SRL_HDR_ZIGZAG, num);

762

srl_buf_cat_zigzag(aTHX_ &enc->buf, SRL_HDR_ZIGZAG, num);

772

763

}

773

764

}

774

765

}

795

786

SV *replacement= NULL;

796

787

PTABLE_t *freezeobj_svhash = SRL_GET_FREEZEOBJ_SVHASH(enc);

797

788

if (SvREFCNT(referent)>1) {

798

replacement= PTABLE_fetch(freezeobj_svhash, referent);

789

replacement= (SV *) PTABLE_fetch(freezeobj_svhash, referent);

799

790

}

800

791

if (!replacement) {

801

792

int count;

852

843

853

844

if (oldoffset != 0) {

854

845

/* Issue COPY instead of literal class name string */

855

srl_buf_cat_varint(aTHX_ enc,

846

srl_buf_cat_varint(aTHX_ &enc->buf,

856

847

expect_false(replacement) ? SRL_HDR_OBJECTV_FREEZE : SRL_HDR_OBJECTV,

857

848

(UV)oldoffset);

858

849

}

867

858

* At least, we can safely use the same PTABLE to store the ptrs to hashkeys since

868

859

* the set of pointers will never collide.

869

860

* /me bows to Yves for the delightfully evil hack. */

870

srl_buf_cat_char(enc, expect_false(replacement) ? SRL_HDR_OBJECT_FREEZE : SRL_HDR_OBJECT);

861

srl_buf_cat_char(&enc->buf, expect_false(replacement) ? SRL_HDR_OBJECT_FREEZE : SRL_HDR_OBJECT);

871

862

872

863

/* remember current offset before advancing it */

873

PTABLE_store(string_seenhash, (void *)stash, INT2PTR(void *, BODY_POS_OFS(enc->buf)));

864

PTABLE_store(string_seenhash, (void *)stash, INT2PTR(void *, BODY_POS_OFS(&enc->buf)));

874

865

875

866

/* HvNAMEUTF8 not in older perls and it would be 0 for those anyway */

876

867

#if PERL_VERSION >= 16

907

898

return enc;

908

899

}

909

900

910

911

/* Update a varint anywhere in the output stream with defined start and end

912

* positions. This can produce non-canonical varints and is useful for filling

913

* pre-allocated varints. */

914

SRL_STATIC_INLINE void

915

srl_update_varint_from_to(pTHX_ char *varint_start, char *varint_end, UV number)

916

{

917

while (number >= 0x80) { /* while we are larger than 7 bits long */

918

*varint_start++ = (number & 0x7f) | 0x80; /* write out the least significant 7 bits, set the high bit */

919

number = number >> 7; /* shift off the 7 least significant bits */

920

}

921

/* if it is the same size we can use a canonical varint */

922

if ( varint_start == varint_end ) {

923

*varint_start = number; /* encode the last 7 bits without the high bit being set */

924

} else {

925

/* if not we produce a non-canonical varint, basically we stuff

926

* 0 bits (via 0x80) into the "tail" of the varint, until we can

927

* stick in a null to terminate the sequence. This means that the

928

* varint is effectively "self-padding", and we only need special

929

* logic in the encoder - a decoder will happily process a non-canonical

930

* varint with no problem */

931

*varint_start++ = (number & 0x7f) | 0x80;

932

while ( varint_start < varint_end )

933

*varint_start++ = 0x80;

934

*varint_start= 0;

935

}

936

}

937

938

939

/* Resets the compression header flag to OFF.

940

* Obviously requires that a Sereal header was already written to the

941

* encoder's output buffer. */

942

SRL_STATIC_INLINE void

943

srl_reset_compression_header_flag(srl_encoder_t *enc)

944

{

945

/* sizeof(const char *) includes a count of \0 */

946

char *flags_and_version_byte = enc->buf.start + sizeof(SRL_MAGIC_STRING) - 1;

947

/* disable snappy flag in header */

948

*flags_and_version_byte = SRL_PROTOCOL_ENCODING_RAW |

949

(*flags_and_version_byte & SRL_PROTOCOL_VERSION_MASK);

950

}

951

952

901

SRL_STATIC_INLINE srl_encoder_t *

953

902

srl_dump_data_structure(pTHX_ srl_encoder_t *enc, SV *src, SV *user_header_src)

954

903

{

904

U32 compress_flags;

905

955

906

enc = srl_prepare_encoder(aTHX_ enc);

907

compress_flags= SRL_ENC_HAVE_OPTION(enc, SRL_F_COMPRESS_FLAGS_MASK);

956

908

957

if (expect_true(

958

!SRL_ENC_HAVE_OPTION(enc, ( SRL_F_COMPRESS_SNAPPY

959

| SRL_F_COMPRESS_SNAPPY_INCREMENTAL

960

| SRL_F_COMPRESS_ZLIB))

961

))

962

{

963

srl_write_header(aTHX_ enc, user_header_src);

964

SRL_UPDATE_BODY_POS(enc);

965

srl_dump_sv(aTHX_ enc, src);

966

srl_fixup_weakrefs(aTHX_ enc);

967

}

968

else { /* Have some sort of compression */

909

if (expect_false(compress_flags))

910

{ /* Have some sort of compression */

969

911

ptrdiff_t sereal_header_len;

970

912

STRLEN uncompressed_body_length;

971

913

972

914

/* Alas, have to write entire packet first since the header length

973

915

* will determine offsets. */

974

srl_write_header(aTHX_ enc, user_header_src);

975

sereal_header_len = BUF_POS_OFS(enc->buf);

976

SRL_UPDATE_BODY_POS(enc);

916

srl_write_header(aTHX_ enc, user_header_src, compress_flags);

917

sereal_header_len = BUF_POS_OFS(&enc->buf);

918

SRL_ENC_UPDATE_BODY_POS(enc);

977

919

srl_dump_sv(aTHX_ enc, src);

978

920

srl_fixup_weakrefs(aTHX_ enc);

979

assert(BUF_POS_OFS(enc->buf) > sereal_header_len);

980

uncompressed_body_length = BUF_POS_OFS(enc->buf) - sereal_header_len;

921

assert(BUF_POS_OFS(&enc->buf) > sereal_header_len);

922

uncompressed_body_length = BUF_POS_OFS(&enc->buf) - sereal_header_len;

981

923

982

if (uncompressed_body_length < (STRLEN)enc->compress_threshold)

983

{

924

if (uncompressed_body_length < (STRLEN)enc->compress_threshold) {

984

925

/* Don't bother with compression at all if we have less than $threshold bytes of payload */

985

srl_reset_compression_header_flag(enc);

926

srl_reset_compression_header_flag(&enc->buf);

986

927

}

987

928

else { /* Do Snappy or zlib compression of body */

988

const int is_snappy

989

= SRL_ENC_HAVE_OPTION(enc, ( SRL_F_COMPRESS_SNAPPY

990

| SRL_F_COMPRESS_SNAPPY_INCREMENTAL));

991

/* !is_snappy is the same as "is zlib" right now */

992

993

const int is_traditional_snappy

994

= (SRL_ENC_HAVE_OPTION(enc, SRL_F_COMPRESS_SNAPPY));

995

996

srl_buffer_t old_buf; /* TODO can we use the enc->tmp_buf here to avoid allocations? */

997

char *varint_start= NULL;

998

char *varint_end= NULL;

999

size_t dest_len;

1000

1001

/* Get uncompressed payload and total packet output (after compression) lengths */

1002

dest_len = sereal_header_len + 1

1003

+ ( is_snappy ? (size_t)csnappy_max_compressed_length(uncompressed_body_length)

1004

: (size_t)mz_compressBound(uncompressed_body_length)+SRL_MAX_VARINT_LENGTH );

1005

1006

/* Will have to embed compressed packet length as varint if not

1007

* in traditional Snappy mode. (So needs to be added for any of

1008

* ZLIB, or incremental Snappy.) */

1009

if ( !is_traditional_snappy )

1010

dest_len += SRL_MAX_VARINT_LENGTH;

1011

1012

if (is_snappy)

1013

srl_init_snappy_workmem(aTHX_ enc);

1014

1015

/* Back up old buffer and allocate new one with correct size */

1016

srl_buf_copy_buffer(aTHX_ &enc->buf, &old_buf);

1017

srl_buf_init_buffer(aTHX_ &enc->buf, dest_len);

1018

1019

/* Copy Sereal header */

1020

Copy(old_buf.start, enc->buf.pos, sereal_header_len, char);

1021

enc->buf.pos += sereal_header_len;

1022

SRL_UPDATE_BODY_POS(enc); /* will do the right thing wrt. protocol V1 / V2 */

1023

1024

/* Embed compressed packet length if Zlib */

1025

if (!is_snappy)

1026

srl_buf_cat_varint_nocheck(aTHX_ enc, 0, uncompressed_body_length);

1027

1028

/* Embed compressed packet length if incr. Snappy or Zlib*/

1029

if (expect_true( !is_traditional_snappy )) {

1030

varint_start= enc->buf.pos;

1031

srl_buf_cat_varint_nocheck(aTHX_ enc, 0, dest_len);

1032

varint_end= enc->buf.pos - 1;

1033

}

1034

1035

if (is_snappy) {

1036

uint32_t len = (uint32_t)dest_len;

1037

csnappy_compress(old_buf.start + sereal_header_len, (uint32_t)uncompressed_body_length, enc->buf.pos, &len,

1038

enc->snappy_workmem, CSNAPPY_WORKMEM_BYTES_POWER_OF_TWO);

1039

dest_len = (size_t)len;

1040

}

1041

else {

1042

mz_ulong dl = (mz_ulong)dest_len;

1043

int status = mz_compress2(

1044

(unsigned char *)enc->buf.pos,

1045

&dl,

1046

(const unsigned char *)(old_buf.start + sereal_header_len),

1047

(mz_ulong)uncompressed_body_length,

1048

enc->compress_level

1049

);

1050

(void)status;

1051

assert(status == Z_OK);

1052

dest_len = (size_t)dl;

1053

}

1054

1055

assert(dest_len != 0);

1056

1057

/* If compression didn't help, swap back to old, uncompressed buffer */

1058

if (dest_len >= uncompressed_body_length) {

1059

/* swap in old, uncompressed buffer */

1060

srl_buf_swap_buffer(aTHX_ &enc->buf, &old_buf);

1061

/* disable compression flag */

1062

srl_reset_compression_header_flag(enc);

1063

}

1064

else { /* go ahead with Snappy and do final fixups */

1065

/* overwrite the max size varint with the real size of the compressed data */

1066

if (varint_start)

1067

srl_update_varint_from_to(aTHX_ varint_start, varint_end, dest_len);

1068

enc->buf.pos += dest_len;

1069

}

1070

1071

srl_buf_free_buffer(aTHX_ &old_buf);

1072

assert(enc->buf.pos <= enc->buf.end);

1073

} /* End of "actually do compression" */

929

srl_compress_body(aTHX_ &enc->buf, sereal_header_len,

930

compress_flags, enc->compress_level,

931

&enc->snappy_workmem);

932

933

SRL_ENC_UPDATE_BODY_POS(enc);

934

DEBUG_ASSERT_BUF_SANE(&enc->buf);

935

}

1074

936

} /* End of "want compression?" */

937

else

938

{

939

srl_write_header(aTHX_ enc, user_header_src, compress_flags);

940

SRL_ENC_UPDATE_BODY_POS(enc);

941

srl_dump_sv(aTHX_ enc, src);

942

srl_fixup_weakrefs(aTHX_ enc);

943

}

1075

944

1076

945

/* NOT doing a

1077

946

* SRL_ENC_RESET_OPER_FLAG(enc, SRL_OF_ENCODER_DIRTY);

1087

956

assert(enc->buf.start && enc->buf.pos && enc->buf.pos > enc->buf.start);

1088

957

1089

958

if ( flags && /* for now simpler and equivalent to: flags == SRL_ENC_SV_REUSE_MAYBE */

1090

(BUF_POS_OFS(enc->buf) > 20 && BUF_SPACE(enc->buf) < BUF_POS_OFS(enc->buf) )

959

(BUF_POS_OFS(&enc->buf) > 20 && BUF_SPACE(&enc->buf) < BUF_POS_OFS(&enc->buf) )

1091

960

){

1092

961

/* If not wasting more than 2x memory - FIXME fungible */

1093

962

SV *sv = sv_2mortal(newSV_type(SVt_PV));

1094

SvPV_set(sv, enc->buf.start);

1095

SvLEN_set(sv, BUF_SIZE(enc->buf));

1096

SvCUR_set(sv, BUF_POS_OFS(enc->buf));

963

SvPV_set(sv, (char *) enc->buf.start);

964

SvLEN_set(sv, BUF_SIZE(&enc->buf));

965

SvCUR_set(sv, BUF_POS_OFS(&enc->buf));

1097

966

SvPOK_on(sv);

1098

967

enc->buf.start = enc->buf.pos = NULL; /* no need to free these guys now */

1099

968

return sv;

1100

969

}

1101

970

1102

return sv_2mortal(newSVpvn(enc->buf.start, (STRLEN)BUF_POS_OFS(enc->buf)));

971

return sv_2mortal(newSVpvn((char *)enc->buf.start, (STRLEN)BUF_POS_OFS(&enc->buf)));

1103

972

}

1104

973

1105

974

SRL_STATIC_INLINE void

1116

985

while ( NULL != (ent = PTABLE_iter_next(it)) ) {

1117

986

const ptrdiff_t offset = (ptrdiff_t)ent->value;

1118

987

if ( offset ) {

1119

char *pos = enc->buf.body_pos + offset;

988

srl_buffer_char *pos = enc->buf.body_pos + offset;

1120

989

assert(*pos == SRL_HDR_WEAKEN);

1121

if (DEBUGHACK) warn("setting byte at offset %lu to PAD", (long unsigned int)offset);

990

if (DEBUGHACK) warn("setting byte at offset %"UVuf" to PAD", (UV)offset);

1122

991

*pos = SRL_HDR_PAD;

1123

992

}

1124

993

}

1169

1038

match_flags >>= 1;

1170

1039

}

1171

1040

1172

srl_buf_cat_char(enc, SRL_HDR_REGEXP);

1041

srl_buf_cat_char(&enc->buf, SRL_HDR_REGEXP);

1173

1042

srl_dump_pv(aTHX_ enc, RX_PRECOMP(re),RX_PRELEN(re), (RX_UTF8(re) ? SVf_UTF8 : 0));

1174

1043

srl_dump_pv(aTHX_ enc, reflags, left, 0);

1175

1044

return;

1184

1053

n = av_len(src)+1;

1185

1054

1186

1055

/* heuristic: n is virtually the min. size of any element */

1187

BUF_SIZE_ASSERT(enc, 2 + SRL_MAX_VARINT_LENGTH + n);

1056

BUF_SIZE_ASSERT(&enc->buf, 2 + SRL_MAX_VARINT_LENGTH + n);

1188

1057

1189

1058

if (n < 16 && refcount == 1 && !SRL_ENC_HAVE_OPTION(enc,SRL_F_CANONICAL_REFS)) {

1190

1059

enc->buf.pos--; /* backup over previous REFN */

1191

srl_buf_cat_char_nocheck(enc, SRL_HDR_ARRAYREF + n);

1060

srl_buf_cat_char_nocheck(&enc->buf, SRL_HDR_ARRAYREF + n);

1192

1061

} else {

1193

1062

/* header and num. elements */

1194

srl_buf_cat_varint_nocheck(aTHX_ enc, SRL_HDR_ARRAY, n);

1063

srl_buf_cat_varint_nocheck(aTHX_ &enc->buf, SRL_HDR_ARRAY, n);

1195

1064

}

1196

1065

if (!n)

1197

1066

return;

1257

1126

n = 0;

1258

1127

while ((he = hv_iternext(src))) { ++n; }

1259

1128

1260

/* heuristic: n = ~min size of n values;

1261

* + 2*n = very conservative min size of n hashkeys if all COPY */

1262

BUF_SIZE_ASSERT(enc, 2 + SRL_MAX_VARINT_LENGTH + 3*n);

1129

/* heuristic: n = ~min size of n values;

1130

* + 3*n = very conservative min size of n hashkeys if all COPY */

1131

BUF_SIZE_ASSERT(&enc->buf, 2 + SRL_MAX_VARINT_LENGTH + 3 * n);

1263

1132

1264

1133

if (n < 16 && refcount == 1 && !SRL_ENC_HAVE_OPTION(enc,SRL_F_CANONICAL_REFS)) {

1265

1134

enc->buf.pos--; /* back up over the previous REFN */

1266

srl_buf_cat_char_nocheck(enc, SRL_HDR_HASHREF + n);

1135

srl_buf_cat_char_nocheck(&enc->buf, SRL_HDR_HASHREF + n);

1267

1136

} else {

1268

srl_buf_cat_varint_nocheck(aTHX_ enc, SRL_HDR_HASH, n);

1137

srl_buf_cat_varint_nocheck(aTHX_ &enc->buf, SRL_HDR_HASH, n);

1269

1138

}

1270

1139

1271

1140

(void)hv_iterinit(src); /* return value not reliable according to API docs */

1324

1193

}

1325

1194

} else {

1326

1195

n= HvUSEDKEYS(src);

1327

/* heuristic: n = ~min size of n values;

1328

* + 2*n = very conservative min size of n hashkeys if all COPY */

1329

BUF_SIZE_ASSERT(enc, 2 + SRL_MAX_VARINT_LENGTH + 3*n);

1196

/* heuristic: n = ~min size of n values;

1197

* + 3 * n = very conservative min size of n hashkeys if all COPY */

1198

BUF_SIZE_ASSERT(&enc->buf, 2 + SRL_MAX_VARINT_LENGTH + 3 * n);

1330

1199

if (n < 16 && refcount == 1 && !SRL_ENC_HAVE_OPTION(enc,SRL_F_CANONICAL_REFS)) {

1331

1200

enc->buf.pos--; /* backup over the previous REFN */

1332

srl_buf_cat_char_nocheck(enc, SRL_HDR_HASHREF + n);

1201

srl_buf_cat_char_nocheck(&enc->buf, SRL_HDR_HASHREF + n);

1333

1202

} else {

1334

srl_buf_cat_varint_nocheck(aTHX_ enc, SRL_HDR_HASH, n);

1203

srl_buf_cat_varint_nocheck(aTHX_ &enc->buf, SRL_HDR_HASH, n);

1335

1204

}

1336

1205

if (n) {

1337

1206

HE **he_ptr= HvARRAY(src);

1388

1257

const ptrdiff_t oldoffset = (ptrdiff_t)PTABLE_fetch(string_seenhash, str);

1389

1258

if (oldoffset != 0) {

1390

1259

/* Issue COPY instead of literal hash key string */

1391

srl_buf_cat_varint(aTHX_ enc, SRL_HDR_COPY, (UV)oldoffset);

1260

srl_buf_cat_varint(aTHX_ &enc->buf, SRL_HDR_COPY, (UV)oldoffset);

1392

1261

return;

1393

1262

}

1394

1263

else {

1395

1264

/* remember current offset before advancing it */

1396

const ptrdiff_t newoffset = BODY_POS_OFS(enc->buf);

1265

const ptrdiff_t newoffset = BODY_POS_OFS(&enc->buf);

1397

1266

PTABLE_store(string_seenhash, (void *)str, INT2PTR(void *, newoffset));

1398

1267

}

1399

1268

}

1428

1297

/* emit copy or alias */

1429

1298

if (out_tag == SRL_HDR_ALIAS)

1430

1299

SRL_SET_TRACK_FLAG(*(enc->buf.body_pos + SvUV(ofs_sv)));

1431

srl_buf_cat_varint(aTHX_ enc, out_tag, SvIV(ofs_sv));

1300

srl_buf_cat_varint(aTHX_ &enc->buf, out_tag, SvIV(ofs_sv));

1432

1301

return;

1433

1302

} else if (SvUOK(ofs_sv)) {

1434

srl_buf_cat_varint(aTHX_ enc, out_tag, SvUV(ofs_sv));

1303

srl_buf_cat_varint(aTHX_ &enc->buf, out_tag, SvUV(ofs_sv));

1435

1304

return;

1436

1305

} else {

1437

1306

/* start tracking this string */

1438

sv_setuv(ofs_sv, (UV)BODY_POS_OFS(enc->buf));

1307

sv_setuv(ofs_sv, (UV)BODY_POS_OFS(&enc->buf));

1439

1308

}

1440

1309

}

1441

1310

}

1445

1314

SRL_STATIC_INLINE void

1446

1315

srl_dump_pv(pTHX_ srl_encoder_t *enc, const char* src, STRLEN src_len, int is_utf8)

1447

1316

{

1448

BUF_SIZE_ASSERT(enc, 1 + SRL_MAX_VARINT_LENGTH + src_len); /* overallocate a bit sometimes */

1317

BUF_SIZE_ASSERT(&enc->buf, 1 + SRL_MAX_VARINT_LENGTH + src_len); /* overallocate a bit sometimes */

1449

1318

if (is_utf8) {

1450

srl_buf_cat_varint_nocheck(aTHX_ enc, SRL_HDR_STR_UTF8, src_len);

1319

srl_buf_cat_varint_nocheck(aTHX_ &enc->buf, SRL_HDR_STR_UTF8, src_len);

1451

1320

} else if (src_len <= SRL_MASK_SHORT_BINARY_LEN) {

1452

srl_buf_cat_char_nocheck(enc, SRL_HDR_SHORT_BINARY_LOW | (char)src_len);

1321

srl_buf_cat_char_nocheck(&enc->buf, SRL_HDR_SHORT_BINARY_LOW | (char)src_len);

1453

1322

} else {

1454

srl_buf_cat_varint_nocheck(aTHX_ enc, SRL_HDR_BINARY, src_len);

1323

srl_buf_cat_varint_nocheck(aTHX_ &enc->buf, SRL_HDR_BINARY, src_len);

1455

1324

}

1456

1325

Copy(src, enc->buf.pos, src_len, char);

1457

1326

enc->buf.pos += src_len;

1458

1327

}

1459

1328

1460

1329

#ifdef HAS_HV_BACKREFS

1330

AV *

1331

srl_hv_backreferences_p_safe(pTHX_ HV *hv) {

1332

if (SvOOK(hv)) {

1333

struct xpvhv_aux * const iter = HvAUX(hv);

1334

return iter->xhv_backreferences;

1335

} else {

1336

return NULL;

1337

}

1338

}

1339

#endif

1461

1340

1462

1341

/* Dumps generic SVs and delegates

1463

1342

* to more specialized functions for RVs, etc. */

1482

1361

assert(src);

1483

1362

1484

1363

if (expect_false( ++enc->recursion_depth == enc->max_recursion_depth )) {

1485

croak("Hit maximum recursion depth (%lu), aborting serialization",

1486

(unsigned long)enc->max_recursion_depth);

1364

croak("Hit maximum recursion depth (%"UVuf"), aborting serialization",

1365

(UV)enc->max_recursion_depth);

1487

1366

}

1488

1367

1489

1368

redo_dump:

1491

1370

backrefs= NULL;

1492

1371

svt = SvTYPE(src);

1493

1372

refcount = SvREFCNT(src);

1494

DEBUG_ASSERT_BUF_SANE(enc);

1373

DEBUG_ASSERT_BUF_SANE(&enc->buf);

1495

1374

if ( SvMAGICAL(src) ) {

1496

1375

SvGETMAGIC(src);

1497

1376

#ifdef HAS_HV_BACKREFS

1501

1380

}

1502

1381

#ifdef HAS_HV_BACKREFS

1503

1382

if (expect_false( svt == SVt_PVHV && SvOOK(src) )) {

1504

backrefs= *Perl_hv_backreferences_p(aTHX_ (HV *)src);

1383

backrefs= srl_hv_backreferences_p_safe(aTHX_ (HV *)src);

1505

1384

if (DEBUGHACK) warn("backreferences %p", src);

1506

1385

}

1507

1386

#endif

1510

1389

PTABLE_ENTRY_t *pe= PTABLE_find(weak_seenhash, src);

1511

1390

if (!pe) {

1512

1391

/* not seen it before */

1513

if (DEBUGHACK) warn("scalar %p - is weak referent, storing %lu", src, weakref_ofs);

1392

if (DEBUGHACK) warn("scalar %p - is weak referent, storing %"UVuf, src, weakref_ofs);

1514

1393

/* if weakref_ofs is false we got here some way that holds a refcount on this item */

1515

1394

PTABLE_store(weak_seenhash, src, INT2PTR(void *, weakref_ofs));

1516

1395

} else {

1517

if (DEBUGHACK) warn("scalar %p - is weak referent, seen before value:%lu weakref_ofs:%lu",

1396

if (DEBUGHACK) warn("scalar %p - is weak referent, seen before value:%"UVuf" weakref_ofs:%"UVuf,

1518

1397

src, (UV)pe->value, (UV)weakref_ofs);

1519

1398

if (pe->value)

1520

1399

pe->value= INT2PTR(void *, weakref_ofs);

1527

1406

* if we see it again we recognize it */

1528

1407

if ( expect_false( refcount > 1 ) ) {

1529

1408

if (src == &PL_sv_undef && enc->protocol_version >=3 ) {

1530

srl_buf_cat_char(enc, SRL_HDR_CANONICAL_UNDEF);

1409

srl_buf_cat_char(&enc->buf, SRL_HDR_CANONICAL_UNDEF);

1531

1410

--enc->recursion_depth;

1532

1411

return;

1533

1412

}

1534

1413

else

1535

1414

if (src == &PL_sv_yes) {

1536

srl_buf_cat_char(enc, SRL_HDR_TRUE);

1415

srl_buf_cat_char(&enc->buf, SRL_HDR_TRUE);

1537

1416

--enc->recursion_depth;

1538

1417

return;

1539

1418

}

1540

1419

else

1541

1420

if (src == &PL_sv_no) {

1542

srl_buf_cat_char(enc, SRL_HDR_FALSE);

1421

srl_buf_cat_char(&enc->buf, SRL_HDR_FALSE);

1543

1422

--enc->recursion_depth;

1544

1423

return;

1545

1424

}

1549

1428

if (expect_false(oldoffset)) {

1550

1429

/* we have seen it before, so we do not need to bless it again */

1551

1430

if (ref_rewrite_pos) {

1552

if (DEBUGHACK) warn("ref to %p as %lu", src, (long unsigned int)oldoffset);

1431

if (DEBUGHACK) warn("ref to %p as %"UVuf, src, (UV)oldoffset);

1553

1432

enc->buf.pos= enc->buf.body_pos + ref_rewrite_pos;

1554

srl_buf_cat_varint(aTHX_ enc, SRL_HDR_REFP, (UV)oldoffset);

1433

srl_buf_cat_varint(aTHX_ &enc->buf, SRL_HDR_REFP, (UV)oldoffset);

1555

1434

} else {

1556

if (DEBUGHACK) warn("alias to %p as %lu", src, (long unsigned int)oldoffset);

1557

srl_buf_cat_varint(aTHX_ enc, SRL_HDR_ALIAS, (UV)oldoffset);

1435

if (DEBUGHACK) warn("alias to %p as %"UVuf, src, (UV)oldoffset);

1436

srl_buf_cat_varint(aTHX_ &enc->buf, SRL_HDR_ALIAS, (UV)oldoffset);

1558

1437

}

1559

1438

SRL_SET_TRACK_FLAG(*(enc->buf.body_pos + oldoffset));

1560

1439

--enc->recursion_depth;

1561

1440

return;

1562

1441

}

1563

if (DEBUGHACK) warn("storing %p as %lu", src, (long unsigned int)BODY_POS_OFS(enc->buf));

1564

PTABLE_store(ref_seenhash, src, INT2PTR(void *, BODY_POS_OFS(enc->buf)));

1442

if (DEBUGHACK) warn("storing %p as %"UVuf, src, (UV)BODY_POS_OFS(&enc->buf));

1443

PTABLE_store(ref_seenhash, src, INT2PTR(void *, BODY_POS_OFS(&enc->buf)));

1565

1444

}

1566

1445

}

1446

1567

1447

if (expect_false( weakref_ofs != 0 )) {

1568

1448

sv_dump(src);

1569

croak("Corrupted weakref? weakref_ofs=0 (this should not happen)");

1449

croak("Corrupted weakref? weakref_ofs should be 0, but got %"UVuf" (this should not happen)", weakref_ofs);

1570

1450

}

1451

1571

1452

if (replacement) {

1572

1453

if (SvROK(replacement)) {

1573

1454

src= SvRV(replacement);

1606

1487

#endif

1607

1488

if (expect_false( SvWEAKREF(src) )) {

1608

1489

if (DEBUGHACK) warn("Is weakref %p", src);

1609

weakref_ofs= BODY_POS_OFS(enc->buf);

1610

srl_buf_cat_char(enc, SRL_HDR_WEAKEN);

1490

weakref_ofs= BODY_POS_OFS(&enc->buf);

1491

srl_buf_cat_char(&enc->buf, SRL_HDR_WEAKEN);

1611

1492

}

1612

1493

1613

ref_rewrite_pos= BODY_POS_OFS(enc->buf);

1494

ref_rewrite_pos= BODY_POS_OFS(&enc->buf);

1614

1495

1615

1496

if (expect_false( sv_isobject(src) )) {

1616

1497

/* Write bless operator with class name */

1618

1499

srl_dump_classname(aTHX_ enc, referent, replacement); /* 1 == have freeze call */

1619

1500

}

1620

1501

1621

srl_buf_cat_char(enc, SRL_HDR_REFN);

1502

srl_buf_cat_char(&enc->buf, SRL_HDR_REFN);

1622

1503

refsv= src;

1623

1504

src= referent;

1624

1505

1663

1544

PTABLE_delete(ref_seenhash, src); \

1664

1545

enc->buf.pos= enc->buf.body_pos + ref_rewrite_pos; \

1665

1546

} \

1666

srl_buf_cat_char((enc), SRL_HDR_UNDEF); \

1547

srl_buf_cat_char(&(enc)->buf, SRL_HDR_UNDEF); \

1667

1548

} \

1668

1549

else if ( SRL_ENC_HAVE_OPTION((enc), SRL_F_STRINGIFY_UNKNOWN) ) { \

1669

1550

STRLEN len; \

1703

1584

SRL_HANDLE_UNSUPPORTED_TYPE(enc, src, svt, refsv, ref_rewrite_pos);

1704

1585

}

1705

1586

else if (src == &PL_sv_undef && enc->protocol_version >= 3 ) {

1706

srl_buf_cat_char(enc, SRL_HDR_CANONICAL_UNDEF);

1587

srl_buf_cat_char(&enc->buf, SRL_HDR_CANONICAL_UNDEF);

1707

1588

} else {

1708

srl_buf_cat_char(enc, SRL_HDR_UNDEF);

1589

srl_buf_cat_char(&enc->buf, SRL_HDR_UNDEF);

1709

1590

}

1710

1591

}

1711

1592

else {