From 6d51b25958393d95dee32baafd708aa3909ddb5a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Fri, 1 Apr 2016 16:07:37 +0200
Subject: Eliminate allocation of variables in transform_engine()

When an instruction with a variable number operands (such as
select_val) is seen of the left side of a transformation, the
'next_arg' instruction will allocate a buffer to fit all variables and
all operands will be copied into the buffer. Very often, the 'commit'
instruction will never be reached because of a test or predicate
failing or because of a short window; in that case, the variable
buffer will be deallocated.

Note that originally there were only few instructions with a variable
number of operands, but now common operations such as tuple building
also have a variable number of operands.

To avoid those frequent allocations and deallocations, modify the
'next_arg' instruction to only save a pointer to the first of the
"rest" arguments. Also move the deallocation of the instructions
on the left side from the 'commit' instruction to the 'end'
instruction to ensure that 'store_rest_args' will still work.
---
 erts/emulator/utils/beam_makeops | 65 ++++++++++++++--------------------------
 1 file changed, 22 insertions(+), 43 deletions(-)

(limited to 'erts/emulator/utils/beam_makeops')

diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index f805e7cc64..86bfb5d746 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -1504,8 +1504,6 @@ sub tr_gen_from {
     my($var_num) = 0;
     my(@code);
     my($min_window) = 0;
-    my(@fix_rest_args);
-    my(@fix_pred_funcs);
     my($op, $ref);		# Loop variables.
     my $where = "left side of transformation in line $line: ";
     my %var_used = %$used_ref;
@@ -1530,8 +1528,17 @@ sub tr_gen_from {
 	    my $var;
 	    my(@args);
 
-	    push(@fix_pred_funcs, scalar(@code));
-	    push(@code, [$name, @ops]);
+	    foreach $var (@ops) {
+		error($where, "variable '$var' unbound")
+		    unless defined $var{$var};
+		if ($var_type{$var} eq 'scalar') {
+		    push(@args, "var[$var{$var}]");
+		} else {
+		    push(@args, "rest_args");
+		}
+	    }
+	    my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args);
+	    push(@code, make_op("$name()", 'pred', $pi));
 	    next;
 	}
 
@@ -1595,12 +1602,16 @@ sub tr_gen_from {
 		    $may_fail = 1;
 		    push(@code, &make_op($var, 'is_same_var', $var{$var}));
 		} elsif ($type eq '*') {
-		    #
-		    # Reserve a hole for a 'rest_args' instruction.
-		    #
+		    foreach my $type (values %var_type) {
+			error("only one use of a '*' variable is " .
+			      "allowed on the left hand side of " .
+			      "a transformation")
+			    if $type eq 'array';
+		    }
 		    $ignored_var = '';
-		    push(@fix_rest_args, scalar(@code));
-		    push(@code, $var);
+		    $var{$var} = 'unnumbered';
+		    $var_type{$var} = 'array';
+		    push(@code, make_op($var, 'rest_args'));
 		} elsif ($var_used{$var}) {
 		    $ignored_var = '';
 		    $var_type{$var} = 'scalar';
@@ -1629,38 +1640,6 @@ sub tr_gen_from {
     #
     push(@code, make_op($may_fail ? '' : 'always reached', 'commit'));
 
-    #
-    # If there is an rest_args instruction, we must insert its correct
-    # variable number (higher than any other).
-    #
-    my $index;
-    &error("only one use of a '*' variable is allowed on the left hand side of a transformation")
-	if @fix_rest_args > 1;
-    foreach $index (@fix_rest_args) {
-	my $var = $code[$index];
-	$var{$var} = $var_num++;
-	$var_type{$var} = 'array';
-	splice(@code, $index, 1, &make_op($var, 'rest_args', $var{$var}));
-    }
-
-    foreach $index (@fix_pred_funcs) {
-	my($name, @ops) = @{$code[$index]};
-	my(@args);
-	my $var;
-
-	foreach $var (@ops) {
-	    &error($where, "variable '$var' unbound")
-		unless defined $var{$var};
-	    if ($var_type{$var} eq 'scalar') {
-		push(@args, "var[$var{$var}]");
-	    } else {
-		push(@args, "var+$var{$var}");
-	    }
-	}
-	my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args);
-	splice(@code, $index, 1, make_op("$name()", 'pred', $pi));
-    }
-
     $te_max_vars = $var_num
 	if $te_max_vars < $var_num;
     [$min_window, \%var, \%var_type, \@code];
@@ -1697,7 +1676,7 @@ sub tr_gen_to {
 		if ($var_type{$var} eq 'scalar') {
 		    push(@args, "var[$var{$var}]");
 		} else {
-		    push(@args, "var+$var{$var}");
+		    push(@args, "rest_args");
 		}
 	    }
 	    pop(@code);	# Get rid of 'commit' instruction
@@ -1725,7 +1704,7 @@ sub tr_gen_to {
 	    my($var, $type, $type_val) = @$op;
 
 	    if ($type eq '*') {
-		push(@code, make_op($var, 'store_rest_args', $var{$var}));
+		push(@code, make_op($var, 'store_rest_args'));
 	    } elsif ($var ne '') {
 		&error($where, "variable '$var' unbound")
 		    unless defined $var{$var};
-- 
cgit v1.2.3