File 1025-Generate-C-code-for-the-transformation-engine.patch of Package erlang
From 4dbc9988e7f764d05d31e8432e80ad0d88c8a41a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Sat, 13 May 2023 07:14:35 +0200
Subject: [PATCH 5/5] Generate C code for the transformation engine
Generating C code for the transformation engine is overall simpler
than using a bespoke virtual machine and it makes code loading
somewhat faster.
---
erts/emulator/Makefile.in | 3 -
erts/emulator/beam/beam_load.c | 2 +-
erts/emulator/beam/beam_transform_engine.c | 371 ---------------
erts/emulator/internal_doc/beam_makeops.md | 8 +-
erts/emulator/utils/beam_makeops | 502 +++++++++++++++------
5 files changed, 379 insertions(+), 507 deletions(-)
delete mode 100644 erts/emulator/beam/beam_transform_engine.c
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 5451bdf804..80ebf2a070 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -584,7 +584,6 @@ $(TTF_DIR)/beam_warm.h \
$(TTF_DIR)/beam_hot.h \
$(TTF_DIR)/beam_opcodes.c \
$(TTF_DIR)/beam_opcodes.h \
-$(TTF_DIR)/beam_transform.c \
: $(TTF_DIR)/OPCODES-GENERATED
$(TTF_DIR)/OPCODES-GENERATED: $(OPCODE_TABLES) utils/beam_makeops
$(gen_verbose)LANG=C $(PERL) utils/beam_makeops \
@@ -1013,8 +1012,6 @@ COMMON_OBJS = \
$(OBJDIR)/beam_load.o \
$(OBJDIR)/beam_opcodes.o \
$(OBJDIR)/beam_ranges.o \
- $(OBJDIR)/beam_transform.o \
- $(OBJDIR)/beam_transform_engine.o \
$(OBJDIR)/beam_transform_helpers.o \
$(OBJDIR)/code_ix.o
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index d051085023..839d50d50b 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -417,7 +417,7 @@ static int load_code(LoaderState* stp)
do_transform:
ASSERT(stp->genop != NULL);
- if (gen_opc[stp->genop->op].transform != -1) {
+ if (gen_opc[stp->genop->op].transform) {
if (stp->genop->next == NULL) {
/*
* Simple heuristic: Most transformations requires
diff --git a/erts/emulator/beam/beam_transform_engine.c b/erts/emulator/beam/beam_transform_engine.c
deleted file mode 100644
index 7891c901df..0000000000
--- a/erts/emulator/beam/beam_transform_engine.c
+++ /dev/null
@@ -1,371 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2020-2022. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#include "erl_vm.h"
-#include "export.h"
-#include "bif.h"
-#include "beam_load.h"
-
-int
-erts_transform_engine(LoaderState* st)
-{
- Uint op;
- int ap; /* Current argument. */
- const Uint* restart; /* Where to restart if current match fails. */
- BeamOpArg var[TE_MAX_VARS]; /* Buffer for variables. */
- BeamOpArg* rest_args = NULL;
- int num_rest_args = 0;
- int i; /* General index. */
- Uint mask;
- BeamOp* instr;
- BeamOp* first = st->genop;
- BeamOp* keep = NULL;
- const Uint* pc;
- static Uint restart_fail[1] = {TOP_fail};
-
- ASSERT(gen_opc[first->op].transform != -1);
- restart = op_transform + gen_opc[first->op].transform;
-
- restart:
- ASSERT(restart != NULL);
- pc = restart;
- ASSERT(*pc < NUM_TOPS); /* Valid instruction? */
- instr = first;
-
-#ifdef DEBUG
- restart = NULL;
-#endif
- ap = 0;
- for (;;) {
- op = *pc++;
-
- switch (op) {
- case TOP_next_instr:
- instr = instr->next;
- ap = 0;
- if (instr == NULL) {
- /*
- * We'll need at least one more instruction to decide whether
- * this combination matches or not.
- */
- return TE_SHORT_WINDOW;
- }
- if (*pc++ != instr->op)
- goto restart;
- break;
- case TOP_is_type:
- mask = *pc++;
-
- ASSERT(ap < instr->arity);
- ASSERT(instr->a[ap].type < BEAM_NUM_TAGS);
- if (((1 << instr->a[ap].type) & mask) == 0)
- goto restart;
- break;
- case TOP_pred:
- i = *pc++;
- i = erts_beam_eval_predicate((unsigned) i, st, var, rest_args);
- if (i == 0)
- goto restart;
- break;
- case TOP_is_eq:
- ASSERT(ap < instr->arity);
- if (*pc++ != instr->a[ap].val)
- goto restart;
- break;
-#if defined(TOP_is_bif)
- case TOP_is_bif:
- {
- int bif_number = *pc++;
-
- /*
- * In debug build, the type must be 'u'.
- * In a real build, don't match. (I.e. retain the original
- * call instruction, this will work, but it will be a
- * slight performance loss.)
- */
-
- ASSERT(instr->a[ap].type == TAG_u);
- if (instr->a[ap].type != TAG_u)
- goto restart;
-
- /*
- * In debug build, the assertion will catch invalid indexes
- * immediately. In a real build, the loader will issue
- * an diagnostic later when the instruction is loaded.
- */
-
- i = instr->a[ap].val;
- ASSERT(i < st->beam.imports.count);
- if (i >= st->beam.imports.count) {
- goto restart;
- } else {
- BifEntry *entry = st->bif_imports[i];
-
- if (!entry) {
- /* Not a BIF */
- goto restart;
- }
-
- if (bif_number >= 0 && entry != &bif_table[bif_number]) {
- /* Specific BIF not a match. */
- goto restart;
- }
- }
- }
- break;
-#endif
-#if defined(TOP_is_not_bif)
- case TOP_is_not_bif:
- {
- pc++;
- i = instr->a[ap].val;
-
- /*
- * In debug build, the type must be 'u'.
- */
- ASSERT(instr->a[ap].type == TAG_u);
- if (instr->a[ap].type != TAG_u) {
- goto restart;
- } else if (i < st->beam.imports.count) {
- BeamFile_ImportEntry *import;
-
- if (st->bif_imports[i]) {
- goto restart;
- }
-
- /* erlang:apply/2,3 are strange. They exist as (dummy) BIFs
- * so that they are included in the export table before
- * the erlang module is loaded. They also exist in the
- * erlang module as functions. When used in code, a special
- * Beam instruction is used.
- *
- * Below we recognize erlang:apply/2,3 as special. This is
- * necessary because after setting a trace pattern on
- * them, you can no longer see from the export entry that
- * they are special. */
- import = &st->beam.imports.entries[i];
-
- if (import->module == am_erlang) {
- if (import->function == am_apply) {
- if (import->arity == 2 || import->arity == 3) {
- goto restart;
- }
- }
- }
-
- }
- }
- break;
-
-#endif
-#if defined(TOP_is_func)
- case TOP_is_func:
- {
- Eterm mod = *pc++;
- Eterm func = *pc++;
- int arity = *pc++;
-
- ASSERT(instr->a[ap].type == TAG_u);
- if (instr->a[ap].type != TAG_u) {
- goto restart;
- }
- i = instr->a[ap].val;
- ASSERT(i < st->beam.imports.count);
- {
- BeamFile_ImportEntry *import;
-
- if (i >= st->beam.imports.count) {
- goto restart;
- }
-
- import = &st->beam.imports.entries[i];
-
- if (import->module != mod) {
- goto restart;
- }
- if (import->function != func) {
- goto restart;
- }
- if (import->arity != arity) {
- goto restart;
- }
- }
- }
- break;
-#endif
- case TOP_set_var:
- ASSERT(ap < instr->arity);
- i = *pc++;
- ASSERT(i < TE_MAX_VARS);
- var[i] = instr->a[ap];
- break;
-#if defined(TOP_rest_args)
- case TOP_rest_args:
- {
- int formal_arity = gen_opc[instr->op].arity;
- num_rest_args = instr->arity - formal_arity;
- rest_args = instr->a + formal_arity;
- }
- break;
-#endif
- case TOP_next_arg:
- ap++;
- break;
- case TOP_commit:
- instr = instr->next; /* The next_instr was optimized away. */
- keep = instr;
- break;
-#if defined(TOP_commit_new_instr)
- case TOP_commit_new_instr:
- /*
- * Reuse the last instruction on the left side instead of
- * allocating a new instruction. Note that this is not
- * safe if TOP_rest_args has been executed; therefore,
- * this combined instruction is never used when that is
- * the case.
- */
- ASSERT(instr->a == instr->def_args);
- keep = instr;
- instr->op = op = *pc++;
- instr->arity = gen_opc[op].arity;
- ap = 0;
- break;
-#endif
-#if defined(TOP_keep)
- case TOP_keep:
- /* Keep the current instruction unchanged. */
- keep = instr;
- break;
-#endif
-#if defined(TOP_call)
- case TOP_call:
- {
- BeamOp** lastp;
- BeamOp* new_instr;
-
- i = *pc++;
- new_instr = erts_beam_execute_transform((unsigned) i, st, var, rest_args);
- if (new_instr == NULL) {
- goto restart;
- }
-
- lastp = &new_instr;
- while (*lastp != NULL) {
- lastp = &((*lastp)->next);
- }
-
- keep = instr->next; /* The next_instr was optimized away. */
- *lastp = keep;
- instr = new_instr;
- }
- break;
-#endif
- case TOP_end:
- st->genop = instr;
- while (first != keep) {
- BeamOp* next = first->next;
- beamopallocator_free_op(&st->op_allocator, first);
- first = next;
- }
-
- return TE_OK;
- /*
- * Note that the instructions are generated in reverse order.
- */
- case TOP_new_instr:
- {
- BeamOp* new_instr = beamopallocator_new_op(&st->op_allocator);
- new_instr->next = instr;
- instr = new_instr;
- instr->op = op = *pc++;
- instr->arity = gen_opc[op].arity;
- ap = 0;
- }
- break;
-#ifdef TOP_rename
- case TOP_rename:
- instr->op = op = *pc++;
- instr->arity = gen_opc[op].arity;
- return TE_OK;
-#endif
- case TOP_store_val:
- instr->a[ap].type = pc[0];
- instr->a[ap].val = pc[1];
- pc += 2;
- break;
- case TOP_store_var:
- i = *pc++;
- ASSERT(i < TE_MAX_VARS);
- instr->a[ap] = var[i];
- break;
-#if defined(TOP_store_rest_args)
- case TOP_store_rest_args:
- {
- ASSERT(instr->a == instr->def_args);
- instr->arity = instr->arity + num_rest_args;
- instr->a = erts_alloc(ERTS_ALC_T_LOADER_TMP,
- instr->arity * sizeof(BeamOpArg));
- sys_memcpy(instr->a, instr->def_args, ap*sizeof(BeamOpArg));
- sys_memcpy(instr->a+ap, rest_args, num_rest_args*sizeof(BeamOpArg));
- ap += num_rest_args;
- }
- break;
-#endif
- case TOP_try_me_else:
- restart = pc + 1;
- restart += *pc++;
- ASSERT(*pc < NUM_TOPS); /* Valid instruction? */
- break;
- case TOP_try_me_else_fail:
- restart = restart_fail;
- break;
-#if defined(TOP_nop)
- case TOP_nop:
- break;
-#endif
- case TOP_fail:
- return TE_FAIL;
-#if defined(TOP_skip_unless)
- case TOP_skip_unless:
- /*
- * Note that the caller of transform_engine() guarantees that
- * there is always a second instruction available.
- */
- ASSERT(instr);
- if (instr->next->op != pc[0]) {
- /* The second instruction is wrong. Skip ahead. */
- pc += pc[1] + 2;
- ASSERT(*pc < NUM_TOPS); /* Valid instruction? */
- } else {
- /* Correct second instruction. */
- pc += 2;
- }
- break;
-#endif
- default:
- ASSERT(0);
- }
- }
-}
diff --git a/erts/emulator/internal_doc/beam_makeops.md b/erts/emulator/internal_doc/beam_makeops.md
index 563ad200f7..9c127517dc 100644
--- a/erts/emulator/internal_doc/beam_makeops.md
+++ b/erts/emulator/internal_doc/beam_makeops.md
@@ -379,16 +379,12 @@ Give the option `-emulator` to produce output files for the emulator.
The following output files will be generated in the output directory.
* `beam_opcodes.c` - Defines static data used by the loader
-(`beam_load.c`). Data about generic instructions, specific
-instructions (including how to pack their operands), and
-transformation rules are all part of this file.
+(`beam_load.c`), providing information about generic and specific
+instructions, as well as all C code for the transformation rules.
* `beam_opcodes.h` - Miscellaneous preprocessor definitions, mainly
used by `beam_load.c` but also by `beam_{hot,warm,cold}.h`.
-* `beam_transform.c` - Implementation of guard constraints and generators
-called from transformation rules.
-
For the traditional BEAM interpreter, the following files are also
generated:
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index aee81dd420..796fff7182 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -131,13 +131,7 @@ my @if_line;
#
my $te_max_vars = 0; # Max number of variables ever needed.
my %gen_transform;
-my %match_engine_ops; # All opcodes for the match engine.
-my %gen_transform_offset;
my @transformations;
-my @call_table;
-my %call_table;
-my @pred_table;
-my %pred_table;
# Operand types for generic instructions.
@@ -338,12 +332,6 @@ sub define_type_bit {
define_type_bit('H', $type_bit{'u'});
}
-#
-# Pre-define the 'fail' instruction. It is used internally
-# by the 'try_me_else_fail' instruction.
-#
-$match_engine_ops{'TOP_fail'} = 1;
-
#
# Sanity checks.
#
@@ -866,6 +854,14 @@ sub emulator_output {
open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
comment('C');
include_files();
+ print '#include "erl_term.h"', "\n";
+ print '#include "erl_map.h"', "\n";
+ print '#include "big.h"', "\n";
+ print '#include "erl_bits.h"', "\n";
+ print '#include "erl_binary.h"', "\n";
+ print '#include "beam_transform_helpers.h"', "\n";
+ print '#include "erl_global_literals.h"', "\n";
+ print "\n";
print "const char tag_to_letter[] = {\n ";
for ($i = 0; $i < length($genop_types); $i++) {
@@ -994,11 +990,10 @@ sub emulator_output {
my($arity) = $gen_arity[$i];
printf "/* %3d */ ", $i;
if (!defined $name) {
- init_item("", 0, 0, 0, -1);
+ init_item("", 0, 0, 0, 0);
} else {
my($key) = "$name/$arity";
- my($tr) = defined $gen_transform_offset{$key} ?
- $gen_transform_offset{$key} : -1;
+ my($tr) = defined $gen_transform{$key} ? 1 : 0;
my($spec_op) = $gen_to_spec{$key};
my($num_specific) = $num_specific{$key};
defined $spec_op or
@@ -1075,17 +1070,6 @@ sub emulator_output {
}
print "\n#define BEAM_NUM_TAGS $tag_num\n\n";
- $i = 0;
- foreach (sort keys %match_engine_ops) {
- print "#define $_ $i\n";
- $i++;
- }
- print "#define NUM_TOPS $i\n";
- print "\n";
-
- print "#define TE_MAX_VARS $te_max_vars\n";
- print "\n";
-
print "extern const char tag_to_letter[];\n";
print "extern const Uint op_transform[];\n";
print "\n";
@@ -1128,28 +1112,6 @@ sub emulator_output {
print "#endif\n";
-
- #
- # Extension of transform engine.
- #
-
- $name = "$outdir/beam_transform.c";
- open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
- comment('C');
- include_files();
- print '#include "erl_term.h"', "\n";
- print '#include "erl_map.h"', "\n";
- print '#include "big.h"', "\n";
- print '#include "erl_bits.h"', "\n";
- print '#include "erl_binary.h"', "\n";
- print '#include "beam_transform_helpers.h"', "\n";
- print '#include "erl_global_literals.h"', "\n";
- print "\n";
- gen_tr_code('pred.');
- gen_tr_func('int', 'erts_beam_eval_predicate', @pred_table);
- gen_tr_code('gen.');
- gen_tr_func('BeamOp*', 'erts_beam_execute_transform', @call_table);
-
#
# Implementation of operations for emulator.
#
@@ -2702,6 +2664,12 @@ sub tr_gen {
tr_gen_to($line, $orig_transform, $so_far, @$to_ref);
}
+ #
+ # Print predicate and generation functions.
+ #
+ gen_tr_code('pred.');
+ gen_tr_code('gen.');
+
#
# Group instructions.
#
@@ -2712,36 +2680,360 @@ sub tr_gen {
#
# Print the generated transformation engine.
#
- my($offset) = 0;
- print "const Uint op_transform[] = {\n";
+
+ my $vars = join(", ", map { "v$_" } 0..$te_max_vars-1);
+ print <<"END";
+int erts_transform_engine(LoaderState* st) {
+ BeamOpArg $vars;
+ BeamOp* first = st->genop;
+ BeamOp* instr = first;
+ BeamOp* keep;
+ BeamOpArg* rest_args;
+ int num_rest_args;
+END
+
+ my $label = 0;
+ my $ap = 0;
+ my $ip = 1;
+ my $need_label = 0;
+
+ print " switch (first->op) {\n";
foreach $key (sort keys %gen_transform) {
- $gen_transform_offset{$key} = $offset;
my $lref = $gen_transform{$key};
+ my($name,$arity) = $key =~ m@^([^/]+)/(\d+)$@;
+ print " case $gen_opnum{$name,$arity}: /* $key */\n";
+ $need_label = 0;
+
for (my $i = 0; $i < @$lref; $i++) {
my(undef,undef,undef,$comment,@instr) = @{${$lref}[$i]};
$comment =~ s/\n(.)/\n $1/g;
print $comment;
+ if ($need_label) {
+ print <<"END";
+ fail$label:
+ instr = first;
+END
+ }
+ $label++;
+ $need_label = 1;
+ $ap = 0;
+ $ip = 0;
+ my $fail_action = "return TE_FAIL";
+
foreach $instr (@instr) {
my($size, $instr_ref, $comment) = @$instr;
my($op, @args) = @$instr_ref;
- print " ";
- $op = "TOP_$op";
- $match_engine_ops{$op} = 1;
- if ($comment ne '') {
- printf "%-30s /* %s */\n", (join(", ", ($op, @args)) . ","),
- $comment;
- } else {
- print join(", ", ($op, @args)), ",\n";
+ if ($op eq 'next_arg') {
+ $ap++;
+ } elsif ($op eq 'next_instr') {
+ $ap = 0;
+ $ip++;
+ } elsif ($op eq 'new_instr') {
+ $ap = 0;
+ } elsif ($op eq 'commit') {
+ $ap = 0;
+ } elsif ($op eq 'commit_new_instr') {
+ $ap = 0;
+ $ip--;
+ } elsif ($op eq 'keep') {
+ $ip--;
+ } elsif ($op eq 'try_me_else') {
+ $fail_action = "goto fail$label";
+ } elsif ($op eq 'skip_unless') {
+ $fail_action = "goto fail$label";
+ $need_label = 0;
}
- $offset += $size;
+ gen_te_instr($ap, $ip, $fail_action, $comment, $op, @args);
}
}
- print "\n";
+ print "\n";
+ }
+ print " default: ASSERT(0); return TE_FAIL;\n";
+ print " }\n";
+ print "}\n\n";
+}
+
+sub gen_te_instr {
+ my($ap,$ip,$fail_action,$comment,$op,@args) = @_;
+
+ if ($op eq 'next_arg') {
+ ;
+ } elsif ($op eq 'nop') {
+ ;
+ } elsif ($op eq 'try_me_else') {
+ ;
+ } elsif ($op eq 'try_me_else_fail') {
+ ;
+ } elsif ($op eq 'skip_unless') {
+ my($instr,$count) = @args;
+ my($fail_label) = $fail_action =~ /^goto fail(\d+)/;
+ if (defined $fail_label) {
+ $fail_action = "goto fail" . ($fail_label+$count);
+ }
+ print <<"END";
+ /*
+ * Note that the caller of transform_engine() guarantees that
+ * there is always a second instruction available.
+ */
+ ASSERT(instr);
+ if (instr->next->op != $instr) {
+ /* The second instruction is wrong. Skip ahead. */
+ $fail_action;
+ }
+END
+ } elsif ($op eq 'set_var') {
+ my $var = "v$args[0]";
+ print <<"END";
+ $var = instr->a[$ap]; /* $comment */
+END
+ } elsif ($op eq 'is_bif') {
+ my $bif_number = $args[0];
+ my $specific_bif_action = "";
+ my $bif_comment;
+ if ($bif_number eq '-1') {
+ $bif_comment = "Is $comment a BIF?";
+ } else {
+ $bif_comment = "Is $comment $bif_number?";
+ $specific_bif_action = <<"END";
+ if (entry != &bif_table[$bif_number]) {
+ $fail_action; /* Not $bif_number */
+ }
+END
+ }
+ print <<"END";
+ /* $bif_comment */
+ ASSERT(instr->a[$ap].type == TAG_u);
+ if (instr->a[$ap].type != TAG_u) {
+ $fail_action;
+ } else {
+ int i = instr->a[$ap].val;
+ ASSERT(i < st->beam.imports.count);
+ if (i >= st->beam.imports.count) {
+ $fail_action;
+ } else {
+ BifEntry *entry = st->bif_imports[i];
+
+ if (!entry) {
+ $fail_action; /* Not a BIF */
+ }
+$specific_bif_action
+ }
+ }
+END
+ } elsif ($op eq 'is_not_bif') {
+ my $bif_number = $args[0];
+ print <<"END";
+ /* Is $comment not a BIF? */
+ {
+ int i = instr->a[$ap].val;
+
+ /*
+ * In debug build, the type must be 'u'.
+ */
+ ASSERT(instr->a[$ap].type == TAG_u);
+ if (instr->a[$ap].type != TAG_u) {
+ $fail_action;
+ } else if (i < st->beam.imports.count) {
+ BeamFile_ImportEntry *import;
+
+ if (st->bif_imports[i]) {
+ $fail_action;
+ }
+
+ /* erlang:apply/2,3 are strange. They exist as (dummy) BIFs
+ * so that they are included in the export table before
+ * the erlang module is loaded. They also exist in the
+ * erlang module as functions. When used in code, a special
+ * Beam instruction is used.
+ *
+ * Below we recognize erlang:apply/2,3 as special. This is
+ * necessary because after setting a trace pattern on
+ * them, you can no longer see from the export entry that
+ * they are special. */
+ import = &st->beam.imports.entries[i];
+
+ if (import->module == am_erlang) {
+ if (import->function == am_apply) {
+ if (import->arity == 2 || import->arity == 3) {
+ $fail_action;
+ }
+ }
+ }
+ }
+ }
+END
+ } elsif ($op eq 'is_eq') {
+ my $val = $args[0];
+ print <<"END";
+ /* Test value */
+ if (instr->a[$ap].val != $val) {
+ $fail_action;
+ }
+END
+ } elsif ($op eq 'is_func') {
+ my($mod,$name,$arity) = @args;
+ print <<"END";
+ /* Is $comment the function $mod:$name/$arity? */
+ ASSERT(instr->a[$ap].type == TAG_u);
+ if (instr->a[$ap].type != TAG_u) {
+ $fail_action;
+ } else {
+ int i = instr->a[$ap].val;
+ BeamFile_ImportEntry* import;
+ ASSERT(i < st->beam.imports.count);
+ if (i >= st->beam.imports.count) {
+ $fail_action;
+ }
+ import = &st->beam.imports.entries[i];
+ if (import->module != $mod || import->function != $name || import->arity != $arity) {
+ $fail_action;
+ }
+ }
+END
+ } elsif ($op eq 'is_type') {
+ my $mask = $args[0];
+ print <<"END";
+ /* Test type */
+ if (((1 << instr->a[$ap].type) & $mask) == 0) { /* $comment */
+ $fail_action;
+ }
+END
+ } elsif ($op eq 'next_instr') {
+ my $expected = $args[0];
+ my $window_check = "ASSERT(instr)";
+ if ($ip > 1) {
+ $window_check = "if (instr == NULL) return TE_SHORT_WINDOW";
+ }
+ print <<"END";
+ /* Advance to next instruction */
+ instr = instr->next;
+ $window_check;
+ if (instr->op != $expected) { /* $comment */
+ $fail_action;
+ }
+END
+ } elsif ($op eq 'call') {
+ my($name,@vars) = @args;
+ my $call = $name . "(" . join(", ", ("st", @vars)) . ")";
+ print <<"END";
+ /* Call generator $name() */
+ {
+ BeamOp** lastp;
+ BeamOp* new_instr = $call;
+
+ if (new_instr == NULL) {
+ $fail_action;
+ }
+
+ keep = instr->next; /* The next_instr was optimized away. */
+
+ lastp = &new_instr;
+ while (*lastp != NULL) {
+ lastp = &((*lastp)->next);
+ }
+
+ *lastp = keep;
+ instr = new_instr;
+ }
+END
+ } elsif ($op eq 'pred') {
+ my($name,@vars) = @args;
+ my $pred = "$name(" . join(", ", ("st", @vars)) . ")";
+ print <<"END";
+ /* Call predicate $name() */
+ if (!$pred) {
+ $fail_action;
+ }
+END
+ } elsif ($op eq 'rest_args') {
+ my($formal_arity) = @args;
+ print <<"END";
+ /* Store dynamic arguments ($comment) */
+ num_rest_args = instr->arity - $formal_arity;
+ rest_args = &instr->a[$formal_arity];
+END
+ } elsif ($op eq 'commit') {
+ print <<"END";
+ /* $comment */
+ keep = instr = instr->next;
+END
+ } elsif ($op eq 'commit_new_instr') {
+ my($instr_op) = @args;
+ my $arity = $gen_arity{$gen_opname[$instr_op]};
+ print <<"END";
+ /* $comment; reusing last instruction on the left-hand side */
+ ASSERT(instr->a == instr->def_args);
+ keep = instr;
+ instr->op = $instr_op;
+ instr->arity = $arity;
+END
+ } elsif ($op eq 'keep') {
+ print <<"END";
+ /* Keep the current instruction unchanged */
+ keep = instr;
+END
+ } elsif ($op eq 'new_instr') {
+ my($instr_op) = @args;
+ my $arity = $gen_arity{$gen_opname[$instr_op]};
+ print <<"END";
+ /* Create instruction: $comment */
+ {
+ BeamOp* new_instr = beamopallocator_new_op(&st->op_allocator);
+ new_instr->next = instr;
+ instr = new_instr;
+ instr->op = $instr_op;
+ instr->arity = $arity;
+ }
+END
+ } elsif ($op eq 'rename') {
+ my($instr_op) = @args;
+ my $arity = $gen_arity{$gen_opname[$instr_op]};
+ print <<"END";
+ /* Rename instruction keeping the arguments */
+ instr->op = $instr_op;
+ instr->arity = $arity;
+ return TE_OK;
+END
+ } elsif ($op eq 'store_var') {
+ my $var = $args[0];
+ print " instr->a[$ap] = v$var; /* $comment */\n";
+ } elsif ($op eq 'store_val') {
+ my($type,$val) = @args;
+ print <<"END";
+ /* Store value $comment */
+ instr->a[$ap].type = $type;
+ instr->a[$ap].val = $val;
+END
+ } elsif ($op eq 'store_rest_args') {
+ my($type,$val) = @args;
+ print <<"END";
+ /* Store dynamic arguments ($comment) */
+ ASSERT(instr->a == instr->def_args);
+ instr->arity = instr->arity + num_rest_args;
+ instr->a = erts_alloc(ERTS_ALC_T_LOADER_TMP,
+ instr->arity * sizeof(BeamOpArg));
+ sys_memcpy(instr->a, instr->def_args, $ap * sizeof(BeamOpArg));
+ sys_memcpy(instr->a+$ap, rest_args, num_rest_args*sizeof(BeamOpArg));
+END
+ } elsif ($op eq 'end') {
+ print <<"END";
+ /* End of transformation */
+ st->genop = instr;
+ while (first != keep) {
+ BeamOp* next = first->next;
+ beamopallocator_free_op(&st->op_allocator, first);
+ first = next;
+ }
+ return TE_OK;
+END
+ } elsif ($op eq 'fail') {
+ print "/* Fail transformation */\n";
+ print "return TE_FAIL;\n";
+ } else {
+ error("Unhandled instruction: $op @args");
}
- print starred_comment("Total number of words: $offset");
- print "};\n\n";
}
sub tr_gen_from {
@@ -2786,7 +3078,7 @@ sub tr_gen_from {
unless defined $var{$var};
push @vars, $var;
if ($var_type{$var} eq 'scalar') {
- push(@args, "var[$var{$var}]");
+ push(@args, "v$var{$var}");
push @param_types, 'BeamOpArg';
} else {
push(@args, "rest_args");
@@ -2796,8 +3088,7 @@ sub tr_gen_from {
my $c_name = "pred.$name";
$c_param_types{$c_name} = \@param_types;
$c_code_used{$c_name} = 1;
- my $pi = next_tr_index(\@{pred_table}, \%pred_table, $name, @args);
- my $op = make_op("$name()", 'pred', $pi);
+ my $op = make_op("$name()", 'pred', $name, @args);
my @slots = grep(/^\d+/, map { $var{$_} } @vars);
op_slot_usage($op, @slots);
push(@code, $op);
@@ -2814,9 +3105,9 @@ sub tr_gen_from {
push(@code, make_op("$name/$arity", 'next_instr', $opnum));
push @instrs, "$name/$arity";
+ my $arg = 0;
foreach $op (@ops) {
my($var, $type, $type_val, $cond, $val) = @$op;
- my $ignored_var = "$var (ignored)";
if ($type ne '' && $type ne '*') {
$may_fail = 1;
@@ -2826,7 +3117,6 @@ sub tr_gen_from {
# their own built-in type test and don't need to
# be guarded with a type test instruction.
#
- $ignored_var = '';
unless ($cond eq 'is_bif' or
$cond eq 'is_not_bif' or
$cond eq 'is_func') {
@@ -2840,16 +3130,18 @@ sub tr_gen_from {
}
}
+ $arg++;
+ my $var_comment = "variable $var";
+ $var_comment = "argument $arg"
+ if $var eq '';
if ($cond eq 'is_func') {
my($m, $f, $a) = split(/:/, $val);
- $ignored_var = '';
$may_fail = 1;
- push(@code, make_op('', "$cond", "am_$m",
- "am_$f", $a));
+ push @code, make_op($var_comment, $cond, "am_$m", "am_$f", $a);
} elsif ($cond ne '') {
- $ignored_var = '';
$may_fail = 1;
- push(@code, make_op('', "$cond", $val));
+
+ push @code, make_op($var_comment, $cond, $val);
}
if ($var ne '') {
@@ -2866,19 +3158,17 @@ sub tr_gen_from {
"a transformation")
if $type eq 'array';
}
- $ignored_var = '';
$var{$var} = 'unnumbered';
$var_type{$var} = 'array';
- push(@code, make_op($var, 'rest_args'));
+ push @code, make_op($var, 'rest_args', $arity);
} else {
- $ignored_var = '';
$var_type{$var} = 'scalar';
$var{$var} = $var_num;
$var_num++;
push(@code, make_op($var, 'set_var', $var{$var}));
}
}
- push(@code, make_op($ignored_var, 'next_arg'));
+ push(@code, make_op('', 'next_arg'));
}
# Remove redundant 'next_arg' instructions before the end
@@ -2889,7 +3179,8 @@ sub tr_gen_from {
#
# Insert the commit operation.
#
- push(@code, make_op($may_fail ? '' : 'always reached', 'commit'));
+ push(@code, make_op($may_fail ? 'This rule succeeds' :
+ 'This rule always succeeds', 'commit'));
$te_max_vars = $var_num
if $te_max_vars < $var_num;
@@ -2926,7 +3217,7 @@ sub tr_gen_to {
error($where, "variable '$var' unbound")
unless defined $var{$var};
if ($var_type{$var} eq 'scalar') {
- push @args, "var[$var{$var}]";
+ push @args, "v$var{$var}";
push @param_types, 'BeamOpArg';
} else {
push @args, "rest_args";
@@ -2937,9 +3228,7 @@ sub tr_gen_to {
$c_param_types{$c_name} = \@param_types;
$c_code_used{$c_name} = 1;
pop(@code); # Get rid of 'commit' instruction
- my $index = next_tr_index(\@call_table, \%call_table,
- $name, @args);
- my $op = make_op("$name()", 'call', $index);
+ my $op = make_op("$name()", 'call', $name, @args);
my @slots = grep(/^\d+/, map { $var{$_} } @ops);
op_slot_usage($op, @slots);
push(@code, $op);
@@ -3062,7 +3351,7 @@ sub group_tr {
if ($i == $#{$lref}) {
unshift @c, make_op('', 'try_me_else_fail');
} else {
- unshift @c, make_op('', 'try_me_else', code_len(@c));
+ unshift @c, make_op('', 'try_me_else');
}
}
${$lref}[$i] = [$first,$second,$cannot_fail,$comment,@c];
@@ -3083,7 +3372,7 @@ sub group_tr {
for ($j = $i; $j < @$lref; $j++) {
my(undef,$other,undef,undef,@c) = @{${$lref}[$j]};
last unless defined $other and $other eq $current;
- $skip_len += code_len(@c);
+ $skip_len++;
}
if ($j > $i + 1) {
@@ -3097,13 +3386,11 @@ sub group_tr {
splice @$lref, $i, 0, (['','',1,$comment,$op]);
$i = $j + 1;
if ($j == $#{$lref}) {
- my($first,$second,$cannot_fail,$comment,@c) = @{${$lref}[$j]};
- push @c, make_op('wrong second instruction', 'fail');
- ${$lref}[$j] = [$first,$second,$cannot_fail,$comment,@c];
+ my(@c) = (make_op('wrong second instruction', 'fail'));
+ push @$lref, ['','','','',@c];
}
}
}
-
$lref;
}
@@ -3162,6 +3449,7 @@ sub combine_commit {
if ($op eq 'rest_args') {
return;
} elsif ($op eq 'new_instr' and is_instr($$ref[$i-1], 'commit')) {
+ $comment = get_comment($$ref[$i-1]);
my $op = make_op($comment, 'commit_new_instr', @args);
splice @$ref, $i - 1, 2, ($op);
}
@@ -3295,16 +3583,6 @@ sub gen_tr_code {
}
}
-sub code_len {
- my($sum) = 0;
- my($ref);
-
- foreach $ref (@_) {
- $sum += $$ref[0];
- }
- $sum;
-}
-
sub make_op {
my($comment, @op) = @_;
[scalar(@op), [@op], $comment, []];
@@ -3331,34 +3609,6 @@ sub starred_comment {
"\n/*" . join("\n * ", '', @_) . "\n */\n\n";
}
-sub next_tr_index {
- my($lref,$href,$name,@args) = @_;
- my $code = "return $name(" . join(', ', 'st', @args) . ");\n";
- my $index;
-
- if (defined $$href{$code}) {
- $index = $$href{$code};
- } else {
- $index = scalar(@$lref);
- push(@$lref, $code);
- $$href{$code} = $index;
- }
- $index;
-}
-
-sub gen_tr_func {
- my($type,$name,@call_table) = @_;
-
- print "$type $name(unsigned int op, LoaderState* st, BeamOpArg var[], BeamOpArg* rest_args) {\n";
- print " switch (op) {\n";
- for (my $i = 0; $i < @call_table; $i++) {
- print " case $i: $call_table[$i]";
- }
- print qq[ default: erts_exit(ERTS_ABORT_EXIT, "$name: invalid op %d\\n", op);];
- print " }\n";
- print "}\n\n";
-}
-
sub include_files() {
print "#ifdef HAVE_CONFIG_H\n";
print "# include \"config.h\"\n";
--
2.35.3
