aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator
diff options
context:
space:
mode:
authorBjörn Gustavsson <[email protected]>2011-05-12 10:35:32 +0200
committerBjörn Gustavsson <[email protected]>2011-08-03 11:24:52 +0200
commit8f066e99c9d614742dfb987befe72d21de4d739a (patch)
treebdf8a0c45c51c50c7570de6b1a6466ada91ff29d /erts/emulator
parente8becad96454a8deb755f587ca0daaf96dfca90e (diff)
downloadotp-8f066e99c9d614742dfb987befe72d21de4d739a.tar.gz
otp-8f066e99c9d614742dfb987befe72d21de4d739a.tar.bz2
otp-8f066e99c9d614742dfb987befe72d21de4d739a.zip
beam_makeops: Add some sanity checks
We want to make sure that a tag/type name is not defined more than once and that we don't define too many primitive tags. Primitive tags must be named with lowercase letters (or they will be confused with variable names in transformations in the ops.tab file).
Diffstat (limited to 'erts/emulator')
-rwxr-xr-xerts/emulator/utils/beam_makeops69
1 files changed, 52 insertions, 17 deletions
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index e7c57142c0..1a117b168f 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -67,6 +67,10 @@ my $max_gen_operands = 8;
# Must be even. The beam_load.c file must be updated, too.
my $max_spec_operands = 6;
+# The maximum number of primitive genop_types.
+
+my $max_genop_types = 16;
+
my %gen_opnum;
my %num_specific;
my %gen_to_spec;
@@ -142,34 +146,61 @@ my %arg_size = ('r' => 0, # x(0) - x register zero
my %type_bit;
my @tag_type;
+sub define_type_bit {
+ my($tag,$val) = @_;
+ defined $type_bit{$tag} and
+ sanity("the tag '$tag' has already been defined with the value ",
+ $type_bit{$tag});
+ $type_bit{$tag} = $val;
+}
+
{
my($bit) = 1;
my(%bit);
foreach (split('', $genop_types)) {
push(@tag_type, $_);
- $type_bit{$_} = $bit;
+ define_type_bit($_, $bit);
$bit{$_} = $bit;
$bit *= 2;
}
# Composed types.
- $type_bit{'d'} = $type_bit{'x'} | $type_bit{'y'} | $type_bit{'r'};
- $type_bit{'c'} = $type_bit{'i'} | $type_bit{'a'} | $type_bit{'n'} | $type_bit{'q'};
- $type_bit{'s'} = $type_bit{'d'} | $type_bit{'i'} | $type_bit{'a'} | $type_bit{'n'};
- $type_bit{'j'} = $type_bit{'f'} | $type_bit{'p'};
+ define_type_bit('d', $type_bit{'x'} | $type_bit{'y'} | $type_bit{'r'});
+ define_type_bit('c', $type_bit{'i'} | $type_bit{'a'} |
+ $type_bit{'n'} | $type_bit{'q'});
+ define_type_bit('s', $type_bit{'d'} | $type_bit{'i'} |
+ $type_bit{'a'} | $type_bit{'n'});
+ define_type_bit('j', $type_bit{'f'} | $type_bit{'p'});
# Aliases (for matching purposes).
- $type_bit{'I'} = $type_bit{'u'};
- $type_bit{'t'} = $type_bit{'u'};
- $type_bit{'A'} = $type_bit{'u'};
- $type_bit{'L'} = $type_bit{'u'};
- $type_bit{'b'} = $type_bit{'u'};
- $type_bit{'N'} = $type_bit{'u'};
- $type_bit{'U'} = $type_bit{'u'};
- $type_bit{'e'} = $type_bit{'u'};
- $type_bit{'P'} = $type_bit{'u'};
- $type_bit{'Q'} = $type_bit{'u'};
+ define_type_bit('I', $type_bit{'u'});
+ define_type_bit('t', $type_bit{'u'});
+ define_type_bit('A', $type_bit{'u'});
+ define_type_bit('L', $type_bit{'u'});
+ define_type_bit('b', $type_bit{'u'});
+ define_type_bit('N', $type_bit{'u'});
+ define_type_bit('U', $type_bit{'u'});
+ define_type_bit('e', $type_bit{'u'});
+ define_type_bit('P', $type_bit{'u'});
+ define_type_bit('Q', $type_bit{'u'});
+}
+
+#
+# Sanity checks.
+#
+
+{
+ if (@tag_type > $max_genop_types) {
+ sanity("\$max_genop_types is $max_genop_types, ",
+ "but there are ", scalar(@tag_type),
+ " primitive tags defined\n");
+ }
+
+ foreach my $tag (@tag_type) {
+ sanity("tag '$tag': primitive tags must be named with lowercase letters")
+ unless $tag =~ /^[a-z]$/;
+ }
}
#
@@ -436,12 +467,12 @@ sub emulator_output {
#
my(@bits) = (0) x ($max_spec_operands/2);
- my($shift) = 16;
my($i);
for ($i = 0; $i < $max_spec_operands && defined $args[$i]; $i++) {
my $t = $args[$i];
if (defined $type_bit{$t}) {
- $bits[int($i/2)] |= $type_bit{$t} << (16*($i%2));
+ my $shift = $max_genop_types * ($i % 2);
+ $bits[int($i/2)] |= $type_bit{$t} << $shift;
}
}
@@ -753,6 +784,10 @@ sub error {
die $where, @message, "\n";
}
+sub sanity {
+ die "internal error: ", @_, "\n";
+}
+
sub comment {
my($lang, @comments) = @_;
my($prefix);