refactor(driver): prepare native runtime resources with Perl

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>

1 files changed, 212 insertions, 0 deletions

diff --git a/tools/driver/prepare-native-runtime.pl b/tools/driver/prepare-native-runtime.pl
new file mode 100644
index 0000000..6281802
--- /dev/null
+++ b/tools/driver/prepare-native-runtime.pl
@@ -0,0 +1,212 @@
+#!/usr/bin/env perl
+# Freeze the build toolchain's native link inputs into the compiler.
+use strict;
+use warnings;
+use Compress::Zlib qw(compress);
+use Cwd qw(abs_path);
+use File::Basename qw(basename dirname);
+use File::Find qw(find);
+use File::Path qw(make_path);
+use File::Spec;
+use File::Temp qw(tempdir);
+use Getopt::Long qw(GetOptions);
+use JSON::PP ();
+use Text::ParseWords qw(shellwords);
+
+my ($compiler, $output, $platform);
+my @flags;
+Getopt::Long::Configure('no_auto_abbrev', 'no_ignore_case');
+GetOptions('compiler=s' => \$compiler, 'output=s' => \$output,
+    'platform=s' => \$platform, 'flag=s@' => \@flags)
+    or die "Invalid native runtime options\n";
+die "Usage: $0 --compiler=PATH --output=PATH --platform=linux|windows|macos [--flag=VALUE ...]\n"
+    if @ARGV || !defined($compiler) || !defined($output) || !defined($platform)
+        || $platform !~ /\A(?:linux|windows|macos)\z/;
+my $directory = dirname($output);
+make_path($directory);
+my $capture = tempdir(CLEANUP => 1);
+
+sub read_file {
+    my ($path) = @_;
+    open my $fh, '<:raw', $path or die "Cannot read $path: $!\n";
+    local $/;
+    my $data = <$fh>;
+    close $fh or die "Cannot close $path: $!\n";
+    return defined($data) ? $data : '';
+}
+
+sub write_file {
+    my ($path, $data) = @_;
+    open my $fh, '>:raw', $path or die "Cannot write $path: $!\n";
+    print {$fh} $data or die "Cannot write $path: $!\n";
+    close $fh or die "Cannot close $path: $!\n";
+}
+
+sub compiler {
+    my @command = ($compiler, @flags, @_);
+    my $out_path = File::Spec->catfile($capture, 'stdout');
+    my $err_path = File::Spec->catfile($capture, 'stderr');
+    my $pid = fork();
+    die "Cannot fork: $!\n" unless defined $pid;
+    if ($pid == 0) {
+        open STDOUT, '>:raw', $out_path or die "Cannot redirect stdout: $!\n";
+        open STDERR, '>:raw', $err_path or die "Cannot redirect stderr: $!\n";
+        { exec {$command[0]} @command; }
+        die "Cannot execute $command[0]: $!\n";
+    }
+    waitpid($pid, 0) == $pid or die "Cannot wait for compiler: $!\n";
+    my $status = $?;
+    my ($stdout, $stderr) = (read_file($out_path), read_file($err_path));
+    die "Compiler failed (status $status): @command\n$stderr" if $status != 0;
+    s/\r\n/\n/g for ($stdout, $stderr);
+    return ($stdout, $stderr);
+}
+
+# An actual object lets the driver validate its inputs without linking a probe.
+my $source = File::Spec->catfile($directory, 'native-probe.cc');
+my $obj = File::Spec->catfile($directory, 'native-probe.o');
+my $binary = File::Spec->catfile($directory, 'native-probe.out');
+write_file($source, "int main() { return 0; }\n");
+compiler('-c', $source, '-o', $obj);
+my @static = $platform eq 'macos' ? () : $platform eq 'windows'
+    ? ('-static') : ('-static-libstdc++', '-static-libgcc');
+my (undef, $trace) = compiler('-###', '-fuse-ld=lld', @static, $obj, '-o', $binary);
+my @commands = map { [shellwords($_)] } grep { /^\s*"/ } split /\n/, $trace;
+die "Expected one native linker command: $trace" unless @commands == 1;
+my @command = @{$commands[0]};
+shift @command;
+my @directories = map { substr($_, 2) } grep { /^-L/ } @command;
+my ($target) = compiler('-print-effective-triple');
+$target =~ s/^\s+|\s+$//g;
+my (%files, %scripts, %mapped);
+my (@file_order, @mapped_order, @arguments);
+my $root = '@CPSC_RUNTIME@';
+
+sub resolve {
+    my ($name, $static_only) = @_;
+    my @names = $name =~ /^:/ ? (substr($name, 1))
+        : map { "lib$name$_" } ($platform eq 'macos' ? ('.tbd', '.dylib', '.a')
+            : $static_only ? ('.a') : ('.dll.a', '.so', '.a'));
+    for my $dir (@directories) {
+        for my $filename (@names) {
+            my $path = File::Spec->catfile($dir, $filename);
+            return $path if -f $path;
+        }
+    }
+    for my $filename (@names) {
+        my ($found) = compiler("-print-file-name=$filename");
+        $found =~ s/^\s+|\s+$//g;
+        return $found if -f $found;
+    }
+    die "Cannot find native link input $name\n";
+}
+
+sub unix_path {
+    my ($path) = @_;
+    $path =~ s{\\}{/}g if $^O eq 'MSWin32';
+    return $path;
+}
+
+sub add_file {
+    my ($name, $data) = @_;
+    push @file_order, $name unless exists $files{$name};
+    $files{$name} = $data;
+}
+
+my ($sdk, $sdk_real);
+my @sdk_inputs;
+if ($platform eq 'macos') {
+    my ($index) = grep { $command[$_] eq '-syslibroot' } 0 .. $#command;
+    die "A macOS SDK is required to prepare native linking\n" unless defined $index;
+    $sdk = $command[$index + 1];
+    $sdk_real = unix_path(abs_path($sdk));
+    my $lib = File::Spec->catdir($sdk, 'usr', 'lib');
+    push @directories, $lib;
+    # Embed SDK link interfaces, not runtime dylibs or SDK headers.
+    find({no_chdir => 1, wanted => sub {
+        push @sdk_inputs, $File::Find::name if /\.tbd\z/ && -f $_;
+    }}, $lib);
+    for my $path (sort {
+        join("\0", File::Spec->splitdir($a)) cmp join("\0", File::Spec->splitdir($b))
+    } @sdk_inputs) {
+        add_file('sdk/' . unix_path(File::Spec->abs2rel($path, $sdk)), read_file($path));
+    }
+}
+
+sub resource {
+    my ($path) = @_;
+    $path = unix_path(abs_path($path));
+    return "$root/$mapped{$path}" if exists $mapped{$path};
+    my $name = defined($sdk_real) && index($path, "$sdk_real/") == 0
+        ? 'sdk/' . substr($path, length($sdk_real) + 1)
+        : 'files/' . scalar(@mapped_order) . '/' . basename($path);
+    $mapped{$path} = $name;
+    push @mapped_order, $path;
+    my $data = read_file($path);
+    if (index(substr($data, 0, 256), 'GNU ld script') >= 0) {
+        $data =~ s{/\*.*?\*/}{}gs;
+        # Relocate absolute paths and nested GROUP/AS_NEEDED link inputs.
+        $data =~ s{(/[^\s()]+|lib[\w.+-]+\.(?:so(?:\.[\d]+)*|a))}{
+            my $token = $1;
+            '"' . resource(-f $token ? $token : resolve(":$token")) . '"';
+        }ge;
+        $scripts{$name} = 1;
+    }
+    add_file($name, $data);
+    return "$root/$name";
+}
+
+my $static_only = $platform eq 'windows';
+for (my $i = 0; $i < @command;) {
+    my $arg = $command[$i++];
+    if ($arg eq '-o' || $arg eq '-L') {
+        ++$i;
+    } elsif ($arg eq $obj || $arg =~ /^-L/) {
+        next;
+    } elsif ($arg eq '-dynamic-linker' || $arg eq '--dynamic-linker') {
+        # The interpreter must remain an operating-system path.
+        push @arguments, $arg, $command[$i++];
+    } elsif ($arg eq '-syslibroot') {
+        push @arguments, $arg, "$root/sdk";
+        ++$i;
+    } elsif ($arg eq '-Bstatic' || $arg eq '-Bdynamic') {
+        $static_only = $arg eq '-Bstatic';
+        push @arguments, $arg;
+    } elsif ($arg =~ /^-l/) {
+        push @arguments, resource(resolve(substr($arg, 2), $static_only));
+    } elsif (-f $arg) {
+        push @arguments, resource($arg);
+    } else {
+        push @arguments, $arg;
+    }
+}
+
+my $blob = '';
+my @manifest_files;
+for my $name (@file_order) {
+    my $data = $files{$name};
+    push @manifest_files, {path => $name, offset => length($blob), size => length($data),
+        script => $scripts{$name} ? JSON::PP::true : JSON::PP::false};
+    $blob .= $data;
+}
+my $compressed = compress($blob, 9);
+die "Cannot compress native link resources\n" unless defined $compressed;
+# Small separate literals avoid MSVC's individual string literal limit.
+my @literals;
+for (my $i = 0; $i < length($compressed); $i += 1024) {
+    push @literals, '"' . join('', map { sprintf '\\x%02x', $_ }
+        unpack('C*', substr($compressed, $i, 1024))) . '"';
+}
+my $manifest = JSON::PP->new->ascii->canonical->encode(
+    {target => $target, arguments => \@arguments, files => \@manifest_files});
+my $content = "// Generated native link resources; do not edit.\n"
+    . 'static constexpr size_t NativeRuntimeSize = ' . length($blob) . ";\n"
+    . "static const char NativeRuntimeData[] =\n" . join("\n", @literals) . ";\n"
+    . "static const char NativeRuntimeManifest[] = R\"CPSC(\n$manifest\n)CPSC\";\n";
+write_file($output, $content) if !-e $output || read_file($output) ne $content;
+# Track the actual toolchain inputs, not only the generator script.
+write_file(File::Spec->catfile($directory, 'native-runtime-inputs.cmake'),
+    "set_property(DIRECTORY APPEND PROPERTY CMAKE_CONFIGURE_DEPENDS\n"
+    . join("\n", map { "  [==[$_]==]" } (@mapped_order, @sdk_inputs)) . ")\n");
+print 'Embedded ' . scalar(@file_order) . ' native link inputs ('
+    . length($compressed) . " compressed bytes)\n";