From 9fe99adfe6cb8cd0b5936e55a3157d41f8fa6b27 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= <barney@cpan.org>
Date: Sun, 16 Oct 2022 11:01:03 +0200
Subject: Refactor opcode.pl - opcode.h - move PL_opargs into function

---
 regen/opcode.pl | 107 +++++++++++++++++++++++++++++++++-----------------------
 1 file changed, 64 insertions(+), 43 deletions(-)

(limited to 'regen')

diff --git a/regen/opcode.pl b/regen/opcode.pl
index 406e36d8cb..a9cb7bc7e4 100755
--- a/regen/opcode.pl
+++ b/regen/opcode.pl
@@ -24,6 +24,7 @@ sub generate_opcode_h_prologue;
 sub generate_opcode_h_defines;
 sub generate_opcode_h_opnames;
 sub generate_opcode_h_pl_check;
+sub generate_opcode_h_pl_opargs;
 sub generate_opcode_h_pl_ppaddr;
 
 my $restrict_to_core = "if defined(PERL_CORE) || defined(PERL_EXT)";
@@ -927,8 +928,6 @@ require './regen/op_private';
 #use Data::Dumper;
 #print Dumper \%LABELS, \%DEFINES, \%FLAGS, \%BITFIELDS;
 
-generate_opcode_h;
-
 print $on "typedef enum opcode {\n";
 
 my $i = 0;
@@ -940,14 +939,6 @@ print $on "} opcode;\n";
 print $on "\n#define MAXO ", scalar @ops, "\n";
 print $on "#define OP_FREED MAXO\n";
 
-print $oc <<'END';
-
-#ifndef DOINIT
-EXTCONST U32 PL_opargs[];
-#else
-EXTCONST U32 PL_opargs[] = {
-END
-
 # Emit allowed argument types.
 
 my $ARGBITS = 32;
@@ -1000,23 +991,7 @@ my %OP_IS_NUMCOMPARE;   # /S</
 my %OP_IS_DIRHOP;   # /Fd/
 my %OP_IS_INFIX_BIT;    # /S\|/
 
-my $OCSHIFT = 8;
-my $OASHIFT = 12;
-
 for my $op (@ops) {
-    my $argsum = 0;
-    my $flags = $flags{$op};
-    for my $flag (keys %opflags) {
-        if ($flags =~ s/$flag//) {
-            die "Flag collision for '$op' ($flags{$op}, $flag)\n"
-                if $argsum & $opflags{$flag};
-            $argsum |= $opflags{$flag};
-        }
-    }
-    die qq[Opcode '$op' has no class indicator ($flags{$op} => $flags)\n]
-        unless exists $opclass{$flags};
-    $argsum |= $opclass{$flags} << $OCSHIFT;
-    my $argshift = $OASHIFT;
     for my $arg (split(' ',$args{$op})) {
         if ($arg =~ s/^D//) {
             # handle 1st, just to put D 1st.
@@ -1032,26 +1007,10 @@ for my $op (@ops) {
             $OP_IS_NUMCOMPARE{$op} = $opnum{$op} if $arg =~ s/<//;
             $OP_IS_INFIX_BIT {$op} = $opnum{$op} if $arg =~ s/\|//;
         }
-        my $argnum = ($arg =~ s/\?//) ? 8 : 0;
-        die "op = $op, arg = $arg\n"
-            unless exists $argnum{$arg};
-        $argnum += $argnum{$arg};
-        die "Argument overflow for '$op'\n"
-            if $argshift >= $ARGBITS ||
-               $argnum > ((1 << ($ARGBITS - $argshift)) - 1);
-        $argsum += $argnum << $argshift;
-        $argshift += 4;
     }
-    $argsum = sprintf("0x%08x", $argsum);
-    print $oc "\t", tab(3, "$argsum,"), "/* $op */\n";
 }
 
-print $oc <<'END';
-};
-#endif
-
-END_EXTERN_C
-END
+generate_opcode_h;
 
 # Emit OP_IS_* macros
 
@@ -1130,6 +1089,7 @@ sub generate_opcode_h {
     generate_opcode_h_opnames;
     generate_opcode_h_pl_ppaddr;
     generate_opcode_h_pl_check;
+    generate_opcode_h_pl_opargs;
 }
 
 my @unimplemented;
@@ -1236,6 +1196,67 @@ sub generate_opcode_h_pl_check {
     END
 }
 
+sub generate_opcode_h_pl_opargs {
+    my $OCSHIFT = 8;
+    my $OASHIFT = 12;
+
+    print $oc <<~'END';
+
+    #ifndef DOINIT
+    EXTCONST U32 PL_opargs[];
+    #else
+    EXTCONST U32 PL_opargs[] = {
+    END
+
+    for my $op (@ops) {
+        my $argsum = 0;
+        my $flags = $flags{$op};
+        for my $flag (keys %opflags) {
+            if ($flags =~ s/$flag//) {
+                die "Flag collision for '$op' ($flags{$op}, $flag)\n"
+                    if $argsum & $opflags{$flag};
+                $argsum |= $opflags{$flag};
+            }
+        }
+        die qq[Opcode '$op' has no class indicator ($flags{$op} => $flags)\n]
+            unless exists $opclass{$flags};
+        $argsum |= $opclass{$flags} << $OCSHIFT;
+        my $argshift = $OASHIFT;
+        for my $arg (split(' ',$args{$op})) {
+            if ($arg =~ s/^D//) {
+                # handle 1st, just to put D 1st.
+            }
+            if ($arg =~ /^F/) {
+                # record opnums of these opnames
+                $arg =~ s/s//;
+                $arg =~ s/-//;
+                $arg =~ s/\+//;
+            } elsif ($arg =~ /^S./) {
+                $arg =~ s/<//;
+                $arg =~ s/\|//;
+            }
+            my $argnum = ($arg =~ s/\?//) ? 8 : 0;
+            die "op = $op, arg = $arg\n"
+                unless exists $argnum{$arg};
+            $argnum += $argnum{$arg};
+            die "Argument overflow for '$op'\n"
+                if $argshift >= $ARGBITS ||
+                $argnum > ((1 << ($ARGBITS - $argshift)) - 1);
+            $argsum += $argnum << $argshift;
+            $argshift += 4;
+        }
+        $argsum = sprintf("0x%08x", $argsum);
+        print $oc "\t", tab(3, "$argsum,"), "/* $op */\n";
+    }
+
+    print $oc <<~'END';
+    };
+    #endif
+
+    END_EXTERN_C
+    END
+}
+
 sub generate_opcode_h_pl_ppaddr {
     # Emit ppcode switch array.
 
-- 
cgit v1.2.1