aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/utils/make_preload
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /erts/emulator/utils/make_preload
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'erts/emulator/utils/make_preload')
-rwxr-xr-xerts/emulator/utils/make_preload209
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
+}