1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
| | # Copyright (C) all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
# Just-ahead-of-time builder for the lib/PublicInbox/xap_helper.h shim.
# I never want users to be without source code for repairs, so this
# aims to replicate the feel of a scripting language using C++.
# The resulting executable is not linked to Perl in any way.
package PublicInbox::XapHelperCxx;
use v5.12;
use PublicInbox::Spawn qw(run_die run_qx run_wait which);
use PublicInbox::IO qw(try_cat write_file);
use PublicInbox::Search;
use Fcntl qw(SEEK_SET);
use Config;
use autodie;
my $cxx = which($ENV{CXX} // 'c++') // which('clang') // die 'no C++ compiler';
my $dir = substr("$cxx-$Config{archname}", 1); # drop leading '/'
$dir =~ tr!/!-!;
my $idir;
if ((defined($ENV{XDG_CACHE_HOME}) && -d $ENV{XDG_CACHE_HOME}) ||
(defined($ENV{HOME}) && -d $ENV{HOME})) {
$idir = ($ENV{XDG_CACHE_HOME} //
(($ENV{HOME} // die('HOME unset')).'/.cache')
).'/public-inbox/jaot';
}
$idir //= $ENV{PERL_INLINE_DIRECTORY} //
die 'HOME and PERL_INLINE_DIRECTORY unset';
substr($dir, 0, 0) = "$idir/";
my $bin = "$dir/xap_helper";
my ($srcpfx) = (__FILE__ =~ m!\A(.+/)[^/]+\z!);
my @srcs = map { $srcpfx.$_ } qw(xh_mset.h xh_cidx.h xap_helper.h);
my @pm_dep = map { $srcpfx.$_ } qw(Search.pm CodeSearch.pm);
my $ldflags = '-Wl,-O1';
$ldflags .= ' -Wl,--compress-debug-sections=zlib' if $^O ne 'openbsd';
my $xflags = ($ENV{CXXFLAGS} // '-Wall -ggdb3 -pipe') . ' ' .
' -DTHREADID=' . PublicInbox::Search::THREADID .
' -DXH_SPEC="'.join('',
map { s/=.*/:/; $_ } @PublicInbox::Search::XH_SPEC) . '" ' .
($ENV{LDFLAGS} // $ldflags);
substr($xflags, 0, 0, '-O2 ') if !defined($ENV{CXXFLAGS}) && !-w __FILE__;
my $xap_modversion;
sub xap_cfg (@) {
my $cmd = [ $ENV{PKG_CONFIG} // 'pkg-config', @_, 'xapian-core' ];
chomp(my $ret = run_qx($cmd, undef, { 2 => \(my $err) }));
return $ret if !$?;
die <<EOM;
@$cmd failed: Xapian development files missing? (\$?=$?)
$err
EOM
}
sub needs_rebuild () {
my $prev = try_cat("$dir/XFLAGS") or return 1;
chomp $prev;
return 1 if $prev ne $xflags;
$prev = try_cat("$dir/xap_modversion") or return 1;
chomp $prev;
$xap_modversion = xap_cfg('--modversion');
$xap_modversion ne $prev;
}
sub build () {
if (!-d $dir) {
require File::Path;
eval { File::Path::make_path($dir) };
if (!-d $dir && defined($ENV{PERL_INLINE_DIRECTORY})) {
$dir = $ENV{PERL_INLINE_DIRECTORY};
File::Path::make_path($dir);
}
}
require PublicInbox::CodeSearch;
require PublicInbox::Lock;
my ($prog) = ($bin =~ m!/([^/]+)\z!);
my $lk = PublicInbox::Lock->new("$dir/$prog.lock")->lock_for_scope;
write_file '>', "$dir/$prog.cpp", qq{#include "xap_helper.h"\n},
PublicInbox::Search::generate_cxx(),
PublicInbox::CodeSearch::generate_cxx();
# xap_modversion may be set by needs_rebuild
$xap_modversion //= xap_cfg('--modversion');
my $fl = xap_cfg(qw(--libs --cflags));
# Using rpath seems acceptable/encouraged in the NetBSD packaging world
# since /usr/pkg/lib isn't searched by the dynamic loader by default.
# Not sure if other OSes need this, but rpath seems fine for JAOT
# binaries (like this one) even if other distros discourage it for
# distributed packages.
$^O eq 'netbsd' and $fl =~ s/(\A|[ \t])\-L([^ \t]+)([ \t]|\z)/
"$1-L$2 -Wl,-rpath=$2$3"/egsx;
my @xflags = split(' ', "$fl $xflags"); # ' ' awk-mode eats leading WS
my @cflags = ('-I', $srcpfx, grep(!/\A-(?:Wl|l|L)/, @xflags));
run_die([$cxx, '-o', "$dir/$prog.o", '-c', "$dir/$prog.cpp", @cflags]);
# xapian on Alpine Linux (tested 3.19.0) is linked against libstdc++,
# and clang needs to be told to use it (rather than libc++):
my @try = rindex($cxx, 'clang') >= 0 ? qw(-lstdc++) : ();
my @cmd = ($cxx, '-o', "$dir/$prog.tmp", "$dir/$prog.o", @xflags);
while (run_wait(\@cmd) and @try) {
warn("# attempting to link again with $try[0]...\n");
push(@cmd, shift(@try));
}
die "# @cmd failed: \$?=$?" if $?;
unlink "$dir/$prog.cpp", "$dir/$prog.o";
write_file '>', "$dir/XFLAGS.tmp", $xflags, "\n";
write_file '>', "$dir/xap_modversion.tmp", $xap_modversion, "\n";
undef $xap_modversion; # do we ever build() twice?
# not quite atomic, but close enough :P
rename("$dir/$_.tmp", "$dir/$_") for ($prog, qw(XFLAGS xap_modversion));
}
sub check_build () {
use Time::HiRes qw(stat);
my $ctime = 0;
my @bin = stat($bin) or return build();
for (@srcs, @pm_dep) {
my @st = stat($_) or die "stat $_: $!";
if ($st[10] > $ctime) {
$ctime = $st[10];
return build() if $ctime > $bin[10];
}
}
needs_rebuild() ? build() : 0;
}
# returns spawn arg
sub cmd {
die 'PI_NO_CXX set' if $ENV{PI_NO_CXX};
check_build();
my @cmd;
if (my $v = $ENV{VALGRIND}) {
$v = 'valgrind -v' if $v eq '1';
@cmd = split(/\s+/, $v);
}
push @cmd, $bin;
\@cmd;
}
1;
|