# New Ticket Created by Leopold Toetsch
# Please include the string: [perl #23231]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=23231 >
Attached is (if it wasn't stripped again ;-) a patch, that allows using
dynamic PMCs.
- pmc2c.pl has a new class flag "dynpmc"
- these appends a global init function to the class file
- this init function is called twice for setup & init
- it may register as many PMCs as it wants
- example: dynclasses/dynfoo.pasm, foo.pmc
TODOs
- Parrot_base_vtables is still a static array, this should better be
allocated, but existing vtables shouldn't move
- Communicating the state between parrot and the shared lib is ugly.
Maybe passing real callback functions would be better.
Or don't have any globals at all: Instead put globals into the first
interpreter, and let other interpreters just point there.
Comments welcome & have fun,
leo
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/62310/45923/730b81/dyn_PMCs.patch
--- parrot/MANIFEST Tue Aug 5 10:56:23 2003
+++ parrot-leo/MANIFEST Wed Aug 6 17:41:41 2003
@@ -203,7 +203,9 @@
dotgnu.ops []
dynclasses/Makefile [devel]
dynclasses/README [devel]
+dynclasses/dynfoo.pasm [devel]
dynclasses/foo.pmc [devel]
+dynext.c []
editor/pasm.el [devel]
editor/pasm.vim [devel]
embed.c []
@@ -1289,6 +1291,7 @@
include/parrot/datatypes.h [devel]include
include/parrot/debug.h [devel]include
include/parrot/dod.h [devel]include
+include/parrot/dynext.h [devel]include
include/parrot/embed.h [devel]include
include/parrot/encoding.h [devel]include
include/parrot/enums.h [devel]include
--- parrot/classes/pmc2c.pl Thu Jul 31 21:07:07 2003
+++ parrot-leo/classes/pmc2c.pl Wed Aug 6 17:40:06 2003
@@ -59,7 +59,7 @@
=item 2.
-pmclass PMCNAME [extends PMCNAME] [abstract] [extension] [noinit] {
+pmclass PMCNAME [extends PMCNAME] [abstract] [dynpmc] [noinit] {
=item 3.
@@ -587,12 +587,66 @@
$methodlist
};
+ if (!whoami)
whoami = string_make(interp,
"$classname", @{[length($classname)]}, 0, PObj_constant_FLAG, 0);
Parrot_base_vtables[entry] = temp_base_vtable;
$class_init_code
}
+EOC
+ }
+
+ if (exists $flags{dynpmc}) {
+ my $lc_classname = lc $classname;
+ $OUT .= <<EOC;
+/*
+ * This init function will be called to setup/init/whatever
+ * is needed to get this extension running
+ */
+#include "parrot/dynext.h"
+
+int Parrot_dynext_${lc_classname}_init(Interp *interp, int action, void *param)
+{
+ dynext_pmc_info_t *info = (dynext_pmc_info_t*) param;
+ int ok;
+ int i;
+
+ /*
+ * These are globals. As the shared lib is linked against libparrot
+ * the shared libs has its own globals, so we must initialize these
+ * yep, that's ugly
+ */
+ for (i = 1; i < *(info->class_max); i++)
+ Parrot_base_vtables[i] = info->base_vtable[i];
+ enum_class_max = *info->class_max;
+ switch (action) {
+ case DYNEXT_SETUP_PMC:
+ string_init(); /* default type/encoding */
+ /* one time setup code */
+
+ /* for all PMCs we want to register:
+ */
+ if (!whoami)
+ whoami = string_make(interp,
+ "$classname", @{[length($classname)]}, 0,
+ PObj_constant_FLAG, 0);
+ info->class_name = whoami;
+ ok = Parrot_dynext_setup_pmc(interp, info);
+ $initname(interp, info->class_enum);
+ /* set our class enum */
+ Parrot_base_vtables[info->class_enum].base_type = info->class_enum;
+ /* copy vtable back to caller */
+ info->base_vtable[info->class_enum] =
+ Parrot_base_vtables[info->class_enum];
+ return ok;
+ case DYNEXT_INIT_PMC:
+ /* per interpreter/thread init code */
+ return Parrot_dynext_init_pmc(interp, info);
+ }
+ return DYNEXT_INIT_ERR; /* error, unsupported action */
+}
+
EOC
}
--- parrot/config/gen/core_pmcs.pl Thu Jul 3 12:04:47 2003
+++ parrot-leo/config/gen/core_pmcs.pl Wed Aug 6 10:58:29 2003
@@ -33,7 +33,7 @@
print OUT " enum_class_default,\n";
print OUT " enum_class_$_,\n" foreach (@pmcs);
print OUT <<"END";
- enum_class_max
+ enum_class_core_max
};
/* &end_gen */
--- parrot/config/gen/makefiles/root.in Mon Jul 28 00:35:45 2003
+++ parrot-leo/config/gen/makefiles/root.in Wed Aug 6 12:05:34 2003
@@ -100,7 +100,9 @@
$(INC)/regfuncs.h $(INC)/string_funcs.h $(INC)/encoding.h \
$(INC)/chartype.h $(INC)/oplib.h $(INC)/sub.h $(INC)/unicode.h \
$(INC)/perltypes.h $(INC)/exit.h $(INC)/nci.h $(INC)/pobj.h \
- $(INC)/thread.h $(INC)/tsq.h $(INC)/longopt.h $(INC)/objects.h
+ $(INC)/thread.h $(INC)/tsq.h $(INC)/longopt.h $(INC)/objects.h \
+ $(INC)/dynext.h
+
ALL_H_FILES = $(GENERAL_H_FILES)
@@ -128,7 +130,8 @@
packout$(O) byteorder$(O) debug$(O) smallobject$(O) \
headers$(O) dod$(O) method_util$(O) exit$(O) \
misc$(O) spf_render$(O) spf_vtable$(O) datatypes$(O) fingerprint$(O) \
- nci$(O) cpu_dep$(O) ${asmfun_o} tsq$(O) longopt$(O) events$(O)
+ nci$(O) cpu_dep$(O) ${asmfun_o} tsq$(O) longopt$(O) events$(O) \
+ dynext$(O)
O_FILES = $(INTERP_O_FILES) $(IO_O_FILES) $(CLASS_O_FILES) \
$(ENCODING_O_FILES) $(CHARTYPE_O_FILES)
@@ -417,6 +420,8 @@
chartype/usascii$(O) : $(GENERAL_H_FILES)
chartype/unicode$(O) : $(GENERAL_H_FILES)
+
+dynext$(O) : $(GENERAL_H_FILES)
exceptions$(O) : $(GENERAL_H_FILES)
--- parrot/core.ops Mon Jul 28 15:38:19 2003
+++ parrot-leo/core.ops Wed Aug 6 13:54:19 2003
@@ -2,6 +2,7 @@
** core.ops
*/
+#include "parrot/dynext.h"
VERSION = PARROT_VERSION;
=head1 NAME
@@ -899,10 +900,11 @@
########################################
-=item B<loadext>(in STR, in STR)
+=item B<load_pmc>(in STR, in PMC)
-Load in an extension. $1 is the name of the extension library, $2 is the
-initialization routine for it.
+Load in a pmc extension library. $1 is the name of the extension library,
+$2 is an initializer that may have additional information for the PMCs
+in that extension.
=item B<loadlib>(out PMC, in STR)
@@ -934,22 +936,10 @@
=cut
-inline op loadext(in STR, in STR) {
- void * p;
- void (*func)(void);
- string_to_cstring(interpreter, ($2));
- string_to_cstring(interpreter, ($1));
- p = Parrot_dlopen($1->strstart);
- if(p == NULL) {
- const char * err = Parrot_dlerror();
- fprintf(stderr, "%s\n", err);
- PANIC("Failed to load native library");
- }
- func = D2FPTR(Parrot_dlsym(p, $2->strstart));
- if (NULL == func) {
- PANIC("Failed to find symbol in native library");
- }
- (*func)();
+inline op load_pmc(in STR, in PMC) {
+ int err = Parrot_load_pmc(interpreter, $1, $2);
+ if (err)
+ internal_exception(-1, "Failed to load dynamic PMC extension");
goto NEXT();
}
--- parrot/dod.c Wed Jul 30 17:00:29 2003
+++ parrot-leo/dod.c Wed Aug 6 11:06:38 2003
@@ -293,7 +293,7 @@
pobject_lives(interpreter, (Buffer *)interpreter->current_file);
if (interpreter->current_package)
pobject_lives(interpreter, (Buffer *)interpreter->current_package);
- for (i = 1; i < enum_class_max; i++)
+ for (i = 1; i < (UINTVAL)enum_class_max; i++)
pobject_lives(interpreter, (Buffer *)Parrot_base_vtables[i].name
(interpreter, 0));
--- parrot/dynclasses/Makefile Thu Jul 31 21:06:53 2003
+++ parrot-leo/dynclasses/Makefile Wed Aug 6 12:57:29 2003
@@ -8,7 +8,8 @@
cd .. ; perl classes/pmc2c.pl dynclasses/foo.pmc
foo_pmc.so : foo.c
- cc --shared -g -o foo_pmc.so -I../include -I../classes foo.c
+ cc -shared -g -o foo_pmc.so \
+ -I../include -I../classes -L../blib/lib -lparrot foo.c
clean :
rm -f foo.c foo.h foo_pmc.so
--- parrot/dynclasses/README Thu Jul 31 21:06:53 2003
+++ parrot-leo/dynclasses/README Wed Aug 6 17:37:14 2003
@@ -6,4 +6,18 @@
2) edit Makefile (or much better provide a script that generates
a platform independent Makefile ;-)
+$ make -s
+$ make shared
$ make -C dynclasses
+
+$ ./parrot dynclasses/dynfoo.pasm
+ok 1
+34
+ok 2
+42
+
+3) If anything changes inside parrot don't forget:
+
+$ make -C dynclasses clean
+
+and repeat above steps.
--- parrot/dynclasses/foo.pmc Thu Jul 31 21:06:53 2003
+++ parrot-leo/dynclasses/foo.pmc Wed Aug 6 12:00:07 2003
@@ -9,7 +9,7 @@
*/
#define enum_class_Foo -1
-pmclass Foo {
+pmclass Foo dynpmc {
STRING* name () {
return whoami;
--- parrot/global_setup.c Mon Jul 28 00:35:37 2003
+++ parrot-leo/global_setup.c Wed Aug 6 14:28:27 2003
@@ -29,6 +29,14 @@
string_init(); /* Set up the string subsystem */
+ /* allocate core vtable */
+#if 0
+ /* no - we can't move existing vtables */
+ Parrot_base_vtables =
+ mem_sys_allocate(sizeof(VTABLE) * enum_class_core_max);
+#endif
+ enum_class_max = enum_class_core_max;
+
/* Call base vtable class constructor methods */
Parrot_initialize_core_pmcs(interpreter);
--- parrot/include/parrot/pmc.h Mon Jul 28 00:35:47 2003
+++ parrot-leo/include/parrot/pmc.h Wed Aug 6 14:27:39 2003
@@ -16,7 +16,9 @@
#include "parrot/core_pmcs.h"
#include "parrot/pobj.h"
-VAR_SCOPE VTABLE Parrot_base_vtables[enum_class_max];
+#define PARROT_MAX_CLASSES 100
+VAR_SCOPE VTABLE Parrot_base_vtables[PARROT_MAX_CLASSES];
+VAR_SCOPE INTVAL enum_class_max;
/* Prototypes */
--- parrot/languages/imcc/imcc.y Sat Aug 2 10:55:03 2003
+++ parrot-leo/languages/imcc/imcc.y Wed Aug 6 16:10:18 2003
@@ -20,6 +20,7 @@
#include "imc.h"
#include "pbc.h"
#include "parser.h"
+#include "parrot/dynext.h"
#define YYDEBUG 1
#define YYERROR_VERBOSE 1
@@ -344,6 +345,12 @@
/* mark end as absolute branch */
if (!strcmp(name, "end")) {
ins->type |= ITBRANCH | IF_goto;
+ }
+ if (!strcmp(name, "load_pmc")) {
+ SymReg *r0 = r[0]; /* lib name */
+ STRING *lib = string_from_cstring(interpreter, r0->name + 1,
+ strlen(r0->name) - 2);
+ Parrot_load_pmc(interpreter, lib, NULL);
}
/* set up branch flags */
if (op_info->jump) {
--- /dev/null Fri Feb 28 14:27:28 2003
+++ parrot-leo/dynext.c Wed Aug 6 17:28:10 2003
@@ -0,0 +1,117 @@
+/* dynext.c
+ * Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
+ * CVS Info
+ * $Id$
+ * Overview:
+ * Dynamic extension stuff
+ * Data Structure and Algorithms:
+ * History:
+ * Initial rev by leo 2003.08.06
+ * Notes:
+ * References:
+ */
+
+#include "parrot/parrot.h"
+#include "parrot/dynext.h"
+
+/*
+ * if this pmc class isn't already in our global vtable
+ * reallocate it and assign class enum
+ */
+int
+Parrot_dynext_setup_pmc(Interp *interp, dynext_pmc_info_t *info)
+{
+ int i;
+
+ for (i = 1; i < (int)enum_class_max; i++) {
+ if (!string_compare(interp, info->class_name,
+ Parrot_base_vtables[i].name(interp, NULL))) {
+ info->class_enum = i;
+ return DYNEXT_INIT_OK;
+ }
+ }
+#if 0
+ Parrot_base_vtables = mem_sys_realloc(
+ Parrot_base_vtables, sizeof(VTABLE) * (enum_class_max + 1));
+#endif
+ info->class_enum = (*info->class_max)++;
+
+ return DYNEXT_INIT_OK;
+}
+
+/*
+ * register a dynamic class pmc in the interpreter's registry
+ */
+int
+Parrot_dynext_init_pmc (Interp *interp, dynext_pmc_info_t *info)
+{
+ PMC *classname_hash;
+ PMC *key;
+
+ classname_hash = VTABLE_get_pmc_keyed_int(interp,
+ interp->iglobals, (INTVAL)IGLOBALS_CLASSNAME_HASH);
+ key = key_new_string(interp, info->class_name);
+ VTABLE_set_integer_keyed(interp, classname_hash, key, info->class_enum);
+ return DYNEXT_INIT_OK;
+}
+
+int
+Parrot_load_pmc(Interp *interpreter, STRING *lib, PMC *initializer)
+{
+ STRING *path, *init_func;
+ void * handle;
+ void (*func)(Interp *, int, void *);
+ char *cpath, *cinit_func;
+ dynext_pmc_info_t info;
+
+ /* TODO runtime path for dynamic extensions */
+ /* TODO $SO extension */
+#ifndef RUNTIME_DYNEXT
+# define RUNTIME_DYNEXT "runtime/parrot/dynext/"
+#endif
+#ifndef SO_EXTENSION
+# define SO_EXTENSION ".so"
+#endif
+
+ path = Parrot_sprintf_c(interpreter, "%s%Ss_pmc%s",
+ RUNTIME_DYNEXT,
+ lib,
+ SO_EXTENSION);
+ cpath = string_to_cstring(interpreter, path);
+ handle = Parrot_dlopen(cpath);
+ if (!handle) {
+ const char * err = Parrot_dlerror();
+ fprintf(stderr, "%s\n", err);
+ return -1;
+ }
+ string_cstring_free(cpath);
+ init_func = Parrot_sprintf_c(interpreter, "Parrot_dynext_%Ss_init", lib);
+ cinit_func = string_to_cstring(interpreter, init_func);
+ func = Parrot_dlsym(handle, cinit_func);
+ if (NULL == func) {
+ fprintf(stderr, "Failed to find symbol '%s' in native library\n",
+ cinit_func);
+ return -1;
+ }
+ string_cstring_free(cinit_func);
+ /*
+ * setup init info structure */
+ info.class_name = lib;
+ info.initializer = initializer;
+ info.class_max = &enum_class_max;
+ info.base_vtable = Parrot_base_vtables;
+ /* TODO error checks */
+ (*func)(interpreter, DYNEXT_SETUP_PMC, (void *) &info);
+ (*func)(interpreter, DYNEXT_INIT_PMC, (void *) &info);
+ return 0;
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/
--- /dev/null Fri Feb 28 14:27:28 2003
+++ parrot-leo/include/parrot/dynext.h Wed Aug 6 16:29:15 2003
@@ -0,0 +1,39 @@
+/* dynext.h
+*
+* $Id$
+*
+* Parrot dynamic extensions
+*/
+
+#if !defined(DYNEXT_H_GUARD)
+#define DYNEXT_H_GUARD
+
+typedef enum {
+ DYNEXT_NONE,
+ DYNEXT_SETUP_PMC,
+ DYNEXT_INIT_PMC,
+ DYNEXT_SETUP_OPLIB,
+ DYNEXT_INIT_OPLIB
+} dynex_enum_action_t;
+
+typedef enum {
+ DYNEXT_INIT_OK,
+ DYNEXT_INIT_ERR
+} dynex_enum_err_t;
+
+typedef struct {
+ INTVAL class_enum;
+ STRING *class_name;
+ PMC *initializer;
+ INTVAL *class_max;
+ VTABLE *base_vtable;
+} dynext_pmc_info_t;
+
+/* dynamic PMC loading */
+int Parrot_load_pmc(Interp *interpreter, STRING *lib, PMC *initializer);
+/* callbacks for these */
+int Parrot_dynext_setup_pmc(Interp *, dynext_pmc_info_t *);
+int Parrot_dynext_init_pmc (Interp *, dynext_pmc_info_t *);
+
+#endif
+
--- /dev/null Fri Feb 28 14:27:28 2003
+++ parrot-leo/dynclasses/dynfoo.pasm Wed Aug 6 16:10:00 2003
@@ -0,0 +1,11 @@
+ load_pmc "foo", P0
+ print "ok 1\n"
+ find_type I0, "Foo"
+ print I0
+ print "\n"
+ new P0, .Foo
+ print "ok 2\n"
+ set I0, P0
+ print I0
+ print "\n"
+ end
