extract_fields can extract named variable fields from an opcode; it
returns a hash which can be then passed as environment parameter to
eval_block. More importantly, this allows the caller to augment the
block environment with more variables, if they wish to do so.
Signed-off-by: Jan Bobek <jan.bo...@gmail.com>
---
risugen_arm.pm | 6 +++--
risugen_common.pm | 64 ++++++++++++++++++++++++++++-------------------
risugen_m68k.pm | 3 ++-
risugen_ppc64.pm | 6 +++--
4 files changed, 48 insertions(+), 31 deletions(-)
diff --git a/risugen_arm.pm b/risugen_arm.pm
index 8d423b1..23a468c 100644
--- a/risugen_arm.pm
+++ b/risugen_arm.pm
@@ -992,7 +992,8 @@ sub gen_one_insn($$)
if (defined $constraint) {
# user-specified constraint: evaluate in an environment
# with variables set corresponding to the variable fields.
- my $v = eval_with_fields($insnname, $insn, $rec, "constraints",
$constraint);
+ my %env = extract_fields($insn, $rec);
+ my $v = eval_block($insnname, "constraints", $constraint, \%env);
if (!$v) {
$constraintfailures++;
if ($constraintfailures > 10000) {
@@ -1020,7 +1021,8 @@ sub gen_one_insn($$)
} else {
align(4);
}
- $basereg = eval_with_fields($insnname, $insn, $rec, "memory",
$memblock);
+ my %env = extract_fields($insn, $rec);
+ $basereg = eval_block($insnname, "memory", $memblock, \%env);
if ($is_aarch64) {
data_barrier();
diff --git a/risugen_common.pm b/risugen_common.pm
index d63250a..3f927ef 100644
--- a/risugen_common.pm
+++ b/risugen_common.pm
@@ -25,8 +25,8 @@ BEGIN {
our @ISA = qw(Exporter);
our @EXPORT = qw(open_bin close_bin set_endian insn32 insn16
$bytecount insnv randint progress_start
- progress_update progress_end
- eval_with_fields is_pow_of_2 sextract ctz
+ progress_update progress_end extract_fields
+ eval_block is_pow_of_2 sextract ctz
dump_insn_details);
}
@@ -138,36 +138,48 @@ sub progress_end()
$| = 0;
}
-sub eval_with_fields($$$$$) {
- # Evaluate the given block in an environment with Perl variables
- # set corresponding to the variable fields for the insn.
- # Return the result of the eval; we die with a useful error
- # message in case of syntax error.
- #
- # At the moment we just evaluate the string in the environment
- # of the calling package.
- # What we *ought* to do here is to give the config snippets
- # their own package, and explicitly import into it only the
- # functions that we want to be accessible to the config.
- # That would provide better separation and an explicitly set up
- # environment that doesn't allow config file code to accidentally
- # change state it shouldn't have access to, and avoid the need to
- # use 'caller' to get the package name of our calling function.
- my ($insnname, $insn, $rec, $blockname, $block) = @_;
+sub extract_fields($$)
+{
+ my ($insn, $rec) = @_;
+
+ my %fields = ();
+ for my $tuple (@{ $rec->{fields} }) {
+ my ($var, $pos, $mask) = @$tuple;
+ $fields{$var} = ($insn >> $pos) & $mask;
+ }
+ return %fields;
+}
+
+# Evaluate the given block in an environment with Perl variables set
+# corresponding to env. Return the result of the eval; we die with a
+# useful error message in case of syntax error.
+#
+# At the moment we just evaluate the string in the environment of the
+# calling package. What we *ought* to do here is to give the config
+# snippets their own package, and explicitly import into it only the
+# functions that we want to be accessible to the config. That would
+# provide better separation and an explicitly set up environment that
+# doesn't allow config file code to accidentally change state it
+# shouldn't have access to, and avoid the need to use 'caller' to get
+# the package name of our calling function.
+sub eval_block($$$$)
+{
+ my ($insnname, $blockname, $block, $env) = @_;
+
my $calling_package = caller;
my $evalstr = "{ package $calling_package; ";
- for my $tuple (@{ $rec->{fields} }) {
- my ($var, $pos, $mask) = @$tuple;
- my $val = ($insn >> $pos) & $mask;
- $evalstr .= "my (\$$var) = $val; ";
+ for (keys %{$env}) {
+ $evalstr .= "my " unless $_ eq '_';
+ $evalstr .= "(\$$_) = \$env->{$_}; ";
}
$evalstr .= $block;
$evalstr .= "}";
+
my $v = eval $evalstr;
- if ($@) {
- print "Syntax error detected evaluating $insnname $blockname
string:\n$block\n$@";
- exit(1);
- }
+ die "Syntax error detected evaluating $insnname $blockname string:\n"
+ . "$block\n"
+ . "$@"
+ if ($@);
return $v;
}
diff --git a/risugen_m68k.pm b/risugen_m68k.pm
index 7d62b13..8c812b5 100644
--- a/risugen_m68k.pm
+++ b/risugen_m68k.pm
@@ -129,7 +129,8 @@ sub gen_one_insn($$)
if (defined $constraint) {
# user-specified constraint: evaluate in an environment
# with variables set corresponding to the variable fields.
- my $v = eval_with_fields($insnname, $insn, $rec, "constraints",
$constraint);
+ my %env = extract_fields($insn, $rec);
+ my $v = eval_block($insnname, "constraints", $constraint, \%env);
if (!$v) {
$constraintfailures++;
if ($constraintfailures > 10000) {
diff --git a/risugen_ppc64.pm b/risugen_ppc64.pm
index b241172..40f717e 100644
--- a/risugen_ppc64.pm
+++ b/risugen_ppc64.pm
@@ -311,7 +311,8 @@ sub gen_one_insn($$)
if (defined $constraint) {
# user-specified constraint: evaluate in an environment
# with variables set corresponding to the variable fields.
- my $v = eval_with_fields($insnname, $insn, $rec, "constraints",
$constraint);
+ my %env = extract_fields($insn, $rec);
+ my $v = eval_block($insnname, "constraints", $constraint, \%env);
if (!$v) {
$constraintfailures++;
if ($constraintfailures > 10000) {
@@ -335,7 +336,8 @@ sub gen_one_insn($$)
# Default alignment requirement for ARM is 4 bytes,
# we use 16 for Aarch64, although often unnecessary and overkill.
align(16);
- $basereg = eval_with_fields($insnname, $insn, $rec, "memory",
$memblock);
+ my %env = extract_fields($insn, $rec);
+ $basereg = eval_block($insnname, "memory", $memblock, \%env);
}
insn32($insn);
--
2.20.1
