G'day all.
Adds argument direction information into Parrot::Op and the
op_info_table.
Cheers,
Andrew Bromage
Index: ops2c.pl
===================================================================
RCS file: /cvs/public/parrot/ops2c.pl,v
retrieving revision 1.22
diff -u -r1.22 ops2c.pl
--- ops2c.pl 19 Mar 2002 23:28:50 -0000 1.22
+++ ops2c.pl 22 Apr 2002 00:44:15 -0000
@@ -12,6 +12,13 @@
use lib 'lib';
use Parrot::OpsFile;
+my %arg_dir_mapping = (
+ '' => 'PARROT_ARGDIR_IGNORED',
+ 'i' => 'PARROT_ARGDIR_IN',
+ 'o' => 'PARROT_ARGDIR_OUT',
+ 'io' => 'PARROT_ARGDIR_INOUT'
+);
+
sub Usage {
print STDERR <<_EOF_;
usage: $0 trans input.ops [input2.ops ...]
@@ -232,6 +239,7 @@
my $body = $op->body;
my $arg_count = $op->size;
my $arg_types = "{ " . join(", ", map { sprintf("PARROT_ARG_%s", uc $_) }
$op->arg_types) . " }";
+ my $arg_dirs = "{ " . join(", ", map { $arg_dir_mapping{$_} } $op->arg_dirs) .
+" }";
print SOURCE <<END_C;
{ /* $index */
@@ -241,7 +249,8 @@
"$func_name",
"", /* TODO: Put the body here */
$arg_count,
- $arg_types
+ $arg_types,
+ $arg_dirs
},
END_C
Index: include/parrot/op.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/op.h,v
retrieving revision 1.9
diff -u -r1.9 op.h
--- include/parrot/op.h 4 Mar 2002 03:17:21 -0000 1.9
+++ include/parrot/op.h 22 Apr 2002 00:44:16 -0000
@@ -36,6 +36,14 @@
PARROT_ARG_S
} arg_type_t;
+typedef enum {
+ PARROT_ARGDIR_IGNORED,
+
+ PARROT_ARGDIR_IN,
+ PARROT_ARGDIR_OUT,
+ PARROT_ARGDIR_INOUT
+} arg_dir_t;
+
#define PARROT_ARG_OP 0
/* NOTE: Sure wish we could put the types here... */
@@ -61,6 +69,7 @@
const char *body;
INTVAL arg_count; /* Includes opcode as one arg */
arg_type_t types[PARROT_MAX_ARGS];
+ arg_dir_t dirs[PARROT_MAX_ARGS];
} op_info_t;
Index: lib/Parrot/Op.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Op.pm,v
retrieving revision 1.7
diff -u -r1.7 Op.pm
--- lib/Parrot/Op.pm 15 Feb 2002 03:24:57 -0000 1.7
+++ lib/Parrot/Op.pm 22 Apr 2002 00:44:17 -0000
@@ -18,12 +18,13 @@
sub new
{
my $class = shift;
- my ($code, $type, $name, @args) = @_;
+ my ($code, $type, $name, $args, $argdirs) = @_;
my $self = { CODE => $code,
TYPE => $type,
NAME => $name,
- ARGS => [ @args ],
+ ARGS => [ @$args ],
+ ARGDIRS => [ @$argdirs ],
BODY => '',
MAY_JUMP => 0,
};
@@ -115,6 +116,27 @@
{
my $self = shift;
return $self->{ARGS}[shift];
+}
+
+#
+# arg_dirs()
+#
+
+sub arg_dirs
+{
+ my $self = shift;
+ return @{$self->{ARGDIRS}};
+}
+
+
+#
+# arg_dir()
+#
+
+sub arg_dir
+{
+ my $self = shift;
+ return $self->{ARGDIRS}[shift];
}
Index: lib/Parrot/OpsFile.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/OpsFile.pm,v
retrieving revision 1.18
diff -u -r1.18 OpsFile.pm
--- lib/Parrot/OpsFile.pm 19 Apr 2002 01:32:43 -0000 1.18
+++ lib/Parrot/OpsFile.pm 22 Apr 2002 00:44:17 -0000
@@ -93,6 +93,7 @@
my $short_name;
my $args;
my @args;
+ my @argdirs;
my $seen_pod;
my $seen_op;
my $line;
@@ -164,6 +165,7 @@
$short_name = lc $2;
$args = trim(lc $3);
@args = split(/\s*,\s*/, $args);
+ @argdirs = ();
$body = '';
$seen_op = 1;
$line = $.+1;
@@ -179,17 +181,21 @@
if ($use eq 'in') {
push @temp, ($type eq 'p') ? 'p' : "$type|${type}c";
+ push @argdirs, 'i';
}
elsif ($use eq 'inconst') {
die "Parrot::OpsFile: Arg format 'inconst PMC' is not allowed!"
if $type eq 'p';
push @temp, "${type}c";
+ push @argdirs, 'i';
}
elsif ($use eq 'inout') {
push @temp, $type;
+ push @argdirs, 'io';
}
else {
push @temp, $type;
+ push @argdirs, 'o';
}
}
@@ -207,7 +213,8 @@
#
if (/^}\s*$/) {
- $count += $self->make_op($count, $type, $short_name, $body, \@args, $line,
$orig);
+ $count += $self->make_op($count, $type, $short_name, $body, \@args,
+ \@argdirs, $line, $orig);
$seen_op = 0;
@@ -241,13 +248,15 @@
sub make_op
{
- my ($self, $code, $type, $short_name, $body, $args, $line, $file) = @_;
+ my ($self, $code, $type, $short_name, $body, $args, $argdirs,
+ $line, $file) = @_;
my $counter = 0;
my $jumps = 0;
foreach my $variant (expand_args(@$args)) {
my(@fixedargs)=split(/,/,$variant);
- my $op = Parrot::Op->new($code++, $type, $short_name, 'op', @fixedargs);
+ my $op = Parrot::Op->new($code++, $type, $short_name,
+ [ 'op', @fixedargs ], [ '', @$argdirs ]);
my $op_size = $op->size;
#
