cvsuser 05/03/30 04:54:38
Modified: classes fixedstringarray.pmc
src mmd.c packfile.c
t/pmc mmd.t
Log:
MMD 9 - dispatch on native arg types
* dispatch depending on argument types - no PMCs yet
* FixedStringArray.freeze . thaw
* mark all PMC constants
Revision Changes Path
1.8 +52 -1 parrot/classes/fixedstringarray.pmc
Index: fixedstringarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/fixedstringarray.pmc,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- fixedstringarray.pmc 20 Mar 2005 12:47:01 -0000 1.7
+++ fixedstringarray.pmc 30 Mar 2005 12:54:33 -0000 1.8
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: fixedstringarray.pmc,v 1.7 2005/03/20 12:47:01 bernhard Exp $
+$Id: fixedstringarray.pmc,v 1.8 2005/03/30 12:54:33 leo Exp $
=head1 NAME
@@ -470,6 +470,57 @@
DYNSELF.set_pmc_keyed_int(k, value);
}
+/*
+
+=back
+
+=head2 Freeze/thaw Interface
+
+=over 4
+
+=item C<void freeze(visit_info *info)>
+
+Used to archive the string.
+
+=cut
+
+*/
+ void freeze(visit_info *info) {
+ IMAGE_IO *io = info->image_io;
+ INTVAL i, n;
+ STRING **data;
+
+ data = (STRING**)PMC_data(SELF);
+ n = PMC_int_val(SELF);
+ io->vtable->push_integer(INTERP, io, n);
+ for (i = 0; i < n; ++i) {
+ io->vtable->push_string(INTERP, io, data[i]);
+ }
+ }
+
+/*
+
+=item C<void thaw(visit_info *info)>
+
+Used to unarchive the string.
+
+=cut
+
+*/
+ void thaw(visit_info *info) {
+ IMAGE_IO *io = info->image_io;
+ INTVAL i, n;
+ STRING **data;
+ SUPER(info);
+ if (info->extra_flags == EXTRA_IS_NULL) {
+ DYNSELF.init();
+ n = io->vtable->shift_integer(INTERP, io);
+ DYNSELF.set_integer_native(n);
+ data = PMC_data(SELF);
+ for (i = 0; i < n; ++i)
+ data[i] = io->vtable->shift_string(INTERP, io);
+ }
+ }
}
/*
1.56 +39 -3 parrot/src/mmd.c
Index: mmd.c
===================================================================
RCS file: /cvs/public/parrot/src/mmd.c,v
retrieving revision 1.55
retrieving revision 1.56
diff -u -r1.55 -r1.56
--- mmd.c 30 Mar 2005 11:12:35 -0000 1.55
+++ mmd.c 30 Mar 2005 12:54:34 -0000 1.56
@@ -1,6 +1,6 @@
/*
Copyright: 2003 The Perl Foundation. All Rights Reserved.
-$Id: mmd.c,v 1.55 2005/03/30 11:12:35 leo Exp $
+$Id: mmd.c,v 1.56 2005/03/30 12:54:34 leo Exp $
=head1 NAME
@@ -959,19 +959,42 @@
*/
+static PMC*
+mmd_cvt_to_types(Interp* interpreter, PMC *multi_sig)
+{
+ INTVAL i, n, type;
+ PMC *ar;
+ STRING *sig;
+
+ n = VTABLE_elements(interpreter, multi_sig);
+ ar = pmc_new(interpreter, enum_class_FixedIntegerArray);
+ VTABLE_set_integer_native(interpreter, ar, n);
+ for (i = 0; i < n; ++i) {
+ sig = VTABLE_get_string_keyed_int(interpreter, multi_sig, i);
+ type = pmc_type(interpreter, sig);
+ VTABLE_set_integer_keyed_int(interpreter, ar, i, type);
+ }
+ return ar;
+}
+
#define MMD_BIG_DISTANCE 0x7fff
static UINTVAL
mmd_distance(Interp *interpreter, PMC *pmc, PMC *arg_tuple)
{
PMC *multi_sig;
- INTVAL n, args, dist;
+ INTVAL i, n, args, dist;
+ INTVAL type_sig, type_call;
multi_sig = PMC_sub(pmc)->multi_signature;
if (!multi_sig) {
/* some method */
return 0;
}
+ if (multi_sig->vtable->base_type == enum_class_FixedStringArray) {
+ multi_sig = PMC_sub(pmc)->multi_signature =
+ mmd_cvt_to_types(interpreter, multi_sig);
+ }
n = VTABLE_elements(interpreter, multi_sig);
args = VTABLE_elements(interpreter, arg_tuple);
/*
@@ -984,7 +1007,20 @@
if (args > n)
dist = 1;
/*
- * TODO run through arg types */
+ * now go through args
+ */
+ for (i = 0; i < n; ++i) {
+ type_sig = VTABLE_get_integer_keyed_int(interpreter, multi_sig, i);
+ type_call = VTABLE_get_integer_keyed_int(interpreter, arg_tuple, i);
+ if (type_sig == type_call)
+ continue;
+ /* different native types are very different */
+ if (type_sig <= 0 || type_call <= 0) {
+ dist = MMD_BIG_DISTANCE;
+ break;
+ }
+ /* TODO now consider MRO of types */
+ }
return dist;
}
1.195 +9 -25 parrot/src/packfile.c
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/src/packfile.c,v
retrieving revision 1.194
retrieving revision 1.195
diff -u -r1.194 -r1.195
--- packfile.c 30 Mar 2005 09:07:29 -0000 1.194
+++ packfile.c 30 Mar 2005 12:54:36 -0000 1.195
@@ -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.194 2005/03/30 09:07:29 leo Exp $
+$Id: packfile.c,v 1.195 2005/03/30 12:54:36 leo Exp $
=head1 NAME
@@ -365,36 +365,20 @@
static void
mark_1_seg(Parrot_Interp interpreter, struct PackFile_ByteCode *cs)
{
- opcode_t i, ci;
- struct PackFile_FixupTable *ft;
+ opcode_t i;
struct PackFile_ConstTable *ct;
- PMC *sub_pmc;
- PMC *p;
- STRING *name;
+ PMC *pmc;
- ft = cs->fixups;
- if (!ft)
- return;
ct = cs->consts;
if (!ct)
return;
/* fprintf(stderr, "mark %s\n", cs->base.name); */
- for (i = 0; i < ft->fixup_count; i++) {
- switch (ft->fixups[i]->type) {
- case enum_fixup_sub:
- ci = ft->fixups[i]->offset;
- sub_pmc = ct->constants[ci]->u.key;
- pobject_lives(interpreter, (PObj *)sub_pmc);
- name = PMC_sub(sub_pmc)->name;
- if (name)
- pobject_lives(interpreter, (PObj *)name);
- p = PMC_sub(sub_pmc)->name_space;
- if (!PMC_IS_NULL(p))
- pobject_lives(interpreter, (PObj *)p);
- p = PMC_sub(sub_pmc)->multi_signature;
- if (!PMC_IS_NULL(p))
- pobject_lives(interpreter, (PObj *)p);
- break;
+ for (i = 0; i < ct->const_count; i++) {
+ switch (ct->constants[i]->type) {
+ case PFC_PMC:
+ pmc = ct->constants[i]->u.key;
+ if (pmc)
+ pobject_lives(interpreter, (PObj *)pmc);
}
}
}
1.17 +28 -2 parrot/t/pmc/mmd.t
Index: mmd.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/mmd.t,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- mmd.t 30 Mar 2005 11:12:36 -0000 1.16
+++ mmd.t 30 Mar 2005 12:54:37 -0000 1.17
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: mmd.t,v 1.16 2005/03/30 11:12:36 leo Exp $
+# $Id: mmd.t,v 1.17 2005/03/30 12:54:37 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 11;
+use Parrot::Test tests => 12;
pir_output_is(<<'CODE', <<'OUTPUT', "PASM divide");
@@ -355,6 +355,7 @@
pir_output_is(<<'CODE', <<'OUT', "MMD on argument count");
.namespace ["main"]
.sub main @MAIN
+ sweepoff # TODO
p("ok 1\n")
p("-twice", "ok 2\n")
.end
@@ -381,3 +382,28 @@
ok 2
ok 2
OUT
+
+pir_output_is(<<'CODE', <<'OUT', "MMD on mative types");
+.namespace ["main"]
+.sub main @MAIN
+ sweepoff # TODO
+ p("ok 1\n")
+ p(42)
+.end
+
+.namespace [""]
+
+.sub p @MULTI(string)
+ .param string s
+ print s
+.end
+
+.sub p @MULTI(int)
+ .param int i
+ print i
+ print "\n"
+.end
+CODE
+ok 1
+42
+OUT
