--- parrot/lib/Parrot/Vtable.pm Fri Jun 21 21:00:02 2002 +++ parrot-leo/lib/Parrot/Vtable.pm Mon Mar 24 10:40:27 2003 @@ -6,7 +6,7 @@ use strict; @Parrot::Vtable::ISA = qw(Exporter); -@Parrot::Vtable::EXPORT = qw(parse_vtable vtbl_defs vtbl_struct); +@Parrot::Vtable::EXPORT = qw(parse_vtable vtbl_defs vtbl_struct vtbl_macros); sub make_re { my $re = shift; @@ -22,6 +22,7 @@ my $arglist_re = make_re('(?:'.$param_re.'(?:\s*,\s*'.$param_re.')*)?'); my $method_re = make_re('^\s*('.$type_re.')\s+('.$ident_re.')\s*\(('.$arglist_re.')\)\s*$'); + sub parse_vtable { my $file = defined $_[0] ? shift() : 'vtable.tbl'; @@ -83,6 +84,29 @@ $struct .= "};\n"; return $struct; +} + +sub vtbl_macros { + my $vtable = shift; + my $macros = <<"EOM"; + +/* + * vtable accessor macros + * as vtable methods might get moved around internally + * these macros hide the details + */ + +EOM + for my $entry (@{$vtable}) { + my @args = split /,\s*/, $entry->[2]; + unshift @args, "i interp", "p pmc"; + my $args = join ', ', map { (split / /, $args[$_])[1] } (0..@args); + $macros .= <<"EOM"; +#define VTABLE_$entry->[1]($args) \\ + (pmc)->vtable->$entry->[1]($args) +EOM + } + $macros; } "SQUAWK"; --- parrot/vtable_h.pl Fri Jun 21 21:00:01 2002 +++ parrot-leo/vtable_h.pl Mon Mar 24 10:42:40 2003 @@ -32,5 +32,7 @@ print OUT vtbl_struct($vtable); +print OUT vtbl_macros($vtable); + print OUT "\n#endif\n";