cvsuser 04/08/22 02:00:19
Modified: classes pmc2c2.pl
dynclasses foo.pmc
imcc parser_util.c
lib/Parrot Pmc2c.pm
src packfile.c
Log:
[perl #31268] [PATCH] Dynamic library with multiple PMCs
as promised with this patch:
pmc2c2 ... --library foo --c pmc1.pmc pmc2.pmc pmc3.pmc ...
outputs pmcX.c and pmc_pmcX.h as it did before, plus
foo.c and pmc_foo.h containig a single Parrot_lib_foo_load
that initialized vtables and MMD dispatch for all the PMCs,
taking into account circular PMC dependencies in MMD dispatch.
It also updated dynext/foo.pmc removing the now useless #define to -1
and pmc2c2.pl to search for PMCs/PMC dumps in the current directory, too.
[perl #31269] [PATCH] More packgile dixes
this patch fixes some problems with previous week's patch:
it allowed loading and running bytecode when there was no current
packfile (interpreter->code == NULL) but created a circular
dependency with the loaded packfile containing itself in its
directory.
The attached patch removes this circular dependency.
Courtesy of Mattia Barbon <[EMAIL PROTECTED]>
Revision Changes Path
1.15 +24 -28 parrot/classes/pmc2c2.pl
Index: pmc2c2.pl
===================================================================
RCS file: /cvs/public/parrot/classes/pmc2c2.pl,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- pmc2c2.pl 15 Aug 2004 10:08:58 -0000 1.14
+++ pmc2c2.pl 22 Aug 2004 09:00:05 -0000 1.15
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: pmc2c2.pl,v 1.14 2004/08/15 10:08:58 leo Exp $
+# $Id: pmc2c2.pl,v 1.15 2004/08/22 09:00:05 leo Exp $
=head1 NAME
@@ -24,6 +24,12 @@
% perl classes/pmc2c2.pl -c classes/foo.pmc ...
+Create fooX.c and pmc_fooX.h from fooX.dump files, also create libfoo.c
+containing the initialization function for all fooX PMCs.
+
+ % perl classes/pmc2c2.pl --library libfoo -c \
+ classes/foo1.pmc classes/foo2.pmc ...
+
=head1 DESCRIPTION
The job of the PMC compiler is to take .pmc files and create C files which
@@ -53,6 +59,12 @@
Specify include path where to find PMCs.
+=item C<--library=libname>
+
+Specifiy the library name. This will create E<lt>libnameE<gt>.c and
+pmc_E<lt>libnameE<gt>.h. The initialization function will be named
+after libname and will initialize all PMCs in the library.
+
=back
=head2 Internals
@@ -561,35 +573,17 @@
sub gen_c {
my $include = shift;
my (@files) = @_;
- foreach my $file (@files) {
- my $class = read_dump($include, $file);
- # finally append vtable.dump
- $class->{vtable} = read_dump($include, "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;
- }
+
+ my $library = Parrot::Pmc2c::Library->new
+ ( \%opt, read_dump($include, "vtable.pmc"),
+ map { $_, read_dump($include, $_) }
+ @files );
+
+ $library->write_all_files;
}
sub main {
- my ($default, $dump, $gen_c, $result, $tree, $debug, $verbose, $nobody,
$nolines, @include);
+ my ($default, $dump, $gen_c, $result, $tree, $debug, $verbose, $nobody,
$nolines, @include, $library);
$result = GetOptions(
"vtable" => \$default,
"dump" => \$dump,
@@ -600,12 +594,14 @@
"debug+" => \$debug,
"verbose+" => \$verbose,
"include=s" => [EMAIL PROTECTED],
+ "library=s" => \$library,
);
$opt{debug} = $debug || 0;
$opt{verbose} = $verbose || 0;
$opt{nobody} = $nobody || 0;
$opt{nolines} = $nolines || 0;
- unshift @include, "$FindBin::Bin/..", $FindBin::Bin;
+ $opt{library} = $library;
+ unshift @include, ".", "$FindBin::Bin/..", $FindBin::Bin;
$default and do {
dump_default();
1.4 +0 -5 parrot/dynclasses/foo.pmc
Index: foo.pmc
===================================================================
RCS file: /cvs/public/parrot/dynclasses/foo.pmc,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- foo.pmc 25 Aug 2003 09:46:29 -0000 1.3
+++ foo.pmc 22 Aug 2004 09:00:15 -0000 1.4
@@ -4,11 +4,6 @@
#include "parrot/parrot.h"
-/*
- * the real class enum is created at load time
- */
-#define enum_class_Foo -1
-
pmclass Foo dynpmc {
INTVAL get_integer() {
1.75 +6 -5 parrot/imcc/parser_util.c
Index: parser_util.c
===================================================================
RCS file: /cvs/public/parrot/imcc/parser_util.c,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -w -r1.74 -r1.75
--- parser_util.c 15 Aug 2004 10:09:00 -0000 1.74
+++ parser_util.c 22 Aug 2004 09:00:16 -0000 1.75
@@ -477,13 +477,14 @@
}
#endif
PackFile_fixup_subs(interp);
+ if (pf_save) {
/* restore old byte_code, */
- if (pf_save)
(void)Parrot_switch_to_cs(interp, pf_save->cur_cs, 0);
- sourcefile = source;
/* append new packfile to current directory */
PackFile_add_segment(&interp->code->directory,
&pf->directory.base);
+ }
+ sourcefile = source;
return pf;
}
1.38 +230 -30 parrot/lib/Parrot/Pmc2c.pm
Index: Pmc2c.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Pmc2c.pm,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -w -r1.37 -r1.38
--- Pmc2c.pm 17 Aug 2004 08:50:48 -0000 1.37
+++ Pmc2c.pm 22 Aug 2004 09:00:17 -0000 1.38
@@ -1,5 +1,5 @@
# Copyright: 2004 The Perl Foundation. All Rights Reserved.
-# $Id: Pmc2c.pm,v 1.37 2004/08/17 08:50:48 leo Exp $
+# $Id: Pmc2c.pm,v 1.38 2004/08/22 09:00:17 leo Exp $
=head1 NAME
@@ -105,33 +105,52 @@
$nclass;
}
-=item C<dynext_load_code($classname, $call_class_init)>
+=item C<dynext_load_code($library_name, @classes)>
-C<$classname> is the name of a PMC.
+C<$library_name> is the name of the dynamic library to be created.
-C<$call_class_init> is the C code for a call to the PMC's class
-initialization method.
+C<@classes> are the names of the PMCs for which initialization
+code is to be generated.
This function is exported.
=cut
sub dynext_load_code {
- my ($classname, $call_class_init ) = @_;
- my $lc_classname = lc $classname;
- return <<"EOC";
+ my ($libname, @classes ) = @_;
+ my $lc_libname = lc $libname;
+ my $cout;
+
+ $cout .= <<"EOC";
/*
* This load function will be called to do global (once) setup
* whatever is needed to get this extension running
*/
+#include "parrot/parrot.h"
+#include "parrot/extend.h"
#include "parrot/dynext.h"
-PMC* Parrot_lib_${lc_classname}_load(Interp *interpreter); /* don't warn */
-PMC* Parrot_lib_${lc_classname}_load(Interp *interpreter)
+EOC
+ foreach my $class (@classes) {
+ my $lc_class = lc $class;
+ $cout .= <<"EOC";
+#include "pmc_${lc_class}.h"
+EOC
+ }
+ $cout .= <<"EOC";
+
+Parrot_PMC Parrot_lib_${lc_libname}_load(Parrot_INTERP interpreter); /* don't warn
*/
+Parrot_PMC Parrot_lib_${lc_libname}_load(Parrot_INTERP interpreter)
{
- STRING *whoami;
- PMC *pmc;
- INTVAL type;
+ Parrot_STRING whoami;
+ Parrot_PMC pmc;
+EOC
+ foreach my $class (@classes) {
+ $cout .= <<"EOC";
+ Parrot_Int type${class};
+EOC
+ }
+ $cout .= <<"EOC";
int pass;
/*
@@ -145,12 +164,27 @@
/*
* for all PMCs we want to register:
*/
- whoami = string_from_cstring(interpreter, "$classname", 0);
- type = pmc_register(interpreter, whoami);
+EOC
+ foreach my $class (@classes) {
+ $cout .= <<"EOC";
+ whoami = string_from_cstring(interpreter, "$class", 0);
+ type${class} = pmc_register(interpreter, whoami);
+EOC
+ }
+ $cout .= <<"EOC";
+
/* do class_init code */
for (pass = 0; pass <= 1; ++pass) {
- $call_class_init
+EOC
+ foreach my $class (@classes) {
+ my $lc_class = lc $class;
+ $cout .= <<"EOC";
+ Parrot_${class}_class_init(interpreter, type$class, pass);
+EOC
+ }
+ $cout .= <<"EOC";
}
+
return pmc;
}
@@ -320,7 +354,7 @@
$pmc = ' pmc';
}
return <<"EOC";
-$extern$ret${newl}Parrot_${classname}_$meth(Parrot_Interp$interp,
PMC*$pmc$args)$semi
+$extern$ret${newl}Parrot_${classname}_$meth(Interp*$interp, PMC*$pmc$args)$semi
EOC
}
@@ -497,10 +531,7 @@
sub lib_load_code() {
my $self = shift;
my $classname = $self->{class};
- # TODO multiple (e.g. Const subclasses)
- my $call_class_init =
- "Parrot_${classname}_class_init(interpreter, type, pass);\n";
- return dynext_load_code($classname, $call_class_init);
+ return dynext_load_code($classname, $classname);
}
=item C<pmc_is_dynpmc>
@@ -617,13 +648,6 @@
which is passed in entry to class_init.
*/
EOC
- # init vtable slot
- if ($self->{flags}{dynpmc}) {
- $cout .= <<"EOC";
-
- temp_base_vtable.base_type = entry;
-EOC
- }
# declare auxiliary variables for dyncpmc IDs
foreach my $dynclass (keys %init_mmds) {
next if $dynclass eq $classname;
@@ -631,6 +655,13 @@
int my_enum_class_$dynclass = Parrot_PMC_typenum(interp, "$dynclass");
EOC
}
+ # init vtable slot
+ if ($self->{flags}{dynpmc}) {
+ $cout .= <<"EOC";
+
+ temp_base_vtable.base_type = entry;
+EOC
+ }
# init MMD "right" slots with the dynpmc types
foreach my $entry (@init_mmds) {
if ($entry->[1] eq $classname) {
@@ -652,7 +683,15 @@
EOC
}
$cout .= <<"EOC";
- if (!pass) {
+ if (pass == 0) {
+EOC
+ # init vtable slot
+ if ($self->{flags}{dynpmc}) {
+ $cout .= <<"EOC";
+ temp_base_vtable.base_type = entry;
+EOC
+ }
+ $cout .= <<"EOC";
/*
* Parrot_base_vtables is a true global - register just once
*/
@@ -676,7 +715,36 @@
EOC
$cout .= <<"EOC";
$class_init_code
- if (pass) {
+ if (pass == 1) {
+EOC
+ # declare auxiliary variables for dyncpmc IDs
+ foreach my $dynclass (keys %init_mmds) {
+ next if $dynclass eq $classname;
+ $cout .= <<"EOC";
+ int my_enum_class_$dynclass = Parrot_PMC_typenum(interp, "$dynclass");
+EOC
+ }
+ # init MMD "right" slots with the dynpmc types
+ foreach my $entry (@init_mmds) {
+ if ($entry->[1] eq $classname) {
+ $cout .= <<"EOC";
+ _temp_mmd_init[$entry->[0]].right = entry;
+EOC
+ }
+ else {
+ $cout .= <<"EOC";
+ _temp_mmd_init[$entry->[0]].right = my_enum_class_$entry->[1];
+EOC
+ }
+ }
+ # just to be safe
+ foreach my $dynclass (keys %init_mmds) {
+ next if $dynclass eq $classname;
+ $cout .= <<"EOC";
+ assert(my_enum_class_$dynclass != enum_class_default);
+EOC
+ }
+ $cout .= <<"EOC";
#define N_MMD_INIT (sizeof(_temp_mmd_init)/sizeof(_temp_mmd_init[0]))
Parrot_mmd_register_parents(interp, entry,
_temp_mmd_init, N_MMD_INIT);
@@ -1331,6 +1399,138 @@
=back
+=head1 Parrot::Pmc2c::Library
+
+This class is a wrapper around a collection of PMCs linked in the same
+dynamic library. A degenerate case is having an unnamed library with just ne
+PMC, which is the case used by the Parrot core.
+
+=head2 Parrot::Pmc2c::Library Instance Methods
+
+=over 4
+
+=cut
+
+package Parrot::Pmc2c::Library;
+
+=item C<new($opt, $vtable_dump, %pmcs)
+
+ $library = Parrot::Pmc2c::Library->new
+ ( $options, # hash refernce, the same passet to other constructors
+ $vtable_dump, # vtable.dump
+ pmc1 => $pmc1_dump,
+ pmc2 => $pmc2_dump,
+ ... );
+
+Creates a new library object. If the C<$options> hash contains a
+C<library> key its value will be used for the library name.
+
+=cut
+
+sub new {
+ my ($class, $opt, $vtable_dump) = (shift, shift, shift);
+ my %pmcs = @_;
+
+ foreach my $file (keys %pmcs) {
+ $pmcs{$file}->{vtable} = $vtable_dump;
+ $pmcs{$file} = Parrot::Pmc2c->new($pmcs{$file}, $opt);
+ }
+
+ return bless { opt => $opt,
+ pmcs => \%pmcs,
+ }, $class;
+}
+
+=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
+represents a named library.
+
+=cut
+
+sub write_all_files {
+ my $self = shift;
+ my %opt = %{$self->{opt}};
+ my $library = $opt{library} ? 1 : 0;
+
+ 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($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;
+ }
+}
+
+=item C<gen_h>
+
+Writes the header file for the library.
+
+=cut
+
+sub gen_h {
+ my ($self, $file) = @_;
+ my $hout = Parrot::Pmc2c->dont_edit('various files');
+ my $lc_libname = lc $self->{opt}{library};
+
+ $hout .= <<"EOH";
+Parrot_PMC Parrot_lib_${lc_libname}_load(Parrot_INTERP interpreter);
+EOH
+
+ return $hout;
+}
+
+=item C<gen_c>
+
+Writes the C file for the library.
+
+=cut
+
+sub gen_c {
+ my ($self, $file) = @_;
+ my $cout = Parrot::Pmc2c->dont_edit('various files');
+
+ $cout .= Parrot::Pmc2c::dynext_load_code($self->{opt}{library},
+ map { $_->{class} }
+ values %{$self->{pmcs}} );
+
+ return $cout;
+}
+
+=back
+
=head1 SEE ALSO
=over 4
1.171 +4 -3 parrot/src/packfile.c
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/src/packfile.c,v
retrieving revision 1.170
retrieving revision 1.171
diff -u -w -r1.170 -r1.171
--- packfile.c 7 Aug 2004 11:32:26 -0000 1.170
+++ packfile.c 22 Aug 2004 09:00:18 -0000 1.171
@@ -2,7 +2,7 @@
Copyright (C) 2001-2002 Gregor N. Purdy. All rights reserved.
This program is free software. It is subject to the same license as
Parrot itself.
-$Id: packfile.c,v 1.170 2004/08/07 11:32:26 leo Exp $
+$Id: packfile.c,v 1.171 2004/08/22 09:00:18 leo Exp $
=head1 NAME
@@ -3087,6 +3087,7 @@
code = VTABLE_invoke(interpreter, compiler, file);
pf = PMC_struct_val(code);
if (pf) {
+ if (pf != interpreter->code)
PackFile_add_segment(&interpreter->code->directory,
&pf->directory.base);
fixup_subs(interpreter, pf, PBC_LOADED);
