cvsuser 04/08/15 03:09:03
Modified: classes pmc2c2.pl
imcc parser_util.c
include/parrot extend.h
src extend.c
Log:
[perl #31112] [PATCH] Add --include directive to pmc2c2.pl
the attached patch adds a --include command line options
specifying one or more directories to be searched for
base .pmc files and/or for vtable.dump and default.dump.
[perl #31113] [PATCH] Parrot_load_bytecode fixes
this patch allows calling Parrot_load_bytecode when
there is no active PackFile. Example:
[perl #31115] [PATCH] Vtable manipolation functions
void Parrot_PMC_set_vtable(INTERP, PMC, VTABLE);
VTABLE Parrot_get_vtable(INTERP, Int);
Courtesy of Mattia Barbon <[EMAIL PROTECTED]>
Revision Changes Path
1.14 +43 -27 parrot/classes/pmc2c2.pl
Index: pmc2c2.pl
===================================================================
RCS file: /cvs/public/parrot/classes/pmc2c2.pl,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- pmc2c2.pl 30 Apr 2004 15:34:24 -0000 1.13
+++ pmc2c2.pl 15 Aug 2004 10:08:58 -0000 1.14
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: pmc2c2.pl,v 1.13 2004/04/30 15:34:24 leo Exp $
+# $Id: pmc2c2.pl,v 1.14 2004/08/15 10:08:58 leo Exp $
=head1 NAME
@@ -49,6 +49,10 @@
Emit an empty body in the dump. This may be useful for debugging.
+=item C<--include=/path/to/pmc>
+
+Specify include path where to find PMCs.
+
=back
=head2 Internals
@@ -214,7 +218,6 @@
=cut
use FindBin;
-use lib 'lib';
use lib "$FindBin::Bin/..";
use lib "$FindBin::Bin/../lib";
use Parrot::Vtable;
@@ -226,6 +229,23 @@
main();
+sub find_file {
+ my $include = shift;
+ my $file = shift;
+ my $die_unless_found = shift;
+
+ foreach my $dir ( @$include ) {
+ my $path = File::Spec->catfile( $dir, $file );
+ return $path if -e $path;
+ }
+
+ die "can't find file '$file' in path '",
+ ( join "', '", @$include ), "'"
+ if $die_unless_found;
+
+ undef;
+}
+
sub dump_default {
my $file = "$FindBin::Bin/../vtable.tbl";
my $default = parse_vtable($file);
@@ -385,6 +405,7 @@
# make a linear list of class->{parents} array
sub gen_parent_list {
+ my $include = shift;
my ($this, $all) = @_;
my @todo = ($this);
my $class = $all->{$this};
@@ -396,7 +417,7 @@
next if exists $class->{has_parent}{$parent};
if (!$all->{$parent}) {
my $pf = lc $parent;
- $all->{$parent} = read_dump("classes/$pf.pmc");
+ $all->{$parent} = read_dump($include, "$pf.pmc");
}
$class->{has_parent}{$parent} = { %{$all->{$parent}{has_method} }};
push(@todo, $parent);
@@ -468,6 +489,7 @@
}
sub dump_pmc {
+ my $include = shift;
my @files = @_;
my %all;
# help these dumb 'shells' that are no shells
@@ -478,9 +500,9 @@
$all{$class} = $res;
}
- my $vt = read_dump("vtable.pmc");
+ my $vt = read_dump($include, "vtable.pmc");
if (!$all{default}) {
- $all{default} = read_dump("classes/default.pmc");
+ $all{default} = read_dump($include, "classes/default.pmc");
}
add_defaulted($all{default}, $vt);
@@ -488,13 +510,12 @@
my $dump;
my $file = $all{$name}->{file};
($dump = $file) =~ s/\.\w+$/\.dump/;
- gen_parent_list($name, \%all);
+ gen_parent_list($include, $name, \%all);
my $class = $all{$name};
gen_super_meths($class, $vt);
# XXX write default.dump only once
- next if ( ## $dump eq 'classes/default.dump' &&
- ((-e $dump && dump_is_newer($dump)) ||
- (-e "../$dump" && dump_is_newer("../$dump"))));
+ my $existing = find_file($include, $dump);
+ next if ($existing && -e $existing && dump_is_newer($existing));
my $Dumper = Data::Dumper->new([$class], [qw(class)]);
$Dumper->Indent(1);
print "Writing $dump\n" if $opt{verbose};
@@ -505,20 +526,11 @@
}
sub read_dump {
+ my $include = shift;
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 = "$FindBin::Bin/../vtable.dump";
- }
- unless ( -e $dump) {
- $dump = "$FindBin::Bin/../classes/$dump";
- }
- }
+ $dump = find_file($include, $dump, 1);
print "Reading $dump\n" if $opt{verbose};
open D, "<$dump" or die "Can't read '$dump'";
@@ -533,9 +545,10 @@
}
sub print_tree {
+ my $include = shift;
my ($depth, @files) = @_;
foreach my $file (@files) {
- my $class = read_dump($file);
+ my $class = read_dump($include, $file);
my $name = $class->{class};
print " " x $depth, $name, "\n";
foreach my $parent (keys %{$class->{flags}{extends}}) {
@@ -546,11 +559,12 @@
}
sub gen_c {
+ my $include = shift;
my (@files) = @_;
foreach my $file (@files) {
- my $class = read_dump($file);
+ my $class = read_dump($include, $file);
# finally append vtable.dump
- $class->{vtable} = read_dump("vtable.pmc");
+ $class->{vtable} = read_dump($include, "vtable.pmc");
my $generator = Parrot::Pmc2c->new($class, \%opt);
print Data::Dumper->Dump([$generator]) if $opt{debug} > 1;
@@ -575,7 +589,7 @@
}
sub main {
- my ($default, $dump, $gen_c, $result, $tree, $debug, $verbose, $nobody,
$nolines);
+ my ($default, $dump, $gen_c, $result, $tree, $debug, $verbose, $nobody,
$nolines, @include);
$result = GetOptions(
"vtable" => \$default,
"dump" => \$dump,
@@ -585,26 +599,28 @@
"no-lines" => \$nolines,
"debug+" => \$debug,
"verbose+" => \$verbose,
+ "include=s" => [EMAIL PROTECTED],
);
$opt{debug} = $debug || 0;
$opt{verbose} = $verbose || 0;
$opt{nobody} = $nobody || 0;
$opt{nolines} = $nolines || 0;
+ unshift @include, "$FindBin::Bin/..", $FindBin::Bin;
$default and do {
dump_default();
exit;
};
$dump and do {
- dump_pmc(@ARGV);
+ dump_pmc([EMAIL PROTECTED], @ARGV);
exit;
};
$tree and do {
- print_tree(0, @ARGV);
+ print_tree([EMAIL PROTECTED], 0, @ARGV);
exit;
};
$gen_c and do {
- gen_c(@ARGV);
+ gen_c([EMAIL PROTECTED], @ARGV);
exit;
};
}
1.74 +4 -2 parrot/imcc/parser_util.c
Index: parser_util.c
===================================================================
RCS file: /cvs/public/parrot/imcc/parser_util.c,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -w -r1.73 -r1.74
--- parser_util.c 6 Aug 2004 12:23:51 -0000 1.73
+++ parser_util.c 15 Aug 2004 10:09:00 -0000 1.74
@@ -478,6 +478,7 @@
#endif
PackFile_fixup_subs(interp);
/* 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 */
@@ -574,6 +575,7 @@
imc_cleanup(interp);
+ if (pf_save)
(void)Parrot_switch_to_cs(interp, pf_save->cur_cs, 0);
sourcefile = source;
pasm_file = pasm;
1.18 +5 -1 parrot/include/parrot/extend.h
Index: extend.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/extend.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- extend.h 25 Jun 2004 19:05:07 -0000 1.17
+++ extend.h 15 Aug 2004 10:09:01 -0000 1.18
@@ -1,7 +1,7 @@
/* extend.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: extend.h,v 1.17 2004/06/25 19:05:07 nicholas Exp $
+ * $Id: extend.h,v 1.18 2004/08/15 10:09:01 leo Exp $
* Overview:
* This is the Parrot extension mechanism, the face we present to
* extension modules and whatnot
@@ -29,6 +29,7 @@
#define Parrot_STRING STRING *
#define Parrot_PMC PMC *
#define Parrot_Language Parrot_Int
+#define Parrot_VTABLE VTABLE *
#else
@@ -40,9 +41,11 @@
typedef void * Parrot_CharType;
typedef const void * Parrot_Const_Encoding;
typedef const void * Parrot_Const_CharType;
+typedef const void * Parrot_VTABLE;
#endif
+Parrot_VTABLE Parrot_get_vtable(Parrot_INTERP, Parrot_Int);
Parrot_PMC Parrot_PMC_get_pmc_intkey(Parrot_INTERP, Parrot_PMC, Parrot_Int);
Parrot_STRING Parrot_PMC_get_string(Parrot_INTERP, Parrot_PMC);
Parrot_STRING Parrot_PMC_get_string_intkey(Parrot_INTERP, Parrot_PMC, Parrot_Int);
@@ -57,6 +60,7 @@
char *Parrot_PMC_get_cstringn(Parrot_INTERP, Parrot_PMC, Parrot_Int *);
char *Parrot_PMC_get_cstringn_intkey(Parrot_INTERP, Parrot_PMC, Parrot_Int *,
Parrot_Int);
+void Parrot_PMC_set_vtable(Parrot_INTERP, Parrot_PMC, Parrot_VTABLE);
void Parrot_PMC_set_pmc_intkey(Parrot_INTERP, Parrot_PMC, Parrot_Int, Parrot_PMC);
void Parrot_PMC_set_string(Parrot_INTERP, Parrot_PMC, Parrot_STRING);
void Parrot_PMC_set_string_intkey(Parrot_INTERP, Parrot_PMC, Parrot_Int,
Parrot_STRING);
1.28 +37 -1 parrot/src/extend.c
Index: extend.c
===================================================================
RCS file: /cvs/public/parrot/src/extend.c,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -w -r1.27 -r1.28
--- extend.c 25 Jun 2004 19:05:13 -0000 1.27
+++ extend.c 15 Aug 2004 10:09:03 -0000 1.28
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: extend.c,v 1.27 2004/06/25 19:05:13 nicholas Exp $
+$Id: extend.c,v 1.28 2004/08/15 10:09:03 leo Exp $
=head1 NAME
@@ -799,6 +799,42 @@
/*
+=item C<void
+Parrot_pmc_set_vtable(Parrot_INTERP interpreter, Parrot_PMC pmc,
+ Parrot_VTABLE vtable)>
+
+Replaces the vtable of the PMC.
+
+=cut
+
+*/
+
+void
+Parrot_PMC_set_vtable(Parrot_INTERP interpreter, Parrot_PMC pmc,
+ Parrot_VTABLE vtable)
+{
+ pmc->vtable = vtable;
+}
+
+/*
+
+=item C<Parrot_VTABLE
+Parrot_get_vtable(Parrot_INTERP interpreter, Parrot_Int id)>
+
+Returns the vtable corresponding to the given PMC ID.
+
+=cut
+
+*/
+
+Parrot_VTABLE
+Parrot_get_vtable(Parrot_INTERP interpreter, Parrot_Int id)
+{
+ return Parrot_base_vtables[id];
+}
+
+/*
+
=back
=head1 SEE ALSO
