2 Copyright (C) 2001-2009, Parrot Foundation.
7 src/pmc_freeze.c - Freeze and thaw functionality
11 Thawing PMCs uses a list with (maximum) size of the amount of PMCs to
12 keep track of retrieved PMCs.
14 The individual information of PMCs is frozen/thawed by their vtables.
16 To avoid recursion, the whole functionality is driven by
17 C<< pmc->vtable->visit >>, which is called for the first PMC initially.
18 Container PMCs call a "todo-callback" for all contained PMCs. The
19 individual action vtable (freeze/thaw) is then called for all todo-PMCs.
21 In the current implementation C<IMAGE_IO> is a stand-in for some kind of
22 serializer PMC which will eventually be written. It associates a Parrot
23 C<STRING> with a vtable.
29 #include "parrot/parrot.h"
30 #include "pmc/pmc_context.h"
31 #include "pmc_freeze.str"
33 /* HEADERIZER HFILE: include/parrot/pmc_freeze.h */
34 /* HEADERIZER BEGIN: static */
35 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
37 static void create_image(PARROT_INTERP
,
38 ARGIN_NULLOK(PMC
*pmc
),
39 ARGMOD(visit_info
*info
))
40 __attribute__nonnull__(1)
41 __attribute__nonnull__(3)
45 static void do_action(PARROT_INTERP
,
46 ARGIN_NULLOK(PMC
*pmc
),
47 ARGIN(visit_info
*info
),
50 __attribute__nonnull__(1)
51 __attribute__nonnull__(3);
54 static void do_thaw(PARROT_INTERP
,
55 ARGIN_NULLOK(PMC
*pmc
),
56 ARGIN(visit_info
*info
))
57 __attribute__nonnull__(1)
58 __attribute__nonnull__(3);
61 static void freeze_pmc(PARROT_INTERP
,
62 ARGIN_NULLOK(PMC
*pmc
),
63 ARGIN(visit_info
*info
),
66 __attribute__nonnull__(1)
67 __attribute__nonnull__(3);
69 static void ft_init(PARROT_INTERP
, ARGIN(visit_info
*info
))
70 __attribute__nonnull__(1)
71 __attribute__nonnull__(2);
74 static void op_check_size(PARROT_INTERP
, ARGIN(STRING
*s
), size_t len
)
75 __attribute__nonnull__(1)
76 __attribute__nonnull__(2);
78 static void push_opcode_integer(PARROT_INTERP
,
81 __attribute__nonnull__(1)
82 __attribute__nonnull__(2);
84 static void push_opcode_number(PARROT_INTERP
,
87 __attribute__nonnull__(1)
88 __attribute__nonnull__(2);
90 static void push_opcode_pmc(PARROT_INTERP
,
93 __attribute__nonnull__(1)
94 __attribute__nonnull__(2)
95 __attribute__nonnull__(3);
97 static void push_opcode_string(PARROT_INTERP
,
100 __attribute__nonnull__(1)
101 __attribute__nonnull__(2)
102 __attribute__nonnull__(3);
104 PARROT_WARN_UNUSED_RESULT
105 PARROT_CAN_RETURN_NULL
106 static PMC
* run_thaw(PARROT_INTERP
,
107 ARGIN(STRING
* image
),
108 visit_enum_type what
)
109 __attribute__nonnull__(1)
110 __attribute__nonnull__(2);
112 static INTVAL
shift_opcode_integer(SHIM_INTERP
, ARGIN(IMAGE_IO
*io
))
113 __attribute__nonnull__(2);
115 static FLOATVAL
shift_opcode_number(SHIM_INTERP
, ARGIN(IMAGE_IO
*io
))
116 __attribute__nonnull__(2);
118 PARROT_WARN_UNUSED_RESULT
119 PARROT_CAN_RETURN_NULL
120 static PMC
* shift_opcode_pmc(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
))
121 __attribute__nonnull__(1)
122 __attribute__nonnull__(2);
124 PARROT_WARN_UNUSED_RESULT
125 PARROT_CANNOT_RETURN_NULL
126 static STRING
* shift_opcode_string(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
))
127 __attribute__nonnull__(1)
128 __attribute__nonnull__(2);
131 PARROT_CANNOT_RETURN_NULL
132 static PMC
* thaw_create_pmc(PARROT_INTERP
,
133 ARGIN(const visit_info
*info
),
135 __attribute__nonnull__(1)
136 __attribute__nonnull__(2);
139 static int thaw_pmc(PARROT_INTERP
,
140 ARGMOD(visit_info
*info
),
142 ARGOUT(INTVAL
*type
))
143 __attribute__nonnull__(1)
144 __attribute__nonnull__(2)
145 __attribute__nonnull__(3)
146 __attribute__nonnull__(4)
149 FUNC_MODIFIES(*type
);
151 static void todo_list_init(PARROT_INTERP
, ARGOUT(visit_info
*info
))
152 __attribute__nonnull__(1)
153 __attribute__nonnull__(2)
154 FUNC_MODIFIES(*info
);
157 static int todo_list_seen(PARROT_INTERP
,
159 ARGMOD(visit_info
*info
),
161 __attribute__nonnull__(1)
162 __attribute__nonnull__(2)
163 __attribute__nonnull__(3)
164 __attribute__nonnull__(4)
168 static void visit_loop_todo_list(PARROT_INTERP
,
169 ARGIN_NULLOK(PMC
*current
),
170 ARGIN(visit_info
*info
))
171 __attribute__nonnull__(1)
172 __attribute__nonnull__(3);
174 static void visit_todo_list(PARROT_INTERP
,
175 ARGIN_NULLOK(PMC
* pmc
),
176 ARGIN(visit_info
* info
))
177 __attribute__nonnull__(1)
178 __attribute__nonnull__(3);
180 static void visit_todo_list_thaw(PARROT_INTERP
,
181 ARGIN_NULLOK(PMC
* old
),
182 ARGIN(visit_info
* info
))
183 __attribute__nonnull__(1)
184 __attribute__nonnull__(3);
186 #define ASSERT_ARGS_create_image __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
187 PARROT_ASSERT_ARG(interp) \
188 , PARROT_ASSERT_ARG(info))
189 #define ASSERT_ARGS_do_action __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
190 PARROT_ASSERT_ARG(interp) \
191 , PARROT_ASSERT_ARG(info))
192 #define ASSERT_ARGS_do_thaw __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
193 PARROT_ASSERT_ARG(interp) \
194 , PARROT_ASSERT_ARG(info))
195 #define ASSERT_ARGS_freeze_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
196 PARROT_ASSERT_ARG(interp) \
197 , PARROT_ASSERT_ARG(info))
198 #define ASSERT_ARGS_ft_init __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
199 PARROT_ASSERT_ARG(interp) \
200 , PARROT_ASSERT_ARG(info))
201 #define ASSERT_ARGS_op_check_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
202 PARROT_ASSERT_ARG(interp) \
203 , PARROT_ASSERT_ARG(s))
204 #define ASSERT_ARGS_push_opcode_integer __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
205 PARROT_ASSERT_ARG(interp) \
206 , PARROT_ASSERT_ARG(io))
207 #define ASSERT_ARGS_push_opcode_number __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
208 PARROT_ASSERT_ARG(interp) \
209 , PARROT_ASSERT_ARG(io))
210 #define ASSERT_ARGS_push_opcode_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
211 PARROT_ASSERT_ARG(interp) \
212 , PARROT_ASSERT_ARG(io) \
213 , PARROT_ASSERT_ARG(v))
214 #define ASSERT_ARGS_push_opcode_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
215 PARROT_ASSERT_ARG(interp) \
216 , PARROT_ASSERT_ARG(io) \
217 , PARROT_ASSERT_ARG(v))
218 #define ASSERT_ARGS_run_thaw __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
219 PARROT_ASSERT_ARG(interp) \
220 , PARROT_ASSERT_ARG(image))
221 #define ASSERT_ARGS_shift_opcode_integer __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
222 PARROT_ASSERT_ARG(io))
223 #define ASSERT_ARGS_shift_opcode_number __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
224 PARROT_ASSERT_ARG(io))
225 #define ASSERT_ARGS_shift_opcode_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
226 PARROT_ASSERT_ARG(interp) \
227 , PARROT_ASSERT_ARG(io))
228 #define ASSERT_ARGS_shift_opcode_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
229 PARROT_ASSERT_ARG(interp) \
230 , PARROT_ASSERT_ARG(io))
231 #define ASSERT_ARGS_thaw_create_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
232 PARROT_ASSERT_ARG(interp) \
233 , PARROT_ASSERT_ARG(info))
234 #define ASSERT_ARGS_thaw_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
235 PARROT_ASSERT_ARG(interp) \
236 , PARROT_ASSERT_ARG(info) \
237 , PARROT_ASSERT_ARG(id) \
238 , PARROT_ASSERT_ARG(type))
239 #define ASSERT_ARGS_todo_list_init __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
240 PARROT_ASSERT_ARG(interp) \
241 , PARROT_ASSERT_ARG(info))
242 #define ASSERT_ARGS_todo_list_seen __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
243 PARROT_ASSERT_ARG(interp) \
244 , PARROT_ASSERT_ARG(pmc) \
245 , PARROT_ASSERT_ARG(info) \
246 , PARROT_ASSERT_ARG(id))
247 #define ASSERT_ARGS_visit_loop_todo_list __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
248 PARROT_ASSERT_ARG(interp) \
249 , PARROT_ASSERT_ARG(info))
250 #define ASSERT_ARGS_visit_todo_list __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
251 PARROT_ASSERT_ARG(interp) \
252 , PARROT_ASSERT_ARG(info))
253 #define ASSERT_ARGS_visit_todo_list_thaw __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
254 PARROT_ASSERT_ARG(interp) \
255 , PARROT_ASSERT_ARG(info))
256 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
257 /* HEADERIZER END: static */
259 /* when thawing a string longer then this size, we first do a GC run and then
260 * block GC - the system can't give us more headers */
262 #define THAW_BLOCK_GC_SIZE 100000
264 /* preallocate freeze image for aggregates with this estimation */
265 #define FREEZE_BYTES_PER_ITEM 9
267 /* macros/constants to handle packing/unpacking of PMC IDs and flags
268 * the 2 LSBs are used for flags, all other bits are used for PMC ID
270 #define PackID_new(id, flags) (((UINTVAL)(id) * 4) | ((UINTVAL)(flags) & 3))
271 #define PackID_get_PMCID(id) ((UINTVAL)(id) / 4)
272 #define PackID_set_PMCID(lv, id) (lv) = PackID_new((id), PackID_get_FLAGS(lv))
273 #define PackID_get_FLAGS(id) ((UINTVAL)(id) & 3)
274 #define PackID_set_FLAGS(lv, flags) (lv) = PackID_new(PackID_get_PMCID(lv), (flags))
277 enum_PackID_normal
= 0,
278 enum_PackID_seen
= 1,
279 enum_PackID_prev_type
= 2,
280 enum_PackID_extra_info
= 3
285 =head2 C<opcode_t> IO Functions
289 =item C<static void op_check_size(PARROT_INTERP, STRING *s, size_t len)>
291 Checks the size of the "stream" buffer to see if it can accommodate
292 C<len> more bytes. If not, expands the buffer.
300 op_check_size(PARROT_INTERP
, ARGIN(STRING
*s
), size_t len
)
302 ASSERT_ARGS(op_check_size
)
303 const size_t used
= s
->bufused
;
304 const int need_free
= (int)Buffer_buflen(s
) - used
- len
;
306 /* grow by factor 1.5 or such */
307 if (need_free
<= 16) {
308 size_t new_size
= (size_t) (Buffer_buflen(s
) * 1.5);
309 if (new_size
< Buffer_buflen(s
) - need_free
+ 512)
310 new_size
= Buffer_buflen(s
) - need_free
+ 512;
311 Parrot_gc_reallocate_string_storage(interp
, s
, new_size
);
312 PARROT_ASSERT(Buffer_buflen(s
) - used
- len
>= 15);
315 #ifndef DISABLE_GC_DEBUG
316 Parrot_gc_compact_memory_pool(interp
);
324 =item C<static void push_opcode_integer(PARROT_INTERP, IMAGE_IO *io, INTVAL v)>
326 Pushes the integer C<v> onto the end of the C<*io> "stream".
328 XXX assumes sizeof (opcode_t) == sizeof (INTVAL).
335 push_opcode_integer(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
), INTVAL v
)
337 ASSERT_ARGS(push_opcode_integer
)
338 UINTVAL size
= sizeof (opcode_t
);
339 STRING
*op
= Parrot_str_new_init(interp
, (char *)&v
, size
,
340 Parrot_fixed_8_encoding_ptr
, Parrot_binary_charset_ptr
, 0);
342 PARROT_ASSERT(sizeof (opcode_t
) == sizeof (INTVAL
));
343 io
->image
= Parrot_str_append(interp
, io
->image
, op
);
349 =item C<static void push_opcode_number(PARROT_INTERP, IMAGE_IO *io, FLOATVAL v)>
351 Pushes the number C<v> onto the end of the C<*io> "stream".
358 push_opcode_number(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
), FLOATVAL v
)
360 ASSERT_ARGS(push_opcode_number
)
363 STRING
* const s
= io
->image
;
364 const size_t len
= PF_size_number() * sizeof (opcode_t
);
365 const size_t used
= s
->bufused
;
367 op_check_size(interp
, s
, len
);
368 ignored
= PF_store_number((opcode_t
*)((ptrcast_t
)s
->strstart
+ used
), &v
);
378 =item C<static void push_opcode_string(PARROT_INTERP, IMAGE_IO *io, STRING *v)>
380 Pushes the string C<*v> onto the end of the C<*io> "stream".
387 push_opcode_string(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
), ARGIN(STRING
*v
))
389 ASSERT_ARGS(push_opcode_string
)
392 STRING
* const s
= io
->image
;
393 const size_t len
= PF_size_string(v
) * sizeof (opcode_t
);
394 const size_t used
= s
->bufused
;
396 op_check_size(interp
, s
, len
);
397 ignored
= PF_store_string((opcode_t
*)((ptrcast_t
)s
->strstart
+ used
), v
);
407 =item C<static void push_opcode_pmc(PARROT_INTERP, IMAGE_IO *io, PMC* v)>
409 Pushes the PMC C<*v> onto the end of the C<*io> "stream".
416 push_opcode_pmc(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
), ARGIN(PMC
* v
))
418 ASSERT_ARGS(push_opcode_pmc
)
419 UINTVAL size
= sizeof (opcode_t
);
420 STRING
*op
= Parrot_str_new_init(interp
, (char *)&v
, size
,
421 Parrot_fixed_8_encoding_ptr
, Parrot_binary_charset_ptr
, 0);
422 io
->image
= Parrot_str_append(interp
, io
->image
, op
);
428 =item C<static INTVAL shift_opcode_integer(PARROT_INTERP, IMAGE_IO *io)>
430 Removes and returns an integer from the start of the C<*io> "stream".
437 shift_opcode_integer(SHIM_INTERP
, ARGIN(IMAGE_IO
*io
))
439 ASSERT_ARGS(shift_opcode_integer
)
440 const char * const start
= (char *)io
->image
->strstart
;
441 char **opcode
= &io
->image
->strstart
;
442 const INTVAL i
= PF_fetch_integer(io
->pf
,
443 (const opcode_t
**)opcode
);
445 io
->image
->bufused
-= ((char *)io
->image
->strstart
- start
);
446 io
->image
->strlen
-= ((char *)io
->image
->strstart
- start
);
448 PARROT_ASSERT((int)io
->image
->bufused
>= 0);
456 =item C<static PMC* shift_opcode_pmc(PARROT_INTERP, IMAGE_IO *io)>
458 Removes and returns an PMC from the start of the C<*io> "stream".
460 Note that this actually reads a PMC id, not a PMC.
466 PARROT_WARN_UNUSED_RESULT
467 PARROT_CAN_RETURN_NULL
469 shift_opcode_pmc(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
))
471 ASSERT_ARGS(shift_opcode_pmc
)
472 INTVAL i
= shift_opcode_integer(interp
, io
);
479 =item C<static FLOATVAL shift_opcode_number(PARROT_INTERP, IMAGE_IO *io)>
481 Removes and returns an number from the start of the C<*io> "stream".
488 shift_opcode_number(SHIM_INTERP
, ARGIN(IMAGE_IO
*io
))
490 ASSERT_ARGS(shift_opcode_number
)
492 const char * const start
= (const char *)io
->image
->strstart
;
493 char **opcode
= &io
->image
->strstart
;
494 const FLOATVAL f
= PF_fetch_number(io
->pf
,
495 (const opcode_t
**)opcode
);
497 io
->image
->bufused
-= ((char *)io
->image
->strstart
- start
);
498 io
->image
->strlen
-= ((char *)io
->image
->strstart
- start
);
500 PARROT_ASSERT((int)io
->image
->bufused
>= 0);
508 =item C<static STRING* shift_opcode_string(PARROT_INTERP, IMAGE_IO *io)>
510 Removes and returns a string from the start of the C<*io> "stream".
516 PARROT_WARN_UNUSED_RESULT
517 PARROT_CANNOT_RETURN_NULL
519 shift_opcode_string(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
))
521 ASSERT_ARGS(shift_opcode_string
)
523 char * const start
= (char*)io
->image
->strstart
;
524 char * opcode
= io
->image
->strstart
;
525 STRING
* const s
= PF_fetch_string(interp
, io
->pf
,
526 (const opcode_t
**)&opcode
);
528 io
->image
->strstart
= opcode
;
529 io
->image
->bufused
-= (opcode
- start
);
530 io
->image
->strlen
-= (opcode
- start
);
532 PARROT_ASSERT((int)io
->image
->bufused
>= 0);
542 =head2 Helper Functions
551 * this function setup stuff may be replaced by a real PMC
553 * TODO add read/write header functions, e.g. vtable->init_pmc
556 static image_funcs opcode_funcs
= {
561 shift_opcode_integer
,
569 =item C<static void ft_init(PARROT_INTERP, visit_info *info)>
571 Initializes the freeze/thaw subsystem.
578 ft_init(PARROT_INTERP
, ARGIN(visit_info
*info
))
581 STRING
*s
= info
->image
;
584 /* We want to store a 16-byte aligned header, but the actual
585 * header may be shorter. */
586 const unsigned int header_length
= PACKFILE_HEADER_BYTES
+
587 (PACKFILE_HEADER_BYTES
% 16 ?
588 16 - PACKFILE_HEADER_BYTES
% 16 : 0);
590 info
->image_io
= mem_allocate_typed(IMAGE_IO
);
591 info
->image_io
->image
= s
= info
->image
;
593 info
->image_io
->vtable
= &opcode_funcs
;
595 pf
= info
->image_io
->pf
= PackFile_new(interp
, 0);
597 if (info
->what
== VISIT_FREEZE_NORMAL
598 || info
->what
== VISIT_FREEZE_AT_DESTRUCT
) {
600 op_check_size(interp
, s
, header_length
);
601 mem_sys_memcopy(s
->strstart
, pf
->header
, PACKFILE_HEADER_BYTES
);
602 s
->bufused
+= header_length
;
603 s
->strlen
+= header_length
;
606 if (Parrot_str_byte_length(interp
, s
) < header_length
) {
607 Parrot_ex_throw_from_c_args(interp
, NULL
,
608 EXCEPTION_INVALID_STRING_REPRESENTATION
,
609 "bad string to thaw");
612 /* TT #749: use the validation logic from Packfile_unpack */
613 if (pf
->header
->bc_major
!= PARROT_PBC_MAJOR
614 || pf
->header
->bc_minor
!= PARROT_PBC_MINOR
)
615 Parrot_ex_throw_from_c_args(interp
, NULL
,
616 EXCEPTION_INVALID_STRING_REPRESENTATION
,
617 "can't thaw a PMC from Parrot %d.%d", pf
->header
->bc_major
,
618 pf
->header
->bc_minor
);
620 mem_sys_memcopy(pf
->header
, s
->strstart
, PACKFILE_HEADER_BYTES
);
621 PackFile_assign_transforms(pf
);
623 s
->bufused
-= header_length
;
624 s
->strlen
-= header_length
;
626 LVALUE_CAST(char *, s
->strstart
) += header_length
;
629 info
->last_type
= -1;
630 info
->id_list
= pmc_new(interp
, enum_class_Array
);
632 info
->extra_flags
= EXTRA_IS_NULL
;
633 info
->container
= NULL
;
639 =item C<static void todo_list_init(PARROT_INTERP, visit_info *info)>
641 Initializes the C<*info> lists.
648 todo_list_init(PARROT_INTERP
, ARGOUT(visit_info
*info
))
650 ASSERT_ARGS(todo_list_init
)
651 info
->visit_pmc_now
= visit_todo_list
;
653 /* we must use PMCs here so that they get marked properly */
654 info
->todo
= pmc_new(interp
, enum_class_Array
);
655 info
->seen
= pmc_new(interp
, enum_class_Hash
);
656 VTABLE_set_pointer(interp
, info
->seen
, parrot_new_intval_hash(interp
));
658 ft_init(interp
, info
);
664 =item C<static void freeze_pmc(PARROT_INTERP, PMC *pmc, visit_info *info, int
667 Freeze PMC, setting type, seen, and "same-as-last" indicators as
676 freeze_pmc(PARROT_INTERP
, ARGIN_NULLOK(PMC
*pmc
), ARGIN(visit_info
*info
),
677 int seen
, UINTVAL id
)
679 ASSERT_ARGS(freeze_pmc
)
680 IMAGE_IO
* const io
= info
->image_io
;
683 if (PMC_IS_NULL(pmc
)) {
684 /* NULL + seen bit */
685 VTABLE_push_pmc(interp
, io
, (PMC
*)PackID_new(NULL
, enum_PackID_seen
));
689 type
= pmc
->vtable
->base_type
;
691 if (PObj_is_object_TEST(pmc
))
692 type
= enum_class_Object
;
695 if (info
->extra_flags
) {
696 PackID_set_FLAGS(id
, enum_PackID_extra_info
);
697 VTABLE_push_pmc(interp
, io
, (PMC
*)id
);
698 VTABLE_push_integer(interp
, io
, info
->extra_flags
);
702 PackID_set_FLAGS(id
, enum_PackID_seen
);
704 else if (type
== info
->last_type
)
705 PackID_set_FLAGS(id
, enum_PackID_prev_type
);
707 VTABLE_push_pmc(interp
, io
, (PMC
*)id
);
709 if (PackID_get_FLAGS(id
) == enum_PackID_normal
) {
711 VTABLE_push_integer(interp
, io
, type
);
712 info
->last_type
= type
;
719 =item C<static int thaw_pmc(PARROT_INTERP, visit_info *info, UINTVAL *id, INTVAL
722 Freeze and thaw a PMC (id).
724 For example, the ASCII representation of the C<Array>
726 P0 = [P1=666, P2=777, P0]
730 0xdf4 30 3 0xdf8 33 666 0xdf2 777 0xdf5
732 where 30 is C<class_enum_Array>, 33 is C<class_enum_Integer>, the
733 type of the second C<Integer> is suppressed, the repeated P0 has bit 0
742 thaw_pmc(PARROT_INTERP
, ARGMOD(visit_info
*info
),
743 ARGOUT(UINTVAL
*id
), ARGOUT(INTVAL
*type
))
745 ASSERT_ARGS(thaw_pmc
)
746 IMAGE_IO
* const io
= info
->image_io
;
747 PMC
*n
= VTABLE_shift_pmc(interp
, io
);
750 info
->extra_flags
= EXTRA_IS_NULL
;
752 switch (PackID_get_FLAGS(n
)) {
753 case enum_PackID_extra_info
:
754 /* pmc has extra data */
755 info
->extra_flags
= VTABLE_shift_integer(interp
, io
);
757 case enum_PackID_seen
:
760 case enum_PackID_prev_type
:
761 /* prev PMC was same type */
762 *type
= info
->last_type
;
767 *type
= VTABLE_shift_integer(interp
, io
);
768 info
->last_type
= *type
;
771 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
772 "Unknown PMC type to thaw %d", (int) *type
);
774 /* that ought to be a class */
775 if (*type
>= interp
->n_vtable_max
|| !interp
->vtables
[*type
])
776 *type
= enum_class_Class
;
788 =item C<static void do_action(PARROT_INTERP, PMC *pmc, visit_info *info, int
791 Called from C<visit_todo_list()> to perform the action specified in
794 Currently only C<VISIT_FREEZE_NORMAL> and C<VISIT_FREEZE_AT_DESTRUCT> are
803 do_action(PARROT_INTERP
, ARGIN_NULLOK(PMC
*pmc
), ARGIN(visit_info
*info
),
804 int seen
, UINTVAL id
)
806 ASSERT_ARGS(do_action
)
807 switch (info
->what
) {
808 case VISIT_FREEZE_AT_DESTRUCT
:
809 case VISIT_FREEZE_NORMAL
:
810 freeze_pmc(interp
, pmc
, info
, seen
, id
);
812 info
->visit_action
= pmc
->vtable
->freeze
;
815 Parrot_ex_throw_from_c_args(interp
, NULL
, 1, "Illegal action %ld",
823 =item C<static PMC* thaw_create_pmc(PARROT_INTERP, const visit_info *info,
826 Called from C<do_thaw()> to attach the vtable etc. to C<*pmc>.
833 PARROT_CANNOT_RETURN_NULL
835 thaw_create_pmc(PARROT_INTERP
, ARGIN(const visit_info
*info
),
838 ASSERT_ARGS(thaw_create_pmc
)
840 switch (info
->what
) {
841 case VISIT_THAW_NORMAL
:
842 pmc
= pmc_new_noinit(interp
, type
);
844 case VISIT_THAW_CONSTANTS
:
845 pmc
= constant_pmc_new_noinit(interp
, type
);
848 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
849 "Illegal visit_next type");
858 =item C<static void do_thaw(PARROT_INTERP, PMC *pmc, visit_info *info)>
860 Called by C<visit_todo_list_thaw()> to thaw and return a PMC.
862 C<seen> is false if this is the first time the PMC has been encountered.
870 do_thaw(PARROT_INTERP
, ARGIN_NULLOK(PMC
*pmc
), ARGIN(visit_info
*info
))
875 /* set below, but avoid compiler warning */
878 int must_have_seen
= thaw_pmc(interp
, info
, &id
, &type
);
880 id
= PackID_get_PMCID(id
);
885 if (!info
->thaw_result
)
886 info
->thaw_result
= pmc
;
888 *info
->thaw_ptr
= pmc
;
892 pos
= (PMC
**)Parrot_pmc_array_get(interp
, (List
*)PMC_data(info
->id_list
),
895 if (pos
== (void *)-1)
904 if (info
->extra_flags
== EXTRA_IS_PROP_HASH
) {
905 interp
->vtables
[enum_class_default
]->thaw(interp
, pmc
, info
);
909 /* else maybe VTABLE_thaw ... but there is no other extra stuff */
911 PARROT_ASSERT(must_have_seen
);
913 *info
->thaw_ptr
= pmc
;
917 PARROT_ASSERT(!must_have_seen
);
918 pmc
= thaw_create_pmc(interp
, info
, type
);
920 VTABLE_thaw(interp
, pmc
, info
);
922 if (info
->extra_flags
== EXTRA_CLASS_EXISTS
) {
923 pmc
= (PMC
*)info
->extra
;
925 info
->extra_flags
= 0;
928 if (!info
->thaw_result
)
929 info
->thaw_result
= pmc
;
931 *info
->thaw_ptr
= pmc
;
934 Parrot_pmc_array_assign(interp
, (List
*)PMC_data(info
->id_list
), id
, pmc
, enum_type_PMC
);
936 /* remember nested aggregates depth first */
937 Parrot_pmc_array_unshift(interp
, (List
*)PMC_data(info
->todo
), pmc
, enum_type_PMC
);
942 =item C<static int todo_list_seen(PARROT_INTERP, PMC *pmc, visit_info *info,
945 Returns true if the PMC was seen, otherwise it put it on the todo list.
946 Generates an ID (tag) for PMC, offset by 4 as are addresses. Low bits are
955 todo_list_seen(PARROT_INTERP
, ARGIN(PMC
*pmc
), ARGMOD(visit_info
*info
),
958 ASSERT_ARGS(todo_list_seen
)
959 HashBucket
* const b
=
960 parrot_hash_get_bucket(interp
,
961 (Hash
*)VTABLE_get_pointer(interp
, info
->seen
), pmc
);
964 *id
= (UINTVAL
) b
->value
;
968 /* next id to freeze */
970 *id
= PackID_new(info
->id
, enum_PackID_normal
);
972 parrot_hash_put(interp
,
973 (Hash
*)VTABLE_get_pointer(interp
, info
->seen
), pmc
, (void *)*id
);
975 /* remember containers */
976 Parrot_pmc_array_unshift(interp
, (List
*)PMC_data(info
->todo
), pmc
, enum_type_PMC
);
984 =item C<static void visit_todo_list(PARROT_INTERP, PMC* pmc, visit_info* info)>
986 Checks the seen PMC via the todo list.
993 visit_todo_list(PARROT_INTERP
, ARGIN_NULLOK(PMC
* pmc
), ARGIN(visit_info
* info
))
995 ASSERT_ARGS(visit_todo_list
)
999 if (PMC_IS_NULL(pmc
)) {
1004 seen
= todo_list_seen(interp
, pmc
, info
, &id
);
1006 do_action(interp
, pmc
, info
, seen
, id
);
1009 (info
->visit_action
)(interp
, pmc
, info
);
1015 =item C<static void visit_todo_list_thaw(PARROT_INTERP, PMC* old, visit_info*
1018 Callback for thaw - action first.
1020 Todo-list and seen handling is all in C<do_thaw()>.
1027 visit_todo_list_thaw(PARROT_INTERP
, ARGIN_NULLOK(PMC
* old
), ARGIN(visit_info
* info
))
1029 ASSERT_ARGS(visit_todo_list_thaw
)
1030 do_thaw(interp
, old
, info
);
1036 =item C<static void visit_loop_todo_list(PARROT_INTERP, PMC *current, visit_info
1046 visit_loop_todo_list(PARROT_INTERP
, ARGIN_NULLOK(PMC
*current
),
1047 ARGIN(visit_info
*info
))
1049 ASSERT_ARGS(visit_loop_todo_list
)
1051 List
*finish_list
= NULL
;
1052 List
* const todo
= (List
*)PMC_data(info
->todo
);
1053 int finished_first
= 0;
1054 const int thawing
= info
->what
== VISIT_THAW_CONSTANTS
1055 || info
->what
== VISIT_THAW_NORMAL
;
1058 /* create a list that contains PMCs that need thawfinish */
1060 PMC
* const finish_list_pmc
= pmc_new(interp
, enum_class_Array
);
1061 finish_list
= (List
*)PMC_data(finish_list_pmc
);
1064 (info
->visit_pmc_now
)(interp
, current
, info
);
1066 /* can't cache upper limit, visit may append items */
1068 while ((list_item
= (PMC
**)Parrot_pmc_array_shift(interp
, todo
, enum_type_PMC
))) {
1069 current
= *list_item
;
1071 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
1072 "NULL current PMC in visit_loop_todo_list");
1074 PARROT_ASSERT(current
->vtable
);
1076 /* Workaround for thawing constants. Clear constant flag */
1077 /* See src/packfile.c:3999 */
1079 PObj_constant_CLEAR(current
);
1081 VTABLE_visit(interp
, current
, info
);
1084 if (current
== info
->thaw_result
)
1086 if (current
->vtable
->thawfinish
!= interp
->vtables
[enum_class_default
]->thawfinish
)
1087 Parrot_pmc_array_unshift(interp
, finish_list
, current
, enum_type_PMC
);
1093 /* if image isn't consumed, there are some extra data to thaw */
1094 if (info
->image
->bufused
> 0) {
1095 (info
->visit_pmc_now
)(interp
, NULL
, info
);
1099 /* on thawing call thawfinish for each processed PMC */
1100 if (!finished_first
)
1101 Parrot_pmc_array_unshift(interp
, finish_list
, info
->thaw_result
, enum_type_PMC
);
1103 n
= Parrot_pmc_array_length(interp
, finish_list
);
1105 for (i
= 0; i
< n
; ++i
) {
1106 current
= *(PMC
**)Parrot_pmc_array_get(interp
, finish_list
, i
, enum_type_PMC
);
1107 if (!PMC_IS_NULL(current
))
1108 VTABLE_thawfinish(interp
, current
, info
);
1116 =item C<static void create_image(PARROT_INTERP, PMC *pmc, visit_info *info)>
1118 Allocate image to some estimated size.
1125 create_image(PARROT_INTERP
, ARGIN_NULLOK(PMC
*pmc
), ARGMOD(visit_info
*info
))
1127 ASSERT_ARGS(create_image
)
1128 STRING
*array
= CONST_STRING(interp
, "array");
1129 STRING
*hash
= CONST_STRING(interp
, "hash");
1132 if (!PMC_IS_NULL(pmc
)
1133 && (VTABLE_does(interp
, pmc
, array
) || VTABLE_does(interp
, pmc
, hash
))) {
1134 const INTVAL items
= VTABLE_elements(interp
, pmc
);
1135 /* TODO check e.g. first item of aggregate and estimate size */
1136 len
= items
* FREEZE_BYTES_PER_ITEM
;
1139 len
= FREEZE_BYTES_PER_ITEM
;
1141 info
->image
= Parrot_str_new_init(interp
, NULL
, len
,
1142 Parrot_fixed_8_encoding_ptr
, Parrot_binary_charset_ptr
, 0);
1148 =item C<static PMC* run_thaw(PARROT_INTERP, STRING* image, visit_enum_type
1151 Performs thawing. C<what> indicates what to be thawed.
1153 For now it seems cheaper to use a list for remembering contained
1154 aggregates. We could of course decide dynamically, which strategy to
1155 use, e.g.: given a big image, the first thawed item is a small
1156 aggregate. This implies, it probably contains (or some big strings) more
1157 nested containers, for which another approach could be a win.
1163 PARROT_WARN_UNUSED_RESULT
1164 PARROT_CAN_RETURN_NULL
1166 run_thaw(PARROT_INTERP
, ARGIN(STRING
* image
), visit_enum_type what
)
1168 ASSERT_ARGS(run_thaw
)
1171 const UINTVAL bufused
= image
->bufused
;
1175 * if we are thawing a lot of PMCs, it's cheaper to do
1176 * a GC run first and then block GC - the limit should be
1177 * chosen so that no more then one GC run would be triggered
1181 * md5_3.pir shows a segfault during thawing the config hash
1182 * info->thaw_ptr becomes invalid - seems that the hash got
1183 * collected under us.
1185 if (1 || (Parrot_str_byte_length(interp
, image
) > THAW_BLOCK_GC_SIZE
)) {
1186 Parrot_block_GC_mark(interp
);
1187 Parrot_block_GC_sweep(interp
);
1191 /* _NORMAL or _CONSTANTS */
1194 todo_list_init(interp
, &info
);
1195 info
.visit_pmc_now
= visit_todo_list_thaw
;
1197 info
.thaw_result
= NULL
;
1200 visit_loop_todo_list(interp
, NULL
, &info
);
1203 * thaw consumes the image string by incrementing strstart
1204 * and decrementing bufused - restore that
1206 LVALUE_CAST(char *, image
->strstart
) -= bufused
;
1207 image
->bufused
= bufused
;
1208 image
->strlen
+= bufused
;
1210 PARROT_ASSERT(image
->strstart
>= (char *)Buffer_bufstart(image
));
1213 Parrot_unblock_GC_mark(interp
);
1214 Parrot_unblock_GC_sweep(interp
);
1217 PackFile_destroy(interp
, info
.image_io
->pf
);
1218 mem_sys_free(info
.image_io
);
1219 info
.image_io
= NULL
;
1220 return info
.thaw_result
;
1228 =head2 Public Interface
1232 =item C<STRING* Parrot_freeze(PARROT_INTERP, PMC *pmc)>
1234 Freeze using either method.
1241 PARROT_WARN_UNUSED_RESULT
1242 PARROT_CAN_RETURN_NULL
1244 Parrot_freeze(PARROT_INTERP
, ARGIN(PMC
*pmc
))
1246 ASSERT_ARGS(Parrot_freeze
)
1248 * freeze using a todo list and seen hash
1249 * Please note that both have to be PMCs, so that trace_system_stack
1250 * can call mark on the PMCs
1254 info
.what
= VISIT_FREEZE_NORMAL
;
1255 create_image(interp
, pmc
, &info
);
1256 todo_list_init(interp
, &info
);
1258 visit_loop_todo_list(interp
, pmc
, &info
);
1260 PackFile_destroy(interp
, info
.image_io
->pf
);
1261 mem_sys_free(info
.image_io
);
1268 =item C<PMC* Parrot_thaw(PARROT_INTERP, STRING *image)>
1270 Thaws a PMC. Called from the C<thaw> opcode.
1277 PARROT_WARN_UNUSED_RESULT
1278 PARROT_CAN_RETURN_NULL
1280 Parrot_thaw(PARROT_INTERP
, ARGIN(STRING
*image
))
1282 ASSERT_ARGS(Parrot_thaw
)
1283 return run_thaw(interp
, image
, VISIT_THAW_NORMAL
);
1289 =item C<PMC* Parrot_thaw_constants(PARROT_INTERP, STRING *image)>
1291 Thaws constants, used by PackFile for unpacking PMC constants.
1298 PARROT_WARN_UNUSED_RESULT
1299 PARROT_CAN_RETURN_NULL
1301 Parrot_thaw_constants(PARROT_INTERP
, ARGIN(STRING
*image
))
1303 ASSERT_ARGS(Parrot_thaw_constants
)
1304 return run_thaw(interp
, image
, VISIT_THAW_CONSTANTS
);
1310 =item C<PMC* Parrot_clone(PARROT_INTERP, PMC *pmc)>
1312 There are for sure shortcuts to clone faster, e.g. always thaw the image
1313 immediately or use a special callback. For now we just thaw a frozen PMC.
1320 PARROT_WARN_UNUSED_RESULT
1321 PARROT_CAN_RETURN_NULL
1323 Parrot_clone(PARROT_INTERP
, ARGIN(PMC
*pmc
))
1325 ASSERT_ARGS(Parrot_clone
)
1326 return VTABLE_clone(interp
, pmc
);
1336 The seen-hash version for freezing might go away sometime.
1340 Lot of discussion on p6i and F<docs/dev/pmc_freeze.pod>.
1344 Initial version by leo 2003.11.03 - 2003.11.07.
1353 * c-file-style: "parrot"
1355 * vim: expandtab shiftwidth=4: