1 files changed, 141 insertions, 0 deletions
diff --git a/winsup/cygwin/gendevices b/winsup/cygwin/gendevices
new file mode 100755
index 000000000..0b2271e71
--- /dev/null
+++ b/winsup/cygwin/gendevices
@@ -0,0 +1,141 @@
+#!/usr/bin/perl
+use File::Basename;
+use Cwd;
+my $cwd = getcwd;
+
+use strict;
+use integer;
+sub devsort;
+
+my $input = shift;
+my $output = shift;
+my $base = "/tmp/" . basename($input, '.in') . '.' . $$;
+my $c = $base . '.c';
+my $shilka = $base . '.shilka';
+
+open(INPUT, $input) or die "$0: couldn't open '$input' - $!\n";
+
+my @lines = ();
+my $storage_ix = -1;
+my @storage = ();
+my %pointers = ();
+my @patterns = ();
+my $patterns_ix = -1;
+while (<INPUT>) {
+    if (/%storage_here/) {
+	$storage_ix = @lines;
+    } elsif (/^"([^"]+)",\s*(.*)$/o) {
+    	push(@patterns, [$1, $2]);
+	next;
+    }
+    if (@patterns) {
+	for my $f (sort devsort @patterns) {
+	    my $x = $f->[0];
+	    my $rest = $f->[1];
+	    my ($dev, $devrest) = ($x =~ /([^%]+)(%.*)?$/o);
+	    push(@lines, generate($dev, $devrest, $rest, []));
+	}
+	@patterns = ();
+    }
+    push(@lines, $_);
+}
+
+close INPUT;
+# @storage = sort devsort @storage;
+chop $storage[$#storage];
+chop $storage[$#storage];
+$storage[$#storage] .= "\n";
+splice(@lines, $storage_ix, 1,
+       "static const device dev_storage[] =\n", "{\n",
+       @storage, "};\n\n",
+       sort {$a cmp $b} values %pointers);
+open(SHILKA, '>', $shilka);
+print SHILKA @lines;
+close SHILKA;
+
+chdir '/tmp';
+system qw'shilka -length -strip -no-definitions', $shilka;
+exit $? if $?;
+chdir $cwd;
+unlink $shilka;
+open(C, $c) or die "$0: couldn't open $c - $!\n";
+@lines = <C>;
+close C;
+unlink $c;
+splice(@lines, 0, 3);
+my $ign_until_brace = 0;
+for (my $i = 0; $i < @lines; $i++) {
+    $_ = $lines[$i];
+    $ign_until_brace = 1 if /(?:KR_reset|KR_output_statistics).*\)\s*$/o;
+    if ($ign_until_brace || /(?:#\s*line|(?:KR_reset|KR_output_statistics).*;)/)  {
+	$ign_until_brace = 0 if $ign_until_brace && /}/o;
+	splice(@lines, $i, 1);
+	redo;
+    };
+}
+open(OUTPUT, '>', $output) or die "$0: couldn't open $output - $!\n";
+print OUTPUT @lines;
+close OUTPUT;
+
+sub generate {
+    my $dev = shift;
+    my $devrest = shift;
+    my $rest = shift;
+    my $vars = shift;
+    my $res;
+    my @lines = ();
+    if ($devrest) {
+	my ($a, $low, $high, $fmt, $b) = ($devrest =~ /%([\({])([^-]+)-([^\)}]+)[\)}](.)(.*)/o);
+	my ($middle, $devrest0) = ($b =~ /^([^%]*)(%.*)?$/);
+	$fmt = "%$fmt";
+	my $vars_ix = @{$vars};
+	for my $f ($low .. $high) {
+	    $vars->[$vars_ix] = $f;
+	    $#{$vars} = $vars_ix;
+	    my $dev0 = $dev . sprintf($fmt, $f) . $middle;
+	    push(@lines, generate($dev0, $devrest0, $rest, $vars));
+	}
+      } else {
+	my $fh = $dev;
+	$fh =~ s%/%_%og;
+	my $shilka_id = $fh;
+	my $storage_str = $fh . '_storage';
+	$fh =~ s/^_dev_/FH_/o;
+	$fh = uc $fh;
+	$shilka_id =~ s/^_dev_//o;
+	$storage_str =~ s/^_dev/dev/o;
+	my $storage_loc = "dev_storage + " . @storage;
+	@lines = ('"' . $dev . '"' . " = $shilka_id {return $storage_loc;}\n");
+	$rest = "$fh, $rest" if $rest =~ /^"/o;
+	$rest = fixup($rest, $vars);
+	if ($rest =~ /^(.*), ([a-z_]*_dev)/) {
+	    $pointers{$2} ||= "const device *$2 = $storage_loc;\n"; 
+	    $rest = $1;
+	}
+	push(@storage, "  {\"$dev\", " . $rest . "},\n");
+    }
+    return @lines;
+}
+
+sub fixup {
+    my $rest = shift;
+    my $vars = shift;
+    0 while $rest =~ s/{([^}]*)}/evalit($1, $vars)/eg;
+    return $rest;
+}
+
+sub evalit {
+    my $what = shift;
+    my $vars = shift;
+    $what =~ s/\$(\d+)/'$vars->[$1-1]'/g;
+    my $res = eval $what;
+    return $res;
+}
+
+sub devsort {
+    my $a0 = $a->[0];
+    my $b0 = $b->[0];
+    $a0 =~ s/(\D)(\d+)/"$1" . sprintf "%05d", $2/e;
+    $b0 =~ s/(\D)(\d+)/"$1" . sprintf "%05d", $2/e;
+    return $a0 cmp $b0;
+}