summaryrefslogtreecommitdiff
path: root/support/splint/scripts
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/splint/scripts
Initial commit
Diffstat (limited to 'support/splint/scripts')
-rwxr-xr-xsupport/splint/scripts/bindx.pl101
-rwxr-xr-xsupport/splint/scripts/brack.pl105
-rwxr-xr-xsupport/splint/scripts/cslist.pl40
-rwxr-xr-xsupport/splint/scripts/unline.pl31
4 files changed, 277 insertions, 0 deletions
diff --git a/support/splint/scripts/bindx.pl b/support/splint/scripts/bindx.pl
new file mode 100755
index 0000000000..ace62429ba
--- /dev/null
+++ b/support/splint/scripts/bindx.pl
@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+
+open FILE, "$ARGV[0]" or die "Cannot open input file $ARGV[0]\n";
+open FILE_OUT, ">$ARGV[1]" or die "Cannot open input file $ARGV[1]\n";
+
+sub lex_order (\@\@) { # lexicographic ordering
+
+ my (@string1) = @{shift @_};
+ my (@string2) = @{shift @_};
+
+ my ($i);
+
+ $i = 0;
+
+ while ( $string1[$i] == $string2[$i] && $i <= $#string1 && $i <= $#string2 ) { $i++ }
+
+ if ( $i > $#string1 || $i > $#string2 ) {
+
+ return $#string1 <=> $#string2;
+
+ }
+
+ return ( $string1[$i] <=> $string2[$i] );
+
+}
+
+sub numerically { $b <=> $a; }
+
+sub alphabetically { # lexicographic ordering based on the ASCII order defined in @main_order
+
+ my (@chars1) = map { $main_order{$_} } split //, $a;
+ my (@chars2) = map { $main_order{$_} } split //, $b;
+
+ return lex_order @chars1, @chars2;
+
+}
+
+sub lexicographically { # lexicographic ordering for numeric sequences separated by spaces
+
+ my (@chars1) = split / /, $a;
+ my (@chars2) = split / /, $b;
+
+ return lex_order @chars1, @chars2;
+}
+
+$alphabet = "\#\$\%^&*<>[]{}()+-=_|\\,:;~`.?!\'\"\@0123456789AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz";
+@main_set = split //, $alphabet;
+map { $main_order{$_} = index $alphabet, $_ } @main_set; # inefficient ...
+
+$ldelim[1] = "\\["; $rdelim[1] = "]";
+$ldelim[0] = "\\("; $rdelim[0] = ")";
+$ldelim[5] = "\\e"; $rdelim[5] = "e";
+$ldelim[4] = "\\f"; $rdelim[4] = "f";
+$ldelim[3] = "\\g"; $rdelim[3] = "g";
+
+while (<FILE>) {
+
+ $input = $_;
+
+ if ( $input =~ /\\(.)TI\s*([0-9]+)\s*\{(\\[a-z]+)\s*\{(.+)\}\}\{(.+)\}\{(.+)\}\{(.+)\}\n/ ) {
+
+ ($domain, $rank, $type, $key, $nspace, $pageno, $ref) = ($1, $2, $3, $4, $5, $6, $7);
+ $key =~ s/\{([0-9]+)\}/pack "c1", $1/eg;
+
+ push @{$index{$domain}{$key}{refs}}, "$ref $rank";
+ $index{$domain}{$key}{nspace} = $nspace;
+ $index{$domain}{$key}{type} = $type;
+
+ }
+
+}
+
+$i = 0;
+
+foreach $domain (sort keys %index ) {
+
+ if ( $i > 0) {
+
+ print FILE_OUT "\\indexseparator{$domain}{$i}\n";
+
+ }
+
+ $i++;
+
+ foreach $key ( sort alphabetically keys %{$index{$domain}} ) {
+
+ %ref_list = ();
+ map { exists $ref_list{$_} ? ($ref_list{$_}++) : ($ref_list{$_} = 0) } @{$index{$domain}{$key}{refs}};
+
+ @ref_list = sort lexicographically keys %ref_list;
+ @ref_list = map { @r = split / /, $_; "$ldelim[$r[1]]$r[0]$rdelim[$r[1]]" } @ref_list;
+
+ $ukey = $key;
+ $ukey =~ s/(.)/"\{".(unpack "c1", $1)."\}"/eg;
+
+ print FILE_OUT "\\GI{$index{$domain}{$key}{nspace}}{$index{$domain}{$key}{type}}{$ukey}, ",
+ (join ', ', @ref_list), ". \% $key, sec nos. ", (join ', ', @ref_list ), "\n";
+
+ }
+}
+
diff --git a/support/splint/scripts/brack.pl b/support/splint/scripts/brack.pl
new file mode 100755
index 0000000000..6e110e5cf3
--- /dev/null
+++ b/support/splint/scripts/brack.pl
@@ -0,0 +1,105 @@
+#!/usr/bin/perl
+
+# a simple script to replace all @G ... @`other' regions with
+# @= ... @>@; lines
+# comments are allowed at the end of the lines.
+# only one style of comments is accepted: /* ... */. note that these are not
+# output
+
+open FILE, "$ARGV[0]" or die "Cannot open input file $ARGV[0]\n";
+open FILEOUT, ">$ARGV[1]" or die "Cannot open output file $ARGV[1]\n";
+
+$state = 0;
+while (<FILE>) {
+
+ $inline = $_;
+
+
+ if ( $inline =~ m/^\@G(.*)$/ ) { # @G detected, this line is part of the `other language' region
+
+ $inline = $1; $state = 1;
+ if ( $inline =~ m/^\(([^)]*)\).*/ ) {
+ printf FILEOUT "\@q Start generic language section\@>\n\@t}\\begingsec{%s}{\@>\n", "$1"; # a parser switcher
+ } else {
+ $inline = " Start \@\@G (generic) language section";
+ printf FILEOUT "\@q%s\@>\n\@t}\\begingsec{b}{\@>\n", "$inline"; # a parser switcher
+ }
+
+ } elsif ( $inline =~ m/^\@[\scp].*$/ ) { # @`other' detected, so `other language' region is over
+
+ if ($state == 1) {
+ printf FILEOUT "\@q%s\@>\n\@t}\\endgsec{\@>\n",
+ "End of generic language section"; # a parser switcher
+ }
+ $state = 0;
+ printf FILEOUT "%s", "$inline";
+
+ } elsif ( $inline =~ m/^\s*\@[=t].*$/ ) { # @= detected, just copy the line
+
+ printf FILEOUT "%s", "$inline";
+
+ } elsif ( $inline =~ m/^\@g(.*)$/ ) { # @`other' detected, so `other language' region is over
+
+ if ($state == 1) {
+ printf FILEOUT "\@q%s\@>\n\@t}\\endgsec{\@>\n",
+ "End of generic language section"; # a parser switcher
+ }
+
+ $inline = $1; $state = 0;
+
+ if ( not $inline ) { $inline = "End generic language section"; }
+ printf FILEOUT "\@q%s\@>\n", "$inline";
+
+ } elsif ( $inline =~ m/^\@O(.*)$/ ) { # @O detected, so `other language' region is paused
+
+ $inline = $1; $state = 0;
+
+ if ( not $inline ) { $inline = "End generic language section"; }
+ printf FILEOUT "\@q%s\@>\n", "$inline";
+
+ } elsif ( $inline =~ m/^\@o(.*)$/ ) { # @o detected, so `other language' region is resumed
+
+ $inline = $1; $state = 1;
+
+ if ( not $inline ) { $inline = "End generic language section"; }
+ printf FILEOUT "\@q%s\@>\n", "$inline";
+
+ } elsif ( $state == 1 ) {
+
+ if ( $inline =~ m/\/\*.*\*\/\s*$/ ) {
+
+ $inline =~ m/^(.*\S|)\s*(\/\*.*\*\/)\s*$/;
+ $string = $1; $comment = $2;
+
+ } else {
+
+ $inline =~ m/^(.*)$/;
+ $string = $1; $comment = "";
+
+ }
+
+ if ( $string ) {
+
+ printf FILEOUT "\@=%s\@>\@;", "$string";
+
+ } else {
+
+ printf FILEOUT "\@=%s\@>\@;", " ";
+
+ }
+
+ if ( $comment ) {
+
+ printf FILEOUT "%s", "$comment";
+
+ }
+
+ printf FILEOUT "%s", "\n";
+
+ } else {
+
+ printf FILEOUT "%s", "$inline";
+
+ }
+
+}
diff --git a/support/splint/scripts/cslist.pl b/support/splint/scripts/cslist.pl
new file mode 100755
index 0000000000..d1df62bc07
--- /dev/null
+++ b/support/splint/scripts/cslist.pl
@@ -0,0 +1,40 @@
+for ($i = 0; $i <= $#ARGV; $i++) {
+
+ open FILE, "<$ARGV[$i]" or die "Cannot open file $ARGV[$i]!\n";
+ $filename = $ARGV[$i];
+
+ while(<FILE>) {
+
+ $text = $_;
+
+ while( $text =~ /(\\newcount|\\newtoks|\\newdimen|\\newif|\\let|\\([exg]|char|toks|count)*def)\w*(\\[a-zA-Z@]+)/g ) {
+
+ $cs = $3;
+ push @all, $cs;
+
+ if ( defined $secse{$cs}->{$filename} ) { $secse{$cs}->{$filename}++; }
+ else { $secse{$cs}->{$filename} = 1; };
+
+ }
+
+ }
+}
+#print keys %secse;
+@alphsecs = sort keys %secse;
+
+foreach $ocs (@alphsecs) {
+
+ print "$ocs %";
+ @fnames = sort keys $secse{$ocs};
+ foreach $fname (@fnames) {
+ print " $fname ($secse{$ocs}->{$fname} occurence";
+ if ( $secse{$ocs}->{$fname} > 1 ) {print "s";}
+ print ")";
+ }
+ print "\n";
+}
+
+print "\n";
+$i = $#alphsecs;
+$i++;
+print "total sequences: $i\n";
diff --git a/support/splint/scripts/unline.pl b/support/splint/scripts/unline.pl
new file mode 100755
index 0000000000..5349156cb4
--- /dev/null
+++ b/support/splint/scripts/unline.pl
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+# a simple script to remove comments and #line directives left by CTANGLE
+# this allows one to build Makefiles and linker scripts from inside CWEB
+# by making a few simple changes to the macros (to facilitate typeseting)
+# and using CWEB's @= ... @> facility.
+
+open FILE, "$ARGV[0]" or die "Cannot open input file $ARGV[0]\n";
+open FILEOUT, ">$ARGV[1]" or die "Cannot open output file $ARGV[1]\n";
+
+while (<FILE>) {
+
+ $inline = $_;
+
+ s/^(\#line.*)\n$//g;
+
+ if ( $ARGV[2] != 3 ) {
+
+ s/\/\*.*\*\///g;
+
+ }
+
+ printf FILEOUT "%s", "$_";
+
+# if ( m/^.*\S.*\n$/ ) {
+
+# printf FILEOUT "%s", "$_";
+
+# }
+
+}