cvsuser 03/10/07 08:40:38
Modified: . MANIFEST
Added: classes pmc2c2.pl
lib/Parrot Pmc2c.pm
Log:
new pmc compiler
* experimental of course
* no Makefile integration
* not too much docs yet
* dynamic pmc handling is missing
Revision Changes Path
1.449 +2 -0 parrot/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.448
retrieving revision 1.449
diff -u -w -r1.448 -r1.449
--- MANIFEST 7 Oct 2003 05:07:14 -0000 1.448
+++ MANIFEST 7 Oct 2003 15:40:24 -0000 1.449
@@ -58,6 +58,7 @@
classes/perlstring.pmc []
classes/perlundef.pmc []
classes/pmc2c.pl []
+classes/pmc2c2.pl []
classes/pointer.pmc []
classes/ref.pmc []
classes/retcontinuation.pmc []
@@ -2067,6 +2068,7 @@
lib/Parrot/PackFile/FixupTable.pm [devel]
lib/Parrot/PakFile2.pm [devel]
lib/Parrot/PakFile2.xs [devel]
+lib/Parrot/Pmc2c.pm [devel]
lib/Parrot/String.pm [devel]
lib/Parrot/Test.pm [devel]
lib/Parrot/Types.pm [devel]
1.1 parrot/classes/pmc2c2.pl
Index: pmc2c2.pl
===================================================================
#! /usr/bin/perl -w
#
# pmc2c2.pl
#
# Generate a C source and a header
# file from the methods defined in a .pmc file.
#
=head1 NAME
pmc2c2.pl - V2 PMC compiler
=head1 SYNOPSIS
=over 4
=item perl classes/pmc2c2.pl --dump classes/foo.pmc ...
Create F<classes/foo.dump>
=item perl pmc2c2.pl --vtable
Create F<vtable.dump>
=item perl classes/pmc2c2.pl --tree classes/*.pmc
Print class tree of given pmcs.
=item perl classes/pmc2c2.pl -c classes/foo.pmc ...
TODO create classes/foo.{c,h} from classes/foo.dump
=back
=cut
use FindBin;
use lib 'lib';
use lib "$FindBin::Bin/..";
use lib "$FindBin::Bin/../lib";
use Parrot::Vtable;
use Parrot::Pmc2c;
use strict;
use Data::Dumper;
use Getopt::Long;
my %opt;
main();
sub dump_default {
my $default = parse_vtable("$FindBin::Bin/../vtable.tbl");
open(VTD, ">vtable.dump") or die "Can't write vtable.dump";
my %vt;
$vt{flags} = {};
$vt{pre} = '';
$vt{post} = '';
my %meth_hash;
my $i = 0;
foreach my $entry (@$default) {
$meth_hash{$entry->[1]} = $i++;
push ( @{$vt{methods}},
{
parameters => $entry->[2],
meth => $entry->[1],
type => $entry->[0],
section => $entry->[3]
});
}
$vt{'has_method'} = \%meth_hash;
my $Dumper = Data::Dumper->new([\%vt], [qw(class)]);
$Dumper->Indent(3);
print VTD $Dumper->Dump();
close VTD;
}
sub count_newlines {
return scalar(() = $_[0] =~ /\n/g);
}
sub extract_balanced {
my $balance = 0;
my $lines = 0;
for(shift) {
s/^(\s+)//;
$lines += count_newlines($1);
/^\{/ or die "bad block open: ".substr($_,0,10),"..."; # }
while(/(\{)|(\})/g) {
if($1) {
$balance++;
} else { # $2
--$balance or return (substr($_, 0, pos, ""), $_, $lines);
}
}
die "Badly balanced" if $balance;
}
}
sub parse_flags {
my $c = shift;
$$c =~ s/^(.*?^\s*)pmclass ([\w]*)//ms;
my ($pre, $classname) = ($1, $2);
my %has_value = ( does => 1, extends => 1 );
my %flags;
# look through the pmc declaration header for flags such as noinit
while ($$c =~ s/^(?:\s*)(\w+)//s) {
if ($has_value{$1}) {
my $what = $1;
if (s/^(?:\s+)(\w+)//s) {
$flags{$what}{$1} = 1;
}
else {
die "Parser error: no value for '$what'";
}
}
else {
$flags{$1} = 1;
}
}
# setup some defaults
if ($classname eq 'OrderedHash') {
#$flags{extends}{PerlHash} = 1;
}
if ($classname ne 'default') {
$flags{extends}{default} = 1 unless $flags{extends};
$flags{does}{scalar} = 1 unless $flags{does};
}
($pre, $classname, \%flags);
}
sub parse_pmc {
local $_ = shift;
my $signature_re = qr{
^
(?: #blank spaces and comments and spurious semicolons
[;\n\s]*
(?:/\*.*?\*/)? # C-like comments
)*
(\w+\**) #type
\s+
(\w+) #method name
\s*
\(([^\(]*)\) #parameters
}sx;
my ($pre, $classname, $flags) = parse_flags(\$_);
my $lineno = 1;
$lineno += count_newlines($pre);
my ($classblock, $post, $lines) = extract_balanced($_);
$classblock = substr($classblock, 1,-1); # trim out the { }
my (@methods, %meth_hash);
while ($classblock =~ s/($signature_re)//) {
$lineno += count_newlines($1);
my ($type, $methodname, $parameters) = ($2,$3,$4);
my ($methodblock, $rema, $lines) = extract_balanced($classblock);
$lineno += $lines;
$methodblock = "" if $opt{nobody};
# name => method idx mapping
$meth_hash{$methodname} = scalar @methods;
push @methods,
{ 'meth' => $methodname,
'body' => $methodblock,
'line' => $lineno,
'type' => $type,
'parameters' => $parameters
};
$classblock = $rema;
$lineno += count_newlines($methodblock);
}
return ( $classname, {
'pre' => $pre,
'flags' => $flags,
'methods' => [EMAIL PROTECTED],
'post' => $post,
'class' => $classname,
'has_method' => \%meth_hash
}
);
}
# make a linear list of class->{parents} array
sub gen_parent_list {
my ($this, $all) = @_;
my @todo = ($this);
my $class = $all->{$this};
while (@todo) {
my $n = shift @todo;
my $sub = $all->{$n};
next if $n eq 'default';
foreach my $parent (keys %{$sub->{flags}{extends}}) {
next if exists $class->{has_parent}{$parent};
if (!$all->{$parent}) {
my $pf = lc $parent;
$all->{$parent} = read_dump("classes/$pf.pmc");
}
$class->{has_parent}{$parent} = { %{$all->{$parent}{has_method} }};
push(@todo, $parent);
push(@{ $class->{parents} }, $parent);
}
}
}
sub dump_1_pmc {
my $file = shift;
$file =~ s/\.\w+/.pmc/;
print "Reading $file\n" if $opt{verbose};
open F, "<$file" or die "Can't read '$file'";
local $/;
my $contents = <F>;
close F;
return parse_pmc($contents);
}
sub gen_super_meths {
my ($self, $vt) = @_;
# look through all meths in class and locate the nearest parent
foreach my $entry (@{ $vt->{methods} } ) {
my $meth = $entry->{meth};
next if exists $self->{super}{$meth};
foreach my $pname (@{ $self->{parents} } ) {
if (exists $self->{has_parent}{$pname}{$meth} ) {
$self->{super}{$meth} = $pname;
last;
}
}
unless (exists $self->{super}{$meth}) {
$self->{super}{$meth} = 'default';
}
}
}
sub add_defaulted {
my ($class, $vt) = @_;
my $i = @{ $class->{methods} };
foreach my $e ( @{$vt->{methods}} ) {
my $meth = $e->{meth};
$class->{super}{$meth} = 'default';
}
}
sub dump_pmc {
my @files = @_;
my %all;
foreach my $file (@files) {
my ($class, $res) = dump_1_pmc($file);
$res->{file} = $file;
$all{$class} = $res;
}
my $vt = read_dump("vtable.pmc");
if (!$all{default}) {
$all{default} = read_dump("classes/default.pmc");
}
add_defaulted($all{default}, $vt);
foreach my $name (keys %all) {
my $dump;
my $file = $all{$name}->{file};
($dump = $file) =~ s/\.\w+/\.dump/;
gen_parent_list($name, \%all);
my $class = $all{$name};
gen_super_meths($class, $vt);
my $Dumper = Data::Dumper->new([$class], [qw(class)]);
$Dumper->Indent(1);
open PMD, ">$dump" or die "Can't write '$dump";
print PMD $Dumper->Dump;
close PMD;
}
}
sub read_dump {
my $file = shift;
my $dump;
($dump = $file) =~ s/\.\w+/.dump/;
unless ( -e $dump) {
if ($dump =~ m!^classes/!) {
$dump =~ s!^classes/!!;
}
elsif ($dump =~ m!^vtable!) {
$dump = "../vtable.dump";
}
}
print "Reading $dump\n" if $opt{verbose};
open D, "<$dump" or die "Can't read '$dump'";
local $/;
my $contents = <D>;
close D;
my $class;
# $class => { ... };
eval $contents;
die $@ if $@;
$class;
}
sub print_tree {
my ($depth, @files) = @_;
foreach my $file (@files) {
my $class = read_dump($file);
my $name = $class->{class};
print " " x $depth, $name, "\n";
foreach my $parent (keys %{$class->{flags}{extends}}) {
my $pmc = "classes/" . lc($parent) . ".pmc";
print_tree($depth + 1, $pmc);
}
}
}
sub gen_c {
my (@files) = @_;
foreach my $file (@files) {
my $class = read_dump($file);
# finally append vtable.dump
$class->{vtable} = read_dump("vtable.pmc");
my $generator = Parrot::Pmc2c->new($class, \%opt);
print Data::Dumper->Dump([$generator]) if $opt{debug} > 1;
my $hout = $generator->gen_h($file);
print $hout if $opt{debug};
my $h;
($h = $file) =~ s/\.\w+/.h/;
$h =~ s/(\w+)\.h/pmc_$1.h/;
print "Writing $h\n" if $opt{verbose};
open H, ">$h" or die "Can't write '$h";
print H $hout;
close H;
my $cout = $generator->gen_c($file);
print $cout if $opt{debug};
my $c;
($c = $file) =~ s/\.\w+/.c/;
print "Writing $c\n" if $opt{verbose};
open C, ">$c" or die "Can't write '$c";
print C $cout;
close C;
}
}
sub main {
my ($default, $dump, $gen_c, $result, $tree, $debug, $verbose, $nobody,
$nolines);
$result = GetOptions(
"vtable" => \$default,
"dump" => \$dump,
"c|gen-c" => \$gen_c,
"tree" => \$tree,
"nobody" => \$nobody,
"nolines" => \$nolines,
"debug+" => \$debug,
"verbose+" => \$verbose,
);
$opt{debug} = $debug || 0;
$opt{verbose} = $verbose || 0;
$opt{nobody} = $nobody || 0;
$opt{nolines} = $nolines || 0;
$default and do {
dump_default();
exit;
};
$dump and do {
dump_pmc(@ARGV);
exit;
};
$tree and do {
print_tree(0, @ARGV);
exit;
};
$gen_c and do {
gen_c(@ARGV);
exit;
};
}
# vim: expandtab shiftwidth=4:
1.1 parrot/lib/Parrot/Pmc2c.pm
Index: Pmc2c.pm
===================================================================
package Parrot::Pmc2c;
use vars qw(@EXPORT_OK @writes %writes );
use base qw( Exporter );
@EXPORT_OK = qw(gen_c gen_h);
BEGIN {
@writes = qw(STORE PUSH POP SHIFT UNSHIFT DELETE);
@[EMAIL PROTECTED] = (1) x @writes;
};
sub does_write($$) {
my ($meth, $section) = @_;
exists $writes{$section} || $meth eq 'morph';
}
sub get_vtable_section() {
my $self = shift;
# make a hash of all method names containing vtable section
my $vt = $self->{vtable};
foreach my $entry (@{ $vt->{methods} } ) {
$self->{all}{$entry->{meth}} = $entry->{section};
}
}
sub make_const() {
my ($self, $class) = @_;
my $const = bless {}, $class . '::Const';
$self->{const} = $const;
my @methods = @{ $self->{methods} };
# copy super
$const->{super} = { %{ $self->{super} } };
my $i;
foreach my $entry (@methods) {
my $meth = $entry->{meth};
if (does_write($meth, $self->{all}{$meth})) {
# create methods if they write
$const->{has_method}{$meth} = $i++;
push @{ $const->{methods} }, {
meth => "$meth",
type => $entry->{type},
parameters => $entry->{parameters}
};
}
else {
# if not - they are inherited from $self
$const->{super}{$meth} = $self->{class};
}
}
# copy parent(s), prepend self as parrent
$const->{parents} = [ $self->{class}, @{ $self->{parents} } ];
# copy flags, set is_const
$const->{flags} = {is_const => 1, %{ $self->{flags} } };
delete $const->{flags}{const_too};
# set const in does
$const->{flags}{does}{const} = 1;
# set classname
$const->{class} = "Const" . $self->{class};
# and alias vtable
$const->{vtable} = $self->{vtable};
# set parentname
$const->{parentname} = $self->{class};
}
sub init() {
my ($self, $class) = @_;
$self->get_vtable_section();
$self->make_const($class) if $self->{flags}{const_too};
}
sub class_name {
my ($self, $class) = @_;
my %special = ( 'Ref' => 1, 'default' => 1 );
my $classname = $self->{class};
my $nclass = $class;
# bless object into different classes inheriting from
# Parrot::Pmc2c
if ($special{$classname}) {
$nclass .= "::" . $classname;
}
else {
$nclass .= "::Standard";
}
$nclass;
}
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = shift;
$self->{opt} = shift;
$class = class_name($self, $class);
bless $self, $class;
$self->init($class);
$self;
}
sub count_newlines {
return scalar(() = $_[0] =~ /\n/g);
}
sub dont_edit() {
my ($self, $pmcfile) = @_;
return <<"EOC";
/*
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
*
* This file is generated automatically from '$pmcfile'
* by $0.
*
* Any changes made here will be lost!
*
*/
EOC
}
sub decl() {
my ($self, $classname, $method, $for_header) = @_;
my $ret = $method->{type};
my $meth= $method->{meth};
my $args= $method->{parameters};
$args = ", $args" if $args =~ /\S/;
my ($extern, $newl, $semi, $interp, $pmc);
if ($for_header) {
$extern = "extern ";
$newl = " ";
$semi = ";";
$interp = $pmc = "";
}
else {
$extern = "";
$newl = "\n";
$semi = "";
$interp = ' interpreter';
$pmc = ' pmc';
}
return <<"EOC";
$extern$ret${newl}Parrot_${classname}_$meth(Parrot_Interp$interp, PMC*$pmc$args)$semi
EOC
}
sub includes() {
my $self = shift;
my $cout = "";
foreach my $parents ($self->{class}, @{ $self->{parents} } ) {
my $name = lc $parents;
$cout .= <<"EOC";
#include "pmc_$name.h"
EOC
}
"$cout\n";
}
sub full_arguments {
my $args = shift;
if ($args =~ /\S/) {
return "INTERP, SELF, $args";
} else {
return "INTERP, SELF";
}
}
sub rewrite_method ($$$$$) {
my ($class, $method, $super, $super_table) = @_;
local $_ = $_[4];
# Rewrite method body
my $supertype = "enum_class_$super";
die "$class defines unknown vtable method '$method'\n"
if ! defined $super_table->{$method};
my $supermethod = "Parrot_" . $super_table->{$method} . "_$method";
# Rewrite DYNSUPER(args...)
s/DYNSUPER\(\s*(.*?)\)/"Parrot_base_vtables[$supertype].$method(".full_arguments($1).")"/eg;
# Rewrite OtherClass.SUPER(args...)
s/(\w+)\.SUPER\(\s*(.*?)\)/"Parrot_${1}_$method(".full_arguments($2).")"/eg;
# Rewrite SUPER(args...)
s/SUPER\(\s*(.*?)\)/"$supermethod(".full_arguments($1).")"/eg;
# Rewrite DYNSELF.other_method(args...)
s/DYNSELF\.(\w+)\(\s*(.*?)\)/"pmc->vtable->$1(".full_arguments($2).")"/eg;
# Rewrite DYNSELF(args...). See comments above.
s/DYNSELF\(\s*(.*?)\)/"pmc->vtable->$method(".full_arguments($1).")"/eg;
# Rewrite OtherClass.SELF.other_method(args...)
s/(\w+)\.SELF\.(\w+)\(\s*(.*?)\)/"Parrot_${1}_$2(".full_arguments($3).")"/eg;
# Rewrite SELF.other_method(args...)
s/SELF\.(\w+)\(\s*(.*?)\)/"Parrot_${class}_$1(".full_arguments($2).")"/eg;
# Rewrite SELF -> pmc, INTERP -> interpreter
s/SELF/pmc/g;
s/INTERP/interpreter/g;
# now use macros for all rewritten stuff
s/\b(?:\w+)->vtable->(\w+)\(/ VTABLE_$1(/g;
return $_;
}
sub body
{
my ($self, $method) = @_;
my $cout = "";
my $classname = $self->{class};
my $pmc = lc($classname) .'.pmc';
my $meth = $method->{meth};
unless ($self->{opt}{nolines}) {
$cout .= <<"EOC";
#line $method->{line} "$pmc"
EOC
}
$cout .= $self->decl($classname, $method, 0);
my $body = $method->{body};
$body =~ s/^\t/ /mg;
$body =~ s/^[ ]{4}//mg;
my $super = $self->{super}{$meth};
$cout .= rewrite_method($classname, $meth, $super, $self->{super},
$body);
$cout .= "\n\n";
}
sub methods() {
my ($self, $line) = @_;
my $cout = "";
foreach my $method (@{ $self->{vtable}{methods}} ) {
next if $method->{meth} eq 'class_init';
my $ret = $self->body($method, $line);
$line += count_newlines($ret);
$cout .= $ret;
}
$cout;
}
sub init_func() {
my $self = shift;
my $cout = "";
return "" if exists $self->{flags}{noinit};
# gen C line comment
my $classname = $self->{class};
my $vtbl_flag = $self->{flags}{const_too} ?
'VTABLE_HAS_CONST_TOO' : $self->{flags}{is_const} ?
'VTABLE_IS_CONST_FLAG' : 0;
if (exists $self->{flags}{need_ext}) {
$vtbl_flag .= '|VTABLE_PMC_NEEDS_EXT';
}
my @meths;
foreach my $method (@{ $self->{vtable}{methods}} ) {
my $meth = $method->{meth};
if ($self->implements($meth)) {
push @meths, "Parrot_${classname}_$meth";
}
elsif (exists $self->{super}{$meth}) {
my $class = $self->{super}{$meth};
push @meths, "Parrot_${class}_$meth";
}
else {
push @meths, "Parrot_default_$meth";
}
}
my $methlist = join(",\n ", @meths);
my $isa = join(" ", $classname, @{ $self->{parents} });
$isa =~ s/\s?default$//;
my $does = join(" ", keys(%{ $self->{flags}{does} }));
my $n = exists $self->{has_method}{class_init} ?
$self->{has_method}{class_init} : -1;
my $class_init_code = $n >= 0 ? $self->{methods}[$n]{body} : "";
$class_init_code =~ s/INTERP/interp/g;
$cout .= <<"EOC";
void
Parrot_${classname}_class_init(Parrot_Interp interp, int entry)
{
struct _vtable temp_base_vtable = {
NULL, /* package */
enum_class_$classname, /* base_type */
NULL, /* whoami */
NULL, /* method_table */
$vtbl_flag, /* flags */
NULL, /* does_str */
NULL, /* isa_str */
NULL, /* extra data */
$methlist
EOC
$cout .= <<"EOC";
};
/*
* parrotio calls some class_init functions during its class_init
* code, so some of the slots might already be allocated
*/
if (!Parrot_base_vtables[entry]) {
temp_base_vtable.whoami = string_make(interp,
"$classname", @{[length($classname)]}, 0,
PObj_constant_FLAG|PObj_external_FLAG , 0);
temp_base_vtable.isa_str = string_make(interp,
"$isa", @{[length($isa)]}, 0,
PObj_constant_FLAG|PObj_external_FLAG , 0);
temp_base_vtable.does_str = string_make(interp,
"$does", @{[length($does)]}, 0,
PObj_constant_FLAG|PObj_external_FLAG , 0);
Parrot_base_vtables[entry] =
Parrot_clone_vtable(interp, &temp_base_vtable);
}
$class_init_code
} /* Parrot_${classname}_class_init */
EOC
$cout;
}
sub gen_c() {
my ($self, $file) = @_;
my $cout = $self->dont_edit($file);
$cout .= $self->{pre};
$cout .= $self->includes;
my $l = count_newlines($cout);
$cout .= $self->methods($l);
$cout .= $self->init_func;
if ($self->{const}) {
$cout .= $self->{const}->methods($l);
$cout .= $self->{const}->init_func;
}
$cout .= $self->{post};
$cout;
}
sub gen_h() {
my ($self, $file) = @_;
my $hout = $self->dont_edit($file);
my $classname = $self->{class};
# generat decls for all methods in this file
foreach my $meth (@{ $self->{vtable}{methods} } ) {
if ($self->implements($meth->{meth})) {
$hout .= $self->decl($classname, $meth, 1);
}
}
# class init decl
$hout .= <<"EOC";
void Parrot_${classname}_class_init(Parrot_Interp, int);
EOC
if ($self->{const}) {
$self = $self->{const};
my $classname = $self->{class};
$hout .= "\n/* Const */\n";
foreach my $meth (@{ $self->{methods} } ) {
$hout .= $self->decl($classname, $meth, 1);
}
$hout .= <<"EOC";
void Parrot_${classname}_class_init(Parrot_Interp, int);
EOC
}
$hout;
}
# true if this class generates code for $meth
sub implements
{
my ($self, $meth) = @_;
return exists $self->{has_method}{$meth};
}
# standard behavior
package Parrot::Pmc2c::Standard;
use base 'Parrot::Pmc2c';
sub body
{
my ($self, $method) = @_;
my $meth = $method->{meth};
# exisiting methods get emitted
if ($self->implements($meth)) {
my $n = $self->{has_method}{$meth};
return $self->SUPER::body($self->{methods}[$n]);
}
"";
}
# through excepton if meth writes
package Parrot::Pmc2c::Standard::Const;
use base 'Parrot::Pmc2c::Standard';
sub body {
my ($self, $method) = @_;
my $meth = $method->{meth};
return "" unless ($self->implements($meth));
my $decl = $self->decl($self->{class}, $method, 0);
my $classname = $self->{class};
my $parentname = $self->{parentname};
my $ret = $method->{type} eq 'void' ? "" : "return ($method->{type})0;";
my $cout = <<"EOC";
$decl {
EOC
if ($meth eq 'morph') {
$cout .= <<EOC;
if (Parrot_is_const_pmc(interpreter, pmc))
internal_exception(WRITE_TO_CONSTCLASS,
"$meth() in $classname");
else
Parrot_${parentname}_$meth(interpreter, pmc, type);
EOC
}
else {
$cout .= <<EOC;
internal_exception(WRITE_TO_CONSTCLASS,
"$meth() in $classname");
$ret
EOC
}
$cout .= <<"EOC";
}
EOC
$cout;
}
# Ref directs all unknow methods to the referee
package Parrot::Pmc2c::Ref;
use base 'Parrot::Pmc2c';
sub implements
{
1;
}
sub body
{
my ($self, $method, $line) = @_;
my $meth = $method->{meth};
# exisiting methods get emitted
if ($self->SUPER::implements($meth)) {
my $n = $self->{has_method}{$meth};
return $self->SUPER::body($self->{methods}[$n]);
}
my $parameters = $method->{parameters};
my $n=0;
my @args = grep {$n++ & 1 ? $_ : 0} split / /, $parameters;
my $arg = '';
$arg = ", ". join(' ', @args) if @args;
$parameters = ", $parameters" if $parameters;
my $body = "VTABLE_$meth(interpreter, PMC_ptr2p(pmc)$arg)";
my $ret = $method->{type} eq 'void' ? "$body;" : "return $body;" ;
my $decl = $self->decl($self->{class}, $method, 0);
my $l = "";
unless ($self->{opt}{nolines}) {
$l = <<"EOC";
#line $line "ref.c"
EOC
}
return <<EOC;
$l
$decl {
$ret
}
EOC
}
# default throws an execption for unknown meths
package Parrot::Pmc2c::default;
use base 'Parrot::Pmc2c';
sub implements
{
1;
}
sub body
{
my ($self, $method, $line) = @_;
my $meth = $method->{meth};
# exisiting methods get emitted
if ($self->SUPER::implements($meth)) {
my $n = $self->{has_method}{$meth};
return $self->SUPER::body($self->{methods}[$n]);
}
my $decl = $self->decl($self->{class}, $method, 0);
my $l = "";
my $ret = $method->{type} eq 'void' ? "" : "return ($method->{type})0;";
unless ($self->{opt}{nolines}) {
$l = <<"EOC";
#line $line "default.c"
EOC
}
return <<EOC;
$l
${decl} {
internal_exception(ILL_INHERIT,
"$meth() not implemented in class '%s'",
caller(interpreter, pmc));
$ret
}
EOC
}
# vim: expandtab shiftwidth=4:
1;
