[svn:parrot] r38450 - branches/tt528_vtinit/lib/Parrot/Pmc2c
cotto at svn.parrot.org
cotto at svn.parrot.org
Sun May 3 05:44:53 UTC 2009
Author: cotto
Date: Sun May 3 05:44:52 2009
New Revision: 38450
URL: https://trac.parrot.org/parrot/changeset/38450
Log:
[pmc2c] add code to generate update_vtable for variant vtables, plus get_vtable
Parrot builds, but with some test failures.
Modified:
branches/tt528_vtinit/lib/Parrot/Pmc2c/PMCEmitter.pm
Modified: branches/tt528_vtinit/lib/Parrot/Pmc2c/PMCEmitter.pm
==============================================================================
--- branches/tt528_vtinit/lib/Parrot/Pmc2c/PMCEmitter.pm Sun May 3 03:22:49 2009 (r38449)
+++ branches/tt528_vtinit/lib/Parrot/Pmc2c/PMCEmitter.pm Sun May 3 05:44:52 2009 (r38450)
@@ -106,7 +106,6 @@
my ($self) = @_;
my $h = $self->{emitter};
my $name = uc $self->name;
- my $lc_name = $self->name;
$h->emit( dont_edit( $self->filename ) );
$h->emit(<<"EOH");
@@ -121,7 +120,6 @@
$h->emit( $self->{ro}->hdecls ) if ( $self->{ro} );
$self->gen_attributes;
$h->emit(<<"EOH");
- PARROT_EXPORT VTABLE * Parrot_${lc_name}_update_vtable(VTABLE *);
#endif /* PARROT_PMC_${name}_H_GUARD */
@@ -141,7 +139,8 @@
my ($self) = @_;
my $hout;
- my $name = $self->name;
+ my $name = $self->name;
+ my $lc_name = $self->name;
# generate decls for all vtable methods in this PMC
foreach my $vt_method_name ( @{ $self->vtable->names } ) {
@@ -160,6 +159,10 @@
# class init decl
$hout .= 'PARROT_DYNEXT_EXPORT ' if ( $self->is_dynamic );
$hout .= "void Parrot_${name}_class_init(PARROT_INTERP, int, int);\n";
+
+ $hout .= 'PARROT_DYNEXT_EXPORT ' if ( $self->is_dynamic );
+ $hout .= "VTABLE* Parrot_${lc_name}_update_vtable(VTABLE*);\n";
+
$self->{hdecls} .= $hout;
return $self->{hdecls};
@@ -403,17 +406,15 @@
return "Parrot_${implementor}_$vt_method_name";
}
-=item C<vtable_decl($name)>
+=item C<vtable_flags()>
-Returns the C code for the declaration of a vtable temporary named
-C<$name> with the functions for this class.
+Returns C code to produce a PMC's flags.
=cut
-sub vtable_decl {
- my ( $self, $temp_struct_name, $enum_name ) = @_;
+sub vtable_flags {
+ my ($self) = @_;
- # gen vtable flags
my $vtbl_flag = 0;
$vtbl_flag .= '|VTABLE_PMC_NEEDS_EXT' if $self->flag('need_ext');
$vtbl_flag .= '|VTABLE_PMC_IS_SINGLETON' if $self->flag('singleton');
@@ -421,6 +422,22 @@
$vtbl_flag .= '|VTABLE_IS_READONLY_FLAG' if $self->flag('is_ro');
$vtbl_flag .= '|VTABLE_HAS_READONLY_FLAG' if $self->flag('has_ro');
+ return $vtbl_flag;
+}
+
+=item C<vtable_decl($name)>
+
+Returns the C code for the declaration of a vtable temporary named
+C<$name> with the functions for this class.
+
+=cut
+
+sub vtable_decl {
+ my ( $self, $temp_struct_name, $enum_name ) = @_;
+
+ # gen vtable flags
+ my $vtbl_flag = $self->vtable_flags;
+
my @vt_methods;
foreach my $vt_method ( @{ $self->vtable->methods } ) {
next if $vt_method->is_mmd;
@@ -490,6 +507,15 @@
$extra_vt{ro} = $self->{ro} if $self->{ro};
$cout .= <<"EOC";
+PARROT_EXPORT VTABLE* Parrot_${classname}_update_vtable(VTABLE*);
+VTABLE* Parrot_${classname}_get_vtable(PARROT_INTERP);
+EOC
+
+ for my $k (keys %extra_vt) {
+ $cout .= "PARROT_EXPORT VTABLE* Parrot_${classname}_update_${k}_vtable(VTABLE*);\n";
+ }
+
+ $cout .= <<"EOC";
void
Parrot_${classname}_class_init(PARROT_INTERP, int entry, int pass)
{
@@ -525,13 +551,14 @@
$cout .= "\";\n";
$cout .= <<"EOC";
-$vtable_decl
+$vtable_decl
EOC
for my $k ( keys %extra_vt ) {
$cout .= $extra_vt{$k}->vtable_decl( "temp_${k}_vtable", $enum_name );
}
+
my $const = ( $self->{flags}{dynpmc} ) ? " " : " const ";
if ( @$multi_funcs ) {
$cout .= <<"EOC";
@@ -545,63 +572,73 @@
$cout .= <<"EOC";
if (pass == 0) {
EOC
+ for my $k ( keys %extra_vt ) {
+ $cout .= " VTABLE *vt_$k;\n";
+ }
+
+ my $flags = $self->vtable_flags;
$cout .= <<"EOC";
Hash *isa_hash;
/* create vtable - clone it - we have to set a few items */
- VTABLE * const vt_clone = Parrot_clone_vtable(interp,
- &temp_base_vtable);
+ VTABLE * vt = Parrot_${classname}_get_vtable(interp);
+ vt->base_type = enum_class_$classname;
+ vt->flags = $flags;
+ vt->attribute_defs = attr_defs;
EOC
for my $k ( keys %extra_vt ) {
+ my $k_flags = $self->$k->vtable_flags;
$cout .= <<"EOC";
- VTABLE * const vt_${k}_clone = Parrot_clone_vtable(interp,
- &temp_${k}_vtable);
+ vt_${k} = Parrot_${classname}_get_vtable(interp);
+ vt_$k->base_type = enum_class_$classname;
+ vt_$k->flags = $k_flags;
+ vt_$k->attribute_defs = attr_defs;
EOC
}
# init vtable slot
if ( $self->is_dynamic ) {
$cout .= <<"EOC";
- vt_clone->base_type = entry;
- vt_clone->whoami = string_make(interp, "$classname", @{[length($classname)]}, "ascii",
+ vt->base_type = entry;
+ vt->whoami = string_make(interp, "$classname", @{[length($classname)]}, "ascii",
PObj_constant_FLAG|PObj_external_FLAG);
- vt_clone->provides_str = Parrot_str_append(interp, vt_clone->provides_str,
+ vt->provides_str = Parrot_str_append(interp, vt->provides_str,
string_make(interp, " $provides", @{[length($provides) + 1]}, "ascii",
PObj_constant_FLAG|PObj_external_FLAG));
/* set up isa hash */
isa_hash = parrot_new_hash(interp);
- vt_clone->isa_hash = isa_hash;
+ vt->isa_hash = isa_hash;
EOC
}
else {
$cout .= <<"EOC";
- vt_clone->whoami = CONST_STRING_GEN(interp, "$classname");
- vt_clone->provides_str = CONST_STRING_GEN(interp, "$provides");
+ vt->whoami = CONST_STRING_GEN(interp, "$classname");
+ vt->provides_str = CONST_STRING_GEN(interp, "$provides");
/* set up isa hash */
isa_hash = parrot_new_hash(interp);
- vt_clone->isa_hash = isa_hash;
+ vt->isa_hash = isa_hash;
EOC
}
for my $k ( keys %extra_vt ) {
$cout .= <<"EOC";
- vt_${k}_clone->base_type = entry;
- vt_${k}_clone->whoami = vt_clone->whoami;
- vt_${k}_clone->provides_str = vt_clone->provides_str;
+ vt_${k}->base_type = entry;
+ vt_${k}->whoami = vt->whoami;
+ vt_${k}->provides_str = vt->provides_str;
EOC
}
if ( $extra_vt{ro} ) {
$cout .= <<"EOC";
- vt_clone->ro_variant_vtable = vt_ro_clone;
- vt_ro_clone->ro_variant_vtable = vt_clone;
- vt_ro_clone->isa_hash = isa_hash;
+ vt->ro_variant_vtable = vt_ro;
+ vt_ro->ro_variant_vtable = vt;
+ vt_ro->isa_hash = isa_hash;
EOC
}
$cout .= <<"EOC";
- interp->vtables[entry] = vt_clone;
+ interp->vtables[entry] = vt;
EOC
for my $isa ($classname, @isa) {
@@ -641,12 +678,12 @@
$cout .= <<"EOC";
{
PMC *mro = pmc_new(interp, enum_class_ResizableStringArray);
- VTABLE * const vt_clone = interp->vtables[entry];
+ VTABLE * const vt = interp->vtables[entry];
- vt_clone->mro = mro;
+ vt->mro = mro;
- if (vt_clone->ro_variant_vtable)
- vt_clone->ro_variant_vtable->mro = mro;
+ if (vt->ro_variant_vtable)
+ vt->ro_variant_vtable->mro = mro;
EOC
@@ -733,6 +770,47 @@
}
EOC
+
+ for my $k (keys %extra_vt) {
+
+ my $vtable_updates = '';
+ for my $name ( @{ $self->$k->vtable->names } ) {
+ if (exists $self->$k->{has_method}{$name}) {
+ $vtable_updates .= " vt->$name = Parrot_${classname}_${k}_${name};\n";
+ }
+ }
+
+ $cout .= <<"EOC";
+
+PARROT_EXPORT VTABLE *Parrot_${classname}_update_${k}_vtable(VTABLE *vt) {
+$vtable_updates
+ return vt;
+}
+EOC
+ }
+
+ my $get_vtable = '';
+ foreach my $parent_name ( reverse ($self->name, @{ $self->parents }) ) {
+ unless ($parent_name eq 'default') {
+ $get_vtable .= " vt = Parrot_${parent_name}_update_vtable(vt);\n";
+ }
+ }
+ my $set_default = '';
+ foreach my $vtable_func ( @{ $self->vtable->names } ) {
+ $set_default .= " vt->$vtable_func = Parrot_default_$vtable_func;\n";
+ }
+ $cout .= <<"EOC";
+
+
+VTABLE* Parrot_${classname}_get_vtable(PARROT_INTERP) {
+
+ VTABLE *vt = Parrot_new_vtable(interp);
+$set_default
+$get_vtable
+ return vt;
+}
+EOC
+
if ( $self->is_dynamic ) {
$cout .= dynext_load_code( $classname, $classname => {} );
}
More information about the parrot-commits
mailing list