diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/splint/scripts |
Initial commit
Diffstat (limited to 'support/splint/scripts')
-rwxr-xr-x | support/splint/scripts/bindx.pl | 101 | ||||
-rwxr-xr-x | support/splint/scripts/brack.pl | 105 | ||||
-rwxr-xr-x | support/splint/scripts/cslist.pl | 40 | ||||
-rwxr-xr-x | support/splint/scripts/unline.pl | 31 |
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", "$_"; + +# } + +} |