The R13B03 release.OTP_R13B03

1 files changed, 209 insertions, 0 deletions

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
+}