# New Ticket Created by Jürgen Bömmels
# Please include the string: [perl #23034]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=23034 >
Hi,
During searching for memory leaks and hunting bugs only visible on
MacOS, I started a little fun project:
Implementation of methods for the ParrotIO-PMCs.
Actually this is the first pmc implementing the find_method
vtable-call.
The implementation is quite simple: find_method returns an nci-object
which calls the corresponding PIO-function. So far so simple.
But for this to work, i needed to extend the prototype-system of the
native call interface. Currently there is no way to pass a PMC down to
the native function, so I implemented a new type-letter 'P' for a PMC*
valued function (only jit/i386 and call_list.txt).
QUESTION: The calling convention for methods states that P2 should be
the object the sub was called on. The current build_call_frames pushes
the object starting at P5. How can the NCI-Interface be extended to
pass objects in P2 down to the c-functions?
The NCI-Objects are created at class_init time and stored in a
PerlHash. Therefor PerlHash and PerlUndef must get initialised in the
class_init of ParrotIO.
QUESTION: The class initialisation code seems strange to me. Will the
class initialisation be called once for each interpreter (there are
interpreter variables in there) or once for each program start (the
classes are entered in a static array Parrot_base_vtables)?
All tests passed on Linux/i386 with and without JIT.
bye
boe
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/61285/45241/900fb2/io14.diff
? make_test_imcc
Index: build_nativecall.pl
===================================================================
RCS file: /cvs/public/parrot/build_nativecall.pl,v
retrieving revision 1.14
diff -u -r1.14 build_nativecall.pl
--- build_nativecall.pl 14 Jun 2003 17:48:31 -0000 1.14
+++ build_nativecall.pl 18 Jul 2003 06:46:48 -0000
@@ -201,6 +201,9 @@
/I/ && do {
return "interpreter";
};
+ /P/ && do {my $regnum = $reg_ref->{p}++;
+ return "PMC_REG($regnum)";
+ };
}
Index: call_list.txt
===================================================================
RCS file: /cvs/public/parrot/call_list.txt,v
retrieving revision 1.8
diff -u -r1.8 call_list.txt
--- call_list.txt 18 Jan 2003 09:14:30 -0000 1.8
+++ call_list.txt 18 Jul 2003 06:46:48 -0000
@@ -13,6 +13,7 @@
# t - character string
# PMC reg stuff
# p - data pointer from PMC (on store into a new UnManagedStruct PMC)
+# P - pointer to a PMC-register
# special stuff
# I - Parrot_Interp param
#
@@ -39,3 +40,10 @@
i pppp
i ppi
p It
+# These are needed for parrotio.pmc
+i IP
+v IP
+i IPi
+i IPii
+i IPiii
+i IPt
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/interpreter.c,v
retrieving revision 1.171
diff -u -r1.171 interpreter.c
--- interpreter.c 16 Jul 2003 12:53:01 -0000 1.171
+++ interpreter.c 18 Jul 2003 06:46:49 -0000
@@ -503,6 +503,9 @@
* mem_setup_allocator() is called. */
interpreter->flags = flags;
+ /* Set up the memory allocation system */
+ mem_setup_allocator(interpreter);
+
/* PANIC will fail until this is done */
SET_NULL(interpreter->piodata);
PIO_init(interpreter);
@@ -517,9 +520,6 @@
"with DISABLE_GC_DEBUG.\n");
#endif
}
-
- /* Set up the memory allocation system */
- mem_setup_allocator(interpreter);
/* initialize classes */
Parrot_init(interpreter, 0);
Index: classes/parrotio.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotio.pmc,v
retrieving revision 1.4
diff -u -r1.4 parrotio.pmc
--- classes/parrotio.pmc 9 Jul 2003 08:33:11 -0000 1.4
+++ classes/parrotio.pmc 18 Jul 2003 06:46:50 -0000
@@ -13,12 +13,62 @@
#include "parrot/parrot.h"
+static void
+enter_nci_method(struct Parrot_Interp *interpreter, PMC *method_table,
+ void *func, const char *name, const char *proto)
+{
+ PMC *method;
+
+ method = pmc_new(interpreter, enum_class_NCI);
+ VTABLE_set_string_keyed(interpreter, method, func,
+ string_make(interpreter, proto, strlen(proto),
+ NULL, 0, NULL));
+ VTABLE_set_pmc_keyed(interpreter, method_table,
+ key_new_string(interpreter,
+ string_make(interpreter, name,
+ strlen(name), NULL,
+ 0, NULL)),
+ method);
+}
+
pmclass ParrotIO {
STRING* name () {
return whoami;
}
+ void class_init () {
+ PMC *method_table;;
+
+ /* 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);
+
+ method_table = pmc_new(INTERP, enum_class_PerlHash);
+
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_close), "close", "iIP");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_flush), "flush", "vIP");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_read), "read", "iIPii");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_write), "write", "iIPii");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_setbuf), "setbuf", "iIPi");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_setlinebuf), "setlinebuf", "iIP");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_puts), "puts", "iIPt");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_seek), "seek", "iIPiii");
+ enter_nci_method(INTERP, method_table,
+ F2DPTR(PIO_eof), "eof", "iIP");
+
+ ((ParrotIOData *)(INTERP->piodata))->method_table = method_table;
+ }
+
void init () {
PObj_active_destroy_SET(SELF);
PObj_needs_early_DOD_SET(SELF);
@@ -42,5 +92,12 @@
INTVAL get_bool() {
return !PIO_eof(INTERP, SELF);
+ }
+
+ PMC* find_method (STRING* name) {
+ PMC* method_table = ((ParrotIOData *)(INTERP->piodata))->method_table;
+
+ return VTABLE_get_pmc_keyed(INTERP, method_table,
+ key_new_string(INTERP, name));
}
}
Index: include/parrot/io.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/io.h,v
retrieving revision 1.34
diff -u -r1.34 io.h
--- include/parrot/io.h 3 Jul 2003 10:03:57 -0000 1.34
+++ include/parrot/io.h 18 Jul 2003 06:46:52 -0000
@@ -166,6 +166,7 @@
struct _ParrotIOData {
ParrotIOTable table;
ParrotIOLayer *default_stack;
+ PMC *method_table;
};
Index: jit/i386/jit_emit.h
===================================================================
RCS file: /cvs/public/parrot/jit/i386/jit_emit.h,v
retrieving revision 1.68
diff -u -r1.68 jit_emit.h
--- jit/i386/jit_emit.h 9 Jul 2003 10:31:55 -0000 1.68
+++ jit/i386/jit_emit.h 18 Jul 2003 06:46:54 -0000
@@ -2484,7 +2484,7 @@
const char *typs[] = {
"lisc", /* I */
"t", /* S */
- "p", /* P */
+ "pP", /* P */
"fd" /* N */
};
int first_reg = 5;
@@ -2589,6 +2589,11 @@
emitm_movl_m_r(pc, emit_EAX, emit_EAX, 0, 1,
offsetof(struct PMC_EXT, data));
#endif
+ emitm_pushl_r(pc, emit_EAX);
+ break;
+ case 'P': /* push PMC * */
+ jit_emit_mov_rm_i(pc, emit_EAX,
+ &PMC_REG(count_regs(sig, signature->strstart)));
emitm_pushl_r(pc, emit_EAX);
break;
case 'v':
Index: t/pmc/io.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/io.t,v
retrieving revision 1.5
diff -u -r1.5 io.t
--- t/pmc/io.t 9 Jul 2003 19:27:05 -0000 1.5
+++ t/pmc/io.t 18 Jul 2003 06:46:55 -0000
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 17;
+use Parrot::Test tests => 18;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "open/close");
@@ -256,4 +256,14 @@
1.000000
foo
This is a test
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', 'puts method');
+ set S5, "ok\n"
+ getstdout P5
+ find_method P0, P5, "puts"
+ invoke
+ end
+CODE
+ok
OUTPUT
--
Juergen Boemmels [EMAIL PROTECTED]
Fachbereich Physik Tel: ++49-(0)631-205-2817
Universitaet Kaiserslautern Fax: ++49-(0)631-205-3906
PGP Key fingerprint = 9F 56 54 3D 45 C1 32 6F 23 F6 C7 2F 85 93 DD 47
