[Qemu-devel] [RISU PATCH v3 02/18] risugen_common: split eval_with_fields into extract_fields and eval_block

[Jan Bobek <jan.bobek@gmail.com>]

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.bobek@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