NAME 
src/pmc_freeze.c - Freeze and thaw functionality
DESCRIPTION
Freeze uses the next_for_GC pointer() to remember seen PMCs.
PMCs are written as IDs (or tags),
which are calculated from their arena address.
This PMC number is multiplied by four.
The 2 low bits indicate a seen PMC or a PMC of the same type as the previous one respectively.
Thawing PMCs uses a list with (maximum) size of the amount of PMCs to keep track of retrieved PMCs.
The individual information of PMCs is frozen/thawed by their vtables.
To avoid recursion,
the whole functionality is driven by pmc->vtable->visit,
which is called for the first PMC initially.
Container PMCs call a "todo-callback" for all contained PMCs.
The individual action vtable (freeze/thaw) is then called for all todo-PMCs.
In the current implementation IMAGE_IO is a stand-in for some kind of serializer PMC which will eventually be written.
It associates a Parrot STRING with a vtable.
*/
#include "parrot/parrot.h"
/* default.pmc thawing of properties */ void Parrot_default_thaw(Interp* , PMC* pmc, visit_info *info);
/* XXX This should be in a header file. */ extern void Parrot_default_thawfinish(PARROT_INTERP, PMC* pmc, visit_info *info);
/* HEADERIZER HFILE: include/parrot/pmc_freeze.h */ /* HEADERIZER BEGIN: static */
static void add_pmc_next_for_GC( SHIM_INTERP, NOTNULL(PMC *pmc), NOTNULL(visit_info *info) ) __attribute__nonnull__(2) __attribute__nonnull__(3);
static void add_pmc_todo_list( PARROT_INTERP, NULLOK(PMC *pmc), NOTNULL(visit_info *info) ) __attribute__nonnull__(1) __attribute__nonnull__(3);
static void cleanup_next_for_GC( PARROT_INTERP ) __attribute__nonnull__(1);
static void cleanup_next_for_GC_pool( NOTNULL(Small_Object_Pool *pool) ) __attribute__nonnull__(1);
static void create_image( PARROT_INTERP, NULLOK(PMC *pmc), NOTNULL(visit_info *info) ) __attribute__nonnull__(1) __attribute__nonnull__(3);
PARROT_INLINE static void do_action( PARROT_INTERP, NULLOK(PMC *pmc), NOTNULL(visit_info *info), int seen, UINTVAL id ) __attribute__nonnull__(1) __attribute__nonnull__(3);
PARROT_INLINE static void do_thaw( PARROT_INTERP, NOTNULL(PMC* pmc), NOTNULL(visit_info *info) ) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3);
PARROT_INLINE static void freeze_pmc( PARROT_INTERP, NULLOK(PMC *pmc), NOTNULL(visit_info *info), int seen, UINTVAL id ) __attribute__nonnull__(1) __attribute__nonnull__(3);
static void ft_init( PARROT_INTERP, NOTNULL(visit_info *info) ) __attribute__nonnull__(1) __attribute__nonnull__(2);
static UINTVAL id_from_pmc( PARROT_INTERP, NOTNULL(PMC* pmc) ) __attribute__nonnull__(1) __attribute__nonnull__(2);
PARROT_INLINE static int next_for_GC_seen( PARROT_INTERP, NULLOK(PMC *pmc), NOTNULL(visit_info *info), NOTNULL(UINTVAL *id) ) __attribute__nonnull__(1) __attribute__nonnull__(3) __attribute__nonnull__(4);
static void op_append( PARROT_INTERP, NOTNULL(STRING *s), opcode_t b, size_t len ) __attribute__nonnull__(1) __attribute__nonnull__(2);
PARROT_INLINE static void op_check_size( PARROT_INTERP, NOTNULL(STRING *s), size_t len ) __attribute__nonnull__(1) __attribute__nonnull__(2);
static void pmc_add_ext( PARROT_INTERP, NOTNULL(PMC *pmc) ) __attribute__nonnull__(1) __attribute__nonnull__(2);
static void push_ascii_integer( PARROT_INTERP, NOTNULL(IMAGE_IO *io), INTVAL v ) __attribute__nonnull__(1) __attribute__nonnull__(2);
static void push_ascii_number( PARROT_INTERP, NOTNULL(IMAGE_IO *io), FLOATVAL v ) __attribute__nonnull__(1) __attribute__nonnull__(2);
static void push_ascii_pmc( PARROT_INTERP, NOTNULL(IMAGE_IO *io), NOTNULL(const PMC* v) ) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3);
static void push_ascii_string( PARROT_INTERP, NOTNULL(IMAGE_IO *io), NOTNULL(STRING *s) ) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3);
static void push_opcode_integer( PARROT_INTERP, NOTNULL(IMAGE_IO *io), INTVAL v ) __attribute__nonnull__(1) __attribute__nonnull__(2);
static void push_opcode_number( PARROT_INTERP, NOTNULL(IMAGE_IO *io), FLOATVAL v ) __attribute__nonnull__(1) __attribute__nonnull__(2);
static void push_opcode_pmc( PARROT_INTERP, NOTNULL(IMAGE_IO *io), NOTNULL(PMC* v) ) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3);
static void push_opcode_string( PARROT_INTERP, NOTNULL(IMAGE_IO *io), NOTNULL(STRING *v) ) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3);
PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static PMC* run_thaw( PARROT_INTERP, NOTNULL(STRING* image), visit_enum_type what ) __attribute__nonnull__(1) __attribute__nonnull__(2);
static INTVAL shift_ascii_integer( SHIM_INTERP, NOTNULL(IMAGE_IO *io) ) __attribute__nonnull__(2);
static FLOATVAL shift_ascii_number( SHIM_INTERP, NOTNULL(IMAGE_IO *io) ) __attribute__nonnull__(2);
PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static PMC* shift_ascii_pmc( SHIM_INTERP, NOTNULL(IMAGE_IO *io) ) __attribute__nonnull__(2);
PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static STRING* shift_ascii_string( PARROT_INTERP, NOTNULL(IMAGE_IO *io) ) __attribute__nonnull__(1) __attribute__nonnull__(2);
static INTVAL shift_opcode_integer( SHIM_INTERP, NOTNULL(IMAGE_IO *io) ) __attribute__nonnull__(2);
static FLOATVAL shift_opcode_number( SHIM_INTERP, NOTNULL(IMAGE_IO *io) ) __attribute__nonnull__(2);
PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static PMC* shift_opcode_pmc( PARROT_INTERP, NOTNULL(IMAGE_IO *io) ) __attribute__nonnull__(1) __attribute__nonnull__(2);
PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static STRING* shift_opcode_string( PARROT_INTERP, NOTNULL(IMAGE_IO *io) ) __attribute__nonnull__(1) __attribute__nonnull__(2);
static void str_append( PARROT_INTERP, NOTNULL(STRING *s), NOTNULL(const void *b), size_t len ) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3);
PARROT_INLINE PARROT_CANNOT_RETURN_NULL static PMC* thaw_create_pmc( PARROT_INTERP, NOTNULL(const visit_info *info), INTVAL type ) __attribute__nonnull__(1) __attribute__nonnull__(2);
PARROT_INLINE static int thaw_pmc( PARROT_INTERP, NOTNULL(visit_info *info), NOTNULL(UINTVAL *id), NOTNULL(INTVAL *type) ) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4);
static void todo_list_init( PARROT_INTERP, NOTNULL(visit_info *info) ) __attribute__nonnull__(1) __attribute__nonnull__(2);
PARROT_INLINE static int todo_list_seen( PARROT_INTERP, NOTNULL(PMC *pmc), NOTNULL(visit_info *info), NOTNULL(UINTVAL *id) ) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3) __attribute__nonnull__(4);
static void visit_loop_next_for_GC( PARROT_INTERP, NOTNULL(PMC *current), NOTNULL(visit_info *info) ) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3);
static void visit_loop_todo_list( PARROT_INTERP, NULLOK(PMC *current), NOTNULL(visit_info *info) ) __attribute__nonnull__(1) __attribute__nonnull__(3);
static void visit_next_for_GC( PARROT_INTERP, NOTNULL(PMC* pmc), NOTNULL(visit_info* info) ) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3);
static void visit_todo_list( PARROT_INTERP, NOTNULL(PMC* pmc), NOTNULL(visit_info* info) ) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3);
static void visit_todo_list_thaw( PARROT_INTERP, NOTNULL(PMC* old), NOTNULL(visit_info* info) ) __attribute__nonnull__(1) __attribute__nonnull__(2) __attribute__nonnull__(3);
/* HEADERIZER END: static */
/* * define this to 1 for testing */ #ifndef FREEZE_ASCII # define FREEZE_ASCII 0 #endif
/* * normal freeze can use next_for_GC ptrs or a seen hash */ #define FREEZE_USE_NEXT_FOR_GC 0
/* * when thawing a string longer then this size, we first do a * DOD run and then block DOD/GC - the system can't give us more headers */ #define THAW_BLOCK_DOD_SIZE 100000
/* * preallocate freeze image for aggregates with this estimation */ #if FREEZE_ASCII # define FREEZE_BYTES_PER_ITEM 17 #else # define FREEZE_BYTES_PER_ITEM 9 #endif
/*
Image Stream Functions
FUNCDOC: str_append
Appends len bytes from buffer *b to string *s.
Plain ascii - for testing only:
For speed reasons we mess around with the string buffers directly.
No encoding of strings, no transcoding.
*/
static void str_append(PARROT_INTERP, NOTNULL(STRING *s), NOTNULL(const void *b), size_t len) { const size_t used = s->bufused; const int need_free = (int)PObj_buflen(s) - used - len; /* * grow by factor 1.5 or such */ if (need_free <= 16) { size_t new_size = (size_t) (PObj_buflen(s) * 1.5); if (new_size < PObj_buflen(s) - need_free + 512) new_size = PObj_buflen(s) - need_free + 512; Parrot_reallocate_string(interp, s, new_size); PARROT_ASSERT(PObj_buflen(s) - used - len >= 15); } mem_sys_memcopy((void *)((ptrcast_t)s->strstart + used), b, len); s->bufused += len; s->strlen += len; }
/*
FUNCDOC: push_ascii_integer
Pushes an ASCII version of the integer v onto the end of the *io "stream".
*/
static void push_ascii_integer(PARROT_INTERP, NOTNULL(IMAGE_IO *io), INTVAL v) { char buffer[128]; sprintf(buffer, "%d ", (int) v); str_append(interp, io->image, buffer, strlen(buffer)); }
/*
FUNCDOC: push_ascii_number
Pushes an ASCII version of the number v onto the end of the *io "stream".
*/
static void push_ascii_number(PARROT_INTERP, NOTNULL(IMAGE_IO *io), FLOATVAL v) { char buffer[128]; sprintf(buffer, "%g ", (double) v); str_append(interp, io->image, buffer, strlen(buffer)); }
/*
FUNCDOC: push_ascii_string
Pushes an ASCII version of the string *s onto the end of the *io "stream".
For testing only - no encodings and such.
XXX no string delimiters - so no space allowed.
*/
static void push_ascii_string(PARROT_INTERP, NOTNULL(IMAGE_IO *io), NOTNULL(STRING *s)) { const UINTVAL length = string_length(interp, s); char * const buffer = (char *)malloc(4*length); char *cursor = buffer; UINTVAL idx = 0;
/* temporary--write out in UTF-8 */
for (idx = 0; idx < length; ++idx) {
*cursor++ = (unsigned char)string_index(interp, s, idx);
}
str_append(interp, io->image, buffer, cursor - buffer);
str_append(interp, io->image, " ", 1);
free(buffer);
}
/*
FUNCDOC: push_ascii_pmc
Pushes an ASCII version of the PMC *v onto the end of the *io "stream".
*/
static void push_ascii_pmc(PARROT_INTERP, NOTNULL(IMAGE_IO *io), NOTNULL(const PMC* v)) { char buffer[128]; sprintf(buffer, "%p ", (const void *)v); str_append(interp, io->image, buffer, strlen(buffer)); }
/*
FUNCDOC: shift_ascii_integer
Removes and returns an integer from the start of the *io "stream".
*/
static INTVAL shift_ascii_integer(SHIM_INTERP, NOTNULL(IMAGE_IO *io)) { char * const start = (char*)io->image->strstart; char *p = start; const INTVAL i = strtoul(p, &p, 10);
++p;
PARROT_ASSERT(p <= start + io->image->bufused);
io->image->strstart = p;
io->image->bufused -= (p - start);
PARROT_ASSERT((int)io->image->bufused >= 0);
return i;
}
/*
FUNCDOC: shift_ascii_number
Removes and returns an number from the start of the *io "stream".
*/
static FLOATVAL shift_ascii_number(SHIM_INTERP, NOTNULL(IMAGE_IO *io)) { char * const start = (char*)io->image->strstart; char *p = start; const FLOATVAL f = (FLOATVAL) strtod(p, &p);
++p;
PARROT_ASSERT(p <= start + io->image->bufused);
io->image->strstart = p;
io->image->bufused -= (p - start);
PARROT_ASSERT((int)io->image->bufused >= 0);
return f;
}
/*
FUNCDOC: shift_ascii_string
Removes and returns an string from the start of the *io "stream".
*/
PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static STRING* shift_ascii_string(PARROT_INTERP, NOTNULL(IMAGE_IO *io)) { STRING *s;
char * const start = (char*)io->image->strstart;
char *p = start;
while (*p != ' ')
++p;
++p;
PARROT_ASSERT(p <= start + io->image->bufused);
io->image->strstart = p;
io->image->bufused -= (p - start);
PARROT_ASSERT((int)io->image->bufused >= 0);
s = string_make(interp, start, p - start - 1, "iso-8859-1", 0);
/* s = string_make(interp, start, p - start - 1, "UTF-8", 0); */
return s;
}
/*
FUNCDOC: shift_ascii_pmc
Removes and returns a PMC from the start of the *io "stream".
*/
PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static PMC* shift_ascii_pmc(SHIM_INTERP, NOTNULL(IMAGE_IO *io)) { char * const start = (char*)io->image->strstart; char *p = start; const unsigned long i = strtoul(p, &p, 16); ++p; PARROT_ASSERT(p <= start + io->image->bufused); io->image->strstart = p; io->image->bufused -= (p - start); PARROT_ASSERT((int)io->image->bufused >= 0); return (PMC*) i; }
/*
opcode_t IO Functions
FUNCDOC: op_check_size
Checks the size of the "stream" buffer to see if it can accommodate len more bytes. If not then the buffer is expanded.
*/
PARROT_INLINE static void op_check_size(PARROT_INTERP, NOTNULL(STRING *s), size_t len) { const size_t used = s->bufused; const int need_free = (int)PObj_buflen(s) - used - len; /* * grow by factor 1.5 or such */ if (need_free <= 16) { size_t new_size = (size_t) (PObj_buflen(s) * 1.5); if (new_size < PObj_buflen(s) - need_free + 512) new_size = PObj_buflen(s) - need_free + 512; Parrot_reallocate_string(interp, s, new_size); PARROT_ASSERT(PObj_buflen(s) - used - len >= 15); } #ifndef DISABLE_GC_DEBUG Parrot_go_collect(interp); #endif }
/*
FUNCDOC: op_append
Appends the opcode b to the string *s.
*/
static void op_append(PARROT_INTERP, NOTNULL(STRING *s), opcode_t b, size_t len) { op_check_size(interp, s, len); *((opcode_t *)((ptrcast_t)s->strstart + s->bufused)) = b; s->bufused += len; s->strlen += len; }
/*
FUNCDOC: push_opcode_integer
Pushes the integer v onto the end of the *io "stream".
XXX assumes sizeof (opcode_t) == sizeof (INTVAL).
*/
static void push_opcode_integer(PARROT_INTERP, NOTNULL(IMAGE_IO *io), INTVAL v) { PARROT_ASSERT(sizeof (opcode_t) == sizeof (INTVAL)); op_append(interp, io->image, (opcode_t)v, sizeof (opcode_t)); }
/*
FUNCDOC: push_opcode_number
Pushes the number v onto the end of the *io "stream".
*/
static void push_opcode_number(PARROT_INTERP, NOTNULL(IMAGE_IO *io), FLOATVAL v) { const size_t len = PF_size_number() * sizeof (opcode_t); STRING * const s = io->image; const size_t used = s->bufused;
op_check_size(interp, s, len);
PF_store_number((opcode_t *)((ptrcast_t)s->strstart + used), &v);
s->bufused += len;
s->strlen += len;
}
/*
FUNCDOC: push_opcode_string
Pushes the string *v onto the end of the *io "stream".
*/
static void push_opcode_string(PARROT_INTERP, NOTNULL(IMAGE_IO *io), NOTNULL(STRING *v)) { const size_t len = PF_size_string(v) * sizeof (opcode_t); STRING * const s = io->image; const size_t used = s->bufused;
op_check_size(interp, s, len);
PF_store_string((opcode_t *)((ptrcast_t)s->strstart + used), v);
s->bufused += len;
s->strlen += len;
}
/*
FUNCDOC: push_opcode_pmc
Pushes the PMC *v onto the end of the *io "stream".
*/
static void push_opcode_pmc(PARROT_INTERP, NOTNULL(IMAGE_IO *io), NOTNULL(PMC* v)) { op_append(interp, io->image, (opcode_t)v, sizeof (opcode_t)); }
/*
FUNCDOC: shift_opcode_integer
Removes and returns an integer from the start of the *io "stream".
TODO - The shift functions aren't portable yet. We need to have a packfile header for wordsize and endianess.
*/
static INTVAL shift_opcode_integer(SHIM_INTERP, NOTNULL(IMAGE_IO *io)) { const char * const start = (char*)io->image->strstart; const INTVAL i = PF_fetch_integer(io->pf, (opcode_t**) &io->image->strstart);
io->image->bufused -= ((char*)io->image->strstart - start);
PARROT_ASSERT((int)io->image->bufused >= 0);
return i;
}
/*
FUNCDOC: shift_opcode_pmc
Removes and returns an PMC from the start of the *io "stream".
Note that this actually reads a PMC id, not a PMC.
*/
PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static PMC* shift_opcode_pmc(PARROT_INTERP, NOTNULL(IMAGE_IO *io)) { INTVAL i = shift_opcode_integer(interp, io); return (PMC *)i; }
/*
FUNCDOC: shift_opcode_number
Removes and returns an number from the start of the *io "stream".
*/
static FLOATVAL shift_opcode_number(SHIM_INTERP, NOTNULL(IMAGE_IO *io)) { const char * const start = (const char*)io->image->strstart; const FLOATVAL f = PF_fetch_number(io->pf, (opcode_t**) &io->image->strstart);
io->image->bufused -= ((char*)io->image->strstart - start);
PARROT_ASSERT((int)io->image->bufused >= 0);
return f;
}
/*
FUNCDOC: shift_opcode_string
Removes and returns a string from the start of the *io "stream".
*/
PARROT_WARN_UNUSED_RESULT PARROT_CANNOT_RETURN_NULL static STRING* shift_opcode_string(PARROT_INTERP, NOTNULL(IMAGE_IO *io)) { char * const start = (char*)io->image->strstart; STRING * const s = PF_fetch_string(interp, io->pf, (opcode_t**) &io->image->strstart);
io->image->bufused -= ((char*)io->image->strstart - start);
PARROT_ASSERT((int)io->image->bufused >= 0);
return s;
}
/*
Helper Functions
FUNCDOC: pmc_add_ext
Adds a PMC_EXT to *pmc.
*/
static void pmc_add_ext(PARROT_INTERP, NOTNULL(PMC *pmc)) { if (pmc->vtable->flags & VTABLE_PMC_NEEDS_EXT) add_pmc_ext(interp, pmc); }
/*
FUNCDOC: cleanup_next_for_GC_pool
Sets all the next_for_GC pointers to NULL.
*/
static void cleanup_next_for_GC_pool(NOTNULL(Small_Object_Pool *pool)) { Small_Object_Arena *arena;
for (arena = pool->last_Arena; arena; arena = arena->prev) {
PMC *p = (PMC *)arena->start_objects;
UINTVAL i;
for (i = 0; i < arena->used; i++) {
if (!PObj_on_free_list_TEST(p)) {
if (p->pmc_ext)
PMC_next_for_GC(p) = PMCNULL;
}
p++;
}
}
}
/*
FUNCDOC: cleanup_next_for_GC
Cleans up the next_for_GC pointers.
*/
static void cleanup_next_for_GC(PARROT_INTERP) { cleanup_next_for_GC_pool(interp->arena_base->pmc_pool); cleanup_next_for_GC_pool(interp->arena_base->constant_pmc_pool); }
/* * this function setup stuff may be replaced by a real PMC * in the future * TODO add read/write header functions, e.g. vtable->init_pmc */
#if FREEZE_ASCII static image_funcs ascii_funcs = { push_ascii_integer, push_ascii_pmc, push_ascii_string, push_ascii_number, shift_ascii_integer, shift_ascii_pmc, shift_ascii_string, shift_ascii_number }; #else static image_funcs opcode_funcs = { push_opcode_integer, push_opcode_pmc, push_opcode_string, push_opcode_number, shift_opcode_integer, shift_opcode_pmc, shift_opcode_string, shift_opcode_number }; #endif
/*
FUNCDOC: ft_init
Initializes the freeze/thaw subsystem.
*/
static void ft_init(PARROT_INTERP, NOTNULL(visit_info *info)) { STRING *s = info->image; PackFile *pf;
/* We want to store a 16-byte aligned header, but the actual
* header may be shorter. */
const unsigned int header_length = PACKFILE_HEADER_BYTES +
(PACKFILE_HEADER_BYTES % 16 ?
16 - PACKFILE_HEADER_BYTES % 16 : 0);
info->image_io = mem_allocate_typed(IMAGE_IO);
info->image_io->image = s = info->image;
#if FREEZE_ASCII
info->image_io->vtable = &ascii_funcs;
#else
info->image_io->vtable = &opcode_funcs;
#endif
pf = info->image_io->pf = PackFile_new(interp, 0);
if (info->what == VISIT_FREEZE_NORMAL ||
info->what == VISIT_FREEZE_AT_DESTRUCT) {
op_check_size(interp, s, header_length);
mem_sys_memcopy(s->strstart, pf->header, PACKFILE_HEADER_BYTES);
s->bufused += header_length;
s->strlen += header_length;
}
else {
if (string_length(interp, s) < header_length) {
real_exception(interp, NULL, E_IOError,
"bad string to thaw");
}
mem_sys_memcopy(pf->header, s->strstart, PACKFILE_HEADER_BYTES);
PackFile_assign_transforms(pf);
s->bufused -= header_length;
LVALUE_CAST(char *, s->strstart) += header_length;
}
info->last_type = -1;
info->id_list = pmc_new(interp, enum_class_Array);
info->id = 0;
info->extra_flags = EXTRA_IS_NULL;
info->container = NULL;
}
/*
FUNCDOC: todo_list_init
Initializes the *info lists.
*/
static void todo_list_init(PARROT_INTERP, NOTNULL(visit_info *info)) { info->visit_pmc_now = visit_todo_list; info->visit_pmc_later = add_pmc_todo_list; /* we must use PMCs here, so that they get marked properly */ info->todo = pmc_new(interp, enum_class_Array); info->seen = Parrot_new_INTVAL_hash(interp, 0);
ft_init(interp, info);
}
PARROT_INLINE static void freeze_pmc(PARROT_INTERP, NULLOK(PMC *pmc), NOTNULL(visit_info *info), int seen, UINTVAL id) { IMAGE_IO * const io = info->image_io; INTVAL type;
if (PMC_IS_NULL(pmc)) {
/* NULL + seen bit */
VTABLE_push_pmc(interp, io, (PMC*) 1);
return;
}
type = pmc->vtable->base_type;
if (PObj_is_object_TEST(pmc))
type = enum_class_ParrotObject;
if (seen) {
if (info->extra_flags) {
id |= 3;
VTABLE_push_pmc(interp, io, (PMC*)id);
VTABLE_push_integer(interp, io, info->extra_flags);
return;
}
id |= 1; /* mark bit 0 if this PMC is known */
}
else if (type == info->last_type) {
id |= 2; /* mark bit 1 and don't write type */
}
VTABLE_push_pmc(interp, io, (PMC*)id);
if (! (id & 3)) { /* else write type */
VTABLE_push_integer(interp, io, type);
info->last_type = type;
}
}
/*
FUNCDOC: thaw_pmc
Freeze and thaw a PMC (id).
For example, the ASCII representation of the Array
P0 = [P1=666, P2=777, P0]
may look like this:
0xdf4 30 3 0xdf8 33 666 0xdf2 777 0xdf5
where 30 is class_enum_Array, 33 is class_enum_Integer, the type of the second Integer is suppressed, the repeated P0 has bit 0 set.
*/
PARROT_INLINE static int thaw_pmc(PARROT_INTERP, NOTNULL(visit_info *info), NOTNULL(UINTVAL *id), NOTNULL(INTVAL *type)) { PMC *n; IMAGE_IO * const io = info->image_io; int seen = 0;
info->extra_flags = EXTRA_IS_NULL;
n = VTABLE_shift_pmc(interp, io);
if (((UINTVAL) n & 3) == 3) {
/* pmc has extra data */
info->extra_flags = VTABLE_shift_integer(interp, io);
}
else if ((UINTVAL) n & 1) { /* seen PMCs have bit 0 set */
seen = 1;
}
else if ((UINTVAL) n & 2) { /* prev PMC was same type */
*type = info->last_type;
}
else { /* type follows */
info->last_type = *type = VTABLE_shift_integer(interp, io);
if (*type <= 0)
real_exception(interp, NULL, 1, "Unknown PMC type to thaw %d", (int) *type);
if (*type >= interp->n_vtable_max ||
!interp->vtables[*type]) {
/* that ought to be a class */
*type = enum_class_ParrotClass;
}
}
*id = (UINTVAL) n;
return seen;
}
/*
FUNCDOC: do_action
Called from visit_next_for_GC() and visit_todo_list() to perform the action specified in info->what.
Currently only VISIT_FREEZE_NORMAL is implemented.
*/
PARROT_INLINE static void do_action(PARROT_INTERP, NULLOK(PMC *pmc), NOTNULL(visit_info *info), int seen, UINTVAL id) { switch (info->what) { case VISIT_FREEZE_AT_DESTRUCT: case VISIT_FREEZE_NORMAL: freeze_pmc(interp, pmc, info, seen, id); if (pmc) info->visit_action = pmc->vtable->freeze; break; default: real_exception(interp, NULL, 1, "Illegal action %ld", (long)info->what); } }
/*
FUNCDOC: thaw_create_pmc
Called from do_thaw() to attach the vtable etc. to *pmc.
*/
PARROT_INLINE PARROT_CANNOT_RETURN_NULL static PMC* thaw_create_pmc(PARROT_INTERP, NOTNULL(const visit_info *info), INTVAL type) { PMC *pmc; switch (info->what) { case VISIT_THAW_NORMAL: pmc = pmc_new_noinit(interp, type); break; case VISIT_THAW_CONSTANTS: pmc = constant_pmc_new_noinit(interp, type); break; default: real_exception(interp, NULL, 1, "Illegal visit_next type"); } return pmc; }
/*
FUNCDOC: do_thaw
Called by visit_todo_list_thaw() to thaw and return a PMC.
seen is false if this is the first time the PMC has been encountered.
*/
PARROT_INLINE static void do_thaw(PARROT_INTERP, NOTNULL(PMC* pmc), NOTNULL(visit_info *info)) { UINTVAL id; INTVAL type; PMC ** pos; int must_have_seen; type = 0; /* it's set below, avoid compiler warning. */ must_have_seen = thaw_pmc(interp, info, &id, &type);
id >>= 2;
if (!id) {
/* got a NULL PMC */
pmc = PMCNULL;
if (!info->thaw_result)
info->thaw_result = pmc;
else
*info->thaw_ptr = pmc;
return;
}
pos = (PMC **)list_get(interp, (List *)PMC_data(info->id_list), id, enum_type_PMC);
if (pos == (void*)-1)
pos = NULL;
else if (pos) {
pmc = *(PMC**)pos;
if (!pmc)
pos = NULL;
}
if (pos) {
if (info->extra_flags == EXTRA_IS_PROP_HASH) {
Parrot_default_thaw(interp, pmc, info);
return;
}
/* else maybe VTABLE_thaw ... but there is no other extra stuff */
#if FREEZE_USE_NEXT_FOR_GC /* * the next_for_GC method doesn't keep track of repeated scalars * and such, as these are lacking the next_for_GC pointer, so * these are just duplicated with their data. * But we track these when thawing, so that we don't create dups */ if (!must_have_seen) { /* so we must consume the bytecode */ VTABLE_thaw(interp, pmc, info); } #else PARROT_ASSERT(must_have_seen); #endif /* * that's a duplicate if (info->container) DOD_WRITE_BARRIER(interp, info->container, NULL, pmc); */ *info->thaw_ptr = pmc; return; }
PARROT_ASSERT(!must_have_seen);
pmc = thaw_create_pmc(interp, info, type);
VTABLE_thaw(interp, pmc, info);
if (info->extra_flags == EXTRA_CLASS_EXISTS) {
pmc = (PMC *)info->extra;
info->extra = NULL;
info->extra_flags = 0;
}
if (!info->thaw_result)
info->thaw_result = pmc;
else {
if (info->container) {
DOD_WRITE_BARRIER(interp, info->container, NULL, pmc);
}
*info->thaw_ptr = pmc;
}
list_assign(interp, (List *)PMC_data(info->id_list), id, pmc, enum_type_PMC);
/* remember nested aggregates depth first */
if (pmc->pmc_ext)
list_unshift(interp, (List *)PMC_data(info->todo), pmc, enum_type_PMC);
}
static UINTVAL id_from_pmc(PARROT_INTERP, NOTNULL(PMC* pmc)) { UINTVAL id = 1; /* first PMC in first arena */ Small_Object_Arena *arena; Small_Object_Pool *pool; ptrdiff_t ptr_diff;
pmc = (PMC*)PObj_to_ARENA(pmc);
pool = interp->arena_base->pmc_pool;
for (arena = pool->last_Arena; arena; arena = arena->prev) {
ptr_diff = (ptrdiff_t)pmc - (ptrdiff_t)arena->start_objects;
if (ptr_diff >= 0 && ptr_diff <
(ptrdiff_t)(arena->used * pool->object_size)) {
PARROT_ASSERT(ptr_diff % pool->object_size == 0);
id += ptr_diff / pool->object_size;
return id << 2;
}
id += arena->total_objects;
}
pool = interp->arena_base->constant_pmc_pool;
for (arena = pool->last_Arena; arena; arena = arena->prev) {
ptr_diff = (ptrdiff_t)pmc - (ptrdiff_t)arena->start_objects;
if (ptr_diff >= 0 && ptr_diff <
(ptrdiff_t)(arena->used * pool->object_size)) {
PARROT_ASSERT(ptr_diff % pool->object_size == 0);
id += ptr_diff / pool->object_size;
return id << 2;
}
id += arena->total_objects;
}
real_exception(interp, NULL, 1, "Couldn't find PMC in arenas");
return -1;
}
/*
FUNCDOC: add_pmc_next_for_GC
Remembers the PMC for later processing.
*/
static void add_pmc_next_for_GC(SHIM_INTERP, NOTNULL(PMC *pmc), NOTNULL(visit_info *info)) { if (pmc->pmc_ext) { PMC_next_for_GC(info->mark_ptr) = pmc; info->mark_ptr = PMC_next_for_GC(pmc) = pmc; } }
/*
FUNCDOC: next_for_GC_seen
Remembers next child to visit via the next_for_GC pointer generate a unique ID per PMC and freeze the ID (not the PMC address) so thaw the hash-lookup can be replaced by an array lookup then which is a lot faster.
*/
PARROT_INLINE static int next_for_GC_seen(PARROT_INTERP, NULLOK(PMC *pmc), NOTNULL(visit_info *info), NOTNULL(UINTVAL *id)) { int seen = 0; if (PMC_IS_NULL(pmc)) { *id = 0; return 1; }
/*
* we can only remember PMCs with a next_for_GC pointer
* which is located in pmc_ext
*/
if (pmc->pmc_ext) {
/* already seen? */
if (!PMC_IS_NULL(PMC_next_for_GC(pmc))) {
seen = 1;
goto skip;
}
/* put pmc at the end of the list */
PMC_next_for_GC(info->mark_ptr) = pmc;
/* make end self-referential */
info->mark_ptr = PMC_next_for_GC(pmc) = pmc;
}
skip:
*id = id_from_pmc(interp, pmc);
return seen;
}
/*
FUNCDOC: add_pmc_todo_list
Remembers the PMC to be processed later.
*/
static void add_pmc_todo_list(PARROT_INTERP, NULLOK(PMC *pmc), NOTNULL(visit_info *info)) { list_push(interp, (List *)PMC_data(info->todo), pmc, enum_type_PMC); }
/*
FUNCDOC: todo_list_seen
Returns true if the PMC was seen, otherwise it put it on the todo list, generates an ID (tag) for PMC, offset by 4 as are addresses, low bits are flags.
*/
PARROT_INLINE static int todo_list_seen(PARROT_INTERP, NOTNULL(PMC *pmc), NOTNULL(visit_info *info), NOTNULL(UINTVAL *id)) { HashBucket * const b = parrot_hash_get_bucket(interp, (Hash *)PMC_struct_val(info->seen), pmc);
if (b) {
*id = (UINTVAL) b->value;
return 1;
}
info->id += 4; /* next id to freeze */
*id = info->id;
parrot_hash_put(interp, (Hash *)PMC_struct_val(info->seen), pmc, (void*)*id);
/* remember containers */
if (pmc->pmc_ext)
list_unshift(interp, (List *)PMC_data(info->todo), pmc, enum_type_PMC);
return 0;
}
/*
FUNCDOC: visit_next_for_GC
visit_child callbacks:
Checks if the PMC was seen, generate an ID for it if not, then do the appropriate action.
*/
static void visit_next_for_GC(PARROT_INTERP, NOTNULL(PMC* pmc), NOTNULL(visit_info* info)) { UINTVAL id; const int seen = next_for_GC_seen(interp, pmc, info, &id);
real_exception(interp, NULL, 1, "todo convert to depth first");
do_action(interp, pmc, info, seen, id);
/*
* TODO probe for class methods that override the default.
* To avoid overhead, we could have an array[class_enums]
* which (after first find_method) has a bit, if a user
* callback is there.
*/
if (!seen)
(info->visit_action)(interp, pmc, info);
}
/*
FUNCDOC: visit_todo_list
Checks the seen PMC via the todo list.
*/
static void visit_todo_list(PARROT_INTERP, NOTNULL(PMC* pmc), NOTNULL(visit_info* info)) { UINTVAL id; int seen;
if (PMC_IS_NULL(pmc)) {
seen = 1;
id = 0;
}
else
seen = todo_list_seen(interp, pmc, info, &id);
do_action(interp, pmc, info, seen, id);
if (!seen)
(info->visit_action)(interp, pmc, info);
}
/*
FUNCDOC: visit_todo_list_thaw
Callback for thaw - action first.
Todo-list and seen handling is all in do_thaw().
*/
static void visit_todo_list_thaw(PARROT_INTERP, NOTNULL(PMC* old), NOTNULL(visit_info* info)) { do_thaw(interp, old, info); }
/*
FUNCDOC: visit_loop_next_for_GC
Put first item on todo list, then run as long as there are items to be done.
*/
static void visit_loop_next_for_GC(PARROT_INTERP, NOTNULL(PMC *current), NOTNULL(visit_info *info)) { visit_next_for_GC(interp, current, info); if (current->pmc_ext) { PMC *prev = NULL;
while (current != prev) {
VTABLE_visit(interp, current, info);
prev = current;
current = PMC_next_for_GC(current);
}
}
}
/*
FUNCDOC: visit_loop_todo_list
The thaw loop.
*/
static void visit_loop_todo_list(PARROT_INTERP, NULLOK(PMC *current), NOTNULL(visit_info *info)) { List * const todo = (List *)PMC_data(info->todo); PMC *finish_list_pmc; int i, n; List *finish_list = NULL; /* gcc -O3 warning */ int finished_first = 0;
const int thawing = info->what == VISIT_THAW_CONSTANTS ||
info->what == VISIT_THAW_NORMAL;
if (thawing) {
/*
* create a list that contains PMCs that need thawfinish
*/
finish_list_pmc = pmc_new(interp, enum_class_Array);
finish_list = (List *)PMC_data(finish_list_pmc);
}
(info->visit_pmc_now)(interp, current, info);
/*
* can't cache upper limit, visit may append items
*/
again:
for (; (int)list_length(interp, todo);) {
current = *(PMC**)list_shift(interp, todo, enum_type_PMC);
if (!current) {
real_exception(interp, NULL, 1,
"NULL current PMC in visit_loop_todo_list");
}
VTABLE_visit(interp, current, info);
if (thawing) {
if (current == info->thaw_result)
finished_first = 1;
if (current->vtable && current->vtable->thawfinish !=
Parrot_default_thawfinish)
list_unshift(interp, finish_list, current, enum_type_PMC);
}
}
if (thawing) {
/*
* if image isn't consumed, there are some extra data to thaw
*/
if (info->image->bufused > 0) {
(info->visit_pmc_now)(interp, NULL, info);
goto again;
}
/*
* on thawing call thawfinish for each processed PMC
*/
if (!finished_first) {
/*
* the first create PMC might not be in the list,
* if it has no pmc_ext
*/
list_unshift(interp, finish_list,
info->thaw_result, enum_type_PMC);
}
n = (int)list_length(interp, finish_list);
for (i = 0; i < n ; ++i) {
current = *(PMC**)list_get(interp, finish_list, i,
enum_type_PMC);
if (!PMC_IS_NULL(current))
VTABLE_thawfinish(interp, current, info);
}
}
}
/*
FUNCDOC: create_image
Allocate image to some estimated size.
*/
static void create_image(PARROT_INTERP, NULLOK(PMC *pmc), NOTNULL(visit_info *info)) { INTVAL len; if (!PMC_IS_NULL(pmc) && (VTABLE_does(interp, pmc, string_from_literal(interp, "array")) || VTABLE_does(interp, pmc, string_from_literal(interp, "hash")))) { const INTVAL items = VTABLE_elements(interp, pmc); /* * TODO check e.g. first item of aggregate and estimate size */ len = items * FREEZE_BYTES_PER_ITEM; } else len = FREEZE_BYTES_PER_ITEM;
info->image = string_make_empty(interp, enum_stringrep_one, len);
}
/*
FUNCDOC: run_thaw
Performs thawing. what indicates what to be thawed.
Thaw could use the next_for_GC pointers as todo-list too, but this would need 2 runs through the arenas to clean the next_for_GC pointers.
For now it seems cheaper to use a list for remembering contained aggregates. We could of course decide dynamically, which strategy to use, e.g.: given a big image, the first thawed item is a small aggregate. This implies, it probably contains (or some big strings) more nested containers, for which the next_for_GC approach could be a win.
*/
PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL static PMC* run_thaw(PARROT_INTERP, NOTNULL(STRING* image), visit_enum_type what) { visit_info info; int dod_block = 0; const UINTVAL bufused = image->bufused;
info.image = image;
/*
* if we are thawing a lot of PMCs, its cheaper to do
* a DOD run first and then block DOD - the limit should be
* chosen so that no more then one DOD run would be triggered
*
* XXX
*
* md5_3.pir shows a segfault during thawing the config hash
* info->thaw_ptr becomes invalid - seems that the hash got
* collected under us.
*/
if (1 || (string_length(interp, image) > THAW_BLOCK_DOD_SIZE)) {
Parrot_do_dod_run(interp, 1);
Parrot_block_DOD(interp);
Parrot_block_GC(interp);
dod_block = 1;
}
info.what = what; /* _NORMAL or _CONSTANTS */
todo_list_init(interp, &info);
info.visit_pmc_now = visit_todo_list_thaw;
info.visit_pmc_later = add_pmc_todo_list;
info.thaw_result = NULL;
/*
* run thaw loop
*/
visit_loop_todo_list(interp, NULL, &info);
/*
* thaw does "consume" the image string by incrementing strstart
* and decrementing bufused - restore that
*/
LVALUE_CAST(char *, image->strstart) -= bufused;
image->bufused = bufused;
PARROT_ASSERT(image->strstart >= (char *)PObj_bufstart(image));
if (dod_block) {
Parrot_unblock_DOD(interp);
Parrot_unblock_GC(interp);
}
PackFile_destroy(interp, info.image_io->pf);
mem_sys_free(info.image_io);
return info.thaw_result;
}
/*
Public Interface
FUNCDOC: Parrot_freeze_at_destruct
This function must not consume any resources (except the image itself). It uses the next_for_GC pointer, so its not reentrant and must not be interrupted by a DOD run.
*/
PARROT_API PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL STRING* Parrot_freeze_at_destruct(PARROT_INTERP, NOTNULL(PMC* pmc)) { visit_info info;
Parrot_block_DOD(interp);
cleanup_next_for_GC(interp);
info.what = VISIT_FREEZE_AT_DESTRUCT;
info.mark_ptr = pmc;
info.thaw_ptr = NULL;
info.visit_pmc_now = visit_next_for_GC;
info.visit_pmc_later = add_pmc_next_for_GC;
create_image(interp, pmc, &info);
ft_init(interp, &info);
visit_loop_next_for_GC(interp, pmc, &info);
Parrot_unblock_DOD(interp);
PackFile_destroy(interp, info.image_io->pf);
mem_sys_free(info.image_io);
return info.image;
}
/*
FUNCDOC: Parrot_freeze
Freeze using either method.
*/
PARROT_API PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL STRING* Parrot_freeze(PARROT_INTERP, NOTNULL(PMC* pmc)) { #if FREEZE_USE_NEXT_FOR_GC /* * we could do a DOD run here before, to free resources */ return Parrot_freeze_at_destruct(interp, pmc); #else /* * freeze using a todo list and seen hash * Please note that both have to be PMCs, so that trace_system_stack * can call mark on the PMCs */ visit_info info;
info.what = VISIT_FREEZE_NORMAL;
create_image(interp, pmc, &info);
todo_list_init(interp, &info);
visit_loop_todo_list(interp, pmc, &info);
PackFile_destroy(interp, info.image_io->pf);
mem_sys_free(info.image_io);
return info.image;
#endif
}
/*
FUNCDOC: Parrot_thaw
Thaw a PMC, called from the thaw opcode.
*/
PARROT_API PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL PMC* Parrot_thaw(PARROT_INTERP, NOTNULL(STRING* image)) { return run_thaw(interp, image, VISIT_THAW_NORMAL); }
/*
FUNCDOC: Parrot_thaw_constants
Thaw the constants. This is used by PackFile for unpacking PMC constants.
*/
PARROT_API PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL PMC* Parrot_thaw_constants(PARROT_INTERP, NOTNULL(STRING* image)) { return run_thaw(interp, image, VISIT_THAW_CONSTANTS); }
/*
FUNCDOC: Parrot_clone
There are for sure shortcuts to clone faster, e.g. always thaw the image immediately or use a special callback. But for now we just thaw a frozen PMC.
*/
PARROT_API PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL PMC* Parrot_clone(PARROT_INTERP, NOTNULL(PMC* pmc)) { return Parrot_thaw(interp, Parrot_freeze(interp, pmc)); }
/*
TODO
The seen-hash version for freezing might go away sometimes.
SEE ALSO
Lot of discussion on p6i and docs/dev/pmc_freeze.pod.
HISTORY
Initial version by leo 2003.11.03 - 2003.11.07.
*/
/* * Local variables: * c-file-style: "parrot" * End: * vim: expandtab shiftwidth=4: */
