2 Copyright (C) 2001-2007, The Perl Foundation.
7 src/pmc_freeze.c - Freeze and thaw functionality
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.
16 Thawing PMCs uses a list with (maximum) size of the amount of PMCs to
17 keep track of retrieved PMCs.
19 The individual information of PMCs is frozen/thawed by their vtables.
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.
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.
34 #include "parrot/parrot.h"
36 /* default.pmc thawing of properties */
37 void Parrot_default_thaw(Interp
* , PMC
* pmc
, visit_info
*info
);
39 /* XXX This should be in a header file. */
41 Parrot_default_thawfinish(PARROT_INTERP
, PMC
* pmc
, visit_info
*info
);
44 /* HEADERIZER HFILE: include/parrot/pmc_freeze.h */
45 /* HEADERIZER BEGIN: static */
47 static void add_pmc_next_for_GC(SHIM_INTERP
,
49 ARGOUT(visit_info
*info
))
50 __attribute__nonnull__(2)
51 __attribute__nonnull__(3)
54 static void add_pmc_todo_list(PARROT_INTERP
,
55 ARGIN_NULLOK(PMC
*pmc
),
56 ARGIN(visit_info
*info
))
57 __attribute__nonnull__(1)
58 __attribute__nonnull__(3);
60 static void cleanup_next_for_GC(PARROT_INTERP
)
61 __attribute__nonnull__(1);
63 static void cleanup_next_for_GC_pool(ARGIN(Small_Object_Pool
*pool
))
64 __attribute__nonnull__(1);
66 static void create_image(PARROT_INTERP
,
67 ARGIN_NULLOK(PMC
*pmc
),
68 ARGMOD(visit_info
*info
))
69 __attribute__nonnull__(1)
70 __attribute__nonnull__(3)
74 static void do_action(PARROT_INTERP
,
75 ARGIN_NULLOK(PMC
*pmc
),
76 ARGIN(visit_info
*info
),
79 __attribute__nonnull__(1)
80 __attribute__nonnull__(3);
83 static void do_thaw(PARROT_INTERP
, ARGIN(PMC
* pmc
), ARGIN(visit_info
*info
))
84 __attribute__nonnull__(1)
85 __attribute__nonnull__(2)
86 __attribute__nonnull__(3);
89 static void freeze_pmc(PARROT_INTERP
,
90 ARGIN_NULLOK(PMC
*pmc
),
91 ARGIN(visit_info
*info
),
94 __attribute__nonnull__(1)
95 __attribute__nonnull__(3);
97 static void ft_init(PARROT_INTERP
, ARGIN(visit_info
*info
))
98 __attribute__nonnull__(1)
99 __attribute__nonnull__(2);
101 static UINTVAL
id_from_pmc(PARROT_INTERP
, ARGIN(PMC
* pmc
))
102 __attribute__nonnull__(1)
103 __attribute__nonnull__(2);
106 static int next_for_GC_seen(PARROT_INTERP
,
107 ARGIN_NULLOK(PMC
*pmc
),
108 ARGIN(visit_info
*info
),
110 __attribute__nonnull__(1)
111 __attribute__nonnull__(3)
112 __attribute__nonnull__(4)
115 static void op_append(PARROT_INTERP
,
119 __attribute__nonnull__(1)
120 __attribute__nonnull__(2);
123 static void op_check_size(PARROT_INTERP
, ARGIN(STRING
*s
), size_t len
)
124 __attribute__nonnull__(1)
125 __attribute__nonnull__(2);
127 static void pmc_add_ext(PARROT_INTERP
, ARGIN(PMC
*pmc
))
128 __attribute__nonnull__(1)
129 __attribute__nonnull__(2);
131 static void push_ascii_integer(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
), INTVAL v
)
132 __attribute__nonnull__(1)
133 __attribute__nonnull__(2);
135 static void push_ascii_number(PARROT_INTERP
,
136 ARGIN(const IMAGE_IO
*io
),
138 __attribute__nonnull__(1)
139 __attribute__nonnull__(2);
141 static void push_ascii_pmc(PARROT_INTERP
,
144 __attribute__nonnull__(1)
145 __attribute__nonnull__(2)
146 __attribute__nonnull__(3);
148 static void push_ascii_string(PARROT_INTERP
,
150 ARGIN(const STRING
*s
))
151 __attribute__nonnull__(1)
152 __attribute__nonnull__(2)
153 __attribute__nonnull__(3);
155 static void push_opcode_integer(PARROT_INTERP
,
158 __attribute__nonnull__(1)
159 __attribute__nonnull__(2);
161 static void push_opcode_number(PARROT_INTERP
,
164 __attribute__nonnull__(1)
165 __attribute__nonnull__(2);
167 static void push_opcode_pmc(PARROT_INTERP
,
170 __attribute__nonnull__(1)
171 __attribute__nonnull__(2)
172 __attribute__nonnull__(3);
174 static void push_opcode_string(PARROT_INTERP
,
177 __attribute__nonnull__(1)
178 __attribute__nonnull__(2)
179 __attribute__nonnull__(3);
181 PARROT_WARN_UNUSED_RESULT
182 PARROT_CAN_RETURN_NULL
183 static PMC
* run_thaw(PARROT_INTERP
,
184 ARGIN(STRING
* image
),
185 visit_enum_type what
)
186 __attribute__nonnull__(1)
187 __attribute__nonnull__(2);
189 static INTVAL
shift_ascii_integer(SHIM_INTERP
, ARGIN(IMAGE_IO
*io
))
190 __attribute__nonnull__(2);
192 static FLOATVAL
shift_ascii_number(SHIM_INTERP
, ARGIN(IMAGE_IO
*io
))
193 __attribute__nonnull__(2);
195 PARROT_WARN_UNUSED_RESULT
196 PARROT_CAN_RETURN_NULL
197 static PMC
* shift_ascii_pmc(SHIM_INTERP
, ARGIN(IMAGE_IO
*io
))
198 __attribute__nonnull__(2);
200 PARROT_WARN_UNUSED_RESULT
201 PARROT_CAN_RETURN_NULL
202 static STRING
* shift_ascii_string(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
))
203 __attribute__nonnull__(1)
204 __attribute__nonnull__(2);
206 static INTVAL
shift_opcode_integer(SHIM_INTERP
, ARGIN(IMAGE_IO
*io
))
207 __attribute__nonnull__(2);
209 static FLOATVAL
shift_opcode_number(SHIM_INTERP
, ARGIN(IMAGE_IO
*io
))
210 __attribute__nonnull__(2);
212 PARROT_WARN_UNUSED_RESULT
213 PARROT_CAN_RETURN_NULL
214 static PMC
* shift_opcode_pmc(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
))
215 __attribute__nonnull__(1)
216 __attribute__nonnull__(2);
218 PARROT_WARN_UNUSED_RESULT
219 PARROT_CANNOT_RETURN_NULL
220 static STRING
* shift_opcode_string(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
))
221 __attribute__nonnull__(1)
222 __attribute__nonnull__(2);
224 static void str_append(PARROT_INTERP
,
226 ARGIN(const void *b
),
228 __attribute__nonnull__(1)
229 __attribute__nonnull__(2)
230 __attribute__nonnull__(3)
234 PARROT_CANNOT_RETURN_NULL
235 static PMC
* thaw_create_pmc(PARROT_INTERP
,
236 ARGIN(const visit_info
*info
),
238 __attribute__nonnull__(1)
239 __attribute__nonnull__(2);
242 static int thaw_pmc(PARROT_INTERP
,
243 ARGMOD(visit_info
*info
),
245 ARGOUT(INTVAL
*type
))
246 __attribute__nonnull__(1)
247 __attribute__nonnull__(2)
248 __attribute__nonnull__(3)
249 __attribute__nonnull__(4)
252 FUNC_MODIFIES(*type
);
254 static void todo_list_init(PARROT_INTERP
, ARGOUT(visit_info
*info
))
255 __attribute__nonnull__(1)
256 __attribute__nonnull__(2)
257 FUNC_MODIFIES(*info
);
260 static int todo_list_seen(PARROT_INTERP
,
262 ARGMOD(visit_info
*info
),
264 __attribute__nonnull__(1)
265 __attribute__nonnull__(2)
266 __attribute__nonnull__(3)
267 __attribute__nonnull__(4)
271 static void visit_loop_next_for_GC(PARROT_INTERP
,
273 ARGIN(visit_info
*info
))
274 __attribute__nonnull__(1)
275 __attribute__nonnull__(2)
276 __attribute__nonnull__(3);
278 static void visit_loop_todo_list(PARROT_INTERP
,
279 ARGIN_NULLOK(PMC
*current
),
280 ARGIN(visit_info
*info
))
281 __attribute__nonnull__(1)
282 __attribute__nonnull__(3);
284 static void visit_next_for_GC(PARROT_INTERP
,
286 ARGIN(visit_info
* info
))
287 __attribute__nonnull__(1)
288 __attribute__nonnull__(2)
289 __attribute__nonnull__(3);
291 static void visit_todo_list(PARROT_INTERP
,
293 ARGIN(visit_info
* info
))
294 __attribute__nonnull__(1)
295 __attribute__nonnull__(2)
296 __attribute__nonnull__(3);
298 static void visit_todo_list_thaw(PARROT_INTERP
,
300 ARGIN(visit_info
* info
))
301 __attribute__nonnull__(1)
302 __attribute__nonnull__(2)
303 __attribute__nonnull__(3);
305 /* HEADERIZER END: static */
308 * define this to 1 for testing
311 # define FREEZE_ASCII 0
315 * normal freeze can use next_for_GC ptrs or a seen hash
317 #define FREEZE_USE_NEXT_FOR_GC 0
320 * when thawing a string longer then this size, we first do a
321 * DOD run and then block DOD/GC - the system can't give us more headers
323 #define THAW_BLOCK_DOD_SIZE 100000
326 * preallocate freeze image for aggregates with this estimation
329 # define FREEZE_BYTES_PER_ITEM 17
331 # define FREEZE_BYTES_PER_ITEM 9
336 =head2 Image Stream Functions
340 =item C<static void str_append>
342 Appends C<len> bytes from buffer C<*b> to string C<*s>.
344 Plain ascii - for testing only:
346 For speed reasons we mess around with the string buffers directly.
348 No encoding of strings, no transcoding.
355 str_append(PARROT_INTERP
, ARGMOD(STRING
*s
), ARGIN(const void *b
), size_t len
)
357 const size_t used
= s
->bufused
;
358 const int need_free
= (int)PObj_buflen(s
) - used
- len
;
360 * grow by factor 1.5 or such
362 if (need_free
<= 16) {
363 size_t new_size
= (size_t) (PObj_buflen(s
) * 1.5);
364 if (new_size
< PObj_buflen(s
) - need_free
+ 512)
365 new_size
= PObj_buflen(s
) - need_free
+ 512;
366 Parrot_reallocate_string(interp
, s
, new_size
);
367 PARROT_ASSERT(PObj_buflen(s
) - used
- len
>= 15);
369 mem_sys_memcopy((void *)((ptrcast_t
)s
->strstart
+ used
), b
, len
);
376 =item C<static void push_ascii_integer>
378 Pushes an ASCII version of the integer C<v> onto the end of the C<*io>
386 push_ascii_integer(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
), INTVAL v
)
389 const size_t len
= snprintf(buffer
, sizeof (buffer
), "%d ", (int) v
);
390 str_append(interp
, io
->image
, buffer
, len
);
395 =item C<static void push_ascii_number>
397 Pushes an ASCII version of the number C<v> onto the end of the C<*io>
405 push_ascii_number(PARROT_INTERP
, ARGIN(const IMAGE_IO
*io
), FLOATVAL v
)
408 const size_t len
= snprintf(buffer
, sizeof (buffer
), "%g ", (double) v
);
409 str_append(interp
, io
->image
, buffer
, len
);
414 =item C<static void push_ascii_string>
416 Pushes an ASCII version of the string C<*s> onto the end of the C<*io>
419 For testing only - no encodings and such.
421 XXX no string delimiters - so no space allowed.
428 push_ascii_string(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
), ARGIN(const STRING
*s
))
430 const UINTVAL length
= string_length(interp
, s
);
431 char * const buffer
= (char *)malloc(4*length
); /* XXX Why 4? What does that mean? */
432 char *cursor
= buffer
;
435 /* temporary--write out in UTF-8 */
436 for (idx
= 0; idx
< length
; ++idx
) {
437 *cursor
++ = (unsigned char)string_index(interp
, s
, idx
);
440 str_append(interp
, io
->image
, buffer
, cursor
- buffer
);
441 str_append(interp
, io
->image
, " ", 1);
443 mem_sys_free(buffer
);
448 =item C<static void push_ascii_pmc>
450 Pushes an ASCII version of the PMC C<*v> onto the end of the C<*io>
458 push_ascii_pmc(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
), ARGIN(const PMC
* v
))
461 const size_t len
= snprintf(buffer
, sizeof (buffer
), "%p ", (const void *)v
);
462 str_append(interp
, io
->image
, buffer
, len
);
467 =item C<static INTVAL shift_ascii_integer>
469 Removes and returns an integer from the start of the C<*io> "stream".
476 shift_ascii_integer(SHIM_INTERP
, ARGIN(IMAGE_IO
*io
))
478 char * const start
= (char*)io
->image
->strstart
;
480 const INTVAL i
= strtoul(p
, &p
, 10);
483 PARROT_ASSERT(p
<= start
+ io
->image
->bufused
);
484 io
->image
->strstart
= p
;
485 io
->image
->bufused
-= (p
- start
);
486 PARROT_ASSERT((int)io
->image
->bufused
>= 0);
492 =item C<static FLOATVAL shift_ascii_number>
494 Removes and returns an number from the start of the C<*io> "stream".
501 shift_ascii_number(SHIM_INTERP
, ARGIN(IMAGE_IO
*io
))
503 char * const start
= (char*)io
->image
->strstart
;
505 const FLOATVAL f
= (FLOATVAL
) strtod(p
, &p
);
508 PARROT_ASSERT(p
<= start
+ io
->image
->bufused
);
509 io
->image
->strstart
= p
;
510 io
->image
->bufused
-= (p
- start
);
511 PARROT_ASSERT((int)io
->image
->bufused
>= 0);
517 =item C<static STRING* shift_ascii_string>
519 Removes and returns an string from the start of the C<*io> "stream".
525 PARROT_WARN_UNUSED_RESULT
526 PARROT_CAN_RETURN_NULL
528 shift_ascii_string(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
))
532 char * const start
= (char*)io
->image
->strstart
;
538 PARROT_ASSERT(p
<= start
+ io
->image
->bufused
);
539 io
->image
->strstart
= p
;
540 io
->image
->bufused
-= (p
- start
);
541 PARROT_ASSERT((int)io
->image
->bufused
>= 0);
542 s
= string_make(interp
, start
, p
- start
- 1, "iso-8859-1", 0);
543 /* s = string_make(interp, start, p - start - 1, "UTF-8", 0); */
549 =item C<static PMC* shift_ascii_pmc>
551 Removes and returns a PMC from the start of the C<*io> "stream".
557 PARROT_WARN_UNUSED_RESULT
558 PARROT_CAN_RETURN_NULL
560 shift_ascii_pmc(SHIM_INTERP
, ARGIN(IMAGE_IO
*io
))
562 char * const start
= (char*)io
->image
->strstart
;
564 const unsigned long i
= strtoul(p
, &p
, 16);
566 PARROT_ASSERT(p
<= start
+ io
->image
->bufused
);
567 io
->image
->strstart
= p
;
568 io
->image
->bufused
-= (p
- start
);
569 PARROT_ASSERT((int)io
->image
->bufused
>= 0);
577 =head2 C<opcode_t> IO Functions
581 =item C<static void op_check_size>
583 Checks the size of the "stream" buffer to see if it can accommodate
584 C<len> more bytes. If not then the buffer is expanded.
592 op_check_size(PARROT_INTERP
, ARGIN(STRING
*s
), size_t len
)
594 const size_t used
= s
->bufused
;
595 const int need_free
= (int)PObj_buflen(s
) - used
- len
;
597 * grow by factor 1.5 or such
599 if (need_free
<= 16) {
600 size_t new_size
= (size_t) (PObj_buflen(s
) * 1.5);
601 if (new_size
< PObj_buflen(s
) - need_free
+ 512)
602 new_size
= PObj_buflen(s
) - need_free
+ 512;
603 Parrot_reallocate_string(interp
, s
, new_size
);
604 PARROT_ASSERT(PObj_buflen(s
) - used
- len
>= 15);
606 #ifndef DISABLE_GC_DEBUG
607 Parrot_go_collect(interp
);
613 =item C<static void op_append>
615 Appends the opcode C<b> to the string C<*s>.
622 op_append(PARROT_INTERP
, ARGIN(STRING
*s
), opcode_t b
, size_t len
)
624 op_check_size(interp
, s
, len
);
625 *((opcode_t
*)((ptrcast_t
)s
->strstart
+ s
->bufused
)) = b
;
632 =item C<static void push_opcode_integer>
634 Pushes the integer C<v> onto the end of the C<*io> "stream".
636 XXX assumes sizeof (opcode_t) == sizeof (INTVAL).
643 push_opcode_integer(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
), INTVAL v
)
645 PARROT_ASSERT(sizeof (opcode_t
) == sizeof (INTVAL
));
646 op_append(interp
, io
->image
, (opcode_t
)v
, sizeof (opcode_t
));
651 =item C<static void push_opcode_number>
653 Pushes the number C<v> onto the end of the C<*io> "stream".
660 push_opcode_number(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
), FLOATVAL v
)
662 const size_t len
= PF_size_number() * sizeof (opcode_t
);
663 STRING
* const s
= io
->image
;
664 const size_t used
= s
->bufused
;
667 op_check_size(interp
, s
, len
);
668 ignored
= PF_store_number((opcode_t
*)((ptrcast_t
)s
->strstart
+ used
), &v
);
677 =item C<static void push_opcode_string>
679 Pushes the string C<*v> onto the end of the C<*io> "stream".
686 push_opcode_string(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
), ARGIN(STRING
*v
))
688 const size_t len
= PF_size_string(v
) * sizeof (opcode_t
);
689 STRING
* const s
= io
->image
;
690 const size_t used
= s
->bufused
;
693 op_check_size(interp
, s
, len
);
694 ignored
= PF_store_string((opcode_t
*)((ptrcast_t
)s
->strstart
+ used
), v
);
703 =item C<static void push_opcode_pmc>
705 Pushes the PMC C<*v> onto the end of the C<*io> "stream".
712 push_opcode_pmc(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
), ARGIN(PMC
* v
))
714 op_append(interp
, io
->image
, (opcode_t
)v
, sizeof (opcode_t
));
719 =item C<static INTVAL shift_opcode_integer>
721 Removes and returns an integer from the start of the C<*io> "stream".
723 TODO - The shift functions aren't portable yet. We need to have a
724 packfile header for wordsize and endianess.
731 shift_opcode_integer(SHIM_INTERP
, ARGIN(IMAGE_IO
*io
))
733 const char * const start
= (char*)io
->image
->strstart
;
735 PF_fetch_integer(io
->pf
, (opcode_t
**) &io
->image
->strstart
);
737 io
->image
->bufused
-= ((char*)io
->image
->strstart
- start
);
738 PARROT_ASSERT((int)io
->image
->bufused
>= 0);
744 =item C<static PMC* shift_opcode_pmc>
746 Removes and returns an PMC from the start of the C<*io> "stream".
748 Note that this actually reads a PMC id, not a PMC.
754 PARROT_WARN_UNUSED_RESULT
755 PARROT_CAN_RETURN_NULL
757 shift_opcode_pmc(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
))
759 INTVAL i
= shift_opcode_integer(interp
, io
);
765 =item C<static FLOATVAL shift_opcode_number>
767 Removes and returns an number from the start of the C<*io> "stream".
774 shift_opcode_number(SHIM_INTERP
, ARGIN(IMAGE_IO
*io
))
776 const char * const start
= (const char*)io
->image
->strstart
;
778 PF_fetch_number(io
->pf
, (const opcode_t
**) &io
->image
->strstart
);
780 io
->image
->bufused
-= ((char*)io
->image
->strstart
- start
);
781 PARROT_ASSERT((int)io
->image
->bufused
>= 0);
787 =item C<static STRING* shift_opcode_string>
789 Removes and returns a string from the start of the C<*io> "stream".
795 PARROT_WARN_UNUSED_RESULT
796 PARROT_CANNOT_RETURN_NULL
798 shift_opcode_string(PARROT_INTERP
, ARGIN(IMAGE_IO
*io
))
800 char * const start
= (char*)io
->image
->strstart
;
802 PF_fetch_string(interp
, io
->pf
, (const opcode_t
**) &io
->image
->strstart
);
804 io
->image
->bufused
-= ((char*)io
->image
->strstart
- start
);
805 PARROT_ASSERT((int)io
->image
->bufused
>= 0);
813 =head2 Helper Functions
817 =item C<static void pmc_add_ext>
819 Adds a C<PMC_EXT> to C<*pmc>.
826 pmc_add_ext(PARROT_INTERP
, ARGIN(PMC
*pmc
))
828 if (pmc
->vtable
->flags
& VTABLE_PMC_NEEDS_EXT
)
829 add_pmc_ext(interp
, pmc
);
834 =item C<static void cleanup_next_for_GC_pool>
836 Sets all the C<next_for_GC> pointers to C<NULL>.
843 cleanup_next_for_GC_pool(ARGIN(Small_Object_Pool
*pool
))
845 Small_Object_Arena
*arena
;
847 for (arena
= pool
->last_Arena
; arena
; arena
= arena
->prev
) {
848 PMC
*p
= (PMC
*)arena
->start_objects
;
851 for (i
= 0; i
< arena
->used
; i
++) {
852 if (!PObj_on_free_list_TEST(p
)) {
854 PMC_next_for_GC(p
) = PMCNULL
;
863 =item C<static void cleanup_next_for_GC>
865 Cleans up the C<next_for_GC> pointers.
872 cleanup_next_for_GC(PARROT_INTERP
)
874 cleanup_next_for_GC_pool(interp
->arena_base
->pmc_pool
);
875 cleanup_next_for_GC_pool(interp
->arena_base
->constant_pmc_pool
);
879 * this function setup stuff may be replaced by a real PMC
881 * TODO add read/write header functions, e.g. vtable->init_pmc
885 static image_funcs ascii_funcs
= {
896 static image_funcs opcode_funcs
= {
901 shift_opcode_integer
,
910 =item C<static void ft_init>
912 Initializes the freeze/thaw subsystem.
919 ft_init(PARROT_INTERP
, ARGIN(visit_info
*info
))
921 STRING
*s
= info
->image
;
924 /* We want to store a 16-byte aligned header, but the actual
925 * header may be shorter. */
926 const unsigned int header_length
= PACKFILE_HEADER_BYTES
+
927 (PACKFILE_HEADER_BYTES
% 16 ?
928 16 - PACKFILE_HEADER_BYTES
% 16 : 0);
930 info
->image_io
= mem_allocate_typed(IMAGE_IO
);
931 info
->image_io
->image
= s
= info
->image
;
933 info
->image_io
->vtable
= &ascii_funcs
;
935 info
->image_io
->vtable
= &opcode_funcs
;
937 pf
= info
->image_io
->pf
= PackFile_new(interp
, 0);
938 if (info
->what
== VISIT_FREEZE_NORMAL
||
939 info
->what
== VISIT_FREEZE_AT_DESTRUCT
) {
941 op_check_size(interp
, s
, header_length
);
942 mem_sys_memcopy(s
->strstart
, pf
->header
, PACKFILE_HEADER_BYTES
);
943 s
->bufused
+= header_length
;
944 s
->strlen
+= header_length
;
947 if (string_length(interp
, s
) < header_length
) {
948 real_exception(interp
, NULL
, E_IOError
,
949 "bad string to thaw");
951 mem_sys_memcopy(pf
->header
, s
->strstart
, PACKFILE_HEADER_BYTES
);
952 PackFile_assign_transforms(pf
);
953 s
->bufused
-= header_length
;
954 LVALUE_CAST(char *, s
->strstart
) += header_length
;
957 info
->last_type
= -1;
958 info
->id_list
= pmc_new(interp
, enum_class_Array
);
960 info
->extra_flags
= EXTRA_IS_NULL
;
961 info
->container
= NULL
;
966 =item C<static void todo_list_init>
968 Initializes the C<*info> lists.
975 todo_list_init(PARROT_INTERP
, ARGOUT(visit_info
*info
))
977 info
->visit_pmc_now
= visit_todo_list
;
978 info
->visit_pmc_later
= add_pmc_todo_list
;
979 /* we must use PMCs here, so that they get marked properly */
980 info
->todo
= pmc_new(interp
, enum_class_Array
);
981 info
->seen
= Parrot_new_INTVAL_hash(interp
, 0);
983 ft_init(interp
, info
);
989 =item C<static void freeze_pmc>
991 Freeze PMC, setting type, seen, and "same-as-last" indicators as
1000 freeze_pmc(PARROT_INTERP
, ARGIN_NULLOK(PMC
*pmc
), ARGIN(visit_info
*info
),
1001 int seen
, UINTVAL id
)
1003 IMAGE_IO
* const io
= info
->image_io
;
1006 if (PMC_IS_NULL(pmc
)) {
1007 /* NULL + seen bit */
1008 VTABLE_push_pmc(interp
, io
, (PMC
*) 1);
1011 type
= pmc
->vtable
->base_type
;
1013 if (PObj_is_object_TEST(pmc
))
1014 type
= enum_class_Object
;
1016 if (info
->extra_flags
) {
1018 VTABLE_push_pmc(interp
, io
, (PMC
*)id
);
1019 VTABLE_push_integer(interp
, io
, info
->extra_flags
);
1022 id
|= 1; /* mark bit 0 if this PMC is known */
1024 else if (type
== info
->last_type
) {
1025 id
|= 2; /* mark bit 1 and don't write type */
1027 VTABLE_push_pmc(interp
, io
, (PMC
*)id
);
1028 if (! (id
& 3)) { /* else write type */
1029 VTABLE_push_integer(interp
, io
, type
);
1030 info
->last_type
= type
;
1036 =item C<static int thaw_pmc>
1038 Freeze and thaw a PMC (id).
1040 For example, the ASCII representation of the C<Array>
1042 P0 = [P1=666, P2=777, P0]
1046 0xdf4 30 3 0xdf8 33 666 0xdf2 777 0xdf5
1048 where 30 is C<class_enum_Array>, 33 is C<class_enum_Integer>, the
1049 type of the second C<Integer> is suppressed, the repeated P0 has bit 0
1058 thaw_pmc(PARROT_INTERP
, ARGMOD(visit_info
*info
),
1059 ARGOUT(UINTVAL
*id
), ARGOUT(INTVAL
*type
))
1062 IMAGE_IO
* const io
= info
->image_io
;
1065 info
->extra_flags
= EXTRA_IS_NULL
;
1066 n
= VTABLE_shift_pmc(interp
, io
);
1067 if (((UINTVAL
) n
& 3) == 3) {
1068 /* pmc has extra data */
1069 info
->extra_flags
= VTABLE_shift_integer(interp
, io
);
1071 else if ((UINTVAL
) n
& 1) { /* seen PMCs have bit 0 set */
1074 else if ((UINTVAL
) n
& 2) { /* prev PMC was same type */
1075 *type
= info
->last_type
;
1077 else { /* type follows */
1078 *type
= VTABLE_shift_integer(interp
, io
);
1079 info
->last_type
= *type
;
1081 real_exception(interp
, NULL
, 1, "Unknown PMC type to thaw %d", (int) *type
);
1082 if (*type
>= interp
->n_vtable_max
||
1083 !interp
->vtables
[*type
]) {
1084 /* that ought to be a class */
1085 *type
= enum_class_Class
;
1094 =item C<static void do_action>
1096 Called from C<visit_next_for_GC()> and C<visit_todo_list()> to perform
1097 the action specified in C<< info->what >>.
1099 Currently only C<VISIT_FREEZE_NORMAL> is implemented.
1107 do_action(PARROT_INTERP
, ARGIN_NULLOK(PMC
*pmc
), ARGIN(visit_info
*info
),
1108 int seen
, UINTVAL id
)
1110 switch (info
->what
) {
1111 case VISIT_FREEZE_AT_DESTRUCT
:
1112 case VISIT_FREEZE_NORMAL
:
1113 freeze_pmc(interp
, pmc
, info
, seen
, id
);
1115 info
->visit_action
= pmc
->vtable
->freeze
;
1118 real_exception(interp
, NULL
, 1, "Illegal action %ld", (long)info
->what
);
1124 =item C<static PMC* thaw_create_pmc>
1126 Called from C<do_thaw()> to attach the vtable etc. to C<*pmc>.
1133 PARROT_CANNOT_RETURN_NULL
1135 thaw_create_pmc(PARROT_INTERP
, ARGIN(const visit_info
*info
),
1139 switch (info
->what
) {
1140 case VISIT_THAW_NORMAL
:
1141 pmc
= pmc_new_noinit(interp
, type
);
1143 case VISIT_THAW_CONSTANTS
:
1144 pmc
= constant_pmc_new_noinit(interp
, type
);
1147 real_exception(interp
, NULL
, 1, "Illegal visit_next type");
1154 =item C<static void do_thaw>
1156 Called by C<visit_todo_list_thaw()> to thaw and return a PMC.
1158 C<seen> is false if this is the first time the PMC has been encountered.
1166 do_thaw(PARROT_INTERP
, ARGIN(PMC
* pmc
), ARGIN(visit_info
*info
))
1172 type
= 0; /* it's set below, avoid compiler warning. */
1173 must_have_seen
= thaw_pmc(interp
, info
, &id
, &type
);
1178 /* got a NULL PMC */
1180 if (!info
->thaw_result
)
1181 info
->thaw_result
= pmc
;
1183 *info
->thaw_ptr
= pmc
;
1187 pos
= (PMC
**)list_get(interp
, (List
*)PMC_data(info
->id_list
), id
, enum_type_PMC
);
1188 if (pos
== (void*)-1)
1196 if (info
->extra_flags
== EXTRA_IS_PROP_HASH
) {
1197 Parrot_default_thaw(interp
, pmc
, info
);
1200 /* else maybe VTABLE_thaw ... but there is no other extra stuff */
1202 #if FREEZE_USE_NEXT_FOR_GC
1204 * the next_for_GC method doesn't keep track of repeated scalars
1205 * and such, as these are lacking the next_for_GC pointer, so
1206 * these are just duplicated with their data.
1207 * But we track these when thawing, so that we don't create dups
1209 if (!must_have_seen
) {
1210 /* so we must consume the bytecode */
1211 VTABLE_thaw(interp
, pmc
, info
);
1214 PARROT_ASSERT(must_have_seen
);
1217 * that's a duplicate
1218 if (info->container)
1219 DOD_WRITE_BARRIER(interp, info->container, NULL, pmc);
1221 *info
->thaw_ptr
= pmc
;
1225 PARROT_ASSERT(!must_have_seen
);
1226 pmc
= thaw_create_pmc(interp
, info
, type
);
1228 VTABLE_thaw(interp
, pmc
, info
);
1229 if (info
->extra_flags
== EXTRA_CLASS_EXISTS
) {
1230 pmc
= (PMC
*)info
->extra
;
1232 info
->extra_flags
= 0;
1234 if (!info
->thaw_result
)
1235 info
->thaw_result
= pmc
;
1237 if (info
->container
) {
1238 DOD_WRITE_BARRIER(interp
, info
->container
, NULL
, pmc
);
1240 *info
->thaw_ptr
= pmc
;
1242 list_assign(interp
, (List
*)PMC_data(info
->id_list
), id
, pmc
, enum_type_PMC
);
1243 /* remember nested aggregates depth first */
1245 list_unshift(interp
, (List
*)PMC_data(info
->todo
), pmc
, enum_type_PMC
);
1251 =item C<static UINTVAL id_from_pmc>
1253 Find a PMC in an arena, and return an id (left-shifted 2 bits),
1254 based on its position.
1256 If not found, throw an exception.
1263 id_from_pmc(PARROT_INTERP
, ARGIN(PMC
* pmc
))
1265 UINTVAL id
= 1; /* first PMC in first arena */
1266 Small_Object_Arena
*arena
;
1267 Small_Object_Pool
*pool
;
1269 pmc
= (PMC
*)PObj_to_ARENA(pmc
);
1270 pool
= interp
->arena_base
->pmc_pool
;
1271 for (arena
= pool
->last_Arena
; arena
; arena
= arena
->prev
) {
1272 const ptrdiff_t ptr_diff
= (ptrdiff_t)pmc
- (ptrdiff_t)arena
->start_objects
;
1273 if (ptr_diff
>= 0 && ptr_diff
<
1274 (ptrdiff_t)(arena
->used
* pool
->object_size
)) {
1275 PARROT_ASSERT(ptr_diff
% pool
->object_size
== 0);
1276 id
+= ptr_diff
/ pool
->object_size
;
1279 id
+= arena
->total_objects
;
1282 pool
= interp
->arena_base
->constant_pmc_pool
;
1283 for (arena
= pool
->last_Arena
; arena
; arena
= arena
->prev
) {
1284 const ptrdiff_t ptr_diff
= (ptrdiff_t)pmc
- (ptrdiff_t)arena
->start_objects
;
1285 if (ptr_diff
>= 0 && ptr_diff
<
1286 (ptrdiff_t)(arena
->used
* pool
->object_size
)) {
1287 PARROT_ASSERT(ptr_diff
% pool
->object_size
== 0);
1288 id
+= ptr_diff
/ pool
->object_size
;
1291 id
+= arena
->total_objects
;
1294 real_exception(interp
, NULL
, 1, "Couldn't find PMC in arenas");
1299 =item C<static void add_pmc_next_for_GC>
1301 Remembers the PMC for later processing.
1308 add_pmc_next_for_GC(SHIM_INTERP
, ARGIN(PMC
*pmc
), ARGOUT(visit_info
*info
))
1311 PMC_next_for_GC(info
->mark_ptr
) = pmc
;
1312 info
->mark_ptr
= PMC_next_for_GC(pmc
) = pmc
;
1318 =item C<static int next_for_GC_seen>
1320 Remembers next child to visit via the C<next_for_GC pointer> generate a
1321 unique ID per PMC and freeze the ID (not the PMC address) so thaw the
1322 hash-lookup can be replaced by an array lookup then which is a lot
1331 next_for_GC_seen(PARROT_INTERP
, ARGIN_NULLOK(PMC
*pmc
),
1332 ARGIN(visit_info
*info
), ARGOUT(UINTVAL
*id
))
1336 if (PMC_IS_NULL(pmc
)) {
1342 * we can only remember PMCs with a next_for_GC pointer
1343 * which is located in pmc_ext
1347 if (!PMC_IS_NULL(PMC_next_for_GC(pmc
))) {
1351 /* put pmc at the end of the list */
1352 PMC_next_for_GC(info
->mark_ptr
) = pmc
;
1353 /* make end self-referential */
1354 info
->mark_ptr
= PMC_next_for_GC(pmc
) = pmc
;
1357 *id
= id_from_pmc(interp
, pmc
);
1363 =item C<static void add_pmc_todo_list>
1365 Remembers the PMC to be processed later.
1372 add_pmc_todo_list(PARROT_INTERP
, ARGIN_NULLOK(PMC
*pmc
), ARGIN(visit_info
*info
))
1374 list_push(interp
, (List
*)PMC_data(info
->todo
), pmc
, enum_type_PMC
);
1379 =item C<static int todo_list_seen>
1381 Returns true if the PMC was seen, otherwise it put it on the todo list,
1382 generates an ID (tag) for PMC, offset by 4 as are addresses, low bits
1391 todo_list_seen(PARROT_INTERP
, ARGIN(PMC
*pmc
), ARGMOD(visit_info
*info
),
1392 ARGOUT(UINTVAL
*id
))
1394 HashBucket
* const b
=
1395 parrot_hash_get_bucket(interp
, (Hash
*)PMC_struct_val(info
->seen
), pmc
);
1398 *id
= (UINTVAL
) b
->value
;
1402 info
->id
+= 4; /* next id to freeze */
1404 parrot_hash_put(interp
, (Hash
*)PMC_struct_val(info
->seen
), pmc
, (void*)*id
);
1405 /* remember containers */
1407 list_unshift(interp
, (List
*)PMC_data(info
->todo
), pmc
, enum_type_PMC
);
1413 =item C<static void visit_next_for_GC>
1415 C<visit_child> callbacks:
1417 Checks if the PMC was seen, generate an ID for it if not, then do the
1425 visit_next_for_GC(PARROT_INTERP
, ARGIN(PMC
* pmc
), ARGIN(visit_info
* info
))
1428 const int seen
= next_for_GC_seen(interp
, pmc
, info
, &id
);
1431 real_exception(interp
, NULL
, 1, "todo convert to depth first");
1432 /* do_action(interp, pmc, info, seen, id); UNCOMMENT WHEN TODO IS DONE*/
1434 * TODO probe for class methods that override the default.
1435 * To avoid overhead, we could have an array[class_enums]
1436 * which (after first find_method) has a bit, if a user
1437 * callback is there.
1439 /* UNCOMMENT WHEN TODO IS DONE
1441 (info->visit_action)(interp, pmc, info);
1447 =item C<static void visit_todo_list>
1449 Checks the seen PMC via the todo list.
1456 visit_todo_list(PARROT_INTERP
, ARGIN(PMC
* pmc
), ARGIN(visit_info
* info
))
1461 if (PMC_IS_NULL(pmc
)) {
1466 seen
= todo_list_seen(interp
, pmc
, info
, &id
);
1467 do_action(interp
, pmc
, info
, seen
, id
);
1469 (info
->visit_action
)(interp
, pmc
, info
);
1474 =item C<static void visit_todo_list_thaw>
1476 Callback for thaw - action first.
1478 Todo-list and seen handling is all in C<do_thaw()>.
1485 visit_todo_list_thaw(PARROT_INTERP
, ARGIN(PMC
* old
), ARGIN(visit_info
* info
))
1487 do_thaw(interp
, old
, info
);
1492 =item C<static void visit_loop_next_for_GC>
1494 Put first item on todo list, then run as long as there are items to be
1502 visit_loop_next_for_GC(PARROT_INTERP
, ARGIN(PMC
*current
),
1503 ARGIN(visit_info
*info
))
1505 visit_next_for_GC(interp
, current
, info
);
1506 if (current
->pmc_ext
) {
1509 while (current
!= prev
) {
1510 VTABLE_visit(interp
, current
, info
);
1512 current
= PMC_next_for_GC(current
);
1519 =item C<static void visit_loop_todo_list>
1528 visit_loop_todo_list(PARROT_INTERP
, ARGIN_NULLOK(PMC
*current
),
1529 ARGIN(visit_info
*info
))
1531 List
* const todo
= (List
*)PMC_data(info
->todo
);
1535 int finished_first
= 0;
1538 info
->what
== VISIT_THAW_CONSTANTS
||
1539 info
->what
== VISIT_THAW_NORMAL
;
1543 * create a list that contains PMCs that need thawfinish
1545 PMC
* const finish_list_pmc
= pmc_new(interp
, enum_class_Array
);
1546 finish_list
= (List
*)PMC_data(finish_list_pmc
);
1551 (info
->visit_pmc_now
)(interp
, current
, info
);
1553 * can't cache upper limit, visit may append items
1556 while ((list_item
= (PMC
**)list_shift(interp
, todo
, enum_type_PMC
))) {
1557 /* XXX list_shift can return NULL and we're dereferencing it without checking */
1558 current
= *list_item
;
1560 real_exception(interp
, NULL
, 1,
1561 "NULL current PMC in visit_loop_todo_list");
1563 VTABLE_visit(interp
, current
, info
);
1565 if (current
== info
->thaw_result
)
1567 if (current
->vtable
&& current
->vtable
->thawfinish
!=
1568 Parrot_default_thawfinish
)
1569 list_unshift(interp
, finish_list
, current
, enum_type_PMC
);
1576 * if image isn't consumed, there are some extra data to thaw
1578 if (info
->image
->bufused
> 0) {
1579 (info
->visit_pmc_now
)(interp
, NULL
, info
);
1583 * on thawing call thawfinish for each processed PMC
1585 if (!finished_first
) {
1587 * the first create PMC might not be in the list,
1588 * if it has no pmc_ext
1590 list_unshift(interp
, finish_list
, info
->thaw_result
, enum_type_PMC
);
1592 n
= list_length(interp
, finish_list
);
1593 for (i
= 0; i
< n
; ++i
) {
1594 current
= *(PMC
**)list_get(interp
, finish_list
, i
, enum_type_PMC
);
1595 if (!PMC_IS_NULL(current
))
1596 VTABLE_thawfinish(interp
, current
, info
);
1603 =item C<static void create_image>
1605 Allocate image to some estimated size.
1612 create_image(PARROT_INTERP
, ARGIN_NULLOK(PMC
*pmc
), ARGMOD(visit_info
*info
))
1615 if (!PMC_IS_NULL(pmc
) && (VTABLE_does(interp
, pmc
,
1616 string_from_literal(interp
, "array")) ||
1617 VTABLE_does(interp
, pmc
,
1618 string_from_literal(interp
, "hash")))) {
1619 const INTVAL items
= VTABLE_elements(interp
, pmc
);
1621 * TODO check e.g. first item of aggregate and estimate size
1623 len
= items
* FREEZE_BYTES_PER_ITEM
;
1626 len
= FREEZE_BYTES_PER_ITEM
;
1628 info
->image
= string_make_empty(interp
, enum_stringrep_one
, len
);
1633 =item C<static PMC* run_thaw>
1635 Performs thawing. C<what> indicates what to be thawed.
1637 Thaw could use the C<next_for_GC> pointers as todo-list too, but this
1638 would need 2 runs through the arenas to clean the C<next_for_GC>
1641 For now it seems cheaper to use a list for remembering contained
1642 aggregates. We could of course decide dynamically, which strategy to
1643 use, e.g.: given a big image, the first thawed item is a small
1644 aggregate. This implies, it probably contains (or some big strings) more
1645 nested containers, for which the C<next_for_GC> approach could be a win.
1651 PARROT_WARN_UNUSED_RESULT
1652 PARROT_CAN_RETURN_NULL
1654 run_thaw(PARROT_INTERP
, ARGIN(STRING
* image
), visit_enum_type what
)
1658 const UINTVAL bufused
= image
->bufused
;
1662 * if we are thawing a lot of PMCs, its cheaper to do
1663 * a DOD run first and then block DOD - the limit should be
1664 * chosen so that no more then one DOD run would be triggered
1668 * md5_3.pir shows a segfault during thawing the config hash
1669 * info->thaw_ptr becomes invalid - seems that the hash got
1670 * collected under us.
1672 if (1 || (string_length(interp
, image
) > THAW_BLOCK_DOD_SIZE
)) {
1673 Parrot_do_dod_run(interp
, 1);
1674 Parrot_block_DOD(interp
);
1675 Parrot_block_GC(interp
);
1679 info
.what
= what
; /* _NORMAL or _CONSTANTS */
1680 todo_list_init(interp
, &info
);
1681 info
.visit_pmc_now
= visit_todo_list_thaw
;
1682 info
.visit_pmc_later
= add_pmc_todo_list
;
1684 info
.thaw_result
= NULL
;
1688 visit_loop_todo_list(interp
, NULL
, &info
);
1690 * thaw does "consume" the image string by incrementing strstart
1691 * and decrementing bufused - restore that
1693 LVALUE_CAST(char *, image
->strstart
) -= bufused
;
1694 image
->bufused
= bufused
;
1695 PARROT_ASSERT(image
->strstart
>= (char *)PObj_bufstart(image
));
1698 Parrot_unblock_DOD(interp
);
1699 Parrot_unblock_GC(interp
);
1701 PackFile_destroy(interp
, info
.image_io
->pf
);
1702 mem_sys_free(info
.image_io
);
1703 info
.image_io
= NULL
;
1704 return info
.thaw_result
;
1711 =head2 Public Interface
1715 =item C<STRING* Parrot_freeze_at_destruct>
1717 This function must not consume any resources (except the image itself).
1718 It uses the C<next_for_GC> pointer, so its not reentrant and must not be
1719 interrupted by a DOD run.
1726 PARROT_WARN_UNUSED_RESULT
1727 PARROT_CAN_RETURN_NULL
1729 Parrot_freeze_at_destruct(PARROT_INTERP
, ARGIN(PMC
* pmc
))
1733 Parrot_block_DOD(interp
);
1734 cleanup_next_for_GC(interp
);
1735 info
.what
= VISIT_FREEZE_AT_DESTRUCT
;
1736 info
.mark_ptr
= pmc
;
1737 info
.thaw_ptr
= NULL
;
1738 info
.visit_pmc_now
= visit_next_for_GC
;
1739 info
.visit_pmc_later
= add_pmc_next_for_GC
;
1740 create_image(interp
, pmc
, &info
);
1741 ft_init(interp
, &info
);
1743 visit_loop_next_for_GC(interp
, pmc
, &info
);
1745 Parrot_unblock_DOD(interp
);
1746 PackFile_destroy(interp
, info
.image_io
->pf
);
1747 mem_sys_free(info
.image_io
);
1753 =item C<STRING* Parrot_freeze>
1755 Freeze using either method.
1762 PARROT_WARN_UNUSED_RESULT
1763 PARROT_CAN_RETURN_NULL
1765 Parrot_freeze(PARROT_INTERP
, ARGIN(PMC
* pmc
))
1767 #if FREEZE_USE_NEXT_FOR_GC
1769 * we could do a DOD run here before, to free resources
1771 return Parrot_freeze_at_destruct(interp
, pmc
);
1774 * freeze using a todo list and seen hash
1775 * Please note that both have to be PMCs, so that trace_system_stack
1776 * can call mark on the PMCs
1780 info
.what
= VISIT_FREEZE_NORMAL
;
1781 create_image(interp
, pmc
, &info
);
1782 todo_list_init(interp
, &info
);
1784 visit_loop_todo_list(interp
, pmc
, &info
);
1786 PackFile_destroy(interp
, info
.image_io
->pf
);
1787 mem_sys_free(info
.image_io
);
1794 =item C<PMC* Parrot_thaw>
1796 Thaw a PMC, called from the C<thaw> opcode.
1803 PARROT_WARN_UNUSED_RESULT
1804 PARROT_CAN_RETURN_NULL
1806 Parrot_thaw(PARROT_INTERP
, ARGIN(STRING
* image
))
1808 return run_thaw(interp
, image
, VISIT_THAW_NORMAL
);
1813 =item C<PMC* Parrot_thaw_constants>
1815 Thaw the constants. This is used by PackFile for unpacking PMC
1823 PARROT_WARN_UNUSED_RESULT
1824 PARROT_CAN_RETURN_NULL
1826 Parrot_thaw_constants(PARROT_INTERP
, ARGIN(STRING
* image
))
1828 return run_thaw(interp
, image
, VISIT_THAW_CONSTANTS
);
1833 =item C<PMC* Parrot_clone>
1835 There are for sure shortcuts to clone faster, e.g. always thaw the image
1836 immediately or use a special callback. But for now we just thaw a frozen
1844 PARROT_WARN_UNUSED_RESULT
1845 PARROT_CAN_RETURN_NULL
1847 Parrot_clone(PARROT_INTERP
, ARGIN(PMC
* pmc
))
1849 return VTABLE_clone(interp
, pmc
);
1858 The seen-hash version for freezing might go away sometimes.
1862 Lot of discussion on p6i and F<docs/dev/pmc_freeze.pod>.
1866 Initial version by leo 2003.11.03 - 2003.11.07.
1875 * c-file-style: "parrot"
1877 * vim: expandtab shiftwidth=4: