Introduce micro instructions

beam_makeops will place all micro instructions in a block and generate
goto instructions from one micro instruction to the next. It will also
add adjustments of 'I' if necessary (if the micro instructions have
different length).

1 files changed, 263 insertions, 42 deletions

diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index 8041a96bcb..6b202176d0 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -91,10 +91,14 @@ my @op_to_name;
 
 my @obsolete;
 
-# Instructions implemented in C.
+# Instructions and micro instructions implemented in C.
 my %c_code;                     # C code block, location, arguments.
 my %c_code_used;                # Used or not.
 
+# Definitions for instructions combined from micro instructions.
+my %combined_instrs;
+my %combined_code;           # Combined micro instructions.
+
 my %hot_code;
 my %cold_code;
 
@@ -103,6 +107,7 @@ my %unnumbered;
 
 my %is_transformed;
 
+
 #
 # Pre-processor.
 #
@@ -265,15 +270,21 @@ my $c_code_block;
 my $c_code_loc;
 my @c_args;
 
+sub save_c_code {
+    my($name,$block,$loc,@args) = @_;
+
+}
+
 while (<>) {
     my($op_num);
     if ($in_c_code) {
         if (/^\}/) {
-            $c_code_block =~ s/^    //mg;
-            chomp $c_code_block;
-            $c_code{$in_c_code} =
-                [$c_code_block,$c_code_loc,@c_args];
+            my $name = $in_c_code;
+            my $block = $c_code_block;
             $in_c_code = '';
+            $block =~ s/^    //mg;
+            chomp $block;
+            $c_code{$name} = [$block,$c_code_loc,@c_args];
         } else {
             $c_code_block .= $_;
         }
@@ -356,7 +367,7 @@ while (<>) {
     #
     # Handle C code blocks.
     #
-    if (/^(\w+)\(([^\)]*)\)\s*{/) {
+    if (/^(\w[\w.]*)\(([^\)]*)\)\s*{/) {
         my $name = $1;
         $in_c_code = $name;
         $c_code_block = '';
@@ -370,6 +381,15 @@ while (<>) {
     }
 
     #
+    # Handle definition of instructions in terms of
+    # micro instructions.
+    #
+    if (/^(\w+)\s*:=\s*([\w.]+)\s*;\s*$/) {
+        $combined_instrs{$1} = ["$ARGV($.)","beam_instrs.h",$2];
+        next;
+    }
+
+    #
     # Parse off the number of the operation.
     #
     $op_num = undef;
@@ -516,6 +536,11 @@ sub emulator_output {
     print "\n";
 
     #
+    # Combine micro instruction into instruction blocks.
+    #
+    combine_micro_instructions();
+
+    #
     # Generate code for specific ops.
     #
     my($spec_opnum) = 0;
@@ -555,7 +580,8 @@ sub emulator_output {
 	    # Call a generator to calculate size and generate macros
 	    # for the emulator.
 	    #
-	    my($size, $code, $pack) = basic_generator($name, $hot, @args);
+	    my($size, $code, $pack) =
+                basic_generator($name, $hot, '', 0, undef, @args);
 
 	    #
 	    # Save the generated $code for later.
@@ -787,6 +813,12 @@ sub emulator_output {
     comment('C');
     print_code(\%cold_code);
 
+    foreach my $key (keys %combined_code) {
+        my $name = "$outdir/$key";
+        open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
+        comment('C');
+        print @{$combined_code{$key}};
+    }
 }
 
 sub init_item {
@@ -976,12 +1008,192 @@ sub comment {
 }
 
 #
+# Combine micro instruction into instruction blocks.
+#
+sub combine_micro_instructions {
+    my %groups;
+    my %group_file;
+
+    # Sanity check, normalize micro instructions.
+    foreach my $instr (keys %combined_instrs) {
+        my $ref = $combined_instrs{$instr};
+        my($def_loc,$outfile,$def) = @$ref;
+        my($group,@subs) = split /[.]/, $def;
+        my $arity = 0;
+        @subs = map { "$group.$_" } @subs;
+        foreach my $s (@subs) {
+            my $code = $c_code{$s};
+            defined $code or
+                error("$def_loc: no definition of $s");
+            $c_code_used{$s} = 1;
+            my(undef,undef,@c_args) = @{$code};
+            $arity += scalar(@c_args);
+        }
+        push @{$groups{$group}}, [$instr,$arity,@subs];
+        $group_file{$group} = $outfile;
+    }
+
+    # Now generate code for each group.
+    foreach my $group (sort keys %groups) {
+        my $code = combine_instruction_group($group, @{$groups{$group}});
+        my $outfile = $group_file{$group};
+        push @{$combined_code{$outfile}}, $code;
+    }
+}
+
+sub combine_instruction_group {
+    my($group,@in_instrs) = @_;
+    my $gcode = '';             # Code for the entire group.
+
+    # Get code for the head of the group (if any).
+    my $head_name = "$group.head";
+    $c_code_used{$head_name} = 1;
+    my $head_code_ref = $c_code{$head_name};
+    if (defined $head_code_ref) {
+        my($head_code,$where,@c_args) = @{$head_code_ref};
+        @c_args and error("$where: no arguments allowed for " .
+                          "head function '$head_name()'");
+        $gcode = $head_code . "\n";
+    }
+
+    # Variables.
+    my %offsets;
+    my @instrs;
+    my %num_references;
+    my $group_size = 0;
+
+    # Do basic error checking. Associate operands of instructions
+    # with the correct micro instructions. Calculate offsets for micro
+    # instructions.
+    foreach my $ref_instr (@in_instrs) {
+        my($specific,$arity,@subs) = @$ref_instr;
+        my $specific_key = "$specific/$arity";
+        my $specific_op_ref = $specific_op{$specific_key};
+        error("no $specific_key instruction")
+            unless defined $specific_op_ref;
+        foreach my $specific_op (@$specific_op_ref) {
+            my($name, $hot, @args) = @{$specific_op};
+            my $offset = 0;
+            my @rest = @args;
+            my @new_subs;
+            my $opcase = $specific;
+            $opcase .= "_" . join '', @args if @args;
+            foreach my $s (@subs) {
+                my $code = $c_code{$s};
+                my(undef,undef,@c_args) = @{$code};
+                my @first;
+                foreach (0..$#c_args) {
+                    push @first, shift @rest;
+                }
+                my($size,undef) = basic_generator($s, 0, '', 0, undef, @first);
+                $offsets{$s} = $offset
+                    unless defined $offsets{$s} and $offsets{$s} >= $offset;
+                $offset += $size - 1;
+                my $label = micro_label($s);
+                $num_references{$label} = 0;
+                push @new_subs, [$opcase,$label,$s,$size-1,@first];
+                $opcase = '';
+            }
+            $group_size = $offset if $group_size < $offset;
+            push @instrs, [$specific_key,@new_subs];
+        }
+    }
+
+    # Link the sub instructions for each instructions to each
+    # other.
+    my @all_instrs;
+    foreach my $instr (@instrs) {
+        my($specific_key,@subs) = @{$instr};
+        for (my $i = 0; $i < @subs; $i++) {
+            my($opcase,$label,$s,$size,@args) = @{$subs[$i]};
+            my $next = '';
+            (undef,$next) = @{$subs[$i+1]} if $i < $#subs;
+            $num_references{$next}++ if $next;
+            my $instr_info = "$opcase:$label:$next:$s:$size:@args";
+            push @all_instrs, [$label,$offsets{$s},$instr_info];
+        }
+    }
+
+    my %order_to_instrs;
+    my %label_to_offset;
+    my %order_to_offset;
+    foreach my $instr (@all_instrs) {
+        my($label,$offset,$instr_info) = @$instr;
+        my $sort_key = sprintf("%02d.%02d", $offset, $num_references{$label});
+        push @{$order_to_instrs{$sort_key}}, $instr_info;
+        $label_to_offset{$label} = $offset;
+        $order_to_offset{$sort_key} = $offset;
+    }
+
+    my(@slots) = sort {$a <=> $b} keys %order_to_instrs;
+
+    # Now generate the code for the entire group.
+    my $offset = 0;
+    for(my $i = 0; $i < @slots; $i++) {
+        my $key = $slots[$i];
+
+        # Sort micro-instructions with OpCase before other micro-instructions.
+        my(@instrs) = @{$order_to_instrs{$key}};
+        my $order_func = sub {
+            my $a_key = ($a =~ /^:/) ? "1$a" : "0$a";
+            my $b_key = ($b =~ /^:/) ? "1$b" : "0$b";
+            $a_key cmp $b_key;
+        };
+        @instrs = sort $order_func @instrs;
+
+        my %seen;
+        foreach my $instr (@instrs) {
+            my($opcase,$label,$next,$s,$size,$args) = split ":", $instr;
+            my(@first) = split " ", $args;
+
+            my $seen_key = "$label:$next:" . scalar(@first);
+            next if $opcase eq '' and $seen{$seen_key};
+            $seen{$seen_key} = 1;
+
+            if ($opcase ne '') {
+                $gcode .= "OpCase($opcase):\n";
+            }
+            if ($num_references{$label}) {
+                $gcode .= "$label:\n";
+            }
+
+            my $flags = '';
+            my $transfer_to_next = '';
+            my $dec = 0;
+
+            unless ($i == $#slots) {
+                $flags = "-no_next";
+                my $next_offset = $label_to_offset{$next};
+                $dec = $next_offset - ($offset + $size);
+                $transfer_to_next = "I -= $dec;\n" if $dec;
+                $transfer_to_next .= "goto $next;\n\n";
+            }
+
+            my(undef,$gen_code) =
+                basic_generator($s, 0, $flags, $offset,
+                                $group_size-$offset-$dec, @first);
+            $gcode .= $gen_code . $transfer_to_next;
+        }
+        $offset = $order_to_offset{$slots[$i+1]} if $i < $#slots;
+    }
+
+    "{\n$gcode\n}\n\n";
+}
+
+sub micro_label {
+    my $label = shift;
+    $label =~ s/[.]/__/g;
+    $label;
+}
+
+
+#
 # Basic implementation of instruction in emulator loop
 # (assuming no packing).
 #
 
 sub basic_generator {
-    my($name, $hot, @args) = @_;
+    my($name,$hot,$extra_comments,$offset,$group_size,@args) = @_;
     my $size = 0;
     my $flags = '';
     my @f;
@@ -994,8 +1206,8 @@ sub basic_generator {
     # Pack arguments for hot code with an implementation.
     #
 
-    my $c_code = $c_code{$name};
-    if ($hot and defined $c_code) {
+    my $c_code_ref = $c_code{$name};
+    if ($hot and defined $c_code_ref) {
         ($prefix, $pack_spec, @args) = do_pack(@args);
     }
 
@@ -1004,6 +1216,8 @@ sub basic_generator {
     # the macro.
     #
 
+    my $need_block = 0;
+    my $arg_offset = $offset;
     foreach (@args) {
 	my($this_size) = $arg_size{$_};
       SWITCH:
@@ -1018,7 +1232,7 @@ sub basic_generator {
                 last SWITCH;
             };
 	    /[lxy]/ and do {
-                push(@f, $_ . "b(Arg($size))");
+                push(@f, $_ . "b(Arg($arg_offset))");
                 last SWITCH;
             };
 	    /n/ and do {
@@ -1030,78 +1244,79 @@ sub basic_generator {
                 $var_decls .= "Eterm $tmp;\n";
                 $tmp_arg_num++;
                 push(@f, $tmp);
-                $prefix .= "GetR($size, $tmp);\n";
+                $prefix .= "GetR($arg_offset, $tmp);\n";
+                $need_block = 1;
                 last SWITCH;
             };
 	    /d/ and do {
-                $var_decls .= "Eterm dst = Arg($size);\n" .
+                $var_decls .= "Eterm dst = Arg($arg_offset);\n" .
                     "Eterm* dst_ptr = REG_TARGET_PTR(dst);\n";
                 push(@f, "*dst_ptr");
                 last SWITCH;
             };
             defined $arg_size{$_} and do {
-                push(@f, "Arg($size)");
+                push(@f, "Arg($arg_offset)");
                 last SWITCH;
             };
 
 	    die "$name: The generator can't handle $_, at";
 	}
 	$size += $this_size;
+        $arg_offset += $this_size;
     }
 
     #
     # If the implementation is in beam_emu.c, there is nothing
     # more to do.
     #
-    unless (defined $c_code) {
+    unless (defined $c_code_ref) {
         return ($size+1, undef, '');
     }
 
+    $group_size = $size unless defined $group_size;
+
     #
     # Generate main body of the implementation.
     #
-    my $macro_code;
-    if (defined $c_code) {
-        my($c_code,$where,@c_args) = @{$c_code};
-        my %bindings;
-        $c_code_used{$name} = 1;
+    my($c_code,$where,@c_args) = @{$c_code_ref};
+    my %bindings;
+    $c_code_used{$name} = 1;
 
-        if (@f != @c_args) {
-            error("$where: defining '$name' with ", scalar(@c_args),
-                  " arguments instead of expected ", scalar(@f), " arguments");
-        }
+    if (@f != @c_args) {
+        error("$where: defining '$name' with ", scalar(@c_args),
+              " arguments instead of expected ", scalar(@f), " arguments");
+    }
 
-        for (my $i = 0; $i < @f; $i++) {
-            my $var = $c_args[$i];
-            $bindings{$var} = $f[$i];
-        }
-        $bindings{'NEXT_INSTRUCTION'} = "I+" . ($size + 1);
-        $c_code = eval { expand_all($c_code, \%bindings) };
-        unless (defined $c_code) {
-            warn $@;
-            error("... from the body of $name at $where");
-        }
-        my(@comments) = $c_code =~ m@//[|]\s*(.*)@g;
-        $flags = "@comments";
-        $macro_code = "$prefix$c_code";
+    for (my $i = 0; $i < @f; $i++) {
+        my $var = $c_args[$i];
+        $bindings{$var} = $f[$i];
     }
+    $bindings{'NEXT_INSTRUCTION'} = "I+" . ($group_size+$offset+1);
+    $c_code = eval { expand_all($c_code, \%bindings) };
+    unless (defined $c_code) {
+        warn $@;
+        error("... from the body of $name at $where");
+    }
+    my(@comments) = $c_code =~ m@//[|]\s*(.*)@g;
+    $c_code =~ s@//[|]\s*(.*)\n?@@g;
+    $flags = "@comments $extra_comments";
 
     #
     # Generate code for transferring to the next instruction.
     #
     my $dispatch_next;
-    my $offset = $size + 1;
+    my $instr_offset = $group_size + $offset + 1;
 
     if ($flags =~ /-no_next/) {
         $dispatch_next = "";
     } elsif ($flags =~ /-no_prefetch/) {
-        $dispatch_next = "\nI += $offset;\n" .
+        $dispatch_next = "\nI += $instr_offset;\n" .
             "ASSERT(VALID_INSTR(*I));\n" .
             "Goto(*I);";
     } else {
         $var_decls .= "BeamInstr* _nextpf = " .
-            "(BeamInstr *) I[$offset];\n";
-        $dispatch_next = "\nI += $offset;\n" .
+            "(BeamInstr *) I[$instr_offset];\n";
+        $dispatch_next = "\nI += $instr_offset;\n" .
             "ASSERT(VALID_INSTR(_nextpf));\n" .
             "Goto(_nextpf);";
     }
@@ -1109,9 +1324,15 @@ sub basic_generator {
     #
     # Assemble the complete code for the instruction.
     #
+    my $body = "$c_code$dispatch_next";
+    if ($need_block) {
+        $body = "$prefix\{\n$body\n}";
+    } else {
+        $body = "$prefix$body";
+    }
     my $code = join("\n",
                     "{",
-                    "$var_decls$macro_code$dispatch_next",
+                    "$var_decls$body",
                     "}", "");
     ($size+1, $code, $pack_spec);
 }