newlib/winsup/cygwin/gentls_offsets

#!/usr/bin/perl -s
my $tls = shift;
my $tls_out = shift;
open(TLS, $tls) or die "$0: couldn't open tls file \"$tls\" - $!\n";
my $struct = '';
my @fields = ();
my $def = '';
$tls = join('', <TLS>);
$tls =~ s/\n[^\n]*gentls_offsets[^\n]*\n(.+)\Z/$1/os;
my $pre = $`;
substr($tls, 0, length($pre)) = '';
$pre =~ s/\n#ifndef _[^\n]+\n/\n/os;
$pre .= "\n//*/";
$tls =~ s%/\*\s*gentls_offsets.*?/\*\s*gentls_offsets\s*\*/%%ogs;
foreach ($tls =~ /^.*\n/mg) {
    $def .= $_ if $struct;
    last if /^};/o;
    /^\s*typedef/o and do {
	$def .= $_ ;
	next;
    };
    if (!s/;.*$//o) {
	if (!$struct && /^\s*(?:struct|class)\s*([a-z_0-9]+)/o) {
	    $def .= $_;
	    $struct = $1 
	}
	next;
    }
    s/(?:\[[^\]]*\]|struct|class)//o;
    s/^\s+\S+\s+//o;
    s/[\*\s()]+//go;
    for my $f (split(/,/)) {
	push(@fields, $f);
    }
}
close TLS;
open(TMP, '>', "/tmp/$$.cc") or die "$0: couldn't open temporary index file \"/tmp/$$.c\" - $!\n";
print TMP <<EOF;
#define __INSIDE_CYGWIN__
#define __attribute__(X)
#include <stdio.h>
#include <stdlib.h>
#include <signal.h>
typedef void *HANDLE;
$pre
$def
int
main(int argc, char **argv)
{
  $struct foo[1];
# define foo_end ((char *) (foo + 1))
# define offset(f) (((char *) &(foo->f)) - foo_end)
EOF
    print TMP 'puts ("//;# autogenerated:  Do not edit.\n");', "\n\n";
    for my $f (@fields) {
	print TMP '  printf ("//; $tls::', $f, ' = %d;\n", ', "offset($f));\n";
    }
    print TMP '  puts ("//; __DATA__\n");', "\n";
    for my $f (@fields) {
	print TMP '  printf ("#define tls_', $f, ' (%d)\n", ', "offset($f));\n";
    }

    print TMP <<EOF;

  exit (0);
}
EOF
close TMP;
system @ARGV, '-o', "/tmp/$$-1.cc", '-E', "/tmp/$$.cc";
system 'g++', '-o', "/tmp/$$.a.out", "/tmp/$$-1.cc" and
($? == 127 && system 'c++',  '-o', "/tmp/$$.a.out", "/tmp/$$-1.cc") and
die "$0: couldn't generate executable for offset calculation \"/tmp/$$.a.out\" - $!\n";
open(TLS_OUT, '>', $tls_out) or die "$0: couldn't open tls index file \"tls_out\" - $!\n";
open(OFFS, "/tmp/$$.a.out|") or die "$0: couldn't run \"/tmp/$$.a.out\" - $!\n";
print TLS_OUT <OFFS>;
close OFFS;
close TLS_OUT;
unlink "/tmp/$$.cc", "/tmp/$$.a.out";
exit(0);