Andy, is it OK to use your Perl 5 static inline probing code in MoarVM?
The MoarVM licence is Artistic 2, which I don't think is directly compatible
with Perl 5's union of Artistic & GPL. So I think I need to ask permission
from you, as author and therefore copyright holder.
Attached is the proposed patch, which implements compiler based probing for
the MoarVM Configure.pl. Tested on OS X, FreeBSD, Linux, HP/UX and AIX.
Not tested on Win32, so might not work there without tweaks.
It takes the probing C code for static inline from Perl 5's Configure
pretty much verbatim, and uses that to determine what to use to get the
compiler to generate inline functions that don't also have an external
definition. I believe that probing is essential, as the correct magic to
use varies with different versions of some compilers, and so attempting to
maintain an explicit list is going to be more work than this.
Nicholas Clark
>From dba2746602e470cd325907b0aaedb46970ee96a6 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <n...@ccl4.org>
Date: Tue, 18 Feb 2014 15:13:10 +0100
Subject: [PATCH 1/6] Add probing code to Configure.pm to learn how the
compiler does 'static inline'
The compiler probing framework is intended to be generic, and is based on the
approach used by Perl 5's Configure, but with the compiler and linker flags
derived from Configure.pl's own values, which should make it portable to Win32
as well as *nix.
The probing code for static inline is a direct port of the Perl 5 code written
by Andy Dougherty, applied to Perl 5 as commit 17a6c8e38505fd8d in July 2010.
---
Configure.pl | 3 +
build/probe.pm | 175 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 178 insertions(+)
create mode 100644 build/probe.pm
diff --git a/Configure.pl b/Configure.pl
index 0c8b59e..16172f9 100644
--- a/Configure.pl
+++ b/Configure.pl
@@ -11,6 +11,7 @@ use File::Spec;
use build::setup;
use build::auto;
+use build::probe;
my $NAME = 'moar';
my $GENLIST = 'build/gen.list';
@@ -201,9 +202,11 @@ print "OK\n";
if ($config{crossconf}) {
build::auto::detect_cross(\%config, \%defaults);
+ build::probe::static_inline_cross(\%config, \%defaults);
}
else {
build::auto::detect_native(\%config, \%defaults);
+ build::probe::static_inline_native(\%config, \%defaults);
}
my $order = $config{be} ? 'big endian' : 'little endian';
diff --git a/build/probe.pm b/build/probe.pm
new file mode 100644
index 0000000..5e4cee2
--- /dev/null
+++ b/build/probe.pm
@@ -0,0 +1,175 @@
+package build::probe;
+use strict;
+use warnings;
+
+use File::Path qw(make_path remove_tree);
+use File::Spec::Functions qw(curdir catdir rel2abs devnull);
+
+my $devnull = devnull();
+
+my $probe_dir;
+
+END {
+ remove_tree($probe_dir)
+ if defined $probe_dir;
+}
+
+{
+ package build::probe::restore_cwd;
+ use Cwd;
+
+ sub new {
+ my $cwd = getcwd;
+ die "Can't getcwd: $!"
+ unless defined $cwd && length $cwd;
+ bless \$cwd;
+ }
+
+ sub DESTROY {
+ chdir ${$_[0]}
+ or warn "Can't restore cwd to ${$_[0]}: $!";
+ }
+}
+
+sub _to_probe_dir {
+ unless (defined $probe_dir) {
+ $probe_dir = rel2abs(catdir(curdir(), 'probe'));
+ make_path($probe_dir);
+ }
+ my $restore = build::probe::restore_cwd->new();
+ chdir $probe_dir
+ or die "Can't chir $probe_dir: $!";
+ return $restore;
+}
+
+sub compile {
+ my ($config, $leaf, $defines, $files) = @_;
+ my $restore = _to_probe_dir();
+
+ my $cl_define = join ' ', map {$config->{ccdef} . $_} @$defines;
+
+ my @objs;
+ foreach my $file ("$leaf.c", @$files) {
+ (my $obj = $file) =~ s/\.c/$config->{obj}/;
+ my $command = "$config->{cc} $cl_define $config->{ccout} $obj $config->{ccswitch} $file >$devnull 2>&1";
+ system $command
+ and return;
+ push @objs, $obj;
+ }
+
+ my $command = "$config->{ld} $config->{ldout} $leaf @objs >$devnull 2>&1";
+ system $command
+ and return;
+ return 1;
+}
+
+sub _spew {
+ my ($filename, $content) = @_;
+ open my $fh, '>', $filename
+ or die "Can't open $filename: $!";
+ print $fh $content
+ or die "Can't write to $filename: $!";
+ close $fh
+ or die "Can't close $filename: $!";
+}
+
+sub static_inline_native {
+ my ($config) = @_;
+ my $restore = _to_probe_dir();
+ _spew('try.c', <<'EOT');
+#include <stdlib.h>
+
+int main(int argc, char **argv) {
+#ifdef __GNUC__
+ return EXIT_SUCCESS;
+#else
+ return EXIT_FAILURE;
+#endif
+}
+EOT
+
+ print ::dots(' probing whether your compiler thinks that it is gcc');
+ compile($config, 'try')
+ or die "Can't compile simple gcc probe, so something is badly wrong";
+ my $gcc = !system './try';
+ print $gcc ? "YES\n": "NO\n";
+
+ print ::dots(' probing how your compiler does static inline');
+
+ _spew('inline.c', <<'EOCP');
+#include <stdlib.h>
+extern int f_via_a(int x);
+extern int f_via_b(int x);
+int main(int argc, char **argv)
+{
+ int y;
+
+ y = f_via_a(0);
+#ifdef USE_B
+ y = f_via_b(0);
+#endif
+ if (y == 42) {
+ return EXIT_SUCCESS;
+ }
+ else {
+ return EXIT_FAILURE;
+ }
+}
+EOCP
+
+_spew('a.c', <<'EOCP');
+static INLINE int f(int x) {
+ int y;
+ y = x + 42;
+ return y;
+}
+
+int f_via_a(int x)
+{
+ return f(x);
+}
+EOCP
+_spew('b.c', <<'EOCP');
+extern int f(int x);
+
+int f_via_b(int x)
+{
+ return f(x);
+}
+EOCP
+
+ # For gcc, prefer __inline__, which permits the cflags to add -ansi
+ my @try = $gcc ? qw(__inline__ inline __inline _inline)
+ : qw(inline __inline__ __inline _inline);
+
+ my $s_i;
+ while (my $try = shift @try) {
+ next unless compile($config, 'inline', ["INLINE=$try"], ['a.c']);
+ next if system "./inline";
+ # Now make sure there is no external linkage of static functions
+ if(!compile($config, 'inline', ["INLINE=$try", "USE_B"], ['a.c', 'b.c'])
+ || system "./inline") {
+ $s_i = "static $try";
+ last;
+ }
+ }
+
+ if ($s_i) {
+ print "$s_i\n";
+ } else {
+ print "none, so falling back to static\n";
+ $s_i = 'static';
+ }
+ $config->{static_inline} = $s_i;
+}
+
+sub static_inline_cross {
+ my ($config) = @_;
+ # FIXME. Needs testing, but might be robust enough to do what the native
+ # code does, but just skip the system() to run the executable. Although this
+ # might get confused by link time optimisations that only fail at run time,
+ # which the system test does detect.
+ $config->{static_inline} = 'static';
+}
+
+'00';
--
1.8.4.2
