[svn:parrot] r38353 - in trunk: lib/Parrot/Pmc2c src/pmc
whiteknight at svn.parrot.org
whiteknight at svn.parrot.org
Sat Apr 25 17:23:12 UTC 2009
Author: whiteknight
Date: Sat Apr 25 17:23:11 2009
New Revision: 38353
URL: https://trac.parrot.org/parrot/changeset/38353
Log:
A fix for TT #544, plus proof-of-concept implementation in ManagedStruct PMC. Allows parsing arbitrary function pointers as ATTRs, to reduce the use of void* pointers floating around.
Modified:
trunk/lib/Parrot/Pmc2c/Attribute.pm
trunk/lib/Parrot/Pmc2c/PMCEmitter.pm
trunk/lib/Parrot/Pmc2c/Parser.pm
trunk/src/pmc/managedstruct.pmc
Modified: trunk/lib/Parrot/Pmc2c/Attribute.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c/Attribute.pm Sat Apr 25 16:06:39 2009 (r38352)
+++ trunk/lib/Parrot/Pmc2c/Attribute.pm Sat Apr 25 17:23:11 2009 (r38353)
@@ -99,6 +99,13 @@
my $pmcname = $pmc->{name};
my $attrtype = $self->{type};
my $attrname = $self->{name};
+ my $isfuncptr = 0;
+ my $origtype = $attrtype;
+ if($attrname =~ m/\(\*(\w*)\)\((.*?)\)/) {
+ $isfuncptr = 1;
+ $origtype = $attrtype . " (*)(" . $2 . ")";
+ $attrname = $1;
+ }
# Store regexes used to check some types to avoid repetitions
my $isptrtostring = qr/STRING\s*\*$/;
@@ -113,7 +120,14 @@
if (PObj_is_object_TEST(pmc)) { \\
EOA
- if ($attrtype eq "INTVAL") {
+ if ($isfuncptr == 1) {
+ $decl .= <<"EOA";
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, \\
+ "Attributes of type '$origtype' cannot be " \\
+ "subclassed from a high-level PMC."); \\
+EOA
+ }
+ elsif ($attrtype eq "INTVAL") {
$decl .= <<"EOA";
PMC *attr_value = VTABLE_get_attr_str(interp, \\
pmc, Parrot_str_new_constant(interp, "$attrname")); \\
@@ -161,7 +175,14 @@
if (PObj_is_object_TEST(pmc)) { \\
EOA
- if ($attrtype eq "INTVAL") {
+ if ($isfuncptr == 1) {
+ $decl .= <<"EOA";
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, \\
+ "Attributes of type '$origtype' cannot be " \\
+ "subclassed from a high-level PMC."); \\
+EOA
+ }
+ elsif ($attrtype eq "INTVAL") {
$decl .= <<"EOA";
PMC *attr_value = pmc_new(interp, enum_class_Integer); \\
VTABLE_set_integer_native(interp, attr_value, value); \\
Modified: trunk/lib/Parrot/Pmc2c/PMCEmitter.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c/PMCEmitter.pm Sat Apr 25 16:06:39 2009 (r38352)
+++ trunk/lib/Parrot/Pmc2c/PMCEmitter.pm Sat Apr 25 17:23:11 2009 (r38353)
@@ -498,8 +498,12 @@
my $attributes = $self->attributes;
foreach my $attribute ( @$attributes ) {
my $attrtype = $attribute->{type};
+ my $attrname = $attribute->{name};
my $typeid = ':'; # Unhandled
- if ($attrtype eq "INTVAL") {
+ if($attrname =~ m/\(*(\w+)\)\(.*?\)/) {
+ $attrname = $1;
+ }
+ elsif ($attrtype eq "INTVAL") {
$typeid = 'I';
}
elsif ($attrtype eq "FLOATVAL") {
@@ -513,7 +517,7 @@
}
$cout .= $typeid;
- $cout .= $attribute->name;
+ $cout .= $attrname;
$cout .= ' ';
}
Modified: trunk/lib/Parrot/Pmc2c/Parser.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c/Parser.pm Sat Apr 25 16:06:39 2009 (r38352)
+++ trunk/lib/Parrot/Pmc2c/Parser.pm Sat Apr 25 17:23:11 2009 (r38353)
@@ -135,7 +135,10 @@
# name
\s*
- (\w+)
+ (
+ \w+
+ | \(\*\w*\)\(.*?\)
+ )
# modifiers
\s*
Modified: trunk/src/pmc/managedstruct.pmc
==============================================================================
--- trunk/src/pmc/managedstruct.pmc Sat Apr 25 16:06:39 2009 (r38352)
+++ trunk/src/pmc/managedstruct.pmc Sat Apr 25 17:23:11 2009 (r38353)
@@ -29,12 +29,12 @@
* custom_free_func is called before the normal destroy() function does any
* work.
*/
- ATTR void *custom_free_func;
+ ATTR void (*custom_free_func)(PARROT_INTERP, void *, void *);
ATTR void *custom_free_priv;
/* if custom_clone_func is set, it will be called *instead* of the normal
* clone() function logic.
*/
- ATTR void *custom_clone_func;
+ ATTR PMC * (*custom_clone_func)(PARROT_INTERP, PMC *ptr, void *priv);
ATTR void *custom_clone_priv;
/*
@@ -86,8 +86,7 @@
VTABLE void destroy() {
void *ptr = PARROT_MANAGEDSTRUCT(SELF)->ptr;
if (ptr) {
- custom_free_func_t free_func =
- (custom_free_func_t)PARROT_MANAGEDSTRUCT(SELF)->custom_free_func;
+ custom_free_func_t free_func = PARROT_MANAGEDSTRUCT(SELF)->custom_free_func;
if (free_func) {
void *free_data = PARROT_MANAGEDSTRUCT(SELF)->custom_free_priv;
free_func(interp, ptr, free_data);
@@ -144,8 +143,7 @@
*/
VTABLE PMC *clone() {
- custom_clone_func_t clone_func =
- (custom_clone_func_t)PARROT_MANAGEDSTRUCT(SELF)->custom_clone_func;
+ custom_clone_func_t clone_func = PARROT_MANAGEDSTRUCT(SELF)->custom_clone_func;
PMC *dest;
if (clone_func) {
void *clone_data = PARROT_MANAGEDSTRUCT(SELF)->custom_clone_priv;
More information about the parrot-commits
mailing list