cvsuser 03/11/24 09:11:41
Modified: classes array.pmc perlhash.pmc sub.pmc
include/parrot hash.h list.h pmc_freeze.h
pf pf_items.c
src hash.c list.c pmc_freeze.c
t/pmc freeze.t
Log:
freeze-thaw-5
* string and number serialize vtables
* move array visist to list.c
* hash_visit for freeze and thaw
* PerlHash vtables and freeze/thaw test
Revision Changes Path
1.73 +4 -21 parrot/classes/array.pmc
Index: array.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/array.pmc,v
retrieving revision 1.72
retrieving revision 1.73
diff -u -w -r1.72 -r1.73
--- array.pmc 24 Nov 2003 10:25:44 -0000 1.72
+++ array.pmc 24 Nov 2003 17:11:23 -0000 1.73
@@ -1,7 +1,7 @@
/* array.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: array.pmc,v 1.72 2003/11/24 10:25:44 leo Exp $
+ * $Id: array.pmc,v 1.73 2003/11/24 17:11:23 leo Exp $
* Overview:
* These are the vtable functions for the Array base class
* Data Structure and Algorithms:
@@ -537,36 +537,19 @@
}
void visit(visit_info *info) {
- INTVAL i;
-
SUPER(info);
- /* doesn't handle sparse arrays - test only */
- for (i = 0; i < VTABLE_elements(INTERP, SELF); ++i) {
- PMC *child;
- void *ret = list_get(INTERP, (List *) PMC_data(pmc), i,
- enum_type_PMC);
- if (!ret || ret == (void *) -1) {
- ret = NULL;
- child = NULL;
- }
- else
- child = *(PMC**)ret;
- info->thaw_ptr = ret;
- (info->visit_child_function)(INTERP, child, info);
- }
+ list_visit(INTERP, (List *) PMC_data(SELF), info);
}
void freeze(visit_info *info) {
IMAGE_IO *io = info->image_io;
- io->vtable->push_integer(INTERP, io,
- VTABLE_elements(INTERP, SELF));
+ io->vtable->push_integer(INTERP, io, VTABLE_elements(INTERP, SELF));
}
void thaw(visit_info *info) {
IMAGE_IO *io = info->image_io;
SUPER(info);
- DYNSELF.set_integer_native(
- io->vtable->shift_integer(INTERP, io));
+ DYNSELF.set_integer_native(io->vtable->shift_integer(INTERP, io));
}
}
1.60 +16 -1 parrot/classes/perlhash.pmc
Index: perlhash.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlhash.pmc,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -w -r1.59 -r1.60
--- perlhash.pmc 21 Nov 2003 10:49:23 -0000 1.59
+++ perlhash.pmc 24 Nov 2003 17:11:23 -0000 1.60
@@ -1,7 +1,7 @@
/* perlhash.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: perlhash.pmc,v 1.59 2003/11/21 10:49:23 leo Exp $
+ * $Id: perlhash.pmc,v 1.60 2003/11/24 17:11:23 leo Exp $
* Overview:
* These are the vtable functions for the PerlHash base class
* Data Structure and Algorithms:
@@ -290,4 +290,19 @@
return ret;
}
+ void visit(visit_info *info) {
+ SUPER(info);
+ hash_visit(INTERP, (Hash*)PMC_ptr1v(SELF), info);
+ }
+
+ void freeze(visit_info *info) {
+ IMAGE_IO *io = info->image_io;
+ io->vtable->push_integer(INTERP, io, VTABLE_elements(INTERP, SELF));
+ }
+
+ void thaw(visit_info *info) {
+ IMAGE_IO *io = info->image_io;
+ SUPER(info);
+ info->extra = (void *)io->vtable->shift_integer(INTERP, io);
+ }
}
1.31 +83 -51 parrot/classes/sub.pmc
Index: sub.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/sub.pmc,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -w -r1.30 -r1.31
--- sub.pmc 20 Nov 2003 14:57:47 -0000 1.30
+++ sub.pmc 24 Nov 2003 17:11:23 -0000 1.31
@@ -1,7 +1,7 @@
/* Sub.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: sub.pmc,v 1.30 2003/11/20 14:57:47 leo Exp $
+ * $Id: sub.pmc,v 1.31 2003/11/24 17:11:23 leo Exp $
* Overview:
* These are the vtable functions for the Sub (subroutine) base class
* Data Structure and Algorithms:
@@ -20,8 +20,11 @@
PMC_sub(SELF) = new_sub(INTERP, sizeof(struct Parrot_Sub));
SELF->cache.struct_val = NULL;
PObj_custom_mark_destroy_SETALL(SELF);
+ PObj_get_FLAGS(SELF) &= ~PObj_private1_FLAG;
if (Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG))
- printf("Address of base segment is %p\n", ((struct Parrot_Sub
*)PMC_sub(SELF))->seg->base.pf->byte_code);
+ printf("Address of base segment is %p\n",
+ ((struct Parrot_Sub *)
+ PMC_sub(SELF))->seg->base.pf->byte_code);
}
void destroy () {
@@ -35,6 +38,7 @@
}
void set_pointer (void* value) {
+ PObj_get_FLAGS(SELF) |= PObj_private1_FLAG;
SELF->cache.struct_val = value;
}
@@ -84,15 +88,43 @@
void freeze(visit_info *info) {
IMAGE_IO *io = info->image_io;
struct Parrot_Sub * sub = (struct Parrot_Sub *)PMC_sub(SELF);
+ size_t start_offs, end_offs;
+
+ SUPER(info);
/*
* we currently need to write 3 items
- * - name of the sub's label
+ * - name of the sub's label: in properties
* - start offset in byte-code segment
* - end offset in byte-code segment
*/
+
+ /*
+ * if sub addresses are absolute, the flag is set
+ */
+ if (PObj_get_FLAGS(SELF) & PObj_private1_FLAG) {
+ start_offs = (ptrdiff_t) SELF->cache.struct_val -
+ (ptrdiff_t) sub->seg->base.pf->byte_code;
+ end_offs = (ptrdiff_t)sub->end -
+ (ptrdiff_t) sub->seg->base.pf->byte_code;
+ }
+ else {
+ start_offs = (size_t)SELF->cache.struct_val;
+ end_offs = (size_t)sub->end;
+ }
+ io->vtable->push_integer(INTERP, io, (INTVAL) start_offs);
+ io->vtable->push_integer(INTERP, io, (INTVAL) end_offs);
}
void thaw(visit_info *info) {
IMAGE_IO *io = info->image_io;
+ size_t start_offs, end_offs;
+ /*
+ * we get relative offsets
+ */
+ PObj_get_FLAGS(SELF) &= ~PObj_private1_FLAG;
+ SUPER(info);
+
+ start_offs = (size_t) io->vtable->shift_integer(INTERP, io);
+ end_offs = (size_t) io->vtable->shift_integer(INTERP, io);
}
}
1.22 +3 -2 parrot/include/parrot/hash.h
Index: hash.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/hash.h,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -w -r1.21 -r1.22
--- hash.h 21 Nov 2003 10:49:27 -0000 1.21
+++ hash.h 24 Nov 2003 17:11:26 -0000 1.22
@@ -1,7 +1,7 @@
/* hash.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: hash.h,v 1.21 2003/11/21 10:49:27 leo Exp $
+ * $Id: hash.h,v 1.22 2003/11/24 17:11:26 leo Exp $
* Overview:
* Hashtable implementation
* Data Structure and Algorithms:
@@ -86,9 +86,10 @@
HashBucket *hash_get_bucket(Interp * interpreter, Hash *hash, void *key);
void *hash_get(Interp * interpreter, Hash *hash, void *key);
INTVAL hash_exists(Interp * interpreter, Hash *hash, void *key);
-void hash_put(Interp * interpreter, Hash *hash, void *key, void *value);
+HashBucket *hash_put(Interp * interpreter, Hash *hash, void *key, void *value);
void hash_delete(Interp * interpreter, Hash *hash, void *key);
void mark_hash(Interp * interpreter, Hash *hash);
+void hash_visit(Interp * interpreter, Hash *hash, void*);
void dump_hash(Interp * interpreter, Hash *hash);
#endif
1.14 +2 -1 parrot/include/parrot/list.h
Index: list.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/list.h,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- list.h 10 Jan 2003 09:37:23 -0000 1.13
+++ list.h 24 Nov 2003 17:11:26 -0000 1.14
@@ -3,7 +3,7 @@
* Copyright: (c) 2002 Leopold Toetsch <[EMAIL PROTECTED]>
* License: Artistic/GPL, see README and LICENSES for details
* CVS Info
- * $Id: list.h,v 1.13 2003/01/10 09:37:23 leo Exp $
+ * $Id: list.h,v 1.14 2003/11/24 17:11:26 leo Exp $
* Overview:
* list aka array routines for Parrot
* s. list.c for more
@@ -77,6 +77,7 @@
List * list_new_init(Interp *interpreter, INTVAL type, PMC *init);
List * list_clone(Interp *interpreter, List *other);
void list_mark(Interp* interpreter, List* list);
+void list_visit(Interp* interpreter, List* list, void*);
INTVAL list_length(Interp* interpreter, List* list);
void list_set_length(Interp* interpreter, List* list, INTVAL len);
void list_push(Interp *interpreter, List *list, void *item, int type);
1.2 +10 -1 parrot/include/parrot/pmc_freeze.h
Index: pmc_freeze.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pmc_freeze.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- pmc_freeze.h 19 Nov 2003 15:44:04 -0000 1.1
+++ pmc_freeze.h 24 Nov 2003 17:11:26 -0000 1.2
@@ -1,7 +1,7 @@
/* pmc_freeze.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pmc_freeze.h,v 1.1 2003/11/19 15:44:04 dan Exp $
+ * $Id: pmc_freeze.h,v 1.2 2003/11/24 17:11:26 leo Exp $
* Overview:
* PMC freeze and thaw interface
* Data Structure and Algorithms:
@@ -31,14 +31,22 @@
#define IMAGE_IO struct _image_io
typedef void (*push_integer_f) (Parrot_Interp, IMAGE_IO*, INTVAL);
typedef void (*push_pmc_f) (Parrot_Interp, IMAGE_IO*, PMC*);
+typedef void (*push_string_f) (Parrot_Interp, IMAGE_IO*, STRING*);
+typedef void (*push_number_f) (Parrot_Interp, IMAGE_IO*, FLOATVAL);
typedef INTVAL (*shift_integer_f) (Parrot_Interp, IMAGE_IO*);
typedef PMC* (*shift_pmc_f) (Parrot_Interp, IMAGE_IO*);
+typedef STRING* (*shift_string_f) (Parrot_Interp, IMAGE_IO*);
+typedef FLOATVAL(*shift_number_f) (Parrot_Interp, IMAGE_IO*);
typedef struct _image_funcs {
push_integer_f push_integer;
push_pmc_f push_pmc;
+ push_string_f push_string;
+ push_number_f push_number;
shift_integer_f shift_integer;
shift_pmc_f shift_pmc;
+ shift_string_f shift_string;
+ shift_number_f shift_number;
} image_funcs;
typedef struct _image_io {
@@ -58,6 +66,7 @@
PMC* todo; /* todo list */
PMC* id_list; /* used by thaw */
UINTVAL id; /* freze ID of PMC */
+ void* extra; /* PMC specific */
IMAGE_IO *image_io;
} visit_info;
1.3 +6 -6 parrot/pf/pf_items.c
Index: pf_items.c
===================================================================
RCS file: /cvs/public/parrot/pf/pf_items.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- pf_items.c 22 Nov 2003 11:20:09 -0000 1.2
+++ pf_items.c 24 Nov 2003 17:11:32 -0000 1.3
@@ -1,7 +1,7 @@
/* pf_items.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pf_items.c,v 1.2 2003/11/22 11:20:09 leo Exp $
+ * $Id: pf_items.c,v 1.3 2003/11/24 17:11:32 leo Exp $
* Overview:
* Low level packfile functions to fetch and store Parrot data, i.e.
* INTVAL, FLOATVAL, STRING ...
@@ -184,7 +184,7 @@
opcode_t
PF_fetch_opcode(struct PackFile *pf, opcode_t **stream) {
opcode_t o;
- if (!pf->fetch_op)
+ if (!pf || !pf->fetch_op)
return *(*stream)++;
#if TRACE_PACKFILE == 2
PIO_eprintf(NULL, "PF_fetch_opcode: Reordering.\n");
@@ -231,8 +231,8 @@
INTVAL
PF_fetch_integer(struct PackFile *pf, opcode_t **stream) {
INTVAL i;
- if(pf->fetch_iv == NULL)
- return *(*stream++);
+ if (!pf || pf->fetch_iv == NULL)
+ return *(*stream)++;
i = (pf->fetch_iv)(**stream);
/* XXX assume sizeof(opcode_t) == sizeof(INTVAL) on the
* machine producing this PBC
@@ -283,7 +283,7 @@
*/
FLOATVAL f;
double d;
- if (!pf->fetch_nv) {
+ if (!pf || !pf->fetch_nv) {
#if TRACE_PACKFILE
PIO_eprintf(NULL, "PF_fetch_number: Native [%d bytes]..\n",
sizeof(FLOATVAL));
@@ -359,7 +359,7 @@
opcode_t type;
size_t size;
STRING *s;
- int wordsize = pf->header->wordsize;
+ int wordsize = pf ? pf->header->wordsize : sizeof(opcode_t);
flags = PF_fetch_opcode(pf, cursor);
/* don't let PBC mess our internals - only constant or not */
1.63 +42 -2 parrot/src/hash.c
Index: hash.c
===================================================================
RCS file: /cvs/public/parrot/src/hash.c,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -w -r1.62 -r1.63
--- hash.c 24 Nov 2003 10:25:47 -0000 1.62
+++ hash.c 24 Nov 2003 17:11:38 -0000 1.63
@@ -1,7 +1,7 @@
/* hash.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: hash.c,v 1.62 2003/11/24 10:25:47 leo Exp $
+ * $Id: hash.c,v 1.63 2003/11/24 17:11:38 leo Exp $
* Overview:
* Data Structure and Algorithms:
* A hashtable contains an array of bucket indexes. Buckets
@@ -304,6 +304,45 @@
}
}
+void
+hash_visit(Interp *interpreter, Hash *hash, void* pinfo)
+{
+ visit_info* info = (visit_info*) pinfo;
+ size_t i, n;
+ STRING *key;
+ IMAGE_IO *io = info->image_io;
+ HashBucket *b;
+ int freezing =
+ info->what == VISIT_FREEZE_NORMAL ||
+ info->what == VISIT_FREEZE_AT_DESTRUCT;
+ /*
+ * during thaw info->extra is the key/value count
+ */
+ assert(hash->entry_type == enum_hash_pmc);
+ switch (info->what) {
+ case VISIT_THAW_NORMAL:
+ case VISIT_THAW_CONSTANTS:
+ n = (size_t) info->extra;
+ for (i = 0; i < n; ++i) {
+ key = io->vtable->shift_string(interpreter, io);
+ b = hash_put(interpreter, hash, key, NULL);
+ info->thaw_ptr = (PMC**)&b->value;
+ (info->visit_child_function)(interpreter, NULL, info);
+ }
+ break;
+ default:
+ for (i = 0; i <= hash->max_chain; i++) {
+ b = lookupBucket(hash, i);
+ while (b) {
+ if (freezing)
+ io->vtable->push_string(interpreter, io, b->key);
+ (info->visit_child_function)(interpreter, b->value, info);
+ b = getBucket(hash, b->next);
+ }
+ }
+ }
+}
+
/* For a hashtable of size N, we use MAXFULL_PERCENT% of N as the number of
* buckets. This way, as soon as we run out of buckets on the free list,
* we know that it's time to resize the hashtable.
@@ -581,7 +620,7 @@
}
/* The key is *not* copied. */
-void
+HashBucket*
hash_put(Interp *interpreter, Hash *hash, void *okey, void *value)
{
BucketIndex *table;
@@ -617,6 +656,7 @@
table[hashval & hash->max_chain] = bucket_index;
}
/* dump_hash(interpreter, hash); */
+ return bucket;
}
void
1.40 +27 -1 parrot/src/list.c
Index: list.c
===================================================================
RCS file: /cvs/public/parrot/src/list.c,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -w -r1.39 -r1.40
--- list.c 23 Oct 2003 17:48:59 -0000 1.39
+++ list.c 24 Nov 2003 17:11:38 -0000 1.40
@@ -3,7 +3,7 @@
* Copyright: (c) 2002 Leopold Toetsch <[EMAIL PROTECTED]>
* License: Artistic/GPL, see README and LICENSES for details
* CVS Info
- * $Id: list.c,v 1.39 2003/10/23 17:48:59 robert Exp $
+ * $Id: list.c,v 1.40 2003/11/24 17:11:38 leo Exp $
* Overview:
* list aka array routines for Parrot
* History:
@@ -1158,6 +1158,32 @@
pobject_lives(interpreter, (PObj *)list);
if (list->user_data)
pobject_lives(interpreter, (PObj *) list->user_data);
+}
+
+void
+list_visit(Interp *interpreter, List *list, void *pinfo)
+{
+ List_chunk *chunk;
+ visit_info *info = (visit_info*) pinfo;
+ UINTVAL i, idx, n;
+ PMC **pos;
+
+ n = list_length(interpreter, list);
+ assert (list->item_type == enum_type_PMC);
+ /* TODO intlist ... */
+ for (idx = 0, chunk = list->first; chunk; chunk = chunk->next) {
+ /* TODO deleted elements */
+ if (!(chunk->flags & sparse)) {
+ for (i = 0; i < chunk->items && idx < n; i++, idx++) {
+ pos = ((PMC **)chunk->data.bufstart) + i;
+ info->thaw_ptr = pos;
+ (info->visit_child_function)(interpreter, *pos, info);
+ }
+ }
+ /*
+ * TODO handle sparse
+ */
+ }
}
INTVAL
1.8 +140 -15 parrot/src/pmc_freeze.c
Index: pmc_freeze.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc_freeze.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- pmc_freeze.c 22 Nov 2003 09:55:49 -0000 1.7
+++ pmc_freeze.c 24 Nov 2003 17:11:38 -0000 1.8
@@ -1,7 +1,7 @@
/* pmc_freeze.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pmc_freeze.c,v 1.7 2003/11/22 09:55:49 leo Exp $
+ * $Id: pmc_freeze.c,v 1.8 2003/11/24 17:11:38 leo Exp $
* Overview:
* Freeze and thaw functionality
* Data Structure and Algorithms:
@@ -73,7 +73,7 @@
str_append(Parrot_Interp interpreter, STRING *s, const void *b, size_t len)
{
size_t used = s->bufused;
- size_t need_free = s->buflen - used - len;
+ int need_free = (int)s->buflen - used - len;
/*
* grow by factor 1.5 or such
*/
@@ -98,6 +98,25 @@
}
static void
+push_ascii_number(Parrot_Interp interpreter, IMAGE_IO *io, FLOATVAL v)
+{
+ char buffer[128];
+ sprintf(buffer, "%g ", (double) v);
+ str_append(interpreter, io->image, buffer, strlen(buffer));
+}
+
+/*
+ * for testing only - no encodings and such
+ * XXX no string delimiters - so no space allowed
+ */
+static void
+push_ascii_string(Parrot_Interp interpreter, IMAGE_IO *io, STRING *s)
+{
+ str_append(interpreter, io->image, s->strstart, s->bufused);
+ str_append(interpreter, io->image, " ", 1);
+}
+
+static void
push_ascii_pmc(Parrot_Interp interpreter, IMAGE_IO *io, PMC* v)
{
char buffer[128];
@@ -121,6 +140,40 @@
return i;
}
+static FLOATVAL
+shift_ascii_number(Parrot_Interp interpreter, IMAGE_IO *io)
+{
+ char *start, *p;
+ FLOATVAL f;
+
+ p = start = (char*)io->image->strstart;
+ f = (FLOATVAL) strtod(p, &p);
+ ++p;
+ assert(p <= start + io->image->bufused);
+ io->image->strstart = p;
+ io->image->bufused -= (p - start);
+ assert((int)io->image->bufused >= 0);
+ return f;
+}
+
+static STRING*
+shift_ascii_string(Parrot_Interp interpreter, IMAGE_IO *io)
+{
+ char *start, *p;
+ STRING *s;
+
+ p = start = (char*)io->image->strstart;
+ while (*p != ' ')
+ ++p;
+ ++p;
+ assert(p <= start + io->image->bufused);
+ io->image->strstart = p;
+ io->image->bufused -= (p - start);
+ assert((int)io->image->bufused >= 0);
+ s = string_make(interpreter, start, p - start - 1, NULL, 0, NULL);
+ return s;
+}
+
static PMC*
shift_ascii_pmc(Parrot_Interp interpreter, IMAGE_IO *io)
{
@@ -141,11 +194,11 @@
* opcode_t io functions
*/
-static void
-op_append(Parrot_Interp interpreter, STRING *s, opcode_t b, size_t len)
+static PARROT_INLINE void
+op_check_size(Parrot_Interp interpreter, STRING *s, size_t len)
{
size_t used = s->bufused;
- size_t need_free = s->buflen - used - len;
+ int need_free = (int)s->buflen - used - len;
/*
* grow by factor 1.5 or such
*/
@@ -156,44 +209,106 @@
Parrot_reallocate_string(interpreter, s, new_size);
assert(s->buflen - used - len >= 15);
}
- *((opcode_t *)((ptrcast_t)s->strstart + used)) = b;
+}
+
+static void
+op_append(Parrot_Interp interpreter, STRING *s, opcode_t b, size_t len)
+{
+ op_check_size(interpreter, s, len);
+ *((opcode_t *)((ptrcast_t)s->strstart + s->bufused)) = b;
s->bufused += len;
s->strlen += len;
}
+/*
+ * XXX assumes sizeof(opcode_t) == sizeof(INTVAL)
+ */
static void
push_opcode_integer(Parrot_Interp interpreter, IMAGE_IO *io, INTVAL v)
{
+ assert(sizeof(opcode_t) == sizeof(INTVAL));
op_append(interpreter, io->image, (opcode_t)v, sizeof(opcode_t));
}
static void
+push_opcode_number(Parrot_Interp interpreter, IMAGE_IO *io, FLOATVAL v)
+{
+ size_t len = PF_size_number() * sizeof(opcode_t);
+ STRING *s = io->image;
+ size_t used = s->bufused;
+
+ op_check_size(interpreter, s, len);
+ PF_store_number( (opcode_t *)((ptrcast_t)s->strstart + used), &v);
+ s->bufused += len;
+ s->strlen += len;
+}
+
+static void
+push_opcode_string(Parrot_Interp interpreter, IMAGE_IO *io, STRING* v)
+{
+ size_t len = PF_size_string(v) * sizeof(opcode_t);
+ STRING *s = io->image;
+ size_t used = s->bufused;
+
+ op_check_size(interpreter, s, len);
+ PF_store_string( (opcode_t *)((ptrcast_t)s->strstart + used), v);
+ s->bufused += len;
+ s->strlen += len;
+}
+
+static void
push_opcode_pmc(Parrot_Interp interpreter, IMAGE_IO *io, PMC* v)
{
op_append(interpreter, io->image, (opcode_t)v, sizeof(opcode_t));
}
+/*
+ * the shift functions aren't portable yet
+ * we need to have a packfile header for wordsize and endianess
+ */
static INTVAL
shift_opcode_integer(Parrot_Interp interpreter, IMAGE_IO *io)
{
- char *start, *p;
INTVAL i;
- p = start = (char*)io->image->strstart;
- i = *((opcode_t*) p)++;
- assert(p <= start + io->image->bufused);
- io->image->strstart = p;
- io->image->bufused -= (p - start);
+ size_t len = PF_size_integer() * sizeof(opcode_t);
+ i = PF_fetch_integer(NULL, (opcode_t**) &io->image->strstart);
+ io->image->bufused -= len;
assert((int)io->image->bufused >= 0);
return i;
}
+/*
+ * shift_pmc actually reads a PMC id, not a PMC
+ */
static PMC*
shift_opcode_pmc(Parrot_Interp interpreter, IMAGE_IO *io)
{
return (PMC*) shift_opcode_integer(interpreter, io);
}
+static FLOATVAL
+shift_opcode_number(Parrot_Interp interpreter, IMAGE_IO *io)
+{
+ FLOATVAL f;
+ size_t len = PF_size_number() * sizeof(opcode_t);
+ f = PF_fetch_number(NULL, (opcode_t**) &io->image->strstart);
+ io->image->bufused -= len;
+ assert((int)io->image->bufused >= 0);
+ return f;
+}
+
+static STRING*
+shift_opcode_string(Parrot_Interp interpreter, IMAGE_IO *io)
+{
+ char *start;
+ STRING *s;
+ start = (char*)io->image->strstart;
+ s = PF_fetch_string(interpreter, NULL, (opcode_t**) &io->image->strstart);
+ io->image->bufused -= ((char*)io->image->strstart - start);
+ assert((int)io->image->bufused >= 0);
+ return s;
+}
/*
* helper functions
*/
@@ -262,14 +377,22 @@
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_pmc,
+ shift_ascii_string,
+ shift_ascii_number
};
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_pmc,
+ shift_opcode_string,
+ shift_opcode_number
};
static IMAGE_IO io_init;
@@ -344,6 +467,7 @@
IMAGE_IO *io = info->image_io;
int seen = 0;
+ info->extra = NULL;
n = io->vtable->shift_pmc(interpreter, io);
if ( (UINTVAL) n & 1) { /* seen PMCs have bit 0 set */
seen = 1;
@@ -354,7 +478,7 @@
else { /* type follows */
info->last_type = *type = io->vtable->shift_integer(interpreter, io);
if (*type <= 0 || *type >= enum_class_max)
- internal_exception(1, "Unknown PMC to thaw %d", (int) *type);
+ internal_exception(1, "Unknown PMC type to thaw %d", (int) *type);
}
*id = (UINTVAL) n & ~3;
return seen;
@@ -379,6 +503,7 @@
internal_exception(1, "Illegal action %d", info->what);
break;
}
+ info->extra = NULL;
}
PARROT_INLINE static PMC*
1.3 +31 -1 parrot/t/pmc/freeze.t
Index: freeze.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/freeze.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- freeze.t 19 Nov 2003 17:08:01 -0000 1.2
+++ freeze.t 24 Nov 2003 17:11:41 -0000 1.3
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 5;
+use Parrot::Test tests => 6;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "freeze/thaw a PerlInt");
@@ -147,6 +147,36 @@
666
777
4
+666
+777
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "freeze/thaw a PerlHash");
+ new P1, .PerlInt
+ set P1, 666
+ new P0, .PerlHash
+ set P0["k1"], P1
+ new P1, .PerlInt
+ set P1, 777
+ set P0["k2"], P1
+ freeze S0, P0
+
+ thaw P10, S0
+ typeof S10, P10
+ print S10
+ print " "
+ set I11, P10
+ print I11
+ print "\n"
+ set P12, P10["k1"]
+ print P12
+ print "\n"
+ set P12, P10["k2"]
+ print P12
+ print "\n"
+ end
+CODE
+PerlHash 2
666
777
OUTPUT
