diff options
Diffstat (limited to 'erts/emulator/utils/make_preload')
| -rwxr-xr-x | erts/emulator/utils/make_preload | 209 |
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 +} |