cvsuser 04/06/22 03:57:27
Modified: classes default.pmc parrotinterpreter.pmc parrotio.pmc
parrotthread.pmc
config/gen core_pmcs.pl
include/parrot interpreter.h
lib/Parrot Pmc2c.pm
src dod.c inter_create.c inter_misc.c objects.c
t/pmc delegate.t io.t pmc.t
Log:
NCI and globals 2
* toss the nci method table - use the method cache instead
* which implies:
* 2 stage PMC class creation, after 1st pass globals are created
* in 2nd pass NCI methods are put into the globals
* namespace of NCI methods is the classname
* simple (one parent) inheritance of NCI meths
* adjust delegate tests to use appropriate namespace
Revision Changes Path
1.88 +8 -1 parrot/classes/default.pmc
Index: default.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/default.pmc,v
retrieving revision 1.87
retrieving revision 1.88
diff -u -w -r1.87 -r1.88
--- default.pmc 15 May 2004 22:12:01 -0000 1.87
+++ default.pmc 22 Jun 2004 10:57:09 -0000 1.88
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: default.pmc,v 1.87 2004/05/15 22:12:01 dan Exp $
+$Id: default.pmc,v 1.88 2004/06/22 10:57:09 leo Exp $
=head1 NAME
@@ -338,6 +338,9 @@
*/
PMC* find_method(STRING* method_name) {
+ return Parrot_find_method_with_cache(INTERP, SELF, method_name);
+
+#if 0
PMC *meth_hash;
int type = SELF->vtable->base_type;
@@ -348,6 +351,7 @@
if (!meth_hash)
return NULL;
return VTABLE_get_pmc_keyed_str(INTERP, meth_hash, method_name);
+#endif
}
/*
@@ -730,6 +734,8 @@
*/
INTVAL can (STRING* method) {
+ return VTABLE_find_method(interpreter, SELF, method) != NULL;
+#if 0
PMC *meth_hash;
int type = SELF->vtable->base_type;
@@ -740,6 +746,7 @@
if (!meth_hash)
return 0;
return VTABLE_exists_keyed_str(INTERP, meth_hash, method);
+#endif
}
/*
1.30 +24 -29 parrot/classes/parrotinterpreter.pmc
Index: parrotinterpreter.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotinterpreter.pmc,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -w -r1.29 -r1.30
--- parrotinterpreter.pmc 23 Apr 2004 09:20:16 -0000 1.29
+++ parrotinterpreter.pmc 22 Jun 2004 10:57:09 -0000 1.30
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: parrotinterpreter.pmc,v 1.29 2004/04/23 09:20:16 jrieks Exp $
+$Id: parrotinterpreter.pmc,v 1.30 2004/06/22 10:57:09 leo Exp $
=head1 NAME
@@ -214,9 +214,6 @@
d->flags = s->flags;
}
-void Parrot_NCI_class_init(Parrot_Interp, int);
-void Parrot_PerlHash_class_init(Parrot_Interp, int);
-void Parrot_PerlUndef_class_init(Parrot_Interp, int);
/*
@@ -265,10 +262,7 @@
void class_init () {
int typ = enum_class_ParrotInterpreter;
- /* These classes are needed now so make sure they are inited */
- Parrot_NCI_class_init(interp, enum_class_NCI);
- Parrot_PerlHash_class_init(interp, enum_class_PerlHash);
- Parrot_PerlUndef_class_init(interp, enum_class_PerlUndef);
+ if (pass) {
/*
* thread start methods for threads type 1..3
@@ -291,6 +285,7 @@
F2DPTR(pt_thread_detach), "detach", "vi");
enter_nci_method(INTERP, typ,
F2DPTR(pt_thread_kill), "kill", "vi");
+ }
}
1.24 +13 -20 parrot/classes/parrotio.pmc
Index: parrotio.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotio.pmc,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -w -r1.23 -r1.24
--- parrotio.pmc 22 Jun 2004 08:35:46 -0000 1.23
+++ parrotio.pmc 22 Jun 2004 10:57:09 -0000 1.24
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: parrotio.pmc,v 1.23 2004/06/22 08:35:46 leo Exp $
+$Id: parrotio.pmc,v 1.24 2004/06/22 10:57:09 leo Exp $
=head1 NAME
@@ -24,10 +24,6 @@
#include "../io/io_private.h"
-void Parrot_NCI_class_init(Parrot_Interp, int);
-void Parrot_PerlHash_class_init(Parrot_Interp, int);
-void Parrot_PerlUndef_class_init(Parrot_Interp, int);
-
pmclass ParrotIO need_ext {
/*
@@ -42,11 +38,7 @@
void class_init () {
- /* These classes are needed now so make sure they are inited */
- Parrot_NCI_class_init(interp, enum_class_NCI);
- Parrot_PerlHash_class_init(interp, enum_class_PerlHash);
- Parrot_PerlUndef_class_init(interp, enum_class_PerlUndef);
-
+ if (pass) {
enter_nci_method(INTERP, enum_class_ParrotIO,
F2DPTR(PIO_flush), "flush", "vIO");
enter_nci_method(INTERP, enum_class_ParrotIO,
@@ -58,6 +50,7 @@
enter_nci_method(INTERP, enum_class_ParrotIO,
F2DPTR(PIO_eof), "eof", "iIO");
}
+ }
/*
1.10 +1 -20 parrot/classes/parrotthread.pmc
Index: parrotthread.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotthread.pmc,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- parrotthread.pmc 30 Mar 2004 10:23:08 -0000 1.9
+++ parrotthread.pmc 22 Jun 2004 10:57:09 -0000 1.10
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: parrotthread.pmc,v 1.9 2004/03/30 10:23:08 leo Exp $
+$Id: parrotthread.pmc,v 1.10 2004/06/22 10:57:09 leo Exp $
=head1 NAME
@@ -44,25 +44,6 @@
/*
-=item C<void class_init()>
-
-Class initializer.
-
-=cut
-
-*/
-
- void class_init() {
- /*
- * inherit interpreter methods - needs interpreter already
- * initialized
- */
- INTERP->nci_method_table[enum_class_ParrotThread] =
- INTERP->nci_method_table[enum_class_ParrotInterpreter];
- }
-
-/*
-
=item C<void init()>
Initializes the thread.
1.15 +6 -3 parrot/config/gen/core_pmcs.pl
Index: core_pmcs.pl
===================================================================
RCS file: /cvs/public/parrot/config/gen/core_pmcs.pl,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- core_pmcs.pl 9 May 2004 14:58:06 -0000 1.14
+++ core_pmcs.pl 22 Jun 2004 10:57:13 -0000 1.15
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: core_pmcs.pl,v 1.14 2004/05/09 14:58:06 leo Exp $
+# $Id: core_pmcs.pl,v 1.15 2004/06/22 10:57:13 leo Exp $
=head1 NAME
@@ -79,7 +79,7 @@
END
- print OUT "extern void Parrot_${_}_class_init(Interp *, int);\n"
+ print OUT "extern void Parrot_${_}_class_init(Interp *, int, int);\n"
foreach (@pmcs);
print OUT <<"END";
@@ -87,12 +87,15 @@
extern void Parrot_initialize_core_pmcs(Interp *interp);
void Parrot_initialize_core_pmcs(Interp *interp)
{
+ int pass;
+ for (pass = 0; pass <= 1; ++pass) {
END
- print OUT " Parrot_${_}_class_init(interp, enum_class_${_});\n"
+ print OUT " Parrot_${_}_class_init(interp, enum_class_${_}, pass);\n"
foreach (@pmcs);
print OUT <<"END";
}
+}
static void register_pmc(Interp *interp, PMC* registry, int pmc_id)
{
1.138 +1 -3 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.137
retrieving revision 1.138
diff -u -w -r1.137 -r1.138
--- interpreter.h 19 May 2004 21:08:59 -0000 1.137
+++ interpreter.h 22 Jun 2004 10:57:16 -0000 1.138
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.h,v 1.137 2004/05/19 21:08:59 jrieks Exp $
+ * $Id: interpreter.h,v 1.138 2004/06/22 10:57:16 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -269,10 +269,8 @@
PMC* DOD_registry; /* registered PMCs added to the root set */
MMD_table *binop_mmd_funcs; /* Table of MMD functions */
UINTVAL n_binop_mmd_funcs; /* function count */
- PMC** nci_method_table; /* Method table PMC for NCI stubs per class */
struct _Caches * caches; /* s. caches.h */
STRING **const_cstring_table; /* CONST_STRING(x) items */
- size_t nci_method_table_size; /* allocated size of this table */
struct QUEUE* task_queue; /* per interpreter queue */
int sleeping; /* used during sleep in events */
struct parrot_exception_t *exceptions; /* internal exception stack */
1.28 +4 -4 parrot/lib/Parrot/Pmc2c.pm
Index: Pmc2c.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Pmc2c.pm,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -w -r1.27 -r1.28
--- Pmc2c.pm 10 Jun 2004 14:15:37 -0000 1.27
+++ Pmc2c.pm 22 Jun 2004 10:57:19 -0000 1.28
@@ -1,5 +1,5 @@
# Copyright: 2004 The Perl Foundation. All Rights Reserved.
-# $Id: Pmc2c.pm,v 1.27 2004/06/10 14:15:37 dan Exp $
+# $Id: Pmc2c.pm,v 1.28 2004/06/22 10:57:19 leo Exp $
=head1 NAME
@@ -488,7 +488,7 @@
my $classname = $self->{class};
# TODO multiple (e.g. Const subclasses)
my $call_class_init =
- "Parrot_${classname}_class_init(interpreter, type);\n";
+ "Parrot_${classname}_class_init(interpreter, type, pass);\n";
return dynext_load_code($classname, $call_class_init);
}
@@ -566,7 +566,7 @@
$class_init_code =~ s/INTERP/interp/g;
$cout .= <<"EOC";
void
-Parrot_${classname}_class_init(Parrot_Interp interp, int entry)
+Parrot_${classname}_class_init(Parrot_Interp interp, int entry, int pass)
{
struct _vtable temp_base_vtable = {
NULL, /* package */
@@ -684,7 +684,7 @@
}
# class init decl
$hout .= <<"EOC";
-void Parrot_${classname}_class_init(Parrot_Interp, int);
+void Parrot_${classname}_class_init(Parrot_Interp, int, int);
EOC
$hout;
}
1.114 +1 -7 parrot/src/dod.c
Index: dod.c
===================================================================
RCS file: /cvs/public/parrot/src/dod.c,v
retrieving revision 1.113
retrieving revision 1.114
diff -u -w -r1.113 -r1.114
--- dod.c 8 Jun 2004 20:34:35 -0000 1.113
+++ dod.c 22 Jun 2004 10:57:23 -0000 1.114
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: dod.c,v 1.113 2004/06/08 20:34:35 dan Exp $
+$Id: dod.c,v 1.114 2004/06/22 10:57:23 leo Exp $
=head1 NAME
@@ -270,12 +270,6 @@
mark_object_cache(interpreter);
mark_saved_regs(interpreter);
- /* mark NCI meth hash */
- for (i = 0; i < interpreter->nci_method_table_size; ++i) {
- PMC *h = interpreter->nci_method_table[i];
- if (h)
- pobject_lives(interpreter, (PObj*)h);
- }
/* Now mark the class hash */
pobject_lives(interpreter, (PObj *)interpreter->class_hash);
1.2 +1 -7 parrot/src/inter_create.c
Index: inter_create.c
===================================================================
RCS file: /cvs/public/parrot/src/inter_create.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- inter_create.c 5 May 2004 13:10:35 -0000 1.1
+++ inter_create.c 22 Jun 2004 10:57:23 -0000 1.2
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: inter_create.c,v 1.1 2004/05/05 13:10:35 leo Exp $
+$Id: inter_create.c,v 1.2 2004/06/22 10:57:23 leo Exp $
=head1 NAME
@@ -162,12 +162,6 @@
pmc_init_null(interpreter);
#endif
- /* Need an empty stash */
- interpreter->globals = mem_sys_allocate(sizeof(struct Stash));
- interpreter->globals->stash_hash =
- pmc_new(interpreter, enum_class_PerlHash);
- interpreter->globals->parent_stash = NULL;
-
/* context data */
/* Initialize interpreter's flags */
interpreter->ctx.warns = new_buffer_header(interpreter);
1.3 +17 -1 parrot/src/inter_misc.c
Index: inter_misc.c
===================================================================
RCS file: /cvs/public/parrot/src/inter_misc.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- inter_misc.c 7 May 2004 10:33:39 -0000 1.2
+++ inter_misc.c 22 Jun 2004 10:57:23 -0000 1.3
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: inter_misc.c,v 1.2 2004/05/07 10:33:39 leo Exp $
+$Id: inter_misc.c,v 1.3 2004/06/22 10:57:23 leo Exp $
=head1 NAME
@@ -39,6 +39,7 @@
enter_nci_method(Parrot_Interp interpreter, int type,
void *func, const char *name, const char *proto)
{
+#if 0
PMC *method, *method_table, **table;
int i;
@@ -75,6 +76,21 @@
strlen(name), "iso-8859-1",
PObj_constant_FLAG|PObj_external_FLAG),
method);
+#else
+ PMC *method;
+ method = pmc_new(interpreter, enum_class_NCI);
+ VTABLE_set_pointer_keyed_str(interpreter, method,
+ string_make(interpreter, proto, strlen(proto),
+ "iso-8859-1", PObj_constant_FLAG|PObj_external_FLAG),
+ func);
+ Parrot_store_global(interpreter,
+ Parrot_base_vtables[type]->whoami,
+ string_make(interpreter, name,
+ strlen(name), "iso-8859-1",
+ PObj_constant_FLAG|PObj_external_FLAG),
+ method);
+
+#endif
}
/*
1.94 +35 -4 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.93
retrieving revision 1.94
diff -u -w -r1.93 -r1.94
--- objects.c 19 May 2004 09:37:06 -0000 1.93
+++ objects.c 22 Jun 2004 10:57:23 -0000 1.94
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.93 2004/05/19 09:37:06 jrieks Exp $
+$Id: objects.c,v 1.94 2004/06/22 10:57:23 leo Exp $
=head1 NAME
@@ -988,12 +988,43 @@
INTVAL classcount = 0; /* The number of classes we need to
search */
- /* if its a non-classes, just return the sub */
+ /*
+ * if its a non-ParrotClass PMC, then the namespace
+ * is the PMC's class name
+ * see also enter_nci_method()
+ */
if (!PObj_is_class_TEST(class)) {
+ STRING *class_name = class->vtable->whoami;
+ STRING *isa;
+ UINTVAL start;
+ INTVAL pos;
+ method = Parrot_find_global(interpreter,
+ class_name,
+ method_name);
+ if (method)
+ return method;
+ /*
+ * now look into that PMCs parents
+ * the parent classes are in vtable->isa_str as blank
+ * terminated class names - suboptimal but good enough for now
+ */
+ start = class_name->strlen + 1;
+ for (isa = class->vtable->isa_str; ;) {
+ if (isa->strlen <= start)
+ return NULL;
+ pos = string_str_index(interpreter, isa,
+ CONST_STRING(interpreter, " "), start);
+ if (pos == -1) {
return Parrot_find_global(interpreter,
- NULL,
+ string_substr(interpreter, isa, start,
+ isa->strlen - start, NULL, 0),
method_name);
}
+ /* TODO */
+ break;
+ }
+ return NULL;
+ }
/* The order of operations:
*
1.7 +11 -1 parrot/t/pmc/delegate.t
Index: delegate.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/delegate.t,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- delegate.t 20 Apr 2004 07:44:50 -0000 1.6
+++ delegate.t 22 Jun 2004 10:57:27 -0000 1.7
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: delegate.t,v 1.6 2004/04/20 07:44:50 leo Exp $
+# $Id: delegate.t,v 1.7 2004/06/22 10:57:27 leo Exp $
=head1 NAME
@@ -25,6 +25,7 @@
new P0, .delegate
set P0, 42
end
+.namespace ["delegate"]
.pcc_sub __set_integer_native:
# need a private store to keep state - we dont have that yet
# for now check param passing
@@ -42,6 +43,7 @@
print I0
print "\n"
end
+.namespace ["delegate"]
.pcc_sub __get_integer:
set I5, 42
invoke P1
@@ -53,6 +55,7 @@
new P0, .delegate
set P0, "fortytwo"
end
+.namespace ["delegate"]
.pcc_sub __set_string_native:
print S5
print "\n"
@@ -67,6 +70,7 @@
print S0
print "\n"
end
+.namespace ["delegate"]
.pcc_sub __get_string:
set S5, "fortytwo"
invoke P1
@@ -78,6 +82,7 @@
new P0, .delegate
set P0, 47.11
end
+.namespace ["delegate"]
.pcc_sub __set_number_native:
print N5
print "\n"
@@ -92,6 +97,7 @@
print N0
print "\n"
end
+.namespace ["delegate"]
.pcc_sub __get_number:
set N5, 47.11
invoke P1
@@ -105,6 +111,7 @@
set P1, 42
assign P0, P1
end
+.namespace ["delegate"]
.pcc_sub __assign_pmc:
print P5
print "\n"
@@ -123,6 +130,7 @@
print P2 # yeah 1+1 = 3
print "\n"
end
+.namespace ["delegate"]
.pcc_sub __set_integer_native:
# cant keep state yet
# just return
@@ -152,6 +160,7 @@
print P2 # yeah 1+1 = 3
print "\n"
end
+.namespace ["delegate"]
.pcc_sub __set_integer_native:
# cant keep state yet
# just print arg and return
@@ -193,6 +202,7 @@
print "\n"
print S5
end
+.namespace ["delegate"]
.pcc_sub __set_integer_native:
# cant keep state yet
# just print arg and return
1.30 +21 -2 parrot/t/pmc/io.t
Index: io.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/io.t,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -w -r1.29 -r1.30
--- io.t 22 Jun 2004 08:36:00 -0000 1.29
+++ io.t 22 Jun 2004 10:57:27 -0000 1.30
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: io.t,v 1.29 2004/06/22 08:36:00 leo Exp $
+# $Id: io.t,v 1.30 2004/06/22 10:57:27 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 25;
+use Parrot::Test tests => 26;
use Test::More;
sub file_content_is {
@@ -343,6 +343,25 @@
ok 2
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', 'puts method - PIR');
+##PIR##
+.sub main @MAIN
+ .local string s
+ s = "ok 2\n"
+ .local pmc io
+ io = getstdout
+ $I0 = can io, "puts"
+ if $I0 goto ok1
+ print "not "
+ok1: print "ok 1\n"
+ io."puts"(s)
+.end
+
+CODE
+ok 1
+ok 2
+OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', 'callmethod puts');
getstderr P2 # the object
set S0, "puts" # method
1.85 +2 -1 parrot/t/pmc/pmc.t
Index: pmc.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/pmc.t,v
retrieving revision 1.84
retrieving revision 1.85
diff -u -w -r1.84 -r1.85
--- pmc.t 14 Mar 2004 08:49:16 -0000 1.84
+++ pmc.t 22 Jun 2004 10:57:27 -0000 1.85
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: pmc.t,v 1.84 2004/03/14 08:49:16 leo Exp $
+# $Id: pmc.t,v 1.85 2004/06/22 10:57:27 leo Exp $
=head1 NAME
@@ -1533,6 +1533,7 @@
print "\\n"
end
# delegate calls these 2 functions
+.namespace ["delegate"]
.pcc_sub __name:
set S5, "delegate"
set I0, 1
