cvsuser 04/11/11 02:30:58
Modified: lib/Parrot Pmc2c.pm
Log:
Refactor to avoid needless passing of filenames, and make clear what is a
method and what is a function.
Revision Changes Path
1.53 +72 -80 parrot/lib/Parrot/Pmc2c.pm
Index: Pmc2c.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Pmc2c.pm,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -r1.52 -r1.53
--- Pmc2c.pm 10 Nov 2004 23:18:36 -0000 1.52
+++ Pmc2c.pm 11 Nov 2004 10:30:57 -0000 1.53
@@ -1,5 +1,5 @@
# Copyright: 2004 The Perl Foundation. All Rights Reserved.
-# $Id: Pmc2c.pm,v 1.52 2004/11/10 23:18:36 nicholas Exp $
+# $Id: Pmc2c.pm,v 1.53 2004/11/11 10:30:57 nicholas Exp $
=head1 NAME
@@ -26,7 +26,7 @@
use Parrot::PMC qw(%pmc_types);
use base qw( Exporter );
[EMAIL PROTECTED] = qw(gen_c gen_h gen_ret dynext_load_code count_newlines);
[EMAIL PROTECTED] = qw(count_newlines gen_ret dont_edit);
BEGIN {
@writes = qw(STORE PUSH POP SHIFT UNSHIFT DELETE);
@@ -57,6 +57,29 @@
return scalar $_[0] =~ tr/\n//;
}
+=item C<dont_edit($pmcfile)>
+
+Returns the "DO NOT EDIT THIS FILE" warning text. C<$pmcfile> is the name
+of the original source F<*.pmc> file.
+
+=cut
+
+sub dont_edit {
+ my ($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
+}
+
=item C<gen_ret($method, $body)>
Generate the C code for a C<return> statement, if the body is empty then
@@ -312,29 +335,6 @@
}
-=item C<dont_edit($pmcfile)>
-
-Returns the "DO NOT EDIT THIS FILE" warning text. C<$pmcfile> is the name
-of the original source F<*.pmc> file.
-
-=cut
-
-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
-}
-
=item C<decl($classname, $method, $for_header)>
Returns the C code for the PMC method declaration. C<$for_header>
@@ -894,17 +894,15 @@
$cout;
}
-=item C<gen_c($file)>
+=item C<gen_c()>
Generates the C implementation file code for the PMC.
-C<$file> is the name of the original source F<*.pmc> file.
-
=cut
sub gen_c() {
- my ($self, $file) = @_;
- my $cout = $self->dont_edit($file);
+ my ($self) = @_;
+ my $cout = dont_edit($self->{file});
$cout .= $self->{pre};
$cout .= $self->includes;
my $l = count_newlines($cout);
@@ -948,17 +946,15 @@
$hout;
}
-=item C<gen_h($file)>
+=item C<gen_h()>
Generates the C header file code for the PMC.
-C<$file> is the name of the original source F<*.pmc> file.
-
=cut
sub gen_h() {
- my ($self, $file) = @_;
- my $hout = $self->dont_edit($file);
+ my ($self) = @_;
+ my $hout = dont_edit($self->{file});
my $name = uc $self->{class};
$hout .= <<"EOH";
@@ -1559,58 +1555,54 @@
}, $class;
}
+sub _write_a_file($$$) {
+ my ($generator, $h_name, $c_name) = @_;
+ my $opt = $generator->{opt};
+ local (*H, *C);
+
+ print Data::Dumper->Dump([$generator]) if $opt->{debug} > 1;
+ my $hout = $generator->gen_h();
+ print $hout if $opt->{debug};
+ print "Writing $h_name\n" if $opt->{verbose};
+ open H, ">$h_name" or die "Can't write '$h_name";
+ print H $hout;
+ close H;
+ my $cout = $generator->gen_c();
+ print $cout if $opt->{debug};
+ print "Writing $c_name\n" if $opt->{verbose};
+ open C, ">$c_name" or die "Can't write '$c_name";
+ print C $cout;
+ close C;
+}
+
=item C<write_all_files()>
Writes C and header files for all the PMCs in the library,
-plus E<lt>libnameE<gt>.c and pmc_E<lt>libnameE<gt>.h if his object
+I<or> E<lt>libnameE<gt>.c and pmc_E<lt>libnameE<gt>.h if his object
represents a named library.
=cut
sub write_all_files {
my $self = shift;
- my %opt = %{$self->{opt}};
- my $library = $opt{library} ? 1 : 0;
+ my $library = $self->{opt}{library};
- if (!$library) {
- while (my @fc = each %{$self->{pmcs}}) {
- my ($file, $generator) = @fc;
- 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;
- }
+ if ($library) {
+ my $hout = $self->gen_h($library);
+ my $h = "$library.h";
+ my $c = "$library.c";
+ _write_a_file($self, $h, $c);
+ } else {
+ while (my @fc = each %{$self->{pmcs}}) {
+ my ($file, $generator) = @fc;
+ my $h;
+ ($h = $file) =~ s/\.\w+$/.h/;
+ $h =~ s/(\w+)\.h$/pmc_$1.h/;
+ my $c;
+ ($c = $file) =~ s/\.\w+$/.c/;
- }
- else {
- my $hout = $self->gen_h($opt{library});
- my $h = "$opt{library}.h";
- print "Writing $h\n" if $opt{verbose};
- open H, ">$h" or die "Can't write '$h";
- print H $hout;
- close H;
- my $cout = $self->gen_c($opt{library});
- print $cout if $opt{debug};
- my $c = "$opt{library}.c";
- print "Writing $c\n" if $opt{verbose};
- open C, ">$c" or die "Can't write '$c";
- print C $cout;
- close C;
+ _write_a_file($generator, $h, $c);
+ }
}
}
@@ -1621,8 +1613,8 @@
=cut
sub gen_h {
- my ($self, $file) = @_;
- my $hout = Parrot::Pmc2c->dont_edit('various files');
+ my ($self) = @_;
+ my $hout = Parrot::Pmc2c::dont_edit('various files');
my $lc_libname = lc $self->{opt}{library};
$hout .= <<"EOH";
@@ -1639,8 +1631,8 @@
=cut
sub gen_c {
- my ($self, $file) = @_;
- my $cout = Parrot::Pmc2c->dont_edit('various files');
+ my ($self) = @_;
+ my $cout = Parrot::Pmc2c::dont_edit('various files');
$cout .= $self->includes;
$cout .= Parrot::Pmc2c::dynext_load_code($self->{opt}{library},
