#!/usr/bin/perl
# binary search maximum stack depth for arrays and hashes
# and store it in stacksize.h
use Config;
use Cwd;
my $f;
my $fn = "stacksize.h";
my ($bad1, $bad2) = (45000, 25000);
sub QUIET () {
(defined $ENV{MAKEFLAGS} and $ENV{MAKEFLAGS} =~ /\b(s|silent|quiet)\b/
and !defined($ENV{TRAVIS}))
? 1 : 0
}
sub PARALLEL () {
if (defined $ENV{MAKEFLAGS}
and $ENV{MAKEFLAGS} =~ /\bj\s*(\d+)\b/
and $1 > 1) {
return 1;
} else {
return 0;
}
}
sub is_miniperl {
return !defined &DynaLoader::boot_DynaLoader;
}
if (is_miniperl()) {
print "skip miniperl\n" unless QUIET;
exit;
}
if (@ARGV and $ARGV[0] eq '--core') {
$ENV{PERL_CORE} = 1;
}
my $PERL = $^X;
if ($ENV{PERL_CORE}) {
my $path;
my $ldlib = $Config{ldlibpthname};
if (-d 'dist/Storable') {
chdir 'dist/Storable';
$PERL = "../../$PERL" unless $PERL =~ m|^/|;
}
if ($ldlib) {
$path = getcwd()."/../..";
}
if ($^O eq 'MSWin32' and -d '../dist/Storable') {
chdir '..\dist\Storable';
$PERL = "..\\..\\$PERL" unless $PERL =~ /^[A-Za-z]:\\/;
}
$PERL = "\"$PERL\"" if $PERL =~ / /;
if ($ldlib) {
$PERL = "$ldlib=$path $PERL";
}
}
if (open $f, "<", $fn) {
my $s;
while ($s = <$f>) {
#print $s unless $QUIET;
if ($s =~ m|^/\* bisected|) {
print "already bisected\n" unless QUIET;
exit;
}
}
close $f;
}
my ($n, $good, $bad, $found) =
(35000, 100, $bad1, undef);
my $try = '$t=[$t]';
print "probe for max. stack sizes...\n" unless QUIET;
my $mblib = '-Mblib';
if ($ENV{PERL_CORE}) {
if ($^O eq 'MSWin32') {
$mblib = '-I..\..\lib\auto -I..\..\lib';
} else {
$mblib = '-I../../lib/auto -I../../lib';
}
}
if (PARALLEL) {
# problem with parallel builds. wait for INST_DYNAMIC linking to be done.
# the problem is the RM_F INST_DYNAMIC race.
print "parallel build race - wait for linker ...\n" unless QUIET;
sleep(2.0);
}
for my $i (0..1) {
my $probe ="$PERL $mblib -e\"require Storable or die; Storable::dclone([]) or die;\"";
if (system($probe) != 0) {
print "Storable not yet usable: $probe\n" unless QUIET;
unless ($i) { # XXX race?
require Config;
system($Config::Config{make});
# and try again
} else {
exit;
}
} else {
last;
}
}
sub cmd {
my $i = shift;
die unless $i;
($^O eq 'MSWin32')
? "$PERL $mblib -MStorable=dclone -e\"my \$t; $try for 1..$i;dclone(\$t);\""
: "$PERL $mblib -MStorable=dclone -e'my \$t; $try for 1..$i;dclone(\$t);'"
}
# try more
sub good {
my $i = shift; # this passed
my $j = $i + abs(int(($bad - $i) / 2));
print "$i passed, try more $j ...\n" unless QUIET;
$good = $i;
if ($j <= $i) {
$found++;
}
return $j;
}
# try less
sub bad {
my $i = shift; # this failed
my $j = $i - abs(int(($i - $good) / 2));
print "$i failed, try less $j ...\n" unless QUIET;
$bad = $i;
if ($j >= $i) {
$j = $good;
$found++;
}
return $j;
}
while (!$found) {
my $cmd = cmd($n);
#print "$cmd\n" unless $QUIET;
if (system($cmd) == 0) {
$n = good($n);
} else {
$n = bad($n);
}
}
print "MAX_DEPTH = $n\n" unless QUIET;
my $max_depth = $n;
($n, $good, $bad, $found) =
(int($n/2), 50, $n, undef);
# pack j only since 5.8
my $max = ($] > 5.007 and length(pack "j", 0) < 8)
? ($^O eq 'MSWin32' ? 3000 : 8000)
: $bad2;
$n = $max if $n > $max;
$bad = $max if $bad > $max;
$try = '$t={1=>$t}';
while (!$found) {
my $cmd = cmd($n);
#print "$cmd\n" unless $QUIET;
if (system($cmd) == 0) {
$n = good($n);
} else {
$n = bad($n);
}
}
if ($max_depth == $bad1-1
and $n == $bad2-1)
{
# more likely the shell. travis docker ubuntu e.g.
print "Error: Apparently your system(SHELLSTRING) cannot catch stack overflows\n"
unless QUIET;
$max_depth = 512;
$n = 256;
print "MAX_DEPTH = $max_depth\n" unless QUIET;
}
print "MAX_DEPTH_HASH = $n\n" unless QUIET;
my $max_depth_hash = $n;
open $f, ">", $fn or exit(1);
print $f "/* bisected with stacksize.pl */\n";
print $f "#define PST_STACK_MAX_DEPTH $max_depth\n";
print $f "#define PST_STACK_MAX_DEPTH_HASH $max_depth_hash\n";
close $f;