src/pmc_freeze.c

   1 /*
   2 Copyright (C) 2001-2006, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/pmc_freeze.c - Freeze and thaw functionality
   8
   9 =head1 DESCRIPTION
  10
  11 Freeze uses the C<next_for_GC pointer()> to remember seen PMCs. PMCs are
  12 written as IDs (or tags), which are calculated from their arena address.
  13 This PMC number is multiplied by four. The 2 low bits indicate a seen
  14 PMC or a PMC of the same type as the previous one respectively.
  15
  16 Thawing PMCs uses a list with (maximum) size of the amount of PMCs to
  17 keep track of retrieved PMCs.
  18
  19 The individual information of PMCs is frozen/thawed by their vtables.
  20
  21 To avoid recursion, the whole functionality is driven by
  22 C<< pmc->vtable->visit >>, which is called for the first PMC initially.
  23 Container PMCs call a "todo-callback" for all contained PMCs. The
  24 individual action vtable (freeze/thaw) is then called for all todo-PMCs.
  25
  26 In the current implementation C<IMAGE_IO> is a stand-in for some kind of
  27 serializer PMC which will eventually be written. It associates a Parrot
  28 C<STRING> with a vtable.
  29
  30 =cut
  31
  32 */
  33
  34 #include "parrot/parrot.h"
  35 #include <assert.h>
  36
  37 /* default.pmc thawing of properties */
  38 void Parrot_default_thaw(Interp* , PMC* pmc, visit_info *info);
  39
  40 /*
  41  * define this to 1 for testing
  42  */
  43 #ifndef FREEZE_ASCII
  44 #define FREEZE_ASCII 0
  45 #endif
  46
  47 /*
  48  * normal freeze can use next_for_GC ptrs or a seen hash
  49  */
  50 #define FREEZE_USE_NEXT_FOR_GC 0
  51
  52 /*
  53  * when thawing a string longer then this size, we first do a
  54  * DOD run and then block DOD/GC - the system can't give us more headers
  55  */
  56 #define THAW_BLOCK_DOD_SIZE 100000
  57
  58 /*
  59  * preallocate freeze image for aggregates with this estimation
  60  */
  61 #if FREEZE_ASCII
  62 #  define FREEZE_BYTES_PER_ITEM 17
  63 #else
  64 #  define FREEZE_BYTES_PER_ITEM 9
  65 #endif
  66
  67 /*
  68
  69 =head2 Image Stream Functions
  70
  71 =over 4
  72
  73 =item C<static void
  74 str_append(Parrot_Interp interpreter, STRING *s, const void *b, size_t len)>
  75
  76 Appends C<len> bytes from buffer C<*b> to string C<*s>.
  77
  78 Plain ascii - for testing only:
  79
  80 For speed reasons we mess around with the string buffers directly.
  81
  82 No encoding of strings, no transcoding.
  83
  84 =cut
  85
  86 */
  87
  88 static void
  89 str_append(Parrot_Interp interpreter, STRING *s, const void *b, size_t len)
  90 {
  91     const size_t used = s->bufused;
  92     const int need_free = (int)PObj_buflen(s) - used - len;
  93     /*
  94      * grow by factor 1.5 or such
  95      */
  96     if (need_free <= 16) {
  97         size_t new_size = (size_t) (PObj_buflen(s) * 1.5);
  98         if (new_size < PObj_buflen(s) - need_free + 512)
  99             new_size = PObj_buflen(s) - need_free + 512;
 100         Parrot_reallocate_string(interpreter, s, new_size);
 101         assert(PObj_buflen(s) - used - len >= 15);
 102     }
 103     mem_sys_memcopy((void *)((ptrcast_t)s->strstart + used), b, len);
 104     s->bufused += len;
 105     s->strlen += len;
 106 }
 107
 108 /*
 109
 110 =item C<static void
 111 push_ascii_integer(Parrot_Interp interpreter, IMAGE_IO *io, INTVAL v)>
 112
 113 Pushes an ASCII version of the integer C<v> onto the end of the C<*io>
 114 "stream".
 115
 116 =cut
 117
 118 */
 119
 120 static void
 121 push_ascii_integer(Parrot_Interp interpreter, IMAGE_IO *io, INTVAL v)
 122 {
 123     char buffer[128];
 124     sprintf(buffer, "%d ", (int) v);
 125     str_append(interpreter, io->image, buffer, strlen(buffer));
 126 }
 127
 128 /*
 129
 130 =item C<static void
 131 push_ascii_number(Parrot_Interp interpreter, IMAGE_IO *io, FLOATVAL v)>
 132
 133 Pushes an ASCII version of the number C<v> onto the end of the C<*io>
 134 "stream".
 135
 136 =cut
 137
 138 */
 139
 140 static void
 141 push_ascii_number(Parrot_Interp interpreter, IMAGE_IO *io, FLOATVAL v)
 142 {
 143     char buffer[128];
 144     sprintf(buffer, "%g ", (double) v);
 145     str_append(interpreter, io->image, buffer, strlen(buffer));
 146 }
 147
 148 /*
 149
 150 =item C<static void
 151 push_ascii_string(Parrot_Interp interpreter, IMAGE_IO *io, STRING *s)>
 152
 153 Pushes an ASCII version of the string C<*s> onto the end of the C<*io>
 154 "stream".
 155
 156 For testing only - no encodings and such.
 157
 158 XXX no string delimiters - so no space allowed.
 159
 160 =cut
 161
 162 */
 163
 164 static void
 165 push_ascii_string(Parrot_Interp interpreter, IMAGE_IO *io, STRING *s)
 166 {
 167     const UINTVAL length = string_length(interpreter, s);
 168     char * const buffer = malloc(4*length);
 169     char *cursor = buffer;
 170     UINTVAL idx = 0;
 171
 172     /* temporary--write out in UTF-8 */
 173     for ( idx = 0; idx < length; ++idx ) {
 174         *cursor++ = (unsigned char)string_index(interpreter, s, idx);
 175     }
 176
 177     str_append(interpreter, io->image, buffer, cursor - buffer);
 178     str_append(interpreter, io->image, " ", 1);
 179
 180     free(buffer);
 181 }
 182
 183 /*
 184
 185 =item C<static void
 186 push_ascii_pmc(Parrot_Interp interpreter, IMAGE_IO *io, PMC* v)>
 187
 188 Pushes an ASCII version of the PMC C<*v> onto the end of the C<*io>
 189 "stream".
 190
 191 =cut
 192
 193 */
 194
 195 static void
 196 push_ascii_pmc(Parrot_Interp interpreter, IMAGE_IO *io, const PMC* v)
 197 {
 198     char buffer[128];
 199     sprintf(buffer, "%p ", v);
 200     str_append(interpreter, io->image, buffer, strlen(buffer));
 201 }
 202
 203 /*
 204
 205 =item C<static INTVAL
 206 shift_ascii_integer(Parrot_Interp interpreter, IMAGE_IO *io)>
 207
 208 Removes and returns an integer from the start of the C<*io> "stream".
 209
 210 =cut
 211
 212 */
 213
 214 static INTVAL
 215 shift_ascii_integer(Parrot_Interp interpreter, IMAGE_IO *io)
 216 {
 217     char * const start = (char*)io->image->strstart;
 218     char *p = start;
 219     const INTVAL i = strtoul(p, &p, 10);
 220
 221     ++p;
 222     assert(p <= start + io->image->bufused);
 223     io->image->strstart = p;
 224     io->image->bufused -= (p - start);
 225     assert((int)io->image->bufused >= 0);
 226     return i;
 227 }
 228
 229 /*
 230
 231 =item C<static FLOATVAL
 232 shift_ascii_number(Parrot_Interp interpreter, IMAGE_IO *io)>
 233
 234 Removes and returns an number from the start of the C<*io> "stream".
 235
 236 =cut
 237
 238 */
 239
 240 static FLOATVAL
 241 shift_ascii_number(Parrot_Interp interpreter, IMAGE_IO *io)
 242 {
 243     char * const start = (char*)io->image->strstart;
 244     char *p = start;
 245     const FLOATVAL f = (FLOATVAL) strtod(p, &p);
 246
 247     ++p;
 248     assert(p <= start + io->image->bufused);
 249     io->image->strstart = p;
 250     io->image->bufused -= (p - start);
 251     assert((int)io->image->bufused >= 0);
 252     return f;
 253 }
 254
 255 /*
 256
 257 =item C<static STRING*
 258 shift_ascii_string(Parrot_Interp interpreter, IMAGE_IO *io)>
 259
 260 Removes and returns an string from the start of the C<*io> "stream".
 261
 262 =cut
 263
 264 */
 265
 266 static STRING*
 267 shift_ascii_string(Parrot_Interp interpreter, IMAGE_IO *io)
 268 {
 269     STRING *s;
 270
 271     char * const start = (char*)io->image->strstart;
 272     char *p = start;
 273
 274     while (*p != ' ')
 275         ++p;
 276     ++p;
 277     assert(p <= start + io->image->bufused);
 278     io->image->strstart = p;
 279     io->image->bufused -= (p - start);
 280     assert((int)io->image->bufused >= 0);
 281     s = string_make(interpreter, start, p - start - 1, "iso-8859-1", 0);
 282 /*    s = string_make(interpreter, start, p - start - 1, "UTF-8", 0); */
 283     return s;
 284 }
 285
 286 /*
 287
 288 =item C<static PMC*
 289 shift_ascii_pmc(Parrot_Interp interpreter, IMAGE_IO *io)>
 290
 291 Removes and returns a PMC from the start of the C<*io> "stream".
 292
 293 =cut
 294
 295 */
 296
 297 static PMC*
 298 shift_ascii_pmc(Parrot_Interp interpreter, IMAGE_IO *io)
 299 {
 300     char * const start = (char*)io->image->strstart;
 301     char *p = start;
 302     const unsigned long i = strtoul(p, &p, 16);
 303     ++p;
 304     assert(p <= start + io->image->bufused);
 305     io->image->strstart = p;
 306     io->image->bufused -= (p - start);
 307     assert((int)io->image->bufused >= 0);
 308     return (PMC*) i;
 309 }
 310
 311 /*
 312
 313 =back
 314
 315 =head2 C<opcode_t> IO Functions
 316
 317 =over 4
 318
 319 =item C<static PARROT_INLINE void
 320 op_check_size(Parrot_Interp interpreter, STRING *s, size_t len)>
 321
 322 Checks the size of the "stream" buffer to see if it can accommodate
 323 C<len> more bytes. If not then the buffer is expanded.
 324
 325 =cut
 326
 327 */
 328
 329 static PARROT_INLINE void
 330 op_check_size(Parrot_Interp interpreter, STRING *s, size_t len)
 331 {
 332     const size_t used = s->bufused;
 333     const int need_free = (int)PObj_buflen(s) - used - len;
 334     /*
 335      * grow by factor 1.5 or such
 336      */
 337     if (need_free <= 16) {
 338         size_t new_size = (size_t) (PObj_buflen(s) * 1.5);
 339         if (new_size < PObj_buflen(s) - need_free + 512)
 340             new_size = PObj_buflen(s) - need_free + 512;
 341         Parrot_reallocate_string(interpreter, s, new_size);
 342         assert(PObj_buflen(s) - used - len >= 15);
 343     }
 344 #ifndef DISABLE_GC_DEBUG
 345     Parrot_go_collect(interpreter);
 346 #endif
 347 }
 348
 349 /*
 350
 351 =item C<static void
 352 op_append(Parrot_Interp interpreter, STRING *s, opcode_t b, size_t len)>
 353
 354 Appends the opcode C<b> to the string C<*s>.
 355
 356 =cut
 357
 358 */
 359
 360 static void
 361 op_append(Parrot_Interp interpreter, STRING *s, opcode_t b, size_t len)
 362 {
 363     op_check_size(interpreter, s, len);
 364     *((opcode_t *)((ptrcast_t)s->strstart + s->bufused)) = b;
 365     s->bufused += len;
 366     s->strlen += len;
 367 }
 368
 369 /*
 370
 371 =item C<static void
 372 push_opcode_integer(Parrot_Interp interpreter, IMAGE_IO *io, INTVAL v)>
 373
 374 Pushes the integer C<v> onto the end of the C<*io> "stream".
 375
 376 XXX assumes sizeof(opcode_t) == sizeof(INTVAL).
 377
 378 =cut
 379
 380 */
 381
 382 static void
 383 push_opcode_integer(Parrot_Interp interpreter, IMAGE_IO *io, INTVAL v)
 384 {
 385     assert(sizeof(opcode_t) == sizeof(INTVAL));
 386     op_append(interpreter, io->image, (opcode_t)v, sizeof(opcode_t));
 387 }
 388
 389 /*
 390
 391 =item C<static void
 392 push_opcode_number(Parrot_Interp interpreter, IMAGE_IO *io, FLOATVAL v)>
 393
 394 Pushes the number C<v> onto the end of the C<*io> "stream".
 395
 396 =cut
 397
 398 */
 399
 400 static void
 401 push_opcode_number(Parrot_Interp interpreter, IMAGE_IO *io, FLOATVAL v)
 402 {
 403     const size_t len = PF_size_number() * sizeof(opcode_t);
 404     STRING * const s = io->image;
 405     const size_t used = s->bufused;
 406
 407     op_check_size(interpreter, s, len);
 408     PF_store_number( (opcode_t *)((ptrcast_t)s->strstart + used), &v);
 409     s->bufused += len;
 410     s->strlen += len;
 411 }
 412
 413 /*
 414
 415 =item C<static void
 416 push_opcode_string(Parrot_Interp interpreter, IMAGE_IO *io, STRING* v)>
 417
 418 Pushes the string C<*v> onto the end of the C<*io> "stream".
 419
 420 =cut
 421
 422 */
 423
 424 static void
 425 push_opcode_string(Parrot_Interp interpreter, IMAGE_IO *io, STRING* v)
 426 {
 427     const size_t len = PF_size_string(v) * sizeof(opcode_t);
 428     STRING * const s = io->image;
 429     const size_t used = s->bufused;
 430
 431     op_check_size(interpreter, s, len);
 432     PF_store_string( (opcode_t *)((ptrcast_t)s->strstart + used), v);
 433     s->bufused += len;
 434     s->strlen += len;
 435 }
 436
 437 /*
 438
 439 =item C<static void
 440 push_opcode_pmc(Parrot_Interp interpreter, IMAGE_IO *io, PMC* v)>
 441
 442 Pushes the PMC C<*v> onto the end of the C<*io> "stream".
 443
 444 =cut
 445
 446 */
 447
 448 static void
 449 push_opcode_pmc(Parrot_Interp interpreter, IMAGE_IO *io, PMC* v)
 450 {
 451     op_append(interpreter, io->image, (opcode_t)v, sizeof(opcode_t));
 452 }
 453
 454 /*
 455
 456 =item C<static INTVAL
 457 shift_opcode_integer(Parrot_Interp interpreter, IMAGE_IO *io)>
 458
 459 Removes and returns an integer from the start of the C<*io> "stream".
 460
 461 TODO - The shift functions aren't portable yet. We need to have a
 462 packfile header for wordsize and endianess.
 463
 464 =cut
 465
 466 */
 467
 468 static INTVAL
 469 shift_opcode_integer(Parrot_Interp interpreter, IMAGE_IO *io)
 470 {
 471     const char * const start = (char*)io->image->strstart;
 472     const INTVAL i =
 473         PF_fetch_integer(io->pf, (opcode_t**) &io->image->strstart);
 474
 475     io->image->bufused -= ((char*)io->image->strstart - start);
 476     assert((int)io->image->bufused >= 0);
 477     return i;
 478 }
 479
 480 /*
 481
 482 =item C<static PMC*
 483 shift_opcode_pmc(Parrot_Interp interpreter, IMAGE_IO *io)>
 484
 485 Removes and returns an PMC from the start of the C<*io> "stream".
 486
 487 Note that this actually reads a PMC id, not a PMC.
 488
 489 =cut
 490
 491 */
 492
 493 static PMC*
 494 shift_opcode_pmc(Parrot_Interp interpreter, IMAGE_IO *io)
 495 {
 496     return (PMC*) shift_opcode_integer(interpreter, io);
 497 }
 498
 499 /*
 500
 501 =item C<tatic FLOATVAL
 502 shift_opcode_number(Parrot_Interp interpreter, IMAGE_IO *io)>
 503
 504 Removes and returns an number from the start of the C<*io> "stream".
 505
 506 =cut
 507
 508 */
 509
 510 static FLOATVAL
 511 shift_opcode_number(Parrot_Interp interpreter, IMAGE_IO *io)
 512 {
 513     const char * const start = (char*)io->image->strstart;
 514     const FLOATVAL f =
 515         PF_fetch_number(io->pf, (opcode_t**) &io->image->strstart);
 516
 517     io->image->bufused -= ((char*)io->image->strstart - start);
 518     assert((int)io->image->bufused >= 0);
 519     return f;
 520 }
 521
 522 /*
 523
 524 =item C<static STRING*
 525 shift_opcode_string(Parrot_Interp interpreter, IMAGE_IO *io)>
 526
 527 Removes and returns a string from the start of the C<*io> "stream".
 528
 529 =cut
 530
 531 */
 532
 533 static STRING*
 534 shift_opcode_string(Parrot_Interp interpreter, IMAGE_IO *io)
 535 {
 536     char * const start = (char*)io->image->strstart;
 537     STRING * const s =
 538         PF_fetch_string(interpreter, io->pf, (opcode_t**) &io->image->strstart);
 539
 540     io->image->bufused -= ((char*)io->image->strstart - start);
 541     assert((int)io->image->bufused >= 0);
 542     return s;
 543 }
 544
 545 /*
 546
 547 =back
 548
 549 =head2 Helper Functions
 550
 551 =over 4
 552
 553 =cut
 554
 555 */
 556
 557 /*
 558
 559 =item C<static void
 560 pmc_add_ext(Parrot_Interp interpreter, PMC *pmc)>
 561
 562 Adds a C<PMC_EXT> to C<*pmc>.
 563
 564 =cut
 565
 566 */
 567
 568 static void
 569 pmc_add_ext(Parrot_Interp interpreter, PMC *pmc)
 570 {
 571     if (pmc->vtable->flags & VTABLE_PMC_NEEDS_EXT)
 572         add_pmc_ext(interpreter, pmc);
 573 }
 574
 575 /*
 576
 577 =item C<static void
 578 cleanup_next_for_GC_pool(Parrot_Interp interpreter,
 579     struct Small_Object_Pool *pool)>
 580
 581 Sets all the C<next_for_GC> pointers to C<NULL>.
 582
 583 =cut
 584
 585 */
 586
 587 static void
 588 cleanup_next_for_GC_pool(Parrot_Interp interpreter,
 589     struct Small_Object_Pool *pool)
 590 {
 591     struct Small_Object_Arena *arena;
 592
 593     for (arena = pool->last_Arena; arena; arena = arena->prev) {
 594         PMC *p = arena->start_objects;
 595         UINTVAL i;
 596
 597         for (i = 0; i < arena->used; i++) {
 598             if (!PObj_on_free_list_TEST(p)) {
 599                 if (p->pmc_ext)
 600                     PMC_next_for_GC(p) = NULL;
 601             }
 602             p = (PMC *)((char *)p + sizeof(PMC));
 603         }
 604     }
 605 }
 606
 607 /*
 608
 609 =item C<static void
 610 cleanup_next_for_GC(Parrot_Interp interpreter)>
 611
 612 Cleans up the C<next_for_GC> pointers.
 613
 614 =cut
 615
 616 */
 617
 618 static void
 619 cleanup_next_for_GC(Parrot_Interp interpreter)
 620 {
 621     cleanup_next_for_GC_pool(interpreter,
 622             interpreter->arena_base->pmc_pool);
 623     cleanup_next_for_GC_pool(interpreter,
 624             interpreter->arena_base->constant_pmc_pool);
 625 }
 626
 627 /*
 628  * this function setup stuff may be replaced by a real PMC
 629  * in the future
 630  * TODO add read/write header functions, e.g. vtable->init_pmc
 631  */
 632
 633 #if FREEZE_ASCII
 634 static image_funcs ascii_funcs = {
 635     push_ascii_integer,
 636     push_ascii_pmc,
 637     push_ascii_string,
 638     push_ascii_number,
 639     shift_ascii_integer,
 640     shift_ascii_pmc,
 641     shift_ascii_string,
 642     shift_ascii_number
 643 };
 644 #else
 645 static image_funcs opcode_funcs = {
 646     push_opcode_integer,
 647     push_opcode_pmc,
 648     push_opcode_string,
 649     push_opcode_number,
 650     shift_opcode_integer,
 651     shift_opcode_pmc,
 652     shift_opcode_string,
 653     shift_opcode_number
 654 };
 655 #endif
 656
 657 /*
 658
 659 =item C<static void
 660 ft_init(Parrot_Interp interpreter, visit_info *info)>
 661
 662 Initializes the freeze/thaw subsystem.
 663
 664 =cut
 665
 666 */
 667
 668 static void
 669 ft_init(Parrot_Interp interpreter, visit_info *info)
 670 {
 671     STRING *s = info->image;
 672     struct PackFile *pf;
 673
 674     info->image_io = mem_sys_allocate(sizeof(IMAGE_IO));
 675     info->image_io->image = s = info->image;
 676 #if FREEZE_ASCII
 677     info->image_io->vtable = &ascii_funcs;
 678 #else
 679     info->image_io->vtable = &opcode_funcs;
 680 #endif
 681     pf = info->image_io->pf = PackFile_new(interpreter, 0);
 682     if (info->what == VISIT_FREEZE_NORMAL ||
 683         info->what == VISIT_FREEZE_AT_DESTRUCT) {
 684
 685         op_check_size(interpreter, s, PACKFILE_HEADER_BYTES);
 686         mem_sys_memcopy(s->strstart, pf->header, PACKFILE_HEADER_BYTES);
 687         s->bufused += PACKFILE_HEADER_BYTES;
 688         s->strlen += PACKFILE_HEADER_BYTES;
 689     }
 690     else {
 691         if (string_length(interpreter, s) < PACKFILE_HEADER_BYTES) {
 692             real_exception(interpreter, NULL, E_IOError,
 693                     "bad string to thaw");
 694         }
 695         mem_sys_memcopy(pf->header, s->strstart, PACKFILE_HEADER_BYTES);
 696         PackFile_assign_transforms(pf);
 697         s->bufused -= PACKFILE_HEADER_BYTES;
 698         LVALUE_CAST(char *, s->strstart) += 16;
 699     }
 700
 701     info->last_type = -1;
 702     info->id_list = pmc_new(interpreter, enum_class_Array);
 703     info->id = 0;
 704     info->extra_flags = EXTRA_IS_NULL;
 705     info->container = NULL;
 706 }
 707
 708 static void visit_todo_list(Parrot_Interp, PMC*, visit_info* info);
 709 static void add_pmc_todo_list(Parrot_Interp, PMC*, visit_info* info);
 710
 711 /*
 712
 713 =item C<static void
 714 todo_list_init(Parrot_Interp interpreter, visit_info *info)>
 715
 716 Initializes the C<*info> lists.
 717
 718 =cut
 719
 720 */
 721
 722 static void
 723 todo_list_init(Parrot_Interp interpreter, visit_info *info)
 724 {
 725     info->visit_pmc_now = visit_todo_list;
 726     info->visit_pmc_later = add_pmc_todo_list;
 727     /* we must use PMCs here, so that they get marked properly */
 728     info->todo = pmc_new(interpreter, enum_class_Array);
 729     info->seen = Parrot_new_INTVAL_hash(interpreter, 0);
 730
 731     ft_init(interpreter, info);
 732 }
 733
 734 /*
 735
 736 =item C<PARROT_INLINE static void
 737 freeze_pmc(Parrot_Interp interpreter, PMC *pmc, visit_info *info,
 738         int seen, UINTVAL id)>
 739
 740 =cut
 741
 742 */
 743
 744 PARROT_INLINE static void
 745 freeze_pmc(Parrot_Interp interpreter, PMC *pmc, visit_info *info,
 746         int seen, UINTVAL id)
 747 {
 748     IMAGE_IO * const io = info->image_io;
 749     INTVAL type;
 750
 751     if (PMC_IS_NULL(pmc)) {
 752         /* NULL + seen bit */
 753         io->vtable->push_pmc(interpreter, io, (PMC*) 1);
 754         return;
 755     }
 756     type = pmc->vtable->base_type;
 757
 758     if (PObj_is_object_TEST(pmc))
 759         type = enum_class_ParrotObject;
 760     if (seen) {
 761         if (info->extra_flags) {
 762             id |= 3;
 763             io->vtable->push_pmc(interpreter, io, (PMC*)id);
 764             io->vtable->push_integer(interpreter, io, info->extra_flags);
 765             return;
 766         }
 767         id |= 1;         /* mark bit 0 if this PMC is known */
 768     }
 769     else if (type == info->last_type) {
 770         id |= 2;         /* mark bit 1 and don't write type */
 771     }
 772     io->vtable->push_pmc(interpreter, io, (PMC*)id);
 773     if (! (id & 3)) {    /* else write type */
 774         io->vtable->push_integer(interpreter, io, type);
 775         info->last_type = type;
 776     }
 777 }
 778
 779 /*
 780
 781 =item C<PARROT_INLINE static int
 782 thaw_pmc(Parrot_Interp interpreter, visit_info *info,
 783         UINTVAL *id, INTVAL *type)>
 784
 785 Freeze and thaw a PMC (id).
 786
 787 For example, the ASCII representation of the C<Array>
 788
 789 P0 = [P1=666, P2=777, P0]
 790
 791 may look like this:
 792
 793 0xdf4 30 3 0xdf8 33 666 0xdf2 777 0xdf5
 794
 795 where 30 is C<class_enum_Array>, 33 is C<class_enum_Integer>, the
 796 type of the second C<Integer> is suppressed, the repeated P0 has bit 0
 797 set.
 798
 799 =cut
 800
 801 */
 802
 803 PARROT_INLINE static int
 804 thaw_pmc(Parrot_Interp interpreter, visit_info *info,
 805         UINTVAL *id, INTVAL *type)
 806 {
 807     PMC *n;
 808     IMAGE_IO *io = info->image_io;
 809     int seen = 0;
 810
 811     info->extra_flags = EXTRA_IS_NULL;
 812     n = io->vtable->shift_pmc(interpreter, io);
 813     if ( ((UINTVAL) n & 3) == 3) {
 814         /* pmc has extra data */
 815         info->extra_flags = io->vtable->shift_integer(interpreter, io);
 816     }
 817     else if ( (UINTVAL) n & 1) {     /* seen PMCs have bit 0 set */
 818         seen = 1;
 819     }
 820     else if ( (UINTVAL) n & 2) { /* prev PMC was same type */
 821         *type = info->last_type;
 822     }
 823     else {                       /* type follows */
 824         info->last_type = *type = io->vtable->shift_integer(interpreter, io);
 825         if (*type <= 0)
 826             internal_exception(1, "Unknown PMC type to thaw %d", (int) *type);
 827         if (*type >= interpreter->n_vtable_max ||
 828             !interpreter->vtables[*type]) {
 829             /* that ought to be a class */
 830             *type = enum_class_ParrotClass;
 831         }
 832     }
 833     *id = (UINTVAL) n;
 834     return seen;
 835 }
 836
 837 /*
 838
 839 =item C<PARROT_INLINE static void
 840 do_action(Parrot_Interp interpreter, PMC *pmc, visit_info *info,
 841         int seen, UINTVAL id)>
 842
 843 Called from C<visit_next_for_GC()> and C<visit_todo_list()> to perform
 844 the action specified in C<< info->what >>.
 845
 846 Currently only C<VISIT_FREEZE_NORMAL> is implemented.
 847
 848 =cut
 849
 850 */
 851
 852 PARROT_INLINE static void
 853 do_action(Parrot_Interp interpreter, PMC *pmc, visit_info *info,
 854         int seen, UINTVAL id)
 855 {
 856     switch (info->what) {
 857         case VISIT_FREEZE_AT_DESTRUCT:
 858         case VISIT_FREEZE_NORMAL:
 859             freeze_pmc(interpreter, pmc, info, seen, id);
 860             if (pmc)
 861                 info->visit_action = pmc->vtable->freeze;
 862             break;
 863         default:
 864             internal_exception(1, "Illegal action %d", info->what);
 865             break;
 866     }
 867 }
 868
 869 /*
 870
 871 =item C<PARROT_INLINE static PMC*
 872 thaw_create_pmc(Parrot_Interp interpreter, PMC *pmc, visit_info *info,
 873         INTVAL type)>
 874
 875 Called from C<do_thaw()> to attach the vtable etc. to C<*pmc>.
 876
 877 =cut
 878
 879 */
 880
 881 PARROT_INLINE static PMC*
 882 thaw_create_pmc(Parrot_Interp interpreter, const visit_info *info,
 883         INTVAL type)
 884 {
 885     PMC *pmc;
 886     switch (info->what) {
 887         case VISIT_THAW_NORMAL:
 888             pmc = pmc_new_noinit(interpreter, type);
 889             break;
 890         case VISIT_THAW_CONSTANTS:
 891             pmc = constant_pmc_new_noinit(interpreter, type);
 892             break;
 893         default:
 894             pmc = NULL;
 895             internal_exception(1, "Illegal visit_next type");
 896             break;
 897     }
 898     return pmc;
 899 }
 900
 901 /*
 902
 903 =item C<PARROT_INLINE static void
 904 do_thaw(Parrot_Interp interpreter, PMC* pmc, visit_info *info)>
 905
 906 Called by C<visit_todo_list_thaw()> to thaw and return a PMC.
 907
 908 C<seen> is false if this is the first time the PMC has been encountered.
 909
 910 =cut
 911
 912 */
 913
 914 PARROT_INLINE static void
 915 do_thaw(Parrot_Interp interpreter, PMC* pmc, visit_info *info)
 916 {
 917     UINTVAL id;
 918     INTVAL type;
 919     PMC ** pos;
 920     int must_have_seen;
 921     type = 0; /* it's set below, avoid compiler warning. */
 922     must_have_seen = thaw_pmc(interpreter, info, &id, &type);
 923
 924     id >>= 2;
 925
 926     if (!id) {
 927         /* got a NULL PMC */
 928         pmc = PMCNULL;
 929         if (!info->thaw_result)
 930             info->thaw_result = pmc;
 931         else
 932             *info->thaw_ptr = pmc;
 933         return;
 934     }
 935
 936     pos = list_get(interpreter, PMC_data(info->id_list), id, enum_type_PMC);
 937     if (pos == (void*)-1)
 938         pos = NULL;
 939     else if (pos) {
 940         pmc = *(PMC**)pos;
 941         if (!pmc)
 942             pos = NULL;
 943     }
 944     if (pos) {
 945         if (info->extra_flags == EXTRA_IS_PROP_HASH) {
 946             Parrot_default_thaw(interpreter, pmc, info);
 947             return;
 948         }
 949         /* else maybe VTABLE_thaw ... but there is no other extra stuff */
 950
 951 #if FREEZE_USE_NEXT_FOR_GC
 952         /*
 953          * the next_for_GC method doesn't keep track of repeated scalars
 954          * and such, as these are lacking the next_for_GC pointer, so
 955          * these are just duplicated with their data.
 956          * But we track these when thawing, so that we don't create dups
 957          */
 958         if (!must_have_seen) {
 959             /* so we must consume the bytecode */
 960             VTABLE_thaw(interpreter, pmc, info);
 961         }
 962 #else
 963         assert(must_have_seen);
 964 #endif
 965         /*
 966          * that's a duplicate
 967          if (info->container)
 968          DOD_WRITE_BARRIER(interpreter, info->container, NULL, pmc);
 969          */
 970         *info->thaw_ptr = pmc;
 971         return;
 972     }
 973
 974     assert(!must_have_seen);
 975     pmc = thaw_create_pmc(interpreter, info, type);
 976
 977     VTABLE_thaw(interpreter, pmc, info);
 978     if (info->extra_flags == EXTRA_CLASS_EXISTS) {
 979         pmc = info->extra;
 980         info->extra = NULL;
 981         info->extra_flags = 0;
 982     }
 983     if (!info->thaw_result)
 984         info->thaw_result = pmc;
 985     else {
 986         if (info->container) {
 987             DOD_WRITE_BARRIER(interpreter, info->container, NULL, pmc);
 988         }
 989         *info->thaw_ptr = pmc;
 990     }
 991     list_assign(interpreter, PMC_data(info->id_list), id, pmc, enum_type_PMC);
 992     /* remember nested aggregates depth first */
 993     if (pmc->pmc_ext)
 994         list_unshift(interpreter, PMC_data(info->todo), pmc, enum_type_PMC);
 995 }
 996
 997
 998 static UINTVAL
 999 id_from_pmc(Parrot_Interp interpreter, PMC* pmc)
1000 {
1001     UINTVAL id = 1;     /* first PMC in first arena */
1002     struct Small_Object_Arena *arena;
1003     struct Small_Object_Pool *pool;
1004     ptrdiff_t ptr_diff;
1005
1006     pmc = (PMC*)PObj_to_ARENA(pmc);
1007     pool = interpreter->arena_base->pmc_pool;
1008     for (arena = pool->last_Arena; arena; arena = arena->prev) {
1009         ptr_diff = (ptrdiff_t)pmc - (ptrdiff_t)arena->start_objects;
1010         if (ptr_diff >= 0 && ptr_diff <
1011                 (ptrdiff_t)(arena->used * pool->object_size)) {
1012             assert(ptr_diff % pool->object_size == 0);
1013             id += ptr_diff / pool->object_size;
1014             return id << 2;
1015         }
1016         id += arena->total_objects;
1017     }
1018     pool = interpreter->arena_base->constant_pmc_pool;
1019     for (arena = pool->last_Arena; arena; arena = arena->prev) {
1020         ptr_diff = (ptrdiff_t)pmc - (ptrdiff_t)arena->start_objects;
1021         if (ptr_diff >= 0 && ptr_diff <
1022                 (ptrdiff_t)(arena->used * pool->object_size)) {
1023             assert(ptr_diff % pool->object_size == 0);
1024             id += ptr_diff / pool->object_size;
1025             return id << 2;
1026         }
1027         id += arena->total_objects;
1028     }
1029
1030     internal_exception(1, "Couldn't find PMC in arenas");
1031     return -1;
1032 }
1033
1034 /*
1035
1036 =item C<static void
1037 add_pmc_next_for_GC(Parrot_Interp interpreter, PMC *pmc, visit_info *info)>
1038
1039 Remembers the PMC for later processing.
1040
1041 =cut
1042
1043 */
1044
1045 static void
1046 add_pmc_next_for_GC(Parrot_Interp interpreter, PMC *pmc, visit_info *info)
1047 {
1048     if (pmc->pmc_ext) {
1049         PMC_next_for_GC(info->mark_ptr) = pmc;
1050         info->mark_ptr = PMC_next_for_GC(pmc) = pmc;
1051     }
1052 }
1053
1054 /*
1055
1056 =item C<PARROT_INLINE static int
1057 next_for_GC_seen(Parrot_Interp interpreter, PMC *pmc, visit_info *info,
1058         UINTVAL *id)>
1059
1060 Remembers next child to visit via the C<next_for_GC pointer> generate a
1061 unique ID per PMC and freeze the ID (not the PMC address) so thaw the
1062 hash-lookup can be replaced by an array lookup then which is a lot
1063 faster.
1064
1065 =cut
1066
1067 */
1068
1069 PARROT_INLINE static int
1070 next_for_GC_seen(Parrot_Interp interpreter, PMC *pmc, visit_info *info,
1071         UINTVAL *id)
1072 {
1073     int seen = 0;
1074     if (PMC_IS_NULL(pmc)) {
1075         *id = 0;
1076         return 1;
1077     }
1078
1079     /*
1080      * we can only remember PMCs with a next_for_GC pointer
1081      * which is located in pmc_ext
1082      */
1083     if (pmc->pmc_ext) {
1084         /* already seen? */
1085         if (PMC_next_for_GC(pmc)) {
1086             seen = 1;
1087             goto skip;
1088         }
1089         /* put pmc at the end of the list */
1090         PMC_next_for_GC(info->mark_ptr) = pmc;
1091         /* make end self-referential */
1092         info->mark_ptr = PMC_next_for_GC(pmc) = pmc;
1093     }
1094 skip:
1095     *id = id_from_pmc(interpreter, pmc);
1096     return seen;
1097 }
1098
1099 /*
1100
1101 =item C<static void
1102 add_pmc_todo_list(Parrot_Interp interpreter, PMC *pmc, visit_info *info)>
1103
1104 Remembers the PMC to be processed later.
1105
1106 =cut
1107
1108 */
1109
1110 static void
1111 add_pmc_todo_list(Parrot_Interp interpreter, PMC *pmc, visit_info *info)
1112 {
1113     list_push(interpreter, PMC_data(info->todo), pmc, enum_type_PMC);
1114 }
1115
1116 /*
1117
1118 =item C<PARROT_INLINE static int
1119 todo_list_seen(Parrot_Interp interpreter, PMC *pmc, visit_info *info,
1120         UINTVAL *id)>
1121
1122 Returns true if the PMC was seen, otherwise it put it on the todo list,
1123 generates an ID (tag) for PMC, offset by 4 as are addresses, low bits
1124 are flags.
1125
1126 =cut
1127
1128 */
1129
1130 PARROT_INLINE static int
1131 todo_list_seen(Parrot_Interp interpreter, PMC *pmc, visit_info *info,
1132         UINTVAL *id)
1133 {
1134     HashBucket * const b =
1135         parrot_hash_get_bucket(interpreter, PMC_struct_val(info->seen), pmc);
1136
1137     if (b) {
1138         *id = (UINTVAL) b->value;
1139         return 1;
1140     }
1141
1142     info->id += 4;      /* next id to freeze */
1143     *id = info->id;
1144     parrot_hash_put(interpreter, PMC_struct_val(info->seen), pmc, (void*)*id);
1145     /* remember containers */
1146     if (pmc->pmc_ext)
1147         list_unshift(interpreter, PMC_data(info->todo), pmc, enum_type_PMC);
1148     return 0;
1149 }
1150
1151 /*
1152
1153 =item C<static void
1154 visit_next_for_GC(Parrot_Interp interpreter, PMC* pmc, visit_info* info)>
1155
1156 C<visit_child> callbacks:
1157
1158 Checks if the PMC was seen, generate an ID for it if not, then do the
1159 appropriate action.
1160
1161 =cut
1162
1163 */
1164
1165 static void
1166 visit_next_for_GC(Parrot_Interp interpreter, PMC* pmc, visit_info* info)
1167 {
1168     UINTVAL id;
1169     const int seen = next_for_GC_seen(interpreter, pmc, info, &id);
1170
1171     internal_exception(1, "todo convert to depth first");
1172     do_action(interpreter, pmc, info, seen, id);
1173     /*
1174      * TODO probe for class methods that override the default.
1175      * To avoid overhead, we could have an array[class_enums]
1176      * which (after first find_method) has a bit, if a user
1177      * callback is there.
1178      */
1179     if (!seen)
1180         (info->visit_action)(interpreter, pmc, info);
1181 }
1182
1183 /*
1184
1185 =item C<static void
1186 visit_todo_list(Parrot_Interp interpreter, PMC* pmc, visit_info* info)>
1187
1188 Checks the seen PMC via the todo list.
1189
1190 =cut
1191
1192 */
1193
1194 static void
1195 visit_todo_list(Parrot_Interp interpreter, PMC* pmc, visit_info* info)
1196 {
1197     UINTVAL id;
1198     int seen;
1199
1200     if (PMC_IS_NULL(pmc)) {
1201         seen = 1;
1202         id = 0;
1203     }
1204     else
1205         seen = todo_list_seen(interpreter, pmc, info, &id);
1206     do_action(interpreter, pmc, info, seen, id);
1207     if (!seen)
1208         (info->visit_action)(interpreter, pmc, info);
1209 }
1210
1211 /*
1212
1213 =item C<static void
1214 visit_todo_list_thaw(Parrot_Interp interpreter, PMC* old, visit_info* info)>
1215
1216 Callback for thaw - action first.
1217
1218 Todo-list and seen handling is all in C<do_thaw()>.
1219
1220 =cut
1221
1222 */
1223
1224 static void
1225 visit_todo_list_thaw(Parrot_Interp interpreter, PMC* old, visit_info* info)
1226 {
1227     do_thaw(interpreter, old, info);
1228 }
1229
1230 /*
1231
1232 =item C<static void
1233 visit_loop_next_for_GC(Parrot_Interp interpreter, PMC *current,
1234         visit_info *info)>
1235
1236 Put first item on todo list, then run as long as there are items to be
1237 done.
1238
1239 =cut
1240
1241 */
1242
1243 static void
1244 visit_loop_next_for_GC(Parrot_Interp interpreter, PMC *current,
1245         visit_info *info)
1246 {
1247     visit_next_for_GC(interpreter, current, info);
1248     if (current->pmc_ext) {
1249         PMC *prev = NULL;
1250
1251         while (current != prev) {
1252             VTABLE_visit(interpreter, current, info);
1253             prev = current;
1254             current = PMC_next_for_GC(current);
1255         }
1256     }
1257 }
1258
1259 /*
1260
1261 =item C<static PMC*
1262 visit_loop_todo_list(Parrot_Interp interpreter, PMC *current,
1263         visit_info *info)>
1264
1265 The thaw loop.
1266
1267 =cut
1268
1269 */
1270
1271 /* XXX This should be in a header file. */
1272 extern void
1273 Parrot_default_thawfinish(Interp* interpreter, PMC* pmc, visit_info *info);
1274
1275 static void
1276 visit_loop_todo_list(Parrot_Interp interpreter, PMC *current,
1277         visit_info *info)
1278 {
1279     List *todo = PMC_data(info->todo);
1280     PMC *finish_list_pmc;
1281     int i, n;
1282     List *finish_list = NULL;   /* gcc -O3 warning */
1283     int finished_first = 0;
1284
1285     const int thawing =  info->what == VISIT_THAW_CONSTANTS ||
1286             info->what == VISIT_THAW_NORMAL;
1287     if (thawing) {
1288         /*
1289          * create a list that contains PMCs that need thawfinish
1290          */
1291         finish_list_pmc = pmc_new(interpreter, enum_class_Array);
1292         finish_list = PMC_data(finish_list_pmc);
1293     }
1294
1295     (info->visit_pmc_now)(interpreter, current, info);
1296     /*
1297      * can't cache upper limit, visit may append items
1298      */
1299 again:
1300     for (; (int)list_length(interpreter, todo); ) {
1301         current = *(PMC**)list_shift(interpreter, todo, enum_type_PMC);
1302         VTABLE_visit(interpreter, current, info);
1303         if (thawing) {
1304             if (current == info->thaw_result)
1305                 finished_first = 1;
1306             if (current->vtable && current->vtable->thawfinish !=
1307                     Parrot_default_thawfinish)
1308                 list_unshift(interpreter, finish_list, current, enum_type_PMC);
1309         }
1310     }
1311
1312     if (thawing) {
1313         /*
1314          * if image isn't consumed, there are some extra data to thaw
1315          */
1316         if (info->image->bufused > 0) {
1317             (info->visit_pmc_now)(interpreter, NULL, info);
1318             goto again;
1319         }
1320         /*
1321          * on thawing call thawfinish for each processed PMC
1322          */
1323         if (!finished_first) {
1324             /*
1325              * the first create PMC might not be in the list,
1326              * if it has no pmc_ext
1327              */
1328             list_unshift(interpreter, finish_list,
1329                     info->thaw_result, enum_type_PMC);
1330         }
1331         n = (int)list_length(interpreter, finish_list);
1332         for (i = 0; i < n ; ++i) {
1333             current = *(PMC**)list_get(interpreter, finish_list, i,
1334                     enum_type_PMC);
1335             if (!PMC_IS_NULL(current))
1336                 VTABLE_thawfinish(interpreter, current, info);
1337         }
1338     }
1339 }
1340
1341 /*
1342
1343 =item C<static void
1344 create_image(Parrot_Interp interpreter, PMC *pmc, visit_info *info)>
1345
1346 Allocate image to some estimated size.
1347
1348 =cut
1349
1350 */
1351
1352 static void
1353 create_image(Parrot_Interp interpreter, PMC *pmc, visit_info *info)
1354 {
1355     INTVAL len;
1356     if (!PMC_IS_NULL(pmc) && (VTABLE_does(interpreter, pmc,
1357                 string_from_cstring(interpreter, "array", 0)) ||
1358         VTABLE_does(interpreter, pmc,
1359                 string_from_cstring(interpreter, "hash", 0)))) {
1360         const INTVAL items = VTABLE_elements(interpreter, pmc);
1361         /*
1362          * TODO check e.g. first item of aggregate and estimate size
1363          */
1364         len = items * FREEZE_BYTES_PER_ITEM;
1365     }
1366     else
1367         len = FREEZE_BYTES_PER_ITEM;
1368
1369     info->image = string_make_empty(interpreter, enum_stringrep_one, len);
1370 }
1371
1372 /*
1373
1374 =item C<static PMC*
1375 run_thaw(Parrot_Interp interpreter, STRING* image, visit_enum_type what)>
1376
1377 Performs thawing. C<what> indicates what to be thawed.
1378
1379 Thaw could use the C<next_for_GC> pointers as todo-list too, but this
1380 would need 2 runs through the arenas to clean the C<next_for_GC>
1381 pointers.
1382
1383 For now it seems cheaper to use a list for remembering contained
1384 aggregates. We could of course decide dynamically, which strategy to
1385 use, e.g.: given a big image, the first thawed item is a small
1386 aggregate. This implies, it probably contains (or some big strings) more
1387 nested containers, for which the C<next_for_GC> approach could be a win.
1388
1389 =cut
1390
1391 */
1392
1393 static PMC*
1394 run_thaw(Parrot_Interp interpreter, STRING* image, visit_enum_type what)
1395 {
1396     visit_info info;
1397     int dod_block = 0;
1398     const UINTVAL bufused = image->bufused;
1399
1400     info.image = image;
1401     /*
1402      * if we are thawing a lot of PMCs, its cheaper to do
1403      * a DOD run first and then block DOD - the limit should be
1404      * chosen so that no more then one DOD run would be triggered
1405      *
1406      * XXX
1407      *
1408      * md5_3.pir shows a segfault during thawing the config hash
1409      * info->thaw_ptr becomes invalid - seems that the hash got
1410      * collected under us.
1411      */
1412     if (1 || (string_length(interpreter, image) > THAW_BLOCK_DOD_SIZE)) {
1413         Parrot_do_dod_run(interpreter, 1);
1414         Parrot_block_DOD(interpreter);
1415         Parrot_block_GC(interpreter);
1416         dod_block = 1;
1417     }
1418
1419     info.what = what;   /* _NORMAL or _CONSTANTS */
1420     todo_list_init(interpreter, &info);
1421     info.visit_pmc_now = visit_todo_list_thaw;
1422     info.visit_pmc_later = add_pmc_todo_list;
1423
1424     info.thaw_result = NULL;
1425     /*
1426      * run thaw loop
1427      */
1428     visit_loop_todo_list(interpreter, NULL, &info);
1429     /*
1430      * thaw does "consume" the image string by incrementing strstart
1431      * and decrementing bufused - restore that
1432      */
1433     LVALUE_CAST(char *, image->strstart) -= bufused;
1434     image->bufused = bufused;
1435     assert(image->strstart >= PObj_bufstart(image));
1436
1437     if (dod_block) {
1438         Parrot_unblock_DOD(interpreter);
1439         Parrot_unblock_GC(interpreter);
1440     }
1441     PackFile_destroy(interpreter, info.image_io->pf);
1442     mem_sys_free(info.image_io);
1443     return info.thaw_result;
1444 }
1445
1446 /*
1447
1448 =back
1449
1450 =head2 Public Interface
1451
1452 =over 4
1453
1454 =item C<STRING*
1455 Parrot_freeze_at_destruct(Parrot_Interp interpreter, PMC* pmc)>
1456
1457 This function must not consume any resources (except the image itself).
1458 It uses the C<next_for_GC> pointer, so its not reentrant and must not be
1459 interrupted by a DOD run.
1460
1461 =cut
1462
1463 */
1464
1465 STRING*
1466 Parrot_freeze_at_destruct(Parrot_Interp interpreter, PMC* pmc)
1467 {
1468     visit_info info;
1469
1470     Parrot_block_DOD(interpreter);
1471     cleanup_next_for_GC(interpreter);
1472     info.what = VISIT_FREEZE_AT_DESTRUCT;
1473     info.mark_ptr = pmc;
1474     info.thaw_ptr = NULL;
1475     info.visit_pmc_now = visit_next_for_GC;
1476     info.visit_pmc_later = add_pmc_next_for_GC;
1477     create_image(interpreter, pmc, &info);
1478     ft_init(interpreter, &info);
1479
1480     visit_loop_next_for_GC(interpreter, pmc, &info);
1481
1482     Parrot_unblock_DOD(interpreter);
1483     PackFile_destroy(interpreter, info.image_io->pf);
1484     mem_sys_free(info.image_io);
1485     return info.image;
1486 }
1487
1488 /*
1489
1490 =item C<STRING*
1491 Parrot_freeze(Parrot_Interp interpreter, PMC* pmc)>
1492
1493 Freeze using either method.
1494
1495 =cut
1496
1497 */
1498
1499 STRING*
1500 Parrot_freeze(Parrot_Interp interpreter, PMC* pmc)
1501 {
1502 #if FREEZE_USE_NEXT_FOR_GC
1503     /*
1504      * we could do a DOD run here before, to free resources
1505      */
1506     return Parrot_freeze_at_destruct(interpreter, pmc);
1507 #else
1508     /*
1509      * freeze using a todo list and seen hash
1510      * Please note that both have to be PMCs, so that trace_system_stack
1511      * can call mark on the PMCs
1512      */
1513     visit_info info;
1514
1515     info.what = VISIT_FREEZE_NORMAL;
1516     create_image(interpreter, pmc, &info);
1517     todo_list_init(interpreter, &info);
1518
1519     visit_loop_todo_list(interpreter, pmc, &info);
1520
1521     PackFile_destroy(interpreter, info.image_io->pf);
1522     mem_sys_free(info.image_io);
1523     return info.image;
1524 #endif
1525 }
1526
1527 /*
1528
1529 =item C<PMC*
1530 Parrot_thaw(Parrot_Interp interpreter, STRING* image)>
1531
1532 Thaw a PMC, called from the C<thaw> opcode.
1533
1534 =cut
1535
1536 */
1537
1538 PMC*
1539 Parrot_thaw(Parrot_Interp interpreter, STRING* image)
1540 {
1541     return run_thaw(interpreter, image, VISIT_THAW_NORMAL);
1542 }
1543
1544 /*
1545
1546 =item C<PMC*
1547 Parrot_thaw_constants(Parrot_Interp interpreter, STRING* image)>
1548
1549 Thaw the constants. This is used by PackFile for unpacking PMC
1550 constants.
1551
1552 =cut
1553
1554 */
1555
1556 PMC*
1557 Parrot_thaw_constants(Parrot_Interp interpreter, STRING* image)
1558 {
1559     return run_thaw(interpreter, image, VISIT_THAW_CONSTANTS);
1560 }
1561
1562 /*
1563
1564 =item C<PMC*
1565 Parrot_clone(Parrot_Interp interpreter, PMC* pmc)>
1566
1567 There are for sure shortcuts to clone faster, e.g. always thaw the image
1568 immediately or use a special callback. But for now we just thaw a frozen
1569 PMC.
1570
1571 =cut
1572
1573 */
1574
1575 PMC*
1576 Parrot_clone(Parrot_Interp interpreter, PMC* pmc)
1577 {
1578     return Parrot_thaw(interpreter, Parrot_freeze(interpreter, pmc));
1579 }
1580
1581 /*
1582
1583 =back
1584
1585 =head1 TODO
1586
1587 The seen-hash version for freezing might go away sometimes.
1588
1589 =head1 SEE ALSO
1590
1591 Lot of discussion on p6i and F<docs/dev/pmc_freeze.pod>.
1592
1593 =head1 HISTORY
1594
1595 Initial version by leo 2003.11.03 - 2003.11.07.
1596
1597 =cut
1598
1599 */
1600
1601
1602 /*
1603  * Local variables:
1604  *   c-file-style: "parrot"
1605  * End:
1606  * vim: expandtab shiftwidth=4:
1607  */