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 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 "pmc_freeze.str"
  36
  37 /* HEADERIZER HFILE: include/parrot/pmc_freeze.h */
  38 /* HEADERIZER BEGIN: static */
  39 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  40
  41 static void add_pmc_next_for_GC(SHIM_INTERP,
  42     ARGIN(PMC *pmc),
  43     ARGOUT(visit_info *info))
  44         __attribute__nonnull__(2)
  45         __attribute__nonnull__(3)
  46         FUNC_MODIFIES(*info);
  47
  48 static void add_pmc_todo_list(PARROT_INTERP,
  49     ARGIN_NULLOK(PMC *pmc),
  50     ARGIN(visit_info *info))
  51         __attribute__nonnull__(1)
  52         __attribute__nonnull__(3);
  53
  54 static void create_image(PARROT_INTERP,
  55     ARGIN_NULLOK(PMC *pmc),
  56     ARGMOD(visit_info *info))
  57         __attribute__nonnull__(1)
  58         __attribute__nonnull__(3)
  59         FUNC_MODIFIES(*info);
  60
  61 PARROT_INLINE
  62 static void do_action(PARROT_INTERP,
  63     ARGIN_NULLOK(PMC *pmc),
  64     ARGIN(visit_info *info),
  65     int seen,
  66     UINTVAL id)
  67         __attribute__nonnull__(1)
  68         __attribute__nonnull__(3);
  69
  70 PARROT_INLINE
  71 static void do_thaw(PARROT_INTERP,
  72     ARGIN_NULLOK(PMC* pmc),
  73     ARGIN(visit_info *info))
  74         __attribute__nonnull__(1)
  75         __attribute__nonnull__(3);
  76
  77 PARROT_INLINE
  78 static void freeze_pmc(PARROT_INTERP,
  79     ARGIN_NULLOK(PMC *pmc),
  80     ARGIN(visit_info *info),
  81     int seen,
  82     UINTVAL id)
  83         __attribute__nonnull__(1)
  84         __attribute__nonnull__(3);
  85
  86 static void ft_init(PARROT_INTERP, ARGIN(visit_info *info))
  87         __attribute__nonnull__(1)
  88         __attribute__nonnull__(2);
  89
  90 static UINTVAL id_from_pmc(PARROT_INTERP, ARGIN(PMC* pmc))
  91         __attribute__nonnull__(1)
  92         __attribute__nonnull__(2);
  93
  94 PARROT_INLINE
  95 static int next_for_GC_seen(PARROT_INTERP,
  96     ARGIN_NULLOK(PMC *pmc),
  97     ARGIN(visit_info *info),
  98     ARGOUT(UINTVAL *id))
  99         __attribute__nonnull__(1)
 100         __attribute__nonnull__(3)
 101         __attribute__nonnull__(4)
 102         FUNC_MODIFIES(*id);
 103
 104 static void op_append(PARROT_INTERP,
 105     ARGIN(STRING *s),
 106     opcode_t b,
 107     size_t len)
 108         __attribute__nonnull__(1)
 109         __attribute__nonnull__(2);
 110
 111 PARROT_INLINE
 112 static void op_check_size(PARROT_INTERP, ARGIN(STRING *s), size_t len)
 113         __attribute__nonnull__(1)
 114         __attribute__nonnull__(2);
 115
 116 static void pmc_add_ext(PARROT_INTERP, ARGIN(PMC *pmc))
 117         __attribute__nonnull__(1)
 118         __attribute__nonnull__(2);
 119
 120 static void push_ascii_integer(PARROT_INTERP, ARGIN(IMAGE_IO *io), INTVAL v)
 121         __attribute__nonnull__(1)
 122         __attribute__nonnull__(2);
 123
 124 static void push_ascii_number(PARROT_INTERP,
 125     ARGIN(const IMAGE_IO *io),
 126     FLOATVAL v)
 127         __attribute__nonnull__(1)
 128         __attribute__nonnull__(2);
 129
 130 static void push_ascii_pmc(PARROT_INTERP,
 131     ARGIN(IMAGE_IO *io),
 132     ARGIN(const PMC* v))
 133         __attribute__nonnull__(1)
 134         __attribute__nonnull__(2)
 135         __attribute__nonnull__(3);
 136
 137 static void push_ascii_string(PARROT_INTERP,
 138     ARGIN(IMAGE_IO *io),
 139     ARGIN(const STRING *s))
 140         __attribute__nonnull__(1)
 141         __attribute__nonnull__(2)
 142         __attribute__nonnull__(3);
 143
 144 static void push_opcode_integer(PARROT_INTERP,
 145     ARGIN(IMAGE_IO *io),
 146     INTVAL v)
 147         __attribute__nonnull__(1)
 148         __attribute__nonnull__(2);
 149
 150 static void push_opcode_number(PARROT_INTERP,
 151     ARGIN(IMAGE_IO *io),
 152     FLOATVAL v)
 153         __attribute__nonnull__(1)
 154         __attribute__nonnull__(2);
 155
 156 static void push_opcode_pmc(PARROT_INTERP,
 157     ARGIN(IMAGE_IO *io),
 158     ARGIN(PMC* v))
 159         __attribute__nonnull__(1)
 160         __attribute__nonnull__(2)
 161         __attribute__nonnull__(3);
 162
 163 static void push_opcode_string(PARROT_INTERP,
 164     ARGIN(IMAGE_IO *io),
 165     ARGIN(STRING *v))
 166         __attribute__nonnull__(1)
 167         __attribute__nonnull__(2)
 168         __attribute__nonnull__(3);
 169
 170 PARROT_WARN_UNUSED_RESULT
 171 PARROT_CAN_RETURN_NULL
 172 static PMC* run_thaw(PARROT_INTERP,
 173     ARGIN(STRING* image),
 174     visit_enum_type what)
 175         __attribute__nonnull__(1)
 176         __attribute__nonnull__(2);
 177
 178 static INTVAL shift_ascii_integer(SHIM_INTERP, ARGIN(IMAGE_IO *io))
 179         __attribute__nonnull__(2);
 180
 181 static FLOATVAL shift_ascii_number(SHIM_INTERP, ARGIN(IMAGE_IO *io))
 182         __attribute__nonnull__(2);
 183
 184 PARROT_WARN_UNUSED_RESULT
 185 PARROT_CAN_RETURN_NULL
 186 static PMC* shift_ascii_pmc(SHIM_INTERP, ARGIN(IMAGE_IO *io))
 187         __attribute__nonnull__(2);
 188
 189 PARROT_WARN_UNUSED_RESULT
 190 PARROT_CAN_RETURN_NULL
 191 static STRING* shift_ascii_string(PARROT_INTERP, ARGIN(IMAGE_IO *io))
 192         __attribute__nonnull__(1)
 193         __attribute__nonnull__(2);
 194
 195 static INTVAL shift_opcode_integer(SHIM_INTERP, ARGIN(IMAGE_IO *io))
 196         __attribute__nonnull__(2);
 197
 198 static FLOATVAL shift_opcode_number(SHIM_INTERP, ARGIN(IMAGE_IO *io))
 199         __attribute__nonnull__(2);
 200
 201 PARROT_WARN_UNUSED_RESULT
 202 PARROT_CAN_RETURN_NULL
 203 static PMC* shift_opcode_pmc(PARROT_INTERP, ARGIN(IMAGE_IO *io))
 204         __attribute__nonnull__(1)
 205         __attribute__nonnull__(2);
 206
 207 PARROT_WARN_UNUSED_RESULT
 208 PARROT_CANNOT_RETURN_NULL
 209 static STRING* shift_opcode_string(PARROT_INTERP, ARGIN(IMAGE_IO *io))
 210         __attribute__nonnull__(1)
 211         __attribute__nonnull__(2);
 212
 213 static void str_append(PARROT_INTERP,
 214     ARGMOD(STRING *s),
 215     ARGIN(const void *b),
 216     size_t len)
 217         __attribute__nonnull__(1)
 218         __attribute__nonnull__(2)
 219         __attribute__nonnull__(3)
 220         FUNC_MODIFIES(*s);
 221
 222 PARROT_INLINE
 223 PARROT_CANNOT_RETURN_NULL
 224 static PMC* thaw_create_pmc(PARROT_INTERP,
 225     ARGIN(const visit_info *info),
 226     INTVAL type)
 227         __attribute__nonnull__(1)
 228         __attribute__nonnull__(2);
 229
 230 PARROT_INLINE
 231 static int thaw_pmc(PARROT_INTERP,
 232     ARGMOD(visit_info *info),
 233     ARGOUT(UINTVAL *id),
 234     ARGOUT(INTVAL *type))
 235         __attribute__nonnull__(1)
 236         __attribute__nonnull__(2)
 237         __attribute__nonnull__(3)
 238         __attribute__nonnull__(4)
 239         FUNC_MODIFIES(*info)
 240         FUNC_MODIFIES(*id)
 241         FUNC_MODIFIES(*type);
 242
 243 static void todo_list_init(PARROT_INTERP, ARGOUT(visit_info *info))
 244         __attribute__nonnull__(1)
 245         __attribute__nonnull__(2)
 246         FUNC_MODIFIES(*info);
 247
 248 PARROT_INLINE
 249 static int todo_list_seen(PARROT_INTERP,
 250     ARGIN(PMC *pmc),
 251     ARGMOD(visit_info *info),
 252     ARGOUT(UINTVAL *id))
 253         __attribute__nonnull__(1)
 254         __attribute__nonnull__(2)
 255         __attribute__nonnull__(3)
 256         __attribute__nonnull__(4)
 257         FUNC_MODIFIES(*info)
 258         FUNC_MODIFIES(*id);
 259
 260 static void visit_loop_next_for_GC(PARROT_INTERP,
 261     ARGIN(PMC *current),
 262     ARGIN(visit_info *info))
 263         __attribute__nonnull__(1)
 264         __attribute__nonnull__(2)
 265         __attribute__nonnull__(3);
 266
 267 static void visit_loop_todo_list(PARROT_INTERP,
 268     ARGIN_NULLOK(PMC *current),
 269     ARGIN(visit_info *info))
 270         __attribute__nonnull__(1)
 271         __attribute__nonnull__(3);
 272
 273 static void visit_next_for_GC(PARROT_INTERP,
 274     ARGIN(PMC* pmc),
 275     ARGIN(visit_info* info))
 276         __attribute__nonnull__(1)
 277         __attribute__nonnull__(2)
 278         __attribute__nonnull__(3);
 279
 280 static void visit_todo_list(PARROT_INTERP,
 281     ARGIN_NULLOK(PMC* pmc),
 282     ARGIN(visit_info* info))
 283         __attribute__nonnull__(1)
 284         __attribute__nonnull__(3);
 285
 286 static void visit_todo_list_thaw(PARROT_INTERP,
 287     ARGIN_NULLOK(PMC* old),
 288     ARGIN(visit_info* info))
 289         __attribute__nonnull__(1)
 290         __attribute__nonnull__(3);
 291
 292 #define ASSERT_ARGS_add_pmc_next_for_GC __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 293        PARROT_ASSERT_ARG(pmc) \
 294     || PARROT_ASSERT_ARG(info)
 295 #define ASSERT_ARGS_add_pmc_todo_list __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 296        PARROT_ASSERT_ARG(interp) \
 297     || PARROT_ASSERT_ARG(info)
 298 #define ASSERT_ARGS_create_image __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 299        PARROT_ASSERT_ARG(interp) \
 300     || PARROT_ASSERT_ARG(info)
 301 #define ASSERT_ARGS_do_action __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 302        PARROT_ASSERT_ARG(interp) \
 303     || PARROT_ASSERT_ARG(info)
 304 #define ASSERT_ARGS_do_thaw __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 305        PARROT_ASSERT_ARG(interp) \
 306     || PARROT_ASSERT_ARG(info)
 307 #define ASSERT_ARGS_freeze_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 308        PARROT_ASSERT_ARG(interp) \
 309     || PARROT_ASSERT_ARG(info)
 310 #define ASSERT_ARGS_ft_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 311        PARROT_ASSERT_ARG(interp) \
 312     || PARROT_ASSERT_ARG(info)
 313 #define ASSERT_ARGS_id_from_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 314        PARROT_ASSERT_ARG(interp) \
 315     || PARROT_ASSERT_ARG(pmc)
 316 #define ASSERT_ARGS_next_for_GC_seen __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 317        PARROT_ASSERT_ARG(interp) \
 318     || PARROT_ASSERT_ARG(info) \
 319     || PARROT_ASSERT_ARG(id)
 320 #define ASSERT_ARGS_op_append __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 321        PARROT_ASSERT_ARG(interp) \
 322     || PARROT_ASSERT_ARG(s)
 323 #define ASSERT_ARGS_op_check_size __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 324        PARROT_ASSERT_ARG(interp) \
 325     || PARROT_ASSERT_ARG(s)
 326 #define ASSERT_ARGS_pmc_add_ext __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 327        PARROT_ASSERT_ARG(interp) \
 328     || PARROT_ASSERT_ARG(pmc)
 329 #define ASSERT_ARGS_push_ascii_integer __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 330        PARROT_ASSERT_ARG(interp) \
 331     || PARROT_ASSERT_ARG(io)
 332 #define ASSERT_ARGS_push_ascii_number __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 333        PARROT_ASSERT_ARG(interp) \
 334     || PARROT_ASSERT_ARG(io)
 335 #define ASSERT_ARGS_push_ascii_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 336        PARROT_ASSERT_ARG(interp) \
 337     || PARROT_ASSERT_ARG(io) \
 338     || PARROT_ASSERT_ARG(v)
 339 #define ASSERT_ARGS_push_ascii_string __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 340        PARROT_ASSERT_ARG(interp) \
 341     || PARROT_ASSERT_ARG(io) \
 342     || PARROT_ASSERT_ARG(s)
 343 #define ASSERT_ARGS_push_opcode_integer __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 344        PARROT_ASSERT_ARG(interp) \
 345     || PARROT_ASSERT_ARG(io)
 346 #define ASSERT_ARGS_push_opcode_number __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 347        PARROT_ASSERT_ARG(interp) \
 348     || PARROT_ASSERT_ARG(io)
 349 #define ASSERT_ARGS_push_opcode_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 350        PARROT_ASSERT_ARG(interp) \
 351     || PARROT_ASSERT_ARG(io) \
 352     || PARROT_ASSERT_ARG(v)
 353 #define ASSERT_ARGS_push_opcode_string __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 354        PARROT_ASSERT_ARG(interp) \
 355     || PARROT_ASSERT_ARG(io) \
 356     || PARROT_ASSERT_ARG(v)
 357 #define ASSERT_ARGS_run_thaw __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 358        PARROT_ASSERT_ARG(interp) \
 359     || PARROT_ASSERT_ARG(image)
 360 #define ASSERT_ARGS_shift_ascii_integer __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 361        PARROT_ASSERT_ARG(io)
 362 #define ASSERT_ARGS_shift_ascii_number __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 363        PARROT_ASSERT_ARG(io)
 364 #define ASSERT_ARGS_shift_ascii_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 365        PARROT_ASSERT_ARG(io)
 366 #define ASSERT_ARGS_shift_ascii_string __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 367        PARROT_ASSERT_ARG(interp) \
 368     || PARROT_ASSERT_ARG(io)
 369 #define ASSERT_ARGS_shift_opcode_integer __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 370        PARROT_ASSERT_ARG(io)
 371 #define ASSERT_ARGS_shift_opcode_number __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 372        PARROT_ASSERT_ARG(io)
 373 #define ASSERT_ARGS_shift_opcode_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 374        PARROT_ASSERT_ARG(interp) \
 375     || PARROT_ASSERT_ARG(io)
 376 #define ASSERT_ARGS_shift_opcode_string __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 377        PARROT_ASSERT_ARG(interp) \
 378     || PARROT_ASSERT_ARG(io)
 379 #define ASSERT_ARGS_str_append __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 380        PARROT_ASSERT_ARG(interp) \
 381     || PARROT_ASSERT_ARG(s) \
 382     || PARROT_ASSERT_ARG(b)
 383 #define ASSERT_ARGS_thaw_create_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 384        PARROT_ASSERT_ARG(interp) \
 385     || PARROT_ASSERT_ARG(info)
 386 #define ASSERT_ARGS_thaw_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 387        PARROT_ASSERT_ARG(interp) \
 388     || PARROT_ASSERT_ARG(info) \
 389     || PARROT_ASSERT_ARG(id) \
 390     || PARROT_ASSERT_ARG(type)
 391 #define ASSERT_ARGS_todo_list_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 392        PARROT_ASSERT_ARG(interp) \
 393     || PARROT_ASSERT_ARG(info)
 394 #define ASSERT_ARGS_todo_list_seen __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 395        PARROT_ASSERT_ARG(interp) \
 396     || PARROT_ASSERT_ARG(pmc) \
 397     || PARROT_ASSERT_ARG(info) \
 398     || PARROT_ASSERT_ARG(id)
 399 #define ASSERT_ARGS_visit_loop_next_for_GC __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 400        PARROT_ASSERT_ARG(interp) \
 401     || PARROT_ASSERT_ARG(current) \
 402     || PARROT_ASSERT_ARG(info)
 403 #define ASSERT_ARGS_visit_loop_todo_list __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 404        PARROT_ASSERT_ARG(interp) \
 405     || PARROT_ASSERT_ARG(info)
 406 #define ASSERT_ARGS_visit_next_for_GC __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 407        PARROT_ASSERT_ARG(interp) \
 408     || PARROT_ASSERT_ARG(pmc) \
 409     || PARROT_ASSERT_ARG(info)
 410 #define ASSERT_ARGS_visit_todo_list __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 411        PARROT_ASSERT_ARG(interp) \
 412     || PARROT_ASSERT_ARG(info)
 413 #define ASSERT_ARGS_visit_todo_list_thaw __attribute__unused__ int _ASSERT_ARGS_CHECK = \
 414        PARROT_ASSERT_ARG(interp) \
 415     || PARROT_ASSERT_ARG(info)
 416 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 417 /* HEADERIZER END: static */
 418
 419 /*
 420  * define this to 1 for testing. TODO: 1 is broken.
 421  */
 422 #ifndef FREEZE_ASCII
 423 #  define FREEZE_ASCII 0
 424 #endif
 425
 426 /* normal freeze can use next_for_GC ptrs or a seen hash */
 427 #define FREEZE_USE_NEXT_FOR_GC 0
 428
 429 /* when thawing a string longer then this size, we first do a GC run and then
 430  * block GC - the system can't give us more headers */
 431
 432 #define THAW_BLOCK_GC_SIZE 100000
 433
 434 /* preallocate freeze image for aggregates with this estimation */
 435 #if FREEZE_ASCII
 436 #  define FREEZE_BYTES_PER_ITEM 17
 437 #else
 438 #  define FREEZE_BYTES_PER_ITEM 9
 439 #endif
 440
 441 /*
 442
 443 =head2 Image Stream Functions
 444
 445 =over 4
 446
 447 =item C<static void str_append(PARROT_INTERP, STRING *s, const void *b, size_t
 448 len)>
 449
 450 Appends C<len> bytes from buffer C<*b> to string C<*s>.
 451
 452 Plain ascii - for testing only:
 453
 454 For speed reasons we mess around with the string buffers directly.
 455
 456 No encoding of strings, no transcoding.
 457
 458 =cut
 459
 460 */
 461
 462 static void
 463 str_append(PARROT_INTERP, ARGMOD(STRING *s), ARGIN(const void *b), size_t len)
 464 {
 465     ASSERT_ARGS(str_append)
 466     const size_t used = s->bufused;
 467     const int need_free = (int)PObj_buflen(s) - used - len;
 468     /*
 469      * grow by factor 1.5 or such
 470      */
 471     if (need_free <= 16) {
 472         size_t new_size = (size_t) (PObj_buflen(s) * 1.5);
 473         if (new_size < PObj_buflen(s) - need_free + 512)
 474             new_size = PObj_buflen(s) - need_free + 512;
 475         Parrot_gc_reallocate_string_storage(interp, s, new_size);
 476         PARROT_ASSERT(PObj_buflen(s) - used - len >= 15);
 477     }
 478     mem_sys_memcopy((void *)((ptrcast_t)s->strstart + used), b, len);
 479     s->bufused += len;
 480     s->strlen += len;
 481 }
 482
 483 /*
 484
 485 =item C<static void push_ascii_integer(PARROT_INTERP, IMAGE_IO *io, INTVAL v)>
 486
 487 Pushes an ASCII version of the integer C<v> onto the end of the C<*io>
 488 "stream".
 489
 490 =cut
 491
 492 */
 493
 494 static void
 495 push_ascii_integer(PARROT_INTERP, ARGIN(IMAGE_IO *io), INTVAL v)
 496 {
 497     ASSERT_ARGS(push_ascii_integer)
 498     char buffer[20];
 499     const size_t len = snprintf(buffer, sizeof (buffer), "%d ", (int) v);
 500     str_append(interp, io->image, buffer, len);
 501 }
 502
 503 /*
 504
 505 =item C<static void push_ascii_number(PARROT_INTERP, const IMAGE_IO *io,
 506 FLOATVAL v)>
 507
 508 Pushes an ASCII version of the number C<v> onto the end of the C<*io>
 509 "stream".
 510
 511 =cut
 512
 513 */
 514
 515 static void
 516 push_ascii_number(PARROT_INTERP, ARGIN(const IMAGE_IO *io), FLOATVAL v)
 517 {
 518     ASSERT_ARGS(push_ascii_number)
 519     char buffer[40];
 520     const size_t len = snprintf(buffer, sizeof (buffer), "%g ", (double) v);
 521     str_append(interp, io->image, buffer, len);
 522 }
 523
 524 /*
 525
 526 =item C<static void push_ascii_string(PARROT_INTERP, IMAGE_IO *io, const STRING
 527 *s)>
 528
 529 Pushes an ASCII version of the string C<*s> onto the end of the C<*io>
 530 "stream".
 531
 532 For testing only - no encodings and such.
 533
 534 XXX no string delimiters - so no space allowed.
 535
 536 =cut
 537
 538 */
 539
 540 static void
 541 push_ascii_string(PARROT_INTERP, ARGIN(IMAGE_IO *io), ARGIN(const STRING *s))
 542 {
 543     ASSERT_ARGS(push_ascii_string)
 544     const UINTVAL length = Parrot_str_byte_length(interp, s);
 545     char * const buffer = (char *)malloc(4*length); /* XXX Why 4?  What does that mean? */
 546     char *cursor = buffer;
 547     UINTVAL idx = 0;
 548
 549     /* temporary--write out in UTF-8 */
 550     for (idx = 0; idx < length; ++idx) {
 551         *cursor++ = (unsigned char)Parrot_str_indexed(interp, s, idx);
 552     }
 553
 554     str_append(interp, io->image, buffer, cursor - buffer);
 555     str_append(interp, io->image, " ", 1);
 556
 557     mem_sys_free(buffer);
 558 }
 559
 560 /*
 561
 562 =item C<static void push_ascii_pmc(PARROT_INTERP, IMAGE_IO *io, const PMC* v)>
 563
 564 Pushes an ASCII version of the PMC C<*v> onto the end of the C<*io>
 565 "stream".
 566
 567 =cut
 568
 569 */
 570
 571 static void
 572 push_ascii_pmc(PARROT_INTERP, ARGIN(IMAGE_IO *io), ARGIN(const PMC* v))
 573 {
 574     ASSERT_ARGS(push_ascii_pmc)
 575     char buffer[20];
 576     const size_t len = snprintf(buffer, sizeof (buffer), "%p ", (const void *)v);
 577     str_append(interp, io->image, buffer, len);
 578 }
 579
 580 /*
 581
 582 =item C<static INTVAL shift_ascii_integer(PARROT_INTERP, IMAGE_IO *io)>
 583
 584 Removes and returns an integer from the start of the C<*io> "stream".
 585
 586 =cut
 587
 588 */
 589
 590 static INTVAL
 591 shift_ascii_integer(SHIM_INTERP, ARGIN(IMAGE_IO *io))
 592 {
 593     ASSERT_ARGS(shift_ascii_integer)
 594     char * const start = (char*)io->image->strstart;
 595     char *p = start;
 596     const INTVAL i = strtoul(p, &p, 10);
 597
 598     ++p;
 599     PARROT_ASSERT(p <= start + io->image->bufused);
 600     io->image->strstart = p;
 601     io->image->bufused -= (p - start);
 602     PARROT_ASSERT((int)io->image->bufused >= 0);
 603     return i;
 604 }
 605
 606 /*
 607
 608 =item C<static FLOATVAL shift_ascii_number(PARROT_INTERP, IMAGE_IO *io)>
 609
 610 Removes and returns an number from the start of the C<*io> "stream".
 611
 612 =cut
 613
 614 */
 615
 616 static FLOATVAL
 617 shift_ascii_number(SHIM_INTERP, ARGIN(IMAGE_IO *io))
 618 {
 619     ASSERT_ARGS(shift_ascii_number)
 620     char * const start = (char*)io->image->strstart;
 621     char *p = start;
 622     const FLOATVAL f = (FLOATVAL) strtod(p, &p);
 623
 624     ++p;
 625     PARROT_ASSERT(p <= start + io->image->bufused);
 626     io->image->strstart = p;
 627     io->image->bufused -= (p - start);
 628     PARROT_ASSERT((int)io->image->bufused >= 0);
 629     return f;
 630 }
 631
 632 /*
 633
 634 =item C<static STRING* shift_ascii_string(PARROT_INTERP, IMAGE_IO *io)>
 635
 636 Removes and returns an string from the start of the C<*io> "stream".
 637
 638 =cut
 639
 640 */
 641
 642 PARROT_WARN_UNUSED_RESULT
 643 PARROT_CAN_RETURN_NULL
 644 static STRING*
 645 shift_ascii_string(PARROT_INTERP, ARGIN(IMAGE_IO *io))
 646 {
 647     ASSERT_ARGS(shift_ascii_string)
 648     STRING *s;
 649
 650     char * const start = (char*)io->image->strstart;
 651     char *p = start;
 652
 653     while (*p != ' ')
 654         ++p;
 655     ++p;
 656     PARROT_ASSERT(p <= start + io->image->bufused);
 657     io->image->strstart = p;
 658     io->image->bufused -= (p - start);
 659     PARROT_ASSERT((int)io->image->bufused >= 0);
 660     s = string_make(interp, start, p - start - 1, "iso-8859-1", 0);
 661 /*    s = string_make(interp, start, p - start - 1, "UTF-8", 0); */
 662     return s;
 663 }
 664
 665 /*
 666
 667 =item C<static PMC* shift_ascii_pmc(PARROT_INTERP, IMAGE_IO *io)>
 668
 669 Removes and returns a PMC from the start of the C<*io> "stream".
 670
 671 =cut
 672
 673 */
 674
 675 PARROT_WARN_UNUSED_RESULT
 676 PARROT_CAN_RETURN_NULL
 677 static PMC*
 678 shift_ascii_pmc(SHIM_INTERP, ARGIN(IMAGE_IO *io))
 679 {
 680     ASSERT_ARGS(shift_ascii_pmc)
 681     char * const start = (char*)io->image->strstart;
 682     char *p = start;
 683     const unsigned long i = strtoul(p, &p, 16);
 684     ++p;
 685     PARROT_ASSERT(p <= start + io->image->bufused);
 686     io->image->strstart = p;
 687     io->image->bufused -= (p - start);
 688     PARROT_ASSERT((int)io->image->bufused >= 0);
 689     return (PMC*) i;
 690 }
 691
 692 /*
 693
 694 =back
 695
 696 =head2 C<opcode_t> IO Functions
 697
 698 =over 4
 699
 700 =item C<static void op_check_size(PARROT_INTERP, STRING *s, size_t len)>
 701
 702 Checks the size of the "stream" buffer to see if it can accommodate
 703 C<len> more bytes. If not then the buffer is expanded.
 704
 705 =cut
 706
 707 */
 708
 709 PARROT_INLINE
 710 static void
 711 op_check_size(PARROT_INTERP, ARGIN(STRING *s), size_t len)
 712 {
 713     ASSERT_ARGS(op_check_size)
 714     const size_t used = s->bufused;
 715     const int need_free = (int)PObj_buflen(s) - used - len;
 716     /*
 717      * grow by factor 1.5 or such
 718      */
 719     if (need_free <= 16) {
 720         size_t new_size = (size_t) (PObj_buflen(s) * 1.5);
 721         if (new_size < PObj_buflen(s) - need_free + 512)
 722             new_size = PObj_buflen(s) - need_free + 512;
 723         Parrot_gc_reallocate_string_storage(interp, s, new_size);
 724         PARROT_ASSERT(PObj_buflen(s) - used - len >= 15);
 725     }
 726 #ifndef DISABLE_GC_DEBUG
 727     Parrot_gc_compact_memory_pool(interp);
 728 #endif
 729 }
 730
 731 /*
 732
 733 =item C<static void op_append(PARROT_INTERP, STRING *s, opcode_t b, size_t len)>
 734
 735 Appends the opcode C<b> to the string C<*s>.
 736
 737 =cut
 738
 739 */
 740
 741 static void
 742 op_append(PARROT_INTERP, ARGIN(STRING *s), opcode_t b, size_t len)
 743 {
 744     ASSERT_ARGS(op_append)
 745     char *str_pos;
 746
 747     op_check_size(interp, s, len);
 748     str_pos = s->strstart + s->bufused;
 749     *((opcode_t *)(str_pos)) = b;
 750     s->bufused += len;
 751     s->strlen += len;
 752 }
 753
 754 /*
 755
 756 =item C<static void push_opcode_integer(PARROT_INTERP, IMAGE_IO *io, INTVAL v)>
 757
 758 Pushes the integer C<v> onto the end of the C<*io> "stream".
 759
 760 XXX assumes sizeof (opcode_t) == sizeof (INTVAL).
 761
 762 =cut
 763
 764 */
 765
 766 static void
 767 push_opcode_integer(PARROT_INTERP, ARGIN(IMAGE_IO *io), INTVAL v)
 768 {
 769     ASSERT_ARGS(push_opcode_integer)
 770     PARROT_ASSERT(sizeof (opcode_t) == sizeof (INTVAL));
 771     op_append(interp, io->image, (opcode_t)v, sizeof (opcode_t));
 772 }
 773
 774 /*
 775
 776 =item C<static void push_opcode_number(PARROT_INTERP, IMAGE_IO *io, FLOATVAL v)>
 777
 778 Pushes the number C<v> onto the end of the C<*io> "stream".
 779
 780 =cut
 781
 782 */
 783
 784 static void
 785 push_opcode_number(PARROT_INTERP, ARGIN(IMAGE_IO *io), FLOATVAL v)
 786 {
 787     ASSERT_ARGS(push_opcode_number)
 788     const size_t   len  = PF_size_number() * sizeof (opcode_t);
 789     STRING * const s    = io->image;
 790     const size_t   used = s->bufused;
 791     opcode_t      *ignored;
 792
 793     op_check_size(interp, s, len);
 794     ignored = PF_store_number((opcode_t *)((ptrcast_t)s->strstart + used), &v);
 795     UNUSED(ignored);
 796
 797     s->bufused += len;
 798     s->strlen  += len;
 799 }
 800
 801 /*
 802
 803 =item C<static void push_opcode_string(PARROT_INTERP, IMAGE_IO *io, STRING *v)>
 804
 805 Pushes the string C<*v> onto the end of the C<*io> "stream".
 806
 807 =cut
 808
 809 */
 810
 811 static void
 812 push_opcode_string(PARROT_INTERP, ARGIN(IMAGE_IO *io), ARGIN(STRING *v))
 813 {
 814     ASSERT_ARGS(push_opcode_string)
 815     const size_t len = PF_size_string(v) * sizeof (opcode_t);
 816     STRING * const s = io->image;
 817     const size_t used = s->bufused;
 818     opcode_t      *ignored;
 819
 820     op_check_size(interp, s, len);
 821     ignored = PF_store_string((opcode_t *)((ptrcast_t)s->strstart + used), v);
 822     UNUSED(ignored);
 823
 824     s->bufused += len;
 825     s->strlen += len;
 826 }
 827
 828 /*
 829
 830 =item C<static void push_opcode_pmc(PARROT_INTERP, IMAGE_IO *io, PMC* v)>
 831
 832 Pushes the PMC C<*v> onto the end of the C<*io> "stream".
 833
 834 =cut
 835
 836 */
 837
 838 static void
 839 push_opcode_pmc(PARROT_INTERP, ARGIN(IMAGE_IO *io), ARGIN(PMC* v))
 840 {
 841     ASSERT_ARGS(push_opcode_pmc)
 842     op_append(interp, io->image, (opcode_t)v, sizeof (opcode_t));
 843 }
 844
 845 /*
 846
 847 =item C<static INTVAL shift_opcode_integer(PARROT_INTERP, IMAGE_IO *io)>
 848
 849 Removes and returns an integer from the start of the C<*io> "stream".
 850
 851 =cut
 852
 853 */
 854
 855 static INTVAL
 856 shift_opcode_integer(SHIM_INTERP, ARGIN(IMAGE_IO *io))
 857 {
 858     ASSERT_ARGS(shift_opcode_integer)
 859     const char * const   start  = (char *)io->image->strstart;
 860     char               **opcode = &io->image->strstart;
 861     const INTVAL i              = PF_fetch_integer(io->pf,
 862                                     (const opcode_t **)opcode);
 863
 864     io->image->bufused -= ((char *)io->image->strstart - start);
 865     PARROT_ASSERT((int)io->image->bufused >= 0);
 866
 867     return i;
 868 }
 869
 870 /*
 871
 872 =item C<static PMC* shift_opcode_pmc(PARROT_INTERP, IMAGE_IO *io)>
 873
 874 Removes and returns an PMC from the start of the C<*io> "stream".
 875
 876 Note that this actually reads a PMC id, not a PMC.
 877
 878 =cut
 879
 880 */
 881
 882 PARROT_WARN_UNUSED_RESULT
 883 PARROT_CAN_RETURN_NULL
 884 static PMC*
 885 shift_opcode_pmc(PARROT_INTERP, ARGIN(IMAGE_IO *io))
 886 {
 887     ASSERT_ARGS(shift_opcode_pmc)
 888     INTVAL i = shift_opcode_integer(interp, io);
 889     return (PMC *)i;
 890 }
 891
 892 /*
 893
 894 =item C<static FLOATVAL shift_opcode_number(PARROT_INTERP, IMAGE_IO *io)>
 895
 896 Removes and returns an number from the start of the C<*io> "stream".
 897
 898 =cut
 899
 900 */
 901
 902 static FLOATVAL
 903 shift_opcode_number(SHIM_INTERP, ARGIN(IMAGE_IO *io))
 904 {
 905     ASSERT_ARGS(shift_opcode_number)
 906     const char * const   start  = (const char *)io->image->strstart;
 907     char               **opcode = &io->image->strstart;
 908     const FLOATVAL       f      = PF_fetch_number(io->pf,
 909                                     (const opcode_t **)opcode);
 910
 911     io->image->bufused -= ((char *)io->image->strstart - start);
 912     PARROT_ASSERT((int)io->image->bufused >= 0);
 913
 914     return f;
 915 }
 916
 917 /*
 918
 919 =item C<static STRING* shift_opcode_string(PARROT_INTERP, IMAGE_IO *io)>
 920
 921 Removes and returns a string from the start of the C<*io> "stream".
 922
 923 =cut
 924
 925 */
 926
 927 PARROT_WARN_UNUSED_RESULT
 928 PARROT_CANNOT_RETURN_NULL
 929 static STRING*
 930 shift_opcode_string(PARROT_INTERP, ARGIN(IMAGE_IO *io))
 931 {
 932     ASSERT_ARGS(shift_opcode_string)
 933     char * const   start  = (char*)io->image->strstart;
 934     char         **opcode = &io->image->strstart;
 935     STRING * const s      = PF_fetch_string(interp, io->pf,
 936                                 (const opcode_t **)opcode);
 937
 938     io->image->bufused -= ((char *)io->image->strstart - start);
 939     PARROT_ASSERT((int)io->image->bufused >= 0);
 940
 941     return s;
 942 }
 943
 944 /*
 945
 946 =back
 947
 948 =head2 Helper Functions
 949
 950 =over 4
 951
 952 =item C<static void pmc_add_ext(PARROT_INTERP, PMC *pmc)>
 953
 954 Adds a C<PMC_EXT> to C<*pmc>.
 955
 956 =cut
 957
 958 */
 959
 960 static void
 961 pmc_add_ext(PARROT_INTERP, ARGIN(PMC *pmc))
 962 {
 963     ASSERT_ARGS(pmc_add_ext)
 964     if (pmc->vtable->flags & VTABLE_PMC_NEEDS_EXT)
 965         Parrot_gc_add_pmc_ext(interp, pmc);
 966 }
 967
 968 /*
 969  * this function setup stuff may be replaced by a real PMC
 970  * in the future
 971  * TODO add read/write header functions, e.g. vtable->init_pmc
 972  */
 973
 974 #if FREEZE_ASCII
 975 static image_funcs ascii_funcs = {
 976     push_ascii_integer,
 977     push_ascii_pmc,
 978     push_ascii_string,
 979     push_ascii_number,
 980     shift_ascii_integer,
 981     shift_ascii_pmc,
 982     shift_ascii_string,
 983     shift_ascii_number
 984 };
 985 #else
 986 static image_funcs opcode_funcs = {
 987     push_opcode_integer,
 988     push_opcode_pmc,
 989     push_opcode_string,
 990     push_opcode_number,
 991     shift_opcode_integer,
 992     shift_opcode_pmc,
 993     shift_opcode_string,
 994     shift_opcode_number
 995 };
 996 #endif
 997
 998 /*
 999
1000 =item C<static void ft_init(PARROT_INTERP, visit_info *info)>
1001
1002 Initializes the freeze/thaw subsystem.
1003
1004 =cut
1005
1006 */
1007
1008 static void
1009 ft_init(PARROT_INTERP, ARGIN(visit_info *info))
1010 {
1011     ASSERT_ARGS(ft_init)
1012     STRING *s = info->image;
1013     PackFile *pf;
1014
1015     /* We want to store a 16-byte aligned header, but the actual
1016      * header may be shorter. */
1017     const unsigned int header_length = PACKFILE_HEADER_BYTES +
1018         (PACKFILE_HEADER_BYTES % 16 ?
1019          16 - PACKFILE_HEADER_BYTES % 16 : 0);
1020
1021     info->image_io = mem_allocate_typed(IMAGE_IO);
1022     info->image_io->image = s = info->image;
1023 #if FREEZE_ASCII
1024     info->image_io->vtable = &ascii_funcs;
1025 #else
1026     info->image_io->vtable = &opcode_funcs;
1027 #endif
1028     pf = info->image_io->pf = PackFile_new(interp, 0);
1029     if (info->what == VISIT_FREEZE_NORMAL ||
1030         info->what == VISIT_FREEZE_AT_DESTRUCT) {
1031
1032         op_check_size(interp, s, header_length);
1033         mem_sys_memcopy(s->strstart, pf->header, PACKFILE_HEADER_BYTES);
1034         s->bufused += header_length;
1035         s->strlen += header_length;
1036     }
1037     else {
1038         if (Parrot_str_byte_length(interp, s) < header_length) {
1039             Parrot_ex_throw_from_c_args(interp, NULL,
1040                 EXCEPTION_INVALID_STRING_REPRESENTATION,
1041                 "bad string to thaw");
1042         }
1043
1044         /* TT #749: use the validation logic from Packfile_unpack */
1045         if (pf->header->bc_major != PARROT_PBC_MAJOR
1046         ||  pf->header->bc_minor != PARROT_PBC_MINOR)
1047             Parrot_ex_throw_from_c_args(interp, NULL,
1048                     EXCEPTION_INVALID_STRING_REPRESENTATION,
1049                     "can't thaw a PMC from Parrot %d.%d", pf->header->bc_major,
1050                     pf->header->bc_minor);
1051
1052         mem_sys_memcopy(pf->header, s->strstart, PACKFILE_HEADER_BYTES);
1053         PackFile_assign_transforms(pf);
1054         s->bufused -= header_length;
1055         LVALUE_CAST(char *, s->strstart) += header_length;
1056     }
1057
1058     info->last_type = -1;
1059     info->id_list = pmc_new(interp, enum_class_Array);
1060     info->id = 0;
1061     info->extra_flags = EXTRA_IS_NULL;
1062     info->container = NULL;
1063 }
1064
1065 /*
1066
1067 =item C<static void todo_list_init(PARROT_INTERP, visit_info *info)>
1068
1069 Initializes the C<*info> lists.
1070
1071 =cut
1072
1073 */
1074
1075 static void
1076 todo_list_init(PARROT_INTERP, ARGOUT(visit_info *info))
1077 {
1078     ASSERT_ARGS(todo_list_init)
1079     info->visit_pmc_now = visit_todo_list;
1080     info->visit_pmc_later = add_pmc_todo_list;
1081     /* we must use PMCs here, so that they get marked properly */
1082     info->todo = pmc_new(interp, enum_class_Array);
1083     info->seen = pmc_new(interp, enum_class_Hash);
1084     VTABLE_set_pointer(interp, info->seen, parrot_new_intval_hash(interp));
1085
1086     ft_init(interp, info);
1087 }
1088
1089
1090 /*
1091
1092 =item C<static void freeze_pmc(PARROT_INTERP, PMC *pmc, visit_info *info, int
1093 seen, UINTVAL id)>
1094
1095 Freeze PMC, setting type, seen, and "same-as-last" indicators as
1096 appropriate.
1097
1098 =cut
1099
1100 */
1101
1102 PARROT_INLINE
1103 static void
1104 freeze_pmc(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc), ARGIN(visit_info *info),
1105         int seen, UINTVAL id)
1106 {
1107     ASSERT_ARGS(freeze_pmc)
1108     IMAGE_IO * const io = info->image_io;
1109     INTVAL type;
1110
1111     if (PMC_IS_NULL(pmc)) {
1112         /* NULL + seen bit */
1113         VTABLE_push_pmc(interp, io, (PMC*) 1);
1114         return;
1115     }
1116     type = pmc->vtable->base_type;
1117
1118     if (PObj_is_object_TEST(pmc))
1119         type = enum_class_Object;
1120     if (seen) {
1121         if (info->extra_flags) {
1122             id |= 3;
1123             VTABLE_push_pmc(interp, io, (PMC*)id);
1124             VTABLE_push_integer(interp, io, info->extra_flags);
1125             return;
1126         }
1127         id |= 1;         /* mark bit 0 if this PMC is known */
1128     }
1129     else if (type == info->last_type) {
1130         id |= 2;         /* mark bit 1 and don't write type */
1131     }
1132     VTABLE_push_pmc(interp, io, (PMC*)id);
1133     if (! (id & 3)) {    /* else write type */
1134         VTABLE_push_integer(interp, io, type);
1135         info->last_type = type;
1136     }
1137 }
1138
1139 /*
1140
1141 =item C<static int thaw_pmc(PARROT_INTERP, visit_info *info, UINTVAL *id, INTVAL
1142 *type)>
1143
1144 Freeze and thaw a PMC (id).
1145
1146 For example, the ASCII representation of the C<Array>
1147
1148     P0 = [P1=666, P2=777, P0]
1149
1150 may look like this:
1151
1152     0xdf4 30 3 0xdf8 33 666 0xdf2 777 0xdf5
1153
1154 where 30 is C<class_enum_Array>, 33 is C<class_enum_Integer>, the
1155 type of the second C<Integer> is suppressed, the repeated P0 has bit 0
1156 set.
1157
1158 =cut
1159
1160 */
1161
1162 PARROT_INLINE
1163 static int
1164 thaw_pmc(PARROT_INTERP, ARGMOD(visit_info *info),
1165         ARGOUT(UINTVAL *id), ARGOUT(INTVAL *type))
1166 {
1167     ASSERT_ARGS(thaw_pmc)
1168     PMC *n;
1169     IMAGE_IO * const io = info->image_io;
1170     int seen = 0;
1171
1172     info->extra_flags = EXTRA_IS_NULL;
1173     n = VTABLE_shift_pmc(interp, io);
1174     if (((UINTVAL) n & 3) == 3) {
1175         /* pmc has extra data */
1176         info->extra_flags = VTABLE_shift_integer(interp, io);
1177     }
1178     else if ((UINTVAL) n & 1) {     /* seen PMCs have bit 0 set */
1179         seen = 1;
1180     }
1181     else if ((UINTVAL) n & 2) {     /* prev PMC was same type */
1182         *type = info->last_type;
1183     }
1184     else {                          /* type follows */
1185         *type = VTABLE_shift_integer(interp, io);
1186         info->last_type = *type;
1187         if (*type <= 0)
1188             Parrot_ex_throw_from_c_args(interp, NULL, 1,
1189                 "Unknown PMC type to thaw %d", (int) *type);
1190
1191         if (*type >= interp->n_vtable_max ||
1192             !interp->vtables[*type]) {
1193             /* that ought to be a class */
1194             *type = enum_class_Class;
1195         }
1196     }
1197     *id = (UINTVAL) n;
1198     return seen;
1199 }
1200
1201 /*
1202
1203 =item C<static void do_action(PARROT_INTERP, PMC *pmc, visit_info *info, int
1204 seen, UINTVAL id)>
1205
1206 Called from C<visit_next_for_GC()> and C<visit_todo_list()> to perform
1207 the action specified in C<< info->what >>.
1208
1209 Currently only C<VISIT_FREEZE_NORMAL> is implemented.
1210
1211 =cut
1212
1213 */
1214
1215 PARROT_INLINE
1216 static void
1217 do_action(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc), ARGIN(visit_info *info),
1218         int seen, UINTVAL id)
1219 {
1220     ASSERT_ARGS(do_action)
1221     switch (info->what) {
1222         case VISIT_FREEZE_AT_DESTRUCT:
1223         case VISIT_FREEZE_NORMAL:
1224             freeze_pmc(interp, pmc, info, seen, id);
1225             if (pmc)
1226                 info->visit_action = pmc->vtable->freeze;
1227             break;
1228         default:
1229             Parrot_ex_throw_from_c_args(interp, NULL, 1, "Illegal action %ld",
1230                 (long)info->what);
1231     }
1232 }
1233
1234 /*
1235
1236 =item C<static PMC* thaw_create_pmc(PARROT_INTERP, const visit_info *info,
1237 INTVAL type)>
1238
1239 Called from C<do_thaw()> to attach the vtable etc. to C<*pmc>.
1240
1241 =cut
1242
1243 */
1244
1245 PARROT_INLINE
1246 PARROT_CANNOT_RETURN_NULL
1247 static PMC*
1248 thaw_create_pmc(PARROT_INTERP, ARGIN(const visit_info *info),
1249         INTVAL type)
1250 {
1251     ASSERT_ARGS(thaw_create_pmc)
1252     PMC *pmc;
1253     switch (info->what) {
1254         case VISIT_THAW_NORMAL:
1255             pmc = pmc_new_noinit(interp, type);
1256             break;
1257         case VISIT_THAW_CONSTANTS:
1258             pmc = constant_pmc_new_noinit(interp, type);
1259             break;
1260         default:
1261             Parrot_ex_throw_from_c_args(interp, NULL, 1, "Illegal visit_next type");
1262     }
1263     return pmc;
1264 }
1265
1266 /*
1267
1268 =item C<static void do_thaw(PARROT_INTERP, PMC* pmc, visit_info *info)>
1269
1270 Called by C<visit_todo_list_thaw()> to thaw and return a PMC.
1271
1272 C<seen> is false if this is the first time the PMC has been encountered.
1273
1274 =cut
1275
1276 */
1277
1278 PARROT_INLINE
1279 static void
1280 do_thaw(PARROT_INTERP, ARGIN_NULLOK(PMC* pmc), ARGIN(visit_info *info))
1281 {
1282     ASSERT_ARGS(do_thaw)
1283     UINTVAL id;
1284     INTVAL type;
1285     PMC ** pos;
1286     int must_have_seen;
1287     type = 0; /* it's set below, avoid compiler warning. */
1288     must_have_seen = thaw_pmc(interp, info, &id, &type);
1289
1290     id >>= 2;
1291
1292     if (!id) {
1293         /* got a NULL PMC */
1294         pmc = PMCNULL;
1295         if (!info->thaw_result)
1296             info->thaw_result = pmc;
1297         else
1298             *info->thaw_ptr = pmc;
1299         return;
1300     }
1301
1302     pos = (PMC **)list_get(interp, (List *)PMC_data(info->id_list), id, enum_type_PMC);
1303     if (pos == (void*)-1)
1304         pos = NULL;
1305     else if (pos) {
1306         pmc = *(PMC**)pos;
1307         if (!pmc)
1308             pos = NULL;
1309     }
1310     if (pos) {
1311         if (info->extra_flags == EXTRA_IS_PROP_HASH) {
1312             interp->vtables[enum_class_default]->thaw(interp, pmc, info);
1313             return;
1314         }
1315         /* else maybe VTABLE_thaw ... but there is no other extra stuff */
1316
1317 #if FREEZE_USE_NEXT_FOR_GC
1318         /*
1319          * the next_for_GC method doesn't keep track of repeated scalars
1320          * and such, as these are lacking the next_for_GC pointer, so
1321          * these are just duplicated with their data.
1322          * But we track these when thawing, so that we don't create dups
1323          */
1324         if (!must_have_seen) {
1325             /* so we must consume the bytecode */
1326             VTABLE_thaw(interp, pmc, info);
1327         }
1328 #else
1329         PARROT_ASSERT(must_have_seen);
1330 #endif
1331         /*
1332          * that's a duplicate
1333          if (info->container)
1334          GC_WRITE_BARRIER(interp, info->container, NULL, pmc);
1335          */
1336         *info->thaw_ptr = pmc;
1337         return;
1338     }
1339
1340     PARROT_ASSERT(!must_have_seen);
1341     pmc = thaw_create_pmc(interp, info, type);
1342
1343     VTABLE_thaw(interp, pmc, info);
1344     if (info->extra_flags == EXTRA_CLASS_EXISTS) {
1345         pmc = (PMC *)info->extra;
1346         info->extra = NULL;
1347         info->extra_flags = 0;
1348     }
1349     if (!info->thaw_result)
1350         info->thaw_result = pmc;
1351     else {
1352         if (info->container) {
1353             GC_WRITE_BARRIER(interp, info->container, NULL, pmc);
1354         }
1355         *info->thaw_ptr = pmc;
1356     }
1357     list_assign(interp, (List *)PMC_data(info->id_list), id, pmc, enum_type_PMC);
1358     /* remember nested aggregates depth first */
1359     if (pmc->pmc_ext)
1360         list_unshift(interp, (List *)PMC_data(info->todo), pmc, enum_type_PMC);
1361 }
1362
1363
1364 /*
1365
1366 =item C<static UINTVAL id_from_pmc(PARROT_INTERP, PMC* pmc)>
1367
1368 Find a PMC in an arena, and return an id (left-shifted 2 bits),
1369 based on its position.
1370
1371 If not found, throw an exception.
1372
1373 =cut
1374
1375 */
1376
1377 static UINTVAL
1378 id_from_pmc(PARROT_INTERP, ARGIN(PMC* pmc))
1379 {
1380     ASSERT_ARGS(id_from_pmc)
1381     return Parrot_gc_get_pmc_index(interp, pmc) << 2;
1382 }
1383
1384 /*
1385
1386 =item C<static void add_pmc_next_for_GC(PARROT_INTERP, PMC *pmc, visit_info
1387 *info)>
1388
1389 Remembers the PMC for later processing.
1390
1391 =cut
1392
1393 */
1394
1395 static void
1396 add_pmc_next_for_GC(SHIM_INTERP, ARGIN(PMC *pmc), ARGOUT(visit_info *info))
1397 {
1398     ASSERT_ARGS(add_pmc_next_for_GC)
1399     if (pmc->pmc_ext) {
1400         PMC_next_for_GC(info->mark_ptr) = pmc;
1401         info->mark_ptr = PMC_next_for_GC(pmc) = pmc;
1402     }
1403 }
1404
1405 /*
1406
1407 =item C<static int next_for_GC_seen(PARROT_INTERP, PMC *pmc, visit_info *info,
1408 UINTVAL *id)>
1409
1410 Remembers next child to visit via the C<next_for_GC pointer> generate a
1411 unique ID per PMC and freeze the ID (not the PMC address) so thaw the
1412 hash-lookup can be replaced by an array lookup then which is a lot
1413 faster.
1414
1415 =cut
1416
1417 */
1418
1419 PARROT_INLINE
1420 static int
1421 next_for_GC_seen(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc),
1422         ARGIN(visit_info *info), ARGOUT(UINTVAL *id))
1423 {
1424     ASSERT_ARGS(next_for_GC_seen)
1425     int seen = 0;
1426
1427     if (PMC_IS_NULL(pmc)) {
1428         *id = 0;
1429         return 1;
1430     }
1431
1432     /*
1433      * we can only remember PMCs with a next_for_GC pointer
1434      * which is located in pmc_ext
1435      */
1436     if (pmc->pmc_ext) {
1437         /* already seen? */
1438         if (!PMC_IS_NULL(PMC_next_for_GC(pmc))) {
1439             seen = 1;
1440             goto skip;
1441         }
1442         /* put pmc at the end of the list */
1443         PMC_next_for_GC(info->mark_ptr) = pmc;
1444         /* make end self-referential */
1445         info->mark_ptr = PMC_next_for_GC(pmc) = pmc;
1446     }
1447 skip:
1448     *id = id_from_pmc(interp, pmc);
1449     return seen;
1450 }
1451
1452 /*
1453
1454 =item C<static void add_pmc_todo_list(PARROT_INTERP, PMC *pmc, visit_info
1455 *info)>
1456
1457 Remembers the PMC to be processed later.
1458
1459 =cut
1460
1461 */
1462
1463 static void
1464 add_pmc_todo_list(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc), ARGIN(visit_info *info))
1465 {
1466     ASSERT_ARGS(add_pmc_todo_list)
1467     list_push(interp, (List *)PMC_data(info->todo), pmc, enum_type_PMC);
1468 }
1469
1470 /*
1471
1472 =item C<static int todo_list_seen(PARROT_INTERP, PMC *pmc, visit_info *info,
1473 UINTVAL *id)>
1474
1475 Returns true if the PMC was seen, otherwise it put it on the todo list,
1476 generates an ID (tag) for PMC, offset by 4 as are addresses, low bits
1477 are flags.
1478
1479 =cut
1480
1481 */
1482
1483 PARROT_INLINE
1484 static int
1485 todo_list_seen(PARROT_INTERP, ARGIN(PMC *pmc), ARGMOD(visit_info *info),
1486         ARGOUT(UINTVAL *id))
1487 {
1488     ASSERT_ARGS(todo_list_seen)
1489     HashBucket * const b =
1490         parrot_hash_get_bucket(interp,
1491                 (Hash *)VTABLE_get_pointer(interp, info->seen), pmc);
1492
1493     if (b) {
1494         *id = (UINTVAL) b->value;
1495         return 1;
1496     }
1497
1498     info->id += 4;      /* next id to freeze */
1499     *id = info->id;
1500     parrot_hash_put(interp,
1501             (Hash *)VTABLE_get_pointer(interp, info->seen), pmc, (void*)*id);
1502     /* remember containers */
1503     if (pmc->pmc_ext)
1504         list_unshift(interp, (List *)PMC_data(info->todo), pmc, enum_type_PMC);
1505     return 0;
1506 }
1507
1508 /*
1509
1510 =item C<static void visit_next_for_GC(PARROT_INTERP, PMC* pmc, visit_info*
1511 info)>
1512
1513 C<visit_child> callbacks:
1514
1515 Checks if the PMC was seen, generate an ID for it if not, then do the
1516 appropriate action.
1517
1518 =cut
1519
1520 */
1521
1522 static void
1523 visit_next_for_GC(PARROT_INTERP, ARGIN(PMC* pmc), ARGIN(visit_info* info))
1524 {
1525     ASSERT_ARGS(visit_next_for_GC)
1526     UINTVAL id;
1527     const int seen = next_for_GC_seen(interp, pmc, info, &id);
1528     UNUSED(seen);
1529
1530     Parrot_ex_throw_from_c_args(interp, NULL, 1, "todo convert to depth first");
1531     /* do_action(interp, pmc, info, seen, id); UNCOMMENT WHEN TODO IS DONE*/
1532     /*
1533      * TODO probe for class methods that override the default.
1534      * To avoid overhead, we could have an array[class_enums]
1535      * which (after first find_method) has a bit, if a user
1536      * callback is there.
1537      */
1538     /* UNCOMMENT WHEN TODO IS DONE
1539     if (!seen)
1540         (info->visit_action)(interp, pmc, info);
1541     */
1542 }
1543
1544 /*
1545
1546 =item C<static void visit_todo_list(PARROT_INTERP, PMC* pmc, visit_info* info)>
1547
1548 Checks the seen PMC via the todo list.
1549
1550 =cut
1551
1552 */
1553
1554 static void
1555 visit_todo_list(PARROT_INTERP, ARGIN_NULLOK(PMC* pmc), ARGIN(visit_info* info))
1556 {
1557     ASSERT_ARGS(visit_todo_list)
1558     UINTVAL id;
1559     int seen;
1560
1561     if (PMC_IS_NULL(pmc)) {
1562         seen = 1;
1563         id = 0;
1564     }
1565     else
1566         seen = todo_list_seen(interp, pmc, info, &id);
1567     do_action(interp, pmc, info, seen, id);
1568     if (!seen)
1569         (info->visit_action)(interp, pmc, info);
1570 }
1571
1572 /*
1573
1574 =item C<static void visit_todo_list_thaw(PARROT_INTERP, PMC* old, visit_info*
1575 info)>
1576
1577 Callback for thaw - action first.
1578
1579 Todo-list and seen handling is all in C<do_thaw()>.
1580
1581 =cut
1582
1583 */
1584
1585 static void
1586 visit_todo_list_thaw(PARROT_INTERP, ARGIN_NULLOK(PMC* old), ARGIN(visit_info* info))
1587 {
1588     ASSERT_ARGS(visit_todo_list_thaw)
1589     do_thaw(interp, old, info);
1590 }
1591
1592 /*
1593
1594 =item C<static void visit_loop_next_for_GC(PARROT_INTERP, PMC *current,
1595 visit_info *info)>
1596
1597 Put first item on todo list, then run as long as there are items to be
1598 done.
1599
1600 =cut
1601
1602 */
1603
1604 static void
1605 visit_loop_next_for_GC(PARROT_INTERP, ARGIN(PMC *current),
1606         ARGIN(visit_info *info))
1607 {
1608     ASSERT_ARGS(visit_loop_next_for_GC)
1609     visit_next_for_GC(interp, current, info);
1610     if (current->pmc_ext) {
1611         PMC *prev = NULL;
1612
1613         while (current != prev) {
1614             VTABLE_visit(interp, current, info);
1615             prev = current;
1616             current = PMC_next_for_GC(current);
1617         }
1618     }
1619 }
1620
1621
1622 /*
1623
1624 =item C<static void visit_loop_todo_list(PARROT_INTERP, PMC *current, visit_info
1625 *info)>
1626
1627 The thaw loop.
1628
1629 =cut
1630
1631 */
1632
1633 static void
1634 visit_loop_todo_list(PARROT_INTERP, ARGIN_NULLOK(PMC *current),
1635         ARGIN(visit_info *info))
1636 {
1637     ASSERT_ARGS(visit_loop_todo_list)
1638     PMC        **list_item;
1639     List        *finish_list    = NULL;
1640     List * const todo           = (List *)PMC_data(info->todo);
1641     int          finished_first = 0;
1642     const int    thawing        = info->what == VISIT_THAW_CONSTANTS
1643                                || info->what == VISIT_THAW_NORMAL;
1644     int          i;
1645
1646     /* create a list that contains PMCs that need thawfinish */
1647     if (thawing) {
1648         PMC * const finish_list_pmc = pmc_new(interp, enum_class_Array);
1649         finish_list                 = (List *)PMC_data(finish_list_pmc);
1650     }
1651
1652     (info->visit_pmc_now)(interp, current, info);
1653
1654     /* can't cache upper limit, visit may append items */
1655 again:
1656     while ((list_item = (PMC**)list_shift(interp, todo, enum_type_PMC))) {
1657         current = *list_item;
1658         if (!current)
1659             Parrot_ex_throw_from_c_args(interp, NULL, 1,
1660                 "NULL current PMC in visit_loop_todo_list");
1661
1662         PARROT_ASSERT(current->vtable);
1663
1664         /* Workaround for thawing constants. Clear constant flag */
1665         /* See src/packfile.c:3999 */
1666         if (thawing)
1667             PObj_constant_CLEAR(current);
1668
1669         VTABLE_visit(interp, current, info);
1670
1671         if (thawing) {
1672             if (current == info->thaw_result)
1673                 finished_first = 1;
1674             if (current->vtable->thawfinish != interp->vtables[enum_class_default]->thawfinish)
1675                 list_unshift(interp, finish_list, current, enum_type_PMC);
1676         }
1677     }
1678
1679     if (thawing) {
1680         INTVAL n;
1681         /* if image isn't consumed, there are some extra data to thaw */
1682         if (info->image->bufused > 0) {
1683             (info->visit_pmc_now)(interp, NULL, info);
1684             goto again;
1685         }
1686
1687         /* on thawing call thawfinish for each processed PMC */
1688         if (!finished_first) {
1689             /* the first create PMC might not be in the list,
1690              * if it has no pmc_ext */
1691             list_unshift(interp, finish_list, info->thaw_result, enum_type_PMC);
1692         }
1693
1694         n = list_length(interp, finish_list);
1695
1696         for (i = 0; i < n ; ++i) {
1697             current = *(PMC**)list_get(interp, finish_list, i, enum_type_PMC);
1698             if (!PMC_IS_NULL(current))
1699                 VTABLE_thawfinish(interp, current, info);
1700         }
1701     }
1702 }
1703
1704
1705 /*
1706
1707 =item C<static void create_image(PARROT_INTERP, PMC *pmc, visit_info *info)>
1708
1709 Allocate image to some estimated size.
1710
1711 =cut
1712
1713 */
1714
1715 static void
1716 create_image(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc), ARGMOD(visit_info *info))
1717 {
1718     ASSERT_ARGS(create_image)
1719     STRING *array = CONST_STRING(interp, "array");
1720     STRING *hash  = CONST_STRING(interp, "hash");
1721     INTVAL  len;
1722
1723     if (!PMC_IS_NULL(pmc) && (VTABLE_does(interp, pmc, array) ||
1724         VTABLE_does(interp, pmc, hash))) {
1725         const INTVAL items = VTABLE_elements(interp, pmc);
1726         /* TODO check e.g. first item of aggregate and estimate size */
1727         len = items * FREEZE_BYTES_PER_ITEM;
1728     }
1729     else
1730         len = FREEZE_BYTES_PER_ITEM;
1731
1732     info->image = Parrot_str_new_noinit(interp, enum_stringrep_one, len);
1733 }
1734
1735 /*
1736
1737 =item C<static PMC* run_thaw(PARROT_INTERP, STRING* image, visit_enum_type
1738 what)>
1739
1740 Performs thawing. C<what> indicates what to be thawed.
1741
1742 Thaw could use the C<next_for_GC> pointers as todo-list too, but this
1743 would need 2 runs through the arenas to clean the C<next_for_GC>
1744 pointers.
1745
1746 For now it seems cheaper to use a list for remembering contained
1747 aggregates. We could of course decide dynamically, which strategy to
1748 use, e.g.: given a big image, the first thawed item is a small
1749 aggregate. This implies, it probably contains (or some big strings) more
1750 nested containers, for which the C<next_for_GC> approach could be a win.
1751
1752 =cut
1753
1754 */
1755
1756 PARROT_WARN_UNUSED_RESULT
1757 PARROT_CAN_RETURN_NULL
1758 static PMC*
1759 run_thaw(PARROT_INTERP, ARGIN(STRING* image), visit_enum_type what)
1760 {
1761     ASSERT_ARGS(run_thaw)
1762     visit_info info;
1763     int gc_block = 0;
1764     const UINTVAL bufused = image->bufused;
1765
1766     info.image = image;
1767     /*
1768      * if we are thawing a lot of PMCs, its cheaper to do
1769      * a GC run first and then block GC - the limit should be
1770      * chosen so that no more then one GC run would be triggered
1771      *
1772      * XXX
1773      *
1774      * md5_3.pir shows a segfault during thawing the config hash
1775      * info->thaw_ptr becomes invalid - seems that the hash got
1776      * collected under us.
1777      */
1778     if (1 || (Parrot_str_byte_length(interp, image) > THAW_BLOCK_GC_SIZE)) {
1779         Parrot_block_GC_mark(interp);
1780         Parrot_block_GC_sweep(interp);
1781         gc_block = 1;
1782     }
1783
1784     info.what = what;   /* _NORMAL or _CONSTANTS */
1785     todo_list_init(interp, &info);
1786     info.visit_pmc_now = visit_todo_list_thaw;
1787     info.visit_pmc_later = add_pmc_todo_list;
1788
1789     info.thaw_result = NULL;
1790     /*
1791      * run thaw loop
1792      */
1793     visit_loop_todo_list(interp, NULL, &info);
1794     /*
1795      * thaw does "consume" the image string by incrementing strstart
1796      * and decrementing bufused - restore that
1797      */
1798     LVALUE_CAST(char *, image->strstart) -= bufused;
1799     image->bufused = bufused;
1800     PARROT_ASSERT(image->strstart >= (char *)PObj_bufstart(image));
1801
1802     if (gc_block) {
1803         Parrot_unblock_GC_mark(interp);
1804         Parrot_unblock_GC_sweep(interp);
1805     }
1806     PackFile_destroy(interp, info.image_io->pf);
1807     mem_sys_free(info.image_io);
1808     info.image_io = NULL;
1809     return info.thaw_result;
1810 }
1811
1812 /*
1813
1814 =back
1815
1816 =head2 Public Interface
1817
1818 =over 4
1819
1820 =item C<STRING* Parrot_freeze_at_destruct(PARROT_INTERP, PMC* pmc)>
1821
1822 This function must not consume any resources (except the image itself).
1823 It uses the C<next_for_GC> pointer, so its not reentrant and must not be
1824 interrupted by a GC run.
1825
1826 =cut
1827
1828 */
1829
1830 PARROT_EXPORT
1831 PARROT_WARN_UNUSED_RESULT
1832 PARROT_CAN_RETURN_NULL
1833 STRING*
1834 Parrot_freeze_at_destruct(PARROT_INTERP, ARGIN(PMC* pmc))
1835 {
1836     ASSERT_ARGS(Parrot_freeze_at_destruct)
1837     visit_info info;
1838
1839     Parrot_block_GC_mark(interp);
1840     Parrot_gc_cleanup_next_for_GC(interp);
1841     info.what = VISIT_FREEZE_AT_DESTRUCT;
1842     info.mark_ptr = pmc;
1843     info.thaw_ptr = NULL;
1844     info.visit_pmc_now = visit_next_for_GC;
1845     info.visit_pmc_later = add_pmc_next_for_GC;
1846     create_image(interp, pmc, &info);
1847     ft_init(interp, &info);
1848
1849     visit_loop_next_for_GC(interp, pmc, &info);
1850
1851     Parrot_unblock_GC_mark(interp);
1852     PackFile_destroy(interp, info.image_io->pf);
1853     mem_sys_free(info.image_io);
1854     return info.image;
1855 }
1856
1857 /*
1858
1859 =item C<STRING* Parrot_freeze(PARROT_INTERP, PMC* pmc)>
1860
1861 Freeze using either method.
1862
1863 =cut
1864
1865 */
1866
1867 PARROT_EXPORT
1868 PARROT_WARN_UNUSED_RESULT
1869 PARROT_CAN_RETURN_NULL
1870 STRING*
1871 Parrot_freeze(PARROT_INTERP, ARGIN(PMC* pmc))
1872 {
1873     ASSERT_ARGS(Parrot_freeze)
1874 #if FREEZE_USE_NEXT_FOR_GC
1875     ASSERT_ARGS(Parrot_freeze)
1876     /*
1877      * we could do a GC run here before, to free resources
1878      */
1879     return Parrot_freeze_at_destruct(interp, pmc);
1880 #else
1881     /*
1882      * freeze using a todo list and seen hash
1883      * Please note that both have to be PMCs, so that trace_system_stack
1884      * can call mark on the PMCs
1885      */
1886     visit_info info;
1887
1888     info.what = VISIT_FREEZE_NORMAL;
1889     create_image(interp, pmc, &info);
1890     todo_list_init(interp, &info);
1891
1892     visit_loop_todo_list(interp, pmc, &info);
1893
1894     PackFile_destroy(interp, info.image_io->pf);
1895     mem_sys_free(info.image_io);
1896     return info.image;
1897 #endif
1898 }
1899
1900 /*
1901
1902 =item C<PMC* Parrot_thaw(PARROT_INTERP, STRING* image)>
1903
1904 Thaw a PMC, called from the C<thaw> opcode.
1905
1906 =cut
1907
1908 */
1909
1910 PARROT_EXPORT
1911 PARROT_WARN_UNUSED_RESULT
1912 PARROT_CAN_RETURN_NULL
1913 PMC*
1914 Parrot_thaw(PARROT_INTERP, ARGIN(STRING* image))
1915 {
1916     ASSERT_ARGS(Parrot_thaw)
1917     return run_thaw(interp, image, VISIT_THAW_NORMAL);
1918 }
1919
1920 /*
1921
1922 =item C<PMC* Parrot_thaw_constants(PARROT_INTERP, STRING* image)>
1923
1924 Thaw the constants. This is used by PackFile for unpacking PMC
1925 constants.
1926
1927 =cut
1928
1929 */
1930
1931 PARROT_EXPORT
1932 PARROT_WARN_UNUSED_RESULT
1933 PARROT_CAN_RETURN_NULL
1934 PMC*
1935 Parrot_thaw_constants(PARROT_INTERP, ARGIN(STRING* image))
1936 {
1937     ASSERT_ARGS(Parrot_thaw_constants)
1938     return run_thaw(interp, image, VISIT_THAW_CONSTANTS);
1939 }
1940
1941 /*
1942
1943 =item C<PMC* Parrot_clone(PARROT_INTERP, PMC* pmc)>
1944
1945 There are for sure shortcuts to clone faster, e.g. always thaw the image
1946 immediately or use a special callback. But for now we just thaw a frozen
1947 PMC.
1948
1949 =cut
1950
1951 */
1952
1953 PARROT_EXPORT
1954 PARROT_WARN_UNUSED_RESULT
1955 PARROT_CAN_RETURN_NULL
1956 PMC*
1957 Parrot_clone(PARROT_INTERP, ARGIN(PMC* pmc))
1958 {
1959     ASSERT_ARGS(Parrot_clone)
1960     return VTABLE_clone(interp, pmc);
1961 }
1962
1963 /*
1964
1965 =back
1966
1967 =head1 TODO
1968
1969 The seen-hash version for freezing might go away sometimes.
1970
1971 =head1 SEE ALSO
1972
1973 Lot of discussion on p6i and F<docs/dev/pmc_freeze.pod>.
1974
1975 =head1 HISTORY
1976
1977 Initial version by leo 2003.11.03 - 2003.11.07.
1978
1979 =cut
1980
1981 */
1982
1983
1984 /*
1985  * Local variables:
1986  *   c-file-style: "parrot"
1987  * End:
1988  * vim: expandtab shiftwidth=4:
1989  */