The R13B03 release.OTP_R13B03

8 files changed, 3032 insertions, 0 deletions

diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
new file mode 100755
index 0000000000..2b7e8a6dde
--- /dev/null
+++ b/erts/emulator/utils/beam_makeops
@@ -0,0 +1,1500 @@
+#!/usr/bin/env perl
+#
+# %CopyrightBegin%
+# 
+# Copyright Ericsson AB 1998-2009. All Rights Reserved.
+# 
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+# 
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+# 
+# %CopyrightEnd%
+#
+use strict;
+use vars qw($BEAM_FORMAT_NUMBER);
+
+$BEAM_FORMAT_NUMBER = undef;
+
+my $target = \&emulator_output;
+my $outdir = ".";		# Directory for output files.
+my $verbose = 0;
+my $hot = 1;
+my $num_file_opcodes = 0;
+
+# This is shift counts and mask for the packer.
+my $WHOLE_WORD = '';
+my @pack_instr;
+my @pack_shift;
+my @pack_mask;
+
+$pack_instr[2] = ['6', 'i'];
+$pack_instr[3] = ['0', '0', 'i'];
+
+$pack_shift[2] = ['0', 'BEAM_LOOSE_SHIFT'];
+$pack_shift[3] = ['0', 'BEAM_TIGHT_SHIFT', '(2*BEAM_TIGHT_SHIFT)'];
+
+$pack_mask[2]  = ['BEAM_LOOSE_MASK', $WHOLE_WORD];
+$pack_mask[3]  = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK'];
+
+# There are two types of instructions: generic and specific.
+# The generic instructions are those generated by the Beam compiler.
+# Corresponding to each generic instruction, there is generally a
+# whole family of related specific instructions. Specific instructions
+# are those executed by the VM interpreter during run-time.
+
+# Maximum number of operands for a generic instruction.
+# In beam_load.c the MAX_OPARGS refers to the maximum
+# number of operands for generic instructions.
+my $max_gen_operands = 8;
+
+# Maximum number of operands for a specific instruction.
+# Must be even. The beam_load.c file must be updated, too.
+my $max_spec_operands = 6;
+
+my %gen_opnum;
+my %num_specific;
+my %gen_to_spec;
+my %specific_op;
+
+my %gen_arity;
+my @gen_arity;
+
+my @gen_opname;
+my @op_to_name;
+
+my @obsolete;
+
+my %macro;
+my %macro_flags;
+
+my %hot_code;
+my %cold_code;
+
+my @unnumbered_generic;
+my %unnumbered;
+
+#
+# Code transformations.
+#
+my $te_max_vars = 0;		# Max number of variables ever needed.
+my %gen_transform;
+my %min_window;
+my %match_engine_ops;		# All opcodes for the match engine.
+my %gen_transform_offset;
+my @transformations;
+my @call_table;
+my @pred_table;
+
+# Operand types for generic instructions.
+
+my $compiler_types = "uiaxyfhz";
+my $loader_types = "nprvlq";
+my $genop_types = $compiler_types . $loader_types;
+
+#
+# Defines the argument types and their loaded size assuming no packing.
+#
+my %arg_size = ('r' => 0,	# x(0) - x register zero
+		'x' => 1,	# x(N), N > 0 - x register
+		'y' => 1,	# y(N) - y register
+		'i' => 1,	# tagged integer
+		'a' => 1,	# tagged atom
+		'n' => 0,	# NIL (implicit)
+		'c' => 1,	# tagged constant (integer, atom, nil)
+		's' => 1,	# tagged source; any of the above
+		'd' => 1,	# tagged destination register (r, x, y)
+		'f' => 1,	# failure label
+		'j' => 1,	# either 'f' or 'p'
+		'e' => 1,	# pointer to export entry
+		'L' => 0,	# label
+		'I' => 1,	# untagged integer
+		't' => 1,	# untagged integer -- can be packed
+		'b' => 1,	# pointer to bif
+		'A' => 1,	# arity value
+		'P' => 1,	# byte offset into tuple
+		'h' => 1,	# character
+		'l' => 1,	# float reg
+		'q' => 1,	# literal term
+	     );
+
+#
+# Generate bits.
+#
+my %type_bit;
+my @tag_type;
+
+{
+    my($bit) = 1;
+    my(%bit);
+
+    foreach (split('', $genop_types)) {
+	push(@tag_type, $_);
+	$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'};
+
+    # 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'};
+}
+
+#
+# Parse command line options.
+#
+
+while (@ARGV && $ARGV[0] =~ /^-(.*)/) {
+    $_ = $1;
+    shift;
+    ($target = \&emulator_output), next if /^emulator/;
+    ($target = \&compiler_output), next if /^compiler/;
+    ($outdir = shift), next if /^outdir/;
+    ($verbose = 1), next if /^v/;
+    die "$0: Bad option: -$_\n";
+}
+
+#
+# Parse the input files.
+#
+
+while (<>) {
+    my($op_num);
+    chomp;
+    if (s/\\$//) {
+	$_ .= <>;
+	redo unless eof(ARGV);
+    }
+    next if /^\s*$/;
+    next if /^\#/;
+    
+    #
+    # Handle assignments.
+    #
+    if (/^([\w_][\w\d_]+)=(.*)/) {
+	no strict 'refs';
+	my($name) = $1;
+	$$name = $2;
+	next;
+    }
+
+    #
+    # Handle %hot/%cold.
+    # 
+    if (/^\%hot/) {
+	$hot = 1;
+	next;
+    } elsif (/^\%cold/) {
+	$hot = 0;
+	next;
+    }
+    
+    #
+    # Handle macro definitions.
+    #
+    if (/^\%macro:(.*)/) {
+	my($op, $macro, @flags) = split(' ', $1);
+	defined($macro) and $macro =~ /^-/ and
+	    &error("A macro must not start with a hyphen");
+	foreach (@flags) {
+	    /^-/ or &error("Flags for macros should start with a hyphen");
+	}
+	error("Macro for '$op' is already defined")
+	    if defined $macro{$op};
+	$macro{$op} = $macro;
+	$macro_flags{$op} = join('', @flags);
+	next;
+    }
+
+    #
+    # Handle transformations.
+    #
+    if (/=>/) {
+	&parse_transformation($_);
+	next;
+    }
+
+    #
+    # Parse off the number of the operation.
+    #
+    $op_num = undef;
+    if (s/^(\d+):\s*//) {
+	$op_num = $1;
+	$op_num != 0 or &error("Opcode 0 invalid");
+	&error("Opcode $op_num already defined")
+	    if defined $gen_opname[$op_num];
+    }
+
+    #
+    # Parse: Name/Arity  (generic instruction)
+    #
+    if (m@^(-)?(\w+)/(\d)\s*$@) {
+	my($obsolete) = $1;
+	my($name) = $2;
+	my($arity) = $3;
+	$name =~ /^[a-z]/ or &error("Opname must start with a lowercase letter");
+	defined $gen_arity{$name} and $gen_arity{$name} != $arity and
+	    &error("Opname $name already defined with arity $gen_arity{$name}");
+	defined $unnumbered{$name,$arity} and
+	    &error("Opname $name already defined with arity $gen_arity{$name}");
+	
+	if (defined $op_num) {	# Numbered generic operation
+	    $gen_opname[$op_num] = $name;
+	    $gen_arity[$op_num] = $arity;
+	    $gen_opnum{$name,$arity} = $op_num;
+	    $gen_arity{$name} = $arity;
+	    $gen_to_spec{"$name/$arity"} = undef;
+	    $num_specific{"$name/$arity"} = 0;
+	    $min_window{"$name/$arity"} = 255;
+	    $obsolete[$op_num] = $obsolete eq '-';
+	} else {		# Unnumbered generic operation.
+	    push(@unnumbered_generic, [$name, $arity]);
+	    $unnumbered{$name,$arity} = 1;
+	}
+	next;
+    }
+
+    #
+    # Parse specific instructions (only present in emulator/loader):
+    #    Name Arg1 Arg2...
+    #
+    my($name, @args) = split;
+    &error("too many operands")
+	if @args > $max_spec_operands;
+    &syntax_check($name, @args);
+    my $arity = @args;
+    if ($obsolete[$gen_opnum{$name,$arity}]) {
+	error("specific instructions may not be specified for obsolete instructions");
+    }
+    push(@{$specific_op{"$name/$arity"}}, [$name, $hot, @args]);
+    if (defined $op_num) {
+	&error("specific instructions must not be numbered");
+    } elsif (!defined($gen_arity{$name}) && !defined($unnumbered{$name,$arity})) {
+	#
+	# Create an unumbered generic instruction too.
+	#
+	push(@unnumbered_generic, [$name, $arity]);
+	$unnumbered{$name,$arity} = 1;
+    }
+} continue {
+    close(ARGV) if eof(ARGV);
+}
+
+$num_file_opcodes = @gen_opname;
+
+#
+# Number all generic operations without numbers.
+#
+{
+    my $ref;
+
+    foreach $ref (@unnumbered_generic) {
+	my($name, $arity) = @$ref;
+	my $op_num = @gen_opname;
+	push(@gen_opname, $name);
+	push(@gen_arity, $arity);
+	$gen_opnum{$name,$arity} = $op_num;
+	$gen_arity{$name} = $arity;
+	$gen_to_spec{"$name/$arity"} = undef;
+	$num_specific{"$name/$arity"} = 0;
+	$min_window{"$name/$arity"} = 255;
+    }
+}
+
+#
+# Produce output for the chosen target.
+#
+
+&$target;
+
+#
+# Produce output needed by the emulator/loader.
+#
+
+sub emulator_output {
+    my $i;
+    my $name;
+    my $key;			# Loop variable.
+
+    #
+    # Information about opcodes (beam_opcodes.c).
+    #
+    $name = "$outdir/beam_opcodes.c";
+    open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
+    &comment('C');
+    print "#ifdef HAVE_CONFIG_H\n";
+    print "#  include \"config.h\"\n";
+    print "#endif\n\n";
+    print '#include "sys.h"', "\n";
+    print '#include "erl_vm.h"', "\n";
+    print '#include "export.h"', "\n";
+    print '#include "erl_process.h"', "\n";
+    print '#include "bif.h"', "\n";
+    print '#include "erl_atom_table.h"', "\n";
+    print '#include "beam_load.h"', "\n";
+    print "\n";
+
+    print "char tag_to_letter[] = {\n  ";
+    for ($i = 0; $i < length($genop_types); $i++) {
+	print "'$tag_type[$i]', ";
+    }
+    for (; $i < @tag_type; $i++) {
+	print "'_', ";
+    }
+    print "\n};\n";
+    print "\n";
+
+    #
+    # Generate code for specific ops.
+    #
+    my($spec_opnum) = 0;
+    print "OpEntry opc[] = {\n";
+    foreach $key (sort keys %specific_op) {
+	$gen_to_spec{$key} = $spec_opnum;
+	$num_specific{$key} = @{$specific_op{$key}};
+
+	#
+	# Pick up all instructions and manufacture sort keys; we must have
+	# the most specific instructions appearing first (e.g. an 'x' operand
+	# should be matched before 's' or 'd').
+	#
+	my(%items) = ();
+	foreach (@{$specific_op{$key}}) {
+	    my($name, $hot, @args) = @{$_};
+	    my($sign) = join('', @args);
+
+	    # The primitive types should sort before other types.
+
+	    my($sort_key) = $sign;
+	    eval "\$sort_key =~ tr/$genop_types/./";
+	    $sort_key .= ":$sign";
+	    $items{$sort_key} = [$name, $hot, $sign, @args];
+	}
+
+	#
+	# Now call the generator for the sorted result.
+	#
+	foreach (sort keys %items) {
+	    my($name, $hot, $sign, @args) = @{$items{$_}};
+	    my $arity = @args;
+	    my($instr) = "${name}_$sign";
+	    $instr =~ s/_$//;
+
+	    #
+	    # Call a generator to calculate size and generate macros
+	    # for the emulator.
+	    #
+	    my($size, $code, $pack) = &basic_generator($name, $hot, @args);
+
+	    #
+	    # Save the generated $code for later.
+	    #
+	    if (defined $code) {
+		if ($hot) {
+		    push(@{$hot_code{$code}}, $instr);
+		} else {
+		    push(@{$cold_code{$code}}, $instr);
+		}
+	    }
+
+	    #
+	    # Calculate the bit mask which should be used to match this
+	    # instruction.
+	    #
+
+	    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));
+		}
+	    }
+
+	    printf "/* %3d */  ", $spec_opnum;
+	    my $print_name = $sign ne '' ? "${name}_$sign" : $name;
+	    my $init = "{";
+	    my $sep = "";
+	    foreach (@bits) {
+		$init .= sprintf("%s0x%X", $sep, $_);
+		$sep = ",";
+	    }
+	    $init .= "}";
+	    &init_item($print_name, $init, $size, $pack, $sign, 0);
+	    $op_to_name[$spec_opnum] = $instr;
+	    $spec_opnum++;
+	}
+    }
+    print "};\n\n";
+    print "int num_instructions = $spec_opnum;\n\n";
+
+    #
+    # Generate transformations.
+    #
+
+    &tr_gen(@transformations);
+
+    #
+    # Print the generic instruction table.
+    #
+
+    print "GenOpEntry gen_opc[] = {\n";
+    for ($i = 0; $i < @gen_opname; $i++) {
+	if ($i == $num_file_opcodes) {
+	    print "\n/*\n * Internal generic instructions.\n */\n\n";
+	}
+	my($name) = $gen_opname[$i];
+	my($arity) = $gen_arity[$i];
+	printf "/* %3d */  ", $i;
+	if (!defined $name) {
+	    &init_item("", 0, 0, 0, -1);
+	} else {
+	    my($key) = "$name/$arity";
+	    my($tr) = defined $gen_transform_offset{$key} ?
+		$gen_transform_offset{$key} : -1;
+	    my($spec_op) = $gen_to_spec{$key};
+	    my($num_specific) = $num_specific{$key};
+	    defined $spec_op or $tr != -1 or
+		$obsolete[$gen_opnum{$name,$arity}] or
+		error("instruction $key has no specific instruction");
+	    $spec_op = -1 unless defined $spec_op;
+	    &init_item($name, $arity, $spec_op, $num_specific, $tr, $min_window{$key});
+	}
+    }
+    print "};\n";
+
+    #
+    # Information about opcodes (beam_opcodes.h).
+    #
+    $name = "$outdir/beam_opcodes.h";
+    open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
+    &comment('C');
+    print "#ifndef __OPCODES_H__\n";
+    print "#define __OPCODES_H__\n\n";
+
+    print "#define BEAM_FORMAT_NUMBER $BEAM_FORMAT_NUMBER\n";
+    print "#define MAX_GENERIC_OPCODE ", $num_file_opcodes-1, "\n";
+    print "#define NUM_GENERIC_OPS ", scalar(@gen_opname), "\n";
+    print "#define NUM_SPECIFIC_OPS ", scalar(@op_to_name), "\n";
+    print "\n";
+    print "#ifdef ARCH_64\n";
+    print "#  define BEAM_LOOSE_MASK 0x1FFFUL\n";
+    print "#  define BEAM_TIGHT_MASK 0x1FF8UL\n";
+    print "#  define BEAM_LOOSE_SHIFT 16\n";
+    print "#  define BEAM_TIGHT_SHIFT 16\n";
+    print "#else\n";
+    print "#  define BEAM_LOOSE_MASK 0xFFF\n";
+    print "#  define BEAM_TIGHT_MASK 0xFFC\n";
+    print "#  define BEAM_LOOSE_SHIFT 16\n";
+    print "#  define BEAM_TIGHT_SHIFT 10\n";
+    print "#endif\n";
+    print "\n";
+
+    #
+    # Definitions of tags.
+    #
+
+    my $letter;
+    my $tag_num = 0;
+
+    &comment('C', "The following operand types for generic instructions",
+	     "occur in beam files.");
+    foreach $letter (split('', $compiler_types)) {
+	print "#define TAG_$letter $tag_num\n";
+	$tag_num++;
+    }
+    print "\n";
+    &comment('C', "The following operand types are only used in the loader.");
+    foreach $letter (split('', $loader_types)) {
+	print "#define TAG_$letter $tag_num\n";
+	$tag_num++;
+    }
+    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 char tag_to_letter[];\n";
+    print "extern Uint op_transform[];\n";
+    print "\n";
+
+    for ($i = 0; $i < @op_to_name; $i++) {
+	print "#define op_$op_to_name[$i] $i\n";
+    }
+    print "\n";
+
+    print "#define NUMBER_OF_OPCODES ",scalar(@op_to_name),"\n";
+    for ($i = 0; $i < @op_to_name; $i++) {
+	print "#define op_count_$op_to_name[$i] ",$i+scalar(@op_to_name),"\n";
+    }
+    print "\n";
+
+    print "#define DEFINE_OPCODES";
+    foreach (@op_to_name) {
+	print " \\\n&&lb_$_,";
+    }
+    print "\n\n";
+
+    print "#define DEFINE_COUNTING_OPCODES";
+    foreach (@op_to_name) {
+	print " \\\n&&lb_count_$_,";
+    }
+    print "\n\n";
+
+    print "#define DEFINE_COUNTING_LABELS";
+    for ($i = 0; $i < @op_to_name; $i++) {
+	my($name) = $op_to_name[$i];
+	print " \\\nCountCase($name): opc[$i].count++; goto lb_$name;";
+    }
+    print "\n\n";
+
+    for ($i = 0; $i < @gen_opname; $i++) {
+	print "#define genop_$gen_opname[$i]_$gen_arity[$i] $i\n"
+	    if defined $gen_opname[$i];
+    }
+
+
+    print "#endif\n";
+
+
+    #
+    # Extension of transform engine.
+    #
+
+    $name = "$outdir/beam_tr_funcs.h";
+    open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
+    &comment('C');
+    &tr_gen_call(@call_table);
+
+    $name = "$outdir/beam_pred_funcs.h";
+    open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
+    &comment('C');
+    &tr_gen_call(@pred_table);
+
+    #
+    # Implementation of operations for emulator.
+    #
+    $name = "$outdir/beam_hot.h";
+    open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
+    &comment('C');
+    &print_code(\%hot_code);
+
+    $name = "$outdir/beam_cold.h";
+    open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
+    &comment('C');
+    &print_code(\%cold_code);
+
+}
+
+sub init_item {
+    my($sep) = "";
+
+    print "{";
+    foreach (@_) {
+	if (!defined $_) {
+	    print "${sep}NULL";
+	} elsif (/^\{/) {
+	    print "$sep$_";
+	} elsif (/^-?\d/) {
+	    print "$sep$_";
+	} else {
+	    print "$sep\"$_\"";
+	}
+	$sep = ", ";
+    }
+    print "},\n";
+}
+
+sub q {
+    my($str) = @_;
+    "\"$str\"";
+}
+
+sub print_code {
+    my($ref) = @_;
+    my(%sorted);
+    my($key, $label);		# Loop variables.
+
+    foreach $key (keys %$ref) {
+	my($sort_key);
+	my($code) = '';
+	foreach $label (@{$ref->{$key}}) {
+	    $code .= "OpCase($label):\n";
+	    $sort_key = $label;
+	}
+	foreach (split("\n", $key)) {
+	    $code .= "    $_\n";
+	}
+	$code .= "\n";
+	$sorted{$sort_key} = $code;
+    }
+
+    foreach (sort keys %sorted) {
+	print $sorted{$_};
+    }
+}
+
+#
+# Produce output needed by the compiler back-end (assembler).
+#
+
+sub compiler_output {
+    my($module) = 'beam_opcodes';
+    my($name) = "${module}.erl";
+    my($i);
+
+    open(STDOUT, ">$outdir/$name") || die "Failed to open $name for writing: $!\n";
+    print "-module($module).\n";
+    &comment('erlang');
+
+    print "-export([format_number/0]).\n";
+    print "-export([opcode/2,opname/1]).\n";
+    print "\n";
+    print "-spec format_number() -> $BEAM_FORMAT_NUMBER.\n";
+    print "format_number() -> $BEAM_FORMAT_NUMBER.\n\n";
+
+    print "-spec opcode(atom(), 0..", $max_gen_operands, ") -> 1..", $num_file_opcodes-1, ".\n";
+    for ($i = 0; $i < @gen_opname; $i++) {
+	next unless defined $gen_opname[$i];
+	print "%%" if $obsolete[$i];
+	print "opcode(", &quote($gen_opname[$i]), ", $gen_arity[$i]) -> $i;\n";
+    }
+    print "opcode(Name, Arity) -> erlang:error(badarg, [Name,Arity]).\n\n";
+
+    print "-spec opname(1..", $num_file_opcodes-1, ") -> {atom(),0..", $max_gen_operands, "}.\n";
+    for ($i = 0; $i < @gen_opname; $i++) {
+	next unless defined $gen_opname[$i];
+	print "opname($i) -> {",
+	&quote($gen_opname[$i]), ",$gen_arity[$i]};\n";
+    }
+    print "opname(Number) -> erlang:error(badarg, [Number]).\n";
+
+    #
+    # Generate .hrl file.
+    #
+    my($name) = "$outdir/${module}.hrl";
+    open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
+    &comment('erlang');
+
+    for ($i = 0; $i < @tag_type && $i < 8; $i++) {
+	print "-define(tag_$tag_type[$i], $i).\n";
+    }
+    print "\n";
+
+}
+
+#
+# Check an operation for validity.
+#
+sub syntax_check {
+    my($name, @args) = @_;
+    my($i);
+
+    &error("Bad opcode name '$name'")
+	unless $name =~ /^[a-z][\w\d_]*$/;
+    for ($i = 0; $i < @args; $i++) {
+	&error("Argument " . ($i+1) . ": invalid type '$args[$i]'")
+	    unless defined $arg_size{$args[$i]};
+    }
+}
+
+sub error {
+    my(@message) = @_;
+    my($where) = $. ? "$ARGV($.): " : "";
+    die $where, @message, "\n";
+}
+
+sub comment {
+    my($lang, @comments) = @_;
+    my($prefix);
+
+    if ($lang eq 'C') {
+	print "/*\n";
+	$prefix = " * ";
+    } elsif ($lang eq 'erlang') {
+	$prefix = '%% ';
+    } else {
+	$prefix = '# ';
+    }
+    my(@prog) = split('/', $0);
+    my($prog) = $prog[$#prog];
+
+    if (@comments) {
+	my $line;
+	foreach $line (@comments) {
+	    print "$prefix$line\n";
+	}
+    } else {
+	print "$prefix Warning: Do not edit this file.  It was automatically\n";
+	print "$prefix generated by '$prog' on ", (scalar localtime), ".\n";
+    }
+    if ($lang eq 'C') {
+	print " */\n";
+    }
+    print "\n";
+}
+
+#
+# Basic implementation of instruction in emulator loop
+# (assuming no packing).
+#
+
+sub basic_generator {
+    my($name, $hot, @args) = @_;
+    my($size) = 0;
+    my($macro) = '';
+    my($flags) = '';
+    my(@f);
+    my(@f_types);
+    my($fail_type);
+    my($prefix) = '';
+    my($tmp_arg_num) = 1;
+    my($pack_spec) = '';
+    my($var_decls) = '';
+    my($gen_dest_arg) = 'StoreSimpleDest';
+    my($i);
+
+    # The following argument types should be included as macro arguments.
+    my(%incl_arg) = ('c' => 1,
+		     'i' => 1,
+		     'a' => 1,
+		     'A' => 1,
+		     'N' => 1,
+		     'U' => 1,
+		     'I' => 1,
+		     't' => 1,
+		     'P' => 1,
+		     );
+
+    # Pick up the macro to use and its flags (if any).
+
+    $macro = $macro{$name} if defined $macro{$name};
+    $flags = $macro_flags{$name} if defined $macro_flags{$name};
+
+    #
+    # Add any arguments to be included as macro arguments (for instance,
+    # 'p' is usually not an argument, except for calls).
+    #
+
+    while ($flags =~ /-arg_(\w)/g) {
+	$incl_arg{$1} = 1;
+    };
+
+    #
+    # Pack arguments if requested.
+    #
+
+    if ($flags =~ /-pack/ && $hot) {
+	($prefix, $pack_spec, @args) = &do_pack(@args);
+    }
+
+    #
+    # Calculate the size of the instruction and generate each argument for
+    # the macro.
+    #
+
+    foreach (@args) {
+	my($this_size) = $arg_size{$_};
+      SWITCH:
+	{
+	    /^pack:(\d):(.*)/ and do { push(@f, $2);
+				       push(@f_types, 'packed');
+				       $this_size = $1;
+				       last SWITCH;
+				   };
+	    /r/    and do { push(@f, "r(0)"); push(@f_types, $_); last SWITCH };
+	    /[xy]/ and do { push(@f, "$_" . "b(Arg($size))");
+			     push(@f_types, $_);
+			     last SWITCH;
+			};
+	    /n/    and do { push(@f, "NIL"); push(@f_types, $_); last SWITCH };
+	    /s/    and do { my($tmp) = "targ$tmp_arg_num";
+			    $var_decls .= "Eterm $tmp; ";
+			    $tmp_arg_num++;
+			    push(@f, $tmp);
+			    push(@f_types, $_);
+			    $prefix .= "GetR($size, $tmp);\n";
+			    last SWITCH; };
+	    /d/    and do { $var_decls .= "Eterm dst; ";
+			    push(@f, "dst");
+			    push(@f_types, $_);
+			    $prefix .= "dst = Arg($size);\n";
+			    $gen_dest_arg = 'StoreResult';
+			    last SWITCH;
+			};
+	    defined($incl_arg{$_})
+		and do { push(@f, "Arg($size)");
+			 push(@f_types, $_);
+			 last SWITCH;
+		     };
+
+	    /[fp]/ and do { $fail_type = $_; last SWITCH };
+
+	    /[eLIFEbASjPowlq]/ and do { last SWITCH; };
+
+	    die "$name: The generator can't handle $_, at";
+	}
+	$size += $this_size;
+    }
+
+    #
+    # If requested, pass a pointer to the destination register.
+    # The destination must be the last operand.
+    #
+    if ($flags =~ /-gen_dest/) {
+	push(@f, $gen_dest_arg);
+    }
+
+    #
+    # Add a fail action macro if requested.
+    #
+
+    $flags =~ /-fail_action/ and do {
+	if (!defined $fail_type) {
+	    my($i);
+	    for ($i = 0; $i < @f_types; $i++) {
+		local($_) = $f_types[$i];
+		/[rxycians]/ and do { push(@f, "Badmatch($f[$i])"); next };
+	    }
+	} elsif ($fail_type eq 'f') {
+	    push(@f, "ClauseFail()");
+	} else {
+	    my($i);
+	    for ($i = 0; $i < @f_types; $i++) {
+		local($_) = $f_types[$i];
+		/[rxycians]/ and do { push(@f, "Badmatch($f[$i])"); next };
+	    }
+	}
+    };
+
+    #
+    # Add a size argument if requested.
+    #
+
+    $flags =~ /-size/ and do {
+	push(@f, $size);
+    };
+
+    # Generate the macro if requested.
+    my($code);
+    if (defined $macro{$name}) {
+	my($macro_code) = "$prefix$macro(" . join(', ', @f) . ");";
+	$var_decls .= "Uint tmp_packed1;"
+	    if $macro_code =~ /tmp_packed1/;
+	$var_decls .= "Uint tmp_packed2;"
+	    if $macro_code =~ /tmp_packed2/;
+	if ($flags =~ /-nonext/) {
+	    $code = "$macro_code\n";
+	} else {
+	    $code = join("\n",
+			 "{ $var_decls",
+			 "Eterm* next;",
+			 "PreFetch($size, next);",
+			 "$macro_code",
+			 "NextPF($size, next);",
+			 "}", "");
+	}
+    }
+
+    # Return the size and code for the macro (if any).
+    $size++;
+    ($size, $code, $pack_spec);
+}
+
+sub do_pack {
+    my(@args) = @_;
+    my($i);
+    my($packable_args) = 0;
+
+    #
+    # Count the number of packable arguments.  If we encounter any 's' or 'd'
+    # arguments, packing is not possible.
+    #
+    for ($i = 0; $i < @args; $i++) {
+	if ($args[$i] =~ /[xyt]/) {
+	    $packable_args++;
+	} elsif ($args[$i] =~ /[sd]/) {
+	    return ('', '', @args);
+	}
+    }
+
+    #
+    # Get out of here if too few or too many arguments.
+    #
+    return ('', '', @args) if $packable_args < 2;
+    &error("too many packable arguments") if $packable_args > 4;
+
+    my($size) = 0;
+    my($pack_prefix) = '';
+    my($down) = '';		# Pack commands (towards instruction
+				# beginning).
+    my($up) = '';		# Pack commands (storing back while
+				# moving forward).
+    my($args_per_word) = $packable_args < 4 ? $packable_args : 2;
+    my(@shift) = @{$pack_shift[$args_per_word]};
+    my(@mask) = @{$pack_mask[$args_per_word]};
+    my(@pack_instr) = @{$pack_instr[$args_per_word]};
+
+    #
+    # Now generate the packing instructions.  One complication is that
+    # the packing engine works from right-to-left, but we must generate
+    # the instructions from left-to-right because we must calculate
+    # instruction sizes from left-to-right.
+    #
+    # XXX Packing 3 't's in one word won't work.  Sorry.
+
+    my $did_some_packing = 0;	# Nothing packed yet.
+    my($ap) = 0;		# Argument number within word.
+    my($tmpnum) = 1;		# Number of temporary variable.
+    my($expr) = '';
+    for ($i = 0; $i < @args; $i++) {
+	my($reg) = $args[$i];
+	my($this_size) = $arg_size{$reg};
+	if ($reg =~ /[xyt]/) {
+	    $this_size = 0;
+	    $did_some_packing = 1;
+
+	    if ($ap == 0) {
+		$pack_prefix .= "tmp_packed$tmpnum = Arg($size);\n";
+		$up .= "p";
+		$down = "P$down";
+		$this_size = 1;
+	    }
+
+	    $down = "$pack_instr[$ap]$down";
+	    my($unpack) = &make_unpack($tmpnum, $shift[$ap], $mask[$ap]);
+	    $args[$i] = "pack:$this_size:$reg" . "b($unpack)";
+
+	    if (++$ap == $args_per_word) {
+		$ap = 0;
+		$tmpnum++;
+	    }
+	} elsif ($arg_size{$reg} && $did_some_packing) {
+	    #
+	    # This is an argument that can't be packed.  Normally, we must
+	    # save it on the pack engine's stack, unless:
+	    #
+	    # 1. The argument has zero size (e.g. r(0)).  Such arguments
+	    #    will not be loaded.  They disappear.
+	    # 2. If the argument is on the left of the first packed argument,
+	    #    the packing engine will never access it (because the engine
+	    #    operates from right-to-left).
+	    #
+
+	    $down = "g${down}";
+	    $up = "${up}p";
+	}
+	$size += $this_size;
+    }
+
+    my $pack_spec = $down . $up;
+    return ($pack_prefix, $pack_spec, @args);
+}
+
+sub make_unpack {
+    my($tmpnum, $shift, $mask) = @_;
+
+    my($e) = "tmp_packed$tmpnum";
+    $e = "($e>>$shift)" if $shift;
+    $e .= "&$mask" unless $mask eq $WHOLE_WORD;
+    $e;
+}
+
+sub quote {
+    local($_) = @_;
+    return "'$_'" if $_ eq 'try';
+    return "'$_'" if $_ eq 'catch';
+    return "'$_'" if $_ eq 'receive';
+    return "'$_'" if $_ =~ /^[A-Z]/;
+    $_;
+}
+
+#
+# Parse instruction transformations when they first appear.
+#
+sub parse_transformation {
+    local($_) = @_;
+    my($orig) = $_;
+
+    my($from, $to) = split(/\s*=>\s*/);
+    my(@op);
+
+    # The source instructions.
+
+    my(@from) = split(/\s*\|\s*/, $from);
+    foreach (@from) {
+	if (/^(\w+)\((.*?)\)/) {
+	    my($name, $arglist) = ($1, $2);
+	    $_ = (&compile_transform_function($name, split(/\s*,\s*/, $arglist)));
+	} else {
+	    (@op) = split;
+	    $_ = &compile_transform(1, @op);
+	}
+    }
+
+    #
+    # Check for a function which should be called to provide the new
+    # instructions if the left-hand side matched.  Otherwise there is
+    # an explicit list of instructions.
+    #
+
+    my @to;
+    if ($to =~ /^(\w+)\((.*?)\)/) {
+	my($name, $arglist) = ($1, $2);
+	@to = (&compile_transform_function($name, split(/\s*,\s*/, $arglist)));
+    } else {
+	@to = split(/\s*\|\s*/, $to);
+	foreach (@to) {
+	    (@op) = split;
+	    $_ = &compile_transform(0, @op);
+	}
+    }
+    push(@transformations, [$., $orig, [@from], [reverse @to]]);
+}
+
+sub compile_transform_function {
+    my($name, @args) = @_;
+
+    [".$name", 0, @args];
+}
+
+sub compile_transform {
+    my($src, $name, @ops) = @_;
+    my $arity = 0;
+    
+    foreach (@ops) {
+	my(@list) = &tr_parse_op($src, $_);
+	$arity++ unless $list[1] eq '*';
+	$_ = [ @list ];
+    }
+
+    if ($obsolete[$gen_opnum{$name,$arity}]) {
+	error("obsolete function must not be used in transformations");
+    }
+    
+    [$name,$arity,@ops];
+}
+
+sub tr_parse_op {
+    my($src, $op) = @_;
+    my($var) = '';
+    my($type) = '';
+    my($type_val) = 0;
+    my($cond) = '';
+    my($cond_val) = '';
+
+    local($_) = $op;
+
+    # Get the variable name if any.
+
+    if (/^([A-Z]\w*)(.*)/) {
+	$var = $1;
+	$_ = $2;
+	&error("garbage after variable")
+	    unless /^=(.*)/ or /^(\s*)$/;
+	$_ = $1;
+    }
+
+    # Get the type if any.
+
+    if (/^([a-z*]+)(.*)/) {
+	$type = $1;
+	$_ = $2;
+	foreach (split('', $type)) {
+	    &error("bad type in $op")
+		unless defined $type_bit{$_} or $type eq '*';
+	}
+    }
+
+    # Get an optional condition. (In source.)
+
+    if (/^==(.*)/) {
+	$cond = 'is_eq';
+	$cond_val = $1;
+	$_ = '';
+    } elsif (/^\$is_bif(.*)/) {
+	$cond = 'is_bif';
+	$cond_val = -1;
+	$_ = $1;
+    } elsif (/^\$is_not_bif(.*)/) {
+	$cond = 'is_not_bif';
+	$cond_val = -1;
+	$_ = $1;
+    } elsif (m@^\$bif:(\w+):(\w+)/(\d)(.*)@) {
+	$cond = 'is_bif';
+	if ($1 eq 'erlang') {
+	    $cond_val = "BIF_$2_$3";
+	} else {
+	    $cond_val = "BIF_$1_$2_$3";
+	}
+	$_ = $4;
+    } elsif (m@^\$func:(\w+):(\w+)/([_\d])(.*)@) {
+	my $arity = $3 eq '_' ? 1024 : $3;
+	$cond = 'is_func';
+	$cond_val = "$1:$2:$arity";
+	$_ = $4;
+    }
+
+    # Get an optional value. (In destination.)
+    if (/^=(.*)/) {
+	$type_val = $1;
+	$_ = '';
+    }
+
+    # Nothing more is allowed after the command.
+
+    &error("garbage '$_' after operand: $op")
+	unless /^\s*$/;
+
+    # Test that destination has no conditions.
+
+    unless ($src) {
+	error("condition not allowed in destination: $op")
+	    if $cond;
+	error("variable name and type cannot be combined in destination: $op")
+	    if $var && $type;
+    }
+
+    # Test that source has no values.
+    if ($src) {
+	error("value not allowed in source: $op")
+	    if $type_val;
+    }
+    ($var,$type,$type_val,$cond,$cond_val);
+}
+
+#
+# Generate code for all transformations.
+#
+
+sub tr_gen {
+    my(@g) = @_;
+
+    my($ref, $key, $instr);	# Loop variables.
+
+    foreach $ref (@g) {
+	my($line, $orig_transform, $from_ref, $to_ref) = @$ref;
+	my $so_far = tr_gen_from($line, @$from_ref);
+	tr_gen_to($line, $orig_transform, $so_far, @$to_ref);
+    }
+
+    #
+    # Print the generated transformation engine.
+    #
+    my($offset) = 0;
+    print "Uint op_transform[] = {\n";
+    foreach $key (keys %gen_transform) {
+	$gen_transform_offset{$key} = $offset;
+	foreach $instr (@{$gen_transform{$key}}) {
+	    my($size, $instr_ref, $comment) = @$instr;
+	    my($op, @args) = @$instr_ref;
+	    print "    ";
+	    if (!defined $op) {
+		$comment =~ s/\n(.)/\n    $1/g;
+		print "\n", $comment;
+	    } else {
+		$op = "TOP_$op";
+		$match_engine_ops{$op} = 1;
+		if ($comment ne '') {
+		    printf "%-24s /* %s */\n", (join(", ", ($op, @args)) . ","),
+		    $comment;
+		} else {
+		    print join(", ", ($op, @args)), ",\n";
+		}
+		$offset += $size;
+	    }
+	}
+	print "\n";
+    }
+    print "/*\n";
+    print " * Total number of words: $offset\n";
+    print " */\n";
+    print "};\n\n";
+}
+
+sub tr_gen_from {
+    my($line, @tr) = @_;
+    my(%var) = ();
+    my(%var_type);
+    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: ";
+
+    foreach $ref (@tr) {
+	my($name, $arity, @ops) = @$ref;
+	my($key) = "$name/$arity";
+	my($opnum);
+
+	#
+	# A name starting with a period is a C pred function to be called.
+	#
+
+	if ($name =~ /^\.(\w+)/) {
+	    $name = $1;
+	    my $var;
+	    my(@args);
+
+	    my $next_instr = pop(@code); # Get rid of 'next_instr'
+	    push(@fix_pred_funcs, scalar(@code));
+	    push(@code, [$name, @ops]);
+	    push(@code, $next_instr);
+	    next;
+	}
+
+	#
+	# Check that $name/$arity refers to a valid generic instruction.
+	#
+
+	&error($where, "invalid generic op $name/$arity")
+	    unless defined $gen_opnum{$name,$arity};
+	$opnum = $gen_opnum{$name,$arity};
+
+	push(@code, &make_op("$name/$arity", 'is_op', $opnum));
+	$min_window++;
+	foreach $op (@ops) {
+	    my($var, $type, $type_val, $cond, $val) = @$op;
+
+	    if ($type ne '' && $type ne '*') {
+		my($types) = '';
+		my($type_mask) = 0;
+		foreach (split('', $type)) {
+		    $types .= "$_ ";
+		    $type_mask |= $type_bit{$_};
+		}
+		push(@code, &make_op($types, 'is_type', $type_mask));
+	    }
+
+	    if ($cond eq 'is_func') {
+		my($m, $f, $a) = split(/:/, $val);
+		push(@code, &make_op('', "$cond", "am_$m",
+				     "am_$f", $a));
+	    } elsif ($cond ne '') {
+		push(@code, &make_op('', "$cond", $val));
+	    }
+
+	    if ($var ne '') {
+		if (defined $var{$var}) {
+		    push(@code, &make_op($var, 'is_same_var', $var{$var}));
+		} elsif ($type eq '*') {
+		    #
+		    # Reserve a hole for a 'rest_args' instruction.
+		    #
+		    push(@fix_rest_args, scalar(@code));
+		    push(@code, $var);
+		} else {
+		    $var_type{$var} = 'scalar';
+		    $var{$var} = $var_num;
+		    $var_num++;
+		    push(@code, &make_op($var, 'set_var', $var{$var}));
+		}
+	    }
+	    if (is_set_var_instr($code[$#code])) {
+		my $ref = pop @code;
+		my $comment = $ref->[2];
+		my $var = $ref->[1][1];
+		push(@code, make_op($comment, 'set_var_next_arg', $var));
+	    } else {
+		push(@code, &make_op('', 'next_arg'));
+	    }
+	}
+	push(@code, &make_op('', 'next_instr'));
+	pop(@code) if $code[$#code]->[1][0] eq 'next_arg';
+    }
+
+    #
+    # Insert the commit operation.
+    #
+    pop(@code);		# Get rid of 'next_instr'
+    push(@code, &make_op('', '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}");
+	    }
+	}
+	splice(@code, $index, 1, &make_op("$name()",
+					  'pred', scalar(@pred_table)));
+	push(@pred_table, [$name, @args]);
+    }
+
+    $te_max_vars = $var_num
+	if $te_max_vars < $var_num;
+    [$min_window, \%var, \%var_type, \@code];
+}
+
+sub tr_gen_to {
+    my($line, $orig_transform, $so_far, @tr) = @_;
+    my($min_window, $var_ref, $var_type_ref, $code_ref) = @$so_far;
+    my(%var) = %$var_ref;
+    my(%var_type) = %$var_type_ref;
+    my(@code) = @$code_ref;
+    my($op, $ref);		# Loop variables.
+    my($where) = "right side of transformation in line $line: ";
+
+    foreach $ref (@tr) {
+	my($name, $arity, @ops) = @$ref;
+
+	#
+	# A name starting with a period is a C function to be called.
+	#
+
+	if ($name =~ /^\.(\w+)/) {
+	    $name = $1;
+	    my $var;
+	    my(@args);
+
+	    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}");
+		}
+	    }
+	    pop(@code);	# Get rid of 'next_instr'
+	    push(@code, &make_op("$name()", 'call', scalar(@call_table)));
+	    push(@call_table, [$name, @args]);
+	    last;
+	}
+
+	#
+	# Check that $name/$arity refers to a valid generic instruction.
+	#
+
+	my($key) = "$name/$arity";
+	&error($where, "invalid generic op $name/$arity")
+	    unless defined $gen_opnum{$name,$arity};
+	my $opnum = $gen_opnum{$name,$arity};
+
+	#
+	# Create code to build the generic instruction.
+	#
+
+	push(@code, &make_op('', 'new_instr'));
+	push(@code, &make_op("$name/$arity", 'store_op', $opnum, $arity));
+	foreach $op (@ops) {
+	    my($var, $type, $type_val) = @$op;
+
+	    if ($var ne '') {
+		&error($where, "variable '$var' unbound")
+		    unless defined $var{$var};
+		push(@code, &make_op($var, 'store_var', $var{$var}));
+	    } elsif ($type ne '') {
+		push(@code, &make_op('', 'store_type', "TAG_$type"));
+		if ($type_val) {
+		    push(@code, &make_op('', 'store_val', $type_val));
+		}
+	    }
+	    push(@code, &make_op('', 'next_arg'));
+	}
+	pop(@code) if $code[$#code]->[1][0] eq 'next_arg';
+    }
+
+    push(@code, &make_op('', 'end'));
+
+    #
+    # Chain together all codes segments having the same first operation.
+    #
+    my($first_ref) = shift(@code);
+    my($size, $first, $key) = @$first_ref;
+    my($dummy, $op, $arity) = @$first;
+    my($comment) = "\n/*\n * Line $line:\n *   $orig_transform\n */\n\n";
+    $min_window{$key} = $min_window
+	if $min_window{$key} > $min_window;
+
+    pop(@{$gen_transform{$key}})
+	if defined @{$gen_transform{$key}}; # Fail
+    my(@prefix) = (&make_op($comment), &make_op('', 'try_me_else', &tr_code_len(@code)));
+    unshift(@code, @prefix);
+    push(@{$gen_transform{$key}}, @code, &make_op('', 'fail'));
+}
+
+sub tr_code_len {
+    my($sum) = 0;
+    my($ref);
+
+    foreach $ref (@_) {
+	$sum += $$ref[0];
+    }
+    $sum;
+}
+
+sub make_op {
+    my($comment, @op) = @_;
+    [scalar(@op), [@op], $comment];
+}
+
+sub is_set_var_instr {
+    my($ref) = @_;
+    return 0 unless ref($ref) eq 'ARRAY';
+    $ref->[1][0] eq 'set_var';
+}
+
+sub tr_gen_call {
+    my(@call_table) = @_;
+    my($i);
+
+    print "\n";
+    for ($i = 0; $i < @call_table; $i++) {
+	my $ref = $call_table[$i];
+	my($name, @args) = @$ref;
+	print "case $i: RVAL = $name(", join(', ', 'st', @args), "); break;\n";
+    }
+    print "\n";
+}
diff --git a/erts/emulator/utils/beam_strip b/erts/emulator/utils/beam_strip
new file mode 100755
index 0000000000..1ce0fea180
--- /dev/null
+++ b/erts/emulator/utils/beam_strip
@@ -0,0 +1,89 @@
+#!/usr/bin/env perl
+#
+# %CopyrightBegin%
+# 
+# Copyright Ericsson AB 2001-2009. All Rights Reserved.
+# 
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+# 
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+# 
+# %CopyrightEnd%
+#
+use strict;
+
+for (@ARGV) {
+    open(IN, "<$_") or do {warn "skipping $_:$!\n"; next};
+    my $data;
+    sysread(IN, $data, 10000000);
+    close IN;
+    my $new_file = eval {slim_beam($data)};
+    open(OUT, ">$_") or die "Failed to write $_:$!\n";
+    print OUT $new_file;
+    close OUT;
+}
+
+# Bug in 5.6.0: The following doesn't work.
+#local $/;
+#while (<>) {
+#    my $new_file = eval {slim_beam($_)};
+#    if ($@) {
+#	...
+#    } else {
+#	...
+#    }
+#}
+
+sub slim_beam {
+    my($beam) = @_;
+    my $size_left = length($beam);
+    my @chunk;
+
+    die "can't read Beam files for OTP R4 or earlier (sorry)"
+	if $beam =~ /^\x7fBEAM!/;
+
+    #
+    # Read and verify the head of the IFF file.
+    #
+    
+    my ($id, $size, $beam_id) = unpack("a4Na4", $beam);
+    die "not a BEAM file: no IFF 'FOR1' chunk"
+	unless $id eq 'FOR1';
+    $size_left -= 8;
+    die "form size $size greater than size ", $size_left, " of module"
+	if $size > $size_left;
+    $size_left -= 4;
+    die "not a BEAM file: IFF form type is not 'BEAM'"
+	unless $beam_id eq 'BEAM';
+
+    #
+    # Read all IFF chunks.
+    #
+
+    $beam = substr($beam, 12, $size_left);
+    while ($size_left > 0) {
+	($id, $size) = unpack("a4N", $beam);
+	$size_left -= 8;
+	die "chunk size $size greater than size ", $size_left, " of module"
+	    if $size > $size_left;
+	$size = 4*int(($size+3)/4);
+	my $chunk = substr($beam, 0, $size+8);
+	$beam = substr($beam, 8+$size);
+	$size_left = length($beam);
+	push(@chunk, $chunk)
+	    unless $id eq 'LocT' || $id eq 'CInf';
+    }
+
+    #
+    # Create new Beam file.
+    #
+    my $new_file = join('', @chunk);
+    "FOR1" . pack("N", length($new_file)+4) . "BEAM" . $new_file;
+}
diff --git a/erts/emulator/utils/make_alloc_types b/erts/emulator/utils/make_alloc_types
new file mode 100755
index 0000000000..53051b7692
--- /dev/null
+++ b/erts/emulator/utils/make_alloc_types
@@ -0,0 +1,672 @@
+#!/usr/bin/env perl
+# -*- cperl -*-
+
+# %CopyrightBegin%
+# 
+# Copyright Ericsson AB 2003-2009. All Rights Reserved.
+# 
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+# 
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+# 
+# %CopyrightEnd%
+
+use strict;
+# use warnings;
+
+use File::Basename;
+
+#
+# Description:
+#   Generates a header file containing defines for memory allocation types
+#   from type declarations in a config file.
+#
+# Usage:
+#    make_alloc_types -src <config-file> -dst <c-header-file>
+#
+# Options:
+#    -src <config-file>
+#    -dst <c-header-file>
+#    [<enabled-boolean-variable> ...]
+#
+# Author: Rickard Green
+#
+
+my $myname = basename($0);
+my $src;
+my $dst;
+my %bool_vars;
+
+while (@ARGV && $ARGV[0]) {
+  my $opt = shift;
+  if ($opt eq '-src') {
+    $src = shift;
+    $src or die "$myname: Missing source file\n";
+  } elsif ($opt eq '-dst') {
+    $dst = shift;
+    $dst or die "$myname: Missing destination file\n";
+  } else {
+    $bool_vars{$opt} = 'true';
+  }
+}
+
+$src or usage("Missing source file");
+$dst or usage("Missing destination file");
+
+open(SRC, "<$src") or die "$myname: Failed to open $src in read mode\n";
+
+my $line;
+my $line_no = 0;
+my $decl;
+
+my %a_tab;
+my %c_tab;
+my %t_tab;
+my %d_tab;
+my @a_order;
+my @c_order;
+my @t_order;
+
+my @cond_stack;
+
+#############################################################################
+# Parse source file
+#############################################################################
+
+while ($line = <SRC>) {
+  $line_no = $line_no + 1;
+  $line = preprocess_line($line);
+
+  if ($line =~ /^(\S+)\s*(.*)/) {
+    $decl = $1;
+    $line = $2;
+
+    if ($decl eq 'type') {
+      if ($line =~ /^(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s*$/) {
+	my $t = $1;
+	my $a = $2;
+	my $c = $3;
+	my $d = $4;
+
+	check_reserved_words('type', $t, $d);
+
+	my $a_entry = $a_tab{$a};
+	$a_entry or src_error("No allocator '$a' declared");
+	my $c_entry = $c_tab{$c};
+	$c_entry or src_error("No class '$c' declared");
+
+	!$t_tab{$t} or src_error("Type '$t' already declared");
+	my $d_user = $d_tab{$d};
+	!$d_user or duplicate_descr($d, $d_user);
+
+	$t_tab{$t} = mk_entry($d, $a, $c);
+	add_type($a_entry, $t);
+
+	$d_tab{$d} = "type '$t'";
+
+      } else {
+	invalid_decl($decl);
+      }
+    } elsif ($decl eq 'allocator') {
+      if ($line =~ /^(\w+)\s+(\w+)\s+(\w+)\s*$/) {
+	my $a = $1;
+	my $mt = $2;
+	my $d = $3;
+
+	check_reserved_words('allocator', $a, $d);
+
+	!$a_tab{$a} or src_error("Allocator '$a' already declared");
+	my $d_user = $d_tab{$d};
+	!$d_user or duplicate_descr($d, $d_user);
+
+	my $e = mk_entry($d);
+	$a_tab{$a} = $e;
+
+	if ($mt =~ /^true$/) {
+	  set_multi_thread($e);
+	}
+	else {
+	  $mt =~ /^false$/ or src_error("Multi-thread option not a boolean");
+	}
+
+	$d_tab{$d} = "allocator '$a'";
+
+	push(@a_order, $a);
+
+      } else {
+	invalid_decl($decl);
+      }
+    } elsif ($decl eq 'class') {
+      if ($line =~ /^(\w+)\s+(\w+)\s*$/) {
+	my $c = $1;
+	my $d = $2;
+
+	check_reserved_words('class', $c, $d);
+
+	!$c_tab{$c} or src_error("Class '$c' already declared");
+	my $d_user = $d_tab{$d};
+	!$d_user or duplicate_descr($d, $d_user);
+
+	$c_tab{$c} = mk_entry($d);
+
+	$d_tab{$d} = "class '$c'";
+
+      } else {
+	invalid_decl($decl);
+      }
+    } else {
+      src_error("Unknown '$decl' declaration found");
+    }
+  }
+}
+
+close(SRC) or warn "$myname: Error closing $src";
+
+check_cond_stack();
+
+#############################################################################
+# Create destination file
+#############################################################################
+
+mkdir(dirname($dst), 0777);
+open(DST, ">$dst") or die "$myname: Failed to open $dst in write mode\n";
+
+print DST "/*
+ * -----------------------------------------------------------------------
+ *
+ * NOTE: Do *not* edit this file; instead, edit '", basename($src),"' and
+ *       build again! This file was automatically generated by
+ *       '$myname' on ", (scalar localtime), ".
+ *
+ * -----------------------------------------------------------------------
+ *
+ * 
+ * Copyright Ericsson AB ", (1900 + (localtime)[5]), ". All Rights Reserved.
+ * 
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the \"License\"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ * 
+ * Software distributed under the License is distributed on an \"AS IS\"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ * 
+ */
+
+#ifndef ERL_ALLOC_TYPES_H__
+#define ERL_ALLOC_TYPES_H__
+
+";
+
+my $a_no = 1;
+my $c_no = 1;
+my $t_no = 1;
+
+# Print allocator numbers -------------------------------------------------
+
+print DST "
+/* --- Allocator numbers -------------------------------------------------- */
+
+#define ERTS_ALC_A_INVALID (0)
+
+";
+
+print DST "#define ERTS_ALC_A_MIN ($a_no)\n\n";
+
+foreach my $a (@a_order) {
+  set_number($a_tab{$a}, $a_no);
+  print DST "#define ERTS_ALC_A_$a ($a_no)\n";
+  $a_no++;
+}
+$a_no--;
+
+print DST "\n#define ERTS_ALC_A_MAX ($a_no)\n";
+
+# Print class numbers -----------------------------------------------------
+
+print DST "
+
+/* --- Class numbers ------------------------------------------------------ */
+
+#define ERTS_ALC_C_INVALID (0)
+
+";
+
+print DST "#define ERTS_ALC_C_MIN ($c_no)\n\n";
+
+foreach my $c (keys(%c_tab)) {
+  push(@c_order, $c);
+  set_number($c_tab{$c}, $c_no);
+  print DST "#define ERTS_ALC_C_$c  ($c_no)\n";
+  $c_no++;
+}
+$c_no--;
+print DST "\n#define ERTS_ALC_C_MAX ($c_no)\n";
+
+# Print type number intervals ---------------------------------------------
+
+print DST "
+
+/* --- Type number intervals ---------------------------------------------- */
+
+#define ERTS_ALC_N_INVALID (0)
+
+";
+
+print DST "#define ERTS_ALC_N_MIN ($t_no)\n\n";
+
+foreach my $a (@a_order) {
+  my $a_entry = $a_tab{$a};
+  my $ts = get_types($a_entry);
+  my $n_ts = @{$ts};
+  if ($n_ts > 0) {
+
+    print DST "/* Type numbers used for ", get_description($a_entry), " */\n";
+    print DST "#define ERTS_ALC_N_MIN_A_$a ($t_no)\n";
+
+    foreach my $t (@{$ts}) {
+      push(@t_order, $t);
+      set_number($t_tab{$t}, $t_no);
+#      print DST "#define ERTS_ALC_N_$t ($t_no)\n";
+      $t_no++;
+    }
+
+    print DST "#define ERTS_ALC_N_MAX_A_$a (", $t_no - 1, ")\n\n";
+  }
+  else {
+    print DST "/* No types use ", get_description($a_entry), " */\n\n";
+  }
+}
+$t_no--;
+print DST "#define ERTS_ALC_N_MAX ($t_no)\n";
+
+# Print multi thread use of allocators -------------------------------------
+
+print DST "
+
+/* --- Multi thread use of allocators -------------------------------------- */
+
+";
+
+foreach my $a (@a_order) {
+  my $mt = get_multi_thread($a_tab{$a});
+  print DST "#define ERTS_ALC_MTA_$a (", $mt ? "1" : "0" ,")\n";
+}
+
+
+# Calculate field sizes, masks, and shifts needed --------------------------
+
+my $a_bits = fits_in_bits($a_no);
+my $c_bits = fits_in_bits($c_no);
+my $n_bits = fits_in_bits($t_no);
+my $t_bits = $a_bits + $n_bits + $c_bits;
+
+$n_bits <= 16
+  # Memory trace format expects type numbers to fit into an Uint16
+  or die("$myname: ", $t_no + 1, " types declared;",
+	 " maximum number of types allowed are ", (1 << 16),"\n");
+
+$t_bits <= 24
+  # We want 8 bits for flags (we actually only use 1 bit for flags
+  # at the time of writing)...
+  or die("$myname: More allocators, classes, and types declared than ",
+	 "allowed\n");
+
+my $a_mask = (1 << $a_bits) - 1;
+my $c_mask = (1 << $c_bits) - 1;
+my $n_mask = (1 << $n_bits) - 1;
+my $t_mask = (1 << $t_bits) - 1;
+
+my $a_shift = 0;
+my $c_shift = $a_bits + $a_shift;
+my $n_shift = $c_bits + $c_shift;
+
+
+# Print the types ----------------------------------------------------------
+
+print DST "
+
+/* --- Types --------------------------------------------------------------- */
+
+typedef Uint32 ErtsAlcType_t; /* The type used for memory types */
+
+#define ERTS_ALC_T_INVALID (0)
+
+";
+
+foreach my $t (@t_order) {
+  print DST
+    "#define ERTS_ALC_T_$t (",
+      ((get_number($a_tab{get_allocator($t_tab{$t})}) << $a_shift)
+       | (get_number($c_tab{get_class($t_tab{$t})}) << $c_shift)
+       | (get_number($t_tab{$t}) << $n_shift)),
+	 ")\n";
+}
+
+
+
+# Print field sizes, masks, and shifts needed ------------------------------
+
+print DST "
+
+/* --- Field sizes, masks, and shifts -------------------------------------- */
+
+#define ERTS_ALC_A_BITS ($a_bits)
+#define ERTS_ALC_C_BITS ($c_bits)
+#define ERTS_ALC_N_BITS ($n_bits)
+#define ERTS_ALC_T_BITS ($t_bits)
+
+#define ERTS_ALC_A_MASK ($a_mask)
+#define ERTS_ALC_C_MASK ($c_mask)
+#define ERTS_ALC_N_MASK ($n_mask)
+#define ERTS_ALC_T_MASK ($t_mask)
+
+#define ERTS_ALC_A_SHIFT ($a_shift)
+#define ERTS_ALC_C_SHIFT ($c_shift)
+#define ERTS_ALC_N_SHIFT ($n_shift)
+";
+
+# Print mappings needed ----------------------------------------------------
+
+print DST "
+
+/* --- Mappings ------------------------------------------------------------ */
+
+/* type -> type number */
+#define ERTS_ALC_T2N(T) (((T) >> ERTS_ALC_N_SHIFT) & ERTS_ALC_N_MASK)
+
+/* type -> allocator number */
+#define ERTS_ALC_T2A(T) (((T) >> ERTS_ALC_A_SHIFT) & ERTS_ALC_A_MASK)
+
+/* type -> class number */
+#define ERTS_ALC_T2C(T) (((T) >> ERTS_ALC_C_SHIFT) & ERTS_ALC_C_MASK)
+
+/* type number -> type */
+#define ERTS_ALC_N2T(N) (erts_alc_n2t[(N)])
+
+/* type number -> type description */
+#define ERTS_ALC_N2TD(N) (erts_alc_n2td[(N)])
+
+/* type -> type description */
+#define ERTS_ALC_T2TD(T) (ERTS_ALC_N2TD(ERTS_ALC_T2N((T))))
+
+/* class number -> class description */
+#define ERTS_ALC_C2CD(C) (erts_alc_c2cd[(C)])
+
+/* allocator number -> allocator description */
+#define ERTS_ALC_A2AD(A) (erts_alc_a2ad[(A)])
+
+extern const ErtsAlcType_t erts_alc_n2t[];
+extern const char *erts_alc_n2td[];
+extern const char *erts_alc_c2cd[];
+extern const char *erts_alc_a2ad[];
+
+#ifdef ERTS_ALC_INTERNAL__
+
+const ErtsAlcType_t erts_alc_n2t[] = {
+  ERTS_ALC_T_INVALID,
+";
+
+foreach my $t (@t_order) {
+  print DST "  ERTS_ALC_T_$t,\n";
+}
+
+print DST "  ERTS_ALC_T_INVALID
+};
+
+const char *erts_alc_n2td[] = {
+  \"invalid_type\",
+";
+
+foreach my $t (@t_order) {
+  print DST "  \"", get_description($t_tab{$t}), "\",\n";
+}
+
+print DST "  NULL
+};
+
+const char *erts_alc_c2cd[] = {
+  \"invalid_class\",
+";
+
+foreach my $c (@c_order) {
+  print DST "  \"", get_description($c_tab{$c}), "\",\n";
+}
+
+print DST "  NULL
+};
+
+const char *erts_alc_a2ad[] = {
+  \"invalid_allocator\",
+";
+
+foreach my $a (@a_order) {
+  print DST "  \"", get_description($a_tab{$a}), "\",\n";
+}
+
+print DST "  NULL
+};
+";
+
+print DST "
+#endif /* #ifdef ERTS_ALC_INTERNAL__ */
+";
+
+# End of DST
+print DST "
+
+/* ------------------------------------------------------------------------- */
+#endif /* #ifndef ERL_ALLOC_TYPES_H__ */
+";
+
+
+close(DST) or warn "$myname: Error closing $dst";
+
+exit;
+
+#############################################################################
+# Help routines
+#############################################################################
+
+sub fits_in_bits {
+  my $val = shift;
+  my $bits;
+
+  $val >= 0 or die "Expected value >= 0; got $val";
+
+  $bits = 0;
+
+  while ($val != 0) {
+    $val >>= 1;
+    $bits++;
+  }
+
+  return $bits;
+}
+
+#############################################################################
+# Table entries
+#
+
+sub mk_entry {
+  my $d = shift;
+  my $a = shift;
+  my $c = shift;
+  return [$d, undef, [], $a, $c, undef];
+}
+
+sub get_description {
+  my $entry = shift;
+  return $entry->[0];
+}
+
+sub get_number {
+  my $entry = shift;
+  return $entry->[1];
+}
+
+sub get_types {
+  my $entry = shift;
+  return $entry->[2];
+}
+
+sub get_allocator {
+  my $entry = shift;
+  return $entry->[3];
+}
+
+sub get_class {
+  my $entry = shift;
+  return $entry->[4];
+}
+
+sub set_number {
+  my $entry = shift;
+  my $number = shift;
+  $entry->[1] = $number;
+}
+
+sub add_type {
+  my $entry = shift;
+  my $t = shift;
+  push(@{$entry->[2]}, $t);
+}
+
+sub set_multi_thread {
+  my $entry = shift;
+  $entry->[5] ='true';
+}
+
+sub get_multi_thread {
+  my $entry = shift;
+  return $entry->[5];
+}
+
+#############################################################################
+# Preprocessing of a line
+
+sub preprocess_line {
+  my $line = shift;
+  $line =~ s/#.*$//;
+  $line =~ /^\s*(.*)$/;
+  $line = $1;
+
+  if (!@cond_stack) {
+    push(@cond_stack, [undef, undef, undef, 'true', undef]);
+  }
+
+  my $see_line = $cond_stack[@cond_stack - 1]->[3];
+
+  if ($line =~ /^(\S+)(.*)$/) {
+    my $ifdefop = $1;
+    my $ifdefarg = $2;
+
+    if ($ifdefop eq '+if') {
+      $ifdefarg =~ /^\s*(\w+)\s*$/ or src_error("Bad '+if'");
+      my $var = $1;
+      if ($see_line) {
+	$see_line = $bool_vars{$var};
+      }
+      push(@cond_stack, ['+if', $var, undef, $see_line, $line_no]);
+      $see_line = undef;
+    }
+    elsif ($ifdefop eq '+ifnot') {
+      $ifdefarg =~ /^\s*(\w+)\s*$/ or src_error("Bad '+ifnot'");
+      my $var = $1;
+      if ($see_line) {
+	$see_line = !$bool_vars{$var};
+      }
+      push(@cond_stack, ['+ifnot', $var, undef, $see_line, $line_no]);
+      $see_line = undef;
+    }
+    elsif ($ifdefop eq '+else') {
+      $ifdefarg =~ /^\s*$/ or src_error("Garbage after '+else'");
+      my $val = $cond_stack[@cond_stack - 1];
+      $val->[0] or src_error("'+else' not matching anything");
+      !$val->[2] or src_error("duplicate '+else'");
+      $val->[2] = 'else';
+      if ($see_line || $cond_stack[@cond_stack - 2]->[3]) {
+	$val->[3] = !$val->[3];
+      }
+      $see_line = undef;
+    }
+    elsif ($ifdefop eq '+endif') {
+      $ifdefarg =~ /^\s*$/ or src_error("Garbage after '+endif'");
+      my $val = pop(@cond_stack);
+      $val->[0] or src_error("'+endif' not matching anything");
+      $see_line = undef;
+    }
+    elsif ($see_line) {
+      if ($ifdefop eq '+enable') {
+	$ifdefarg =~ /^\s*(\w+)\s*$/ or src_error("Bad '+enable'");
+	$bool_vars{$1} = 'true';
+	$see_line = undef;
+      }
+      elsif ($ifdefop eq '+disable') {
+	$ifdefarg =~ /^\s*(\w+)\s*$/ or src_error("Bad '+disable'");
+	$bool_vars{$1} = undef;
+	$see_line = undef;
+      }
+    }
+  }
+
+  return $see_line ? $line : "";
+}
+
+sub check_cond_stack {
+  my $val = $cond_stack[@cond_stack - 1];
+  if ($val->[0]) {
+    $line_no = $val->[4];
+    src_error("'", $val->[0], " ", $val->[1], "' not terminated\n");
+  }
+}
+
+sub check_reserved_words {
+  my $sort = shift;
+  my $name = shift;
+  my $descr = shift;
+
+  !($name eq 'INVALID')
+    or src_error("Reserved $sort 'INVALID' declared");
+  !($descr eq 'invalid_allocator')
+    or src_error("Reserved description 'invalid_allocator' used");
+  !($descr eq 'invalid_class')
+    or src_error("Reserved description 'invalid_class' used");
+  !($descr eq 'invalid_type')
+    or src_error("Reserved description 'invalid_type' used");
+}
+
+#############################################################################
+# Error cases
+
+sub usage {
+  warn "$myname: ", @_, "\n";
+  die "Usage: $myname -src <source> -dst <destination> [<var> ...]\n";
+}
+
+sub src_error {
+  die "$src:$line_no: ", @_, "\n";
+}
+
+sub duplicate_descr {
+  my $d = shift;
+  my $u = shift;
+  src_error("Description '$d' already used for '$u'");
+}
+
+sub invalid_decl {
+  my $decl = shift;
+  src_error("Invalid '$decl' declaration");
+}
+
+#############################################################################
diff --git a/erts/emulator/utils/make_driver_tab b/erts/emulator/utils/make_driver_tab
new file mode 100755
index 0000000000..fbbfa3e49e
--- /dev/null
+++ b/erts/emulator/utils/make_driver_tab
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl 
+#
+# %CopyrightBegin%
+# 
+# Copyright Ericsson AB 1999-2009. All Rights Reserved.
+# 
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+# 
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+# 
+# %CopyrightEnd%
+#
+use strict;
+use File::Basename;
+
+# This program generates driver_tab.c which holds the driver_tab
+# array.  Since the contents of driver_tab will depend on which
+# drivers we wish to include it has to be generated.
+
+# usage: make_driver_tab [-o filename] drivers...
+
+my $file = "";
+my @drivers = ();
+
+while (@ARGV) {
+    my $d = shift;
+    if ( $d =~ /^-o$/ ) {
+	$file = shift or die("-o requires argument");
+	next;
+    }
+    $d = basename $d;
+    $d =~ s/drv(\..*|)$//;	# strip drv.* or just drv
+    push(@drivers, $d);
+}
+
+# Did we want output to a file?
+if ( $file ) {
+    open(STDOUT, ">$file") or die("can't open $file for writing");
+}
+
+print <<EOF;
+#ifdef HAVE_CONFIG_H
+#  include "config.h"
+#endif /* HAVE_CONFIG_H */
+#include <stdio.h>
+#include "global.h"
+
+EOF
+
+# "extern" declarations
+foreach (@drivers) {
+    print "extern ErlDrvEntry ${_}driver_entry;\n";
+}
+
+# The array itself
+print "\nErlDrvEntry *driver_tab[DRIVER_TAB_SIZE] =\n{\n";
+
+foreach (@drivers) {
+    print "    &${_}driver_entry,\n";
+}
+
+print "    NULL\n};\n";
+
+# That's it
diff --git a/erts/emulator/utils/make_preload b/erts/emulator/utils/make_preload
new file mode 100755
index 0000000000..d0671e998d
--- /dev/null
+++ b/erts/emulator/utils/make_preload
@@ -0,0 +1,209 @@
+#!/usr/bin/env perl 
+#
+# %CopyrightBegin%
+# 
+# Copyright Ericsson AB 1999-2009. All Rights Reserved.
+# 
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+# 
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+# 
+# %CopyrightEnd%
+#
+use strict;
+use File::Basename;
+
+#
+# Description:
+#   Packages one erlang module in a form that can be preloaded (C source
+#   for Unix or resource script for Windows).  The output is written to
+#   standard output.
+#
+# Usage:
+#	make_preload [ Options ] file.{jam,beam}
+#
+# Options:
+#	-rc		Produce a resource script rather than C source.
+#
+# Author:
+#    Bjorn Gustavsson
+#
+
+my $gen_rc = 0;
+my $gen_old = 0;
+my $windres = 0;
+my $file;
+
+my $progname = basename($0);
+
+while (@ARGV && $ARGV[0] =~ /^-(\w+)/) {
+    my $opt = shift;
+    if ($opt eq '-rc') {
+	$gen_rc = 1;
+    } elsif ($opt eq '-windres') {
+	$windres = 1;
+    } elsif ($opt eq '-old') {
+	$gen_old = 1;
+    } else {
+	usage("bad option: $opt");
+    }
+}
+
+print header();
+
+my @modules;
+my $num = 1;
+
+foreach $file (@ARGV) {
+    local($/);
+
+    usage("not a beam file")
+	unless $file =~ /\.beam$/;
+    my $module = basename($file, ".beam");
+    if ($gen_rc) {
+	my ($win_file) = split("\n", `(cygpath -d $file 2>/dev/null || cygpath -w $file)`);
+	$win_file =~ s&\\&\\\\&g;
+	print "$num ERLANG_CODE \"$win_file\"\n";
+	push(@modules, "   ", -s $file, "L, $num, ",
+	     length($module), ",\"$module\",\n");
+	$num++;
+    } else {
+	my $i;
+	my $comment = '';
+
+	open(FILE, $file) or error("failed to read $file: $!");
+	$_ = <FILE>;
+	$_ = beam_strip($_);
+	close(FILE);
+	
+	push(@modules, "  {\"$module\", " . length($_) . ", preloaded_$module},\n");
+	print "unsigned preloaded_size_$module = ", length($_), ";\n";
+	print "unsigned char preloaded_$module", "[] = {\n";
+	for ($i = 0; $i < length($_); $i++) {
+	    if ($i % 8 == 0 && $comment ne '') {
+		$comment =~ s@\*/@..@g; # Comment terminator.
+		print " /* $comment */\n  ";
+		$comment = '';
+	    }
+	    my $c = ord(substr($_, $i, 1));
+	    printf("0x%02x,", $c);
+	    $comment .= (32 <= $c && $c < 127) ? chr($c) : '.';
+	}
+	$comment =~ s@\*/@..@g; # Comment terminator.
+	print "     " x (8-($i % 8)), " /* $comment */\n};\n";
+    }
+}
+
+if ($windres) {
+    $modules[$#modules] =~ s/,$//;
+}
+
+if ($gen_rc) {
+    print "#include <beam.rc>\n";
+    $num--;
+    print "\n0 ERLANG_DICT\n";
+    print "BEGIN\n";
+    print "    $num,\n";
+    print @modules;
+    print "END\n";
+} elsif ($gen_old) {
+    print "struct {\n";
+    print "   char* name;\n";
+    print "   int size;\n";
+    print "   unsigned char* code;\n";
+    print "} pre_loaded[] = {\n";
+    foreach (@modules) {
+	print;
+    }
+    print "  {0, 0, 0}\n";
+    print "};\n";
+}
+
+sub usage {
+    warn "$progname: ", @_, "\n";
+    die "usage: $progname -o output-directory file.{jam,beam}\n";
+}
+
+sub error {
+    die "$progname: ", @_, "\n";
+}
+
+sub beam_strip {
+    my($beam) = @_;
+
+
+    my $size_left = length($beam);
+    my %chunk;
+    my %needed_chunk = ('Code' => 1,
+			'Atom' => 1,
+			'ImpT' => 1,
+			'ExpT' => 1,
+			'StrT' => 1,
+			'FunT' => 1,
+			'LitT' => 1);
+
+    die "can't read Beam files for OTP R4 or earlier (sorry)"
+	if $beam =~ /^\x7fBEAM!/;
+
+    #
+    # Read and verify the head of the IFF file.
+    #
+    
+    my ($id, $size, $beam_id) = unpack("a4Na4", $beam);
+
+    return $beam		# It might be compressed.
+	unless $id eq 'FOR1';
+#    die "not a BEAM file: no IFF 'FOR1' chunk"
+#	unless $id eq 'FOR1';
+    $size_left -= 8;
+    die "form size $size greater than size ", $size_left, " of module"
+	if $size > $size_left;
+    $size_left -= 4;
+    die "not a BEAM file: IFF form type is not 'BEAM'"
+	unless $beam_id eq 'BEAM';
+
+    #
+    # Read all IFF chunks.
+    #
+
+    $beam = substr($beam, 12, $size_left);
+    while ($size_left > 0) {
+	($id, $size) = unpack("a4N", $beam);
+	$size_left -= 8;
+	die "chunk size $size greater than size ", $size_left, " of module"
+	    if $size > $size_left;
+	$size = 4*int(($size+3)/4);
+	$chunk{$id} = substr($beam, 0, 8+$size);
+	$beam = substr($beam, 8+$size);
+	$size_left = length($beam);
+    }
+
+    #
+    # Create a new beam file with only the useful chunk types.
+    #
+
+    my @chunks;
+    foreach (sort keys %chunk) {
+	push(@chunks, $chunk{$_})
+	    if $needed_chunk{$_};
+    }
+    $beam = join('', @chunks);
+    join('', "FOR1", pack("N", length($beam)+4), "BEAM", $beam);
+}
+
+sub header {
+    my $time = localtime;
+    <<END;
+/*
+ * DO NOT EDIT THIS FILE.  It was automatically generated
+ * by the `$progname' program on $time.
+ */
+END
+}
diff --git a/erts/emulator/utils/make_tables b/erts/emulator/utils/make_tables
new file mode 100755
index 0000000000..b5391234cf
--- /dev/null
+++ b/erts/emulator/utils/make_tables
@@ -0,0 +1,368 @@
+#!/usr/bin/env perl 
+#
+# %CopyrightBegin%
+# 
+# Copyright Ericsson AB 1999-2009. All Rights Reserved.
+# 
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+# 
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+# 
+# %CopyrightEnd%
+#
+use strict;
+use File::Basename;
+
+#
+# Description:
+#   Creates tables for BIFs and atoms.
+#
+# Usage:
+#    make_tables [ Options ] file...
+#
+# Options:
+#    -src directory	Where to write generated C source files (default ".").
+#    -include directory Where to generate generated C header files (default ".").
+#
+# Output:
+#    <-src>/erl_am.c
+#    <-src>/erl_bif_table.c
+#    <-src>/erl_bif_wrap.c
+#    <-src>/erl_pbifs.c
+#    <-include>/erl_atom_table.h
+#    <-include>/erl_bif_table.h
+#
+# Author: Bjorn Gustavsson
+#
+
+my $progname = basename($0);
+my $src = '.';
+my $include = '.';
+
+my @atom;
+my %atom;
+my %atom_alias;
+my %aliases;
+my $auto_alias_num = 0;
+
+my @bif;
+my @implementation;
+my @pbif;
+
+while (@ARGV && $ARGV[0] =~ /^-(\w+)/) {
+    my $opt = shift;
+    if ($opt eq '-src') {
+	$src = shift;
+	die "No directory for -src argument specified"
+	    unless defined $src;
+    } elsif($opt eq '-include') {
+	$include = shift;
+	die "No directory for -include argument specified"
+	    unless defined $include;
+    } else {
+	usage("bad option: $opt");
+    }
+}
+
+
+while (<>) {
+    next if /^#/;
+    next if /^\s*$/;
+    my($type, @args) = split;
+    if ($type eq 'atom') {
+	save_atoms(@args);
+    } elsif ($type eq 'bif' or $type eq 'ubif') {
+	my($bif,$alias,$alias2) = (@args);
+	$bif =~ m@^([a-z_.'0-9]+):(.*)/(\d)$@ or error("invalid BIF");
+	my($mod,$name,$arity) = ($1,$2,$3);
+	save_atoms($mod, $name);
+	unless (defined $alias) {
+	    $alias = "";
+	    $alias = "${mod}_" unless $mod eq 'erlang';
+	    $alias .= "${name}_$arity";
+	}
+	my $wrapper;
+	$wrapper = "wrap_$alias" if $type eq 'bif';
+	$wrapper = $alias if $type eq 'ubif';
+	push(@bif, ["am_$atom_alias{$mod}","am_$atom_alias{$name}",$arity,
+		    $alias,$wrapper]);
+        push(@pbif, $bif =~ m/^'/ && $alias =~ m/^ebif_/);
+        push(@implementation, $alias2);
+    } else {
+	error("invalid line");
+    }
+} continue {
+    close ARGV if eof;
+}
+
+#
+# Generate the atom header file.
+#
+
+open_file("$include/erl_atom_table.h");
+print <<EOF;
+#ifndef __ERL_ATOM_TABLE_H__
+#define __ERL_ATOM_TABLE_H__
+extern char* erl_atom_names[];
+
+EOF
+my $i;
+for ($i = 0; $i < @atom; $i++) {
+    my $alias = $atom_alias{$atom[$i]};
+    print "#define am_$alias make_atom($i)\n"
+	if defined $alias;
+}
+print "#endif\n";
+
+#
+# Generate the atom table file.
+#
+
+open_file("$src/erl_atom_table.c");
+my $i;
+print "char* erl_atom_names[] = {\n";
+
+for ($i = 0; $i < @atom; $i++) {
+    print '  "', $atom[$i], '",', "\n";
+}
+print "  0\n";
+print "};\n";
+
+#
+# Generate the generic bif list file.
+#
+
+open_file("$include/erl_bif_list.h");
+my $i;
+for ($i = 0; $i < @bif; $i++) {
+    # module atom, function atom, arity, C function, table index
+    print "BIF_LIST($bif[$i]->[0],$bif[$i]->[1],$bif[$i]->[2],$bif[$i]->[3],$i)\n";
+}
+
+#
+# Generate the bif header file.
+#
+
+open_file("$include/erl_bif_table.h");
+my $bif_size = @bif;
+print <<EOF;
+#ifndef __ERL_BIF_TABLE_H__
+#define __ERL_BIF_TABLE_H__
+typedef void *BifFunction;
+
+typedef struct bif_entry {
+    Eterm module;
+    Eterm name;
+    int arity;
+    BifFunction f;
+    BifFunction traced;
+} BifEntry;
+
+extern BifEntry bif_table[];
+extern Export* bif_export[];
+extern unsigned char erts_bif_trace_flags[];
+
+#define BIF_SIZE $bif_size
+
+EOF
+
+my $i;
+for ($i = 0; $i < @bif; $i++) {
+    print "#define BIF_$bif[$i]->[3] $i\n";
+}
+
+print "\n";
+
+for ($i = 0; $i < @bif; $i++) {
+    my $arity = $bif[$i]->[2];
+    my $args = join(', ', 'Process*', ('Eterm') x $arity);
+    print "Eterm $bif[$i]->[3]($args);\n";
+    print "Eterm wrap_$bif[$i]->[3]($args, Uint *I);\n";
+}
+print "#endif\n";
+
+#
+# Generate the bif table file.
+#
+
+open_file("$src/erl_bif_table.c");
+my $i;
+includes("export.h", "sys.h", "erl_vm.h", "erl_process.h", "bif.h",
+	 "erl_bif_table.h", "erl_atom_table.h");
+
+print "\nExport* bif_export[BIF_SIZE];\n";
+print "unsigned char erts_bif_trace_flags[BIF_SIZE];\n\n";
+
+print "BifEntry bif_table[] = {\n";
+for ($i = 0; $i < @bif; $i++) {
+    my $func = $bif[$i]->[3];
+    print "  {", join(', ', @{$bif[$i]}), "},\n";
+}
+print "};\n\n";
+
+#
+# Generate the bif wrappers file.
+#
+
+open_file("$src/erl_bif_wrap.c");
+my $i;
+includes("export.h", "sys.h", "erl_vm.h", "global.h", "erl_process.h", "bif.h",
+	 "erl_bif_table.h", "erl_atom_table.h");
+for ($i = 0; $i < @bif; $i++) {
+    next if $bif[$i]->[3] eq $bif[$i]->[4]; # Skip unwrapped bifs
+    my $arity = $bif[$i]->[2];
+    my $func = $bif[$i]->[3];
+    my $arg;
+    print "Eterm\n";
+    print "wrap_$func(Process* p";
+    for ($arg = 1; $arg <= $arity; $arg++) {
+	print ", Eterm arg$arg";
+    }
+    print ", Uint *I)\n";
+    print "{\n";
+    print "    return erts_bif_trace($i, p";
+    for ($arg = 1; $arg <= 3; $arg++) {
+	if ($arg <= $arity) {
+	    print ", arg$arg";
+	} elsif ($arg == ($arity + 1)) { 
+	    # Place I in correct position
+	    print ", (Eterm) I";
+	} else {
+	    print ", 0";
+	}
+    }
+    # I is always last, as well as in the correct position
+    # Note that "last" and "correct position" may be the same...
+    print ", I);\n";
+    print "}\n\n";
+}
+
+#
+# Generate the package bif file.
+#
+
+open_file("$src/erl_pbifs.c");
+my $i;
+includes("export.h", "sys.h", "erl_vm.h", "global.h", "erl_process.h", "bif.h",
+	 "erl_bif_table.h", "erl_atom_table.h");
+for ($i = 0; $i < @bif; $i++) {
+    my $arity = $bif[$i]->[2];
+    my $func = $bif[$i]->[3];
+    my $arg;
+    next unless $pbif[$i];
+    next unless $func =~ m/^ebif_(.*)/;
+    my $orig_func = $1;
+    $orig_func = $implementation[$i] if $implementation[$i];
+    print "Eterm\n";
+    print "$func(Process* p";
+    for ($arg = 1; $arg <= $arity; $arg++) {
+	print ", Eterm arg$arg";
+    }
+    print ")\n";
+    print "{\n";
+    print "    return $orig_func(p";
+    for ($arg = 1; $arg <= 3; $arg++) {
+	if ($arg <= $arity) {
+	    print ", arg$arg";
+        }
+    }
+    print ");\n";
+    print "}\n\n";
+}
+
+sub open_file {			# or die
+    my($name) = @_;
+
+    open(FILE, ">$name") or die "$0: Failed to create $name: $!\n";
+    select(FILE);
+    comment('C');
+}
+
+sub includes {
+    print "#ifdef HAVE_CONFIG_H\n";
+    print "#  include \"config.h\"\n";
+    print "#endif /* HAVE_CONFIG_H */\n";
+    print map { "#include \"$_\"\n"; } @_;
+    print "\n";
+}
+
+sub save_atoms {
+    my $atom;
+    my $alias;
+
+    foreach $atom (@_) {
+	if ($atom =~ /^\w+$/) {
+	    error("$atom: an atom must start with a lowercase letter\n",
+		  "  (use an alias like this: $atom='$atom')")
+		unless $atom =~ /^[a-z]/;
+	    $alias = $atom;
+	} elsif ($atom =~ /^'(.*)'$/) {
+	    $atom = $1;
+	    $alias = "_AtomAlias$auto_alias_num";
+	    $auto_alias_num++;
+	} elsif ($atom =~ /^(\w+)='(.*)'$/) {
+	    $alias = $1;
+	    $atom = $2;
+	    error("$alias: an alias must start with an uppercase letter")
+		unless $alias =~ /^[A-Z]/;
+	} else {
+	    error("invalid atom: $atom");
+	}
+	next if $atom{$atom};
+	push(@atom, $atom);
+	$atom{$atom} = 1;
+
+	if (defined $alias) {
+	    error("$alias: this alias is already in use")
+		if defined $aliases{$alias} && $aliases{$alias} ne $atom;
+	    $aliases{$alias} = $atom;
+	    $atom_alias{$atom} = $alias;
+	}
+    }
+}
+
+sub usage {
+    warn "$progname: ", @_, "\n";
+    die "usage: $progname -src source-dir -include include-dir file...\n";
+}
+
+sub error {
+    die "$ARGV($.): ", @_, "\n";
+}
+
+sub comment {
+    my($lang, @comments) = @_;
+    my($prefix);
+
+    if ($lang eq 'C') {
+	print "/*\n";
+	$prefix = " * ";
+    } elsif ($lang eq 'erlang') {
+	$prefix = '%% ';
+    } else {
+	$prefix = '# ';
+    }
+    my(@prog) = split('/', $0);
+    my($prog) = $prog[$#prog];
+
+    if (@comments) {
+	my $line;
+	foreach $line (@comments) {
+	    print "$prefix$line\n";
+	}
+    } else {
+	print "$prefix Warning: Do not edit this file.  It was automatically\n";
+	print "$prefix generated by '$progname' on ", (scalar localtime), ".\n";
+    }
+    if ($lang eq 'C') {
+	print " */\n";
+    }
+    print "\n";
+}
diff --git a/erts/emulator/utils/make_version b/erts/emulator/utils/make_version
new file mode 100755
index 0000000000..7757fa8138
--- /dev/null
+++ b/erts/emulator/utils/make_version
@@ -0,0 +1,63 @@
+#!/usr/bin/env perl 
+#
+# %CopyrightBegin%
+# 
+# Copyright Ericsson AB 1999-2009. All Rights Reserved.
+# 
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+# 
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+# 
+# %CopyrightEnd%
+#
+use strict;
+
+# Create the file erl_version.h
+#
+# Usage:
+#    make_version [ -o outputfile ] version architecture
+#
+# Output goes to ./erl_version.h (or to "outputfile" if specified)
+#
+
+my $time_str   = localtime;
+my $outputfile = "erl_version.h";
+
+@ARGV or die "No arguments given to 'make_version'";
+
+if ($ARGV[0] eq '-o') {
+  shift;			# Remove -o
+  $outputfile = shift;
+  defined $outputfile or die "No output file specified";
+}
+
+my $release = shift;
+defined $release or die "No release specified";
+
+my $version = shift;
+defined $version or die "No version name specified";
+
+my $architecture = shift;
+defined $architecture or die "No architecture specified";
+$architecture =~ s&^.*[/\\]&&;	# Remove directory part if any
+
+open(FILE, ">$outputfile") or die "Can't create $outputfile: $!";
+
+print FILE <<EOF;
+/* This file was created by 'make_version' -- don't modify. */
+#define ERLANG_OTP_RELEASE "$release"
+#define ERLANG_VERSION "$version"
+#define ERLANG_COMPILE_DATE "$time_str"
+#define ERLANG_ARCHITECTURE "$architecture"
+EOF
+
+close(FILE);
+
+exit(0);
diff --git a/erts/emulator/utils/mkver.c b/erts/emulator/utils/mkver.c
new file mode 100644
index 0000000000..844014e8f5
--- /dev/null
+++ b/erts/emulator/utils/mkver.c
@@ -0,0 +1,60 @@
+/*
+ * %CopyrightBegin%
+ * 
+ * Copyright Ericsson AB 1996-2009. All Rights Reserved.
+ * 
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ * 
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ * 
+ * %CopyrightEnd%
+ */
+/*
+ * Makes the file erl_version.h.
+ */
+
+#ifdef HAVE_CONFIG_H
+#  include "config.h"
+#endif
+#include <stdio.h>
+#include <stdlib.h>
+#include <errno.h>
+#include <time.h>
+
+int
+main(argc, argv)
+int argc;
+char** argv;
+{
+    FILE *file;
+    time_t now;
+    char *cnow;
+
+    if (argc != 2) {
+	fprintf(stderr, "usage: mkver version\n");
+	exit(1);
+    }
+
+    if ((file = fopen("erl_version.h", "wb")) == NULL) {
+	fprintf(stderr, "Could not create file 'erl_version.h'!\n");
+	exit(1);
+    }
+
+    time(&now);
+    cnow = ctime(&now);
+    cnow[24] = '\0';		/* tidelipom */
+    fprintf(file, "/* This file was created by mkver -- don't modify.*/\n");
+    fprintf(file, "#define ERLANG_VERSION \"%s\"\n", argv[1]);
+    fprintf(file, "#define ERLANG_COMPILE_DATE \"%s\"\n", cnow);
+    fclose(file);
+
+    exit(0);
+    return 0;
+}