summaryrefslogtreecommitdiff
path: root/lib/B
diff options
context:
space:
mode:
Diffstat (limited to 'lib/B')
-rwxr-xr-xlib/B/assemble30
-rw-r--r--lib/B/cc_harness12
-rwxr-xr-xlib/B/disassemble22
-rw-r--r--lib/B/makeliblinks54
4 files changed, 118 insertions, 0 deletions
diff --git a/lib/B/assemble b/lib/B/assemble
new file mode 100755
index 0000000000..43cc5bc4b3
--- /dev/null
+++ b/lib/B/assemble
@@ -0,0 +1,30 @@
+use B::Assembler qw(assemble_fh);
+use FileHandle;
+
+my ($filename, $fh, $out);
+
+if ($ARGV[0] eq "-d") {
+ B::Assembler::debug(1);
+ shift;
+}
+
+$out = \*STDOUT;
+
+if (@ARGV == 0) {
+ $fh = \*STDIN;
+ $filename = "-";
+} elsif (@ARGV == 1) {
+ $filename = $ARGV[0];
+ $fh = new FileHandle "<$filename";
+} elsif (@ARGV == 2) {
+ $filename = $ARGV[0];
+ $fh = new FileHandle "<$filename";
+ $out = new FileHandle ">$ARGV[1]";
+} else {
+ die "Usage: assemble [filename] [outfilename]\n";
+}
+
+binmode $out;
+$SIG{__WARN__} = sub { warn "$filename:@_" };
+$SIG{__DIE__} = sub { die "$filename: @_" };
+assemble_fh($fh, sub { print $out @_ });
diff --git a/lib/B/cc_harness b/lib/B/cc_harness
new file mode 100644
index 0000000000..79f8727a8f
--- /dev/null
+++ b/lib/B/cc_harness
@@ -0,0 +1,12 @@
+use Config;
+
+$libdir = $ENV{PERL_SRC} || "$Config{installarchlib}/CORE";
+
+if (!grep(/^-[cS]$/, @ARGV)) {
+ $linkargs = sprintf("%s $libdir/$Config{libperl} %s",
+ @Config{qw(ldflags libs)});
+}
+
+$cccmd = "$Config{cc} $Config{ccflags} -I$libdir @ARGV $linkargs";
+print "$cccmd\n";
+exec $cccmd;
diff --git a/lib/B/disassemble b/lib/B/disassemble
new file mode 100755
index 0000000000..6530b80950
--- /dev/null
+++ b/lib/B/disassemble
@@ -0,0 +1,22 @@
+use B::Disassembler qw(disassemble_fh);
+use FileHandle;
+
+my $fh;
+if (@ARGV == 0) {
+ $fh = \*STDIN;
+} elsif (@ARGV == 1) {
+ $fh = new FileHandle "<$ARGV[0]";
+} else {
+ die "Usage: disassemble [filename]\n";
+}
+
+sub print_insn {
+ my ($insn, $arg) = @_;
+ if (defined($arg)) {
+ printf "%s %s\n", $insn, $arg;
+ } else {
+ print $insn, "\n";
+ }
+}
+
+disassemble_fh($fh, \&print_insn);
diff --git a/lib/B/makeliblinks b/lib/B/makeliblinks
new file mode 100644
index 0000000000..82560783c0
--- /dev/null
+++ b/lib/B/makeliblinks
@@ -0,0 +1,54 @@
+use File::Find;
+use Config;
+
+if (@ARGV != 2) {
+ warn <<"EOT";
+Usage: makeliblinks libautodir targetdir
+where libautodir is the architecture-dependent auto directory
+(e.g. $Config::Config{archlib}/auto).
+EOT
+ exit 2;
+}
+
+my ($libautodir, $targetdir) = @ARGV;
+
+# Calculate relative path prefix from $targetdir to $libautodir
+sub relprefix {
+ my ($to, $from) = @_;
+ my $up;
+ for ($up = 0; substr($to, 0, length($from)) ne $from; $up++) {
+ $from =~ s(
+ [^/]+ (?# a group of non-slashes)
+ /* (?# maybe with some trailing slashes)
+ $ (?# at the end of the path)
+ )()x;
+ }
+ return (("../" x $up) . substr($to, length($from)));
+}
+
+my $relprefix = relprefix($libautodir, $targetdir);
+
+my ($dlext, $lib_ext) = @Config::Config{qw(dlext lib_ext)};
+
+sub link_if_library {
+ if (/\.($dlext|$lib_ext)$/o) {
+ my $ext = $1;
+ my $name = $File::Find::name;
+ if (substr($name, 0, length($libautodir) + 1) ne "$libautodir/") {
+ die "directory of $name doesn't match $libautodir\n";
+ }
+ substr($name, 0, length($libautodir) + 1) = '';
+ my @parts = split(m(/), $name);
+ if ($parts[-1] ne "$parts[-2].$ext") {
+ die "module name $_ doesn't match its directory $libautodir\n";
+ }
+ pop @parts;
+ my $libpath = "$targetdir/lib" . join("__", @parts) . ".$ext";
+ print "$libpath -> $relprefix/$name\n";
+ symlink("$relprefix/$name", $libpath)
+ or warn "above link failed with error: $!\n";
+ }
+}
+
+find(\&link_if_library, $libautodir);
+exit 0;