src/pmc_freeze.c

   1 /*
   2 Copyright (C) 2001-2009, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/pmc_freeze.c - Freeze and thaw functionality
   8
   9 =head1 DESCRIPTION
  10
  11 Thawing PMCs uses a list with (maximum) size of the amount of PMCs to
  12 keep track of retrieved PMCs.
  13
  14 The individual information of PMCs is frozen/thawed by their vtables.
  15
  16 To avoid recursion, the whole functionality is driven by
  17 C<< pmc->vtable->visit >>, which is called for the first PMC initially.
  18 Container PMCs call a "todo-callback" for all contained PMCs. The
  19 individual action vtable (freeze/thaw) is then called for all todo-PMCs.
  20
  21 In the current implementation C<IMAGE_IO> is a stand-in for some kind of
  22 serializer PMC which will eventually be written. It associates a Parrot
  23 C<STRING> with a vtable.
  24
  25 =cut
  26
  27 */
  28
  29 #include "parrot/parrot.h"
  30 #include "pmc/pmc_context.h"
  31 #include "pmc_freeze.str"
  32
  33 /* HEADERIZER HFILE: include/parrot/pmc_freeze.h */
  34 /* HEADERIZER BEGIN: static */
  35 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  36
  37 static void create_image(PARROT_INTERP,
  38     ARGIN_NULLOK(PMC *pmc),
  39     ARGMOD(visit_info *info))
  40         __attribute__nonnull__(1)
  41         __attribute__nonnull__(3)
  42         FUNC_MODIFIES(*info);
  43
  44 PARROT_INLINE
  45 static void do_action(PARROT_INTERP,
  46     ARGIN_NULLOK(PMC *pmc),
  47     ARGIN(visit_info *info),
  48     int seen,
  49     UINTVAL id)
  50         __attribute__nonnull__(1)
  51         __attribute__nonnull__(3);
  52
  53 PARROT_INLINE
  54 static void do_thaw(PARROT_INTERP,
  55     ARGIN_NULLOK(PMC *pmc),
  56     ARGIN(visit_info *info))
  57         __attribute__nonnull__(1)
  58         __attribute__nonnull__(3);
  59
  60 PARROT_INLINE
  61 static void freeze_pmc(PARROT_INTERP,
  62     ARGIN_NULLOK(PMC *pmc),
  63     ARGIN(visit_info *info),
  64     int seen,
  65     UINTVAL id)
  66         __attribute__nonnull__(1)
  67         __attribute__nonnull__(3);
  68
  69 static void ft_init(PARROT_INTERP, ARGIN(visit_info *info))
  70         __attribute__nonnull__(1)
  71         __attribute__nonnull__(2);
  72
  73 PARROT_INLINE
  74 static void op_check_size(PARROT_INTERP, ARGIN(STRING *s), size_t len)
  75         __attribute__nonnull__(1)
  76         __attribute__nonnull__(2);
  77
  78 static void push_opcode_integer(PARROT_INTERP,
  79     ARGIN(IMAGE_IO *io),
  80     INTVAL v)
  81         __attribute__nonnull__(1)
  82         __attribute__nonnull__(2);
  83
  84 static void push_opcode_number(PARROT_INTERP,
  85     ARGIN(IMAGE_IO *io),
  86     FLOATVAL v)
  87         __attribute__nonnull__(1)
  88         __attribute__nonnull__(2);
  89
  90 static void push_opcode_pmc(PARROT_INTERP,
  91     ARGIN(IMAGE_IO *io),
  92     ARGIN(PMC* v))
  93         __attribute__nonnull__(1)
  94         __attribute__nonnull__(2)
  95         __attribute__nonnull__(3);
  96
  97 static void push_opcode_string(PARROT_INTERP,
  98     ARGIN(IMAGE_IO *io),
  99     ARGIN(STRING *v))
 100         __attribute__nonnull__(1)
 101         __attribute__nonnull__(2)
 102         __attribute__nonnull__(3);
 103
 104 PARROT_WARN_UNUSED_RESULT
 105 PARROT_CAN_RETURN_NULL
 106 static PMC* run_thaw(PARROT_INTERP,
 107     ARGIN(STRING* image),
 108     visit_enum_type what)
 109         __attribute__nonnull__(1)
 110         __attribute__nonnull__(2);
 111
 112 static INTVAL shift_opcode_integer(SHIM_INTERP, ARGIN(IMAGE_IO *io))
 113         __attribute__nonnull__(2);
 114
 115 static FLOATVAL shift_opcode_number(SHIM_INTERP, ARGIN(IMAGE_IO *io))
 116         __attribute__nonnull__(2);
 117
 118 PARROT_WARN_UNUSED_RESULT
 119 PARROT_CAN_RETURN_NULL
 120 static PMC* shift_opcode_pmc(PARROT_INTERP, ARGIN(IMAGE_IO *io))
 121         __attribute__nonnull__(1)
 122         __attribute__nonnull__(2);
 123
 124 PARROT_WARN_UNUSED_RESULT
 125 PARROT_CANNOT_RETURN_NULL
 126 static STRING* shift_opcode_string(PARROT_INTERP, ARGIN(IMAGE_IO *io))
 127         __attribute__nonnull__(1)
 128         __attribute__nonnull__(2);
 129
 130 PARROT_INLINE
 131 PARROT_CANNOT_RETURN_NULL
 132 static PMC* thaw_create_pmc(PARROT_INTERP,
 133     ARGIN(const visit_info *info),
 134     INTVAL type)
 135         __attribute__nonnull__(1)
 136         __attribute__nonnull__(2);
 137
 138 PARROT_INLINE
 139 static int thaw_pmc(PARROT_INTERP,
 140     ARGMOD(visit_info *info),
 141     ARGOUT(UINTVAL *id),
 142     ARGOUT(INTVAL *type))
 143         __attribute__nonnull__(1)
 144         __attribute__nonnull__(2)
 145         __attribute__nonnull__(3)
 146         __attribute__nonnull__(4)
 147         FUNC_MODIFIES(*info)
 148         FUNC_MODIFIES(*id)
 149         FUNC_MODIFIES(*type);
 150
 151 static void todo_list_init(PARROT_INTERP, ARGOUT(visit_info *info))
 152         __attribute__nonnull__(1)
 153         __attribute__nonnull__(2)
 154         FUNC_MODIFIES(*info);
 155
 156 PARROT_INLINE
 157 static int todo_list_seen(PARROT_INTERP,
 158     ARGIN(PMC *pmc),
 159     ARGMOD(visit_info *info),
 160     ARGOUT(UINTVAL *id))
 161         __attribute__nonnull__(1)
 162         __attribute__nonnull__(2)
 163         __attribute__nonnull__(3)
 164         __attribute__nonnull__(4)
 165         FUNC_MODIFIES(*info)
 166         FUNC_MODIFIES(*id);
 167
 168 static void visit_loop_todo_list(PARROT_INTERP,
 169     ARGIN_NULLOK(PMC *current),
 170     ARGIN(visit_info *info))
 171         __attribute__nonnull__(1)
 172         __attribute__nonnull__(3);
 173
 174 static void visit_todo_list(PARROT_INTERP,
 175     ARGIN_NULLOK(PMC* pmc),
 176     ARGIN(visit_info* info))
 177         __attribute__nonnull__(1)
 178         __attribute__nonnull__(3);
 179
 180 static void visit_todo_list_thaw(PARROT_INTERP,
 181     ARGIN_NULLOK(PMC* old),
 182     ARGIN(visit_info* info))
 183         __attribute__nonnull__(1)
 184         __attribute__nonnull__(3);
 185
 186 #define ASSERT_ARGS_create_image __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 187        PARROT_ASSERT_ARG(interp) \
 188     , PARROT_ASSERT_ARG(info))
 189 #define ASSERT_ARGS_do_action __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 190        PARROT_ASSERT_ARG(interp) \
 191     , PARROT_ASSERT_ARG(info))
 192 #define ASSERT_ARGS_do_thaw __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 193        PARROT_ASSERT_ARG(interp) \
 194     , PARROT_ASSERT_ARG(info))
 195 #define ASSERT_ARGS_freeze_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 196        PARROT_ASSERT_ARG(interp) \
 197     , PARROT_ASSERT_ARG(info))
 198 #define ASSERT_ARGS_ft_init __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 199        PARROT_ASSERT_ARG(interp) \
 200     , PARROT_ASSERT_ARG(info))
 201 #define ASSERT_ARGS_op_check_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 202        PARROT_ASSERT_ARG(interp) \
 203     , PARROT_ASSERT_ARG(s))
 204 #define ASSERT_ARGS_push_opcode_integer __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 205        PARROT_ASSERT_ARG(interp) \
 206     , PARROT_ASSERT_ARG(io))
 207 #define ASSERT_ARGS_push_opcode_number __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 208        PARROT_ASSERT_ARG(interp) \
 209     , PARROT_ASSERT_ARG(io))
 210 #define ASSERT_ARGS_push_opcode_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 211        PARROT_ASSERT_ARG(interp) \
 212     , PARROT_ASSERT_ARG(io) \
 213     , PARROT_ASSERT_ARG(v))
 214 #define ASSERT_ARGS_push_opcode_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 215        PARROT_ASSERT_ARG(interp) \
 216     , PARROT_ASSERT_ARG(io) \
 217     , PARROT_ASSERT_ARG(v))
 218 #define ASSERT_ARGS_run_thaw __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 219        PARROT_ASSERT_ARG(interp) \
 220     , PARROT_ASSERT_ARG(image))
 221 #define ASSERT_ARGS_shift_opcode_integer __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 222        PARROT_ASSERT_ARG(io))
 223 #define ASSERT_ARGS_shift_opcode_number __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 224        PARROT_ASSERT_ARG(io))
 225 #define ASSERT_ARGS_shift_opcode_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 226        PARROT_ASSERT_ARG(interp) \
 227     , PARROT_ASSERT_ARG(io))
 228 #define ASSERT_ARGS_shift_opcode_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 229        PARROT_ASSERT_ARG(interp) \
 230     , PARROT_ASSERT_ARG(io))
 231 #define ASSERT_ARGS_thaw_create_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 232        PARROT_ASSERT_ARG(interp) \
 233     , PARROT_ASSERT_ARG(info))
 234 #define ASSERT_ARGS_thaw_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 235        PARROT_ASSERT_ARG(interp) \
 236     , PARROT_ASSERT_ARG(info) \
 237     , PARROT_ASSERT_ARG(id) \
 238     , PARROT_ASSERT_ARG(type))
 239 #define ASSERT_ARGS_todo_list_init __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 240        PARROT_ASSERT_ARG(interp) \
 241     , PARROT_ASSERT_ARG(info))
 242 #define ASSERT_ARGS_todo_list_seen __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 243        PARROT_ASSERT_ARG(interp) \
 244     , PARROT_ASSERT_ARG(pmc) \
 245     , PARROT_ASSERT_ARG(info) \
 246     , PARROT_ASSERT_ARG(id))
 247 #define ASSERT_ARGS_visit_loop_todo_list __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 248        PARROT_ASSERT_ARG(interp) \
 249     , PARROT_ASSERT_ARG(info))
 250 #define ASSERT_ARGS_visit_todo_list __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 251        PARROT_ASSERT_ARG(interp) \
 252     , PARROT_ASSERT_ARG(info))
 253 #define ASSERT_ARGS_visit_todo_list_thaw __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 254        PARROT_ASSERT_ARG(interp) \
 255     , PARROT_ASSERT_ARG(info))
 256 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 257 /* HEADERIZER END: static */
 258
 259 /* when thawing a string longer then this size, we first do a GC run and then
 260  * block GC - the system can't give us more headers */
 261
 262 #define THAW_BLOCK_GC_SIZE 100000
 263
 264 /* preallocate freeze image for aggregates with this estimation */
 265 #define FREEZE_BYTES_PER_ITEM 9
 266
 267 /* macros/constants to handle packing/unpacking of PMC IDs and flags
 268  * the 2 LSBs are used for flags, all other bits are used for PMC ID
 269  */
 270 #define PackID_new(id, flags)       (((UINTVAL)(id) * 4) | ((UINTVAL)(flags) & 3))
 271 #define PackID_get_PMCID(id)        ((UINTVAL)(id) / 4)
 272 #define PackID_set_PMCID(lv, id)    (lv) = PackID_new((id), PackID_get_FLAGS(lv))
 273 #define PackID_get_FLAGS(id)        ((UINTVAL)(id) & 3)
 274 #define PackID_set_FLAGS(lv, flags) (lv) = PackID_new(PackID_get_PMCID(lv), (flags))
 275
 276 enum {
 277     enum_PackID_normal     = 0,
 278     enum_PackID_seen       = 1,
 279     enum_PackID_prev_type  = 2,
 280     enum_PackID_extra_info = 3
 281 };
 282
 283 /*
 284
 285 =head2 C<opcode_t> IO Functions
 286
 287 =over 4
 288
 289 =item C<static void op_check_size(PARROT_INTERP, STRING *s, size_t len)>
 290
 291 Checks the size of the "stream" buffer to see if it can accommodate
 292 C<len> more bytes. If not, expands the buffer.
 293
 294 =cut
 295
 296 */
 297
 298 PARROT_INLINE
 299 static void
 300 op_check_size(PARROT_INTERP, ARGIN(STRING *s), size_t len)
 301 {
 302     ASSERT_ARGS(op_check_size)
 303     const size_t used      = s->bufused;
 304     const int    need_free = (int)Buffer_buflen(s) - used - len;
 305
 306     /* grow by factor 1.5 or such */
 307     if (need_free <= 16) {
 308         size_t new_size = (size_t) (Buffer_buflen(s) * 1.5);
 309         if (new_size < Buffer_buflen(s) - need_free + 512)
 310             new_size = Buffer_buflen(s) - need_free + 512;
 311         Parrot_gc_reallocate_string_storage(interp, s, new_size);
 312         PARROT_ASSERT(Buffer_buflen(s) - used - len >= 15);
 313     }
 314
 315 #ifndef DISABLE_GC_DEBUG
 316     Parrot_gc_compact_memory_pool(interp);
 317 #endif
 318
 319 }
 320
 321
 322 /*
 323
 324 =item C<static void push_opcode_integer(PARROT_INTERP, IMAGE_IO *io, INTVAL v)>
 325
 326 Pushes the integer C<v> onto the end of the C<*io> "stream".
 327
 328 XXX assumes sizeof (opcode_t) == sizeof (INTVAL).
 329
 330 =cut
 331
 332 */
 333
 334 static void
 335 push_opcode_integer(PARROT_INTERP, ARGIN(IMAGE_IO *io), INTVAL v)
 336 {
 337     ASSERT_ARGS(push_opcode_integer)
 338     UINTVAL size = sizeof (opcode_t);
 339     STRING   *op = Parrot_str_new_init(interp, (char *)&v, size,
 340         Parrot_fixed_8_encoding_ptr, Parrot_binary_charset_ptr, 0);
 341
 342     PARROT_ASSERT(sizeof (opcode_t) == sizeof (INTVAL));
 343     io->image = Parrot_str_append(interp, io->image, op);
 344 }
 345
 346
 347 /*
 348
 349 =item C<static void push_opcode_number(PARROT_INTERP, IMAGE_IO *io, FLOATVAL v)>
 350
 351 Pushes the number C<v> onto the end of the C<*io> "stream".
 352
 353 =cut
 354
 355 */
 356
 357 static void
 358 push_opcode_number(PARROT_INTERP, ARGIN(IMAGE_IO *io), FLOATVAL v)
 359 {
 360     ASSERT_ARGS(push_opcode_number)
 361
 362     opcode_t      *ignored;
 363     STRING * const s    = io->image;
 364     const size_t   len  = PF_size_number() * sizeof (opcode_t);
 365     const size_t   used = s->bufused;
 366
 367     op_check_size(interp, s, len);
 368     ignored = PF_store_number((opcode_t *)((ptrcast_t)s->strstart + used), &v);
 369     UNUSED(ignored);
 370
 371     s->bufused += len;
 372     s->strlen  += len;
 373 }
 374
 375
 376 /*
 377
 378 =item C<static void push_opcode_string(PARROT_INTERP, IMAGE_IO *io, STRING *v)>
 379
 380 Pushes the string C<*v> onto the end of the C<*io> "stream".
 381
 382 =cut
 383
 384 */
 385
 386 static void
 387 push_opcode_string(PARROT_INTERP, ARGIN(IMAGE_IO *io), ARGIN(STRING *v))
 388 {
 389     ASSERT_ARGS(push_opcode_string)
 390
 391     opcode_t      *ignored;
 392     STRING * const s    = io->image;
 393     const size_t   len  = PF_size_string(v) * sizeof (opcode_t);
 394     const size_t   used = s->bufused;
 395
 396     op_check_size(interp, s, len);
 397     ignored = PF_store_string((opcode_t *)((ptrcast_t)s->strstart + used), v);
 398     UNUSED(ignored);
 399
 400     s->bufused += len;
 401     s->strlen += len;
 402 }
 403
 404
 405 /*
 406
 407 =item C<static void push_opcode_pmc(PARROT_INTERP, IMAGE_IO *io, PMC* v)>
 408
 409 Pushes the PMC C<*v> onto the end of the C<*io> "stream".
 410
 411 =cut
 412
 413 */
 414
 415 static void
 416 push_opcode_pmc(PARROT_INTERP, ARGIN(IMAGE_IO *io), ARGIN(PMC* v))
 417 {
 418     ASSERT_ARGS(push_opcode_pmc)
 419     UINTVAL size = sizeof (opcode_t);
 420     STRING   *op = Parrot_str_new_init(interp, (char *)&v, size,
 421         Parrot_fixed_8_encoding_ptr, Parrot_binary_charset_ptr, 0);
 422     io->image = Parrot_str_append(interp, io->image, op);
 423 }
 424
 425
 426 /*
 427
 428 =item C<static INTVAL shift_opcode_integer(PARROT_INTERP, IMAGE_IO *io)>
 429
 430 Removes and returns an integer from the start of the C<*io> "stream".
 431
 432 =cut
 433
 434 */
 435
 436 static INTVAL
 437 shift_opcode_integer(SHIM_INTERP, ARGIN(IMAGE_IO *io))
 438 {
 439     ASSERT_ARGS(shift_opcode_integer)
 440     const char * const   start  = (char *)io->image->strstart;
 441     char               **opcode = &io->image->strstart;
 442     const INTVAL i              = PF_fetch_integer(io->pf,
 443                                     (const opcode_t **)opcode);
 444
 445     io->image->bufused -= ((char *)io->image->strstart - start);
 446     io->image->strlen  -= ((char *)io->image->strstart - start);
 447
 448     PARROT_ASSERT((int)io->image->bufused >= 0);
 449
 450     return i;
 451 }
 452
 453
 454 /*
 455
 456 =item C<static PMC* shift_opcode_pmc(PARROT_INTERP, IMAGE_IO *io)>
 457
 458 Removes and returns an PMC from the start of the C<*io> "stream".
 459
 460 Note that this actually reads a PMC id, not a PMC.
 461
 462 =cut
 463
 464 */
 465
 466 PARROT_WARN_UNUSED_RESULT
 467 PARROT_CAN_RETURN_NULL
 468 static PMC*
 469 shift_opcode_pmc(PARROT_INTERP, ARGIN(IMAGE_IO *io))
 470 {
 471     ASSERT_ARGS(shift_opcode_pmc)
 472     INTVAL i = shift_opcode_integer(interp, io);
 473     return (PMC *)i;
 474 }
 475
 476
 477 /*
 478
 479 =item C<static FLOATVAL shift_opcode_number(PARROT_INTERP, IMAGE_IO *io)>
 480
 481 Removes and returns an number from the start of the C<*io> "stream".
 482
 483 =cut
 484
 485 */
 486
 487 static FLOATVAL
 488 shift_opcode_number(SHIM_INTERP, ARGIN(IMAGE_IO *io))
 489 {
 490     ASSERT_ARGS(shift_opcode_number)
 491
 492     const char * const   start  = (const char *)io->image->strstart;
 493     char               **opcode = &io->image->strstart;
 494     const FLOATVAL       f      = PF_fetch_number(io->pf,
 495                                     (const opcode_t **)opcode);
 496
 497     io->image->bufused -= ((char *)io->image->strstart - start);
 498     io->image->strlen  -= ((char *)io->image->strstart - start);
 499
 500     PARROT_ASSERT((int)io->image->bufused >= 0);
 501
 502     return f;
 503 }
 504
 505
 506 /*
 507
 508 =item C<static STRING* shift_opcode_string(PARROT_INTERP, IMAGE_IO *io)>
 509
 510 Removes and returns a string from the start of the C<*io> "stream".
 511
 512 =cut
 513
 514 */
 515
 516 PARROT_WARN_UNUSED_RESULT
 517 PARROT_CANNOT_RETURN_NULL
 518 static STRING*
 519 shift_opcode_string(PARROT_INTERP, ARGIN(IMAGE_IO *io))
 520 {
 521     ASSERT_ARGS(shift_opcode_string)
 522
 523     char * const   start  = (char*)io->image->strstart;
 524     char *         opcode = io->image->strstart;
 525     STRING * const s      = PF_fetch_string(interp, io->pf,
 526                                 (const opcode_t **)&opcode);
 527
 528     io->image->strstart = opcode;
 529     io->image->bufused -= (opcode - start);
 530     io->image->strlen  -= (opcode - start);
 531
 532     PARROT_ASSERT((int)io->image->bufused >= 0);
 533
 534     return s;
 535 }
 536
 537
 538 /*
 539
 540 =back
 541
 542 =head2 Helper Functions
 543
 544 =over 4
 545
 546 =cut
 547
 548 */
 549
 550 /*
 551  * this function setup stuff may be replaced by a real PMC
 552  * in the future
 553  * TODO add read/write header functions, e.g. vtable->init_pmc
 554  */
 555
 556 static image_funcs opcode_funcs = {
 557     push_opcode_integer,
 558     push_opcode_pmc,
 559     push_opcode_string,
 560     push_opcode_number,
 561     shift_opcode_integer,
 562     shift_opcode_pmc,
 563     shift_opcode_string,
 564     shift_opcode_number
 565 };
 566
 567 /*
 568
 569 =item C<static void ft_init(PARROT_INTERP, visit_info *info)>
 570
 571 Initializes the freeze/thaw subsystem.
 572
 573 =cut
 574
 575 */
 576
 577 static void
 578 ft_init(PARROT_INTERP, ARGIN(visit_info *info))
 579 {
 580     ASSERT_ARGS(ft_init)
 581     STRING   *s = info->image;
 582     PackFile *pf;
 583
 584     /* We want to store a 16-byte aligned header, but the actual
 585      * header may be shorter. */
 586     const unsigned int header_length = PACKFILE_HEADER_BYTES +
 587         (PACKFILE_HEADER_BYTES % 16 ?
 588          16 - PACKFILE_HEADER_BYTES % 16 : 0);
 589
 590     info->image_io         = mem_allocate_typed(IMAGE_IO);
 591     info->image_io->image  = s = info->image;
 592
 593     info->image_io->vtable = &opcode_funcs;
 594
 595     pf = info->image_io->pf = PackFile_new(interp, 0);
 596
 597     if (info->what == VISIT_FREEZE_NORMAL
 598     ||  info->what == VISIT_FREEZE_AT_DESTRUCT) {
 599
 600         op_check_size(interp, s, header_length);
 601         mem_sys_memcopy(s->strstart, pf->header, PACKFILE_HEADER_BYTES);
 602         s->bufused += header_length;
 603         s->strlen  += header_length;
 604     }
 605     else {
 606         if (Parrot_str_byte_length(interp, s) < header_length) {
 607             Parrot_ex_throw_from_c_args(interp, NULL,
 608                 EXCEPTION_INVALID_STRING_REPRESENTATION,
 609                 "bad string to thaw");
 610         }
 611
 612         /* TT #749: use the validation logic from Packfile_unpack */
 613         if (pf->header->bc_major != PARROT_PBC_MAJOR
 614         ||  pf->header->bc_minor != PARROT_PBC_MINOR)
 615             Parrot_ex_throw_from_c_args(interp, NULL,
 616                     EXCEPTION_INVALID_STRING_REPRESENTATION,
 617                     "can't thaw a PMC from Parrot %d.%d", pf->header->bc_major,
 618                     pf->header->bc_minor);
 619
 620         mem_sys_memcopy(pf->header, s->strstart, PACKFILE_HEADER_BYTES);
 621         PackFile_assign_transforms(pf);
 622
 623         s->bufused -= header_length;
 624         s->strlen  -= header_length;
 625
 626         LVALUE_CAST(char *, s->strstart) += header_length;
 627     }
 628
 629     info->last_type   = -1;
 630     info->id_list     = pmc_new(interp, enum_class_Array);
 631     info->id          = 0;
 632     info->extra_flags = EXTRA_IS_NULL;
 633     info->container   = NULL;
 634 }
 635
 636
 637 /*
 638
 639 =item C<static void todo_list_init(PARROT_INTERP, visit_info *info)>
 640
 641 Initializes the C<*info> lists.
 642
 643 =cut
 644
 645 */
 646
 647 static void
 648 todo_list_init(PARROT_INTERP, ARGOUT(visit_info *info))
 649 {
 650     ASSERT_ARGS(todo_list_init)
 651     info->visit_pmc_now   = visit_todo_list;
 652
 653     /* we must use PMCs here so that they get marked properly */
 654     info->todo = pmc_new(interp, enum_class_Array);
 655     info->seen = pmc_new(interp, enum_class_Hash);
 656     VTABLE_set_pointer(interp, info->seen, parrot_new_intval_hash(interp));
 657
 658     ft_init(interp, info);
 659 }
 660
 661
 662 /*
 663
 664 =item C<static void freeze_pmc(PARROT_INTERP, PMC *pmc, visit_info *info, int
 665 seen, UINTVAL id)>
 666
 667 Freeze PMC, setting type, seen, and "same-as-last" indicators as
 668 appropriate.
 669
 670 =cut
 671
 672 */
 673
 674 PARROT_INLINE
 675 static void
 676 freeze_pmc(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc), ARGIN(visit_info *info),
 677         int seen, UINTVAL id)
 678 {
 679     ASSERT_ARGS(freeze_pmc)
 680     IMAGE_IO * const io = info->image_io;
 681     INTVAL           type;
 682
 683     if (PMC_IS_NULL(pmc)) {
 684         /* NULL + seen bit */
 685         VTABLE_push_pmc(interp, io, (PMC*)PackID_new(NULL, enum_PackID_seen));
 686         return;
 687     }
 688
 689     type = pmc->vtable->base_type;
 690
 691     if (PObj_is_object_TEST(pmc))
 692         type = enum_class_Object;
 693
 694     if (seen) {
 695         if (info->extra_flags) {
 696             PackID_set_FLAGS(id, enum_PackID_extra_info);
 697             VTABLE_push_pmc(interp, io, (PMC *)id);
 698             VTABLE_push_integer(interp, io, info->extra_flags);
 699             return;
 700         }
 701
 702         PackID_set_FLAGS(id, enum_PackID_seen);
 703     }
 704     else if (type == info->last_type)
 705         PackID_set_FLAGS(id, enum_PackID_prev_type);
 706
 707     VTABLE_push_pmc(interp, io, (PMC*)id);
 708
 709     if (PackID_get_FLAGS(id) == enum_PackID_normal) {
 710         /* write type */
 711         VTABLE_push_integer(interp, io, type);
 712         info->last_type = type;
 713     }
 714 }
 715
 716
 717 /*
 718
 719 =item C<static int thaw_pmc(PARROT_INTERP, visit_info *info, UINTVAL *id, INTVAL
 720 *type)>
 721
 722 Freeze and thaw a PMC (id).
 723
 724 For example, the ASCII representation of the C<Array>
 725
 726     P0 = [P1=666, P2=777, P0]
 727
 728 may look like this:
 729
 730     0xdf4 30 3 0xdf8 33 666 0xdf2 777 0xdf5
 731
 732 where 30 is C<class_enum_Array>, 33 is C<class_enum_Integer>, the
 733 type of the second C<Integer> is suppressed, the repeated P0 has bit 0
 734 set.
 735
 736 =cut
 737
 738 */
 739
 740 PARROT_INLINE
 741 static int
 742 thaw_pmc(PARROT_INTERP, ARGMOD(visit_info *info),
 743         ARGOUT(UINTVAL *id), ARGOUT(INTVAL *type))
 744 {
 745     ASSERT_ARGS(thaw_pmc)
 746     IMAGE_IO * const io   = info->image_io;
 747     PMC             *n    = VTABLE_shift_pmc(interp, io);
 748     int              seen = 0;
 749
 750     info->extra_flags     = EXTRA_IS_NULL;
 751
 752     switch (PackID_get_FLAGS(n)) {
 753       case enum_PackID_extra_info:
 754         /* pmc has extra data */
 755         info->extra_flags = VTABLE_shift_integer(interp, io);
 756         break;
 757       case enum_PackID_seen:
 758         seen = 1;
 759         break;
 760       case enum_PackID_prev_type:
 761         /* prev PMC was same type */
 762         *type = info->last_type;
 763         break;
 764       default:
 765         /* type follows */
 766         {
 767             *type           = VTABLE_shift_integer(interp, io);
 768             info->last_type = *type;
 769
 770             if (*type <= 0)
 771                 Parrot_ex_throw_from_c_args(interp, NULL, 1,
 772                     "Unknown PMC type to thaw %d", (int) *type);
 773
 774             /* that ought to be a class */
 775             if (*type >= interp->n_vtable_max || !interp->vtables[*type])
 776                 *type = enum_class_Class;
 777         }
 778         break;
 779     }
 780
 781     *id = (UINTVAL)n;
 782     return seen;
 783 }
 784
 785
 786 /*
 787
 788 =item C<static void do_action(PARROT_INTERP, PMC *pmc, visit_info *info, int
 789 seen, UINTVAL id)>
 790
 791 Called from C<visit_todo_list()> to perform the action specified in
 792 C<< info->what >>.
 793
 794 Currently only C<VISIT_FREEZE_NORMAL> and C<VISIT_FREEZE_AT_DESTRUCT> are
 795 implemented.
 796
 797 =cut
 798
 799 */
 800
 801 PARROT_INLINE
 802 static void
 803 do_action(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc), ARGIN(visit_info *info),
 804         int seen, UINTVAL id)
 805 {
 806     ASSERT_ARGS(do_action)
 807     switch (info->what) {
 808         case VISIT_FREEZE_AT_DESTRUCT:
 809         case VISIT_FREEZE_NORMAL:
 810             freeze_pmc(interp, pmc, info, seen, id);
 811             if (pmc)
 812                 info->visit_action = pmc->vtable->freeze;
 813             break;
 814         default:
 815             Parrot_ex_throw_from_c_args(interp, NULL, 1, "Illegal action %ld",
 816                 (long)info->what);
 817     }
 818 }
 819
 820
 821 /*
 822
 823 =item C<static PMC* thaw_create_pmc(PARROT_INTERP, const visit_info *info,
 824 INTVAL type)>
 825
 826 Called from C<do_thaw()> to attach the vtable etc. to C<*pmc>.
 827
 828 =cut
 829
 830 */
 831
 832 PARROT_INLINE
 833 PARROT_CANNOT_RETURN_NULL
 834 static PMC*
 835 thaw_create_pmc(PARROT_INTERP, ARGIN(const visit_info *info),
 836         INTVAL type)
 837 {
 838     ASSERT_ARGS(thaw_create_pmc)
 839     PMC *pmc;
 840     switch (info->what) {
 841         case VISIT_THAW_NORMAL:
 842             pmc = pmc_new_noinit(interp, type);
 843             break;
 844         case VISIT_THAW_CONSTANTS:
 845             pmc = constant_pmc_new_noinit(interp, type);
 846             break;
 847         default:
 848             Parrot_ex_throw_from_c_args(interp, NULL, 1,
 849                 "Illegal visit_next type");
 850     }
 851
 852     return pmc;
 853 }
 854
 855
 856 /*
 857
 858 =item C<static void do_thaw(PARROT_INTERP, PMC *pmc, visit_info *info)>
 859
 860 Called by C<visit_todo_list_thaw()> to thaw and return a PMC.
 861
 862 C<seen> is false if this is the first time the PMC has been encountered.
 863
 864 =cut
 865
 866 */
 867
 868 PARROT_INLINE
 869 static void
 870 do_thaw(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc), ARGIN(visit_info *info))
 871 {
 872     ASSERT_ARGS(do_thaw)
 873     PMC **pos;
 874
 875     /* set below, but avoid compiler warning */
 876     UINTVAL id             = 0;
 877     INTVAL  type           = 0;
 878     int     must_have_seen = thaw_pmc(interp, info, &id, &type);
 879
 880     id = PackID_get_PMCID(id);
 881
 882     if (!id) {
 883         /* got a NULL PMC */
 884         pmc = PMCNULL;
 885         if (!info->thaw_result)
 886             info->thaw_result = pmc;
 887         else
 888             *info->thaw_ptr = pmc;
 889         return;
 890     }
 891
 892     pos = (PMC **)Parrot_pmc_array_get(interp, (List *)PMC_data(info->id_list),
 893         id, enum_type_PMC);
 894
 895     if (pos == (void *)-1)
 896         pos = NULL;
 897     else if (pos) {
 898         pmc = *(PMC **)pos;
 899         if (!pmc)
 900             pos = NULL;
 901     }
 902
 903     if (pos) {
 904         if (info->extra_flags == EXTRA_IS_PROP_HASH) {
 905             interp->vtables[enum_class_default]->thaw(interp, pmc, info);
 906             return;
 907         }
 908
 909         /* else maybe VTABLE_thaw ... but there is no other extra stuff */
 910
 911         PARROT_ASSERT(must_have_seen);
 912
 913         *info->thaw_ptr = pmc;
 914         return;
 915     }
 916
 917     PARROT_ASSERT(!must_have_seen);
 918     pmc = thaw_create_pmc(interp, info, type);
 919
 920     VTABLE_thaw(interp, pmc, info);
 921
 922     if (info->extra_flags == EXTRA_CLASS_EXISTS) {
 923         pmc               = (PMC *)info->extra;
 924         info->extra       = NULL;
 925         info->extra_flags = 0;
 926     }
 927
 928     if (!info->thaw_result)
 929         info->thaw_result = pmc;
 930     else
 931         *info->thaw_ptr = pmc;
 932
 933
 934     Parrot_pmc_array_assign(interp, (List *)PMC_data(info->id_list), id, pmc, enum_type_PMC);
 935
 936     /* remember nested aggregates depth first */
 937     Parrot_pmc_array_unshift(interp, (List *)PMC_data(info->todo), pmc, enum_type_PMC);
 938 }
 939
 940 /*
 941
 942 =item C<static int todo_list_seen(PARROT_INTERP, PMC *pmc, visit_info *info,
 943 UINTVAL *id)>
 944
 945 Returns true if the PMC was seen, otherwise it put it on the todo list.
 946 Generates an ID (tag) for PMC, offset by 4 as are addresses.  Low bits are
 947 flags.
 948
 949 =cut
 950
 951 */
 952
 953 PARROT_INLINE
 954 static int
 955 todo_list_seen(PARROT_INTERP, ARGIN(PMC *pmc), ARGMOD(visit_info *info),
 956         ARGOUT(UINTVAL *id))
 957 {
 958     ASSERT_ARGS(todo_list_seen)
 959     HashBucket * const b =
 960         parrot_hash_get_bucket(interp,
 961                 (Hash *)VTABLE_get_pointer(interp, info->seen), pmc);
 962
 963     if (b) {
 964         *id = (UINTVAL) b->value;
 965         return 1;
 966     }
 967
 968     /* next id to freeze */
 969     info->id++;
 970     *id = PackID_new(info->id, enum_PackID_normal);
 971
 972     parrot_hash_put(interp,
 973             (Hash *)VTABLE_get_pointer(interp, info->seen), pmc, (void *)*id);
 974
 975     /* remember containers */
 976     Parrot_pmc_array_unshift(interp, (List *)PMC_data(info->todo), pmc, enum_type_PMC);
 977
 978     return 0;
 979 }
 980
 981
 982 /*
 983
 984 =item C<static void visit_todo_list(PARROT_INTERP, PMC* pmc, visit_info* info)>
 985
 986 Checks the seen PMC via the todo list.
 987
 988 =cut
 989
 990 */
 991
 992 static void
 993 visit_todo_list(PARROT_INTERP, ARGIN_NULLOK(PMC* pmc), ARGIN(visit_info* info))
 994 {
 995     ASSERT_ARGS(visit_todo_list)
 996     int     seen;
 997     UINTVAL id = 0;
 998
 999     if (PMC_IS_NULL(pmc)) {
1000         seen = 1;
1001         id   = 0;
1002     }
1003     else
1004         seen = todo_list_seen(interp, pmc, info, &id);
1005
1006     do_action(interp, pmc, info, seen, id);
1007
1008     if (!seen)
1009         (info->visit_action)(interp, pmc, info);
1010 }
1011
1012
1013 /*
1014
1015 =item C<static void visit_todo_list_thaw(PARROT_INTERP, PMC* old, visit_info*
1016 info)>
1017
1018 Callback for thaw - action first.
1019
1020 Todo-list and seen handling is all in C<do_thaw()>.
1021
1022 =cut
1023
1024 */
1025
1026 static void
1027 visit_todo_list_thaw(PARROT_INTERP, ARGIN_NULLOK(PMC* old), ARGIN(visit_info* info))
1028 {
1029     ASSERT_ARGS(visit_todo_list_thaw)
1030     do_thaw(interp, old, info);
1031 }
1032
1033
1034 /*
1035
1036 =item C<static void visit_loop_todo_list(PARROT_INTERP, PMC *current, visit_info
1037 *info)>
1038
1039 The thaw loop.
1040
1041 =cut
1042
1043 */
1044
1045 static void
1046 visit_loop_todo_list(PARROT_INTERP, ARGIN_NULLOK(PMC *current),
1047         ARGIN(visit_info *info))
1048 {
1049     ASSERT_ARGS(visit_loop_todo_list)
1050     PMC        **list_item;
1051     List        *finish_list    = NULL;
1052     List * const todo           = (List *)PMC_data(info->todo);
1053     int          finished_first = 0;
1054     const int    thawing        = info->what == VISIT_THAW_CONSTANTS
1055                                || info->what == VISIT_THAW_NORMAL;
1056     int          i;
1057
1058     /* create a list that contains PMCs that need thawfinish */
1059     if (thawing) {
1060         PMC * const finish_list_pmc = pmc_new(interp, enum_class_Array);
1061         finish_list                 = (List *)PMC_data(finish_list_pmc);
1062     }
1063
1064     (info->visit_pmc_now)(interp, current, info);
1065
1066     /* can't cache upper limit, visit may append items */
1067 again:
1068     while ((list_item = (PMC **)Parrot_pmc_array_shift(interp, todo, enum_type_PMC))) {
1069         current = *list_item;
1070         if (!current)
1071             Parrot_ex_throw_from_c_args(interp, NULL, 1,
1072                 "NULL current PMC in visit_loop_todo_list");
1073
1074         PARROT_ASSERT(current->vtable);
1075
1076         /* Workaround for thawing constants. Clear constant flag */
1077         /* See src/packfile.c:3999 */
1078         if (thawing)
1079             PObj_constant_CLEAR(current);
1080
1081         VTABLE_visit(interp, current, info);
1082
1083         if (thawing) {
1084             if (current == info->thaw_result)
1085                 finished_first = 1;
1086             if (current->vtable->thawfinish != interp->vtables[enum_class_default]->thawfinish)
1087                 Parrot_pmc_array_unshift(interp, finish_list, current, enum_type_PMC);
1088         }
1089     }
1090
1091     if (thawing) {
1092         INTVAL n;
1093         /* if image isn't consumed, there are some extra data to thaw */
1094         if (info->image->bufused > 0) {
1095             (info->visit_pmc_now)(interp, NULL, info);
1096             goto again;
1097         }
1098
1099         /* on thawing call thawfinish for each processed PMC */
1100         if (!finished_first)
1101             Parrot_pmc_array_unshift(interp, finish_list, info->thaw_result, enum_type_PMC);
1102
1103         n = Parrot_pmc_array_length(interp, finish_list);
1104
1105         for (i = 0; i < n ; ++i) {
1106             current = *(PMC**)Parrot_pmc_array_get(interp, finish_list, i, enum_type_PMC);
1107             if (!PMC_IS_NULL(current))
1108                 VTABLE_thawfinish(interp, current, info);
1109         }
1110     }
1111 }
1112
1113
1114 /*
1115
1116 =item C<static void create_image(PARROT_INTERP, PMC *pmc, visit_info *info)>
1117
1118 Allocate image to some estimated size.
1119
1120 =cut
1121
1122 */
1123
1124 static void
1125 create_image(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc), ARGMOD(visit_info *info))
1126 {
1127     ASSERT_ARGS(create_image)
1128     STRING *array = CONST_STRING(interp, "array");
1129     STRING *hash  = CONST_STRING(interp, "hash");
1130     INTVAL  len;
1131
1132     if (!PMC_IS_NULL(pmc)
1133     && (VTABLE_does(interp, pmc, array) || VTABLE_does(interp, pmc, hash))) {
1134         const INTVAL items = VTABLE_elements(interp, pmc);
1135         /* TODO check e.g. first item of aggregate and estimate size */
1136         len = items * FREEZE_BYTES_PER_ITEM;
1137     }
1138     else
1139         len = FREEZE_BYTES_PER_ITEM;
1140
1141     info->image = Parrot_str_new_init(interp, NULL, len,
1142          Parrot_fixed_8_encoding_ptr, Parrot_binary_charset_ptr, 0);
1143 }
1144
1145
1146 /*
1147
1148 =item C<static PMC* run_thaw(PARROT_INTERP, STRING* image, visit_enum_type
1149 what)>
1150
1151 Performs thawing. C<what> indicates what to be thawed.
1152
1153 For now it seems cheaper to use a list for remembering contained
1154 aggregates. We could of course decide dynamically, which strategy to
1155 use, e.g.: given a big image, the first thawed item is a small
1156 aggregate. This implies, it probably contains (or some big strings) more
1157 nested containers, for which another approach could be a win.
1158
1159 =cut
1160
1161 */
1162
1163 PARROT_WARN_UNUSED_RESULT
1164 PARROT_CAN_RETURN_NULL
1165 static PMC*
1166 run_thaw(PARROT_INTERP, ARGIN(STRING* image), visit_enum_type what)
1167 {
1168     ASSERT_ARGS(run_thaw)
1169     visit_info    info;
1170     int           gc_block = 0;
1171     const UINTVAL bufused  = image->bufused;
1172
1173     info.image = image;
1174     /*
1175      * if we are thawing a lot of PMCs, it's cheaper to do
1176      * a GC run first and then block GC - the limit should be
1177      * chosen so that no more then one GC run would be triggered
1178      *
1179      * XXX
1180      *
1181      * md5_3.pir shows a segfault during thawing the config hash
1182      * info->thaw_ptr becomes invalid - seems that the hash got
1183      * collected under us.
1184      */
1185     if (1 || (Parrot_str_byte_length(interp, image) > THAW_BLOCK_GC_SIZE)) {
1186         Parrot_block_GC_mark(interp);
1187         Parrot_block_GC_sweep(interp);
1188         gc_block = 1;
1189     }
1190
1191     /* _NORMAL or _CONSTANTS */
1192     info.what = what;
1193
1194     todo_list_init(interp, &info);
1195     info.visit_pmc_now   = visit_todo_list_thaw;
1196
1197     info.thaw_result = NULL;
1198
1199     /* run thaw loop */
1200     visit_loop_todo_list(interp, NULL, &info);
1201
1202     /*
1203      * thaw consumes the image string by incrementing strstart
1204      * and decrementing bufused - restore that
1205      */
1206     LVALUE_CAST(char *, image->strstart) -= bufused;
1207     image->bufused = bufused;
1208     image->strlen += bufused;
1209
1210     PARROT_ASSERT(image->strstart >= (char *)Buffer_bufstart(image));
1211
1212     if (gc_block) {
1213         Parrot_unblock_GC_mark(interp);
1214         Parrot_unblock_GC_sweep(interp);
1215     }
1216
1217     PackFile_destroy(interp, info.image_io->pf);
1218     mem_sys_free(info.image_io);
1219     info.image_io = NULL;
1220     return info.thaw_result;
1221 }
1222
1223
1224 /*
1225
1226 =back
1227
1228 =head2 Public Interface
1229
1230 =over 4
1231
1232 =item C<STRING* Parrot_freeze(PARROT_INTERP, PMC *pmc)>
1233
1234 Freeze using either method.
1235
1236 =cut
1237
1238 */
1239
1240 PARROT_EXPORT
1241 PARROT_WARN_UNUSED_RESULT
1242 PARROT_CAN_RETURN_NULL
1243 STRING*
1244 Parrot_freeze(PARROT_INTERP, ARGIN(PMC *pmc))
1245 {
1246     ASSERT_ARGS(Parrot_freeze)
1247     /*
1248      * freeze using a todo list and seen hash
1249      * Please note that both have to be PMCs, so that trace_system_stack
1250      * can call mark on the PMCs
1251      */
1252     visit_info info;
1253
1254     info.what = VISIT_FREEZE_NORMAL;
1255     create_image(interp, pmc, &info);
1256     todo_list_init(interp, &info);
1257
1258     visit_loop_todo_list(interp, pmc, &info);
1259
1260     PackFile_destroy(interp, info.image_io->pf);
1261     mem_sys_free(info.image_io);
1262     return info.image;
1263 }
1264
1265
1266 /*
1267
1268 =item C<PMC* Parrot_thaw(PARROT_INTERP, STRING *image)>
1269
1270 Thaws a PMC.  Called from the C<thaw> opcode.
1271
1272 =cut
1273
1274 */
1275
1276 PARROT_EXPORT
1277 PARROT_WARN_UNUSED_RESULT
1278 PARROT_CAN_RETURN_NULL
1279 PMC*
1280 Parrot_thaw(PARROT_INTERP, ARGIN(STRING *image))
1281 {
1282     ASSERT_ARGS(Parrot_thaw)
1283     return run_thaw(interp, image, VISIT_THAW_NORMAL);
1284 }
1285
1286
1287 /*
1288
1289 =item C<PMC* Parrot_thaw_constants(PARROT_INTERP, STRING *image)>
1290
1291 Thaws constants, used by PackFile for unpacking PMC constants.
1292
1293 =cut
1294
1295 */
1296
1297 PARROT_EXPORT
1298 PARROT_WARN_UNUSED_RESULT
1299 PARROT_CAN_RETURN_NULL
1300 PMC*
1301 Parrot_thaw_constants(PARROT_INTERP, ARGIN(STRING *image))
1302 {
1303     ASSERT_ARGS(Parrot_thaw_constants)
1304     return run_thaw(interp, image, VISIT_THAW_CONSTANTS);
1305 }
1306
1307
1308 /*
1309
1310 =item C<PMC* Parrot_clone(PARROT_INTERP, PMC *pmc)>
1311
1312 There are for sure shortcuts to clone faster, e.g. always thaw the image
1313 immediately or use a special callback.  For now we just thaw a frozen PMC.
1314
1315 =cut
1316
1317 */
1318
1319 PARROT_EXPORT
1320 PARROT_WARN_UNUSED_RESULT
1321 PARROT_CAN_RETURN_NULL
1322 PMC*
1323 Parrot_clone(PARROT_INTERP, ARGIN(PMC *pmc))
1324 {
1325     ASSERT_ARGS(Parrot_clone)
1326     return VTABLE_clone(interp, pmc);
1327 }
1328
1329
1330 /*
1331
1332 =back
1333
1334 =head1 TODO
1335
1336 The seen-hash version for freezing might go away sometime.
1337
1338 =head1 SEE ALSO
1339
1340 Lot of discussion on p6i and F<docs/dev/pmc_freeze.pod>.
1341
1342 =head1 HISTORY
1343
1344 Initial version by leo 2003.11.03 - 2003.11.07.
1345
1346 =cut
1347
1348 */
1349
1350
1351 /*
1352  * Local variables:
1353  *   c-file-style: "parrot"
1354  * End:
1355  * vim: expandtab shiftwidth=4:
1356  */