#!/usr/bin/perl -s # Copyright 2003, 2004, 2005 Red Hat, Inc. # # This file is part of Cygwin. # # This software is a copyrighted work licensed under the terms of the # Cygwin license. Please consult the file "CYGWIN_LICENSE" for # details. # 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 =~ s/\A.*\n#pragma once\n//os; $tls =~ s/\n[^\n]*gentls_offsets[^\n]*\n(.+)\Z/$1/os; my $pre = $`; substr($tls, 0, length($pre)) = ''; $pre .= "\n//*/"; $tls =~ s%/\*\s*gentls_offsets.*?/\*\s*gentls_offsets\s*\*/%%ogs; foreach ($tls =~ /^.*\n/mg) { /^}|\s*(?:typedef|const)/o and do { $def .= $_ ; next; }; $def .= $_ if $struct; 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 < #include #include #include $pre $def int main(int argc, char **argv) { $struct *foo; # define foo_beg ((char *) foo) # define offset(f) ((int) (((char *) &(foo->f)) - foo_beg) - CYGTLS_PADSIZE) # define poffset(f) (((char *) &(foo->f)) - ((char *) foo)) EOF print TMP 'puts ("//;# autogenerated: Do not edit.\n");', "\n\n"; print TMP "printf (\"//; \$tls::sizeof_$struct = %d;\\n\", sizeof($struct\));\n"; for my $f (@fields) { print TMP ' printf ("//; $tls::', $f, ' = %d;\n", ', "offset($f));\n"; print TMP ' printf ("//; $tls::p', $f, ' = %d;\n", ', "poffset($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 ' printf ("#define tls_p', $f, ' (%d)\n", ', "poffset($f));\n"; } print TMP <', $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 ; close OFFS; close TLS_OUT; unlink "/tmp/$$.cc", "/tmp/$$.a.out"; exit(0);