cvsuser 05/03/30 01:07:30
Modified: imcc imcc.y pbc.c
include/parrot global.h sub.h
src global.c packfile.c packout.c
Log:
MMD 7 - pass @MULTI info on to PBC
* types in @MULTI are now stored in the Sub PMC
* cleanup: used freeze/thaw only
* cleanup: remove obsolete parrot_sub_t->packed
Revision Changes Path
1.159 +5 -5 parrot/imcc/imcc.y
Index: imcc.y
===================================================================
RCS file: /cvs/public/parrot/imcc/imcc.y,v
retrieving revision 1.158
retrieving revision 1.159
diff -u -r1.158 -r1.159
--- imcc.y 27 Mar 2005 13:14:19 -0000 1.158
+++ imcc.y 30 Mar 2005 09:07:27 -0000 1.159
@@ -616,11 +616,11 @@
;
multi_type:
- INTV { $$ = mk_const(interp, str_dup("int"), 'S'); }
- | FLOATV { $$ = mk_const(interp, str_dup("num"), 'S'); }
- | PMCV { $$ = mk_const(interp, str_dup("pmc"), 'S'); }
- | STRINGV { $$ = mk_const(interp, str_dup("string"), 'S'); }
- | '_' { $$ = mk_const(interp, str_dup("pmc"), 'S'); }
+ INTV { $$ = mk_const(interp, str_dup("INTVAL"), 'S'); }
+ | FLOATV { $$ = mk_const(interp, str_dup("FLOATVAL"), 'S'); }
+ | PMCV { $$ = mk_const(interp, str_dup("PMC"), 'S'); }
+ | STRINGV { $$ = mk_const(interp, str_dup("STRING"), 'S'); }
+ | '_' { $$ = mk_const(interp, str_dup("PMC"), 'S'); }
| IDENTIFIER { $$ = mk_const(interp, $1, 'S'); }
;
1.115 +60 -65 parrot/imcc/pbc.c
Index: pbc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pbc.c,v
retrieving revision 1.114
retrieving revision 1.115
diff -u -r1.114 -r1.115
--- pbc.c 27 Mar 2005 13:14:19 -0000 1.114
+++ pbc.c 30 Mar 2005 09:07:27 -0000 1.115
@@ -34,8 +34,6 @@
*
*/
-#define PF_USE_FREEZE_THAW 1
-
/*
* globals store the state between individual e_pbc_emit calls
*/
@@ -591,16 +589,34 @@
return k;
}
+static PMC*
+mk_multi_sig(Interp* interpreter, SymReg *r)
+{
+ INTVAL i, n;
+ STRING *sig;
+ PMC *multi_sig;
+ struct pcc_sub_t *pcc_sub;
+
+ pcc_sub = r->pcc_sub;
+ multi_sig = pmc_new(interpreter, enum_class_FixedStringArray);
+ n = pcc_sub->nmulti;
+ VTABLE_set_integer_native(interpreter, multi_sig, n);
+ for (i = 0; i < n; ++i) {
+ sig = string_from_cstring(interpreter, pcc_sub->multi[i]->name, 0);
+ VTABLE_set_string_keyed_int(interpreter, multi_sig, i, sig);
+ }
+ return multi_sig;
+}
+
static int
add_const_pmc_sub(Interp *interpreter, SymReg *r,
int offs, int end)
{
int k;
-#if ! PF_USE_FREEZE_THAW
- char buf[256];
- opcode_t *rc;
- char *class;
-#endif
+ INTVAL type;
+ PMC *name_space;
+ PMC *sub_pmc;
+ struct Parrot_sub *sub;
struct PackFile_Constant *pfc;
SymReg *ns;
int ns_const = -1;
@@ -632,70 +648,49 @@
pfc = ct->constants[k];
globals.cs->subs->pmc_const = k;
-#if PF_USE_FREEZE_THAW
- {
- INTVAL type;
- PMC *name_space;
- PMC *sub_pmc;
- struct Parrot_sub *sub;
-
- type = (r->pcc_sub->calls_a_sub & ITPCCYIELD) ?
- enum_class_Coroutine : enum_class_Sub;
- /* TODO constant - see also src/packfile.c
- */
- sub_pmc = pmc_new(interpreter, type);
- PObj_get_FLAGS(sub_pmc) |= (r->pcc_sub->pragma & SUB_FLAG_PF_MASK);
- sub = PMC_sub(sub_pmc);
- sub->name = string_from_cstring(interpreter, real_name, 0);
-
- name_space = NULL;
- if (ns_const >= 0 && ns_const < ct->const_count) {
- switch (ct->constants[ns_const]->type) {
- case PFC_KEY:
- name_space = ct->constants[ns_const]->u.key;
- break;
- case PFC_STRING:
- name_space = constant_pmc_new(interpreter,
- enum_class_String);
- PMC_str_val(name_space) =
- ct->constants[ns_const]->u.string;
- break;
- }
- }
- sub->name_space = name_space;
- sub->address = (opcode_t*)(long)offs;
- sub->end = (opcode_t*)(long)end;
-
- if (!(r->pcc_sub->pragma & SUB_FLAG_PF_ANON)) {
- Parrot_store_sub_in_namespace(interpreter, pf,
- sub_pmc, sub->name, name_space);
+
+ type = (r->pcc_sub->calls_a_sub & ITPCCYIELD) ?
+ enum_class_Coroutine : enum_class_Sub;
+ /* TODO constant - see also src/packfile.c
+ */
+ sub_pmc = pmc_new(interpreter, type);
+ PObj_get_FLAGS(sub_pmc) |= (r->pcc_sub->pragma & SUB_FLAG_PF_MASK);
+ sub = PMC_sub(sub_pmc);
+ sub->name = string_from_cstring(interpreter, real_name, 0);
+
+ name_space = NULL;
+ if (ns_const >= 0 && ns_const < ct->const_count) {
+ switch (ct->constants[ns_const]->type) {
+ case PFC_KEY:
+ name_space = ct->constants[ns_const]->u.key;
+ break;
+ case PFC_STRING:
+ name_space = constant_pmc_new(interpreter,
+ enum_class_String);
+ PMC_str_val(name_space) =
+ ct->constants[ns_const]->u.string;
+ break;
}
- pfc->type = PFC_PMC;
- pfc->u.key = sub_pmc;
- IMCC_debug(interpreter, DEBUG_PBC_CONST,
- "add_const_pmc_sub '%s' -> '%s' flags %d color %d\n",
- r->name, real_name, r->pcc_sub->pragma, k);
}
-#else
+ sub->name_space = name_space;
+ sub->address = (opcode_t*)(long)offs;
+ sub->end = (opcode_t*)(long)end;
/*
- * TODO use serialize api if that is done
- * for now:
- * "Class name offs end flags namespace#"
+ * check if it's declared multi
*/
- class = "Sub";
- if (r->pcc_sub->calls_a_sub & ITPCCYIELD)
- class = "Coroutine";
- sprintf(buf, "%s %s %d %d %d %d", class, real_name, offs, end,
- r->pcc_sub->pragma, ns_const);
- rc = PackFile_Constant_unpack_pmc(interpreter, ct, pfc, (opcode_t*)buf);
- if (!rc)
- IMCC_fatal(interpreter, 1,
- "add_const_pmc: PackFile_Constant error\n");
+ if (r->pcc_sub->nmulti)
+ sub->multi_signature = mk_multi_sig(interpreter, r);
+ else
+ sub->multi_signature = NULL;
+ if (!(r->pcc_sub->pragma & SUB_FLAG_PF_ANON)) {
+ Parrot_store_sub_in_namespace(interpreter, sub_pmc);
+ }
+ pfc->type = PFC_PMC;
+ pfc->u.key = sub_pmc;
IMCC_debug(interpreter, DEBUG_PBC_CONST,
- "add_const_pmc_sub '%s' -> '%s' flags %d color %d\n\t%s\n",
- r->name, real_name, r->pcc_sub->pragma, k, buf);
-#endif
+ "add_const_pmc_sub '%s' -> '%s' flags %d color %d\n",
+ r->name, real_name, r->pcc_sub->pragma, k);
/*
* create entry in our fixup (=symbol) table
* the offset is the index in the constant table of this Sub
1.6 +2 -3 parrot/include/parrot/global.h
Index: global.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/global.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- global.h 25 Mar 2005 13:18:12 -0000 1.5
+++ global.h 30 Mar 2005 09:07:28 -0000 1.6
@@ -1,7 +1,7 @@
/* global.h
* Copyright: 2004 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: global.h,v 1.5 2005/03/25 13:18:12 leo Exp $
+ * $Id: global.h,v 1.6 2005/03/30 09:07:28 leo Exp $
* Overview:
* Contains accessor functions for globals
* Data Structure and Algorithms:
@@ -17,8 +17,7 @@
PMC *Parrot_get_global(Interp *, STRING *class, STRING *name, void *next);
PMC *Parrot_global_namespace(Interp *, PMC *globals, STRING *ns);
void Parrot_store_global(Interp *, STRING *class, STRING *globalname, PMC
*pmc);
-void Parrot_store_sub_in_namespace(Interp*, struct PackFile *pf,
- PMC* sub_pmc, STRING* sub_name, PMC *name_space);
+void Parrot_store_sub_in_namespace(Interp*, PMC* sub_pmc);
PMC *Parrot_get_name(Interp *, STRING *name);
#endif /* PARROT_GLOBAL_H_GUARD */
1.46 +2 -5 parrot/include/parrot/sub.h
Index: sub.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/sub.h,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -r1.45 -r1.46
--- sub.h 26 Mar 2005 12:07:28 -0000 1.45
+++ sub.h 30 Mar 2005 09:07:28 -0000 1.46
@@ -1,7 +1,7 @@
/* sub.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: sub.h,v 1.45 2005/03/26 12:07:28 leo Exp $
+ * $Id: sub.h,v 1.46 2005/03/30 09:07:28 leo Exp $
* Overview:
* Data Structure and Algorithms:
* Subroutine, coroutine, closure and continuation structures
@@ -51,9 +51,7 @@
STRING *name; /* name of the sub */
PMC *name_space; /* where this Sub is in */
PMC *multi_signature; /* list of types for MMD */
- char *packed; /* to simplify packing Constant Subs
- that's a hack, until we use freeze
- */
+ /* - end common */
struct Stack_Chunk *pad_stack; /* only for closure */
} * parrot_sub_t;
@@ -69,7 +67,6 @@
STRING *name;
PMC *name_space; /* where this Sub is in */
PMC *multi_signature; /* list of types for MMD */
- char *packed;
/* - end common */
struct Parrot_Context ctx; /* XXX 2 continuations */
struct Stack_Chunk *co_control_base;
1.15 +6 -3 parrot/src/global.c
Index: global.c
===================================================================
RCS file: /cvs/public/parrot/src/global.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- global.c 26 Mar 2005 12:07:29 -0000 1.14
+++ global.c 30 Mar 2005 09:07:29 -0000 1.15
@@ -1,6 +1,6 @@
/*
Copyright: 2004 The Perl Foundation. All Rights Reserved.
-$Id: global.c,v 1.14 2005/03/26 12:07:29 leo Exp $
+$Id: global.c,v 1.15 2005/03/30 09:07:29 leo Exp $
=head1 NAME
@@ -243,12 +243,15 @@
}
void
-Parrot_store_sub_in_namespace(Parrot_Interp interpreter, struct PackFile *pf,
- PMC* sub_pmc, STRING* sub_name, PMC *name_space)
+Parrot_store_sub_in_namespace(Parrot_Interp interpreter, PMC* sub_pmc)
{
PMC *globals = interpreter->globals->stash_hash;
INTVAL type, class_type;
+ STRING* sub_name;
+ PMC *name_space;
+ sub_name = PMC_sub(sub_pmc)->name;
+ name_space = PMC_sub(sub_pmc)->name_space;
#if DEBUG_GLOBAL
fprintf(stderr, "PMC_CONST: store_global: name '%s' ns %s\n",
(char*)sub_name->strstart,
1.194 +23 -164 parrot/src/packfile.c
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/src/packfile.c,v
retrieving revision 1.193
retrieving revision 1.194
diff -u -r1.193 -r1.194
--- packfile.c 27 Mar 2005 13:14:20 -0000 1.193
+++ packfile.c 30 Mar 2005 09:07:29 -0000 1.194
@@ -2,7 +2,7 @@
Copyright (C) 2001-2002 Gregor N. Purdy. All rights reserved.
This program is free software. It is subject to the same license as
Parrot itself.
-$Id: packfile.c,v 1.193 2005/03/27 13:14:20 leo Exp $
+$Id: packfile.c,v 1.194 2005/03/30 09:07:29 leo Exp $
=head1 NAME
@@ -33,8 +33,6 @@
#define TRACE_PACKFILE 0
#define TRACE_PACKFILE_PMC 0
-#define PF_USE_FREEZE_THAW 1
-
/*
** Static functions
*/
@@ -2779,31 +2777,28 @@
{
size_t packed_size;
PMC *component;
+ STRING *image;
switch (self->type) {
- case PFC_NUMBER:
- packed_size = PF_size_number();
- break;
-
- case PFC_STRING:
- packed_size = PF_size_string(self->u.string);
- break;
+ case PFC_NUMBER:
+ packed_size = PF_size_number();
+ break;
- case PFC_KEY:
- packed_size = 1;
+ case PFC_STRING:
+ packed_size = PF_size_string(self->u.string);
+ break;
- for (component = self->u.key; component;
- component = PMC_data(component))
- packed_size += 2;
- break;
+ case PFC_KEY:
+ packed_size = 1;
- case PFC_PMC:
- component = self->u.key; /* the pmc (Sub, ...) */
+ for (component = self->u.key; component;
+ component = PMC_data(component))
+ packed_size += 2;
+ break;
-#if PF_USE_FREEZE_THAW
- {
- STRING *image;
+ case PFC_PMC:
+ component = self->u.key; /* the pmc (Sub, ...) */
/*
* TODO create either
@@ -2812,30 +2807,13 @@
*/
image = Parrot_freeze(interpreter, component);
packed_size = PF_size_string(image);
- }
-#else
- /*
- * TODO use serialize api if that is done
- */
- switch (component->vtable->base_type) {
- case enum_class_Sub:
- case enum_class_Closure:
- case enum_class_Coroutine:
- packed_size = PF_size_cstring(
- (PMC_sub(component))->packed);
- break;
- default:
- PIO_eprintf(NULL, "pack_size: Unknown PMC constant");
- return 0;
- }
-#endif
- break;
+ break;
- default:
- PIO_eprintf(NULL,
- "Constant_packed_size: Unrecognized type '%c'!\n",
- (char)self->type);
- return 0;
+ default:
+ PIO_eprintf(NULL,
+ "Constant_packed_size: Unrecognized type '%c'!\n",
+ (char)self->type);
+ return 0;
}
/* Tack on space for the initial type field */
@@ -2919,7 +2897,6 @@
*/
-#if PF_USE_FREEZE_THAW
opcode_t *
PackFile_Constant_unpack_pmc(Interp *interpreter,
struct PackFile_ConstTable *constt,
@@ -2957,15 +2934,7 @@
* XXX place this code in Sub.thaw ?
*/
if (!(PObj_get_FLAGS(pmc) & SUB_FLAG_PF_ANON)) {
- STRING *name;
- INTVAL type;
- PMC *class, *name_space;
- VTABLE *vtable;
-
- name_space = PMC_sub(pmc)->name_space;
- name = PMC_sub(pmc)->name;
- Parrot_store_sub_in_namespace(interpreter, pf,
- pmc, name, name_space);
+ Parrot_store_sub_in_namespace(interpreter, pmc);
}
}
/*
@@ -2975,116 +2944,6 @@
return cursor;
}
-#else
-
-opcode_t *
-PackFile_Constant_unpack_pmc(Interp *interpreter,
- struct PackFile_ConstTable *constt,
- struct PackFile_Constant *self,
- opcode_t *cursor)
-{
- struct PackFile *pf = constt->base.pf;
- char * pmcs;
- char class[32], name[128];
- int start, end, flag;
- int rc, pmc_num;
- PMC *sub_pmc;
- struct Parrot_sub *sub;
- struct PackFile *pf_save;
- int ns_const;
- PMC *name_space = NULL;
-
-#if TRACE_PACKFILE_PMC
- fprintf(stderr, "PMC_CONST '%s'\n", (char*)cursor);
-#endif
- pmcs = PF_fetch_cstring(pf, &cursor);
- /*
- * TODO use serialize api if that is done
- *
- * TODO first get classname, then get rest according to PMC type
- */
- rc = sscanf(pmcs, "%31s %127s %d %d %d %d",
- class, name, &start, &end, &flag, &ns_const);
- if (rc != 6) {
- fprintf(stderr, "PMC_CONST ERR RC '%d'\n", rc);
- }
-
-#if TRACE_PACKFILE_PMC
- fprintf(stderr,
- "PMC_CONST: class '%s', name '%s', start %d end %d flag %d ns
%d\n",
- class, name, start, end, flag, ns_const);
-#endif
- /*
- * make a constant subroutine object of the desired class
- */
- pmc_num = pmc_type(interpreter, string_from_cstring(interpreter, class,
0));
- /*
- * should be constant but that doesn't work, if
- * properties get attached to the sub
- */
- sub_pmc = pmc_new_noinit(interpreter, pmc_num);
- /*
- * this places the current bytecode segment in the Parrot_Sub
- * structure, which needs interpreter->code
- */
- pf_save = interpreter->code;
- interpreter->code = pf;
- VTABLE_init(interpreter, sub_pmc);
-#if 0
- PObj_report_SET(sub_pmc);
-#endif
-
- /* both start and end are relative, so are small -
- * cast for 64-bit compilers where sizeof(int)=4, sizeof(long)=8
- */
- sub = PMC_sub(sub_pmc);
- sub->address = (void *)(long) start;
- sub->end = (opcode_t*)(long)end;
- sub->packed = pmcs;
- sub->name = string_from_cstring(interpreter, name, 0);
- /*
- * if the Sub has some special pragmas in flag (LOAD, MAIN...)
- * then set private flags of that PMC
- */
- if (flag) {
- PObj_get_FLAGS(sub_pmc) |= (flag & SUB_FLAG_PF_MASK);
- }
-
- /*
- * place item in const_table
- */
- self->type = PFC_PMC;
- self->u.key = sub_pmc;
- /*
- * finally place the sub in the global stash
- */
- if (ns_const >= 0 && ns_const < constt->const_count) {
- switch (constt->constants[ns_const]->type) {
- case PFC_KEY:
- name_space = constt->constants[ns_const]->u.key;
- break;
- case PFC_STRING:
- name_space = constant_pmc_new(interpreter,
- enum_class_String);
- PMC_str_val(name_space) =
- constt->constants[ns_const]->u.string;
- break;
- }
- }
- sub->name_space = name_space;
- if (!(flag & SUB_FLAG_PF_ANON)) {
- Parrot_store_sub_in_namespace(interpreter, pf,
- sub_pmc, sub->name, name_space);
- }
-
- /*
- * restore interpreters packfile
- */
- interpreter->code = pf_save;
- return cursor;
-}
-#endif
-
/*
=item C<opcode_t *
1.40 +4 -27 parrot/src/packout.c
Index: packout.c
===================================================================
RCS file: /cvs/public/parrot/src/packout.c,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -r1.39 -r1.40
--- packout.c 27 Mar 2005 13:14:20 -0000 1.39
+++ packout.c 30 Mar 2005 09:07:29 -0000 1.40
@@ -2,7 +2,7 @@
Copyright (C) 2001-2002 Gregor N. Purdy. All rights reserved.
This program is free software. It is subject to the same license as
Parrot itself.
-$Id: packout.c,v 1.39 2005/03/27 13:14:20 leo Exp $
+$Id: packout.c,v 1.40 2005/03/30 09:07:29 leo Exp $
=head1 NAME
@@ -29,8 +29,6 @@
#define TRACE_PACKFILE_PMC 0
-#define PF_USE_FREEZE_THAW 1
-
extern struct PackFile_Directory *directory_new (Interp*, struct PackFile
*pf);
/*
@@ -229,6 +227,7 @@
struct PMC *key;
size_t i;
opcode_t type, slice_bits;
+ STRING *image;
*cursor++ = self->type;
@@ -244,30 +243,8 @@
case PFC_PMC:
key = self->u.key; /* the (Sub) PMC */
-#if PF_USE_FREEZE_THAW
- {
- STRING *image;
- image = Parrot_freeze(interpreter, key);
- cursor = PF_store_string(cursor, image);
- }
-#else
- switch (key->vtable->base_type) {
- case enum_class_Sub:
- case enum_class_Closure:
- case enum_class_Coroutine:
- {
- char *s = (PMC_sub(key))->packed;
-#if TRACE_PACKFILE_PMC
- fprintf(stderr, "PMC_packed '%s'\n", (char*) cursor);
-#endif
- cursor = PF_store_cstring(cursor, s);
- }
- break;
- default:
- internal_exception(1, "pack_size: Unknown PMC constant");
- break;
- }
-#endif
+ image = Parrot_freeze(interpreter, key);
+ cursor = PF_store_string(cursor, image);
break;
case PFC_KEY:
