[svn:parrot] r38629 - in branches/pmc_pct/compilers/pmcc/src: emitter parser

cotto at svn.parrot.org cotto at svn.parrot.org
Sat May 9 07:52:25 UTC 2009


Author: cotto
Date: Sat May  9 07:52:24 2009
New Revision: 38629
URL: https://trac.parrot.org/parrot/changeset/38629

Log:
[pmcc] add ATTR accessor macro generation

Modified:
   branches/pmc_pct/compilers/pmcc/src/emitter/pmc.pm
   branches/pmc_pct/compilers/pmcc/src/parser/actions.pm
   branches/pmc_pct/compilers/pmcc/src/parser/grammar.pg

Modified: branches/pmc_pct/compilers/pmcc/src/emitter/pmc.pm
==============================================================================
--- branches/pmc_pct/compilers/pmcc/src/emitter/pmc.pm	Sat May  9 05:35:24 2009	(r38628)
+++ branches/pmc_pct/compilers/pmcc/src/emitter/pmc.pm	Sat May  9 07:52:24 2009	(r38629)
@@ -4,9 +4,9 @@
 class PMC::Emitter::PMC;
 
 # =item C<generate_h_file>
-# 
+#
 # Generate part of header file.
-# 
+#
 # =cut
 
 # "Template Method". Just override generate_h_file_functions in derived
@@ -17,7 +17,7 @@
     my $name := self.name;
 
     my $guard := 'PARROT_PMC_' ~ self.ucname ~ '_H_GUARD';
-    
+
     # "join" is way too simple...
     my $res := join('', (
         '#ifndef ' ~ $guard ~ "\n",
@@ -39,15 +39,15 @@
 }
 
 # =item C<generate_h_file_functions>
-# 
+#
 # Generate C declarations for vtable functions
-# 
+#
 # =cut
 
 method generate_h_file_functions() {
     my $past := self.past;
     my %vtables := PMC::VTableInfo::vtable_hash();
-    
+
     my @res_builder;
 
     @res_builder.push("void Parrot_" ~ self.name ~ "_class_init(PARROT_INTERP, int, int);\n");
@@ -64,7 +64,7 @@
 
 #=item C<generate_attr_struct>
 #
-#Generate a C declaration for the ATTR wrapper struct 
+#Generate a C declaration for the ATTR wrapper struct
 #
 #=cut
 
@@ -74,11 +74,11 @@
     my $struct_body;
     my $struct_end;
 
-    $struct_start := 
+    $struct_start :=
         "\n/* " ~ self.name ~ " PMC's underlying struct. */\n" ~
         "typedef struct Parrot_" ~ self.name ~ "_attributes {\n";
 
-    my @attrs := self.attrs;    
+    my @attrs := self.attrs;
     my @struct_members;
 
     for @attrs {
@@ -98,7 +98,7 @@
 
 method generate_casting_macro() {
 
-    return 
+    return
         "#define PARROT_" ~ self.ucname ~ "(o) ((Parrot_" ~ self.name ~ "_attributes *) PMC_data(o))\n";
 }
 
@@ -111,34 +111,161 @@
 
 method generate_attr_accessors() {
 
-    my @attrs := self.attrs;    
+    my @attrs := self.attrs;
     my @accessors;
 
     for @attrs {
+        @accessors.push( self.generate_accessor_comment(self.name, $_<name>) );
         @accessors.push( self.generate_get_accessor($_<type>,$_<name>) );
-        #@accessors.push( self.generate_set_accessor($_<type>,$_<name>);
+        @accessors.push( self.generate_set_accessor($_<type>,$_<name>) );
     }
 
     return join("\n", @accessors);
 }
 
+method generate_accessor_comment( $pmcname, $attrname ) {
+    return
+        "\n/* Generated macro accessors for the '"~ $attrname ~
+        "' attribute of the "~ $pmcname ~ " PMC. */\n";
+}
 
 method generate_get_accessor($type, $attr_name) {
 
-    my $macro_start := 
+    my $macro_start :=
 "#define GETATTR_" ~ self.name ~ "_" ~ $attr_name ~ "(interp, pmc, dest) \\
 do { \\
     if (PObj_is_object_TEST(pmc)) { \\\n";
 
-    #XXX: Put code to generate the accessor body here.
+    my $macro_body;
+
+    if $type eq 'INTVAL' {
+        $macro_body := self.intval_getter_body($attr_name);
+    }
+    elsif $type eq 'FLOATVAL' {
+        $macro_body := self.floatval_getter_body($attr_name);
+    }
+    elsif $type eq 'STRING*' {
+        $macro_body := self.strptr_getter_body($attr_name);
+    }
+    elsif $type eq 'PMC*' {
+        $macro_body := self.pmcptr_getter_body($attr_name);
+    }
+    else {
+        $macro_body := self.default_getter_body($type);
+    }
 
-    my $macro_end :=
-"    } \\
+    my $macro_end := "
+    } \\
     else \\
         (dest) = ((Parrot_" ~ self.name ~ "_attributes *)PMC_data(pmc))->" ~ $attr_name ~ "; \\
 } while (0);\n";
 
-    return $macro_start ~ $macro_end;
+    return $macro_start ~ $macro_body ~ $macro_end;
+}
+
+method intval_getter_body($name) {
+    return
+'        PMC *attr_value = VTABLE_get_attr_str(interp, \\
+            pmc, Parrot_str_new_constant(interp, "'~ $name ~'")); \\
+        (dest) = (PMC_IS_NULL(attr_value) ? (INTVAL) 0: VTABLE_get_integer(interp, attr_value)); \\';
+}
+
+method floatval_getter_body($name) {
+    return
+'        PMC *attr_value = VTABLE_get_attr_str(interp, \\
+            pmc, Parrot_str_new_constant(interp, "'~ $name ~'")); \\
+        (dest) = (PMC_IS_NULL(attr_value) ? (FLOATVAL) 0.0: VTABLE_get_number(interp, attr_value)); \\';
+}
+
+method strptr_getter_body($name) {
+    return
+'        PMC *attr_value = VTABLE_get_attr_str(interp, \\
+            pmc, Parrot_str_new_constant(interp, "'~ $name ~'")); \\
+        (dest) = (PMC_IS_NULL(attr_value) ? (STRING *) NULL: VTABLE_get_string(interp, attr_value)); \\';
+}
+
+method pmcptr_getter_body($name) {
+    return
+'        (dest) = VTABLE_get_attr_str(interp, \\
+             pmc, Parrot_str_new_constant(interp, "'~ $name ~'")); \\';
+}
+
+method default_getter_body($type) {
+    return
+"        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, \\
+            \"Attributes of type '"~ $type ~ "' cannot be subclassed from a high-level PMC.\"); \\";
+}
+
+method generate_set_accessor($type, $attr_name) {
+
+    my $macro_start :=
+"#define SETATTR_"~ self.name ~"_"~ $attr_name ~"(interp, pmc, value) \\
+do { \\
+    if (PObj_is_object_TEST(pmc)) { \\\n";
+
+    my $macro_body;
+
+    if $type eq 'INTVAL' {
+        $macro_body := self.intval_setter_body($attr_name);
+    }
+    elsif $type eq 'FLOATVAL' {
+        $macro_body := self.floatval_setter_body($attr_name);
+    }
+    elsif $type eq 'STRING*' {
+        $macro_body := self.strptr_setter_body($attr_name);
+    }
+    elsif $type eq 'PMC*' {
+        $macro_body := self.pmcptr_setter_body($attr_name);
+    }
+    else {
+        $macro_body := self.default_setter_body($type);
+    }
+
+    my $macro_end := "
+    } \\
+    else \\
+        ((Parrot_"~ self.name ~"_attributes *)PMC_data(pmc))->"~ $attr_name ~" = (value); \\
+} while (0);\n";
+
+    return $macro_start ~ $macro_body ~ $macro_end;
+}
+
+
+method intval_setter_body($name) {
+    return
+"        PMC *attr_value = pmc_new(interp, enum_class_Integer); \\
+        VTABLE_set_integer_native(interp, attr_value, value); \\
+        VTABLE_set_attr_str(interp, pmc, \\
+            Parrot_str_new_constant(interp, \""~ $name ~"\"), attr_value); \\";
+}
+
+method floatval_setter_body($name) {
+    return
+"        PMC *attr_value = pmc_new(interp, enum_class_Float); \\
+        VTABLE_set_number_native(interp, attr_value, value); \\
+        VTABLE_set_attr_str(interp, pmc, \\
+            Parrot_str_new_constant(interp, \""~ $name ~"\"), attr_value); \\";
+}
+
+method strptr_setter_body($name) {
+    return
+"        PMC *attr_value = pmc_new(interp, enum_class_String); \\
+        VTABLE_set_string_native(interp, attr_value, value); \\
+        VTABLE_set_attr_str(interp, pmc, \\
+            Parrot_str_new_constant(interp, \""~ $name ~"\"), attr_value); \\";
+}
+
+method pmcptr_setter_body($name) {
+    return
+"         VTABLE_set_attr_str(interp, pmc, \\
+             Parrot_str_new_constant(interp, \""~ $name ~"\"), value); \\";
+}
+
+method default_setter_body($type) {
+    return
+"         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, \\
+              \"Attributes of type '"~ $type ~"' cannot be \" \\
+              \"subclassed from a high-level PMC.\"); \\";
 }
 
 
@@ -148,7 +275,7 @@
 #
 #=cut
 method generate_c_file() {
-    my $res := 
+    my $res :=
           self.generate_c_file_functions()
         ~ self.generate_class_init();
 }
@@ -184,7 +311,7 @@
 method generate_class_init() {
     my @res;
     @res.push(
-          "PARROT_EXPORT void Parrot_" 
+          "PARROT_EXPORT void Parrot_"
         ~ self.name
         ~ "_class_init(PARROT_INTERP, int entry, int pass) {\n");
 

Modified: branches/pmc_pct/compilers/pmcc/src/parser/actions.pm
==============================================================================
--- branches/pmc_pct/compilers/pmcc/src/parser/actions.pm	Sat May  9 05:35:24 2009	(r38628)
+++ branches/pmc_pct/compilers/pmcc/src/parser/actions.pm	Sat May  9 07:52:24 2009	(r38629)
@@ -32,7 +32,7 @@
 
 method traits($/, $key) {
     our $?PMC;
-    
+
     #say("traits " ~$/);
     if $key eq 'extends' {
         $?PMC.parents().push(~$<identifier>);
@@ -48,11 +48,26 @@
     }
 }
 
-method attribute($/) {
+method attribute_type($/, $key) {
     our $?PMC;
-    $?PMC.add_attr(~$/<identifier>, ~$/<c_type>);
+    my $name;
+    my $type;
+    my $accessor_type;
+
+
+    if $key eq 'simple_attr' {
+        $type := ~$/<simple_attr><simple_attr_type>;
+        $name := ~$/<simple_attr><identifier>;
+    }
+    elsif $key eq 'pointer_attr' {
+        $type := ~$/<pointer_attr><pointer_attr_type>;
+        $name := ~$/<pointer_attr><identifier>;
+    }
+    $type.replace(' ','');
+    $?PMC.add_attr($name, $type);
 }
 
+
 method body_part($/, $key) {
     our $?PMC;
 
@@ -71,7 +86,7 @@
 
 method class_init($/) {
     #say('class_init ' ~$<identifier>);
-    my $past := PAST::Block.new( 
+    my $past := PAST::Block.new(
         :blocktype('method'),
         :returns('void'),
         :node($/),
@@ -82,7 +97,7 @@
 
 method vtable($/) {
     #say('VABLE ' ~$<c_signature><identifier>);
-    my $past := PAST::Block.new( 
+    my $past := PAST::Block.new(
         :name(~$<c_signature><identifier>),
         :blocktype('method'),
         :returns(~$<c_signature><c_type>),

Modified: branches/pmc_pct/compilers/pmcc/src/parser/grammar.pg
==============================================================================
--- branches/pmc_pct/compilers/pmcc/src/parser/grammar.pg	Sat May  9 05:35:24 2009	(r38628)
+++ branches/pmc_pct/compilers/pmcc/src/parser/grammar.pg	Sat May  9 07:52:24 2009	(r38629)
@@ -31,7 +31,7 @@
 
 # pmc action will store "header" and "footer"
 rule pmc {
-    pmclass <identifier> 
+    pmclass <identifier>
     {*}                                     #= begin
     <traits>* '{'
         <attribute>*
@@ -56,10 +56,37 @@
 }
 
 rule attribute {
-    'ATTR' <c_type> <identifier> ';' {*}
+    'ATTR' <attribute_type>
 }
 
-# Body of PMC class. 
+rule attribute_type {
+    [ <simple_attr>   {*}  #= simple_attr
+    | <pointer_attr>  {*}  #= pointer_attr
+    ]
+}
+
+rule simple_attr {
+    <simple_attr_type> <identifier> ';'
+}
+
+regex simple_attr_type {
+    [ 'U'? 'INTVAL'
+    | 'FLOATVAL'
+    | 'STRING'
+    | 'struct'?  <identifier>
+    | 'unsigned'? 'char'
+    ]
+}
+
+rule pointer_attr {
+    <pointer_attr_type> <identifier> ';'
+}
+
+rule pointer_attr_type {
+    <simple_attr_type>  '*'+
+}
+
+# Body of PMC class.
 rule body {
     <body_part>*
 }
@@ -151,7 +178,7 @@
 }
 
 token identifier {
-    <.ident> 
+    <.ident>
 }
 
 ## ws token handles whitespaces and C /* */ comments


More information about the parrot-commits mailing list