From 2fbd4374d56cb17fc400594b016aba0126830e7c Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Tue, 6 Oct 2026 16:47:58 -0700 Subject: [PATCH 01/15] Remove scripts that process only version 1 files; port others to version 2 Co-Authored-By: Claude Opus 5.5 --- doc/CHANGELOG.md | 12 + scripts/auxinfo.pl | 87 ---- scripts/clean-decls.php | 36 -- scripts/convertcsv.pl | 75 ++-- scripts/copy_comparable.pl | 128 ------ scripts/decls-add-cluster.pl | 40 +- scripts/decls-lackwit-disjoint.pl | 127 ------ scripts/decls2comp-1.0.py | 180 --------- scripts/decls2comp.py | 25 +- scripts/dfec-to-kvasir-dtrace.py | 559 ------------------------- scripts/dfec-to-kvasir.py | 573 -------------------------- scripts/dtrace-add-cluster.pl | 5 +- scripts/dtrace-count.pl | 8 +- scripts/dtrace-diff.pl | 23 -- scripts/dtrace-indent.pl | 3 +- scripts/dtrace-rm-decls.php | 49 --- scripts/extract_vars.pl | 71 ++-- scripts/find_comparable.pl | 130 ------ scripts/find_globals.pl | 143 ------- scripts/generate-dec-types.py | 175 -------- scripts/lwpp-init.pl | 86 ---- scripts/lwpp.pl | 650 ------------------------------ scripts/set_decl_type.pl | 94 ----- scripts/sort-dtrace.pl | 21 +- 24 files changed, 151 insertions(+), 3149 deletions(-) delete mode 100755 scripts/auxinfo.pl delete mode 100755 scripts/clean-decls.php delete mode 100755 scripts/copy_comparable.pl delete mode 100755 scripts/decls-lackwit-disjoint.pl delete mode 100755 scripts/decls2comp-1.0.py delete mode 100755 scripts/dfec-to-kvasir-dtrace.py delete mode 100755 scripts/dfec-to-kvasir.py delete mode 100755 scripts/dtrace-rm-decls.php delete mode 100755 scripts/find_comparable.pl delete mode 100755 scripts/find_globals.pl delete mode 100755 scripts/generate-dec-types.py delete mode 100755 scripts/lwpp-init.pl delete mode 100755 scripts/lwpp.pl delete mode 100755 scripts/set_decl_type.pl diff --git a/doc/CHANGELOG.md b/doc/CHANGELOG.md index 6db6daed42..f4c85c249b 100644 --- a/doc/CHANGELOG.md +++ b/doc/CHANGELOG.md @@ -21,6 +21,18 @@ Further documentation can be found in: `make -C $DAIKONDIR/java javadoc` It is also available at . +## Version ?? + +Scripts: + +* `convertcsv.pl` and the cluster analysis scripts (`runcluster.pl` and the + scripts it calls) now write version 2 files. +* Removed scripts that processed only version 1 files: `auxinfo.pl`, + `clean-decls.php`, `copy_comparable.pl`, `decls2comp-1.0.py`, + `decls-lackwit-disjoint.pl`, `dfec-to-kvasir.py`, `dfec-to-kvasir-dtrace.py`, + `dtrace-rm-decls.php`, `find_comparable.pl`, `find_globals.pl`, + `generate-dec-types.py`, `lwpp.pl`, `lwpp-init.pl`, and `set_decl_type.pl`. + ## Version 5.9.0 (September 1, 2026) * All Daikon tools now work with Java 8-26. diff --git a/scripts/auxinfo.pl b/scripts/auxinfo.pl deleted file mode 100755 index ef8366f7e9..0000000000 --- a/scripts/auxinfo.pl +++ /dev/null @@ -1,87 +0,0 @@ -#!/usr/bin/env perl - -## Usage: auxinfo []- - -## Adds the specified aux information to the specified variable. -## If a program point is specified, only the specified variable -## at that program point is modified. Any number of var/auxinfo pairs -## can be specified. - -use English; -use strict; -$WARNING = 1; # "-w" flag -my $debug = 0; -my @vars; -my @auxs; -my $line; -my @dfile; - -#process arguments -while (@ARGV) { - push @vars, shift @ARGV; - push @auxs, shift @ARGV; -} - -#read the whole file (its usually not too long) into an array -while ($line = ) { - push @dfile, ($line); - chomp ($dfile[$#dfile]); -} - -#process each var/aux pair -while (@vars) { - my $var = shift @vars; - my $aux = shift @auxs; - my $ppt; - if ($var =~ "-") { - ($ppt, $var) = split (/-/, $var); - } else { - $ppt = "."; - } - if ($debug) { - print STDERR "processing $ppt - $var ($aux)\n"; - } - - #loop through the decls looking for matches - for (my $i = 0; $i <= $#dfile; $i++) { - $line = $dfile[$i]; - if ($line eq "DECLARE") { - $line = $dfile[++$i]; - if (!($line =~ /$ppt/)) { - next; - } - if ($debug) { - print STDERR "found matching ppt: $line\n"; - } - $line = $dfile[++$i]; - while ($line && $line ne "\n") { - my $varname = $line;; - my $type = $dfile[++$i]; - my $rep = $dfile[++$i]; - my $comp = $dfile[++$i]; - $line = $dfile[++$i]; - if ($debug) { - print STDERR "looking $varname | $type | $rep | $comp\n"; - } - if ($varname eq $var) { - if ($debug) { - print STDERR "FOUND $varname | $type | $rep | $comp\n"; - } - if ($type =~ /#/) { - $type .= ", $aux"; - } else { - $type .= " # $aux"; - } - if ($debug) { - print STDERR "New type = $type\n"; - } - $dfile[$i-3] = $type - } - } - - } - } -} -foreach $line (@dfile) { - print "$line\n"; -} diff --git a/scripts/clean-decls.php b/scripts/clean-decls.php deleted file mode 100755 index 80ec074427..0000000000 --- a/scripts/clean-decls.php +++ /dev/null @@ -1,36 +0,0 @@ -#! /usr/bin/env php -; - if ($declare ne "DECLARE\n") { - die "Didn't see \"DECLARE\" as first line of declaration file $inputfile"; - } - my $ppt = ; - chomp($ppt); - my $i = 0; + my $ppt; my @varnames; - my @varDecType; - my @varActType; - my @varComparable; while () { - chomp($_); - $varnames[$i] = $_; - $varDecType[$i] = ; - $varActType[$i] = ; - $varComparable[$i] = ; - $i++; + if (/^ppt\s+(\S+)\s*$/) { + if (defined($ppt)) { + die "Declaration file $inputfile contains more than one program point"; + } + $ppt = unescapeDecl($1); + } elsif (/^\s*variable\s+(\S+)\s*$/) { + push @varnames, unescapeDecl($1); + } } close(DECLHANDLE); + if (!defined($ppt)) { + die "Didn't see a \"ppt\" record in declaration file $inputfile"; + } return ($ppt, @varnames); } @@ -263,7 +274,7 @@ () die("Could not open $dtrace_file for output."); for (my $k = 0; $k < $num_samples; $k++) { - print DTRACEHANDLE "\n$programpointname\n"; + print DTRACEHANDLE "\n" . escapeDecl($programpointname) . "\n"; for (my $j = 0; $j < $num_decl_vars; $j++) { my $csvindex = $varNameCsvIndex{$decl_varnames[$j]}; if ($variableArray{$csvindex}[$k] eq "") { @@ -300,7 +311,7 @@ () $variableArray{$csvindex}[$k] = $prevvalues[$csvindex]; } } - print DTRACEHANDLE "$csv_varnames[$csvindex]\n"; + print DTRACEHANDLE escapeDecl($csv_varnames[$csvindex]) . "\n"; print DTRACEHANDLE "$variableArray{$csvindex}[$k]\n"; print DTRACEHANDLE "1\n"; } @@ -382,7 +393,7 @@ ( $ ) } } - print DTRACEHANDLE "$programpointname\n"; + print DTRACEHANDLE escapeDecl($programpointname) . "\n"; for (my $j = 0; $j<$num_decl_vars; $j++) { my $csvindex = $varNameCsvIndex{$decl_varnames[$j]}; my $value = $sample[$csvindex]; @@ -416,7 +427,7 @@ ( $ ) $variableArray{$csvindex}[$num_samples] = $value; } } - print DTRACEHANDLE "$csv_varnames[$csvindex]\n"; + print DTRACEHANDLE escapeDecl($csv_varnames[$csvindex]) . "\n"; print DTRACEHANDLE "$value\n"; print DTRACEHANDLE "$modbit\n"; } @@ -426,16 +437,18 @@ ( $ ) } if (defined($decls_file)) { - print DECLSHANDLE "DECLARE\n$programpointname\n"; + print DECLSHANDLE "decl-version 2.0\n"; + print DECLSHANDLE "var-comparability none\n\n"; + print DECLSHANDLE "ppt " . escapeDecl($programpointname) . "\n"; + print DECLSHANDLE " ppt-type point\n"; for (my $j = 0; $j<$num_decl_vars; $j++) { my $csvindex = $varNameCsvIndex{$decl_varnames[$j]}; - print DECLSHANDLE "$csv_varnames[$csvindex]\n"; - if ($isNumber[$csvindex]) { - print DECLSHANDLE "double\ndouble\n"; - } else { - print DECLSHANDLE "java.lang.String\njava.lang.String\n"; - } - print DECLSHANDLE "1\n"; + my $type = ($isNumber[$csvindex] ? "double" : "java.lang.String"); + print DECLSHANDLE " variable " . escapeDecl($csv_varnames[$csvindex]) . "\n"; + print DECLSHANDLE " var-kind variable\n"; + print DECLSHANDLE " dec-type $type\n"; + print DECLSHANDLE " rep-type $type\n"; + print DECLSHANDLE " comparability 1\n"; } } diff --git a/scripts/copy_comparable.pl b/scripts/copy_comparable.pl deleted file mode 100755 index b669acbd43..0000000000 --- a/scripts/copy_comparable.pl +++ /dev/null @@ -1,128 +0,0 @@ -#!/usr/bin/env perl - -## Usage: copy_comparable.pl < input_decls_file > output_decls_file -## -template [-prefix ] -## -## Copies global comparability information from one ppt to others. -## Used when the comparability information is incorrect at some points. -## Locals are set to -1 (comparable to everything). -## - -use English; -use strict; -$WARNING = 1; # "-w" flag -my $debug = 0; -my $verbose = 1; -my @vars; -my @new_types; -my $line; -my @dfile; -my $global_prefix = "::"; -my $globals_only = 0; -my $out_file = 1; -my $template = ""; - -#process arguments -while (@ARGV) { - my $arg = shift @ARGV; - if ($arg eq "-prefix") { - $global_prefix = shift @ARGV; - } elsif ($arg eq "-template") { - $template = shift @ARGV; - } else { - print "Unknown argument $arg"; - exit; - } -} - -#read the whole file (its usually not too long) into an array -while ($line = ) { - push @dfile, ($line); - chomp ($dfile[$#dfile]); -} - -# indexed by varname, value is number of occurrences -my %globals; -my %info; -my %mismatch_cnt; -my $exit_cnt = 0; -my @keys; -my $global_name = ""; - -#loop through the decls looking for the specified template ppt -for (my $i = 0; $i <= $#dfile; $i++) { - $line = $dfile[$i]; - if ($line eq "DECLARE") { - $line = $dfile[++$i]; - if (!($line =~ /EXIT[0-9]/)) { - next; - } - my $ppt = $line; - if ($line =~ /$template/) { - print STDERR "found template ppt: $ppt\n"; - } else { - next; - } - - # get the next variable - $line = $dfile[++$i]; - while ($line && $line ne "\n") { - my $varname = $line;; - my $type = $dfile[++$i]; - my $rep = $dfile[++$i]; - my $comp = $dfile[++$i]; - $line = $dfile[++$i]; - #if ($debug) { - # print STDERR "looking $varname | $type | $rep | $comp\n"; - #} - if ($varname !~ /^$global_prefix/) { - next; - } - - $globals{$varname} = "$type : $rep : $comp"; - } - } -} - -# Loop through the file again and replace the comparablity info with -# that from the specified point -#loop through the decls looking for the specified template ppt -for (my $i = 0; $i <= $#dfile; $i++) { - $line = $dfile[$i]; - if ($line eq "DECLARE") { - $line = $dfile[++$i]; - #if (!($line =~ /EXIT[0-9]/)) { - # next; - #} - my $ppt = $line; - if ($line =~ /$template/) { - next; - } - - # get the next variable - $line = $dfile[++$i]; - while ($line && $line ne "\n") { - my $varname = $line;; - my $type = $dfile[++$i]; - my $rep = $dfile[++$i]; - my $comp = $dfile[++$i]; - $line = $dfile[++$i]; - #if ($debug) { - # print STDERR "looking $varname | $type | $rep | $comp\n"; - #} - if ($globals{$varname}) { - ($type, $rep, $comp) = split (/ : /, $globals{$varname}); - $dfile[$i-1] = $comp; - } elsif ($varname =~ /^$global_prefix/) { - print STDERR "$varname not found in template in $ppt\n"; - } else { # must be local, make comparable to all - $dfile[$i-1] = "-1"; - } - } - } -} - -# write the file back out -foreach $line (@dfile) { - print "$line\n"; -} diff --git a/scripts/decls-add-cluster.pl b/scripts/decls-add-cluster.pl index 38f4944469..a6b253128a 100755 --- a/scripts/decls-add-cluster.pl +++ b/scripts/decls-add-cluster.pl @@ -19,16 +19,46 @@ open (IN, $decls_file) || die "couldn't open $decls_file for input\n"; open (OUT, ">$decls_cluster") || die "couldn't open $decls_cluster for output\n"; + # True if the current program point declaration still needs the + # cluster variable. The cluster variable must precede the other + # variables, but must follow the ppt-level records such as ppt-type. + my $pending = 0; + # The "parent"-type parent records of the current program point, as + # " " strings. The cluster variable is + # linked to the cluster variable of each such parent, so that, for + # example, an OBJECT program point gets cluster values from its methods. + my @parents = (); while () { my $line = $_; + if ($pending && ($line =~ /^\s*variable\s/ || $line =~ /^\s*$/)) { + print_cluster_var(@parents); + $pending = 0; + } print OUT $line; - if ($line =~ /:::/) { - print OUT "cluster\n"; - print OUT "int\n"; - print OUT "int\n"; - print OUT "22\n"; + if ($line =~ /^ppt /) { + $pending = 1; + @parents = (); + } elsif ($pending && $line =~ /^\s*parent\s+parent\s+(\S+)\s+(\S+)\s*$/) { + push @parents, "$1 $2"; } } + if ($pending) { + print_cluster_var(@parents); + } close IN; close OUT; } + +# Prints the declaration of the cluster variable. The arguments are the +# " " strings for the program point's parents. +sub print_cluster_var { + my (@parents) = @_; + print OUT " variable cluster\n"; + print OUT " var-kind variable\n"; + print OUT " dec-type int\n"; + print OUT " rep-type int\n"; + print OUT " comparability 22\n"; + foreach my $parent (@parents) { + print OUT " parent $parent\n"; + } +} diff --git a/scripts/decls-lackwit-disjoint.pl b/scripts/decls-lackwit-disjoint.pl deleted file mode 100755 index a13d083a2e..0000000000 --- a/scripts/decls-lackwit-disjoint.pl +++ /dev/null @@ -1,127 +0,0 @@ -#!/usr/bin/env perl - -# Checks that all the explicit lackwit comparability classes are -# disjoint at each program point. This guarantees that the -# comparability relationship is transitive. - -# Could also check that the explicit comparability classes are -# exhaustive. That is, each variable at the program point must be in -# exactly one comparability class. However, this isn't a problem -# we've been seeing, so this check isn't implemented. - -# Note: We don't need this script so much anymore, since the new -# lwpp.pl design guarantees disjoint sets. However, this script is -# still a good sanity check, to make sure lwpp.pl is working -# correctly. - -use English; -use strict; -$WARNING = 1; - -my $element_suffix = "_element"; -my $index_suffix = "_index"; -my $dummy_return = "lh_return_value"; - -if (@ARGV != 1) { - die "Usage: decls-lackwit-consistent.pl \n"; -} - -my ($decls) = @ARGV; --f $decls or die "$decls is not a file\n"; - -open DECLS, $decls or die "can't open $decls\n"; - -my $first_line = ; -chomp $first_line; -my $second_line = ; -chomp $second_line; -if (! (($first_line eq "VarComparability") && ($second_line eq "implicit"))) { - die "Invalid declaration file. Perhaps it was not processed by lackwit.\n"; -} - -# maps implicit types (an integer) to explicit types (hash of -# comparable types) -my %implicit_to_explicit = (); - -# fill the map of implicit to explicit types, from the comments at the -# end of the decls file -while () { - chomp; - if ($_ eq "# Implicit Type to Explicit Type") { - while () { - chomp; - s/\#//; - my ($implicit_type, $colon, @explicit_types) = split; - my %explicit_types = (); - foreach my $x (@explicit_types) { - $explicit_types{$x} = 1; - } - $implicit_to_explicit{$implicit_type} = \%explicit_types; - } - } -} - -# go to the start of the file -seek(DECLS, 0, 0); - -my $error = 0; - -while () { - next if /^\#/; #skip comments - - if (/DECLARE/) { - # All of the implicit types at this program point - my @implicit_types = (); - - my $ppt_declaration = ; - chomp $ppt_declaration; - while (1) { - my $var = ; - last if ((!$var) || ($var =~ /^\s+$/)); - my $declared_type = ; - my $rep_type = ; - my $implicit = ; - chomp $implicit; - - if ($implicit =~ /^(\d+)\[(\d+)\]$/) { - push @implicit_types, $1; - push @implicit_types, $2; - } elsif ($implicit =~ /^\d+$/) { - push @implicit_types, $implicit; - } else { - die "invalid implicit type: $implicit\n"; - } - } - - foreach my $imp1 (@implicit_types) { - foreach my $imp2 (@implicit_types) { - next if ($imp1 == $imp2); - my $explicit; - if (common_key($implicit_to_explicit{$imp1}, - $implicit_to_explicit{$imp2}, \$explicit)) { - print "$ppt_declaration\nexplicit type \"$explicit\" " . - "in multiple implicit types: $imp1, $imp2\n\n"; - $error = 1 - } - } - } - } -} - -if ($error) { - exit 1; -} - - -# returns true if two hashes have a common key, false otherwise -# the common key is placed into $keyref -sub common_key { - my ($hashref1, $hashref2, $key_ref) = @_; - foreach my $key (keys %{$hashref1}) { - if (exists $hashref2->{$key}) { - $$key_ref = $key; - return 1; - } - } - return 0; -} diff --git a/scripts/decls2comp-1.0.py b/scripts/decls2comp-1.0.py deleted file mode 100755 index 8e0271819d..0000000000 --- a/scripts/decls2comp-1.0.py +++ /dev/null @@ -1,180 +0,0 @@ -#!/usr/bin/python3 - -"""Converts a .decls file to a file organized by variable comparability sets at each program point. - -The input is a .decls file with comparability numbers. -This helps with automating regression tests of DynComp. - -Input: .decls file with comparability numbers - -Output: A file which lists the comparability sets of all relevant -variables at each program point, alphabetically sorted and separated -by spaces. All program points are also sorted by alphabetical -order. Output is written to stdout by default - -Usage: ./decls2comp.py input.decls 'no-hashcodes' [optional] -Running this with the 'no-hashcodes' string as the 2nd arg results -in the tool ignoring all variables of rep. type 'hashcode' or -'hashcode[]', etc... - -Prog pt name -All variable names in one comp set -All variable names in another comp set -... - - -Input: - -DECLARE -..add():::ENTER -a -int # isParam=true -int -1 -b -int # isParam=true -int -1 -c -int # isParam=true -int -2 -d -int # isParam=true -int --1 - -Output: - -..add():::ENTER -a b -c --1: d - -Note: Lackwit produces comparability numbers for arrays in the -following format: '9[10]' - we are going to ignore what is between -the brackets so we will treat it as '9'. -""" - -import re -import sys -from pathlib import Path - -LWArrayRExp = re.compile(r"\[.\]") - -ignore_hashcodes = False - -if (len(sys.argv) == 3) and sys.argv[2] == "no-hashcodes": - ignore_hashcodes = True - -# If 'no-hashcodes' option is on, then ignore all variables whose -# rep. type is hashcode -hashcode_re = re.compile(r"hashcode.*") - - -# Break each program point declaration up into separate lists. -# Program points are separated by "DECLARE" statements -# Key: program point name -# Value: list of all strings following program point -all_ppts: dict[str, list[str]] = {} - -temp_all_ppts: list[list[str]] = [] # Temporary before placing in all_ppts - -is_intermediate = 0 - -with Path(sys.argv[1]).open() as f: - for line in f: - line = line.strip() - - if line == "DECLARE": - temp_all_ppts.append([]) # Start a new list - is_intermediate = 0 - elif line == "INTERMEDIATE DECLARE": - temp_all_ppts.append([]) # Start a new list - is_intermediate = 1 - elif line != "" and line[0] != "#": # Don't add blank lines & comments - if len(temp_all_ppts) > 0: - temp_all_ppts[-1].append(line) # Append line to the latest entry - - -# Init all_ppts from temp_all_ppts -for ppt_list in temp_all_ppts: - # Allow duplicates by appending numeric indices onto program point - # name - index = 1 - - ppt_name = ppt_list[0] - - # There is already an entry - if ppt_list[0] in all_ppts: - # Try appending numbers until there isn't an entry - found = 1 - while found: - ppt_name = ppt_list[0] + " (" + str(index) + ")" - if ppt_name not in all_ppts: - break - index += 1 - - all_ppts[ppt_name] = ppt_list[1:] - -# Alphabetically sort the program points -sorted_ppt_keys = sorted(all_ppts.keys()) - -# Process each PPT -for ppt_name in sorted_ppt_keys: - v = all_ppts[ppt_name] - i = 0 - var2comp = {} # Key: variable name, Value: comparability number - - # All info. about variables at a program point come in sets of 4 - # lines. e.g. - # - # a - # int # isParam=true - # int - # 1 - while i < len(v): - cur_rep_type = v[i + 2] - cur_comp = v[i + 3] - - if (not ignore_hashcodes) or (not hashcode_re.match(cur_rep_type)): - is_array_match = LWArrayRExp.search(cur_comp) - if is_array_match: - var2comp[v[i]] = cur_comp[: is_array_match.start()] - else: - var2comp[v[i]] = cur_comp - - i += 4 - - # Now we can do the real work of grouping variables together - # in comparability sets based on their numbers - sorted_vars = sorted(var2comp.keys()) - - print(ppt_name) - - while len(sorted_vars) > 0: - var_name = sorted_vars[0] - - # if var2comp[var_name] == '-1': # Remember that everything is a string - # print '-1:', var_name, - # else: - print(var_name, end=" ") - - comp_num = var2comp[var_name] - - if comp_num: - del var2comp[var_name] - - sorted_vars = sorted(var2comp.keys()) - - for other_var in sorted_vars: - if var2comp[other_var] == comp_num: - print(other_var, end=" ") - del var2comp[other_var] - print() - - # Update sorted_vars after deleting the appropriate entries - # from var2comp - sorted_vars = sorted(var2comp.keys()) - - print() diff --git a/scripts/decls2comp.py b/scripts/decls2comp.py index 96bb08e9ca..ffe32ceb95 100755 --- a/scripts/decls2comp.py +++ b/scripts/decls2comp.py @@ -51,31 +51,12 @@ dec-type int comparability -1 -DECLARE -..add():::ENTER -a -int # isParam=true -int -1 -b -int # isParam=true -int -1 -c -int # isParam=true -int -2 -d -int # isParam=true -int --1 - Output: -..add():::ENTER +..returnIntSum():::ENTER a b c --1: d +d """ import re @@ -107,7 +88,7 @@ # Break each program point declaration up into separate lists. -# Program points are separated by "DECLARE" statements +# Each program point declaration starts with a "ppt" record # Key: program point name # Value: list of all strings following program point all_ppts = {} diff --git a/scripts/dfec-to-kvasir-dtrace.py b/scripts/dfec-to-kvasir-dtrace.py deleted file mode 100755 index f01498b85d..0000000000 --- a/scripts/dfec-to-kvasir-dtrace.py +++ /dev/null @@ -1,559 +0,0 @@ -#!/usr/bin/python3 - -"""Outputs a Kvasir-compatible .dtrace file from a Dfec .dtrace file. - -Outputs a Kvasir-compatible .dtrace file from the Dfec .dtrace file -based on the variables and ordering in the Kvasir .decls file. - -Usage: ./dfec-to-kvasir-dtrace.py - -Cannibalized from dfec-to-kvasir.py so most of these comments -will make absolutely no sense!!! -""" - -import re -import sys -from enum import Enum -from pathlib import Path - -# Process command-line args: -with Path(sys.argv[1]).open() as kvasir_decls_f: - kvasir_decls_all_lines = [line.strip() for line in kvasir_decls_f] - - -DfecGlobalRE = re.compile(r"^::") - -# Dfec and Kvasir variable differences: - -# Globals are prefixed with a '::' in Dfec -# and with a '/' in Kvasir - -# Dfec doesn't append the filename in front of -# file-static global variables like Kvasir does - -# Dfec also doesn't print out function-static variables -# while Kvasir does - -# Dfec derives two Daikon variables for strings -# one for the pointer and the other for the contents, -# while Kvasir only has one for the contents. - -# Dfec uses the arrow notation for struct names while -# Kvasir uses the bracket notation (unless disambiguation -# information is provided) - - -def convert_dfec_var_name(var: str) -> str: - """Convert variable var's name from Dfec conventions to Kvasir conventions. - - Args: - var: the variable's name in Dfec form. - - Returns: - the variable's name in Kvasir form. - """ - global_converted = DfecGlobalRE.sub("/", var) - return global_converted.replace("->", "[].") - - -def convert_kvasir_var_name(var: str) -> str: - """Strip off everything before the '/', if there is one. - - Dfec does not print out the function name for function-static variables, - e.g., 'flex_c@epsclosure/did_stk_init' becomes '/did_stk_init'. - - Args: - var: a string - - Returns: - The string starting after the '/', or the whole string. - """ - if var[0] == "/": - return var - if "/" in var: - return "/" + var.split("/", maxsplit=1)[1] - return var - - -def strip_comp_number(comp_num: str) -> str: - """Kvasir does not support comparability for array indices so strip those off. - - e.g. '104[105]' becomes '104'. - - Args: - comp_num: a comparability, possibly in array form - - Returns: - the comparability without the array part - """ - if "[" in comp_num: - return comp_num[: comp_num.find("[")] - return comp_num - - -# Dfec and Kvasir program point name differences: - -# Global program point names in Dfec are prefixed by 'std.' -# while they are prefixed by '..' in Kvasir - -# Dfec uses 'EXIT1' while Kvasir uses 'EXIT0' for the exit -# so we should probably simply search for 'EXIT' without -# regard to the number behind it. However, Dfec can have -# more than 1 exit while Kvasir can only have 1. Hmmm, -# what do we do about that? -# (Right now, we just keep 'EXIT' without the number before -# putting it in the hashtable. Thus, only one EXIT ppt -# is kept for each function ... I'm just not sure which -# one, though, but that's ok) - -# Dfec's names for C functions have crap in between the parens -# while Kvasir's doesn't. Let's just not worry about what's -# in the parens since C doesn't have overloading. We just want -# to strip off the canonical function name. - - -def strip_dfec_ppt_name(ppt: str) -> tuple[str, str]: - """Strip the extraneous stuff off of Dfec's names and split into parts. - - Input: 'std.ccladd(int;int;)void:::ENTER' - Output: ('ccladd', 'ENTER') - - Args: - ppt: a dfec program point name - - Returns: - a 2-tuple of cleaned ppt name and either 'ENTER' or 'EXITxxx' - """ - fnname, enter_or_exit = ppt.split(":::") - if fnname[:4] == "std.": - fnname = fnname[4:] - # Find the first '(' and end the function name there - fnname = fnname[: fnname.index("(")] - - # Just return 'ENTER' or 'EXIT' with no numbers - # (This means that we can only keep one exit ppt) - if enter_or_exit[1] == "N": - enter_or_exit = "ENTER" - else: - enter_or_exit = "EXIT" - - # Return a pair of the function name and 'ENTER' or 'EXITxxx' - return (fnname, enter_or_exit) - - -def strip_kvasir_ppt_name(ppt: str) -> tuple[str, str]: - """Strip the extraneous stuff off of Kvasir's names and split into parts. - - Args: - ppt: a Kvasir program point name - - Returns: - a 2-tuple of cleaned ppt name and either 'ENTER' or 'EXITxxx' - """ - fnname, enter_or_exit = ppt.split(":::") - - # For globals, grab everything from '..' to '(' - # e.g. for '..main():::ENTER' - # we want 'main' - if fnname[:2] == "..": - fnname = fnname[2 : fnname.find("(")] - - # For file-static names, we need to take everything between - # the LAST period ('.') and the '(' - # e.g. for 'flex.c.yy_push_state():::EXIT0', - # we want 'yy_push_state' - else: - fnname = fnname[fnname.rfind(".") + 1 : fnname.find("(")] - - # Just return 'ENTER' or 'EXIT' with no numbers - # (This means that we can only keep one exit ppt) - if enter_or_exit[1] == "N": - enter_or_exit = "ENTER" - else: - enter_or_exit = "EXIT" - - # Return a pair of the function name and 'ENTER' or 'EXITxxx' - return (fnname, enter_or_exit) - - -# .decls States: -# About to read in ... -# 0 = Nothing important -# 1 = program point name -# 2 = variable name -# 3 = variable declared type -# 4 = variable rep. type -# 5 = variable comparability number - VERY important -class DeclsState(Enum): - """The parse state: what is about to be read.""" - - Uninit = 0 - PptName = 1 - VarName = 2 - DecType = 3 - RepType = 4 - CompNum = 5 - - -cur_var_map = 0 # The current variable map -cur_var_name = "" - -# Key: program point name (stripped using strip_kvasir_ppt_name) -# Value: A list of 2 elts: car: full ppt name -# cdr: A list of lists, -# where each sub-list is: [variable name, rep. type] -kvasir_ppt_map = {} - -# The current parse state. -my_state = DeclsState.Uninit - -cur_var_list: list[list[str]] = [] -for line in kvasir_decls_all_lines: - if my_state == DeclsState.Uninit: - # The program point name always follows the line called "DECLARE". - if line == "DECLARE": - my_state = DeclsState.PptName - - elif my_state == DeclsState.PptName: - cur_var_list = [] - kvasir_ppt_map[strip_kvasir_ppt_name(line)] = [line, cur_var_list] - my_state = DeclsState.VarName - - elif my_state == DeclsState.VarName: - if line == "DECLARE": - my_state = DeclsState.PptName - elif line == "": - my_state = DeclsState.Uninit - else: - cur_var_list.append([]) - cur_var_list[-1].append(line) - my_state = DeclsState.DecType - - elif my_state == DeclsState.DecType: - # cur_var_list[-1].append(line) - my_state = DeclsState.RepType - - elif my_state == DeclsState.RepType: - cur_var_list[-1].append(line) - my_state = DeclsState.CompNum - - elif my_state == DeclsState.CompNum: - # cur_var_list[-1].append(line) - - # Assume we are going to read another variable. - # When we actually read the subsequent line, - # we'll branch according to whether it's a real - # variable or another thing - my_state = DeclsState.VarName - - -def process_ppt(ppt_name: str, var_info: dict[str, list[str]]) -> None: - """Print out the Kvasir version of the name. - - Does nothing if this ppt is not in the Kvasir .decls file. - """ - stripped = strip_dfec_ppt_name(ppt_name) - - if stripped in kvasir_ppt_map: - print(kvasir_ppt_map[stripped][0]) - - # Iterate through all variables in .decls file (to preserve - # order) and print out the corresponding entries in the .dtrace - # file: - var_list = kvasir_ppt_map[stripped][1] - for var_entry in var_list: - var_name = var_entry[0] - rep_type = var_entry[1] - - # Try to look up var_name in the var_info dict., remembering - # the differences between Kvasir and Dfec names: - - # If rep_type == "java.lang.String", then look - # up the entry for the variable + '[]' because - # Dfec has separate variables for the pointer - # and content of strings - var_to_lookup = var_name - if "java.lang.String" in rep_type: - var_to_lookup += "[]" - - var_to_lookup = convert_kvasir_var_name(var_to_lookup) - - if var_to_lookup in var_info: - stuff = var_info[var_to_lookup] - print(var_name) - - if ( - rep_type[-2:] == "[]" - and stuff[0][0] != "[" - and stuff[0] != "uninit" - and stuff[0] != "nonsensical" - ): - print("[", stuff[0], "]") - else: - print(stuff[0]) - - print(stuff[1]) - # Total cop out ... print blank - else: - print(var_name) - - print("uninit") - - print("2") - - # Blank line ends this ppt - print() - - -# .dtrace States: -# About to read in ... -# 0 = program point name or junk (uninit) -# 1 = variable name -# 2 = value -# 3 = modbit -# 4 = Ignore nonce -class DtraceState(Enum): - """The parse state: what is about to be read.""" - - Uninit = 0 - VarName = 1 - Value = 2 - Modbit = 3 - IgnoreNonce = 4 - - -dt_state = DtraceState.Uninit - -cur_ppt_name = "DUMMY PPT NAME" -# For current program point only: -# Key: Variable name (after running through convert_dfec_var_name()) -# Value: list of 2 elts: [value, modbit] -# TODO: Change value from list to tuple? -var_info: dict[str, list[str]] = {} - -cur_var_name = "DUMMY VAR NAME" -cur_var_info: list[str] = [] - -# This is shorthand for xreadlines so that it doesn't have to read the -# entire file in at once, which is crucial for huge examples: -with Path(sys.argv[2]).open() as lines: - for line in lines: - line = line.strip() - - if dt_state == DtraceState.Uninit: - # Match program point name with ':::ENTER' or ':::EXIT' - if ":::ENTER" in line or ":::EXIT" in line: - cur_ppt_name = line - dt_state = DtraceState.VarName - - elif dt_state == DtraceState.IgnoreNonce: - dt_state = DtraceState.VarName - - elif dt_state == DtraceState.VarName: - if line == "this_invocation_nonce": - dt_state = DtraceState.IgnoreNonce - elif line == "": - # We've reached the end of a ppt entry!!! - # So process it - process_ppt(cur_ppt_name, var_info) - - cur_ppt_name = "DUMMY PPT NAME" - var_info = {} - - dt_state = DtraceState.Uninit - else: - cur_var_name = line - cur_var_info = [] - dt_state = DtraceState.Value - - elif dt_state == DtraceState.Value: - cur_var_info.append(line) - dt_state = DtraceState.Modbit - - elif dt_state == DtraceState.Modbit: - cur_var_info.append(line) - var_info[convert_dfec_var_name(cur_var_name)] = cur_var_info - cur_var_name = "DUMMY VAR NAME" - cur_var_info = [] - dt_state = DtraceState.VarName - - -# result_map = {} - -# for ppt in kvasir_ppt_map: -## stripped = strip_kvasir_ppt_name(ppt) -## if stripped in dfec_ppt_map: -## KvasirVarList = kvasir_ppt_map[ppt] -## DfecVarMap = dfec_ppt_map[stripped] - -### print "KvasirVarList:" -### print KvasirVarList -### print "DfecVarMap:" -### print DfecVarMap -### print -### print - -## cur_result_var_list = [] - -### print ppt - -## # Now iterate through the Kvasir variable list: -## for entry in KvasirVarList: -## var = entry[0] -## dec_type = entry[1] -## rep_type = entry[2] -## kvasir_comp_num = entry[3] -## dec_type_comp_num = entry[4] - -## # If rep_type == "java.lang.String", then look -## # up the entry for the variable + '[]' because -## # Dfec has separate variables for the pointer -## # and content of strings -## var_to_lookup = var -## if rep_type == "java.lang.String": -## var_to_lookup += '[]' - -## var_to_lookup = convert_kvasir_var_name(var_to_lookup) - -## if var_to_lookup in DfecVarMap: -## # Throw the comparability number on the end -## # of the entry for that variable - -## # Make this a tuple 'cause it should be immutable: -## # Each entry should be the following: -## # (variable name, dec. type, rep. type, -## # (Lackwit comp. num, Kvasir comp. num, dec. type comp num) -## cur_result_var_list.append((var, dec_type, rep_type, -## (DfecVarMap[var_to_lookup], -## kvasir_comp_num, -## dec_type_comp_num))) -## if DfecVarMap[var_to_lookup] == "": -## print "EMPTY COMP. NUMBER!", var, var_to_lookup - -## # Only for debugging -### DfecVarMap.pop(var_to_lookup) - -## result_map[ppt] = cur_result_var_list - -### This is important to see how much of the intersection between -### Dfec and Kvasir variables that we've successfully picked up: - -### print "Leftovers", DfecVarMap.keys() -### print "# vars in Dfec: ", len(DfecVarMap.keys()) -### print "# vars in Kvasir:", len(KvasirVarList) -### print "# vars in result:", len(cur_result_var_list) -### print - -### Output the resulting .decls file and the var list file: - -### Globals section ... let's just take the first program point and use -### the global vars in that one for the globals section. This makes the -### assumption that the same global variables appear everywhere at all -### program points ... will have to investigate further later ... - -# output_vars_f.write("----SECTION----\n") -# output_vars_f.write("globals\n") - -# example_var_list = result_map[kvasir_ppt_names[0]] - -# for var_entry in example_var_list: -## if '/' in var_entry[0]: # only print out globals and file-statics -## output_vars_f.write(var_entry[0]) -## output_vars_f.write("\n") - -# output_vars_f.write("\n") - - -### Filter kvasir_ppt_names to remove any program points that are NOT -### in the Dfec-generated .decls file: -# kvasir_ppt_names = [name for -## name in kvasir_ppt_names -## if (strip_kvasir_ppt_name(name) in dfec_ppt_map)] - - -### - -# output_no_comp_decls_f.write("VarComparability\nnone\n\n"); - - -# all_decls_files = [output_lackwit_decls_f, -## output_dyn_comp_decls_f, -## output_dec_types_decls_f, -## output_no_comp_decls_f] - -### Output the various .decls files -### (Read these names from kvasir_ppt_names to preserve ordering) -# for ppt in kvasir_ppt_names: - -## for f in all_decls_files: -## f.write("DECLARE\n") -## f.write(ppt) -## f.write("\n") - -## # Only print the :::EXIT program point to the var list file -## # because then we can grab the return value 'return' - -## # Remember that we need to print program points in the form of -## # '..main()' and NOT '..main():::ENTER' and '..main():::EXIT0' -## is_exit = False - -## fnname, enter_or_exit = ppt.split(':::') -## if enter_or_exit[:4] == "EXIT": -## is_exit = True - -## if is_exit: -## output_vars_f.write("----SECTION----\n") -## output_vars_f.write(fnname) -## output_vars_f.write("\n") - -## for var_entry in result_map[ppt]: - -## for f in all_decls_files: -## # Variable name -## f.write(var_entry[0]) -## f.write("\n") - -## # Declared type -## f.write(var_entry[1]) -## f.write("\n") - -## # Representation type -## f.write(var_entry[2]) -## f.write("\n") - -## # Comparability number - this is where the action is! -## # For Lackwit, we choose the car of the tuple, -## output_lackwit_decls_f.write(var_entry[3][0]) -## # For DynComp, we choose the cadr -## output_dyn_comp_decls_f.write(var_entry[3][1]) -## # For dec. type, we choose the caddr -## output_dec_types_decls_f.write(str(var_entry[3][2])) -## # For no comparability, simply print out '22' -## output_no_comp_decls_f.write("22") - -## for f in all_decls_files: -## f.write("\n") - -## # Don't print out globals or file-static vars in the -## # var-list-file for individual program points -## if is_exit and not ('/' in var_entry[0]): -## output_vars_f.write(var_entry[0]) -## output_vars_f.write("\n") - -## # Newline separating neighboring program points -## for f in all_decls_files: -## f.write("\n") - -## if is_exit: -## output_vars_f.write("\n") - - -# print '# Dfec ppts:', len(dfec_ppt_map.keys()) -# print '# Kvasir ppts:', len(kvasir_ppt_map.keys()) -# print '# Common ppts:', len(result_map.keys()) - - -# for f in all_decls_files: -# f.close() - -# output_vars_f.close() diff --git a/scripts/dfec-to-kvasir.py b/scripts/dfec-to-kvasir.py deleted file mode 100755 index 14b969234e..0000000000 --- a/scripts/dfec-to-kvasir.py +++ /dev/null @@ -1,573 +0,0 @@ -#!/usr/bin/python3 - -"""Convert Dfec-generated .decls data with Lackwit comparability information into Kvasir form. - -Then, we don't have to run Dfec at all. - -Takes a .decls file that Dfec produced (with Lackwit comparability), -a .decls file that Kvasir produced (with DynComp comparability), and -outputs 4 .decls file that contain the intersection of Dfec and -Kvasir program points and variables in a format that is compatible -with Kvasir: - -kvasir-with-lackwit.decls: comparability numbers from Lackwit -kvasir-with-dyncomp.decls: comparability numbers from DynComp -kvasir-with-declared-types.decls: comparability numbers inferred from declared types -kvasir-no-comp.decls: no comparability numbers (this is the same thing that - --var-list-file=intersection.vars would generate) - -and outputs a variable list file (intersection.vars) so that Kvasir -can be run and trace data can be collected only for those variables. -""" - -import re -import sys -from enum import Enum -from pathlib import Path - -"""Takes in 7 filenames as params. The first 2 files are inputs and the latter 5 are outputs. - -Usage: -./Lackwit2DynComp.py dfec-produced.decls kvasir-produced.decls \ - kvasir-with-lackwit.decls kvasir-with-dyncomp.decls \ - kvasir-with-declared-types.decls kvasir-no-comp.decls intersection.vars - -If everything goes correctly, kvasir-with-lackwit.decls and -kvasir-with-dyncomp.decls should only differ in their comparability -numbers. Also, when running Kvasir with the ---var-list-file=intersection.vars option, both of these .decls files -should be compatible with the resulting .dtrace file so that Daikon -can run on both sets of output. -""" - -# Process command-line args: -with Path(sys.argv[1]).open() as dfec_f: - dfec_all_lines = [line.strip() for line in dfec_f] - -with Path(sys.argv[2]).open() as kvasir_f: - kvasir_all_lines = [line.strip() for line in kvasir_f] - -output_lackwit_decls_f = Path(sys.argv[3]).open("w") # ruff:ignore[open-file-with-context-handler] -output_dyn_comp_decls_f = Path(sys.argv[4]).open("w") # ruff:ignore[open-file-with-context-handler] - -output_dec_types_decls_f = Path(sys.argv[5]).open("w") # ruff:ignore[open-file-with-context-handler] -output_no_comp_decls_f = Path(sys.argv[6]).open("w") # ruff:ignore[open-file-with-context-handler] - -output_vars_f = Path(sys.argv[7]).open("w") # ruff:ignore[open-file-with-context-handler] - - -DfecGlobalRE = re.compile(r"^::") - -# Dfec and Kvasir variable differences: - -# Globals are prefixed with a '::' in Dfec -# and with a '/' in Kvasir - -# Dfec doesn't append the filename in front of -# file-static global variables like Kvasir does - -# Dfec also doesn't print out function-static variables -# while Kvasir does - -# Dfec derives two Daikon variables for strings -# one for the pointer and the other for the contents, -# while Kvasir only has one for the contents. - -# Dfec uses the arrow notation for struct names while -# Kvasir uses the bracket notation (unless disambiguation -# information is provided) - - -def convert_dfec_var_name(var: str) -> str: - """Convert variable var's name from Dfec conventions to Kvasir conventions. - - Args: - var: the variable's name in Dfec form. - - Returns: - the variable's name in Kvasir form. - """ - global_converted = DfecGlobalRE.sub("/", var) - return global_converted.replace("->", "[].") - - -def convert_kvasir_var_name(var: str) -> str: - """Strip off everything before the '/', if there is one. - - Dfec does not print out the function name for function-static variables, - e.g., 'flex_c@epsclosure/did_stk_init' becomes '/did_stk_init'. - - Args: - var: a string - - Returns: - The string starting after the '/', or the whole string. - """ - if var[0] == "/": - return var - if "/" in var: - return "/" + var.split("/", maxsplit=1)[1] - return var - - -def strip_comp_number(comp_num: str) -> str: - """Kvasir does not support comparability for array indices so strip those off. - - e.g. '104[105]' becomes '104'. - - Args: - comp_num: a comparability, possibly in array form - - Returns: - the comparability without the array part - """ - if "[" in comp_num: - return comp_num[: comp_num.find("[")] - return comp_num - - -# Dfec and Kvasir program point name differences: - -# Global program point names in Dfec are prefixed by 'std.' -# while they are prefixed by '..' in Kvasir - -# Dfec uses 'EXIT1' while Kvasir uses 'EXIT0' for the exit -# so we should probably simply search for 'EXIT' without -# regard to the number behind it. However, Dfec can have -# more than 1 exit while Kvasir can only have 1. Hmmm, -# what do we do about that? -# (Right now, we just keep 'EXIT' without the number before -# putting it in the hashtable. Thus, only one EXIT ppt -# is kept for each function ... I'm just not sure which -# one, though, but that's ok) - -# Dfec's names for C functions have crap in between the parens -# while Kvasir's doesn't. Let's just not worry about what's -# in the parens since C doesn't have overloading. We just want -# to strip off the canonical function name. - - -def strip_dfec_ppt_name(ppt: str) -> tuple[str, str]: - """Strip the extraneous stuff off of Dfec's names and split into parts. - - Input: 'std.ccladd(int;int;)void:::ENTER' - Output: ('ccladd', 'ENTER') - - Args: - ppt: a dfec program point name - - Returns: - a 2-tuple of cleaned ppt name and either 'ENTER' or 'EXITxxx' - """ - fnname, enter_or_exit = ppt.split(":::") - if fnname[:4] == "std.": - fnname = fnname[4:] - # Find the first '(' and end the function name there - fnname = fnname[: fnname.index("(")] - - # Just return 'ENTER' or 'EXIT' with no numbers - # (This means that we can only keep one exit ppt) - if enter_or_exit[1] == "N": - enter_or_exit = "ENTER" - else: - enter_or_exit = "EXIT" - - # Return a pair of the function name and 'ENTER' or 'EXITxxx' - return (fnname, enter_or_exit) - - -def strip_kvasir_ppt_name(ppt: str) -> tuple[str, str]: - """Strip the extraneous stuff off of Kvasir's names and split into parts. - - Args: - ppt: a Kvasir program point name - - Returns: - a 2-tuple of cleaned ppt name and either 'ENTER' or 'EXITxxx' - """ - fnname, enter_or_exit = ppt.split(":::") - - # For globals, grab everything from '..' to '(' - # e.g. for '..main():::ENTER' - # we want 'main' - if fnname[:2] == "..": - fnname = fnname[2 : fnname.find("(")] - - # For file-static names, we need to take everything between - # the LAST period ('.') and the '(' - # e.g. for 'flex.c.yy_push_state():::EXIT0', - # we want 'yy_push_state' - else: - fnname = fnname[fnname.rfind(".") + 1 : fnname.find("(")] - - # Just return 'ENTER' or 'EXIT' with no numbers - # (This means that we can only keep one exit ppt) - if enter_or_exit[1] == "N": - enter_or_exit = "ENTER" - else: - enter_or_exit = "EXIT" - - # Return a pair of the function name and 'ENTER' or 'EXITxxx' - return (fnname, enter_or_exit) - - -# States: -# About to read in ... -# 0 = Nothing important -# 1 = program point name -# 2 = variable name -# 3 = variable declared type -# 4 = variable rep. type -# 5 = variable comparability number - VERY important -class DeclState(Enum): - """The parse state: what is about to be read.""" - - Uninit = 0 - PptName = 1 - VarName = 2 - DecType = 3 - RepType = 4 - CompNum = 5 - - -# The current parse state. -my_state = DeclState.Uninit - - -# Run the state machine to build up a map (dfec_ppt_map) -# where the keys are program point names (stripped using strip_dfec_ppt_name) -# and the values are maps where the keys are variable names and the -# values are comparability numbers -dfec_ppt_map: dict[tuple[str, str], dict[str, str]] = {} - -# The current variable map, which is a value in dfec_ppt_map. -cur_var_map: dict[str, str] = {} -cur_var_name = "DUMMY VAR NAME" - -for line in dfec_all_lines: - if my_state == DeclState.Uninit: - # The program point name always follows the line called "DECLARE". - if line == "DECLARE": - my_state = DeclState.PptName - - elif my_state == DeclState.PptName: - cur_var_map = {} - dfec_ppt_map[strip_dfec_ppt_name(line)] = cur_var_map - my_state = DeclState.VarName - - elif my_state == DeclState.VarName: - if line == "DECLARE": - my_state = DeclState.PptName - elif line == "": - my_state = DeclState.Uninit - else: - cur_var_name = convert_dfec_var_name(line) - my_state = DeclState.DecType - - elif my_state == DeclState.DecType: - my_state = DeclState.RepType - - elif my_state == DeclState.RepType: - my_state = DeclState.CompNum - - elif my_state == DeclState.CompNum: - # strip off array index comparability numbers - # e.g. '217[337]' should become '217' - cur_var_map[cur_var_name] = strip_comp_number(line) - - # Assume we are going to read another variable. - # When we actually read the subsequent line, - # we'll branch according to whether it's a real - # variable or another thing - my_state = DeclState.VarName - - -# Key: program point name -# Value: A list of 5-element sub-lists -# Each sub-list is: -# (variable name, dec_type, rep_type, kvasir_comp_num, declaredTypeCompNum) -# declaredTypeCompNum is calculated later in the next step by assigning -# each variable of the same declared type at a particular program point -# the SAME number -kvasir_ppt_map: dict[str, list[list[str]]] = {} - -# A list of the same strings which are keys to kvasir_ppt_map -# This is desirable because we want to output the program points -# in the same order as they were read in -kvasir_ppt_names = [] - -my_state = DeclState.Uninit - -cur_var_list: list[list[str]] = [] -for line in kvasir_all_lines: - if my_state == DeclState.Uninit: - # The program point name always follows the - # line called "DECLARE" - if line == "DECLARE": - my_state = DeclState.PptName - - elif my_state == DeclState.PptName: - cur_var_list = [] - # Remember to add an entry to both the list and the map - kvasir_ppt_names.append(line) - kvasir_ppt_map[line] = cur_var_list - my_state = DeclState.VarName - - elif my_state == DeclState.VarName: - if line == "DECLARE": - my_state = DeclState.PptName - elif line == "": - my_state = DeclState.Uninit - else: - cur_var_list.append([]) - cur_var_list[-1].append(line) - my_state = DeclState.DecType - - elif my_state == DeclState.DecType: - cur_var_list[-1].append(line) - my_state = DeclState.RepType - - elif my_state == DeclState.RepType: - cur_var_list[-1].append(line) - my_state = DeclState.CompNum - - elif my_state == DeclState.CompNum: - cur_var_list[-1].append(line) - - # Assume we are going to read another variable. - # When we actually read the subsequent line, - # we'll branch according to whether it's a real - # variable or another thing - my_state = DeclState.VarName - - -def strip_comments(comp_num: str) -> str: - """Strip all comments after "#". - - Example: - # space-delimited token: - Input: int # isParam=true - Output: int - - Args: - comp_num: a string - - Returns: - the string with trailing comments stripped - """ - return comp_num.split("#", maxsplit=1)[0].strip() - - -# Now we are going to initialize the declaredTypeCompNum of each entry -# within kvasir_ppt_map. All variables with identical declared type -# strings will have the same comparability number at each program -# point. -for cur_var_list in kvasir_ppt_map.values(): - cur_comp_num = 1 # Start at 1 and monotonically increase - - # Key: declared type; Value: comp. num associated with that type - dec_types_map: dict[str, int] = {} - - for elt in cur_var_list: - cur_dec_type = strip_comments(elt[1]) - if cur_dec_type in dec_types_map: - elt.append(str(dec_types_map[cur_dec_type])) # Use the stored comp. num - else: - elt.append(str(cur_comp_num)) # Use a fresh new comp. num - dec_types_map[cur_dec_type] = cur_comp_num # and add the entry to the map - cur_comp_num += 1 # Don't forget to increment this! - - -# Now both dfec_ppt_map and kvasir_ppt_map should be initialized. We want -# to now iterate through kvasir_ppt_map, translate program -# point/variable names to the names that will appear in dfec_ppt_map, -# look up the appropriate entries, and add them to result_map, which -# contains all program points and variables that are present in BOTH -# the Dfec and Kvasir-generated .decls files. - -# Remember that our goal is to output a Kvasir-compatible .decls file -# with the variables and comparability numbers gathered from the -# Dfec-generated .decls file to output_lackwit_decls_f and one with -# the numbers gathered from DynComp to output_dyn_comp_decls_f. - - -result_map = {} - -for ppt, KvasirVarList in kvasir_ppt_map.items(): - stripped = strip_kvasir_ppt_name(ppt) - if stripped in dfec_ppt_map: - DfecVarMap = dfec_ppt_map[stripped] - - # print "KvasirVarList:" - # print KvasirVarList - # print "DfecVarMap:" - # print DfecVarMap - # print - # print - - cur_result_var_list = [] - - # print ppt - - # Now iterate through the Kvasir variable list: - for entry in KvasirVarList: - var = entry[0] - dec_type = entry[1] - rep_type = entry[2] - kvasir_comp_num = entry[3] - dec_type_comp_num = entry[4] - - # If rep_type == "java.lang.String", then look - # up the entry for the variable + '[]' because - # Dfec has separate variables for the pointer - # and content of strings - var_to_lookup = var - if rep_type == "java.lang.String": - var_to_lookup += "[]" - - var_to_lookup = convert_kvasir_var_name(var_to_lookup) - - if var_to_lookup in DfecVarMap: - # Throw the comparability number on the end - # of the entry for that variable - - # Make this a tuple 'cause it should be immutable: - # Each entry should be the following: - # (variable name, dec. type, rep. type, - # (Lackwit comp. num, Kvasir comp. num, dec. type comp num) - cur_result_var_list.append( - ( - var, - dec_type, - rep_type, - (DfecVarMap[var_to_lookup], kvasir_comp_num, dec_type_comp_num), - ) - ) - if DfecVarMap[var_to_lookup] == "": - print("EMPTY COMP. NUMBER!", var, var_to_lookup) - - # Only for debugging - # DfecVarMap.pop(var_to_lookup) - - result_map[ppt] = cur_result_var_list - -# This is important to see how much of the intersection between -# Dfec and Kvasir variables that we've successfully picked up: - -# print "Leftovers", DfecVarMap.keys() -# print "# vars in Dfec: ", len(DfecVarMap.keys()) -# print "# vars in Kvasir:", len(KvasirVarList) -# print "# vars in result:", len(cur_result_var_list) -# print - -# Output the resulting .decls file and the var list file: - -# Globals section ... let's just take the first program point and use -# the global vars in that one for the globals section. This makes the -# assumption that the same global variables appear everywhere at all -# program points ... will have to investigate further later ... - -output_vars_f.write("----SECTION----\n") -output_vars_f.write("globals\n") - -example_var_list = result_map[kvasir_ppt_names[0]] - -for var_entry in example_var_list: - if "/" in var_entry[0]: # only print out globals and file-statics - output_vars_f.write(var_entry[0]) - output_vars_f.write("\n") - -output_vars_f.write("\n") - - -# Filter kvasir_ppt_names to remove any program points that are NOT -# in the Dfec-generated .decls file: -kvasir_ppt_names = [ - name for name in kvasir_ppt_names if (strip_kvasir_ppt_name(name) in dfec_ppt_map) -] - - -output_no_comp_decls_f.write("VarComparability\nnone\n\n") - - -all_decls_files = [ - output_lackwit_decls_f, - output_dyn_comp_decls_f, - output_dec_types_decls_f, - output_no_comp_decls_f, -] - -# Output the various .decls files -# (Read these names from kvasir_ppt_names to preserve ordering) -for ppt in kvasir_ppt_names: - for f in all_decls_files: - f.write("DECLARE\n") - f.write(ppt) - f.write("\n") - - # Only print the :::EXIT program point to the var list file - # because then we can grab the return value 'return' - - # Remember that we need to print program points in the form of - # '..main()' and NOT '..main():::ENTER' and '..main():::EXIT0' - is_exit = False - - fnname, enter_or_exit = ppt.split(":::") - if enter_or_exit[:4] == "EXIT": - is_exit = True - - if is_exit: - output_vars_f.write("----SECTION----\n") - output_vars_f.write(fnname) - output_vars_f.write("\n") - - for var_entry in result_map[ppt]: - for f in all_decls_files: - # Variable name - f.write(var_entry[0]) - f.write("\n") - - # Declared type - f.write(var_entry[1]) - f.write("\n") - - # Representation type - f.write(var_entry[2]) - f.write("\n") - - # Comparability number - this is where the action is! - # For Lackwit, we choose the car of the tuple, - output_lackwit_decls_f.write(var_entry[3][0]) - # For DynComp, we choose the cadr - output_dyn_comp_decls_f.write(var_entry[3][1]) - # For dec. type, we choose the caddr - output_dec_types_decls_f.write(str(var_entry[3][2])) - # For no comparability, simply print out '22' - output_no_comp_decls_f.write("22") - - for f in all_decls_files: - f.write("\n") - - # Don't print out globals or file-static vars in the - # var-list-file for individual program points - if is_exit and "/" not in var_entry[0]: - output_vars_f.write(var_entry[0]) - output_vars_f.write("\n") - - # Newline separating neighboring program points - for f in all_decls_files: - f.write("\n") - - if is_exit: - output_vars_f.write("\n") - - -# print '# Dfec ppts:', len(dfec_ppt_map.keys()) -# print '# Kvasir ppts:', len(kvasir_ppt_map.keys()) -# print '# Common ppts:', len(result_map.keys()) - - -for f in all_decls_files: - f.close() - -output_vars_f.close() diff --git a/scripts/dtrace-add-cluster.pl b/scripts/dtrace-add-cluster.pl index 765c3ecb56..ce8b55bbe8 100755 --- a/scripts/dtrace-add-cluster.pl +++ b/scripts/dtrace-add-cluster.pl @@ -129,7 +129,10 @@ () while () { my $line = $_; # print ("$line"); - if ($line =~ /:::/) { + if ($line =~ /^ppt /) { + # A program point declaration; the decls file provides the declarations. + &skip_till_next(*DTRACE_IN); + } elsif ($line =~ /:::/) { my $pptname = $line; chomp ($pptname); &insert_cluster_info($pptname); diff --git a/scripts/dtrace-count.pl b/scripts/dtrace-count.pl index 96e0df8500..1d1b81a160 100755 --- a/scripts/dtrace-count.pl +++ b/scripts/dtrace-count.pl @@ -18,11 +18,11 @@ $/ = ""; # Read by paragraph while (<>) { - next if /^VarComparability/ or /^DECLARE/ or /^decl/ or /^ppt/ or /^var/ or /^input/ or /^\/\//; # Skip .decls-like paras + # Skip .decls-like paras + next if /^(ppt |decl-version|var-comparability|input-language|ListImplementors|\/\/)/; next if /^Begin/ or /^Done/; # Skip processing program point comments - # This script currently assumes the V1 declaration record format, which - # requires ::: in the program point name. - /^(.*):::(.+)$/m or die "Can't parse PPT name (in Version 1 format) from <$_>"; + # This script assumes that each program point name contains ":::". + /^(.*):::(.+)$/m or die "Can't parse PPT name from <$_>"; my $name = "$1:::$2"; $long_names{$1}{$2} = 1; s/\n+$//; diff --git a/scripts/dtrace-diff.pl b/scripts/dtrace-diff.pl index 181f8679e0..5c5231e903 100755 --- a/scripts/dtrace-diff.pl +++ b/scripts/dtrace-diff.pl @@ -111,29 +111,6 @@ ( $ ) $$lhashref{"variable order"} = [ @varorder ]; $$declshash{$currppt} = $lhashref; $ppt_seen = 1; - } elsif ($l eq "DECLARE") { - my $currppt = getline($decls); - my $lhashref = {}; - my @varorder = (); - while (my $varname = getline($decls)) { - (defined (my $dtype = getline($decls))) - or die "malformed decls file"; - (defined (my $rtype = getline($decls))) - or die "malformed decls file"; - (defined (my $ltype = getline($decls))) - or die "malformed decls file"; - # print STDERR "decls defining $varname for $currppt\n"; - $$lhashref{$varname} = [$dtype, $rtype, $ltype]; - push @varorder, $varname; - } - $$lhashref{"variable order"} = [ @varorder ]; - $$declshash{$currppt} = $lhashref; - $ppt_seen = 1; - }elsif (($l eq "VarComparability") && !$ppt_seen) { - # It's ok to have a VarComparability as the first thing - # in the decls file. Read the type of comparability, - # then move on. - $l = getline($decls); } elsif (($l eq "ListImplementors") && !$ppt_seen) { # It's ok to have a ListImplementors in the decls file. # Read the type of comparability, then move on. diff --git a/scripts/dtrace-indent.pl b/scripts/dtrace-indent.pl index 71bc3b9459..02b342e72c 100755 --- a/scripts/dtrace-indent.pl +++ b/scripts/dtrace-indent.pl @@ -14,7 +14,8 @@ $/ = ""; # Read by paragraph while (<>) { - next if /^VarComparability/ or /^DECLARE/ or /^decl/ or /^ppt/ or /^var/ or /^input/ or /^\/\//; # Skip .decls-like paras + # Skip .decls-like paras + next if /^(ppt |decl-version|var-comparability|input-language|ListImplementors|\/\/)/; /^(.*):::([A-Z\d]+)$/m or die "Can't parse PPT name from <$_>"; my $base = $1; my $suffix = $2; diff --git a/scripts/dtrace-rm-decls.php b/scripts/dtrace-rm-decls.php deleted file mode 100755 index 5fb630a259..0000000000 --- a/scripts/dtrace-rm-decls.php +++ /dev/null @@ -1,49 +0,0 @@ -#! /usr/bin/env php - -// -// declarations are removed from and placed in -// They are discarded if is not specified - -// main -{ - $dtrace_name = $argv[1]; - $dt_in = fopen ($dtrace_name, "r"); - $dt_out_name = tempnam ("/tmp", "dtrace"); - $dt_out = fopen ($dt_out_name, "w"); - $decl_name = $argv[2]; - if ($decl_name) - $decl = fopen ($decl_name, "w"); - - // process each line in the dtrace file - while (!feof ($dt_in)) { - $line = trim (fgets ($dt_in)); - - // write declarations to the decl file - if ($line == "DECLARE") { - $decl_lines = array(); - while ($line) { - $decl_lines[] = $line; - $line = trim (fgets ($dt_in)); - } - if ($decl) { - foreach ($decl_lines as $decl_line) - fputs ($decl, $decl_line. "\n"); - fputs ($decl, "\n"); - } - continue; - } - - // All other lines are saved - fputs ($dt_out, $line . "\n"); - } - - // close the files - fclose ($dt_in); - fclose ($dt_out); - if ($decl) - fclose ($decl); - - // move the result back to dtrace file - rename ($dt_out_name, $dtrace_name); -} diff --git a/scripts/extract_vars.pl b/scripts/extract_vars.pl index 18577b6de4..d04c068e55 100755 --- a/scripts/extract_vars.pl +++ b/scripts/extract_vars.pl @@ -303,8 +303,8 @@ ( $ ) my $mod = ; # "$mod" is unused # extract variables to be clustered. - # Omit Object variables, .class, array[] or a string - if ( $varname !~ /\.class/ && $varname !~ /\[\]/ && $varname !~ /\.toString/) { + # Omit Object variables, class names, arrays, and strings. + if (!excluded_var($varname)) { if ( exists $pptname_to_varnames{$pptname}{$varname}) { push @vararray, $value; } @@ -463,8 +463,8 @@ ( $ ) open(DECL, $decls_file) || &dieusage("cannot read decls file $decls_file"); while () { my $line = $_; - if ($line =~ /^DECLARE$/) { - my $pptname = &read_decl_ppt(); + if ($line =~ /^ppt (.*?)\s*$/) { + my $pptname = &read_decl_ppt($1); # extract the variables out of only the EXIT program # points. Corresponding ENTER and EXIT invocations must belong to a @@ -486,36 +486,55 @@ ( $ ) } } # read_decls_file -# read a program point declaration in the decls file. -sub read_decl_ppt () { +# Returns true if the variable should not be clustered: its value is a +# class name, an array, or a string. +sub excluded_var ( $ ) { + my ($varname) = @_; + return ($varname =~ /\.getClass\(\)/ || $varname =~ /\[\.\.\]/ || $varname =~ /\.toString/); +} + +# read a program point declaration in the decls file. The "ppt" line, +# whose argument is the ppt name, has already been read. +sub read_decl_ppt ( $ ) { + my ($pptname) = @_; my $nvars; # number of variables at the program point - my $pptname = ; # the pptname. - chomp ($pptname); - # now read the variable names and types - my $varname; - while ( defined($varname = ) && ($varname !~ /^$/) ) { - chomp ($varname); - my $declared_type = ; # "$declared_type" is unused - my $rep_type = ; + # The variable being read, its rep type, and whether it is a constant. + my ($varname, $rep_type, $is_constant); + # Records the variable that was just read. + my $record_var = sub { + if (!defined($varname) || excluded_var($varname)) { + return; + } # If the variable is an Object, keep note of that. Will be ignored (not # be clustered) later because its value is a hashcode. - if ( $varname !~ /\.class/ && $varname !~ /\[\]/ && $varname !~ /\.toString/) { - if ($rep_type =~ /hashcode/) { - push @{$pptname_to_objectvars{$pptname}}, $varname; - $nvars++; # added for object - $pptname_to_varnames{$pptname}{$varname} = 1; - } elsif ( $rep_type =~ /=/) { - # definition. do nothing - } else { - $nvars++; - $pptname_to_varnames{$pptname}{$varname} = 1; - } + if ($rep_type =~ /hashcode/) { + push @{$pptname_to_objectvars{$pptname}}, $varname; + $nvars++; # added for object + $pptname_to_varnames{$pptname}{$varname} = 1; + } elsif ($is_constant) { + # definition. do nothing + } else { + $nvars++; + $pptname_to_varnames{$pptname}{$varname} = 1; + } + }; + + # now read the variable names and types + my $line; + while ( defined($line = ) && ($line !~ /^\s*$/) ) { + if ($line =~ /^\s*variable\s+(.*?)\s*$/) { + &$record_var(); + ($varname, $rep_type, $is_constant) = ($1, "", 0); + } elsif ($line =~ /^\s*rep-type\s+(.*?)\s*$/) { + $rep_type = $1; + } elsif ($line =~ /^\s*constant\s/) { + $is_constant = 1; } - my $var_comp = ; # variable comparability; "$var_comp" is unused } + &$record_var(); # Store the number of variables at this program point. Remember that # @vararray[1] stores the program point name. The invocation nonce is # included in @vararray, but is not counted as a variable. diff --git a/scripts/find_comparable.pl b/scripts/find_comparable.pl deleted file mode 100755 index ae26b22d1c..0000000000 --- a/scripts/find_comparable.pl +++ /dev/null @@ -1,130 +0,0 @@ -#!/usr/bin/env perl - -## Usage: find_comparable.pl < input_decl_file - -## Looks for comparable variables in each ppt and prints them to separate -## files named with the program point. Best executed in empty directory -## -## Only ppts that have at least some variables that are comparable to -## one another will be printed. - -use English; -use strict; -$WARNING = 1; # "-w" flag -my $debug = 0; -# my $verbose = 1; -# my @new_types; -my $line; -my @dfile; -my $global_prefix = "::"; -my $globals_only = 1; -my $out_file = 1; - -#process arguments -while (@ARGV) { - my $arg = shift @ARGV; - if ($arg eq "-prefix") { - $global_prefix = shift @ARGV; - } else { - print "Unknown argument $arg"; - exit; - } -} - -#read the whole file (its usually not too long) into an array -while ($line = ) { - push @dfile, ($line); - chomp ($dfile[$#dfile]); -} - -# indexed by varname, value is number of occurrences -# my %globals; -# my %info; -# my %mismatch_cnt; -my $exit_cnt = 0; -# my @keys; -# my $global_name = ""; - -#loop through the decls looking for numbered exit points -for (my $i = 0; $i <= $#dfile; $i++) { - $line = $dfile[$i]; - if ($line eq "DECLARE") { - $line = $dfile[++$i]; - if (!($line =~ /EXIT[0-9]/)) { - next; - } - my $ppt = $line; - if ($debug) { - print STDERR "found matching ppt: $ppt\n"; - } - $exit_cnt++; - - # map from comparability to variables - my %compar; - - # get the next variable - $line = $dfile[++$i]; - while ($line && $line ne "\n") { - my $varname = $line;; - my $type = $dfile[++$i]; - my $rep = $dfile[++$i]; - my $comp = $dfile[++$i]; - $line = $dfile[++$i]; - #if ($debug) { - # print STDERR "looking $varname | $type | $rep | $comp\n"; - #} - if ($globals_only && ($varname !~ /^$global_prefix/)) { - next; - } - - if ($compar{$comp}) { - $compar{$comp} .= " $varname($rep)"; - } else { - $compar{$comp} = "$varname($rep)"; - } - } - - # print out any comparable variables - if ($out_file) { - my $open = 0; - my $fp; - foreach my $key (sort (keys (%compar))) { - my @vars = split (/ /, $compar{$key}); - if ($#vars > 1) { - if (!$open) { - my $ppt_file = $ppt; - $ppt_file =~ s/\(.*:::/_/; - open ($fp, "|sort > $ppt_file"); - $open = 1; - } - print $fp " "; - foreach my $var (@vars) { - print $fp "$var "; - } - print $fp "\n"; - } - } - if ($open) { - foreach my $key (sort (keys (%compar))) { - my @vars = split (/ /, $compar{$key}); - if ($#vars == 1) { - print $fp " $vars[0]\n"; - } - } - close $fp; - } - } else { - print "\n$ppt\n"; - foreach my $key (keys (%compar)) { - my @vars = split (/ /, $compar{$key}); - if ($#vars > 1) { - print " "; - foreach my $var (@vars) { - print "$var "; - } - print "\n"; - } - } - } - } -} diff --git a/scripts/find_globals.pl b/scripts/find_globals.pl deleted file mode 100755 index 53605271c8..0000000000 --- a/scripts/find_globals.pl +++ /dev/null @@ -1,143 +0,0 @@ -#!/usr/bin/env perl - -## Usage: find_globals.pl < input_decls_file > output_decls_file -## [-prefix -## -## Looks for global variables (those marked with the specified prefix that -## appear at every program point) and creates a new global ppt at the -## end that contains those variables. - -use English; -use strict; -$WARNING = 1; # "-w" flag -my $debug = 0; -my $verbose = 1; -my @vars; -my @new_types; -my $line; -my @dfile; -my $global_prefix = "::"; - -#process arguments -while (@ARGV) { - my $arg = shift @ARGV; - if ($arg eq "-prefix") { - $global_prefix = shift @ARGV; - } else { - print "Unknown argument $arg"; - exit; - } -} - -#read the whole file (its usually not too long) into an array -while ($line = ) { - push @dfile, ($line); - chomp ($dfile[$#dfile]); -} - -# indexed by varname, value is number of occurrences -my %globals; -my %info; -my %mismatch_cnt; -my $exit_cnt = 0; -my @keys; -my $global_name = ""; - -#loop through the decls looking for numbered exit points -for (my $i = 0; $i <= $#dfile; $i++) { - $line = $dfile[$i]; - if ($line eq "DECLARE") { - $line = $dfile[++$i]; - if (!($line =~ /EXIT[0-9]/)) { - next; - } - if ($global_name eq "") { - ($global_name) = split (/\./, $line); - } - if ($debug) { - print STDERR "found matching ppt: $line\n"; - } - $exit_cnt++; - - # get the next variable - $line = $dfile[++$i]; - while ($line && $line ne "\n") { - my $varname = $line;; - my $type = $dfile[++$i]; - my $rep = $dfile[++$i]; - my $comp = $dfile[++$i]; - $line = $dfile[++$i]; - #if ($debug) { - # print STDERR "looking $varname | $type | $rep | $comp\n"; - #} - if ($type =~ /isParam=true/) { - next; - } - if ($globals{$varname}) { - $globals{$varname}++; - my @tinfo = split (/ \^ /, $info{$varname}); - my $match = 0; - foreach my $ti (@tinfo) { - if ($ti eq "$type : $rep : $comp") { - $match = 1; - last; - } - } - if (!$match) { - $mismatch_cnt {$varname}++; - $info{$varname} .= " ^ $type : $rep : $comp"; - } - } else { - $keys[++$#keys] = $varname; - $globals{$varname} = 1; - $info{$varname} = "$type : $rep : $comp"; - } - } - } -} - -if ($verbose) { - print STDERR "$exit_cnt numbered exit routines\n"; -} - -# write the file back out -foreach $line (@dfile) { - print "$line\n"; -} - -# Write out the new global declaration, noting any mismatches -my $global_cnt = 0; -print "\nDECLARE\n"; -print $global_name . ":::GLOBAL\n"; -foreach my $key (@keys) { - my $cnt = $globals{$key}; - if ($cnt == $exit_cnt) { - my $mmcnt = $mismatch_cnt {$key}; - if ($mmcnt) { - $mmcnt++; - print STDERR "$mmcnt sets of type information for global $key:\n"; - my @tinfo = split (/ \^ /, $info{$key}); - foreach my $ti (@tinfo) { - print STDERR " $ti\n"; - } - } else { - if ($key !~ /^$global_prefix/) { - print STDERR "$key doesn't contain global prefix " - . "($global_prefix)\n"; - } else { - print "$key\n"; - my ($type,$rep,$comp) = split (/ : /, $info{$key}); - print "$type\n$rep\n$comp\n"; - $global_cnt++; - } - } - } else { - if ($key =~ /$global_prefix/) { - print STDERR "Global $key only appears in $cnt of $exit_cnt" - . " numbered exit points\n"; - } - } -} -if ($verbose) { - print STDERR "$global_cnt global variables at GLOBAL ppt\n"; -} diff --git a/scripts/generate-dec-types.py b/scripts/generate-dec-types.py deleted file mode 100755 index 3b24b54351..0000000000 --- a/scripts/generate-dec-types.py +++ /dev/null @@ -1,175 +0,0 @@ -#!/usr/bin/python3 - -"""Generates a .decls file with declared type comparability numbers. - -Usage: ./generate-dec-types.py -""" - -# Warning: This was hacked together by copy/paste from -# dfec-to-kvasir.py so some of the comments may make no sense at all - -import sys -from enum import Enum -from pathlib import Path - -# Process command-line args: -with Path(sys.argv[1]).open() as decls_f: - all_lines = [line.strip() for line in decls_f] - - -def strip_comp_number(comp_num: str) -> str: - """Kvasir does not support comparability for array indices, so strip those off. - - e.g. '104[105]' becomes '104'. - - Args: - comp_num: a comparability, possibly in array form - - Returns: - the comparability without the array part - """ - if "[" in comp_num: - return comp_num[: comp_num.find("[")] - return comp_num - - -def strip_comments(comp_num: str) -> str: - """Strip all comments after "#". - - Example: - # space-delimited token: - Input: int # isParam=true - Output: int - - Args: - comp_num: a string - - Returns: - the string with trailing comments stripped - """ - return comp_num.split("#", maxsplit=1)[0].strip() - - -# States: -# About to read in ... -# 0 = Nothing important -# 1 = program point name -# 2 = variable name -# 3 = variable declared type -# 4 = variable rep. type -# 5 = variable comparability number - VERY important -class DeclState(Enum): - """The parse state: what is about to be read.""" - - Uninit = 0 - PptName = 1 - VarName = 2 - DecType = 3 - RepType = 4 - CompNum = 5 - - -# The current parse state. -my_state = DeclState.Uninit - - -# Key: program point name -# Value: A list of 5-element sub-lists -# Each sub-list is: -# (variable name, dec_type, rep_type, declaredTypeCompNum) -# declaredTypeCompNum is calculated later in the next step by assigning -# each variable of the same declared type at a particular program point -# the SAME number -kvasir_ppt_map = {} - -# A list of the same strings which are keys to kvasir_ppt_map -# This is desirable because we want to output the program points -# in the same order as they were read in -kvasir_ppt_names = [] - -my_state = DeclState.Uninit - -cur_var_list: list[list[str]] = [] -for line in all_lines: - if my_state == DeclState.Uninit: - # The program point name always follows the - # line called "DECLARE" - if line == "DECLARE": - my_state = DeclState.PptName - - elif my_state == DeclState.PptName: - cur_var_list = [] - # Remember to add an entry to both the list and the map - kvasir_ppt_names.append(line) - kvasir_ppt_map[line] = cur_var_list - my_state = DeclState.VarName - - elif my_state == DeclState.VarName: - if line == "DECLARE": - my_state = DeclState.PptName - elif line == "": - my_state = DeclState.Uninit - else: - cur_var_list.append([]) - cur_var_list[-1].append(line) - my_state = DeclState.DecType - - elif my_state == DeclState.DecType: - cur_var_list[-1].append(line) - my_state = DeclState.RepType - - elif my_state == DeclState.RepType: - cur_var_list[-1].append(line) - my_state = DeclState.CompNum - - elif my_state == DeclState.CompNum: - cur_var_list[-1].append(line) - - # Assume we are going to read another variable. - # When we actually read the subsequent line, - # we'll branch according to whether it's a real - # variable or another thing - my_state = DeclState.VarName - - -# Now we are going to initialize the declaredTypeCompNum of each entry -# within kvasir_ppt_map. All variables with identical declared type -# strings will have the same comparability number at each program -# point. -for cur_var_list in kvasir_ppt_map.values(): - cur_comp_num = 1 # Start at 1 and monotonically increase - - # Key: declared type; Value: comp. num associated with that type - dec_types_map: dict[str, int] = {} - - for elt in cur_var_list: - cur_dec_type = strip_comments(elt[1]) - if cur_dec_type in dec_types_map: - elt.append(str(dec_types_map[cur_dec_type])) # Use the stored comp. num - else: - elt.append(str(cur_comp_num)) # Use a fresh new comp. num - dec_types_map[cur_dec_type] = cur_comp_num # and add the entry to the map - cur_comp_num += 1 # Don't forget to increment this! - - -# Output the various .decls files -# (Read these names from kvasir_ppt_names to preserve ordering) -for ppt in kvasir_ppt_names: - print("DECLARE") - print(ppt) - - for var_entry in kvasir_ppt_map[ppt]: - # Variable name - print(var_entry[0]) - - # Declared type - print(var_entry[1]) - - # Representation type - print(var_entry[2]) - - # Comp. num (based on declared types only): - print(str(var_entry[4])) - - # Newline separating neighboring program points - print() diff --git a/scripts/lwpp-init.pl b/scripts/lwpp-init.pl deleted file mode 100755 index cbe7ab8c08..0000000000 --- a/scripts/lwpp-init.pl +++ /dev/null @@ -1,86 +0,0 @@ -#!/usr/bin/env perl - -# Creates the lackwit databases. Requires that LACKWIT_HOME is set -# correctly. Requires that 'lh' is in your path (it appears -# in directory front-end/c/). - -use English; -use strict; -$WARNING = 1; - -if (@ARGV < 1) { - die "Usage: lwpp-init.pl [lhargs...] [filenames...]\n"; -} - -my $lackwitdb = shift @ARGV; -# Check args --d $lackwitdb or die "$lackwitdb is not a directory\n"; -my $lhargs = - "-D__builtin_next_arg\\(arg\\)='(((char*)arg)+1)' "; -my @files = (); - -my $doingargs=1; - -ARGPARSE: while (defined (my $arg = shift @ARGV)) { - $arg =~ s/([\'\"\$])/\\$1/g; - if (($doingargs)&&($arg =~ /^-/)) { - $lhargs .= "${arg} "; - } else { - $doingargs=0; - if ($arg =~ /^-/) { - #is -l, skip it - next ARGPARSE; - } else { - if ($arg =~ /\.h$/) { - #is hfile, skip it - next ARGPARSE; - } - } - #is cfile - push @files, $arg; - } -} - -# Check that LACKWIT_HOME is set correctly, and that the required -# files are present and readable -my $lackwit_home = $ENV{LACKWIT_HOME}; --e "$lackwit_home/bin/Lackwit" - or die "Environment variable LACKWIT_HOME is not set correctly\n"; - -$ENV{LACKWITDB} = $lackwitdb; -$ENV{PATH} = "$lackwit_home/bin:" . $ENV{PATH}; -$ENV{LACKWIT_ARGS} = "-ignore __restrict"; - -my $emitheaders_output = `EmitHeaders $lackwit_home/lib/Default.sigs`; -die "EmitHeaders failed:\n$emitheaders_output\n" if ($CHILD_ERROR != 0); - -my $libc = "$lackwit_home/lib/libc.c"; -unshift @files, $libc; - -foreach my $file (@files) { - # An intermediate file is created for each source file to be - # analyzed. The intermediate files are created in the $lackwitdb - # directory. All files are written to the root of $lackwitdb, - # regardless of leading directories. It is not a big problem if - # filenames clash -- each file is analyzed immediately after it is - # created. The files are left around for debugging purposes only. - my $int_file = $file; - $int_file =~ s!\.c!.int.c!; - $int_file =~ s!^(.*)/!!; # strip leading directories - $int_file = "$lackwitdb/$int_file"; - - my $lh_output; - if ($file eq $libc) { - my $lhflags = ""; - if (`uname` =~ /Linux/) { - $lhflags = "-D_LINUX_IN_H -D_LIBIO_H"; - } - $lh_output = `lh -\$ -w $lhflags --gen_c_file_name $int_file $file`; - } else { - $lh_output = `lh -w $lhargs --gen_c_file_name $int_file $file`; - } - die "lh failed processing file $file:\n$lh_output\n" if ($CHILD_ERROR != 0); - my $gcc_output = `gcc -c $int_file -o /dev/null 2>&1`; - $gcc_output =~ /^(.*)Launching real compiler/s; - die "Error processing $int_file\n$1\n" if ($1); -} diff --git a/scripts/lwpp.pl b/scripts/lwpp.pl deleted file mode 100755 index 7a9b01af44..0000000000 --- a/scripts/lwpp.pl +++ /dev/null @@ -1,650 +0,0 @@ -#!/usr/bin/env perl - -# Annotate a declaration file with implicit lackwit comparability -# information. Overwrites the file with Lackwit comparability -# information, saving a copy of the original as -# filename.decls.nonlackwit. - -# Assumes: -# - $LACKWIT_HOME is set to the directory where lackwit is installed -# - The lackwit database has already been created - -# Perl port of a similar C++ program written by Adam Czeisler - -# This program is complicated for several reasons. First, we need to -# "translate" between dfec and lackwit. We need to massage the output -# of dfec before it is sent to lackwit, and we need to massage the -# output of lackwit before writing it to the decls file. Second, -# there are some bugs and missing features in lackwit we need to work -# around. Last, lackwit outputs comparability as a list of comparable -# variables. Daikon needs to have variables grouped into equivalence -# classes. We must translate from lackwit's notion of comparability -# to Daikon's. - -# MISC: Lackwit doesn't know about procedure returns, so we added a -# dummy variable named "lh_return_value". - -# We must remove the leading :: from global variables in the decls -# file, since lackwit can't handle ::. - -# We have to be careful about preserving the transitivity of the -# comparable relationship. That is, if a cmp b, then b cmp a. To -# guarantee transitivity, we calculate the equivalence classes as -# follows. First, we query lackwit to get a set of variables -# comparable to each variable at the ppt. Then, we unify the sets by -# merging sets that have elements in common. The result is a set of -# disjoint sets, with each set representing an equivalence class. -# Next, we filter the equivalence classes, removing elements not -# present at the ppt. Finally, we calculate the implicit type of each -# variable using the equivalence classes. - -# ARRAYS/POINTERS: In C, there is almost no difference between a -# pointer to a single thing, and an array of things. As far as I can -# tell, Lackwit treats pointers and arrays identically. However, -# Lackwit does not have very good support for arrays. We need to -# determine three different comparabilities for an array: the -# comparability of the pointer, the comparability of the elements, and -# the comparability of the indices. Assume we have an array a[]. - -# Lackwit can find pointer comparability fine. Just query for "a". - -# Lackwit has a bug when finding element comparability. If you query -# for "a[]" or "*a", you will usually get the right answer, except -# when the comparability crosses procedure boundaries. Look at the -# lackwit.c file in dfec-tests/lackwit. On its own, lackwit gets the -# right answer for array_elements, but the wrong answer for -# call_array_elements. To fix this, we add the variable "a_element" -# to the source code before instrumenting it. Expressions in the -# program are changed from "a[0] = b" to "a_element = b, a[0] = -# a_element". To find the comparability of "a[]", we actually query -# lackwit for "a_element". Then, the results must be processed to -# convert "a_element" back to "a[]". - -# Lackwit cannot find array index comparability. We add the variable -# "a_index" to the source code before instrumenting it. Expressions -# in the program are changed from "a[0] = b" to "a_index = 0, -# a[a_index] = b". We query lackwit for "a_index" to find the -# comparability of the variables used to index "a". We currently only -# handle single-dimensional arrays. - -# This script can handle only one-dimensional arrays. This is OK, -# since dfec can also handle only one-dimensional arrays. - -# STRUCTS: Lackwit gets structs about 90% right. It has problems with -# pointers to structs. - -# If two struct pointers are comparable, their respective fields -# should also be comparable. If s1 cmp s2, then s1->a cmp s2->a. -# However, Lackwit gets this wrong. Thus, when checking the -# comparability of a structure field, we need to do some work on our -# end. When checking the comparability of s1->a, also check the -# comparability of s1. Say s1 is comparable to s2 and s3. If either -# s2->a or s3->a is in the list of interesting variables (that is, -# variables that appear in the decls file), make s1->a comparable to -# them. - -# When determining the comparability of a struct field, lackwit can -# crash if the expression involves pointers (like a->b) and the -# expression is not present in the program text. However, if the -# expression is not in the program text, it can only be comparable due -# to its parent structure. Thus, if lackwit crashes on a struct -# expression, just assume it returned no comparability information, -# and use the comparability of its parent. - -# lh adds _element and _index variables for pointers to and arrays of -# structs, just like it does for scalars. When determining the -# comparability of a struct field, lackwit will return something like -# "a_element.b", but it might *not* return "a->b" as well. Thus, -# results of the form "a_element.b" are converted to "a->b". - -use English; -use strict; -$WARNING = 1; -use vars qw(%cache %interesting_vars @compar_lists); - -my $element_suffix = "_element"; -my $index_suffix = "_index"; -my $dummy_return = "lh_return_value"; - -if (@ARGV != 2) { - die "Usage: lwpp.pl \n"; -} - -my ($lackwitdb, $outfn) = @ARGV; - -# Check args --d $lackwitdb or die "$lackwitdb is not a directory\n"; --e "$lackwitdb/globals.db" or die "$lackwitdb/globals.db does not exist\n"; --e $outfn or die "decls file $outfn does not exist\n"; - -# Exit if the decls file is empty. -if (-z $outfn) { - print STDERR "Warning: decls file $outfn is empty\n"; - exit 0; -} - -# Check that LACKWIT_HOME is set correctly -my $lackwit_home = $ENV{LACKWIT_HOME}; --e "$lackwit_home/bin/Lackwit" - or die "Environment variable LACKWIT_HOME is not set correctly\n"; - -$ENV{LACKWITDB} = $lackwitdb; -$ENV{PATH} = "$lackwit_home/bin:" . $ENV{PATH}; - -my $backupdecls = $outfn . ".nonlackwit"; -system("mv -f $outfn $backupdecls") - and die "Couldn't back up $outfn!\n"; -open DECLS, $backupdecls or die "Can't open $backupdecls: $!\n"; - -sub die_and_restore { - my $diemsg = shift; - `mv -f $backupdecls $outfn`; - die $diemsg; -} - -my $saw_comparability = 0; -my $first_line = ; -if ($first_line =~ /VarComparability/) { - my $second_line = ; - if ($second_line =~ /implicit/) { - $saw_comparability = 1; - die_and_restore "Invalid declaration file. " . - "Perhaps it has already been processed.\n"; - } elsif ($second_line =~ /none/) { - # Old file was "none", new file will be "implicit" - $saw_comparability = 1; - } - ; # skip blank line -} - -if (!$saw_comparability) { - # reset the filehandle position - seek(DECLS, 0, 0); -} - -my $lwpp_mode = "robust"; -if (exists $ENV{"LWPP_MODE"}) { - $lwpp_mode = $ENV{"LWPP_MODE"}; -} - -if ($lwpp_mode eq "fast") { - start_lackwit(); -} - -open OUT, ">$outfn" or die_and_restore "Can't open $outfn for write: $!\n"; -print OUT "VarComparability\n"; -print OUT "implicit\n"; -print OUT "\n"; - -# maps explicit types (a string of space-separated comparable -# variables) to implicit types (integers) -my %explicit_to_implicit = (); - -while () { - print OUT; - - if (/DECLARE/) { - - my $ppt = ; - chomp $ppt; - print OUT "$ppt\n"; - $ppt =~ /^.*\.(.*)\(/; - my $function = $1; - - # location in the file where the variable declarations start - my $start_vars = tell DECLS; - - # variables at this program point that Daikon finds interesting, - # namely those appearing in the decls file. This includes - # parameters and global variables. - %interesting_vars = (); - - # list of lists of comparable variables at this program point. - # includes uninteresting variables, which will be filtered out later - @compar_lists = (); - - # read the whole program point, creating the hash of interesting - # variables and the list of lists of comparable variables - get_vars_and_comp($function); - - # combine the lists with common elements - @compar_lists = disjoint_lists(@compar_lists); - - # remove all elements that *aren't* interesting - @compar_lists = filter_lists_by_hash(\@compar_lists, \%interesting_vars); - - # reset the file pointer to the start of the ppt - seek DECLS, $start_vars, 0; - - # read the program point, printing the variables and implicit - # comparability types to the output file - print_vars_and_comp(); - } - print OUT "\n"; -} - -print OUT "# Implicit Type to Explicit Type\n"; -foreach my $implicit_type (sort {$a <=> $b;} values %explicit_to_implicit) { - my %explicit_types = reverse %explicit_to_implicit; - my $explicit_type = $explicit_types{$implicit_type}; - printf OUT "# %3s : $explicit_type\n", $implicit_type; -} - -if ($lwpp_mode eq "fast") { - stop_lackwit(); -} - -# finished processing -exit(0); - - -########################################################################### -### Subroutines -### - -# read the whole program point, creating the hash of interesting -# variables and the list of lists of comparable variables -sub get_vars_and_comp { - my ($function) = @_; - - while (my $variable = ) { - last if ((!$variable) || ($variable =~ /^\s+$/)); - chomp $variable; - - $variable = transform($variable); - - my $declared_type = ; - my $rep_type = ; - my $old_comparability = ; - - if (is_array_element($variable)) { - my $array_base = array_base($variable); - - my $element_variable = $array_base . $element_suffix; - $interesting_vars{$element_variable} = 1; - my %element_comparable_variables = - get_comparable_variables($element_variable, $function); - push @compar_lists, [keys %element_comparable_variables]; - - my $index_variable = $array_base . $index_suffix; - $interesting_vars{$index_variable} = 1; - my %index_comparable_variables = - get_comparable_variables($index_variable, $function); - push @compar_lists, [keys %index_comparable_variables]; - } else { - $interesting_vars{$variable} = 1; - my %comparable_variables = - get_comparable_variables($variable, $function); - push @compar_lists, [keys %comparable_variables]; - } - } -} - - -# read the program point, printing the variables and implicit -# comparability types to the output file -sub print_vars_and_comp { - my ($function) = @_; - - # process the variable declarations, one at a time - while (my $variable = ) { - last if ((!$variable) || ($variable =~ /^\s+$/)); - - chomp $variable; - my $declared_type = ; - chomp $declared_type; - my $representation_type = ; - chomp $representation_type; - - print OUT "$variable\n"; - print OUT "$declared_type\n"; - print OUT "$representation_type\n"; - - # throw away old comparability information - ; - - $variable = transform($variable); - - if (is_array_element($variable)) { - my $array_base = array_base($variable); - my $element_variable = $array_base . $element_suffix; - my $index_variable = $array_base . $index_suffix; - my $elem_imp_type = implicit_type($element_variable); - my $index_imp_type = implicit_type($index_variable); - print OUT "$elem_imp_type\[$index_imp_type\]\n"; - } else { - my $imp_type = implicit_type($variable); - print OUT "$imp_type\n"; - } - } -} - - -# For array elements, dfec outputs "foo[]". Lackwit accepts as input -# "foo[]" and "foo[0]", but outputs "foo[0]". Array elements output -# by Lackwit are immediately converted to the "foo_element" form. -# is_array_element and array_base are only called on variables from -# the decls file, so they only need to handle the "foo[]" case. -sub is_array_element { - my ($variable) = @_; - return $variable =~ /\[\]$/; -} -sub array_base { - my ($variable) = @_; - $variable =~ s/\[\]$//; - return $variable; -} - -# returns true if the variable is a struct field -sub is_struct_field { - my ($variable) = @_; - return $variable =~ /->/ || $variable =~ /\./; -} - - -# Returns the list of comparable variables for the specified variable -# in the specified function. Includes possibly uninteresting -# variables. -sub get_comparable_variables { - my ($variable, $function) = @_; - - my %comparable_variables = (); - - # every variable is comparable to itself - $comparable_variables{$variable} = 1; - - my $lackwit_results = lackwit($function, $variable); - - foreach (split /\n/, $lackwit_results) { - chomp; - - # we are looking for lines of the form "(filename:line) variable". - # skip lines not matching this description. - next if not /^\(.*\) (.*)$/; - - my $comparable = $1; - - # skip type-cast variables ("{") and parameters of other - # functions ("@") - next if ($comparable =~ /\{|@/); - - # skip function static variables ("#") - next if ($comparable =~ /\#/); - - # If the variable name contains a colon, it is either local to - # a function, or a function parameter. It will be of the - # format "function:variable". If the name does not contain a - # colon, it is a global variable. - my $comparable_variable; - if ($comparable =~ /^(.*):(.*)$/) { - my $comparable_function = $1; - $comparable_variable = $2; - - # skip variables in other functions - next if ($comparable_function ne $function); - } else { - $comparable_variable = $comparable; - } - - # change array[0] to array_element - $comparable_variable =~ s/\[0\]/$element_suffix/; - - # fields of struct array elements are in the trace file with an "->" - # convert "a_element.b_element.c->d" to "a->b->c->d" - $comparable_variable =~ s/$element_suffix\./->/g; - - $comparable_variables{$comparable_variable} = 1; - - # an array element may be represented in the trace file as a pointer - if ($comparable_variable =~ /^(.*)$element_suffix/) { - my $array_base = $1; - my $pointer = "*$array_base"; - $comparable_variables{$pointer} = 1; - } - } - - # If the variable is an array element, we need to check the - # comparability of the array itself. If the array is comparable to - # another array, the elements of the arrays should be comparable as - # well. - if ($variable =~ /^(.*)$element_suffix$/) { - my $array_base = $1; - my %base_comp_var = - get_comparable_variables($array_base, $function); - foreach my $base_comp_var (keys %base_comp_var) { - my $elem_comp_var = $base_comp_var . $element_suffix; - $comparable_variables{$elem_comp_var} = 1; - } - } - - # If the variable is an array index, we need to check the - # comparability of the array itself. If the array is comparable to - # another array, the indices of the arrays should be comparable as - # well. - if ($variable =~ /^(.*)$index_suffix$/) { - my $pointer_var = $1; - my %pointer_comp_var = - get_comparable_variables($pointer_var, $function); - foreach my $pointer_comp_var (keys %pointer_comp_var) { - my $index_comp_var = $pointer_comp_var . $index_suffix; - $comparable_variables{$index_comp_var} = 1; - } - } - - # If the variable is a field of a structure, we need to check the - # comparability of its parent structure. If the parent is - # comparable to other structures, we need to add the corresponding - # fields of those structures. This is done recursively, to handle - # multiply-nested structures like "a.b.c.d" - if (is_struct_field($variable)) { - my ($struct, $field) = split_struct($variable); - my %parent_comp_var = - get_comparable_variables($struct, $function); - foreach my $parent_comp_var (keys %parent_comp_var) { - my $field_comp_var = $parent_comp_var . $field; - $comparable_variables{$field_comp_var} = 1; - } - } - - return %comparable_variables; -} - - -# Splits a structure field variable into the parent structure and the -# field. The field accessor is appended to the front of the field. -# For example: -# get_struct("a.b") = ("a", ".b") -# get_struct("a.b.c.d") = ("a.b.c", ".d") -# get_struct("a.b->c") = ("a.b", "->c") -sub split_struct { - my ($variable) = @_; - $variable =~ /(.*)(\.|->)([^\.-]*)$/; - return ($1, $2.$3); -} - - -# Returns the string output by BackEnd when queried for the specified -# variable and function. Memoizes calls to BackEnd to improve -# performance. -sub lackwit { - my ($variable, $function) = @_; - - my $key = "$variable $function"; - if (exists $cache{$key}) { - return ${$cache{$key}}; - } - - my $retval; - if ($lwpp_mode eq "fast") { - $retval = _lackwit_fast(@_); - } else { - $retval = _lackwit_robust(@_); - } - $cache{$key} = \$retval; - for my $line (split /\n/, $retval) { - if ($line =~ /^\(.*\) ([^:]+):([^:]+)$/) { - my($other_func, $other_var) = ($1, $2); - my $key = "$other_var $other_func"; - if (not exists $cache{$key}) { - $cache{$key} = \$retval; - } - } - } - return $retval; -} - -use IPC::Open2 'open2'; -my($lackwit_pid, $lackwit_in_fh, $lackwit_out_fh); - -sub start_lackwit { - $lackwit_pid = open2($lackwit_out_fh, $lackwit_in_fh, - "BackEnd -batch"); -} - -sub stop_lackwit { - print $lackwit_in_fh "quit\n"; - waitpid $lackwit_pid, 0; -} - -sub _lackwit_fast { - my ($function, $variable) = @_; - while (my $line = <$lackwit_out_fh>) { - last if $line eq "<>\n"; - } - print $lackwit_in_fh "searchlocal $function:$variable -all\n"; - my @lines; - while (my $line = <$lackwit_out_fh>) { - last if $line eq "<>\n"; - push @lines, $line unless $line =~ /[#\@\{]/; - } - return join("", @lines); -} - -sub _lackwit_robust { - my ($function, $variable) = @_; - # On Solaris, "sh -c" is required to prevent the 'Segmentation Fault' - # error message from going to standard error. For some reason, in - # Solaris, segfaults bypass stderr redirection in an interactive shell. - my $result = - `echo "searchlocal $function:$variable -all" | sh -c BackEnd 2>&1`; - if ($CHILD_ERROR != 0) { - if (is_struct_field($variable)) { - return ""; - } else { -# die_and_restore "FAILURE: BackEnd failed on $function:$variable"; - print "warning: BackEnd failed on $function:$variable. continuing.\n"; - return ""; - } - } - return $result; -} - - -# returns the implicit type of a variable, as an integer -sub implicit_type { - my ($var) = @_; - my @explicit_type = explicit_type($var); - - my $key = join ' ', (sort @explicit_type); - - if (not exists $explicit_to_implicit{$key}) { - my @types = sort {$a <=> $b;} values %explicit_to_implicit; - if (my $maximum_type = pop @types) { - $explicit_to_implicit{$key} = $maximum_type + 1; - } else { - $explicit_to_implicit{$key} = 1; - } - } - return $explicit_to_implicit{$key}; -} - - -# returns the explicit type of a variable, as a list of other -# variables -sub explicit_type { - my ($var) = @_; - foreach my $list_ref (@compar_lists) { - my @compar_list = @{$list_ref}; - if (grep {$_ eq $var} @compar_list) { - return @compar_list; - } - } -} - - -# transforms a variable read from a decls file into a variable that -# lackwit can process -sub transform { - my ($var) = @_; - - # change "return" to "$dummy_return" when appropriate - if ($var eq "return" || $var eq "return[]" || - $var =~ /^return->/ || $var =~ /^return\./) { - $var =~ s/^return/$dummy_return/; - } - - # remove the leading "::" from global variables - $var =~ s/^:://; - - return $var; -} - - -# Given a list of list refs, unifies the lists with common elements. -# Returns a list of list refs, such that the sublists are disjoint. -sub disjoint_lists { - my (@lists) = @_; - my $cur_list_index = 0; - while ($cur_list_index < @lists) { - my $cur_list_ref = $lists[$cur_list_index]; - my $cur_elem_index = 0; - while ($cur_elem_index < @{$cur_list_ref}) { - my $cur_elem = $cur_list_ref->[$cur_elem_index]; - my $other_list_index = $cur_list_index + 1; - while ($other_list_index < @lists) { - my $other_list_ref = $lists[$other_list_index]; - my $other_list_removed = 0; - if (grep {$_ eq $cur_elem} @{$other_list_ref}) { - unify_lists($cur_list_ref, $other_list_ref); - # remove the other list - splice @lists, $other_list_index, 1; - $other_list_removed = 1; - } - if (! $other_list_removed) { - $other_list_index++; - } - } - $cur_elem_index++; - } - $cur_list_index++; - } - return @lists; -} - - -# Takes two list references as arguments. Adds each element of the -# second list to the end of the first, if the element is not already -# in the first list -sub unify_lists { - my ($list_ref1, $list_ref2) = @_; - foreach my $elem (@{$list_ref2}) { - if (! (grep {$_ eq $elem} @{$list_ref1})) { - push @{$list_ref1}, $elem; - } - } -} - - -# takes a list of lists and a hash. -# filters each sublist, keeping only the elements present in the hash. -# returns the new list of lists -sub filter_lists_by_hash { - my ($lists_ref, $hash_ref) = @_; - my @new_lists = (); - foreach my $list_ref (@{$lists_ref}) { - my @list = @{$list_ref}; - my @new_list = grep {exists $hash_ref->{$_}} @list; - push @new_lists, \@new_list; - } - return @new_lists; -} diff --git a/scripts/set_decl_type.pl b/scripts/set_decl_type.pl deleted file mode 100755 index a75afd0c9c..0000000000 --- a/scripts/set_decl_type.pl +++ /dev/null @@ -1,94 +0,0 @@ -#!/usr/bin/env perl - -## Usage: set_decl_type []- - -## Sets the type of the specified specified variable. -## If a program point is specified, only the specified variable -## at that program point is modified. Any number of var/type pairs -## can be specified. - -use English; -use strict; -$WARNING = 1; # "-w" flag -my $debug = 0; -my $verbose = 1; -my @vars; -my @new_types; -my $line; -my @dfile; - -#process arguments -while (@ARGV) { - push @vars, shift @ARGV; - push @new_types, shift @ARGV; -} - -#read the whole file (its usually not too long) into an array -while ($line = ) { - push @dfile, ($line); - chomp ($dfile[$#dfile]); -} - -#process each var/aux pair -while (@vars) { - my $var = shift @vars; - my $new_type = shift @new_types; - my $ppt; - if ($var =~ "-") { - ($ppt, $var) = split (/-/, $var); - } else { - $ppt = "."; - } - if ($debug || $verbose) { - print STDERR "processing $ppt - $var ($new_type)\n"; - } - - #loop through the decls looking for matches - for (my $i = 0; $i <= $#dfile; $i++) { - $line = $dfile[$i]; - if ($line eq "DECLARE") { - $line = $dfile[++$i]; - if (!($line =~ /$ppt/) && ($line ne $ppt)) { - next; - } - if ($debug) { - print STDERR "found matching ppt: $line\n"; - } - $line = $dfile[++$i]; - while ($line && $line ne "\n") { - my $varname = $line;; - my $type = $dfile[++$i]; - my $rep = $dfile[++$i]; - my $comp = $dfile[++$i]; - $line = $dfile[++$i]; - #if ($debug) { - # print STDERR "looking $varname | $type | $rep | $comp\n"; - #} - if ($varname eq $var) { - if ($debug) { - print STDERR "FOUND $varname | $type | $rep | $comp\n"; - } - my $type_only; - my $aux; - if ($type =~ / /) { - ($type_only, $aux) = split (' *', $type, 2); - } else { - $type_only = $type; - $aux = ""; - } - - $type = "$new_type $aux"; - if ($debug) { - print STDERR "New type = $type\n"; - } - $dfile[$i-3] = $type; - $dfile[$i-2] = $new_type; - } - } - - } - } -} -foreach $line (@dfile) { - print "$line\n"; -} diff --git a/scripts/sort-dtrace.pl b/scripts/sort-dtrace.pl index 39f7fa94ba..2ef03b78b8 100755 --- a/scripts/sort-dtrace.pl +++ b/scripts/sort-dtrace.pl @@ -2,7 +2,7 @@ # Canonicalize a .decls, .dtrace, or combined .dtrace file by sorting # PPT declarations, and the variables within each program point, into -# alphabetical order. Each contiguous series of DECLARE paragraphs is +# alphabetical order. Each contiguous series of ppt declaration paragraphs is # reordered, while trace paragraphs remain in the same order as in the # original file. # This change is semantics-preserving: Daikon produces the same @@ -13,7 +13,6 @@ use warnings; my @decls; -my $decls_2 = 0; sub flush_decls { if (@decls) { @@ -26,11 +25,7 @@ sub flush_decls { $/ = ""; # Read by paragraph while (<>) { - if ((/^VarComparability/)) { - print; - next; - } elsif ((/^decl\-version.+/) || (/^decl\-input.+/) || (/^input\-language.+/) || (/^var\-comparability.+/)) { - $decls_2 = 1; + if ((/^decl\-version.+/) || (/^decl\-input.+/) || (/^input\-language.+/) || (/^var\-comparability.+/)) { print; next; } elsif((/^ppt\s.+/)) { @@ -67,18 +62,6 @@ sub flush_decls { push @decls, join("", @ppt); - }elsif (/^DECLARE/) { - chomp; - my @lines = split(/\n/, $_); - die "Bad .decls paragraph format" if shift @lines ne "DECLARE"; - my $ppt_name = shift @lines; - die "Bad number of lines" unless @lines % 4 == 0; - my @vars; - while (@lines) { - push @vars, join("\n", splice(@lines, 0, 4)); - } - @vars = sort @vars; - push @decls, join("\n", "DECLARE", $ppt_name, @vars); } else { flush_decls(); chomp; From 5d304d1978478d104dcc721a02f2b18a3ba94679 Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Tue, 6 Oct 2026 17:55:05 -0700 Subject: [PATCH 02/15] Address code review: reject version 1 input, use rep types, skip constants - extract_vars.pl: exclude variables by rep type rather than by name; drop redundant check - dtrace-count.pl, dtrace-indent.pl, sort-dtrace.pl, dtrace-diff.pl, convertcsv.pl: reject version 1 declarations explicitly - convertcsv.pl: skip constant variables; escape newlines and carriage returns - dtrace-add-cluster.pl: handle EOF in skip_till_next - decls-add-cluster.pl: link cluster variable for all parent relation types - CHANGELOG: note that version 1 input is no longer accepted --- doc/CHANGELOG.md | 2 ++ scripts/convertcsv.pl | 24 ++++++++++++++++++++---- scripts/decls-add-cluster.pl | 4 ++-- scripts/dtrace-add-cluster.pl | 9 +++++---- scripts/dtrace-count.pl | 1 + scripts/dtrace-diff.pl | 2 ++ scripts/dtrace-indent.pl | 1 + scripts/extract_vars.pl | 22 ++++++++++------------ scripts/sort-dtrace.pl | 1 + 9 files changed, 44 insertions(+), 22 deletions(-) diff --git a/doc/CHANGELOG.md b/doc/CHANGELOG.md index f4c85c249b..8e9154d749 100644 --- a/doc/CHANGELOG.md +++ b/doc/CHANGELOG.md @@ -27,6 +27,8 @@ Scripts: * `convertcsv.pl` and the cluster analysis scripts (`runcluster.pl` and the scripts it calls) now write version 2 files. +* `convertcsv.pl -decl`, `dtrace-count.pl`, `dtrace-diff.pl`, + `dtrace-indent.pl`, and `sort-dtrace.pl` no longer accept version 1 files. * Removed scripts that processed only version 1 files: `auxinfo.pl`, `clean-decls.php`, `copy_comparable.pl`, `decls2comp-1.0.py`, `decls-lackwit-disjoint.pl`, `dfec-to-kvasir.py`, `dfec-to-kvasir-dtrace.py`, diff --git a/scripts/convertcsv.pl b/scripts/convertcsv.pl index e058d4093d..429b010723 100755 --- a/scripts/convertcsv.pl +++ b/scripts/convertcsv.pl @@ -67,10 +67,13 @@ ### # Converts a name to the form used in declaration and data trace files: -# backslashes are escaped and blanks are replaced by "\_". +# backslashes, newlines, and carriage returns are escaped, and blanks are +# replaced by "\_". Like FileIO.escape_decl in Daikon. sub escapeDecl ( $ ) { my ($name) = check_args(1, @_); $name =~ s/\\/\\\\/g; + $name =~ s/\n/\\n/g; + $name =~ s/\r/\\r/g; $name =~ s/ /\\_/g; return $name; } @@ -85,24 +88,37 @@ ( $ ) # Parses the provided declaration file, which must contain only one # program point. # Returns an array containing the program point name and the names of -# variables. +# non-constant variables (the ones whose values appear in data trace records). sub parseDecl ( $ ) { my ($inputfile) = check_args(1, @_); open(DECLHANDLE, $inputfile) || die("Cannot open declarations file $inputfile"); my $ppt; my @varnames; + # The variable currently being read, and whether it is a constant. + my ($varname, $is_constant); + my $record_var = sub { + if (defined($varname) && !$is_constant) { + push @varnames, $varname; + } + }; while () { - if (/^ppt\s+(\S+)\s*$/) { + if (/^(DECLARE|VarComparability)$/) { + die "Version 1 declaration file $inputfile is not supported; convert it to version 2 format"; + } elsif (/^ppt\s+(\S+)\s*$/) { if (defined($ppt)) { die "Declaration file $inputfile contains more than one program point"; } $ppt = unescapeDecl($1); } elsif (/^\s*variable\s+(\S+)\s*$/) { - push @varnames, unescapeDecl($1); + &$record_var(); + ($varname, $is_constant) = (unescapeDecl($1), 0); + } elsif (/^\s*constant\s/) { + $is_constant = 1; } } + &$record_var(); close(DECLHANDLE); if (!defined($ppt)) { die "Didn't see a \"ppt\" record in declaration file $inputfile"; diff --git a/scripts/decls-add-cluster.pl b/scripts/decls-add-cluster.pl index a6b253128a..3a70e193ae 100755 --- a/scripts/decls-add-cluster.pl +++ b/scripts/decls-add-cluster.pl @@ -23,7 +23,7 @@ # cluster variable. The cluster variable must precede the other # variables, but must follow the ppt-level records such as ppt-type. my $pending = 0; - # The "parent"-type parent records of the current program point, as + # The parent records of the current program point, as # " " strings. The cluster variable is # linked to the cluster variable of each such parent, so that, for # example, an OBJECT program point gets cluster values from its methods. @@ -38,7 +38,7 @@ if ($line =~ /^ppt /) { $pending = 1; @parents = (); - } elsif ($pending && $line =~ /^\s*parent\s+parent\s+(\S+)\s+(\S+)\s*$/) { + } elsif ($pending && $line =~ /^\s*parent\s+\S+\s+(\S+)\s+(\S+)\s*$/) { push @parents, "$1 $2"; } } diff --git a/scripts/dtrace-add-cluster.pl b/scripts/dtrace-add-cluster.pl index ce8b55bbe8..f714261ff3 100755 --- a/scripts/dtrace-add-cluster.pl +++ b/scripts/dtrace-add-cluster.pl @@ -210,10 +210,11 @@ ( $ ) # read an opened file till you reach a blank line, then return sub skip_till_next(*) { local *FHANDLE = $_[0]; - my $line; - do { - $line = ; - } until ($line =~ /^\s*$/); + while (my $line = ) { + if ($line =~ /^\s*$/) { + return; + } + } return; } # skip_till_next diff --git a/scripts/dtrace-count.pl b/scripts/dtrace-count.pl index 1d1b81a160..76826866bd 100755 --- a/scripts/dtrace-count.pl +++ b/scripts/dtrace-count.pl @@ -18,6 +18,7 @@ $/ = ""; # Read by paragraph while (<>) { + die "Version 1 declarations are not supported; convert to version 2 format" if /^(DECLARE|VarComparability)$/m; # Skip .decls-like paras next if /^(ppt |decl-version|var-comparability|input-language|ListImplementors|\/\/)/; next if /^Begin/ or /^Done/; # Skip processing program point comments diff --git a/scripts/dtrace-diff.pl b/scripts/dtrace-diff.pl index 5c5231e903..6e65233752 100755 --- a/scripts/dtrace-diff.pl +++ b/scripts/dtrace-diff.pl @@ -111,6 +111,8 @@ ( $ ) $$lhashref{"variable order"} = [ @varorder ]; $$declshash{$currppt} = $lhashref; $ppt_seen = 1; + } elsif (($l eq "DECLARE") || ($l eq "VarComparability")) { + die "Version 1 declarations are not supported; convert $mydeclsname to version 2 format"; } elsif (($l eq "ListImplementors") && !$ppt_seen) { # It's ok to have a ListImplementors in the decls file. # Read the type of comparability, then move on. diff --git a/scripts/dtrace-indent.pl b/scripts/dtrace-indent.pl index 02b342e72c..ba2510d40b 100755 --- a/scripts/dtrace-indent.pl +++ b/scripts/dtrace-indent.pl @@ -14,6 +14,7 @@ $/ = ""; # Read by paragraph while (<>) { + die "Version 1 declarations are not supported; convert to version 2 format" if /^(DECLARE|VarComparability)$/m; # Skip .decls-like paras next if /^(ppt |decl-version|var-comparability|input-language|ListImplementors|\/\/)/; /^(.*):::([A-Z\d]+)$/m or die "Can't parse PPT name from <$_>"; diff --git a/scripts/extract_vars.pl b/scripts/extract_vars.pl index d04c068e55..e1abd2c7b8 100755 --- a/scripts/extract_vars.pl +++ b/scripts/extract_vars.pl @@ -302,12 +302,10 @@ ( $ ) $value =~ s/NaN/1e10/; my $mod = ; # "$mod" is unused - # extract variables to be clustered. - # Omit Object variables, class names, arrays, and strings. - if (!excluded_var($varname)) { - if ( exists $pptname_to_varnames{$pptname}{$varname}) { - push @vararray, $value; - } + # extract variables to be clustered. read_decl_ppt omits class names, + # arrays, and strings from %pptname_to_varnames. + if (exists $pptname_to_varnames{$pptname}{$varname}) { + push @vararray, $value; } $varname = ; @@ -486,11 +484,11 @@ ( $ ) } } # read_decls_file -# Returns true if the variable should not be clustered: its value is a -# class name, an array, or a string. -sub excluded_var ( $ ) { - my ($varname) = @_; - return ($varname =~ /\.getClass\(\)/ || $varname =~ /\[\.\.\]/ || $varname =~ /\.toString/); +# Returns true if a variable with the given rep type should not be +# clustered: its value is a string (including a class name) or an array. +sub excluded_rep_type ( $ ) { + my ($rep_type) = @_; + return ($rep_type eq "java.lang.String" || $rep_type =~ /\[\]$/); } # read a program point declaration in the decls file. The "ppt" line, @@ -505,7 +503,7 @@ ( $ ) # Records the variable that was just read. my $record_var = sub { - if (!defined($varname) || excluded_var($varname)) { + if (!defined($varname) || excluded_rep_type($rep_type)) { return; } # If the variable is an Object, keep note of that. Will be ignored (not diff --git a/scripts/sort-dtrace.pl b/scripts/sort-dtrace.pl index 2ef03b78b8..9e8a0246bf 100755 --- a/scripts/sort-dtrace.pl +++ b/scripts/sort-dtrace.pl @@ -25,6 +25,7 @@ sub flush_decls { $/ = ""; # Read by paragraph while (<>) { + die "Version 1 declarations are not supported; convert to version 2 format" if /^(DECLARE|VarComparability)$/m; if ((/^decl\-version.+/) || (/^decl\-input.+/) || (/^input\-language.+/) || (/^var\-comparability.+/)) { print; next; From e455d4801dbcbdfe28ef8dca3d29ad6005ec90a8 Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Tue, 6 Oct 2026 18:22:42 -0700 Subject: [PATCH 03/15] Address code review: share helpers, fix version 2 parsing bugs - util_daikon.pm: add die_if_version_1_decl (checks only a paragraph's first line), is_declaration_paragraph, and skip_till_next - dtrace-count.pl, dtrace-indent.pl, sort-dtrace.pl, dtrace-diff.pl, convertcsv.pl: use the shared helpers - dtrace-diff.pl: skip declaration paragraphs in combined dtrace files; skip constant variables - sort-dtrace.pl: pass through comment paragraphs - decls-add-cluster.pl: link the cluster variable only for "parent" relations, not "user" relations - extract_vars.pl: check for constants before hashcodes; fix null-object assignment; handle end of file without a trailing blank line - convertcsv.pl, extract_vars.pl: replace closures with simpler code - decls2comp.py: implement the no-hashcodes option; remove Lackwit note --- scripts/convertcsv.pl | 22 +++++------- scripts/decls-add-cluster.pl | 7 ++-- scripts/decls2comp.py | 11 +++--- scripts/dtrace-add-cluster.pl | 12 ------- scripts/dtrace-count.pl | 10 ++++-- scripts/dtrace-diff.pl | 56 +++++++++++++++++------------ scripts/dtrace-indent.pl | 10 ++++-- scripts/extract_vars.pl | 66 +++++++++++++---------------------- scripts/sort-dtrace.pl | 17 ++++++--- scripts/util_daikon.pm | 33 +++++++++++++++++- 10 files changed, 138 insertions(+), 106 deletions(-) diff --git a/scripts/convertcsv.pl b/scripts/convertcsv.pl index 429b010723..17f48c3291 100755 --- a/scripts/convertcsv.pl +++ b/scripts/convertcsv.pl @@ -21,6 +21,8 @@ # The file `checkargs.pm` appears in the same directory as this script. use checkargs; +# The file `util_daikon.pm` appears in the same directory as this script. +use util_daikon; # TODO: # If using "-m interpolate", then what about missing values before the @@ -95,30 +97,22 @@ ( $ ) die("Cannot open declarations file $inputfile"); my $ppt; my @varnames; - # The variable currently being read, and whether it is a constant. - my ($varname, $is_constant); - my $record_var = sub { - if (defined($varname) && !$is_constant) { - push @varnames, $varname; - } - }; while () { - if (/^(DECLARE|VarComparability)$/) { - die "Version 1 declaration file $inputfile is not supported; convert it to version 2 format"; - } elsif (/^ppt\s+(\S+)\s*$/) { + die_if_version_1_decl($_, $inputfile); + if (/^ppt\s+(\S+)\s*$/) { if (defined($ppt)) { die "Declaration file $inputfile contains more than one program point"; } $ppt = unescapeDecl($1); } elsif (/^\s*variable\s+(\S+)\s*$/) { - &$record_var(); - ($varname, $is_constant) = (unescapeDecl($1), 0); + push @varnames, unescapeDecl($1); } elsif (/^\s*constant\s/) { - $is_constant = 1; + # The most recently read variable is a constant, so its value does + # not appear in data trace records. + pop @varnames; } } - &$record_var(); close(DECLHANDLE); if (!defined($ppt)) { die "Didn't see a \"ppt\" record in declaration file $inputfile"; diff --git a/scripts/decls-add-cluster.pl b/scripts/decls-add-cluster.pl index 3a70e193ae..0992306c65 100755 --- a/scripts/decls-add-cluster.pl +++ b/scripts/decls-add-cluster.pl @@ -23,10 +23,13 @@ # cluster variable. The cluster variable must precede the other # variables, but must follow the ppt-level records such as ppt-type. my $pending = 0; - # The parent records of the current program point, as + # The "parent"-type parent records of the current program point, as # " " strings. The cluster variable is # linked to the cluster variable of each such parent, so that, for # example, an OBJECT program point gets cluster values from its methods. + # "user"-type relations are not followed: they link a program point + # to an unrelated program point, such as the OBJECT program point of a + # parameter's class. my @parents = (); while () { my $line = $_; @@ -38,7 +41,7 @@ if ($line =~ /^ppt /) { $pending = 1; @parents = (); - } elsif ($pending && $line =~ /^\s*parent\s+\S+\s+(\S+)\s+(\S+)\s*$/) { + } elsif ($pending && $line =~ /^\s*parent\s+parent\s+(\S+)\s+(\S+)\s*$/) { push @parents, "$1 $2"; } } diff --git a/scripts/decls2comp.py b/scripts/decls2comp.py index ffe32ceb95..777f16b9c1 100755 --- a/scripts/decls2comp.py +++ b/scripts/decls2comp.py @@ -68,10 +68,6 @@ REP_START = "rep-type " COMP_START = "comparability " -# Note: Lackwit produces comparability numbers for arrays in the -# following format: '9[10]' - we are going to ignore what is between -# the brackets so we will treat it as '9' - ignore_hashcodes = False if len(sys.argv) < 2: @@ -140,6 +136,7 @@ # prefixed by comparability cur_var = None + hashcode_vars = set() # Variables whose rep. type is a hashcode for line in v: stripped_line = line.strip() @@ -148,6 +145,8 @@ elif stripped_line[0 : len(REP_START)] == REP_START: assert cur_var # There should have been a variable entry before rep-type cur_rep = stripped_line[len(REP_START) :] + if hashcode_re.match(cur_rep): + hashcode_vars.add(cur_var) elif stripped_line[0 : len(COMP_START)] == COMP_START: assert ( cur_var # There should have been a variable entry before comparability @@ -155,6 +154,10 @@ cur_comp = stripped_line[len(COMP_START) :] var2comp[cur_var] = cur_comp + if ignore_hashcodes: + for var in hashcode_vars: + var2comp.pop(var, None) + # Now we can do the real work of grouping variables together # in comparability sets based on their numbers sorted_vars = sorted(var2comp.keys()) diff --git a/scripts/dtrace-add-cluster.pl b/scripts/dtrace-add-cluster.pl index f714261ff3..f843685f7b 100755 --- a/scripts/dtrace-add-cluster.pl +++ b/scripts/dtrace-add-cluster.pl @@ -207,18 +207,6 @@ ( $ ) } # insert_cluster_info -# read an opened file till you reach a blank line, then return -sub skip_till_next(*) { - local *FHANDLE = $_[0]; - while (my $line = ) { - if ($line =~ /^\s*$/) { - return; - } - } - return; -} # skip_till_next - - # copy one file into another, until a blank line is reached. sub copy_till_next(**) { my $line; diff --git a/scripts/dtrace-count.pl b/scripts/dtrace-count.pl index 76826866bd..5335aa3dbd 100755 --- a/scripts/dtrace-count.pl +++ b/scripts/dtrace-count.pl @@ -9,6 +9,12 @@ use 5.006; use warnings; +# Put the script directory on the @INC path. +use File::Basename; +use lib dirname (__FILE__); +# The file `util_daikon.pm` appears in the same directory as this script. +use util_daikon; + # $ppt_count{ppt_name} = [count, num_lines]; # num_lines is the number of lines in each dtrace record. # It is measured to detect discrepancies, which indicate errors in the trace file. @@ -18,9 +24,9 @@ $/ = ""; # Read by paragraph while (<>) { - die "Version 1 declarations are not supported; convert to version 2 format" if /^(DECLARE|VarComparability)$/m; + die_if_version_1_decl($_); # Skip .decls-like paras - next if /^(ppt |decl-version|var-comparability|input-language|ListImplementors|\/\/)/; + next if is_declaration_paragraph($_); next if /^Begin/ or /^Done/; # Skip processing program point comments # This script assumes that each program point name contains ":::". /^(.*):::(.+)$/m or die "Can't parse PPT name from <$_>"; diff --git a/scripts/dtrace-diff.pl b/scripts/dtrace-diff.pl index 6e65233752..52104c0a54 100755 --- a/scripts/dtrace-diff.pl +++ b/scripts/dtrace-diff.pl @@ -9,6 +9,12 @@ use strict; $WARNING = 1; +# Put the script directory on the @INC path. +use File::Basename; +use lib dirname (__FILE__); +# The file `util_daikon.pm` appears in the same directory as this script. +use util_daikon; + my $ignore_exitno = 0; if ($ARGV[0] eq "--ignore_exitno") { @@ -70,56 +76,53 @@ ( $ ) while (defined (my $l = getline($decls))) { $l =~ s://.*::; # strip any comments on this line + die_if_version_1_decl($l, $mydeclsname); if (($l =~ /(^ppt\s+)(.+)/)) { my $currppt = $2; my $lhashref = {}; my @varorder = (); + # The variable currently being read, and its + # [dec-type, rep-type, comparability] triple. my $curvar = ""; - my $currep = ""; - my $curdec = ""; - my $curcomp = ""; + my $curinfo; while(my $subline = getline($decls)) { $subline =~ s/^\s+//; $subline =~ s/\s+$//; if($subline =~ /(^variable\s+)(.+)/) { - unless($curvar eq "") { # Push stuff to the stack - $$lhashref{$curvar} = [$curdec, $currep, $curcomp]; - push @varorder, $curvar; - } $curvar = $2; + $curinfo = ["", "", ""]; + $$lhashref{$curvar} = $curinfo; + push @varorder, $curvar; }elsif (($subline =~ /^parent.+/) || ($subline =~ /^ppt\-type.+/) || ($subline =~ /^flags.+/)) { }elsif ($curvar eq "") { die "Malformed decls file: \"$subline\" at line $INPUT_LINE_NUMBER instead of variable declaration"; + }elsif ($subline =~ /^constant\s/) { + # A constant's value does not appear in data trace records. + delete $$lhashref{$curvar}; + pop @varorder; }elsif ($subline =~ /(^rep\-type\s*)(.+)/) { - $currep = $2; + $$curinfo[1] = $2; }elsif ($subline =~ /(^dec-type\s*)(.+)/) { - $curdec = $2; + $$curinfo[0] = $2; }elsif ($subline =~ /(^comparability\s*)(.+)/) { - $curcomp = $2; + $$curinfo[2] = $2; } } - unless($curvar eq "") { # Push stuff to the stack - $$lhashref{$curvar} = [$curdec, $currep, $curcomp]; - push @varorder, $curvar; - } $$lhashref{"variable order"} = [ @varorder ]; $$declshash{$currppt} = $lhashref; $ppt_seen = 1; - } elsif (($l eq "DECLARE") || ($l eq "VarComparability")) { - die "Version 1 declarations are not supported; convert $mydeclsname to version 2 format"; } elsif (($l eq "ListImplementors") && !$ppt_seen) { # It's ok to have a ListImplementors in the decls file. # Read the type of comparability, then move on. $l = getline($decls); - } elsif (($l =~ /^input\-language.+/) || - ($l =~ /^decl\-version.+/) || - ($l =~ /^var\-comparability.+/)){ + } elsif (is_declaration_paragraph($l)) { + # A header line } elsif ($l) { die "malformed decls file: \"$l\" at line $INPUT_LINE_NUMBER of $mydeclsname"; } @@ -134,12 +137,19 @@ ( $$ ) # file, and hash mapping varname to array of value and modbit. my ($dtfh, $dtfhname) = @_; my $pptname = getline($dtfh); - while ((defined $pptname) && (($pptname eq "") || - ($pptname =~ /^input\-language.+/) || - ($pptname =~ /^decl\-version.+/) || - ($pptname =~ /^var\-comparability.+/))) { + # Skip blank lines and declaration paragraphs, such as headers and + # program point declarations in a combined .dtrace file. + while ((defined $pptname) + && (($pptname eq "") || is_declaration_paragraph($pptname))) { + if ($pptname ne "") { + # Skip the rest of the paragraph. + do { + $pptname = getline($dtfh); + } while ((defined $pptname) && ($pptname ne "")); + } $pptname = getline($dtfh); } + (defined $pptname) and die_if_version_1_decl($pptname, $dtfhname); (defined $pptname) diff --git a/scripts/dtrace-indent.pl b/scripts/dtrace-indent.pl index ba2510d40b..e1760c0d46 100755 --- a/scripts/dtrace-indent.pl +++ b/scripts/dtrace-indent.pl @@ -10,13 +10,19 @@ use 5.006; use warnings; +# Put the script directory on the @INC path. +use File::Basename; +use lib dirname (__FILE__); +# The file `util_daikon.pm` appears in the same directory as this script. +use util_daikon; + my $indentation = 0; $/ = ""; # Read by paragraph while (<>) { - die "Version 1 declarations are not supported; convert to version 2 format" if /^(DECLARE|VarComparability)$/m; + die_if_version_1_decl($_); # Skip .decls-like paras - next if /^(ppt |decl-version|var-comparability|input-language|ListImplementors|\/\/)/; + next if is_declaration_paragraph($_); /^(.*):::([A-Z\d]+)$/m or die "Can't parse PPT name from <$_>"; my $base = $1; my $suffix = $2; diff --git a/scripts/extract_vars.pl b/scripts/extract_vars.pl index e1abd2c7b8..b7aa9a9ef3 100755 --- a/scripts/extract_vars.pl +++ b/scripts/extract_vars.pl @@ -270,7 +270,7 @@ ( $ ) } # get the values of the variables at this ppt that we want to cluster - while ($varname !~ /^$/) { + while (defined($varname) && $varname !~ /^$/) { chomp( $varname ); $value = ; chomp ($value); @@ -287,7 +287,7 @@ ( $ ) if ($object) { if ($value =~ /null/) { - $value =~ -5; + $value = -5; } elsif ($value =~ /missing/) { $value = 0; } else { @@ -418,17 +418,6 @@ ( @ ) } } -# read an opened file till you reach a blank line, then return -# (used to skip a paragraph of lines). -sub skip_till_next ( * ) { - local *FHANDLE = $_[0]; - while (my $line = ) { - if ($line =~ /^\s*$/) { - return; - } - } -} # skip_till_next - # return an array of $target random numbers between 0 (inclusive) and # $max(exclusive). These are used to sample the invocations at a # program point. @@ -496,43 +485,38 @@ ( $ ) sub read_decl_ppt ( $ ) { my ($pptname) = @_; - my $nvars; # number of variables at the program point + my $nvars = 0; # number of variables at the program point - # The variable being read, its rep type, and whether it is a constant. - my ($varname, $rep_type, $is_constant); + # The variables at the program point, in order. Each element is a + # reference to a [name, rep-type, is-constant] array. + my @vars = (); - # Records the variable that was just read. - my $record_var = sub { - if (!defined($varname) || excluded_rep_type($rep_type)) { - return; + # now read the variable names and types + my $line; + while ( defined($line = ) && ($line !~ /^\s*$/) ) { + if ($line =~ /^\s*variable\s+(.*?)\s*$/) { + push @vars, [$1, "", 0]; + } elsif (@vars && $line =~ /^\s*rep-type\s+(.*?)\s*$/) { + $vars[-1][1] = $1; + } elsif (@vars && $line =~ /^\s*constant\s/) { + $vars[-1][2] = 1; + } + } + + foreach my $var (@vars) { + my ($varname, $rep_type, $is_constant) = @$var; + # A constant's value does not appear in data trace records. + if ($is_constant || excluded_rep_type($rep_type)) { + next; } # If the variable is an Object, keep note of that. Will be ignored (not # be clustered) later because its value is a hashcode. if ($rep_type =~ /hashcode/) { push @{$pptname_to_objectvars{$pptname}}, $varname; - $nvars++; # added for object - $pptname_to_varnames{$pptname}{$varname} = 1; - } elsif ($is_constant) { - # definition. do nothing - } else { - $nvars++; - $pptname_to_varnames{$pptname}{$varname} = 1; - } - }; - - # now read the variable names and types - my $line; - while ( defined($line = ) && ($line !~ /^\s*$/) ) { - if ($line =~ /^\s*variable\s+(.*?)\s*$/) { - &$record_var(); - ($varname, $rep_type, $is_constant) = ($1, "", 0); - } elsif ($line =~ /^\s*rep-type\s+(.*?)\s*$/) { - $rep_type = $1; - } elsif ($line =~ /^\s*constant\s/) { - $is_constant = 1; } + $nvars++; + $pptname_to_varnames{$pptname}{$varname} = 1; } - &$record_var(); # Store the number of variables at this program point. Remember that # @vararray[1] stores the program point name. The invocation nonce is # included in @vararray, but is not counted as a variable. diff --git a/scripts/sort-dtrace.pl b/scripts/sort-dtrace.pl index 9e8a0246bf..cb7d814632 100755 --- a/scripts/sort-dtrace.pl +++ b/scripts/sort-dtrace.pl @@ -12,6 +12,12 @@ use 5.006; use warnings; +# Put the script directory on the @INC path. +use File::Basename; +use lib dirname (__FILE__); +# The file `util_daikon.pm` appears in the same directory as this script. +use util_daikon; + my @decls; sub flush_decls { @@ -25,11 +31,8 @@ sub flush_decls { $/ = ""; # Read by paragraph while (<>) { - die "Version 1 declarations are not supported; convert to version 2 format" if /^(DECLARE|VarComparability)$/m; - if ((/^decl\-version.+/) || (/^decl\-input.+/) || (/^input\-language.+/) || (/^var\-comparability.+/)) { - print; - next; - } elsif((/^ppt\s.+/)) { + die_if_version_1_decl($_); + if (/^ppt\s.+/) { my @lines = split(/\n/, $_); my @vars; my $var = ""; @@ -63,6 +66,10 @@ sub flush_decls { push @decls, join("", @ppt); + } elsif (is_declaration_paragraph($_)) { + # A header or comment + flush_decls(); + print; } else { flush_decls(); chomp; diff --git a/scripts/util_daikon.pm b/scripts/util_daikon.pm index 734320a303..a4768344cd 100755 --- a/scripts/util_daikon.pm +++ b/scripts/util_daikon.pm @@ -6,7 +6,8 @@ package util_daikon; require 5.003; # uses prototypes require Exporter; our @ISA = qw(Exporter); -our @EXPORT = qw( cleanup_pptname system_or_die backticks_or_die ); +our @EXPORT = qw( cleanup_pptname system_or_die backticks_or_die + die_if_version_1_decl is_declaration_paragraph skip_till_next ); use English; use strict; @@ -73,6 +74,36 @@ sub cleanup_pptname ( $ ) { return $result; } +# Dies if the argument, which is a paragraph or the first line of a +# paragraph from a .decls or .dtrace file, is a version 1 declaration. +# Only the first line is examined, because a later line of a data record +# may be a variable name such as "DECLARE". The optional second argument +# is the name of the file, for use in the error message. +sub die_if_version_1_decl ( $;$ ) { + my ($para, $filename) = check_args_range(1, 2, @_); + if ($para =~ /\A(DECLARE|VarComparability)$/m) { + my $file = defined($filename) ? " $filename" : ""; + croak "Version 1 declarations are not supported; convert$file to version 2 format"; + } +} + +# Returns true if the argument, which is a paragraph or the first line of a +# paragraph from a version 2 .decls or .dtrace file, is not a data record: +# that is, it is a program point declaration, a header, or a comment. +sub is_declaration_paragraph ( $ ) { + my ($para) = @_; + return $para =~ /\A(ppt |decl-version|decl-input|var-comparability|input-language|ListImplementors|\/\/)/; +} + +# Reads lines from the filehandle until reaching a blank line or end of +# file. This skips the remainder of the current paragraph. +sub skip_till_next ( * ) { + my ($fh) = @_; + while (defined(my $line = <$fh>)) { + last if $line =~ /^\s*$/; + } +} + ########################################################################### ### End of file From b21496c11a6cfff6e61ee2795e4953a3f7f0b2ab Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Tue, 6 Oct 2026 22:16:56 -0700 Subject: [PATCH 04/15] Address code review: shared decls parser, comment handling, version 1 checks - Reject version 1 input in the cluster scripts. - Accept # comments, and comments not followed by a blank line. - Detect version 1 files with CRLF line endings or trailing whitespace. - Detect an existing variable named "cluster". - In dtrace-diff.pl, explain mismatches involving constants. - Move escape_decl, unescape_decl, and a version 2 decls parser to util_daikon.pm. - Classify each record with a single regular expression. - Remove decl-input. --- doc/CHANGELOG.md | 3 +- scripts/convertcsv.pl | 59 +++--------- scripts/decls-add-cluster.pl | 87 ++++++++++++----- scripts/dtrace-add-cluster.pl | 20 ++-- scripts/dtrace-count.pl | 5 +- scripts/dtrace-diff.pl | 133 +++++++++++--------------- scripts/dtrace-indent.pl | 5 +- scripts/extract_vars.pl | 115 +++++++++++------------ scripts/sort-dtrace.pl | 16 +++- scripts/util_daikon.pm | 170 ++++++++++++++++++++++++++++++---- 10 files changed, 369 insertions(+), 244 deletions(-) diff --git a/doc/CHANGELOG.md b/doc/CHANGELOG.md index 8e9154d749..fb062866ae 100644 --- a/doc/CHANGELOG.md +++ b/doc/CHANGELOG.md @@ -28,7 +28,8 @@ Scripts: * `convertcsv.pl` and the cluster analysis scripts (`runcluster.pl` and the scripts it calls) now write version 2 files. * `convertcsv.pl -decl`, `dtrace-count.pl`, `dtrace-diff.pl`, - `dtrace-indent.pl`, and `sort-dtrace.pl` no longer accept version 1 files. + `dtrace-indent.pl`, `sort-dtrace.pl`, and the cluster analysis scripts no + longer accept version 1 files. * Removed scripts that processed only version 1 files: `auxinfo.pl`, `clean-decls.php`, `copy_comparable.pl`, `decls2comp-1.0.py`, `decls-lackwit-disjoint.pl`, `dfec-to-kvasir.py`, `dfec-to-kvasir-dtrace.py`, diff --git a/scripts/convertcsv.pl b/scripts/convertcsv.pl index 17f48c3291..d88f11165a 100755 --- a/scripts/convertcsv.pl +++ b/scripts/convertcsv.pl @@ -68,25 +68,6 @@ ### Subroutines that don't use global variables ### -# Converts a name to the form used in declaration and data trace files: -# backslashes, newlines, and carriage returns are escaped, and blanks are -# replaced by "\_". Like FileIO.escape_decl in Daikon. -sub escapeDecl ( $ ) { - my ($name) = check_args(1, @_); - $name =~ s/\\/\\\\/g; - $name =~ s/\n/\\n/g; - $name =~ s/\r/\\r/g; - $name =~ s/ /\\_/g; - return $name; -} - -# The inverse of escapeDecl. Like FileIO.unescape_decl in Daikon. -sub unescapeDecl ( $ ) { - my ($name) = check_args(1, @_); - $name =~ s/\\(.)/$1 eq "_" ? " " : $1 eq "n" ? "\n" : $1 eq "r" ? "\r" : $1/ge; - return $name; -} - # Parses the provided declaration file, which must contain only one # program point. # Returns an array containing the program point name and the names of @@ -95,30 +76,14 @@ ( $ ) my ($inputfile) = check_args(1, @_); open(DECLHANDLE, $inputfile) || die("Cannot open declarations file $inputfile"); - my $ppt; - my @varnames; - - while () { - die_if_version_1_decl($_, $inputfile); - if (/^ppt\s+(\S+)\s*$/) { - if (defined($ppt)) { - die "Declaration file $inputfile contains more than one program point"; - } - $ppt = unescapeDecl($1); - } elsif (/^\s*variable\s+(\S+)\s*$/) { - push @varnames, unescapeDecl($1); - } elsif (/^\s*constant\s/) { - # The most recently read variable is a constant, so its value does - # not appear in data trace records. - pop @varnames; - } - } + my @ppts = read_ppt_decls(\*DECLHANDLE, $inputfile); close(DECLHANDLE); - if (!defined($ppt)) { - die "Didn't see a \"ppt\" record in declaration file $inputfile"; + if (scalar(@ppts) > 1) { + die "Declaration file $inputfile contains more than one program point"; } - return ($ppt, @varnames); - + my $ppt = $ppts[0]; + my @varnames = map { $$_{name} } grep { !defined($$_{constant}) } @{$$ppt{vars}}; + return ($$ppt{name}, @varnames); } @@ -284,7 +249,7 @@ () die("Could not open $dtrace_file for output."); for (my $k = 0; $k < $num_samples; $k++) { - print DTRACEHANDLE "\n" . escapeDecl($programpointname) . "\n"; + print DTRACEHANDLE "\n" . escape_decl($programpointname) . "\n"; for (my $j = 0; $j < $num_decl_vars; $j++) { my $csvindex = $varNameCsvIndex{$decl_varnames[$j]}; if ($variableArray{$csvindex}[$k] eq "") { @@ -321,7 +286,7 @@ () $variableArray{$csvindex}[$k] = $prevvalues[$csvindex]; } } - print DTRACEHANDLE escapeDecl($csv_varnames[$csvindex]) . "\n"; + print DTRACEHANDLE escape_decl($csv_varnames[$csvindex]) . "\n"; print DTRACEHANDLE "$variableArray{$csvindex}[$k]\n"; print DTRACEHANDLE "1\n"; } @@ -403,7 +368,7 @@ ( $ ) } } - print DTRACEHANDLE escapeDecl($programpointname) . "\n"; + print DTRACEHANDLE escape_decl($programpointname) . "\n"; for (my $j = 0; $j<$num_decl_vars; $j++) { my $csvindex = $varNameCsvIndex{$decl_varnames[$j]}; my $value = $sample[$csvindex]; @@ -437,7 +402,7 @@ ( $ ) $variableArray{$csvindex}[$num_samples] = $value; } } - print DTRACEHANDLE escapeDecl($csv_varnames[$csvindex]) . "\n"; + print DTRACEHANDLE escape_decl($csv_varnames[$csvindex]) . "\n"; print DTRACEHANDLE "$value\n"; print DTRACEHANDLE "$modbit\n"; } @@ -449,12 +414,12 @@ ( $ ) if (defined($decls_file)) { print DECLSHANDLE "decl-version 2.0\n"; print DECLSHANDLE "var-comparability none\n\n"; - print DECLSHANDLE "ppt " . escapeDecl($programpointname) . "\n"; + print DECLSHANDLE "ppt " . escape_decl($programpointname) . "\n"; print DECLSHANDLE " ppt-type point\n"; for (my $j = 0; $j<$num_decl_vars; $j++) { my $csvindex = $varNameCsvIndex{$decl_varnames[$j]}; my $type = ($isNumber[$csvindex] ? "double" : "java.lang.String"); - print DECLSHANDLE " variable " . escapeDecl($csv_varnames[$csvindex]) . "\n"; + print DECLSHANDLE " variable " . escape_decl($csv_varnames[$csvindex]) . "\n"; print DECLSHANDLE " var-kind variable\n"; print DECLSHANDLE " dec-type $type\n"; print DECLSHANDLE " rep-type $type\n"; diff --git a/scripts/decls-add-cluster.pl b/scripts/decls-add-cluster.pl index 0992306c65..ab656271e8 100755 --- a/scripts/decls-add-cluster.pl +++ b/scripts/decls-add-cluster.pl @@ -12,18 +12,53 @@ use strict; $WARNING = 1; # "-w" flag +# Put the script directory on the @INC path. +use File::Basename; +use lib dirname (__FILE__); + +# The file `util_daikon.pm` appears in the same directory as this script. +use util_daikon; + foreach my $decls_file (@ARGV) { $decls_file =~ /.*\/(\S*)\.decls/; my $decls_cluster = "$1_runcluster_temp.decls"; - print " $decls_cluster "; open (IN, $decls_file) || die "couldn't open $decls_file for input\n"; open (OUT, ">$decls_cluster") || die "couldn't open $decls_cluster for output\n"; - # True if the current program point declaration still needs the - # cluster variable. The cluster variable must precede the other - # variables, but must follow the ppt-level records such as ppt-type. - my $pending = 0; - # The "parent"-type parent records of the current program point, as + my $ppt_seen = 0; + local $INPUT_RECORD_SEPARATOR = ""; # Read by paragraph + while (my $para = ) { + # Daikon does not require a blank line after a comment. + my ($comments, $record) = split_leading_comments($para); + print OUT $comments; + if ($record eq "" || record_kind($record, $decls_file) ne "ppt") { + print OUT $record; + next; + } + $ppt_seen = 1; + print OUT add_cluster_var($record, $decls_file); + } + if (!$ppt_seen) { + die "No program point declarations in $decls_file\n"; + } + close IN; + close OUT; + print " $decls_cluster "; +} + +# Returns the program point declaration paragraph that is the first +# argument, with the cluster variable added. The cluster variable must +# precede the other variables, but must follow the ppt-level records such +# as ppt-type. The second argument is the file name, for error messages. +sub add_cluster_var { + my ($record, $decls_file) = @_; + my @lines = split(/^/m, $record); + my $pptname = $lines[0]; + $pptname =~ s/^ppt\s+//; + $pptname =~ s/\s+$//; + my $result = ""; + my $pending = 1; + # The "parent"-type parent records of the program point, as # " " strings. The cluster variable is # linked to the cluster variable of each such parent, so that, for # example, an OBJECT program point gets cluster values from its methods. @@ -31,37 +66,39 @@ # to an unrelated program point, such as the OBJECT program point of a # parameter's class. my @parents = (); - while () { - my $line = $_; + foreach my $line (@lines) { + if ($line =~ /^\s*variable\s+(.*?)\s*$/ && unescape_decl($1) eq "cluster") { + die "Program point " . unescape_decl($pptname) . " in $decls_file already has a variable named \"cluster\"\n"; + } if ($pending && ($line =~ /^\s*variable\s/ || $line =~ /^\s*$/)) { - print_cluster_var(@parents); + $result .= cluster_var_decl(@parents); $pending = 0; } - print OUT $line; - if ($line =~ /^ppt /) { - $pending = 1; - @parents = (); - } elsif ($pending && $line =~ /^\s*parent\s+parent\s+(\S+)\s+(\S+)\s*$/) { + $result .= $line; + if ($pending && $line =~ /^\s*parent\s+parent\s+(\S+)\s+(\S+)\s*$/) { push @parents, "$1 $2"; } } if ($pending) { - print_cluster_var(@parents); + if ($result !~ /\n\z/) { + $result .= "\n"; + } + $result .= cluster_var_decl(@parents); } - close IN; - close OUT; + return $result; } -# Prints the declaration of the cluster variable. The arguments are the +# Returns the declaration of the cluster variable. The arguments are the # " " strings for the program point's parents. -sub print_cluster_var { +sub cluster_var_decl { my (@parents) = @_; - print OUT " variable cluster\n"; - print OUT " var-kind variable\n"; - print OUT " dec-type int\n"; - print OUT " rep-type int\n"; - print OUT " comparability 22\n"; + my $result = " variable cluster\n" + . " var-kind variable\n" + . " dec-type int\n" + . " rep-type int\n" + . " comparability 22\n"; foreach my $parent (@parents) { - print OUT " parent $parent\n"; + $result .= " parent $parent\n"; } + return $result; } diff --git a/scripts/dtrace-add-cluster.pl b/scripts/dtrace-add-cluster.pl index f843685f7b..a0753ead17 100755 --- a/scripts/dtrace-add-cluster.pl +++ b/scripts/dtrace-add-cluster.pl @@ -126,16 +126,19 @@ () || die "couldn't open $newfile for output"; print "Reading from $dtrace_file\n"; - while () { - my $line = $_; -# print ("$line"); - if ($line =~ /^ppt /) { - # A program point declaration; the decls file provides the declarations. - &skip_till_next(*DTRACE_IN); - } elsif ($line =~ /:::/) { + # Each line read here is a blank line or the first line of a record, + # because each record is read in its entirety. + while (my $line = ) { + next if $line =~ /^\s*$/; + my $kind = record_kind($line, $dtrace_file); + if ($kind eq "data") { my $pptname = $line; chomp ($pptname); &insert_cluster_info($pptname); + } elsif ($kind ne "comment") { + # A header or program point declaration; the decls file provides the + # declarations. + &skip_till_next(*DTRACE_IN); } } } @@ -182,7 +185,8 @@ ( $ ) # information, because the entry and exit with the same invocation number # must have the same cluster number. - my $pptstem = $pptname; + # extract_vars.pl names the cluster files by the unescaped name. + my $pptstem = unescape_decl($pptname); $pptstem =~ s/:::(ENTER|EXIT).*//; $pptstem = &cleanup_pptname($pptstem); diff --git a/scripts/dtrace-count.pl b/scripts/dtrace-count.pl index 5335aa3dbd..50f5e358f7 100755 --- a/scripts/dtrace-count.pl +++ b/scripts/dtrace-count.pl @@ -24,9 +24,10 @@ $/ = ""; # Read by paragraph while (<>) { - die_if_version_1_decl($_); + # Daikon does not require a blank line after a comment. + (undef, $_) = split_leading_comments($_); # Skip .decls-like paras - next if is_declaration_paragraph($_); + next if $_ eq "" or record_kind($_) ne "data"; next if /^Begin/ or /^Done/; # Skip processing program point comments # This script assumes that each program point name contains ":::". /^(.*):::(.+)$/m or die "Can't parse PPT name from <$_>"; diff --git a/scripts/dtrace-diff.pl b/scripts/dtrace-diff.pl index 52104c0a54..860f47a628 100755 --- a/scripts/dtrace-diff.pl +++ b/scripts/dtrace-diff.pl @@ -36,13 +36,13 @@ ### sub getline ( $ ) { -# gets a (non-comment, non-blank) line from the filehandle $1 +# gets a (non-comment) line from the filehandle $1 my ($fh) = @_; my $l; do { $l = <$fh>; if ($l) { chomp $l; } - } while ($l && ($l =~ m|^\#|)); + } while ($l && is_comment_line($l)); return $l; } @@ -67,65 +67,26 @@ ( $$ ) sub load_decls ( $ ) { # Loads the decls file given by $1 into a hash, returns a ref. -# The hash maps from ppt name to (map from varname to triple). +# The hash maps from ppt name to the hash returned by read_ppt_decl, +# augmented with two keys: +# "var by name": map from varname to the variable's hash +# "variable order": the names of the non-constant variables, in order. +# These are the variables whose values appear in data trace records. my ($mydeclsname) = @_; -# open DECLS, $mydeclsname or die "couldn't open decls \"$decls\"\n"; my $decls = gzopen(\*DECLS, $mydeclsname); my $declshash = {}; - my $ppt_seen = 0; - while (defined (my $l = getline($decls))) { - - $l =~ s://.*::; # strip any comments on this line - die_if_version_1_decl($l, $mydeclsname); - - if (($l =~ /(^ppt\s+)(.+)/)) { - my $currppt = $2; - my $lhashref = {}; - my @varorder = (); - - # The variable currently being read, and its - # [dec-type, rep-type, comparability] triple. - my $curvar = ""; - my $curinfo; - - while(my $subline = getline($decls)) { - $subline =~ s/^\s+//; - $subline =~ s/\s+$//; - - if($subline =~ /(^variable\s+)(.+)/) { - $curvar = $2; - $curinfo = ["", "", ""]; - $$lhashref{$curvar} = $curinfo; - push @varorder, $curvar; - }elsif (($subline =~ /^parent.+/) || - ($subline =~ /^ppt\-type.+/) || - ($subline =~ /^flags.+/)) { - }elsif ($curvar eq "") { - die "Malformed decls file: \"$subline\" at line $INPUT_LINE_NUMBER instead of variable declaration"; - }elsif ($subline =~ /^constant\s/) { - # A constant's value does not appear in data trace records. - delete $$lhashref{$curvar}; - pop @varorder; - }elsif ($subline =~ /(^rep\-type\s*)(.+)/) { - $$curinfo[1] = $2; - }elsif ($subline =~ /(^dec-type\s*)(.+)/) { - $$curinfo[0] = $2; - }elsif ($subline =~ /(^comparability\s*)(.+)/) { - $$curinfo[2] = $2; - } - } - $$lhashref{"variable order"} = [ @varorder ]; - $$declshash{$currppt} = $lhashref; - $ppt_seen = 1; - } elsif (($l eq "ListImplementors") && !$ppt_seen) { - # It's ok to have a ListImplementors in the decls file. - # Read the type of comparability, then move on. - $l = getline($decls); - } elsif (is_declaration_paragraph($l)) { - # A header line - } elsif ($l) { - die "malformed decls file: \"$l\" at line $INPUT_LINE_NUMBER of $mydeclsname"; + foreach my $ppt (read_ppt_decls($decls, $mydeclsname)) { + my $by_name = {}; + my @varorder = (); + foreach my $var (@{$$ppt{vars}}) { + $$by_name{$$var{name}} = $var; + if (!defined($$var{constant})) { + push @varorder, $$var{name}; + } } + $$ppt{"var by name"} = $by_name; + $$ppt{"variable order"} = [ @varorder ]; + $$declshash{$$ppt{name}} = $ppt; } close \*DECLS; return $declshash; @@ -137,10 +98,11 @@ ( $$ ) # file, and hash mapping varname to array of value and modbit. my ($dtfh, $dtfhname) = @_; my $pptname = getline($dtfh); - # Skip blank lines and declaration paragraphs, such as headers and - # program point declarations in a combined .dtrace file. + # Skip blank lines and records other than data records, such as headers + # and program point declarations in a combined .dtrace file. (getline + # skips comments.) while ((defined $pptname) - && (($pptname eq "") || is_declaration_paragraph($pptname))) { + && (($pptname eq "") || (record_kind($pptname, $dtfhname) ne "data"))) { if ($pptname ne "") { # Skip the rest of the paragraph. do { @@ -149,11 +111,10 @@ ( $$ ) } $pptname = getline($dtfh); } - (defined $pptname) and die_if_version_1_decl($pptname, $dtfhname); - (defined $pptname) or return undef; + $pptname = unescape_decl($pptname); my $pptline = $INPUT_LINE_NUMBER; @@ -162,6 +123,7 @@ ( $$ ) my @varorder = (); while (my $varname = getline($dtfh)) { + $varname = unescape_decl($varname); my ($modbit, $varval); (defined ($varval = getline($dtfh))) # or die "malformed dtrace file (ppt $pptname, var $varname, no varval) $dtfhname"; @@ -224,17 +186,29 @@ ( $$$ ) if ((scalar(@ppt2_varnames) > 0) && ($ppt2_varnames[0] eq "this_invocation_nonce")) { shift @ppt2_varnames; } - if (("@decls_varnames" ne "@ppt1_varnames") - || ("@decls_varnames" ne "@ppt2_varnames")) { + # Variable names are unescaped, so they may contain spaces but not newlines. + if ((join("\n", @decls_varnames) ne join("\n", @ppt1_varnames)) + || (join("\n", @decls_varnames) ne join("\n", @ppt2_varnames))) { print "Mismatched variables for ppt $pptname.\n"; - print " decls: @decls_varnames\n"; - print " trace1: @ppt1_varnames\n"; - print " trace2: @ppt2_varnames\n"; + print " decls: " . join(" ", map { escape_decl($_) } @decls_varnames) . "\n"; + print " trace1: " . join(" ", map { escape_decl($_) } @ppt1_varnames) . "\n"; + print " trace2: " . join(" ", map { escape_decl($_) } @ppt2_varnames) . "\n"; $errors_found++; + foreach my $trace ([$dtaname, \@ppt1_varnames], [$dtbname, \@ppt2_varnames]) { + my ($tracename, $trace_varnames) = @$trace; + foreach my $varname (@$trace_varnames) { + my $var = $$ppt{"var by name"}{$varname}; + if (not defined $var) { + print " ${varname} appears in ${tracename} but is not declared\n"; + } elsif (defined $$var{constant}) { + print " ${varname} appears in ${tracename} but is declared as constant $$var{constant}\n"; + } + } + } } foreach my $varname (@decls_varnames) { - my $varl = $$ppt{$varname}; + my $rep_type = $$ppt{"var by name"}{$varname}{rep_type}; my $la = $$ha{$varname}; my $lb = $$hb{$varname}; #la == lb == [varval, modbit] @@ -247,7 +221,7 @@ ( $$$ ) } elsif (not defined $lb) { print "${varname} \@ ${pptname} undefined in ${dtbname}\n"; $errors_found++; - } elsif ($$varl[1] eq "double") { + } elsif ($rep_type eq "double") { my $difference; if (($$la[0] eq "uninit")||($$lb[0] eq "uninit")) { $difference = !($$la[0] eq $$lb[0]); @@ -275,7 +249,7 @@ ( $$$ ) $differences_found++; } } else { - if ($$varl[1] =~ /^hashcode/) { + if ($rep_type =~ /^hashcode/) { # It's a hashcode, or array of hashcodes; we only care # about which ones are null or not. $$la[0] =~ s/\d*[1-9]\d*/non-null/g; # match numbers except 0 @@ -336,15 +310,16 @@ ( $$$ ) sub dump_decls ( $ ) { # dump the decls struct given by $1 my ($declshash) = @_; - foreach my $ppt (keys %$declshash) { - my $lhashref = $$declshash{$ppt}; - print "\@${ppt}:\n"; - foreach my $var (keys %$lhashref) { - print " ${var}:\n"; - my ($d, $r, $l) = @{$$lhashref{$var}}; - print " declare ${d}\n"; - print " reptype ${r}\n"; - print " lackwit ${l}\n"; + foreach my $pptname (keys %$declshash) { + print "\@${pptname}:\n"; + foreach my $var (@{$$declshash{$pptname}{vars}}) { + print " $$var{name}:\n"; + print " dec-type $$var{dec_type}\n"; + print " rep-type $$var{rep_type}\n"; + print " comparability $$var{comparability}\n"; + if (defined $$var{constant}) { + print " constant $$var{constant}\n"; + } } } } diff --git a/scripts/dtrace-indent.pl b/scripts/dtrace-indent.pl index e1760c0d46..f8b058c99f 100755 --- a/scripts/dtrace-indent.pl +++ b/scripts/dtrace-indent.pl @@ -20,9 +20,10 @@ $/ = ""; # Read by paragraph while (<>) { - die_if_version_1_decl($_); + # Daikon does not require a blank line after a comment. + (undef, $_) = split_leading_comments($_); # Skip .decls-like paras - next if is_declaration_paragraph($_); + next if $_ eq "" or record_kind($_) ne "data"; /^(.*):::([A-Z\d]+)$/m or die "Can't parse PPT name from <$_>"; my $base = $1; my $suffix = $2; diff --git a/scripts/extract_vars.pl b/scripts/extract_vars.pl index b7aa9a9ef3..36859fad2f 100755 --- a/scripts/extract_vars.pl +++ b/scripts/extract_vars.pl @@ -123,24 +123,31 @@ ( $ ) } # print "opened $dtrace_file\n"; - while () { - my $line = $_; - if ($line =~ /:::/) { - my $pptname = $line; - chomp ($pptname); - - if ($pptname =~ /:::ENTER/ || !(exists $pptname_to_fhandles{$pptname})) { - &skip_till_next(*DTRACE); + # Each line read here is a blank line or the first line of a record, + # because each record is read in its entirety. + while (my $line = ) { + next if $line =~ /^\s*$/; + my $kind = record_kind($line, $dtrace_file); + next if $kind eq "comment"; + if ($kind ne "data") { + &skip_till_next(*DTRACE); + next; + } + my $pptname = $line; + chomp ($pptname); + $pptname = unescape_decl($pptname); + + if ($pptname =~ /:::ENTER/ || !(exists $pptname_to_fhandles{$pptname})) { + &skip_till_next(*DTRACE); + } else { + my @ppt_execution = &read_execution($pptname); # [pptname, invocation_nonce, @variable_values] + push @{$pptname_to_vararrays{$pptname}}, @ppt_execution; + if ($algorithm eq 'km' || $algorithm eq 'hierarchical') { + &output_seq(@ppt_execution); + } elsif ($algorithm eq 'xm') { + &output_xmeans(@ppt_execution); } else { - my @ppt_execution = &read_execution($pptname); # [pptname, invocation_nonce, @variable_values] - push @{$pptname_to_vararrays{$pptname}}, @ppt_execution; - if ($algorithm eq 'km' || $algorithm eq 'hierarchical') { - &output_seq(@ppt_execution); - } elsif ($algorithm eq 'xm') { - &output_xmeans(@ppt_execution); - } else { - croak("bad output format $algorithm"); - } + croak("bad output format $algorithm"); } } } @@ -272,6 +279,7 @@ ( $ ) # get the values of the variables at this ppt that we want to cluster while (defined($varname) && $varname !~ /^$/) { chomp( $varname ); + $varname = unescape_decl($varname); $value = ; chomp ($value); @@ -444,33 +452,31 @@ ( $$ ) } # get_random_numbers # read a decls file, figure out the number of variables at each program -# point, and open an output file for each decls file +# point, and open an output file for each program point sub read_decls_file ( $ ) { my $decls_file = $_[0]; open(DECL, $decls_file) || &dieusage("cannot read decls file $decls_file"); - while () { - my $line = $_; - if ($line =~ /^ppt (.*?)\s*$/) { - my $pptname = &read_decl_ppt($1); - - # extract the variables out of only the EXIT program - # points. Corresponding ENTER and EXIT invocations must belong to a - # single cluster, so we can perform clustering on either the ENTER or - # the EXIT, but not both. We choose the exit program point because it - # has more variables in scope there (eg. the return variable, etc). - if ($pptname !~ /ENTER/) { - my $pptfilename = &cleanup_pptname($pptname); - $pptfilename = $pptfilename.".runcluster_temp"; - if ($algorithm eq 'km' || $algorithm eq 'hierarchical') { - &open_file_for_output_seq($pptname, $pptfilename); - } elsif ($algorithm eq 'xm') { - &open_file_for_output_xmeans($pptname, $pptfilename); - } else { - croak("bad output format $algorithm"); - } + foreach my $ppt (read_ppt_decls(\*DECL, $decls_file)) { + my $pptname = &read_decl_ppt($ppt); + + # extract the variables out of only the EXIT program + # points. Corresponding ENTER and EXIT invocations must belong to a + # single cluster, so we can perform clustering on either the ENTER or + # the EXIT, but not both. We choose the exit program point because it + # has more variables in scope there (eg. the return variable, etc). + if ($pptname !~ /ENTER/) { + my $pptfilename = &cleanup_pptname($pptname); + $pptfilename = $pptfilename.".runcluster_temp"; + if ($algorithm eq 'km' || $algorithm eq 'hierarchical') { + &open_file_for_output_seq($pptname, $pptfilename); + } elsif ($algorithm eq 'xm') { + &open_file_for_output_xmeans($pptname, $pptfilename); + } else { + croak("bad output format $algorithm"); } } } + close(DECL); } # read_decls_file # Returns true if a variable with the given rep type should not be @@ -480,33 +486,24 @@ ( $ ) return ($rep_type eq "java.lang.String" || $rep_type =~ /\[\]$/); } -# read a program point declaration in the decls file. The "ppt" line, -# whose argument is the ppt name, has already been read. +# Records the variables to be clustered at a program point. The argument +# is a program point declaration, as returned by read_ppt_decl. Returns +# the program point name. sub read_decl_ppt ( $ ) { - my ($pptname) = @_; + my ($ppt) = @_; + my $pptname = $$ppt{name}; my $nvars = 0; # number of variables at the program point - # The variables at the program point, in order. Each element is a - # reference to a [name, rep-type, is-constant] array. - my @vars = (); - - # now read the variable names and types - my $line; - while ( defined($line = ) && ($line !~ /^\s*$/) ) { - if ($line =~ /^\s*variable\s+(.*?)\s*$/) { - push @vars, [$1, "", 0]; - } elsif (@vars && $line =~ /^\s*rep-type\s+(.*?)\s*$/) { - $vars[-1][1] = $1; - } elsif (@vars && $line =~ /^\s*constant\s/) { - $vars[-1][2] = 1; + foreach my $var (@{$$ppt{vars}}) { + my $varname = $$var{name}; + my $rep_type = $$var{rep_type}; + if ($varname eq "cluster") { + die "Program point $pptname already has a variable named \"cluster\", " + . "which conflicts with the variable that runcluster.pl adds"; } - } - - foreach my $var (@vars) { - my ($varname, $rep_type, $is_constant) = @$var; # A constant's value does not appear in data trace records. - if ($is_constant || excluded_rep_type($rep_type)) { + if (defined($$var{constant}) || excluded_rep_type($rep_type)) { next; } # If the variable is an Object, keep note of that. Will be ignored (not diff --git a/scripts/sort-dtrace.pl b/scripts/sort-dtrace.pl index cb7d814632..575e5a270a 100755 --- a/scripts/sort-dtrace.pl +++ b/scripts/sort-dtrace.pl @@ -31,8 +31,16 @@ sub flush_decls { $/ = ""; # Read by paragraph while (<>) { - die_if_version_1_decl($_); - if (/^ppt\s.+/) { + # Daikon does not require a blank line after a comment. + my $comments; + ($comments, $_) = split_leading_comments($_); + if ($comments ne "") { + flush_decls(); + print $comments; + next if $_ eq ""; + } + my $kind = record_kind($_); + if ($kind eq "ppt") { my @lines = split(/\n/, $_); my @vars; my $var = ""; @@ -66,8 +74,8 @@ sub flush_decls { push @decls, join("", @ppt); - } elsif (is_declaration_paragraph($_)) { - # A header or comment + } elsif ($kind ne "data") { + # A header flush_decls(); print; } else { diff --git a/scripts/util_daikon.pm b/scripts/util_daikon.pm index a4768344cd..b50d52b720 100755 --- a/scripts/util_daikon.pm +++ b/scripts/util_daikon.pm @@ -7,7 +7,9 @@ require 5.003; # uses prototypes require Exporter; our @ISA = qw(Exporter); our @EXPORT = qw( cleanup_pptname system_or_die backticks_or_die - die_if_version_1_decl is_declaration_paragraph skip_till_next ); + escape_decl unescape_decl is_comment_line split_leading_comments + record_kind read_ppt_decl read_ppt_decls + skip_till_next ); use English; use strict; @@ -74,25 +76,159 @@ sub cleanup_pptname ( $ ) { return $result; } -# Dies if the argument, which is a paragraph or the first line of a -# paragraph from a .decls or .dtrace file, is a version 1 declaration. -# Only the first line is examined, because a later line of a data record -# may be a variable name such as "DECLARE". The optional second argument -# is the name of the file, for use in the error message. -sub die_if_version_1_decl ( $;$ ) { - my ($para, $filename) = check_args_range(1, 2, @_); - if ($para =~ /\A(DECLARE|VarComparability)$/m) { - my $file = defined($filename) ? " $filename" : ""; - croak "Version 1 declarations are not supported; convert$file to version 2 format"; - } +# Converts a name to the form used in declaration and data trace files: +# backslashes, newlines, and carriage returns are escaped, and blanks are +# replaced by "\_". Like FileIO.escape_decl in Daikon. +sub escape_decl ( $ ) { + my ($name) = @_; + $name =~ s/\\/\\\\/g; + $name =~ s/ /\\_/g; + $name =~ s/\n/\\n/g; + $name =~ s/\r/\\r/g; + return $name; +} + +# The inverse of escape_decl. Like FileIO.unescape_decl in Daikon: a +# backslash followed by any other character yields that character, and a +# trailing backslash is retained. +sub unescape_decl ( $ ) { + my ($name) = @_; + # Fast path, because this is called on every variable name in a trace. + return $name if index($name, "\\") < 0; + $name =~ s/\\(.)/$1 eq "_" ? " " : $1 eq "n" ? "\n" : $1 eq "r" ? "\r" : $1/ges; + return $name; +} + +# Returns true if the argument, which is a line (or the start of a +# paragraph), is a comment. Like FileIO.isComment in Daikon. +sub is_comment_line ( $ ) { + my ($line) = @_; + return $line =~ /\A(?:\/\/|#)/; } -# Returns true if the argument, which is a paragraph or the first line of a -# paragraph from a version 2 .decls or .dtrace file, is not a data record: -# that is, it is a program point declaration, a header, or a comment. -sub is_declaration_paragraph ( $ ) { +# Splits a paragraph into its leading comment lines and the remainder. +# Daikon does not require a blank line after a comment, so a paragraph may +# consist of comments followed by a record. Returns a two-element list; +# either element may be the empty string. If the paragraph consists only of +# comments, the first element is the entire paragraph, including any +# trailing blank lines. +sub split_leading_comments ( $ ) { my ($para) = @_; - return $para =~ /\A(ppt |decl-version|decl-input|var-comparability|input-language|ListImplementors|\/\/)/; + if ($para =~ /\A((?:(?:\/\/|#)[^\n]*(?:\n|\z))+)/) { + my $comments = $1; + my $rest = substr($para, length($comments)); + if ($rest !~ /\S/) { + return ($para, ""); + } + return ($comments, $rest); + } + return ("", $para); +} + +# Dies, saying that version 1 declarations are not supported. The optional +# argument is the name of the file, for use in the error message. +sub die_version_1 ( ;$ ) { + my ($filename) = @_; + my $file = defined($filename) ? " $filename" : ""; + croak "Version 1 declarations are not supported; convert$file to version 2 format"; +} + +# Returns the kind of a record in a version 2 .decls or .dtrace file. The +# argument is a paragraph, or the first line of a paragraph. The result is +# one of: +# "ppt" a program point declaration +# "header" decl-version, var-comparability, input-language, or +# ListImplementors +# "comment" a comment line +# "data" anything else, which is a data trace record +# Dies if the record is a version 1 declaration. Only the first line is +# examined, because a later line of a data record may be a variable name +# such as "DECLARE". The optional second argument is the name of the file, +# for use in the error message. +# This is called on every record of a potentially huge trace file, so it +# uses a single regular expression. +sub record_kind ( $;$ ) { + my ($para, $filename) = @_; + if ($para !~ /\A(?:(ppt\s)|(decl-version|var-comparability|input-language|ListImplementors)|(\/\/|#)|((?:DECLARE|VarComparability)[ \t\r]*$))/m) { + return "data"; + } + return "ppt" if defined($1); + return "header" if defined($2); + return "comment" if defined($3); + die_version_1($filename); +} + +# Reads the remainder of a version 2 program point declaration from the +# filehandle, up to a blank line or end of file. The first argument is the +# "ppt" line, which has already been read. Comment lines are skipped. +# Returns a reference to a hash with these keys: +# name the (unescaped) program point name +# parents a reference to an array of the ppt-level parent records, each +# a reference to a [relation-type, parent-ppt-name, relation-id] +# array +# vars a reference to an array of the variables, in order. Each is a +# reference to a hash with keys name (unescaped), dec_type, +# rep_type, comparability, and constant (the value of a constant +# variable, or undef if the variable is not a constant). The +# value of a constant variable does not appear in data trace +# records. +sub read_ppt_decl ( $$ ) { + my ($pptline, $fh) = @_; + $pptline =~ /\Appt\s+(.*?)\s*\z/s + or croak "Not a program point declaration: $pptline"; + my $ppt = { name => unescape_decl($1), parents => [], vars => [] }; + my $var; # the variable currently being read + while (defined(my $line = <$fh>)) { + $line =~ s/\A\s+//; + $line =~ s/\s+\z//; + last if $line eq ""; + next if is_comment_line($line); + my ($key, $value) = split(/\s+/, $line, 2); + if ($key eq "variable") { + $var = { name => unescape_decl($value), dec_type => "", rep_type => "", + comparability => "", constant => undef }; + push @{$ppt->{vars}}, $var; + } elsif (!defined($var)) { + if ($key eq "parent") { + push @{$ppt->{parents}}, [split(/\s+/, $value)]; + } + } elsif ($key eq "dec-type") { + $var->{dec_type} = $value; + } elsif ($key eq "rep-type") { + $var->{rep_type} = $value; + } elsif ($key eq "comparability") { + $var->{comparability} = $value; + } elsif ($key eq "constant") { + $var->{constant} = $value; + } + } + return $ppt; +} + +# Reads all the program point declarations from the filehandle, which is a +# version 2 .decls or combined .dtrace file. Headers, comments, and data +# trace records are skipped. Returns a list of references to hashes, as +# returned by read_ppt_decl. Dies if the file is in version 1 format or +# contains no program point declarations. The second argument is the name +# of the file, for use in error messages. +sub read_ppt_decls ( $$ ) { + my ($fh, $filename) = @_; + my @ppts = (); + # Each line read here is a blank line or the first line of a record, + # because each record is read in its entirety. + while (defined(my $line = <$fh>)) { + next if $line =~ /\A\s*\z/; + my $kind = record_kind($line, $filename); + if ($kind eq "ppt") { + push @ppts, read_ppt_decl($line, $fh); + } elsif ($kind ne "comment") { + skip_till_next($fh); + } + } + if (!@ppts) { + croak "No program point declarations in $filename"; + } + return @ppts; } # Reads lines from the filehandle until reaching a blank line or end of From 3cdd2e7e9a3f0e6f131109c837a2c04aac71493d Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Tue, 6 Oct 2026 22:33:25 -0700 Subject: [PATCH 05/15] Address code review: read single-line headers, keep comments with records * util_daikon.pm: new read_record reads one record from a file the way Daikon does: decl-version, var-comparability, and input-language are a single line, and leading comments are returned with the record. All the scripts use it instead of paragraph mode or skip_till_next. * record_kind matches Daikon's tests ("ppt " and an exact "ListImplementors" line). * read_ppt_decls rejects data trace records in a declaration file. * decls-add-cluster.pl: name the output after the file's basename, and die if two inputs would map to the same output. * sort-dtrace.pl: comments stay with the declaration or variable that follows them. * extract_vars.pl: exclude variables by name as well as by rep type. * dtrace-diff.pl: compare variable lists element by element. * Share the "cluster" variable check as check_no_cluster_var. --- doc/CHANGELOG.md | 2 +- scripts/decls-add-cluster.pl | 51 ++++++------ scripts/dtrace-add-cluster.pl | 67 +++++----------- scripts/dtrace-count.pl | 20 +++-- scripts/dtrace-diff.pl | 65 +++++++-------- scripts/dtrace-indent.pl | 22 +++--- scripts/extract_vars.pl | 82 ++++++++----------- scripts/sort-dtrace.pl | 114 +++++++++++++-------------- scripts/util_daikon.pm | 144 +++++++++++++++++++--------------- 9 files changed, 269 insertions(+), 298 deletions(-) diff --git a/doc/CHANGELOG.md b/doc/CHANGELOG.md index fb062866ae..c47720e29f 100644 --- a/doc/CHANGELOG.md +++ b/doc/CHANGELOG.md @@ -29,7 +29,7 @@ Scripts: scripts it calls) now write version 2 files. * `convertcsv.pl -decl`, `dtrace-count.pl`, `dtrace-diff.pl`, `dtrace-indent.pl`, `sort-dtrace.pl`, and the cluster analysis scripts no - longer accept version 1 files. + longer accept version 1 declarations. * Removed scripts that processed only version 1 files: `auxinfo.pl`, `clean-decls.php`, `copy_comparable.pl`, `decls2comp-1.0.py`, `decls-lackwit-disjoint.pl`, `dfec-to-kvasir.py`, `dfec-to-kvasir-dtrace.py`, diff --git a/scripts/decls-add-cluster.pl b/scripts/decls-add-cluster.pl index ab656271e8..fa4cba0415 100755 --- a/scripts/decls-add-cluster.pl +++ b/scripts/decls-add-cluster.pl @@ -4,8 +4,8 @@ ## Adds the variable "cluster" to one or more decls files as the first ## variable at each program point. The original decls files are left -## unchanged, and the result is output to file *_runcluster_temp.decls in the -## current directory. Furthermore, the list of output files is written +## unchanged, and the result for BASENAME.decls is output to file +## BASENAME_runcluster_temp.decls in the current directory. Furthermore, the list of output files is written ## to standard out. use English; @@ -19,24 +19,32 @@ # The file `util_daikon.pm` appears in the same directory as this script. use util_daikon; +# Maps each output file name to the input file that it was created from. +my %output_to_input = (); + foreach my $decls_file (@ARGV) { - $decls_file =~ /.*\/(\S*)\.decls/; - my $decls_cluster = "$1_runcluster_temp.decls"; + my $decls_cluster = basename($decls_file); + $decls_cluster =~ s/\.decls$//; + $decls_cluster .= "_runcluster_temp.decls"; + if (exists($output_to_input{$decls_cluster})) { + die "$decls_file and $output_to_input{$decls_cluster} would both be output to $decls_cluster\n"; + } + $output_to_input{$decls_cluster} = $decls_file; open (IN, $decls_file) || die "couldn't open $decls_file for input\n"; open (OUT, ">$decls_cluster") || die "couldn't open $decls_cluster for output\n"; my $ppt_seen = 0; - local $INPUT_RECORD_SEPARATOR = ""; # Read by paragraph - while (my $para = ) { - # Daikon does not require a blank line after a comment. - my ($comments, $record) = split_leading_comments($para); - print OUT $comments; - if ($record eq "" || record_kind($record, $decls_file) ne "ppt") { - print OUT $record; - next; + while (defined(my $record = read_record(\*IN, $decls_file))) { + print OUT $record->{comments}; + my $text = $record->{text}; + next if $text eq ""; + $text .= "\n" if $text !~ /\n\z/; + if ($record->{kind} eq "ppt") { + $ppt_seen = 1; + check_no_cluster_var(parse_ppt_decl($text), $decls_file); + $text = add_cluster_var($text); } - $ppt_seen = 1; - print OUT add_cluster_var($record, $decls_file); + print OUT $text, "\n"; } if (!$ppt_seen) { die "No program point declarations in $decls_file\n"; @@ -49,13 +57,10 @@ # Returns the program point declaration paragraph that is the first # argument, with the cluster variable added. The cluster variable must # precede the other variables, but must follow the ppt-level records such -# as ppt-type. The second argument is the file name, for error messages. +# as ppt-type. sub add_cluster_var { - my ($record, $decls_file) = @_; + my ($record) = @_; my @lines = split(/^/m, $record); - my $pptname = $lines[0]; - $pptname =~ s/^ppt\s+//; - $pptname =~ s/\s+$//; my $result = ""; my $pending = 1; # The "parent"-type parent records of the program point, as @@ -67,10 +72,7 @@ sub add_cluster_var { # parameter's class. my @parents = (); foreach my $line (@lines) { - if ($line =~ /^\s*variable\s+(.*?)\s*$/ && unescape_decl($1) eq "cluster") { - die "Program point " . unescape_decl($pptname) . " in $decls_file already has a variable named \"cluster\"\n"; - } - if ($pending && ($line =~ /^\s*variable\s/ || $line =~ /^\s*$/)) { + if ($pending && $line =~ /^\s*variable\s/) { $result .= cluster_var_decl(@parents); $pending = 0; } @@ -80,9 +82,6 @@ sub add_cluster_var { } } if ($pending) { - if ($result !~ /\n\z/) { - $result .= "\n"; - } $result .= cluster_var_decl(@parents); } return $result; diff --git a/scripts/dtrace-add-cluster.pl b/scripts/dtrace-add-cluster.pl index a0753ead17..a3a1fe3cfa 100755 --- a/scripts/dtrace-add-cluster.pl +++ b/scripts/dtrace-add-cluster.pl @@ -126,19 +126,11 @@ () || die "couldn't open $newfile for output"; print "Reading from $dtrace_file\n"; - # Each line read here is a blank line or the first line of a record, - # because each record is read in its entirety. - while (my $line = ) { - next if $line =~ /^\s*$/; - my $kind = record_kind($line, $dtrace_file); - if ($kind eq "data") { - my $pptname = $line; - chomp ($pptname); - &insert_cluster_info($pptname); - } elsif ($kind ne "comment") { - # A header or program point declaration; the decls file provides the - # declarations. - &skip_till_next(*DTRACE_IN); + # Headers and program point declarations are omitted; the decls file + # provides the declarations. + while (defined(my $record = read_record(\*DTRACE_IN, $dtrace_file))) { + if ($record->{kind} eq "data") { + &insert_cluster_info($record->{text}); } } } @@ -154,10 +146,13 @@ () ########################### subroutines ###################### -# Read a record from a dtrace file and insert a cluster number if -# appropriate. Discard the record if that ppt was not clustered. +# Takes a data trace record, and outputs it with a cluster number inserted. +# Discards the record if that ppt was not clustered. sub insert_cluster_info ( $ ) { - my $pptname = $_[0]; + my ($record) = @_; + my @lines = split(/^/m, $record); + my $pptname = shift @lines; + chomp ($pptname); # If the first 'variable' at this ppt execution is not an # invocation nonce, then this program point does not have an @@ -165,17 +160,14 @@ ( $ ) # is used to match the entry and exit program points to cluster # information my $invoc; # the invocation nonce for this execution. - my $line = ; -# print "$line\n"; - if ($line !~ /this.invocation.nonce/) { + my $line = shift @lines; + if (!defined($line) || $line !~ /this.invocation.nonce/) { die "No nonces present, and this program adds them incorrectly."; $pptname_to_nonces{$pptname}++; $invoc = $pptname_to_nonces{$pptname}; } else { - $invoc = ; + $invoc = shift @lines; chomp($invoc); - $line = ; - } # Find out if this program point was clustered. If it was, retrieve the @@ -191,39 +183,16 @@ ( $ ) $pptstem = &cleanup_pptname($pptstem); my $cluster_number = $pptname_to_cluster{$pptstem}[$invoc]; - if ((! defined($cluster_number)) || ($cluster_number == 0)) { - chomp ($line); - if (! ($line eq "")) { - &skip_till_next(*DTRACE_IN); - } - } else { + if ((defined($cluster_number)) && ($cluster_number != 0)) { my $output = "$pptname\nthis_invocation_nonce\n$invoc\n"; $output = $output."cluster\n$cluster_number\n1\n"; - print DTRACE_OUT $output; - print DTRACE_OUT $line; - if ($line =~ /^\s*$/) { - # this ppt has no variables. - return; - } - ©_till_next(*DTRACE_IN, *DTRACE_OUT); + $output = $output . join("", @lines); + $output .= "\n" if $output !~ /\n\z/; + print DTRACE_OUT $output, "\n"; } return; } # insert_cluster_info - -# copy one file into another, until a blank line is reached. -sub copy_till_next(**) { - my $line; - local (*INHANDLE, *OUTHANDLE) = @_; - - while ($line = ) { - print OUTHANDLE $line; - if ($line =~ /^\s*$/) { - return; - } - } -} # copy_till_next - ########################## read_cluster_info_xxx ########## # the return is an associative array. The keys are the program point stems # (i.e., without :::ENTER or :::EXIT). The value is an array for which the ith diff --git a/scripts/dtrace-count.pl b/scripts/dtrace-count.pl index 50f5e358f7..3392605530 100755 --- a/scripts/dtrace-count.pl +++ b/scripts/dtrace-count.pl @@ -22,13 +22,19 @@ my %long_names; -$/ = ""; # Read by paragraph -while (<>) { - # Daikon does not require a blank line after a comment. - (undef, $_) = split_leading_comments($_); - # Skip .decls-like paras - next if $_ eq "" or record_kind($_) ne "data"; - next if /^Begin/ or /^Done/; # Skip processing program point comments +foreach my $file (@ARGV ? @ARGV : ("-")) { + open(my $fh, $file) or die "Cannot open $file: $!"; + while (defined(my $record = read_record($fh, $file))) { + # Skip headers and declarations + next if $record->{kind} ne "data"; + count_record($record->{text}); + } + close($fh); +} + +sub count_record { + local $_ = shift; + return if /^Begin/ or /^Done/; # Skip processing program point comments # This script assumes that each program point name contains ":::". /^(.*):::(.+)$/m or die "Can't parse PPT name from <$_>"; my $name = "$1:::$2"; diff --git a/scripts/dtrace-diff.pl b/scripts/dtrace-diff.pl index 860f47a628..ca420ea8bf 100755 --- a/scripts/dtrace-diff.pl +++ b/scripts/dtrace-diff.pl @@ -35,17 +35,6 @@ ### Subroutines ### -sub getline ( $ ) { -# gets a (non-comment) line from the filehandle $1 - my ($fh) = @_; - my $l; - do { - $l = <$fh>; - if ($l) { chomp $l; } - } while ($l && is_comment_line($l)); - return $l; -} - sub gzopen ( $$ ) { # takes a fh and a filename, opens it (using zcat if necessary), and returns # a filehandle. @@ -67,7 +56,7 @@ ( $$ ) sub load_decls ( $ ) { # Loads the decls file given by $1 into a hash, returns a ref. -# The hash maps from ppt name to the hash returned by read_ppt_decl, +# The hash maps from ppt name to the hash returned by parse_ppt_decl, # augmented with two keys: # "var by name": map from varname to the variable's hash # "variable order": the names of the non-constant variables, in order. @@ -97,39 +86,30 @@ ( $$ ) # Returns a "ppt_trace_info": a 3-element array of pptname, line number in # file, and hash mapping varname to array of value and modbit. my ($dtfh, $dtfhname) = @_; - my $pptname = getline($dtfh); - # Skip blank lines and records other than data records, such as headers - # and program point declarations in a combined .dtrace file. (getline - # skips comments.) - while ((defined $pptname) - && (($pptname eq "") || (record_kind($pptname, $dtfhname) ne "data"))) { - if ($pptname ne "") { - # Skip the rest of the paragraph. - do { - $pptname = getline($dtfh); - } while ((defined $pptname) && ($pptname ne "")); - } - $pptname = getline($dtfh); - } - - (defined $pptname) - or return undef; - $pptname = unescape_decl($pptname); - - my $pptline = $INPUT_LINE_NUMBER; + # Skip records other than data records, such as headers and program + # point declarations in a combined .dtrace file. + my $record; + do { + $record = read_record($dtfh, $dtfhname); + (defined $record) + or return undef; + } while ($record->{kind} ne "data"); + my @lines = grep { !is_comment_line($_) } split(/\n/, $record->{text}); + my $pptname = unescape_decl(shift @lines); + my $pptline = $record->{line}; my $ppthash = {}; my @varorder = (); - while (my $varname = getline($dtfh)) { + while (defined(my $varname = shift @lines)) { $varname = unescape_decl($varname); my ($modbit, $varval); - (defined ($varval = getline($dtfh))) + (defined ($varval = shift @lines)) # or die "malformed dtrace file (ppt $pptname, var $varname, no varval) $dtfhname"; or die "malformed dtrace file (ppt $pptname) $dtfhname"; unless ($varname eq 'this_invocation_nonce') { - (defined ($modbit = getline($dtfh))) + (defined ($modbit = shift @lines)) # or die "malformed dtrace file (ppt $pptname, var $varname, val $varval, no modbit) $dtfhname"; or die "malformed dtrace file (ppt $pptname, no modbit) $dtfhname"; } @@ -158,6 +138,16 @@ ( $ ) } } +sub lists_equal ( $$ ) { +# Returns true if the two lists of strings, given by reference, are equal. + my ($x, $y) = @_; + return 0 if scalar(@$x) != scalar(@$y); + for (my $i = 0; $i < scalar(@$x); $i++) { + return 0 if $$x[$i] ne $$y[$i]; + } + return 1; +} + sub cmp_ppts ( $$$ ) { # Compares, according to the decls $1, the two ppts given by $2 and $3. # Arguments 2 and 3 are "ppt_trace_info" objects (see load_ppt for definition). @@ -186,9 +176,8 @@ ( $$$ ) if ((scalar(@ppt2_varnames) > 0) && ($ppt2_varnames[0] eq "this_invocation_nonce")) { shift @ppt2_varnames; } - # Variable names are unescaped, so they may contain spaces but not newlines. - if ((join("\n", @decls_varnames) ne join("\n", @ppt1_varnames)) - || (join("\n", @decls_varnames) ne join("\n", @ppt2_varnames))) { + if (!lists_equal(\@decls_varnames, \@ppt1_varnames) + || !lists_equal(\@decls_varnames, \@ppt2_varnames)) { print "Mismatched variables for ppt $pptname.\n"; print " decls: " . join(" ", map { escape_decl($_) } @decls_varnames) . "\n"; print " trace1: " . join(" ", map { escape_decl($_) } @ppt1_varnames) . "\n"; diff --git a/scripts/dtrace-indent.pl b/scripts/dtrace-indent.pl index f8b058c99f..ec3f545d5a 100755 --- a/scripts/dtrace-indent.pl +++ b/scripts/dtrace-indent.pl @@ -18,25 +18,27 @@ my $indentation = 0; -$/ = ""; # Read by paragraph -while (<>) { - # Daikon does not require a blank line after a comment. - (undef, $_) = split_leading_comments($_); - # Skip .decls-like paras - next if $_ eq "" or record_kind($_) ne "data"; - /^(.*):::([A-Z\d]+)$/m or die "Can't parse PPT name from <$_>"; +foreach my $file (@ARGV ? @ARGV : ("-")) { + open(my $fh, $file) or die "Cannot open $file: $!"; + while (defined(my $record = read_record($fh, $file))) { + # Skip headers and declarations + next if $record->{kind} ne "data"; + my $text = $record->{text}; + $text =~ /^(.*):::([A-Z\d]+)$/m or die "Can't parse PPT name from <$text>"; my $base = $1; my $suffix = $2; my $name = $base . ":::" . $suffix; if ($suffix !~ /^EXIT|^ENTER$/) { - die "What is this line? <$_>"; + die "What is this line? <$text>"; } if ($suffix =~ /^EXIT/) { - $indentation--; + $indentation--; } my $line = (' ' x $indentation) . $name . "\n"; print $line; if ($suffix eq "ENTER") { - $indentation++; + $indentation++; } + } + close($fh); } diff --git a/scripts/extract_vars.pl b/scripts/extract_vars.pl index 36859fad2f..357501b3b1 100755 --- a/scripts/extract_vars.pl +++ b/scripts/extract_vars.pl @@ -123,24 +123,13 @@ ( $ ) } # print "opened $dtrace_file\n"; - # Each line read here is a blank line or the first line of a record, - # because each record is read in its entirety. - while (my $line = ) { - next if $line =~ /^\s*$/; - my $kind = record_kind($line, $dtrace_file); - next if $kind eq "comment"; - if ($kind ne "data") { - &skip_till_next(*DTRACE); - next; - } - my $pptname = $line; - chomp ($pptname); - $pptname = unescape_decl($pptname); + while (defined(my $record = read_record(\*DTRACE, $dtrace_file))) { + next if $record->{kind} ne "data"; + my @lines = split(/\n/, $record->{text}); + my $pptname = unescape_decl(shift @lines); - if ($pptname =~ /:::ENTER/ || !(exists $pptname_to_fhandles{$pptname})) { - &skip_till_next(*DTRACE); - } else { - my @ppt_execution = &read_execution($pptname); # [pptname, invocation_nonce, @variable_values] + if ($pptname !~ /:::ENTER/ && exists $pptname_to_fhandles{$pptname}) { + my @ppt_execution = &read_execution($pptname, @lines); # [pptname, invocation_nonce, @variable_values] push @{$pptname_to_vararrays{$pptname}}, @ppt_execution; if ($algorithm eq 'km' || $algorithm eq 'hierarchical') { &output_seq(@ppt_execution); @@ -248,13 +237,14 @@ () } } -# reads a paragraph of a dtrace file (an execution) and returns an -# array in the format [pptname, invocation_nonce, @variable_values] -sub read_execution ( $ ) { +# Takes the program point name and the remaining lines of a data trace +# record (an execution), and returns an array in the format +# [pptname, invocation_nonce, @variable_values] +sub read_execution ( $@ ) { + my ($pptname, @lines) = @_; my @vararray = (); my @objarray; - my $pptname = $_[0]; # the pptname is the first element in the array. The variables follow it push @vararray, $pptname; @@ -265,23 +255,20 @@ ( $ ) my ($varname, $value); - $varname = ; - if ($varname !~ /this.invocation.nonce/) { + $varname = shift @lines; + if (!defined($varname) || $varname !~ /this.invocation.nonce/) { $pptname_to_nonces{$pptname}++; push @vararray, $pptname_to_nonces{$pptname}; } else { - $value = ; - chomp($value); + $value = shift @lines; push @vararray, $value; - $varname = ; + $varname = shift @lines; } # get the values of the variables at this ppt that we want to cluster - while (defined($varname) && $varname !~ /^$/) { - chomp( $varname ); + while (defined($varname)) { $varname = unescape_decl($varname); - $value = ; - chomp ($value); + $value = shift @lines; # see if the variable is an Object variable my $object = 0; @@ -308,7 +295,7 @@ ( $ ) $value =~ s/null/0/; $value =~ s/missing/-11111/; $value =~ s/NaN/1e10/; - my $mod = ; # "$mod" is unused + shift @lines; # the modified bit is unused # extract variables to be clustered. read_decl_ppt omits class names, # arrays, and strings from %pptname_to_varnames. @@ -316,7 +303,7 @@ ( $ ) push @vararray, $value; } - $varname = ; + $varname = shift @lines; } return @vararray; } @@ -457,7 +444,7 @@ ( $ ) my $decls_file = $_[0]; open(DECL, $decls_file) || &dieusage("cannot read decls file $decls_file"); foreach my $ppt (read_ppt_decls(\*DECL, $decls_file)) { - my $pptname = &read_decl_ppt($ppt); + my $pptname = &read_decl_ppt($ppt, $decls_file); # extract the variables out of only the EXIT program # points. Corresponding ENTER and EXIT invocations must belong to a @@ -479,31 +466,30 @@ ( $ ) close(DECL); } # read_decls_file -# Returns true if a variable with the given rep type should not be -# clustered: its value is a string (including a class name) or an array. -sub excluded_rep_type ( $ ) { - my ($rep_type) = @_; - return ($rep_type eq "java.lang.String" || $rep_type =~ /\[\]$/); +# Returns true if a variable with the given name and rep type should not be +# clustered: its value is a string (including a class name) or an array, or +# it is derived from a class name, an array, or a toString() call. +sub excluded_var ( $$ ) { + my ($varname, $rep_type) = @_; + return ($rep_type eq "java.lang.String" || $rep_type =~ /\[\]$/ + || $varname =~ /\.class|\[\]|\.toString/); } -# Records the variables to be clustered at a program point. The argument -# is a program point declaration, as returned by read_ppt_decl. Returns -# the program point name. -sub read_decl_ppt ( $ ) { +# Records the variables to be clustered at a program point. The arguments +# are a program point declaration, as returned by parse_ppt_decl, and the +# name of the decls file. Returns the program point name. +sub read_decl_ppt ( $$ ) { - my ($ppt) = @_; + my ($ppt, $decls_file) = @_; + check_no_cluster_var($ppt, $decls_file); my $pptname = $$ppt{name}; my $nvars = 0; # number of variables at the program point foreach my $var (@{$$ppt{vars}}) { my $varname = $$var{name}; my $rep_type = $$var{rep_type}; - if ($varname eq "cluster") { - die "Program point $pptname already has a variable named \"cluster\", " - . "which conflicts with the variable that runcluster.pl adds"; - } # A constant's value does not appear in data trace records. - if (defined($$var{constant}) || excluded_rep_type($rep_type)) { + if (defined($$var{constant}) || excluded_var($varname, $rep_type)) { next; } # If the variable is an Object, keep note of that. Will be ignored (not diff --git a/scripts/sort-dtrace.pl b/scripts/sort-dtrace.pl index 575e5a270a..8ee7e204e6 100755 --- a/scripts/sort-dtrace.pl +++ b/scripts/sort-dtrace.pl @@ -18,70 +18,68 @@ # The file `util_daikon.pm` appears in the same directory as this script. use util_daikon; +# The program point declarations that have not yet been output. Each is a +# [comments, text] pair, where comments are the comment lines that precede +# the declaration. my @decls; sub flush_decls { - if (@decls) { - @decls = sort @decls; - print join("\n\n", @decls), "\n\n"; - @decls = (); + foreach my $decl (sort { $a->[1] cmp $b->[1] } @decls) { + print $decl->[0], $decl->[1], "\n"; } + @decls = (); } -$/ = ""; # Read by paragraph - -while (<>) { - # Daikon does not require a blank line after a comment. - my $comments; - ($comments, $_) = split_leading_comments($_); - if ($comments ne "") { - flush_decls(); - print $comments; - next if $_ eq ""; +# Returns the program point declaration that is the argument, with its +# variables sorted. A comment line stays with the line that follows it. +sub sort_variables { + my ($text) = @_; + my @lines = split(/^/m, $text); + # The ppt line and the ppt-level records. + my $head = shift @lines; + # Each element is a [comments, text] pair for one variable. + my @vars; + # Comment lines that are not yet attached to a line. + my $pending = ""; + foreach my $line (@lines) { + if (is_comment_line($line)) { + $pending .= $line; + } elsif ($line =~ /^\s*variable\s/) { + push @vars, [$pending, $line]; + $pending = ""; + } elsif (@vars) { + $vars[-1][1] .= $pending . $line; + $pending = ""; + } else { + $head .= $pending . $line; + $pending = ""; + } } - my $kind = record_kind($_); - if ($kind eq "ppt") { - my @lines = split(/\n/, $_); - my @vars; - my $var = ""; - my @ppt; - - - push @ppt, shift(@lines); - - while((@lines) && (not ($lines[0] =~ /\s*variable/))) { - push @ppt, "\n" . shift(@lines); - } - - while(my $line = shift @lines) { - if($line =~ /^\s+variable.+/){ - if($var) { - push @vars, $var; - $var = ""; - } - $var = join("\n", $var, $line); - } else { - $var = join("\n", $var, $line); - } - } - - if($var) { - push @vars, $var; - } - - @vars = sort @vars; - @ppt = (@ppt, @vars ); - - push @decls, join("", @ppt); - - } elsif ($kind ne "data") { - # A header - flush_decls(); - print; + if (@vars) { + $vars[-1][1] .= $pending; } else { - flush_decls(); - chomp; - my @lines = split(/\n/, $_); + $head .= $pending; + } + return join("", $head, + map { $_->[0] . $_->[1] } sort { $a->[1] cmp $b->[1] } @vars); +} + +foreach my $file (@ARGV ? @ARGV : ("-")) { + open(my $fh, $file) or die "Cannot open $file: $!"; + while (defined(my $record = read_record($fh, $file))) { + my $kind = $record->{kind}; + if ($kind eq "ppt") { + my $text = $record->{text}; + $text .= "\n" if $text !~ /\n\z/; + push @decls, [$record->{comments}, sort_variables($text)]; + next; + } + flush_decls(); + print $record->{comments}; + if ($kind eq "header") { + print $record->{text}, "\n"; + } elsif ($kind eq "data") { + my @lines = split(/\n/, $record->{text}); my @header; push @header, shift @lines; if (@lines and $lines[0] eq "this_invocation_nonce") { @@ -96,5 +94,7 @@ sub flush_decls { @vars = sort @vars; print join("\n", @header, @vars), "\n\n"; } - flush_decls() if eof; + } + close($fh); + flush_decls(); } diff --git a/scripts/util_daikon.pm b/scripts/util_daikon.pm index b50d52b720..9ff493dee5 100755 --- a/scripts/util_daikon.pm +++ b/scripts/util_daikon.pm @@ -7,9 +7,9 @@ require 5.003; # uses prototypes require Exporter; our @ISA = qw(Exporter); our @EXPORT = qw( cleanup_pptname system_or_die backticks_or_die - escape_decl unescape_decl is_comment_line split_leading_comments - record_kind read_ppt_decl read_ppt_decls - skip_till_next ); + escape_decl unescape_decl is_comment_line + record_kind read_record parse_ppt_decl read_ppt_decls + check_no_cluster_var ); use English; use strict; @@ -99,32 +99,13 @@ sub unescape_decl ( $ ) { return $name; } -# Returns true if the argument, which is a line (or the start of a -# paragraph), is a comment. Like FileIO.isComment in Daikon. +# Returns true if the argument, which is a line, is a comment. Like +# FileIO.isComment in Daikon. sub is_comment_line ( $ ) { my ($line) = @_; return $line =~ /\A(?:\/\/|#)/; } -# Splits a paragraph into its leading comment lines and the remainder. -# Daikon does not require a blank line after a comment, so a paragraph may -# consist of comments followed by a record. Returns a two-element list; -# either element may be the empty string. If the paragraph consists only of -# comments, the first element is the entire paragraph, including any -# trailing blank lines. -sub split_leading_comments ( $ ) { - my ($para) = @_; - if ($para =~ /\A((?:(?:\/\/|#)[^\n]*(?:\n|\z))+)/) { - my $comments = $1; - my $rest = substr($para, length($comments)); - if ($rest !~ /\S/) { - return ($para, ""); - } - return ($comments, $rest); - } - return ("", $para); -} - # Dies, saying that version 1 declarations are not supported. The optional # argument is the name of the file, for use in the error message. sub die_version_1 ( ;$ ) { @@ -134,33 +115,71 @@ sub die_version_1 ( ;$ ) { } # Returns the kind of a record in a version 2 .decls or .dtrace file. The -# argument is a paragraph, or the first line of a paragraph. The result is -# one of: +# argument is the first line of the record, which is not a comment. The +# result is one of: # "ppt" a program point declaration # "header" decl-version, var-comparability, input-language, or # ListImplementors -# "comment" a comment line # "data" anything else, which is a data trace record -# Dies if the record is a version 1 declaration. Only the first line is -# examined, because a later line of a data record may be a variable name -# such as "DECLARE". The optional second argument is the name of the file, -# for use in the error message. +# The tests are the same as in FileIO.read_data_trace_record in Daikon. +# Dies if the record is a version 1 declaration. The optional second +# argument is the name of the file, for use in the error message. # This is called on every record of a potentially huge trace file, so it # uses a single regular expression. sub record_kind ( $;$ ) { - my ($para, $filename) = @_; - if ($para !~ /\A(?:(ppt\s)|(decl-version|var-comparability|input-language|ListImplementors)|(\/\/|#)|((?:DECLARE|VarComparability)[ \t\r]*$))/m) { + my ($line, $filename) = @_; + if ($line !~ /\A(?:(ppt )|(decl-version|var-comparability|input-language|ListImplementors\r?\n?\z)|((?:DECLARE|VarComparability)\r?\n?\z))/) { return "data"; } return "ppt" if defined($1); return "header" if defined($2); - return "comment" if defined($3); die_version_1($filename); } -# Reads the remainder of a version 2 program point declaration from the -# filehandle, up to a blank line or end of file. The first argument is the -# "ppt" line, which has already been read. Comment lines are skipped. +# Reads the next record from the filehandle, which is a version 2 .decls or +# .dtrace file. Like FileIO.read_data_trace_record in Daikon, the +# decl-version, var-comparability, and input-language headers are a single +# line, and every other record extends to a blank line or end of file. +# Returns undef at end of file. Otherwise, returns a reference to a hash +# with these keys: +# comments the comment lines that precede the record, or "" +# kind the kind of the record, as returned by record_kind; or "" if +# the file ends after the comments +# text the lines of the record, without the blank line that +# terminates it; or "" if kind is "" +# line the line number of the first line of the record +# The optional second argument is the name of the file, for use in error +# messages. +sub read_record ( $;$ ) { + my ($fh, $filename) = @_; + my $comments = ""; + my $line; + while (defined($line = <$fh>)) { + next if $line =~ /\A\s*\z/; + if (is_comment_line($line)) { + $comments .= $line; + next; + } + last; + } + if (!defined($line)) { + return undef if $comments eq ""; + return { comments => $comments, kind => "", text => "", line => $INPUT_LINE_NUMBER }; + } + my $record = { comments => $comments, kind => record_kind($line, $filename), + text => $line, line => $INPUT_LINE_NUMBER }; + if ($record->{kind} eq "header" && $line !~ /\AListImplementors/) { + return $record; + } + while (defined($line = <$fh>)) { + last if $line =~ /\A\s*\z/; + $record->{text} .= $line; + } + return $record; +} + +# Parses a version 2 program point declaration. The argument is the text +# of the record, as returned by read_record. Comment lines are skipped. # Returns a reference to a hash with these keys: # name the (unescaped) program point name # parents a reference to an array of the ppt-level parent records, each @@ -172,17 +191,17 @@ sub record_kind ( $;$ ) { # variable, or undef if the variable is not a constant). The # value of a constant variable does not appear in data trace # records. -sub read_ppt_decl ( $$ ) { - my ($pptline, $fh) = @_; +sub parse_ppt_decl ( $ ) { + my ($text) = @_; + my ($pptline, @lines) = split(/\n/, $text); $pptline =~ /\Appt\s+(.*?)\s*\z/s or croak "Not a program point declaration: $pptline"; my $ppt = { name => unescape_decl($1), parents => [], vars => [] }; my $var; # the variable currently being read - while (defined(my $line = <$fh>)) { + foreach my $line (@lines) { $line =~ s/\A\s+//; $line =~ s/\s+\z//; - last if $line eq ""; - next if is_comment_line($line); + next if $line eq "" || is_comment_line($line); my ($key, $value) = split(/\s+/, $line, 2); if ($key eq "variable") { $var = { name => unescape_decl($value), dec_type => "", rep_type => "", @@ -206,23 +225,19 @@ sub read_ppt_decl ( $$ ) { } # Reads all the program point declarations from the filehandle, which is a -# version 2 .decls or combined .dtrace file. Headers, comments, and data -# trace records are skipped. Returns a list of references to hashes, as -# returned by read_ppt_decl. Dies if the file is in version 1 format or -# contains no program point declarations. The second argument is the name -# of the file, for use in error messages. +# version 2 .decls file. Headers and comments are skipped. Returns a list +# of references to hashes, as returned by parse_ppt_decl. Dies if the file +# is in version 1 format, contains a data trace record, or contains no +# program point declarations. The second argument is the name of the +# file, for use in error messages. sub read_ppt_decls ( $$ ) { my ($fh, $filename) = @_; my @ppts = (); - # Each line read here is a blank line or the first line of a record, - # because each record is read in its entirety. - while (defined(my $line = <$fh>)) { - next if $line =~ /\A\s*\z/; - my $kind = record_kind($line, $filename); - if ($kind eq "ppt") { - push @ppts, read_ppt_decl($line, $fh); - } elsif ($kind ne "comment") { - skip_till_next($fh); + while (defined(my $record = read_record($fh, $filename))) { + if ($record->{kind} eq "ppt") { + push @ppts, parse_ppt_decl($record->{text}); + } elsif ($record->{kind} eq "data") { + croak "Declaration files should not contain data trace records, but $filename does at line $record->{line}"; } } if (!@ppts) { @@ -231,12 +246,17 @@ sub read_ppt_decls ( $$ ) { return @ppts; } -# Reads lines from the filehandle until reaching a blank line or end of -# file. This skips the remainder of the current paragraph. -sub skip_till_next ( * ) { - my ($fh) = @_; - while (defined(my $line = <$fh>)) { - last if $line =~ /^\s*$/; +# Dies if the program point declaration, as returned by parse_ppt_decl, +# already has a variable named "cluster", which would conflict with the +# variable that the cluster analysis scripts add. The second argument is +# the name of the file, for use in the error message. +sub check_no_cluster_var ( $$ ) { + my ($ppt, $filename) = @_; + foreach my $var (@{$ppt->{vars}}) { + if ($var->{name} eq "cluster") { + croak "Program point $ppt->{name} in $filename already has a variable named \"cluster\", " + . "which conflicts with the variable that runcluster.pl adds"; + } } } From 6176d1bd00a0dc7f106dcf567b1eff7fe247bd31 Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Wed, 7 Oct 2026 07:57:38 -0700 Subject: [PATCH 06/15] Leave the cluster analysis scripts to the runcluster.pl pull request Pull request #856 rewrites runcluster.pl and the scripts it calls (extract_vars.pl, decls-add-cluster.pl, and dtrace-add-cluster.pl), including their support for version 2 files. --- doc/CHANGELOG.md | 7 +- scripts/decls-add-cluster.pl | 95 +++--------------- scripts/dtrace-add-cluster.pl | 75 +++++++++++---- scripts/extract_vars.pl | 176 ++++++++++++++++++---------------- 4 files changed, 167 insertions(+), 186 deletions(-) diff --git a/doc/CHANGELOG.md b/doc/CHANGELOG.md index c47720e29f..f0b9df31e2 100644 --- a/doc/CHANGELOG.md +++ b/doc/CHANGELOG.md @@ -25,11 +25,10 @@ Further documentation can be found in: Scripts: -* `convertcsv.pl` and the cluster analysis scripts (`runcluster.pl` and the - scripts it calls) now write version 2 files. +* `convertcsv.pl` now writes version 2 files. * `convertcsv.pl -decl`, `dtrace-count.pl`, `dtrace-diff.pl`, - `dtrace-indent.pl`, `sort-dtrace.pl`, and the cluster analysis scripts no - longer accept version 1 declarations. + `dtrace-indent.pl`, and `sort-dtrace.pl` no longer accept version 1 + declarations. * Removed scripts that processed only version 1 files: `auxinfo.pl`, `clean-decls.php`, `copy_comparable.pl`, `decls2comp-1.0.py`, `decls-lackwit-disjoint.pl`, `dfec-to-kvasir.py`, `dfec-to-kvasir-dtrace.py`, diff --git a/scripts/decls-add-cluster.pl b/scripts/decls-add-cluster.pl index fa4cba0415..38f4944469 100755 --- a/scripts/decls-add-cluster.pl +++ b/scripts/decls-add-cluster.pl @@ -4,100 +4,31 @@ ## Adds the variable "cluster" to one or more decls files as the first ## variable at each program point. The original decls files are left -## unchanged, and the result for BASENAME.decls is output to file -## BASENAME_runcluster_temp.decls in the current directory. Furthermore, the list of output files is written +## unchanged, and the result is output to file *_runcluster_temp.decls in the +## current directory. Furthermore, the list of output files is written ## to standard out. use English; use strict; $WARNING = 1; # "-w" flag -# Put the script directory on the @INC path. -use File::Basename; -use lib dirname (__FILE__); - -# The file `util_daikon.pm` appears in the same directory as this script. -use util_daikon; - -# Maps each output file name to the input file that it was created from. -my %output_to_input = (); - foreach my $decls_file (@ARGV) { - my $decls_cluster = basename($decls_file); - $decls_cluster =~ s/\.decls$//; - $decls_cluster .= "_runcluster_temp.decls"; - if (exists($output_to_input{$decls_cluster})) { - die "$decls_file and $output_to_input{$decls_cluster} would both be output to $decls_cluster\n"; - } - $output_to_input{$decls_cluster} = $decls_file; + $decls_file =~ /.*\/(\S*)\.decls/; + my $decls_cluster = "$1_runcluster_temp.decls"; + print " $decls_cluster "; open (IN, $decls_file) || die "couldn't open $decls_file for input\n"; open (OUT, ">$decls_cluster") || die "couldn't open $decls_cluster for output\n"; - my $ppt_seen = 0; - while (defined(my $record = read_record(\*IN, $decls_file))) { - print OUT $record->{comments}; - my $text = $record->{text}; - next if $text eq ""; - $text .= "\n" if $text !~ /\n\z/; - if ($record->{kind} eq "ppt") { - $ppt_seen = 1; - check_no_cluster_var(parse_ppt_decl($text), $decls_file); - $text = add_cluster_var($text); + while () { + my $line = $_; + print OUT $line; + if ($line =~ /:::/) { + print OUT "cluster\n"; + print OUT "int\n"; + print OUT "int\n"; + print OUT "22\n"; } - print OUT $text, "\n"; - } - if (!$ppt_seen) { - die "No program point declarations in $decls_file\n"; } close IN; close OUT; - print " $decls_cluster "; -} - -# Returns the program point declaration paragraph that is the first -# argument, with the cluster variable added. The cluster variable must -# precede the other variables, but must follow the ppt-level records such -# as ppt-type. -sub add_cluster_var { - my ($record) = @_; - my @lines = split(/^/m, $record); - my $result = ""; - my $pending = 1; - # The "parent"-type parent records of the program point, as - # " " strings. The cluster variable is - # linked to the cluster variable of each such parent, so that, for - # example, an OBJECT program point gets cluster values from its methods. - # "user"-type relations are not followed: they link a program point - # to an unrelated program point, such as the OBJECT program point of a - # parameter's class. - my @parents = (); - foreach my $line (@lines) { - if ($pending && $line =~ /^\s*variable\s/) { - $result .= cluster_var_decl(@parents); - $pending = 0; - } - $result .= $line; - if ($pending && $line =~ /^\s*parent\s+parent\s+(\S+)\s+(\S+)\s*$/) { - push @parents, "$1 $2"; - } - } - if ($pending) { - $result .= cluster_var_decl(@parents); - } - return $result; -} - -# Returns the declaration of the cluster variable. The arguments are the -# " " strings for the program point's parents. -sub cluster_var_decl { - my (@parents) = @_; - my $result = " variable cluster\n" - . " var-kind variable\n" - . " dec-type int\n" - . " rep-type int\n" - . " comparability 22\n"; - foreach my $parent (@parents) { - $result .= " parent $parent\n"; - } - return $result; } diff --git a/scripts/dtrace-add-cluster.pl b/scripts/dtrace-add-cluster.pl index a3a1fe3cfa..765c3ecb56 100755 --- a/scripts/dtrace-add-cluster.pl +++ b/scripts/dtrace-add-cluster.pl @@ -126,11 +126,13 @@ () || die "couldn't open $newfile for output"; print "Reading from $dtrace_file\n"; - # Headers and program point declarations are omitted; the decls file - # provides the declarations. - while (defined(my $record = read_record(\*DTRACE_IN, $dtrace_file))) { - if ($record->{kind} eq "data") { - &insert_cluster_info($record->{text}); + while () { + my $line = $_; +# print ("$line"); + if ($line =~ /:::/) { + my $pptname = $line; + chomp ($pptname); + &insert_cluster_info($pptname); } } } @@ -146,13 +148,10 @@ () ########################### subroutines ###################### -# Takes a data trace record, and outputs it with a cluster number inserted. -# Discards the record if that ppt was not clustered. +# Read a record from a dtrace file and insert a cluster number if +# appropriate. Discard the record if that ppt was not clustered. sub insert_cluster_info ( $ ) { - my ($record) = @_; - my @lines = split(/^/m, $record); - my $pptname = shift @lines; - chomp ($pptname); + my $pptname = $_[0]; # If the first 'variable' at this ppt execution is not an # invocation nonce, then this program point does not have an @@ -160,14 +159,17 @@ ( $ ) # is used to match the entry and exit program points to cluster # information my $invoc; # the invocation nonce for this execution. - my $line = shift @lines; - if (!defined($line) || $line !~ /this.invocation.nonce/) { + my $line = ; +# print "$line\n"; + if ($line !~ /this.invocation.nonce/) { die "No nonces present, and this program adds them incorrectly."; $pptname_to_nonces{$pptname}++; $invoc = $pptname_to_nonces{$pptname}; } else { - $invoc = shift @lines; + $invoc = ; chomp($invoc); + $line = ; + } # Find out if this program point was clustered. If it was, retrieve the @@ -177,22 +179,55 @@ ( $ ) # information, because the entry and exit with the same invocation number # must have the same cluster number. - # extract_vars.pl names the cluster files by the unescaped name. - my $pptstem = unescape_decl($pptname); + my $pptstem = $pptname; $pptstem =~ s/:::(ENTER|EXIT).*//; $pptstem = &cleanup_pptname($pptstem); my $cluster_number = $pptname_to_cluster{$pptstem}[$invoc]; - if ((defined($cluster_number)) && ($cluster_number != 0)) { + if ((! defined($cluster_number)) || ($cluster_number == 0)) { + chomp ($line); + if (! ($line eq "")) { + &skip_till_next(*DTRACE_IN); + } + } else { my $output = "$pptname\nthis_invocation_nonce\n$invoc\n"; $output = $output."cluster\n$cluster_number\n1\n"; - $output = $output . join("", @lines); - $output .= "\n" if $output !~ /\n\z/; - print DTRACE_OUT $output, "\n"; + print DTRACE_OUT $output; + print DTRACE_OUT $line; + if ($line =~ /^\s*$/) { + # this ppt has no variables. + return; + } + ©_till_next(*DTRACE_IN, *DTRACE_OUT); } return; } # insert_cluster_info + +# read an opened file till you reach a blank line, then return +sub skip_till_next(*) { + local *FHANDLE = $_[0]; + my $line; + do { + $line = ; + } until ($line =~ /^\s*$/); + return; +} # skip_till_next + + +# copy one file into another, until a blank line is reached. +sub copy_till_next(**) { + my $line; + local (*INHANDLE, *OUTHANDLE) = @_; + + while ($line = ) { + print OUTHANDLE $line; + if ($line =~ /^\s*$/) { + return; + } + } +} # copy_till_next + ########################## read_cluster_info_xxx ########## # the return is an associative array. The keys are the program point stems # (i.e., without :::ENTER or :::EXIT). The value is an array for which the ith diff --git a/scripts/extract_vars.pl b/scripts/extract_vars.pl index 357501b3b1..18577b6de4 100755 --- a/scripts/extract_vars.pl +++ b/scripts/extract_vars.pl @@ -123,20 +123,24 @@ ( $ ) } # print "opened $dtrace_file\n"; - while (defined(my $record = read_record(\*DTRACE, $dtrace_file))) { - next if $record->{kind} ne "data"; - my @lines = split(/\n/, $record->{text}); - my $pptname = unescape_decl(shift @lines); - - if ($pptname !~ /:::ENTER/ && exists $pptname_to_fhandles{$pptname}) { - my @ppt_execution = &read_execution($pptname, @lines); # [pptname, invocation_nonce, @variable_values] - push @{$pptname_to_vararrays{$pptname}}, @ppt_execution; - if ($algorithm eq 'km' || $algorithm eq 'hierarchical') { - &output_seq(@ppt_execution); - } elsif ($algorithm eq 'xm') { - &output_xmeans(@ppt_execution); + while () { + my $line = $_; + if ($line =~ /:::/) { + my $pptname = $line; + chomp ($pptname); + + if ($pptname =~ /:::ENTER/ || !(exists $pptname_to_fhandles{$pptname})) { + &skip_till_next(*DTRACE); } else { - croak("bad output format $algorithm"); + my @ppt_execution = &read_execution($pptname); # [pptname, invocation_nonce, @variable_values] + push @{$pptname_to_vararrays{$pptname}}, @ppt_execution; + if ($algorithm eq 'km' || $algorithm eq 'hierarchical') { + &output_seq(@ppt_execution); + } elsif ($algorithm eq 'xm') { + &output_xmeans(@ppt_execution); + } else { + croak("bad output format $algorithm"); + } } } } @@ -237,14 +241,13 @@ () } } -# Takes the program point name and the remaining lines of a data trace -# record (an execution), and returns an array in the format -# [pptname, invocation_nonce, @variable_values] -sub read_execution ( $@ ) { - my ($pptname, @lines) = @_; +# reads a paragraph of a dtrace file (an execution) and returns an +# array in the format [pptname, invocation_nonce, @variable_values] +sub read_execution ( $ ) { my @vararray = (); my @objarray; + my $pptname = $_[0]; # the pptname is the first element in the array. The variables follow it push @vararray, $pptname; @@ -255,20 +258,22 @@ ( $@ ) my ($varname, $value); - $varname = shift @lines; - if (!defined($varname) || $varname !~ /this.invocation.nonce/) { + $varname = ; + if ($varname !~ /this.invocation.nonce/) { $pptname_to_nonces{$pptname}++; push @vararray, $pptname_to_nonces{$pptname}; } else { - $value = shift @lines; + $value = ; + chomp($value); push @vararray, $value; - $varname = shift @lines; + $varname = ; } # get the values of the variables at this ppt that we want to cluster - while (defined($varname)) { - $varname = unescape_decl($varname); - $value = shift @lines; + while ($varname !~ /^$/) { + chomp( $varname ); + $value = ; + chomp ($value); # see if the variable is an Object variable my $object = 0; @@ -282,7 +287,7 @@ ( $@ ) if ($object) { if ($value =~ /null/) { - $value = -5; + $value =~ -5; } elsif ($value =~ /missing/) { $value = 0; } else { @@ -295,15 +300,17 @@ ( $@ ) $value =~ s/null/0/; $value =~ s/missing/-11111/; $value =~ s/NaN/1e10/; - shift @lines; # the modified bit is unused + my $mod = ; # "$mod" is unused - # extract variables to be clustered. read_decl_ppt omits class names, - # arrays, and strings from %pptname_to_varnames. - if (exists $pptname_to_varnames{$pptname}{$varname}) { - push @vararray, $value; + # extract variables to be clustered. + # Omit Object variables, .class, array[] or a string + if ( $varname !~ /\.class/ && $varname !~ /\[\]/ && $varname !~ /\.toString/) { + if ( exists $pptname_to_varnames{$pptname}{$varname}) { + push @vararray, $value; + } } - $varname = shift @lines; + $varname = ; } return @vararray; } @@ -413,6 +420,17 @@ ( @ ) } } +# read an opened file till you reach a blank line, then return +# (used to skip a paragraph of lines). +sub skip_till_next ( * ) { + local *FHANDLE = $_[0]; + while (my $line = ) { + if ($line =~ /^\s*$/) { + return; + } + } +} # skip_till_next + # return an array of $target random numbers between 0 (inclusive) and # $max(exclusive). These are used to sample the invocations at a # program point. @@ -439,66 +457,64 @@ ( $$ ) } # get_random_numbers # read a decls file, figure out the number of variables at each program -# point, and open an output file for each program point +# point, and open an output file for each decls file sub read_decls_file ( $ ) { my $decls_file = $_[0]; open(DECL, $decls_file) || &dieusage("cannot read decls file $decls_file"); - foreach my $ppt (read_ppt_decls(\*DECL, $decls_file)) { - my $pptname = &read_decl_ppt($ppt, $decls_file); - - # extract the variables out of only the EXIT program - # points. Corresponding ENTER and EXIT invocations must belong to a - # single cluster, so we can perform clustering on either the ENTER or - # the EXIT, but not both. We choose the exit program point because it - # has more variables in scope there (eg. the return variable, etc). - if ($pptname !~ /ENTER/) { - my $pptfilename = &cleanup_pptname($pptname); - $pptfilename = $pptfilename.".runcluster_temp"; - if ($algorithm eq 'km' || $algorithm eq 'hierarchical') { - &open_file_for_output_seq($pptname, $pptfilename); - } elsif ($algorithm eq 'xm') { - &open_file_for_output_xmeans($pptname, $pptfilename); - } else { - croak("bad output format $algorithm"); + while () { + my $line = $_; + if ($line =~ /^DECLARE$/) { + my $pptname = &read_decl_ppt(); + + # extract the variables out of only the EXIT program + # points. Corresponding ENTER and EXIT invocations must belong to a + # single cluster, so we can perform clustering on either the ENTER or + # the EXIT, but not both. We choose the exit program point because it + # has more variables in scope there (eg. the return variable, etc). + if ($pptname !~ /ENTER/) { + my $pptfilename = &cleanup_pptname($pptname); + $pptfilename = $pptfilename.".runcluster_temp"; + if ($algorithm eq 'km' || $algorithm eq 'hierarchical') { + &open_file_for_output_seq($pptname, $pptfilename); + } elsif ($algorithm eq 'xm') { + &open_file_for_output_xmeans($pptname, $pptfilename); + } else { + croak("bad output format $algorithm"); + } } } } - close(DECL); } # read_decls_file -# Returns true if a variable with the given name and rep type should not be -# clustered: its value is a string (including a class name) or an array, or -# it is derived from a class name, an array, or a toString() call. -sub excluded_var ( $$ ) { - my ($varname, $rep_type) = @_; - return ($rep_type eq "java.lang.String" || $rep_type =~ /\[\]$/ - || $varname =~ /\.class|\[\]|\.toString/); -} +# read a program point declaration in the decls file. +sub read_decl_ppt () { + + my $nvars; # number of variables at the program point + my $pptname = ; # the pptname. + chomp ($pptname); + + # now read the variable names and types + my $varname; + while ( defined($varname = ) && ($varname !~ /^$/) ) { + chomp ($varname); + my $declared_type = ; # "$declared_type" is unused + my $rep_type = ; -# Records the variables to be clustered at a program point. The arguments -# are a program point declaration, as returned by parse_ppt_decl, and the -# name of the decls file. Returns the program point name. -sub read_decl_ppt ( $$ ) { - - my ($ppt, $decls_file) = @_; - check_no_cluster_var($ppt, $decls_file); - my $pptname = $$ppt{name}; - my $nvars = 0; # number of variables at the program point - - foreach my $var (@{$$ppt{vars}}) { - my $varname = $$var{name}; - my $rep_type = $$var{rep_type}; - # A constant's value does not appear in data trace records. - if (defined($$var{constant}) || excluded_var($varname, $rep_type)) { - next; - } # If the variable is an Object, keep note of that. Will be ignored (not # be clustered) later because its value is a hashcode. - if ($rep_type =~ /hashcode/) { - push @{$pptname_to_objectvars{$pptname}}, $varname; + if ( $varname !~ /\.class/ && $varname !~ /\[\]/ && $varname !~ /\.toString/) { + if ($rep_type =~ /hashcode/) { + push @{$pptname_to_objectvars{$pptname}}, $varname; + $nvars++; # added for object + $pptname_to_varnames{$pptname}{$varname} = 1; + } elsif ( $rep_type =~ /=/) { + # definition. do nothing + } else { + $nvars++; + $pptname_to_varnames{$pptname}{$varname} = 1; + } } - $nvars++; - $pptname_to_varnames{$pptname}{$varname} = 1; + my $var_comp = ; # variable comparability; "$var_comp" is unused } # Store the number of variables at this program point. Remember that # @vararray[1] stores the program point name. The invocation nonce is From b6ffab4aeb701bf78d27ce48570b98556f5521b2 Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Wed, 7 Oct 2026 15:01:19 -0700 Subject: [PATCH 07/15] Make sort-dtrace.pl honor perl -i The tests run `perl -Si sort-dtrace.pl FILE`, but -i has no effect on files that a script opens itself, so the sorted output went to standard output and the file was left unsorted. Co-Authored-By: Claude Opus 5.5 --- scripts/sort-dtrace.pl | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/scripts/sort-dtrace.pl b/scripts/sort-dtrace.pl index 8ee7e204e6..d462d1ab67 100755 --- a/scripts/sort-dtrace.pl +++ b/scripts/sort-dtrace.pl @@ -64,8 +64,18 @@ sub sort_variables { map { $_->[0] . $_->[1] } sort { $a->[1] cmp $b->[1] } @vars); } +# Like Perl's -i command-line option, which has no effect on files that a +# script opens itself: if $^I is defined, each file is rewritten in place, +# and if $^I is non-empty, the original is saved under a backup name. +my $in_place = defined($^I); + foreach my $file (@ARGV ? @ARGV : ("-")) { open(my $fh, $file) or die "Cannot open $file: $!"; + my $output = ""; + if ($in_place && $file ne "-") { + open(my $out, ">", \$output) or die "Cannot open in-memory output: $!"; + select($out); + } while (defined(my $record = read_record($fh, $file))) { my $kind = $record->{kind}; if ($kind eq "ppt") { @@ -97,4 +107,19 @@ sub sort_variables { } close($fh); flush_decls(); + if ($in_place && $file ne "-") { + close(select(STDOUT)); + if ($^I ne "") { + my $backup; + if ($^I =~ /\*/) { + ($backup = $^I) =~ s/\*/$file/g; + } else { + $backup = $file . $^I; + } + rename($file, $backup) or die "Cannot rename $file to $backup: $!"; + } + open(my $out, ">", $file) or die "Cannot write $file: $!"; + print $out $output; + close($out) or die "Cannot write $file: $!"; + } } From 3b4e21c00570e148770ac511f4889642fcb107d3 Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Thu, 8 Oct 2026 07:22:50 -0700 Subject: [PATCH 08/15] sort-dtrace.pl: no blank lines between single-line headers --- scripts/sort-dtrace.pl | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/scripts/sort-dtrace.pl b/scripts/sort-dtrace.pl index d462d1ab67..053aa284f3 100755 --- a/scripts/sort-dtrace.pl +++ b/scripts/sort-dtrace.pl @@ -23,6 +23,18 @@ # the declaration. my @decls; +# True if the most recent output was a single-line header, such as +# "decl-version 2.0". Consecutive single-line headers are output without +# blank lines between them, and a blank line follows the last of them. +my $after_header = 0; + +sub end_headers { + if ($after_header) { + print "\n"; + $after_header = 0; + } +} + sub flush_decls { foreach my $decl (sort { $a->[1] cmp $b->[1] } @decls) { print $decl->[0], $decl->[1], "\n"; @@ -78,6 +90,13 @@ sub sort_variables { } while (defined(my $record = read_record($fh, $file))) { my $kind = $record->{kind}; + if ($kind eq "header" && $record->{text} !~ /\AListImplementors/) { + flush_decls(); + print $record->{comments}, $record->{text}; + $after_header = 1; + next; + } + end_headers(); if ($kind eq "ppt") { my $text = $record->{text}; $text .= "\n" if $text !~ /\n\z/; @@ -106,6 +125,7 @@ sub sort_variables { } } close($fh); + end_headers(); flush_decls(); if ($in_place && $file ne "-") { close(select(STDOUT)); From 2852f88716a8661bebc99f089cc24100b5855732 Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Thu, 8 Oct 2026 08:00:27 -0700 Subject: [PATCH 09/15] Address code review: read records by paragraph, use Perl's -i, validate declarations Read records a paragraph at a time, which is faster; end a record only at an empty line, as Daikon does. Share the record loop via for_each_record, which reads through ARGV so that perl -i works. Give ListImplementors its own record kind. Keep indented comments with the following variable in sort-dtrace.pl. Reject unknown keys in program point declarations. Remove the unused check_no_cluster_var. --- scripts/dtrace-count.pl | 14 +-- scripts/dtrace-diff.pl | 11 +- scripts/dtrace-indent.pl | 43 ++++---- scripts/sort-dtrace.pl | 49 ++------- scripts/util_daikon.pm | 229 +++++++++++++++++++++++++++++---------- 5 files changed, 212 insertions(+), 134 deletions(-) diff --git a/scripts/dtrace-count.pl b/scripts/dtrace-count.pl index 3392605530..b0a241f16f 100755 --- a/scripts/dtrace-count.pl +++ b/scripts/dtrace-count.pl @@ -22,15 +22,11 @@ my %long_names; -foreach my $file (@ARGV ? @ARGV : ("-")) { - open(my $fh, $file) or die "Cannot open $file: $!"; - while (defined(my $record = read_record($fh, $file))) { - # Skip headers and declarations - next if $record->{kind} ne "data"; - count_record($record->{text}); - } - close($fh); -} +for_each_record(sub { + my ($record) = @_; + # Skip headers and declarations + count_record($record->{text}) if $record->{kind} eq "data"; +}); sub count_record { local $_ = shift; diff --git a/scripts/dtrace-diff.pl b/scripts/dtrace-diff.pl index ca420ea8bf..05cda3de3e 100755 --- a/scripts/dtrace-diff.pl +++ b/scripts/dtrace-diff.pl @@ -82,15 +82,16 @@ ( $ ) } sub load_ppt ( $$ ) { -# Loads a single ppt from a dtrace fh given by $1. +# Loads a single ppt using the record reader given by $1 (see +# record_reader in util_daikon.pm), which reads the dtrace file named $2. # Returns a "ppt_trace_info": a 3-element array of pptname, line number in # file, and hash mapping varname to array of value and modbit. - my ($dtfh, $dtfhname) = @_; + my ($dtreader, $dtfhname) = @_; # Skip records other than data records, such as headers and program # point declarations in a combined .dtrace file. my $record; do { - $record = read_record($dtfh, $dtfhname); + $record = $dtreader->(); (defined $record) or return undef; } while ($record->{kind} ne "data"); @@ -265,8 +266,8 @@ ( $$$ ) my ($declshash, $mydtaname, $mydtbname) = @_; # open DTA, $mydtaname or die "couldn't open dtrace \"$mydtaname\"\n"; # open DTB, $mydtbname or die "couldn't open dtrace \"$mydtbname\"\n"; - my $dta = gzopen(\*DTA, $mydtaname); - my $dtb = gzopen(\*DTB, $mydtbname); + my $dta = record_reader(gzopen(\*DTA, $mydtaname), $mydtaname); + my $dtb = record_reader(gzopen(\*DTB, $mydtbname), $mydtbname); PPT: while (1) { diff --git a/scripts/dtrace-indent.pl b/scripts/dtrace-indent.pl index ec3f545d5a..48eb232acb 100755 --- a/scripts/dtrace-indent.pl +++ b/scripts/dtrace-indent.pl @@ -18,27 +18,24 @@ my $indentation = 0; -foreach my $file (@ARGV ? @ARGV : ("-")) { - open(my $fh, $file) or die "Cannot open $file: $!"; - while (defined(my $record = read_record($fh, $file))) { - # Skip headers and declarations - next if $record->{kind} ne "data"; - my $text = $record->{text}; - $text =~ /^(.*):::([A-Z\d]+)$/m or die "Can't parse PPT name from <$text>"; - my $base = $1; - my $suffix = $2; - my $name = $base . ":::" . $suffix; - if ($suffix !~ /^EXIT|^ENTER$/) { - die "What is this line? <$text>"; - } - if ($suffix =~ /^EXIT/) { - $indentation--; - } - my $line = (' ' x $indentation) . $name . "\n"; - print $line; - if ($suffix eq "ENTER") { - $indentation++; - } +for_each_record(sub { + my ($record) = @_; + # Skip headers and declarations + return if $record->{kind} ne "data"; + my $text = $record->{text}; + $text =~ /^(.*):::([A-Z\d]+)$/m or die "Can't parse PPT name from <$text>"; + my $base = $1; + my $suffix = $2; + my $name = $base . ":::" . $suffix; + if ($suffix !~ /^EXIT|^ENTER$/) { + die "What is this line? <$text>"; } - close($fh); -} + if ($suffix =~ /^EXIT/) { + $indentation--; + } + my $line = (' ' x $indentation) . $name . "\n"; + print $line; + if ($suffix eq "ENTER") { + $indentation++; + } +}); diff --git a/scripts/sort-dtrace.pl b/scripts/sort-dtrace.pl index 053aa284f3..7e033ad307 100755 --- a/scripts/sort-dtrace.pl +++ b/scripts/sort-dtrace.pl @@ -54,7 +54,8 @@ sub sort_variables { # Comment lines that are not yet attached to a line. my $pending = ""; foreach my $line (@lines) { - if (is_comment_line($line)) { + my ($stripped) = $line =~ /\A\s*(.*)/s; + if (is_comment_line($stripped)) { $pending .= $line; } elsif ($line =~ /^\s*variable\s/) { push @vars, [$pending, $line]; @@ -76,36 +77,29 @@ sub sort_variables { map { $_->[0] . $_->[1] } sort { $a->[1] cmp $b->[1] } @vars); } -# Like Perl's -i command-line option, which has no effect on files that a -# script opens itself: if $^I is defined, each file is rewritten in place, -# and if $^I is non-empty, the original is saved under a backup name. -my $in_place = defined($^I); +# The files are read through the ARGV filehandle, so Perl's -i command-line +# option rewrites each file in place. +for_each_record(\&process_record, sub { end_headers(); flush_decls(); }); -foreach my $file (@ARGV ? @ARGV : ("-")) { - open(my $fh, $file) or die "Cannot open $file: $!"; - my $output = ""; - if ($in_place && $file ne "-") { - open(my $out, ">", \$output) or die "Cannot open in-memory output: $!"; - select($out); - } - while (defined(my $record = read_record($fh, $file))) { +sub process_record { + my ($record) = @_; my $kind = $record->{kind}; - if ($kind eq "header" && $record->{text} !~ /\AListImplementors/) { + if ($kind eq "header") { flush_decls(); print $record->{comments}, $record->{text}; $after_header = 1; - next; + return; } end_headers(); if ($kind eq "ppt") { my $text = $record->{text}; $text .= "\n" if $text !~ /\n\z/; push @decls, [$record->{comments}, sort_variables($text)]; - next; + return; } flush_decls(); print $record->{comments}; - if ($kind eq "header") { + if ($kind eq "list-implementors") { print $record->{text}, "\n"; } elsif ($kind eq "data") { my @lines = split(/\n/, $record->{text}); @@ -115,7 +109,7 @@ sub sort_variables { push @header, shift @lines; push @header, shift @lines; } - die "Bad number of lines" unless @lines % 3 == 0; + die "Bad number of lines in $ARGV at line $record->{line}" unless @lines % 3 == 0; my @vars; while (@lines) { push @vars, join("\n", splice(@lines, 0, 3)); @@ -123,23 +117,4 @@ sub sort_variables { @vars = sort @vars; print join("\n", @header, @vars), "\n\n"; } - } - close($fh); - end_headers(); - flush_decls(); - if ($in_place && $file ne "-") { - close(select(STDOUT)); - if ($^I ne "") { - my $backup; - if ($^I =~ /\*/) { - ($backup = $^I) =~ s/\*/$file/g; - } else { - $backup = $file . $^I; - } - rename($file, $backup) or die "Cannot rename $file to $backup: $!"; - } - open(my $out, ">", $file) or die "Cannot write $file: $!"; - print $out $output; - close($out) or die "Cannot write $file: $!"; - } } diff --git a/scripts/util_daikon.pm b/scripts/util_daikon.pm index 9ff493dee5..55fdc78349 100755 --- a/scripts/util_daikon.pm +++ b/scripts/util_daikon.pm @@ -8,8 +8,8 @@ require Exporter; our @ISA = qw(Exporter); our @EXPORT = qw( cleanup_pptname system_or_die backticks_or_die escape_decl unescape_decl is_comment_line - record_kind read_record parse_ppt_decl read_ppt_decls - check_no_cluster_var ); + record_kind record_reader for_each_record + parse_ppt_decl read_ppt_decls ); use English; use strict; @@ -117,10 +117,11 @@ sub die_version_1 ( ;$ ) { # Returns the kind of a record in a version 2 .decls or .dtrace file. The # argument is the first line of the record, which is not a comment. The # result is one of: -# "ppt" a program point declaration -# "header" decl-version, var-comparability, input-language, or -# ListImplementors -# "data" anything else, which is a data trace record +# "ppt" a program point declaration +# "header" decl-version, var-comparability, or input-language, +# each of which is a single line +# "list-implementors" ListImplementors, which extends to a blank line +# "data" anything else, which is a data trace record # The tests are the same as in FileIO.read_data_trace_record in Daikon. # Dies if the record is a version 1 declaration. The optional second # argument is the name of the file, for use in the error message. @@ -128,58 +129,162 @@ sub die_version_1 ( ;$ ) { # uses a single regular expression. sub record_kind ( $;$ ) { my ($line, $filename) = @_; - if ($line !~ /\A(?:(ppt )|(decl-version|var-comparability|input-language|ListImplementors\r?\n?\z)|((?:DECLARE|VarComparability)\r?\n?\z))/) { + if ($line !~ /\A(?:(ppt )|(decl-version|var-comparability|input-language)|(ListImplementors\r?\n?\z)|((?:DECLARE|VarComparability)\r?\n?\z))/) { return "data"; } return "ppt" if defined($1); return "header" if defined($2); + return "list-implementors" if defined($3); die_version_1($filename); } -# Reads the next record from the filehandle, which is a version 2 .decls or -# .dtrace file. Like FileIO.read_data_trace_record in Daikon, the +# Reading records. Like FileIO.read_data_trace_record in Daikon, the # decl-version, var-comparability, and input-language headers are a single -# line, and every other record extends to a blank line or end of file. -# Returns undef at end of file. Otherwise, returns a reference to a hash -# with these keys: +# line, comment lines at the start of a record are separate from it, and +# every other record extends to an empty line or end of file. As in +# FileIO.read_ppt_decl, a program point declaration also ends at a line +# that contains only whitespace. +# +# A record is a reference to a hash with these keys: # comments the comment lines that precede the record, or "" # kind the kind of the record, as returned by record_kind; or "" if # the file ends after the comments -# text the lines of the record, without the blank line that +# text the lines of the record, without the empty line that # terminates it; or "" if kind is "" # line the line number of the first line of the record -# The optional second argument is the name of the file, for use in error -# messages. -sub read_record ( $;$ ) { - my ($fh, $filename) = @_; - my $comments = ""; - my $line; - while (defined($line = <$fh>)) { - next if $line =~ /\A\s*\z/; - if (is_comment_line($line)) { - $comments .= $line; +# +# For speed, the input is read a paragraph at a time rather than a line at +# a time. A paragraph ends with an empty line, so it contains at most one +# record that is not a single-line header, and that record is last. + +# Returns a new reader state for the file with the given name. +sub new_reader_state ( $ ) { + my ($filename) = @_; + return { filename => $filename, line => 1, comments => "" }; +} + +# Returns the records in the paragraph, which is the next one read from the +# file whose reader state is the first argument. Updates the state. +sub paragraph_records ( $$ ) { + my ($state, $paragraph) = @_; + my @records = (); + my $line = $state->{line}; + $state->{line} += ($paragraph =~ tr/\n//); + while (1) { + # Skip empty lines. + if ($paragraph =~ s/\A(\n+)//) { + $line += length($1); + } + last if $paragraph eq ""; + my $end = index($paragraph, "\n"); + my $first = ($end < 0) ? $paragraph : substr($paragraph, 0, $end + 1); + my $kind; + if (!is_comment_line($first)) { + $kind = record_kind($first, $state->{filename}); + } + if (!defined($kind) || $kind eq "header") { + if (defined($kind)) { + push @records, { comments => $state->{comments}, kind => $kind, + text => $first, line => $line }; + $state->{comments} = ""; + } else { + $state->{comments} .= $first; + } + $paragraph = ($end < 0) ? "" : substr($paragraph, $end + 1); + $line++; next; } - last; - } - if (!defined($line)) { - return undef if $comments eq ""; - return { comments => $comments, kind => "", text => "", line => $INPUT_LINE_NUMBER }; - } - my $record = { comments => $comments, kind => record_kind($line, $filename), - text => $line, line => $INPUT_LINE_NUMBER }; - if ($record->{kind} eq "header" && $line !~ /\AListImplementors/) { - return $record; + my $text = $paragraph; + $paragraph = ""; + if ($kind eq "ppt" && $text =~ /^[^\S\n]+(?:\n|\z)/m) { + $paragraph = substr($text, $LAST_MATCH_END[0]); + $text = substr($text, 0, $LAST_MATCH_START[0]); + } else { + chop($text) if substr($text, -2) eq "\n\n"; + } + push @records, { comments => $state->{comments}, kind => $kind, + text => $text, line => $line }; + $state->{comments} = ""; + $line += ($text =~ tr/\n//) + 1; } - while (defined($line = <$fh>)) { - last if $line =~ /\A\s*\z/; - $record->{text} .= $line; + return @records; +} + +# Returns the records, if any, that remain at the end of the file whose +# reader state is the argument: comments that no record follows. +sub end_of_file_records ( $ ) { + my ($state) = @_; + return () if $state->{comments} eq ""; + my $record = { comments => $state->{comments}, kind => "", text => "", + line => $state->{line} }; + $state->{comments} = ""; + return ($record); +} + +# Returns a reader for the filehandle, which is a version 2 .decls or +# .dtrace file. Each call to the reader returns the next record, or undef +# at end of file. The optional second argument is the name of the file, +# for use in error messages. +sub record_reader ( $;$ ) { + my ($fh, $filename) = @_; + my $state = new_reader_state($filename); + my @pending = (); + my $at_eof = 0; + return sub { + while (!@pending && !$at_eof) { + local $INPUT_RECORD_SEPARATOR = "\n\n"; + my $paragraph = <$fh>; + if (defined($paragraph)) { + @pending = paragraph_records($state, $paragraph); + } else { + @pending = end_of_file_records($state); + $at_eof = 1; + } + } + return shift @pending; + }; +} + +# Calls the first argument, a subroutine, on each record (as described +# above) of each file named on the command line, or of standard input if +# there are none. The files are read through the ARGV filehandle, so +# Perl's -i command-line option rewrites each file in place with whatever +# the subroutines print. After the last record of each file, calls the +# optional second argument, a subroutine. While the subroutines run, $ARGV +# is the name of the current file. +sub for_each_record ( $;$ ) { + my ($process_record, $end_of_file) = @_; + my $state; + local $INPUT_RECORD_SEPARATOR = "\n\n"; + while (defined(my $paragraph = )) { + $state = new_reader_state($ARGV) if !defined($state); + foreach my $record (paragraph_records($state, $paragraph)) { + $process_record->($record); + } + if (eof(ARGV)) { + foreach my $record (end_of_file_records($state)) { + $process_record->($record); + } + $end_of_file->() if defined($end_of_file); + undef $state; + } } - return $record; } -# Parses a version 2 program point declaration. The argument is the text -# of the record, as returned by read_record. Comment lines are skipped. +# The keys that may appear in a program point declaration, before the +# first variable and within a variable, as in FileIO.read_ppt_decl in +# Daikon. +my %ppt_keys = map { $_ => 1 } qw( parent flags ppt-type ); +my %var_keys = map { $_ => 1 } + qw( var-kind enclosing-var reference-type array function-args rep-type + dec-type flags lang-flags parent comparability constant min-value + max-value min-length max-length valid-values ); + +# Parses a version 2 program point declaration. The first argument is the +# text of the record, as returned by a record reader. Comment lines are +# skipped. The optional second and third arguments are the name of the +# file and the line number of the record, for use in error messages. +# Dies if the declaration is malformed. # Returns a reference to a hash with these keys: # name the (unescaped) program point name # parents a reference to an array of the ppt-level parent records, each @@ -191,26 +296,43 @@ sub read_record ( $;$ ) { # variable, or undef if the variable is not a constant). The # value of a constant variable does not appear in data trace # records. -sub parse_ppt_decl ( $ ) { - my ($text) = @_; +sub parse_ppt_decl ( $;$$ ) { + my ($text, $filename, $line_number) = @_; my ($pptline, @lines) = split(/\n/, $text); + # Returns the location of the line at the given offset from the start of + # the record, for use in error messages. + my $where = sub { + my ($offset) = @_; + my $result = defined($filename) ? $filename : "declaration"; + $result .= " line " . ($line_number + $offset) if defined($line_number); + return $result; + }; $pptline =~ /\Appt\s+(.*?)\s*\z/s - or croak "Not a program point declaration: $pptline"; + or croak "Not a program point declaration in " . $where->(0) . ": $pptline"; my $ppt = { name => unescape_decl($1), parents => [], vars => [] }; my $var; # the variable currently being read - foreach my $line (@lines) { + for (my $i = 0; $i < @lines; $i++) { + my $line = $lines[$i]; $line =~ s/\A\s+//; $line =~ s/\s+\z//; next if $line eq "" || is_comment_line($line); my ($key, $value) = split(/\s+/, $line, 2); + my $error_prefix = "Malformed declaration of $ppt->{name} in " . $where->($i + 1); if ($key eq "variable") { + defined($value) or croak "$error_prefix: variable has no name"; $var = { name => unescape_decl($value), dec_type => "", rep_type => "", comparability => "", constant => undef }; push @{$ppt->{vars}}, $var; } elsif (!defined($var)) { + $ppt_keys{$key} + or croak "$error_prefix: \"$key\" found where \"variable\", \"parent\", \"flags\", or \"ppt-type\" expected"; if ($key eq "parent") { - push @{$ppt->{parents}}, [split(/\s+/, $value)]; + push @{$ppt->{parents}}, [split(/\s+/, defined($value) ? $value : "")]; } + } elsif (!$var_keys{$key}) { + croak "$error_prefix: unexpected variable item \"$key\""; + } elsif (!defined($value) && $key =~ /\A(?:dec-type|rep-type|comparability|constant)\z/) { + croak "$error_prefix: \"$key\" has no value"; } elsif ($key eq "dec-type") { $var->{dec_type} = $value; } elsif ($key eq "rep-type") { @@ -233,9 +355,10 @@ sub parse_ppt_decl ( $ ) { sub read_ppt_decls ( $$ ) { my ($fh, $filename) = @_; my @ppts = (); - while (defined(my $record = read_record($fh, $filename))) { + my $reader = record_reader($fh, $filename); + while (defined(my $record = $reader->())) { if ($record->{kind} eq "ppt") { - push @ppts, parse_ppt_decl($record->{text}); + push @ppts, parse_ppt_decl($record->{text}, $filename, $record->{line}); } elsif ($record->{kind} eq "data") { croak "Declaration files should not contain data trace records, but $filename does at line $record->{line}"; } @@ -246,20 +369,6 @@ sub read_ppt_decls ( $$ ) { return @ppts; } -# Dies if the program point declaration, as returned by parse_ppt_decl, -# already has a variable named "cluster", which would conflict with the -# variable that the cluster analysis scripts add. The second argument is -# the name of the file, for use in the error message. -sub check_no_cluster_var ( $$ ) { - my ($ppt, $filename) = @_; - foreach my $var (@{$ppt->{vars}}) { - if ($var->{name} eq "cluster") { - croak "Program point $ppt->{name} in $filename already has a variable named \"cluster\", " - . "which conflicts with the variable that runcluster.pl adds"; - } - } -} - ########################################################################### ### End of file From 27571d8496a982a2bd04c36b5fcca92dc92f188b Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Thu, 8 Oct 2026 08:15:19 -0700 Subject: [PATCH 10/15] Address code review: CRLF input, comparability sets, dtrace-diff declarations and escaping * util_daikon.pm: accept \r\n line endings; process paragraphs by offset (linear time); reject a variable declared twice or lacking var-kind, dec-type, or rep-type; build error messages only when needed. * decls2comp.py: list variables with negative comparability on a "-1:" line. * dtrace-diff.pl: read declarations from the traces (decls file optional); escape names in all messages; strip comments with one regex; remove the no-op --ignore_exitno option. * convertcsv.pl: match -decl variables to columns by either form of the name, die if none matches, and write the declared names. --- doc/CHANGELOG.md | 3 + scripts/convertcsv.pl | 82 ++++++++++++++---------- scripts/decls2comp.py | 56 +++++++--------- scripts/dtrace-diff.pl | 141 ++++++++++++++++++++++------------------ scripts/util_daikon.pm | 142 ++++++++++++++++++++++++++++++----------- 5 files changed, 259 insertions(+), 165 deletions(-) diff --git a/doc/CHANGELOG.md b/doc/CHANGELOG.md index f0b9df31e2..095f6d2b78 100644 --- a/doc/CHANGELOG.md +++ b/doc/CHANGELOG.md @@ -29,6 +29,9 @@ Scripts: * `convertcsv.pl -decl`, `dtrace-count.pl`, `dtrace-diff.pl`, `dtrace-indent.pl`, and `sort-dtrace.pl` no longer accept version 1 declarations. +* `dtrace-diff.pl` reads program point declarations from the .dtrace files, + so its .decls file argument is now optional. It no longer accepts the + `--ignore_exitno` option, which had no effect. * Removed scripts that processed only version 1 files: `auxinfo.pl`, `clean-decls.php`, `copy_comparable.pl`, `decls2comp-1.0.py`, `decls-lackwit-disjoint.pl`, `dfec-to-kvasir.py`, `dfec-to-kvasir-dtrace.py`, diff --git a/scripts/convertcsv.pl b/scripts/convertcsv.pl index d88f11165a..698fdfe2b8 100755 --- a/scripts/convertcsv.pl +++ b/scripts/convertcsv.pl @@ -86,6 +86,33 @@ ( $ ) return ($$ppt{name}, @varnames); } +# Returns the variable name, surrounded by double quotes (and with +# backslashes and double quotes escaped) if it contains spaces, periods, +# hyphens, double quotes, slashes, or (square|angle|regular) brackets. +# Daikon parses each variable name (see VarInfoName.parse), and a quoted +# name is parsed as a simple name. +sub formatVarName ( $ ) { + my ($input) = check_args(1, @_); + my $simplified = $input; + # To facilitate commenting out + # one or more of these expressions, + # each one was written in a separate line. + $simplified =~ s/ /_/g; + $simplified =~ s/\./_/g; + $simplified =~ s/(\"|-|\/)/_/g; + $simplified =~ s/(\(|\))//g; + $simplified =~ s/(\[|\])//g; + $simplified =~ s/(\<|\>)//g; + if ($simplified eq $input) { + return $input; + } + $simplified = $input; + # Quote backslashes and quotes (in that order) + $simplified =~ s/\\/\\\\/g; + $simplified =~ s/\"/\\\"/g; + return '"' . $simplified . '"'; +} + ########################################################################### @@ -201,7 +228,7 @@ ( $ ) @csv_varnames = $csv->fields(); # get the parsed fields my $i = 0; foreach my $var (@csv_varnames) { - # Remove spaces, double quotes, slashes from the names of variables. + # Quote names that Daikon could not otherwise parse as simple names. $csv_varnames[$i] = formatVarName($csv_varnames[$i]); $i++; } @@ -224,6 +251,22 @@ ( $ ) } my $num_decl_vars = scalar(@decl_varnames); +# The csv index of each declared variable. A declared variable matches a +# csv column whose name is the same, either as written in the csv file or +# as transformed by formatVarName. +my @decl_csvindex; +for (my $j = 0; $j < $num_decl_vars; $j++) { + my $varname = $decl_varnames[$j]; + my $csvindex = $varNameCsvIndex{$varname}; + if (!defined($csvindex)) { + $csvindex = $varNameCsvIndex{formatVarName($varname)}; + } + if (!defined($csvindex)) { + die "Declared variable " . escape_decl($varname) . " is not a column of $inputfilename"; + } + $decl_csvindex[$j] = $csvindex; +} + @@ -251,7 +294,7 @@ () for (my $k = 0; $k < $num_samples; $k++) { print DTRACEHANDLE "\n" . escape_decl($programpointname) . "\n"; for (my $j = 0; $j < $num_decl_vars; $j++) { - my $csvindex = $varNameCsvIndex{$decl_varnames[$j]}; + my $csvindex = $decl_csvindex[$j]; if ($variableArray{$csvindex}[$k] eq "") { my $m; for ($m=1; $m< $num_samples-$k; $m++) { @@ -286,7 +329,7 @@ () $variableArray{$csvindex}[$k] = $prevvalues[$csvindex]; } } - print DTRACEHANDLE escape_decl($csv_varnames[$csvindex]) . "\n"; + print DTRACEHANDLE escape_decl($decl_varnames[$j]) . "\n"; print DTRACEHANDLE "$variableArray{$csvindex}[$k]\n"; print DTRACEHANDLE "1\n"; } @@ -303,33 +346,6 @@ ( $ ) } -# Removes spaces, double quotes, slashes, (square|curly|regular) brackets -# from variable names. -# (This is presumably required by the variable name parsing code.) -sub formatVarName ( $ ) { - my ($input) = check_args(1, @_); - my $simplified = $input; - # To facilitate commenting out - # one or more of these expressions, - # each one was written in a separate line. - $simplified =~ s/ /_/g; - $simplified =~ s/\./_/g; - $simplified =~ s/(\"|-|\/)/_/g; - $simplified =~ s/(\(|\))//g; - $simplified =~ s/(\[|\])//g; - $simplified =~ s/(\<|\>)//g; - if ($simplified eq $input) { - return $input; - } - $simplified = $input; - # Quote backslashes and quotes (in that order) - $simplified =~ s/\\/\\\\/g; - $simplified =~ s/\"/\\\"/g; - return '"' . $simplified . '"'; -} - - - ########################################################################### @@ -370,7 +386,7 @@ ( $ ) print DTRACEHANDLE escape_decl($programpointname) . "\n"; for (my $j = 0; $j<$num_decl_vars; $j++) { - my $csvindex = $varNameCsvIndex{$decl_varnames[$j]}; + my $csvindex = $decl_csvindex[$j]; my $value = $sample[$csvindex]; my $modbit = 1; @@ -402,7 +418,7 @@ ( $ ) $variableArray{$csvindex}[$num_samples] = $value; } } - print DTRACEHANDLE escape_decl($csv_varnames[$csvindex]) . "\n"; + print DTRACEHANDLE escape_decl($decl_varnames[$j]) . "\n"; print DTRACEHANDLE "$value\n"; print DTRACEHANDLE "$modbit\n"; } @@ -417,7 +433,7 @@ ( $ ) print DECLSHANDLE "ppt " . escape_decl($programpointname) . "\n"; print DECLSHANDLE " ppt-type point\n"; for (my $j = 0; $j<$num_decl_vars; $j++) { - my $csvindex = $varNameCsvIndex{$decl_varnames[$j]}; + my $csvindex = $decl_csvindex[$j]; my $type = ($isNumber[$csvindex] ? "double" : "java.lang.String"); print DECLSHANDLE " variable " . escape_decl($csv_varnames[$csvindex]) . "\n"; print DECLSHANDLE " var-kind variable\n"; diff --git a/scripts/decls2comp.py b/scripts/decls2comp.py index 777f16b9c1..59f348af5f 100755 --- a/scripts/decls2comp.py +++ b/scripts/decls2comp.py @@ -11,6 +11,13 @@ by spaces. All program points are also sorted by alphabetical order. Output is written to stdout by default +Variables are in the same comparability set if their comparabilities +are identical. For arrays, this is stricter than Daikon, which +compares the element and index comparabilities (as in "9[10]") +separately. A variable whose comparability is negative and is not an +array is comparable to every variable; all such variables are listed on +the last line for the program point, which starts with "-1:". + Usage: ./decls2comp.py input.decls 'no-hashcodes' [optional] Running this with the 'no-hashcodes' string as the 2nd arg results in the tool ignoring all variables of rep. type 'hashcode' or @@ -56,7 +63,7 @@ ..returnIntSum():::ENTER a b c -d +-1: d """ import re @@ -130,7 +137,7 @@ for ppt_name in sorted_ppt_keys: v = all_ppts[ppt_name] i = 0 - var2comp = {} # Key: variable name, Value: comparability number + var2comp: dict[str, str] = {} # Key: variable name, Value: comparability number # The comparability info for a variable at a program point is # prefixed by comparability @@ -160,38 +167,19 @@ # Now we can do the real work of grouping variables together # in comparability sets based on their numbers - sorted_vars = sorted(var2comp.keys()) - - print(ppt_name) - - start_of_line = 1 - while len(sorted_vars) > 0: - var_name = sorted_vars[0] - - # if var2comp[var_name] == '-1': # Remember that everything is a string - # print '-1:', var_name, - # else: - if start_of_line == 1: - print(var_name, end="") - StartOfLine = 0 + groups = {} # Key: comparability, Value: sorted list of variable names + always_comparable = [] # Variables that are comparable to every variable + for var_name in sorted(var2comp.keys()): + comp = var2comp[var_name] + if comp.startswith("-") and "[" not in comp: + always_comparable.append(var_name) else: - print("", var_name, end="") - - comp_num = var2comp[var_name] - - if comp_num: - del var2comp[var_name] - - sorted_vars = sorted(var2comp.keys()) - - for other_var in sorted_vars: - if var2comp[other_var] == comp_num: - print("", other_var, end="") - del var2comp[other_var] - print() - - # Update sorted_vars after deleting the appropriate entries - # from var2comp - sorted_vars = sorted(var2comp.keys()) + groups.setdefault(comp, []).append(var_name) + print(ppt_name) + # Each group is sorted, so this orders the groups by their first variable. + for group in sorted(groups.values()): + print(" ".join(group)) + if always_comparable: + print("-1:", " ".join(always_comparable)) print() diff --git a/scripts/dtrace-diff.pl b/scripts/dtrace-diff.pl index 05cda3de3e..6621b65821 100755 --- a/scripts/dtrace-diff.pl +++ b/scripts/dtrace-diff.pl @@ -1,9 +1,11 @@ #!/usr/bin/env perl # dtrace-diff.pl -# How to invoke: declsfile dtrace1 dtrace2 +# How to invoke: [declsfile] dtrace1 dtrace2 # Outputs differences that aren't hashcodes. -# Optionally also ignores differences in exit ppt numbers. +# The program point declarations are those in declsfile, if it is given, +# plus those in the dtrace files. declsfile may be a .decls file or a +# .dtrace file that contains declarations. use English; use strict; @@ -15,17 +17,11 @@ # The file `util_daikon.pm` appears in the same directory as this script. use util_daikon; -my $ignore_exitno = 0; - -if ($ARGV[0] eq "--ignore_exitno") { - $ignore_exitno = 1; - shift @ARGV; -} - -if (scalar(@ARGV) != 3) { - die "Usage: $0 [--ignore-exitno] \n"; +if (scalar(@ARGV) != 2 && scalar(@ARGV) != 3) { + die "Usage: $0 [] \n"; } -my ($declsname, $dtaname, $dtbname) = @ARGV; +my $declsname = (scalar(@ARGV) == 3) ? shift @ARGV : undef; +my ($dtaname, $dtbname) = @ARGV; my $differences_found = 0; my $errors_found = 0; @@ -54,48 +50,71 @@ ( $$ ) } -sub load_decls ( $ ) { -# Loads the decls file given by $1 into a hash, returns a ref. -# The hash maps from ppt name to the hash returned by parse_ppt_decl, +sub add_ppt_decl ( $$$$ ) { +# Adds the program point declaration whose text is $2, which appears at +# line $4 of the file named $3, to the decls hash $1, unless the hash +# already contains a declaration of the program point. +# The decls hash maps from ppt name to the hash returned by parse_ppt_decl, # augmented with two keys: # "var by name": map from varname to the variable's hash # "variable order": the names of the non-constant variables, in order. # These are the variables whose values appear in data trace records. - my ($mydeclsname) = @_; - my $decls = gzopen(\*DECLS, $mydeclsname); - my $declshash = {}; - foreach my $ppt (read_ppt_decls($decls, $mydeclsname)) { - my $by_name = {}; - my @varorder = (); - foreach my $var (@{$$ppt{vars}}) { - $$by_name{$$var{name}} = $var; - if (!defined($$var{constant})) { - push @varorder, $$var{name}; - } + my ($declshash, $text, $filename, $line) = @_; + my $ppt = parse_ppt_decl($text, $filename, $line); + return if exists $$declshash{$$ppt{name}}; + my $by_name = {}; + my @varorder = (); + foreach my $var (@{$$ppt{vars}}) { + $$by_name{$$var{name}} = $var; + if (!defined($$var{constant})) { + push @varorder, $$var{name}; + } + } + $$ppt{"var by name"} = $by_name; + $$ppt{"variable order"} = [ @varorder ]; + $$declshash{$$ppt{name}} = $ppt; +} + +sub load_decls ( $$ ) { +# Adds the program point declarations in the file named $2 to the decls +# hash $1 (see add_ppt_decl). Data trace records in the file are ignored. + my ($declshash, $mydeclsname) = @_; + my $reader = record_reader(gzopen(\*DECLS, $mydeclsname), $mydeclsname); + my $found = 0; + while (defined(my $record = $reader->())) { + if ($record->{kind} eq "ppt") { + add_ppt_decl($declshash, $record->{text}, $mydeclsname, $record->{line}); + $found = 1; } - $$ppt{"var by name"} = $by_name; - $$ppt{"variable order"} = [ @varorder ]; - $$declshash{$$ppt{name}} = $ppt; } close \*DECLS; - return $declshash; + $found or die "No program point declarations in $mydeclsname\n"; } -sub load_ppt ( $$ ) { -# Loads a single ppt using the record reader given by $1 (see -# record_reader in util_daikon.pm), which reads the dtrace file named $2. +sub load_ppt ( $$$ ) { +# Loads a single ppt using the record reader given by $2 (see +# record_reader in util_daikon.pm), which reads the dtrace file named $3. +# Program point declarations that precede the ppt are added to the decls +# hash $1. # Returns a "ppt_trace_info": a 3-element array of pptname, line number in # file, and hash mapping varname to array of value and modbit. - my ($dtreader, $dtfhname) = @_; - # Skip records other than data records, such as headers and program - # point declarations in a combined .dtrace file. + my ($declshash, $dtreader, $dtfhname) = @_; + # Skip records other than data records, such as headers. my $record; - do { + while (1) { $record = $dtreader->(); (defined $record) or return undef; - } while ($record->{kind} ne "data"); - my @lines = grep { !is_comment_line($_) } split(/\n/, $record->{text}); + last if $record->{kind} eq "data"; + if ($record->{kind} eq "ppt") { + add_ppt_decl($declshash, $record->{text}, $dtfhname, $record->{line}); + } + } + my $text = $record->{text}; + # Remove comment lines (see is_comment_line in util_daikon.pm). This + # is faster than testing each line. + $text =~ s/^(?:\/\/|#).*\n?//mg; + my @lines = split(/\n/, $text); my $pptname = unescape_decl(shift @lines); my $pptline = $record->{line}; @@ -107,14 +126,12 @@ ( $$ ) $varname = unescape_decl($varname); my ($modbit, $varval); (defined ($varval = shift @lines)) - # or die "malformed dtrace file (ppt $pptname, var $varname, no varval) $dtfhname"; - or die "malformed dtrace file (ppt $pptname) $dtfhname"; + or die "malformed dtrace file (ppt " . escape_decl($pptname) . ") $dtfhname"; unless ($varname eq 'this_invocation_nonce') { (defined ($modbit = shift @lines)) - # or die "malformed dtrace file (ppt $pptname, var $varname, val $varval, no modbit) $dtfhname"; - or die "malformed dtrace file (ppt $pptname, no modbit) $dtfhname"; + or die "malformed dtrace file (ppt " . escape_decl($pptname) . ", no modbit) $dtfhname"; } - die "duplicate entry in dtracefile for var $varname at $pptname in $dtfhname\n" + die "duplicate entry in dtracefile for var " . escape_decl($varname) . " at " . escape_decl($pptname) . " in $dtfhname\n" if (defined $$ppthash{$varname}); $$ppthash{$varname} = [$varval, $modbit]; push @varorder, $varname; @@ -154,13 +171,14 @@ ( $$$ ) # Arguments 2 and 3 are "ppt_trace_info" objects (see load_ppt for definition). my ($declshash, $ppta, $pptb) = @_; if ($$ppta[0] ne $$pptb[0]) { - print "ppt name difference: ${dtaname}=\"" . $$ppta[0] . " [line " . $$ppta[1] - . "] ". "\", ${dtbname}=\"" . $$pptb[0] . "\" [line ". $$pptb[1] ."]\n"; + print "ppt name difference: ${dtaname}=\"" . escape_decl($$ppta[0]) . " [line " . $$ppta[1] + . "] ". "\", ${dtbname}=\"" . escape_decl($$pptb[0]) . "\" [line ". $$pptb[1] ."]\n"; $differences_found++; return; } - my $pptname = $$ppta[0]; - my $ppt = $$declshash{$pptname}; + my $ppt = $$declshash{$$ppta[0]}; + # Names in the output are escaped, as in a dtrace file. + my $pptname = escape_decl($$ppta[0]); if (not defined $ppt) { print "ppt name not in decls: \"${pptname}\"\n"; $errors_found++; @@ -186,8 +204,9 @@ ( $$$ ) $errors_found++; foreach my $trace ([$dtaname, \@ppt1_varnames], [$dtbname, \@ppt2_varnames]) { my ($tracename, $trace_varnames) = @$trace; - foreach my $varname (@$trace_varnames) { - my $var = $$ppt{"var by name"}{$varname}; + foreach my $name (@$trace_varnames) { + my $var = $$ppt{"var by name"}{$name}; + my $varname = escape_decl($name); if (not defined $var) { print " ${varname} appears in ${tracename} but is not declared\n"; } elsif (defined $$var{constant}) { @@ -197,10 +216,11 @@ ( $$$ ) } } - foreach my $varname (@decls_varnames) { - my $rep_type = $$ppt{"var by name"}{$varname}{rep_type}; - my $la = $$ha{$varname}; - my $lb = $$hb{$varname}; + foreach my $name (@decls_varnames) { + my $rep_type = $$ppt{"var by name"}{$name}{rep_type}; + my $la = $$ha{$name}; + my $lb = $$hb{$name}; + my $varname = escape_decl($name); #la == lb == [varval, modbit] if ((not defined $la) && (not defined $lb)) { print "${varname} \@ ${pptname} undefined in both dtrace files\n"; @@ -270,12 +290,8 @@ ( $$$ ) my $dtb = record_reader(gzopen(\*DTB, $mydtbname), $mydtbname); PPT: while (1) { - - #Skip headers - - - my $ppta = load_ppt($dta, $mydtaname); - my $pptb = load_ppt($dtb, $mydtbname); + my $ppta = load_ppt($declshash, $dta, $mydtaname); + my $pptb = load_ppt($declshash, $dtb, $mydtbname); if ((not defined $ppta) && (not defined $pptb)) { last PPT; } elsif (not defined $ppta) { @@ -319,7 +335,10 @@ ( $ ) ### # load decls file -my $gdeclshash = load_decls($declsname); +my $gdeclshash = {}; +if (defined $declsname) { + load_decls($gdeclshash, $declsname); +} # dump it # dump_decls($gdeclshash); diff --git a/scripts/util_daikon.pm b/scripts/util_daikon.pm index 55fdc78349..fbad759185 100755 --- a/scripts/util_daikon.pm +++ b/scripts/util_daikon.pm @@ -154,30 +154,69 @@ sub record_kind ( $;$ ) { # line the line number of the first line of the record # # For speed, the input is read a paragraph at a time rather than a line at -# a time. A paragraph ends with an empty line, so it contains at most one -# record that is not a single-line header, and that record is last. +# a time. A paragraph ends with an empty line. Line endings may be "\n" +# or "\r\n", as determined by the first line of the file; "\r\n" line +# endings are converted to "\n". # Returns a new reader state for the file with the given name. sub new_reader_state ( $ ) { my ($filename) = @_; - return { filename => $filename, line => 1, comments => "" }; + return { filename => $filename, line => 1, comments => "", + separator => undef }; } +# Returns the next paragraph of the filehandle, which is the file whose +# reader state is the second argument, or undef at end of file. +sub read_paragraph ( $$ ) { + my ($fh, $state) = @_; + if (defined($state->{separator})) { + local $INPUT_RECORD_SEPARATOR = $state->{separator}; + return scalar(<$fh>); + } + # This is the first line of the file. Use it to determine the line + # ending, then read the rest of the paragraph. + my $first_line; + { + local $INPUT_RECORD_SEPARATOR = "\n"; + $first_line = <$fh>; + } + return undef if !defined($first_line); + $state->{separator} = ($first_line =~ /\r\n\z/) ? "\r\n\r\n" : "\n\n"; + return $first_line if $first_line !~ /\n\z/ || $first_line =~ /\A\r?\n\z/; + local $INPUT_RECORD_SEPARATOR = $state->{separator}; + my $rest = <$fh>; + return defined($rest) ? $first_line . $rest : $first_line; +} + +# Each of these matches the line that terminates a record: for a program +# point declaration, a line that contains only whitespace; for any other +# record, an empty line. +my $ppt_terminator = qr/^[^\S\n]*(?:\n|\z)/m; +my $other_terminator = qr/^\n/m; + # Returns the records in the paragraph, which is the next one read from the # file whose reader state is the first argument. Updates the state. sub paragraph_records ( $$ ) { my ($state, $paragraph) = @_; + $paragraph =~ s/\r\n/\n/g if $state->{separator} eq "\r\n\r\n"; my @records = (); my $line = $state->{line}; $state->{line} += ($paragraph =~ tr/\n//); + my $length = length($paragraph); + # The paragraph is processed by moving $pos forward rather than by + # removing text from the front of $paragraph, which would make + # processing a long paragraph take quadratic time. + my $pos = 0; while (1) { # Skip empty lines. - if ($paragraph =~ s/\A(\n+)//) { - $line += length($1); + while ($pos < $length && substr($paragraph, $pos, 1) eq "\n") { + $pos++; + $line++; } - last if $paragraph eq ""; - my $end = index($paragraph, "\n"); - my $first = ($end < 0) ? $paragraph : substr($paragraph, 0, $end + 1); + last if $pos == $length; + my $end = index($paragraph, "\n", $pos); + my $next = ($end < 0) ? $length : $end + 1; + my $first = substr($paragraph, $pos, $next - $pos); my $kind; if (!is_comment_line($first)) { $kind = record_kind($first, $state->{filename}); @@ -190,22 +229,26 @@ sub paragraph_records ( $$ ) { } else { $state->{comments} .= $first; } - $paragraph = ($end < 0) ? "" : substr($paragraph, $end + 1); + $pos = $next; $line++; next; } - my $text = $paragraph; - $paragraph = ""; - if ($kind eq "ppt" && $text =~ /^[^\S\n]+(?:\n|\z)/m) { - $paragraph = substr($text, $LAST_MATCH_END[0]); - $text = substr($text, 0, $LAST_MATCH_START[0]); + # The record extends to its terminating line or to the end of the + # paragraph. The first line of the record does not terminate it. + pos($paragraph) = $next; + my ($text_end, $after); + my $terminator = ($kind eq "ppt") ? $ppt_terminator : $other_terminator; + if ($paragraph =~ /$terminator/g) { + ($text_end, $after) = ($LAST_MATCH_START[0], $LAST_MATCH_END[0]); } else { - chop($text) if substr($text, -2) eq "\n\n"; + ($text_end, $after) = ($length, $length); } + my $text = substr($paragraph, $pos, $text_end - $pos); push @records, { comments => $state->{comments}, kind => $kind, text => $text, line => $line }; $state->{comments} = ""; $line += ($text =~ tr/\n//) + 1; + $pos = $after; } return @records; } @@ -232,8 +275,7 @@ sub record_reader ( $;$ ) { my $at_eof = 0; return sub { while (!@pending && !$at_eof) { - local $INPUT_RECORD_SEPARATOR = "\n\n"; - my $paragraph = <$fh>; + my $paragraph = read_paragraph($fh, $state); if (defined($paragraph)) { @pending = paragraph_records($state, $paragraph); } else { @@ -254,10 +296,9 @@ sub record_reader ( $;$ ) { # is the name of the current file. sub for_each_record ( $;$ ) { my ($process_record, $end_of_file) = @_; - my $state; - local $INPUT_RECORD_SEPARATOR = "\n\n"; - while (defined(my $paragraph = )) { - $state = new_reader_state($ARGV) if !defined($state); + my $state = new_reader_state(undef); + while (defined(my $paragraph = read_paragraph(\*ARGV, $state))) { + $state->{filename} = $ARGV; foreach my $record (paragraph_records($state, $paragraph)) { $process_record->($record); } @@ -266,7 +307,7 @@ sub for_each_record ( $;$ ) { $process_record->($record); } $end_of_file->() if defined($end_of_file); - undef $state; + $state = new_reader_state(undef); } } } @@ -284,7 +325,8 @@ my %var_keys = map { $_ => 1 } # text of the record, as returned by a record reader. Comment lines are # skipped. The optional second and third arguments are the name of the # file and the line number of the record, for use in error messages. -# Dies if the declaration is malformed. +# Dies if the declaration is malformed, including if a variable is declared +# twice or lacks var-kind, dec-type, or rep-type. # Returns a reference to a hash with these keys: # name the (unescaped) program point name # parents a reference to an array of the ppt-level parent records, each @@ -310,39 +352,65 @@ sub parse_ppt_decl ( $;$$ ) { $pptline =~ /\Appt\s+(.*?)\s*\z/s or croak "Not a program point declaration in " . $where->(0) . ": $pptline"; my $ppt = { name => unescape_decl($1), parents => [], vars => [] }; + # Dies with a message about the line at the given index of @lines. + my $malformed = sub { + my ($i, $message) = @_; + croak "Malformed declaration of " . escape_decl($ppt->{name}) . " in " + . $where->($i + 1) . ": $message"; + }; my $var; # the variable currently being read + my $var_index; # the index in @lines of the declaration of $var + my %var_items; # the keys that have appeared for $var + my %var_names; # the names of the variables declared so far + # Dies if $var lacks a key that Daikon requires (see + # VarDefinition.checkRep in Daikon). + my $check_var = sub { + return if !defined($var); + foreach my $key (qw( var-kind dec-type rep-type )) { + $var_items{$key} + or $malformed->($var_index, "variable " . escape_decl($var->{name}) . " has no $key"); + } + }; for (my $i = 0; $i < @lines; $i++) { my $line = $lines[$i]; $line =~ s/\A\s+//; $line =~ s/\s+\z//; next if $line eq "" || is_comment_line($line); my ($key, $value) = split(/\s+/, $line, 2); - my $error_prefix = "Malformed declaration of $ppt->{name} in " . $where->($i + 1); if ($key eq "variable") { - defined($value) or croak "$error_prefix: variable has no name"; + defined($value) or $malformed->($i, "variable has no name"); + $check_var->(); $var = { name => unescape_decl($value), dec_type => "", rep_type => "", comparability => "", constant => undef }; + $var_index = $i; + %var_items = (); + $var_names{$var->{name}}++ + and $malformed->($i, "variable $value declared twice"); push @{$ppt->{vars}}, $var; } elsif (!defined($var)) { $ppt_keys{$key} - or croak "$error_prefix: \"$key\" found where \"variable\", \"parent\", \"flags\", or \"ppt-type\" expected"; + or $malformed->($i, "\"$key\" found where \"variable\", \"parent\", \"flags\", or \"ppt-type\" expected"); if ($key eq "parent") { push @{$ppt->{parents}}, [split(/\s+/, defined($value) ? $value : "")]; } } elsif (!$var_keys{$key}) { - croak "$error_prefix: unexpected variable item \"$key\""; - } elsif (!defined($value) && $key =~ /\A(?:dec-type|rep-type|comparability|constant)\z/) { - croak "$error_prefix: \"$key\" has no value"; - } elsif ($key eq "dec-type") { - $var->{dec_type} = $value; - } elsif ($key eq "rep-type") { - $var->{rep_type} = $value; - } elsif ($key eq "comparability") { - $var->{comparability} = $value; - } elsif ($key eq "constant") { - $var->{constant} = $value; + $malformed->($i, "unexpected variable item \"$key\""); + } elsif (!defined($value) && $key =~ /\A(?:var-kind|dec-type|rep-type|comparability|constant)\z/) { + $malformed->($i, "\"$key\" has no value"); + } else { + $var_items{$key} = 1; + if ($key eq "dec-type") { + $var->{dec_type} = $value; + } elsif ($key eq "rep-type") { + $var->{rep_type} = $value; + } elsif ($key eq "comparability") { + $var->{comparability} = $value; + } elsif ($key eq "constant") { + $var->{constant} = $value; + } } } + $check_var->(); return $ppt; } From ec7b064ed425fe2d8c1b896656e02b8ba23ffa4e Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Sat, 10 Oct 2026 18:21:42 -0700 Subject: [PATCH 11/15] Address code review: declaration differences, CRLF output, array comparability, truncated records * dtrace-diff.pl reports a difference when two declarations of a program point have different variables, and reuses read_ppt_decls. * sort-dtrace.pl writes the input file's line endings. * decls2comp.py recognizes arrays by their rep-type. * dtrace-count.pl honors a "// EOF" line among a record's leading comments. * util_daikon.pm and dtrace-diff.pl use English without match variables. --- scripts/decls2comp.py | 5 ++- scripts/dtrace-count.pl | 10 ++++-- scripts/dtrace-diff.pl | 72 ++++++++++++++++++++++++++++++----------- scripts/sort-dtrace.pl | 23 +++++++++---- scripts/util_daikon.pm | 46 +++++++++++++++++--------- 5 files changed, 112 insertions(+), 44 deletions(-) diff --git a/scripts/decls2comp.py b/scripts/decls2comp.py index 59f348af5f..ecca7a5600 100755 --- a/scripts/decls2comp.py +++ b/scripts/decls2comp.py @@ -144,6 +144,7 @@ cur_var = None hashcode_vars = set() # Variables whose rep. type is a hashcode + array_vars = set() # Variables whose rep. type is an array for line in v: stripped_line = line.strip() @@ -154,6 +155,8 @@ cur_rep = stripped_line[len(REP_START) :] if hashcode_re.match(cur_rep): hashcode_vars.add(cur_var) + if cur_rep.endswith("[]"): + array_vars.add(cur_var) elif stripped_line[0 : len(COMP_START)] == COMP_START: assert ( cur_var # There should have been a variable entry before comparability @@ -171,7 +174,7 @@ always_comparable = [] # Variables that are comparable to every variable for var_name in sorted(var2comp.keys()): comp = var2comp[var_name] - if comp.startswith("-") and "[" not in comp: + if comp.startswith("-") and var_name not in array_vars: always_comparable.append(var_name) else: groups.setdefault(comp, []).append(var_name) diff --git a/scripts/dtrace-count.pl b/scripts/dtrace-count.pl index b0a241f16f..02db5f0127 100755 --- a/scripts/dtrace-count.pl +++ b/scripts/dtrace-count.pl @@ -25,11 +25,15 @@ for_each_record(sub { my ($record) = @_; # Skip headers and declarations - count_record($record->{text}) if $record->{kind} eq "data"; + count_record($record) if $record->{kind} eq "data"; }); sub count_record { - local $_ = shift; + my ($record) = @_; + local $_ = $record->{text}; + # A truncated record is marked by a "// EOF" line, which may be among + # the comment lines that precede the record. + my $truncated = ($record->{comments} =~ m{^// EOF}m || $_ =~ "// EOF"); return if /^Begin/ or /^Done/; # Skip processing program point comments # This script assumes that each program point name contains ":::". /^(.*):::(.+)$/m or die "Can't parse PPT name from <$_>"; @@ -47,7 +51,7 @@ sub count_record { die "Mismatched line count (expected $ppt_count{$name}[1], found $line_count)". " for $name in $_" unless (($ppt_count{$name}[1] == $line_count) - || ($_ =~ "// EOF") || ($name=~m/std::allocator())) { - if ($record->{kind} eq "ppt") { - add_ppt_decl($declshash, $record->{text}, $mydeclsname, $record->{line}); - $found = 1; - } + foreach my $ppt (read_ppt_decls(gzopen(\*DECLS, $mydeclsname), $mydeclsname, 1)) { + add_ppt_decl($declshash, $ppt); } close \*DECLS; - $found or die "No program point declarations in $mydeclsname\n"; } sub load_ppt ( $$$ ) { @@ -107,7 +142,8 @@ ( $$$ ) or return undef; last if $record->{kind} eq "data"; if ($record->{kind} eq "ppt") { - add_ppt_decl($declshash, $record->{text}, $dtfhname, $record->{line}); + add_ppt_decl($declshash, + parse_ppt_decl($record->{text}, $dtfhname, $record->{line})); } } my $text = $record->{text}; diff --git a/scripts/sort-dtrace.pl b/scripts/sort-dtrace.pl index 7e033ad307..aea448c51d 100755 --- a/scripts/sort-dtrace.pl +++ b/scripts/sort-dtrace.pl @@ -28,16 +28,26 @@ # blank lines between them, and a blank line follows the last of them. my $after_header = 0; +# The line ending of the current file, "\n" or "\r\n". +my $newline = "\n"; + +# Prints the arguments, using the line ending of the current file. +sub output { + my $text = join("", @_); + $text =~ s/\n/\r\n/g if $newline ne "\n"; + print $text; +} + sub end_headers { if ($after_header) { - print "\n"; + output "\n"; $after_header = 0; } } sub flush_decls { foreach my $decl (sort { $a->[1] cmp $b->[1] } @decls) { - print $decl->[0], $decl->[1], "\n"; + output $decl->[0], $decl->[1], "\n"; } @decls = (); } @@ -83,10 +93,11 @@ sub sort_variables { sub process_record { my ($record) = @_; + $newline = $record->{newline}; my $kind = $record->{kind}; if ($kind eq "header") { flush_decls(); - print $record->{comments}, $record->{text}; + output $record->{comments}, $record->{text}; $after_header = 1; return; } @@ -98,9 +109,9 @@ sub process_record { return; } flush_decls(); - print $record->{comments}; + output $record->{comments}; if ($kind eq "list-implementors") { - print $record->{text}, "\n"; + output $record->{text}, "\n"; } elsif ($kind eq "data") { my @lines = split(/\n/, $record->{text}); my @header; @@ -115,6 +126,6 @@ sub process_record { push @vars, join("\n", splice(@lines, 0, 3)); } @vars = sort @vars; - print join("\n", @header, @vars), "\n\n"; + output join("\n", @header, @vars), "\n\n"; } } diff --git a/scripts/util_daikon.pm b/scripts/util_daikon.pm index fbad759185..030ea59ad3 100755 --- a/scripts/util_daikon.pm +++ b/scripts/util_daikon.pm @@ -11,7 +11,7 @@ our @EXPORT = qw( cleanup_pptname system_or_die backticks_or_die record_kind record_reader for_each_record parse_ppt_decl read_ppt_decls ); -use English; +use English qw(-no_match_vars); use strict; $WARNING = 1; # "-w" flag @@ -152,11 +152,14 @@ sub record_kind ( $;$ ) { # text the lines of the record, without the empty line that # terminates it; or "" if kind is "" # line the line number of the first line of the record +# newline the line ending of the file, "\n" or "\r\n" # # For speed, the input is read a paragraph at a time rather than a line at # a time. A paragraph ends with an empty line. Line endings may be "\n" -# or "\r\n", as determined by the first line of the file; "\r\n" line -# endings are converted to "\n". +# or "\r\n", as determined by the first line of the file. In the comments +# and text of a record, "\r\n" line endings are converted to "\n"; a +# client that writes a file in place can use the newline key to restore +# them. # Returns a new reader state for the file with the given name. sub new_reader_state ( $ ) { @@ -198,7 +201,11 @@ my $other_terminator = qr/^\n/m; # file whose reader state is the first argument. Updates the state. sub paragraph_records ( $$ ) { my ($state, $paragraph) = @_; - $paragraph =~ s/\r\n/\n/g if $state->{separator} eq "\r\n\r\n"; + my $newline = "\n"; + if ($state->{separator} eq "\r\n\r\n") { + $paragraph =~ s/\r\n/\n/g; + $newline = "\r\n"; + } my @records = (); my $line = $state->{line}; $state->{line} += ($paragraph =~ tr/\n//); @@ -224,7 +231,7 @@ sub paragraph_records ( $$ ) { if (!defined($kind) || $kind eq "header") { if (defined($kind)) { push @records, { comments => $state->{comments}, kind => $kind, - text => $first, line => $line }; + text => $first, line => $line, newline => $newline }; $state->{comments} = ""; } else { $state->{comments} .= $first; @@ -245,7 +252,7 @@ sub paragraph_records ( $$ ) { } my $text = substr($paragraph, $pos, $text_end - $pos); push @records, { comments => $state->{comments}, kind => $kind, - text => $text, line => $line }; + text => $text, line => $line, newline => $newline }; $state->{comments} = ""; $line += ($text =~ tr/\n//) + 1; $pos = $after; @@ -258,8 +265,10 @@ sub paragraph_records ( $$ ) { sub end_of_file_records ( $ ) { my ($state) = @_; return () if $state->{comments} eq ""; + my $newline = (defined($state->{separator}) + && $state->{separator} eq "\r\n\r\n") ? "\r\n" : "\n"; my $record = { comments => $state->{comments}, kind => "", text => "", - line => $state->{line} }; + line => $state->{line}, newline => $newline }; $state->{comments} = ""; return ($record); } @@ -338,6 +347,8 @@ my %var_keys = map { $_ => 1 } # variable, or undef if the variable is not a constant). The # value of a constant variable does not appear in data trace # records. +# file the second argument, or undef +# line the third argument, or undef sub parse_ppt_decl ( $;$$ ) { my ($text, $filename, $line_number) = @_; my ($pptline, @lines) = split(/\n/, $text); @@ -351,7 +362,8 @@ sub parse_ppt_decl ( $;$$ ) { }; $pptline =~ /\Appt\s+(.*?)\s*\z/s or croak "Not a program point declaration in " . $where->(0) . ": $pptline"; - my $ppt = { name => unescape_decl($1), parents => [], vars => [] }; + my $ppt = { name => unescape_decl($1), parents => [], vars => [], + file => $filename, line => $line_number }; # Dies with a message about the line at the given index of @lines. my $malformed = sub { my ($i, $message) = @_; @@ -415,19 +427,21 @@ sub parse_ppt_decl ( $;$$ ) { } # Reads all the program point declarations from the filehandle, which is a -# version 2 .decls file. Headers and comments are skipped. Returns a list -# of references to hashes, as returned by parse_ppt_decl. Dies if the file -# is in version 1 format, contains a data trace record, or contains no -# program point declarations. The second argument is the name of the -# file, for use in error messages. -sub read_ppt_decls ( $$ ) { - my ($fh, $filename) = @_; +# version 2 .decls file, or a .dtrace file if the optional third argument +# is true. Headers, comments, and (for a .dtrace file) data trace records +# are skipped. Returns a list of references to hashes, as returned by +# parse_ppt_decl. Dies if the file is in version 1 format, contains no +# program point declarations, or is a .decls file that contains a data +# trace record. The second argument is the name of the file, for use in +# error messages. +sub read_ppt_decls ( $$;$ ) { + my ($fh, $filename, $allow_data) = @_; my @ppts = (); my $reader = record_reader($fh, $filename); while (defined(my $record = $reader->())) { if ($record->{kind} eq "ppt") { push @ppts, parse_ppt_decl($record->{text}, $filename, $record->{line}); - } elsif ($record->{kind} eq "data") { + } elsif ($record->{kind} eq "data" && !$allow_data) { croak "Declaration files should not contain data trace records, but $filename does at line $record->{line}"; } } From acc344dabc9d21548c8ff77c28ccbdbc0899cac4 Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Sat, 10 Oct 2026 18:38:51 -0700 Subject: [PATCH 12/15] Address code review: -1: line in analyze-comp-file.py, optional declsfile in dtrace-diff-fast.pl, dead code --- scripts/analyze-comp-file.py | 31 ++++++++++++++++++++++++------- scripts/convertcsv.pl | 17 +++++++---------- scripts/decls2comp.py | 22 +++++++++++++--------- scripts/dtrace-count.pl | 25 ++++++++++++++++++++----- scripts/dtrace-diff-fast.pl | 8 ++++---- scripts/dtrace-diff.pl | 14 +++++++------- scripts/sort-dtrace.pl | 35 ++++++++++++++++++++++++----------- scripts/util_daikon.pm | 9 ++++----- 8 files changed, 103 insertions(+), 58 deletions(-) diff --git a/scripts/analyze-comp-file.py b/scripts/analyze-comp-file.py index 28a59d1510..d2c74c74d3 100755 --- a/scripts/analyze-comp-file.py +++ b/scripts/analyze-comp-file.py @@ -12,9 +12,10 @@ all_lines = [line.strip() for line in f] # Key: program point name -# Value: a list where each element is the size of a comparability set -# for that ppt -ppt_info_dict = {} +# Value: a pair of a list where each element is the size of a comparability +# set for that ppt, and the number of variables that are comparable +# to every variable at that ppt +ppt_info_dict: dict[str, tuple[list[int], int]] = {} # The current program point we are analyzing cur_ppt = None @@ -22,6 +23,9 @@ # Initialize this to an empty list and append on the size of the # comparability sets for each line you encounter in the program point. cur_ppt_set_sizes: list[int] = [] +# The number of variables at the current program point that are comparable +# to every variable. decls2comp.py lists them on a line starting with "-1:". +cur_ppt_num_always_comparable = 0 # Initialize ppt_info_dict for line in all_lines: @@ -35,10 +39,15 @@ # Normally, throw all of the data about the previous program # point into ppt_info_dict and update cur_ppt else: - ppt_info_dict[cur_ppt] = cur_ppt_set_sizes + ppt_info_dict[cur_ppt] = (cur_ppt_set_sizes, cur_ppt_num_always_comparable) cur_ppt = line cur_ppt_set_sizes = [] + cur_ppt_num_always_comparable = 0 + + # The variables that are comparable to every variable + elif line.startswith("-1:"): + cur_ppt_num_always_comparable = len(line.split()) - 1 # (Ignore blank lines) ... we hit a space-delimited list of # comparable variables @@ -46,6 +55,8 @@ # Size of comparability set for that line (usually 1) cur_ppt_set_sizes.append(len(line.split())) +if cur_ppt: + ppt_info_dict[cur_ppt] = (cur_ppt_set_sizes, cur_ppt_num_always_comparable) # Now ppt_info_dict should be initialized with all numerical data. # We can now crunch numbers and produce useful-looking results @@ -58,9 +69,15 @@ total_square_vars_no_comp = 0 -for ppt, comp_set_sizes_at_ppt in ppt_info_dict.items(): # ruff:ignore[unused-loop-control-variable, incorrect-dict-iterator] - total_vars_at_ppt = sum(comp_set_sizes_at_ppt) - square_vars_at_ppt = sum((i * i) for i in comp_set_sizes_at_ppt) +for ppt, (comp_set_sizes_at_ppt, num_always_comparable) in ppt_info_dict.items(): # ruff:ignore[unused-loop-control-variable, incorrect-dict-iterator] + total_vars_at_ppt = sum(comp_set_sizes_at_ppt) + num_always_comparable + # The sum, over all variables at the ppt, of the number of variables it is + # comparable to. A variable in a comparability set of size i is + # comparable to the i variables in its set and to every variable that is + # comparable to every variable. + square_vars_at_ppt = sum((i * (i + num_always_comparable)) for i in comp_set_sizes_at_ppt) + ( + num_always_comparable * total_vars_at_ppt + ) if total_vars_at_ppt > 0: avg_for_ppt = float(square_vars_at_ppt) / float(total_vars_at_ppt) diff --git a/scripts/convertcsv.pl b/scripts/convertcsv.pl index 698fdfe2b8..1a6be1a7d8 100755 --- a/scripts/convertcsv.pl +++ b/scripts/convertcsv.pl @@ -371,16 +371,13 @@ ( $ ) my @sample = $csv->fields(); # get the parsed fields { - # Check the number of columns in the csv file. + # Check the number of columns in the csv file. The header line + # determines the number of columns. Some columns might not be + # declared variables, such as when a constant variable has a column. my $sample_length = scalar(@sample); - if ($sample_length > $num_decl_vars) { - die "csv file $inputfilename line " . ($num_samples+1) . " contains $sample_length values, was declared to have $num_decl_vars"; - } - if ($sample_length < $num_decl_vars) { - die "csv file $inputfilename line " . ($num_samples+1) . " contains $sample_length values, was declared to have $num_decl_vars"; - for (my $z = $sample_length; $z < $num_decl_vars; $z++) { - $sample[$z] = ""; - } + my $num_csv_vars = scalar(@csv_varnames); + if ($sample_length != $num_csv_vars) { + die "csv file $inputfilename line " . ($num_samples+1) . " contains $sample_length values, but the header line contains $num_csv_vars"; } } @@ -435,7 +432,7 @@ ( $ ) for (my $j = 0; $j<$num_decl_vars; $j++) { my $csvindex = $decl_csvindex[$j]; my $type = ($isNumber[$csvindex] ? "double" : "java.lang.String"); - print DECLSHANDLE " variable " . escape_decl($csv_varnames[$csvindex]) . "\n"; + print DECLSHANDLE " variable " . escape_decl($decl_varnames[$j]) . "\n"; print DECLSHANDLE " var-kind variable\n"; print DECLSHANDLE " dec-type $type\n"; print DECLSHANDLE " rep-type $type\n"; diff --git a/scripts/decls2comp.py b/scripts/decls2comp.py index ecca7a5600..5cad491118 100755 --- a/scripts/decls2comp.py +++ b/scripts/decls2comp.py @@ -15,8 +15,9 @@ are identical. For arrays, this is stricter than Daikon, which compares the element and index comparabilities (as in "9[10]") separately. A variable whose comparability is negative and is not an -array is comparable to every variable; all such variables are listed on -the last line for the program point, which starts with "-1:". +array, or that has no comparability, is comparable to every variable; +all such variables are listed on the last line for the program point, +which starts with "-1:". Usage: ./decls2comp.py input.decls 'no-hashcodes' [optional] Running this with the 'no-hashcodes' string as the 2nd arg results @@ -102,10 +103,12 @@ for line in f: line = line.strip() + # Skip blank lines and comments. This is like FileIO.isComment in Daikon. + if line == "" or line.startswith(("//", "#")): + continue if line[0:4] == "ppt ": temp_all_ppts.append([line[len(PPT_START) :]]) # Start a new list - is_intermediate = 0 - elif line != "" and line[0] != "#": # Don't add blank lines & comments + else: if len(temp_all_ppts) > 0: temp_all_ppts[-1].append(line) # Append line to the latest entry @@ -121,8 +124,7 @@ # There is already an entry if ppt_list[0] in all_ppts: # Try appending numbers until there isn't an entry - found = 1 - while found: + while True: ppt_name = ppt_list[0] + " (" + str(index) + ")" if ppt_name not in all_ppts: break @@ -136,8 +138,9 @@ # Process each PPT for ppt_name in sorted_ppt_keys: v = all_ppts[ppt_name] - i = 0 - var2comp: dict[str, str] = {} # Key: variable name, Value: comparability number + # Key: variable name, Value: comparability number, or None if the + # variable has no comparability + var2comp: dict[str, str | None] = {} # The comparability info for a variable at a program point is # prefixed by comparability @@ -150,6 +153,7 @@ if stripped_line[0 : len(VAR_START)] == VAR_START: cur_var = stripped_line[len(VAR_START) :] + var2comp[cur_var] = None elif stripped_line[0 : len(REP_START)] == REP_START: assert cur_var # There should have been a variable entry before rep-type cur_rep = stripped_line[len(REP_START) :] @@ -174,7 +178,7 @@ always_comparable = [] # Variables that are comparable to every variable for var_name in sorted(var2comp.keys()): comp = var2comp[var_name] - if comp.startswith("-") and var_name not in array_vars: + if comp is None or (comp.startswith("-") and var_name not in array_vars): always_comparable.append(var_name) else: groups.setdefault(comp, []).append(var_name) diff --git a/scripts/dtrace-count.pl b/scripts/dtrace-count.pl index 02db5f0127..46aa39f1cc 100755 --- a/scripts/dtrace-count.pl +++ b/scripts/dtrace-count.pl @@ -22,18 +22,33 @@ my %long_names; +# A truncated record is marked by a "// EOF" line, which is either within +# the record or among the comment lines that follow it, which precede the +# next record. Therefore, a data record is counted only once the next +# record has been read, or at the end of the file. +my $pending; # the data record that has not yet been counted + for_each_record(sub { my ($record) = @_; + if (defined($pending)) { + count_record($pending, scalar($record->{comments} =~ m{^// EOF}m)); + undef $pending; + } # Skip headers and declarations - count_record($record) if $record->{kind} eq "data"; + $pending = $record if $record->{kind} eq "data"; +}, sub { + if (defined($pending)) { + count_record($pending, 0); + undef $pending; + } }); +# Counts the data record given by the first argument. The second argument +# is true if a "// EOF" line follows the record. sub count_record { - my ($record) = @_; + my ($record, $followed_by_eof) = @_; local $_ = $record->{text}; - # A truncated record is marked by a "// EOF" line, which may be among - # the comment lines that precede the record. - my $truncated = ($record->{comments} =~ m{^// EOF}m || $_ =~ "// EOF"); + my $truncated = ($followed_by_eof || $_ =~ "// EOF"); return if /^Begin/ or /^Done/; # Skip processing program point comments # This script assumes that each program point name contains ":::". /^(.*):::(.+)$/m or die "Can't parse PPT name from <$_>"; diff --git a/scripts/dtrace-diff-fast.pl b/scripts/dtrace-diff-fast.pl index 2016cb1e63..25b98e0496 100755 --- a/scripts/dtrace-diff-fast.pl +++ b/scripts/dtrace-diff-fast.pl @@ -1,7 +1,7 @@ #!/usr/bin/env perl # dtrace-diff-fast.pl -# arguments: dtrace-diff declsfile dtrace1 dtrace2 +# arguments: [declsfile] dtrace1 dtrace2 # (declsfile is ignored, but accepted for compatibility with dtrace-diff.pl) # Outputs the first difference that isn't a large pointer-like integer @@ -18,10 +18,10 @@ BEGIN } } -if (scalar(@ARGV) != 3) { - die "Usage: $0 \n"; +if (scalar(@ARGV) != 2 && scalar(@ARGV) != 3) { + die "Usage: $0 [] \n"; } -my ($decls_name, $dt1_name, $dt2_name) = @ARGV; +my ($dt1_name, $dt2_name) = @ARGV[-2, -1]; if ($dt1_name =~ /\.gz$/) { open(DT1, "gzip -dc $dt1_name |") or die "Can't open $dt1_name: $!\n"; } else { diff --git a/scripts/dtrace-diff.pl b/scripts/dtrace-diff.pl index dd246c9225..2dbc03a81c 100755 --- a/scripts/dtrace-diff.pl +++ b/scripts/dtrace-diff.pl @@ -19,7 +19,7 @@ # The file `util_daikon.pm` appears in the same directory as this script. use util_daikon; -if (scalar(@ARGV) != 2 && scalar(@ARGV) != 3) { +if ((scalar(@ARGV) != 2 && scalar(@ARGV) != 3) || grep(/^-./, @ARGV)) { die "Usage: $0 [] \n"; } my $declsname = (scalar(@ARGV) == 3) ? shift @ARGV : undef; @@ -131,8 +131,9 @@ ( $$$ ) # record_reader in util_daikon.pm), which reads the dtrace file named $3. # Program point declarations that precede the ppt are added to the decls # hash $1. -# Returns a "ppt_trace_info": a 3-element array of pptname, line number in -# file, and hash mapping varname to array of value and modbit. +# Returns a "ppt_trace_info": a 4-element array of pptname, line number in +# file, hash mapping varname to array of value and modbit, and array of +# varnames in the order they appear in the file. my ($declshash, $dtreader, $dtfhname) = @_; # Skip records other than data records, such as headers. my $record; @@ -172,9 +173,8 @@ ( $$$ ) $$ppthash{$varname} = [$varval, $modbit]; push @varorder, $varname; } - $$ppthash{"variable order"} = [ @varorder ]; - return [$pptname, $pptline, $ppthash]; + return [$pptname, $pptline, $ppthash, \@varorder]; } sub print_ppt ( $ ) { @@ -222,8 +222,8 @@ ( $$$ ) } my $ha = $$ppta[2]; my $hb = $$pptb[2]; my @decls_varnames = @{$$ppt{"variable order"}}; - my @ppt1_varnames = @{$$ha{"variable order"}}; - my @ppt2_varnames = @{$$hb{"variable order"}}; + my @ppt1_varnames = @{$$ppta[3]}; + my @ppt2_varnames = @{$$pptb[3]}; if ((scalar(@ppt1_varnames) > 0) && ($ppt1_varnames[0] eq "this_invocation_nonce")) { shift @ppt1_varnames; diff --git a/scripts/sort-dtrace.pl b/scripts/sort-dtrace.pl index aea448c51d..ec39b78a9e 100755 --- a/scripts/sort-dtrace.pl +++ b/scripts/sort-dtrace.pl @@ -113,19 +113,32 @@ sub process_record { if ($kind eq "list-implementors") { output $record->{text}, "\n"; } elsif ($kind eq "data") { - my @lines = split(/\n/, $record->{text}); - my @header; - push @header, shift @lines; - if (@lines and $lines[0] eq "this_invocation_nonce") { - push @header, shift @lines; - push @header, shift @lines; + my ($pptname, @lines) = split(/\n/, $record->{text}); + # Each element is a [comments, line] pair for one non-comment line. A + # comment line stays with the line that follows it. + my @items; + # Comment lines that are not yet attached to a line. + my $pending = ""; + foreach my $line (@lines) { + if (is_comment_line($line)) { + $pending .= "$line\n"; + } else { + push @items, [$pending, $line]; + $pending = ""; + } } - die "Bad number of lines in $ARGV at line $record->{line}" unless @lines % 3 == 0; + my @header = ($pptname); + if (@items and $items[0][1] eq "this_invocation_nonce") { + push @header, map { $_->[0] . $_->[1] } splice(@items, 0, 2); + } + die "Bad number of lines in $ARGV at line $record->{line}" unless @items % 3 == 0; + # Each element is a [name, text] pair for one variable. my @vars; - while (@lines) { - push @vars, join("\n", splice(@lines, 0, 3)); + while (@items) { + my @var = splice(@items, 0, 3); + push @vars, [$var[0][1], join("\n", map { $_->[0] . $_->[1] } @var)]; } - @vars = sort @vars; - output join("\n", @header, @vars), "\n\n"; + @vars = map { $_->[1] } sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] } @vars; + output join("\n", @header, @vars), "\n", $pending, "\n"; } } diff --git a/scripts/util_daikon.pm b/scripts/util_daikon.pm index 030ea59ad3..25ade60568 100755 --- a/scripts/util_daikon.pm +++ b/scripts/util_daikon.pm @@ -430,10 +430,9 @@ sub parse_ppt_decl ( $;$$ ) { # version 2 .decls file, or a .dtrace file if the optional third argument # is true. Headers, comments, and (for a .dtrace file) data trace records # are skipped. Returns a list of references to hashes, as returned by -# parse_ppt_decl. Dies if the file is in version 1 format, contains no -# program point declarations, or is a .decls file that contains a data -# trace record. The second argument is the name of the file, for use in -# error messages. +# parse_ppt_decl. Dies if the file is in version 1 format, or is a .decls +# file that contains a data trace record or no program point declarations. +# The second argument is the name of the file, for use in error messages. sub read_ppt_decls ( $$;$ ) { my ($fh, $filename, $allow_data) = @_; my @ppts = (); @@ -445,7 +444,7 @@ sub read_ppt_decls ( $$;$ ) { croak "Declaration files should not contain data trace records, but $filename does at line $record->{line}"; } } - if (!@ppts) { + if (!@ppts && !$allow_data) { croak "No program point declarations in $filename"; } return @ppts; From 93624b6cb4e629f2916c9ed40614bbce2452022b Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Sat, 10 Oct 2026 21:44:13 -0700 Subject: [PATCH 13/15] convertcsv.pl: do not quote variable names; update Kvasir .comp goals for variables without comparability --- scripts/convertcsv.pl | 42 +------------------ .../ArrayTest-cpp/ArrayTest-cpp.comp.goal | 6 +++ tests/kvasir-tests/Dstr/Dstr.comp.goal | 1 + .../SimpleClassesTest.comp.goal | 5 +++ .../StackArrayCppTest.comp.goal | 1 + .../StackCppTest/StackCppTest.comp.goal | 2 + .../StackCppTestInline.comp.goal | 2 + 7 files changed, 19 insertions(+), 40 deletions(-) diff --git a/scripts/convertcsv.pl b/scripts/convertcsv.pl index 1a6be1a7d8..7aa52376dd 100755 --- a/scripts/convertcsv.pl +++ b/scripts/convertcsv.pl @@ -86,33 +86,6 @@ ( $ ) return ($$ppt{name}, @varnames); } -# Returns the variable name, surrounded by double quotes (and with -# backslashes and double quotes escaped) if it contains spaces, periods, -# hyphens, double quotes, slashes, or (square|angle|regular) brackets. -# Daikon parses each variable name (see VarInfoName.parse), and a quoted -# name is parsed as a simple name. -sub formatVarName ( $ ) { - my ($input) = check_args(1, @_); - my $simplified = $input; - # To facilitate commenting out - # one or more of these expressions, - # each one was written in a separate line. - $simplified =~ s/ /_/g; - $simplified =~ s/\./_/g; - $simplified =~ s/(\"|-|\/)/_/g; - $simplified =~ s/(\(|\))//g; - $simplified =~ s/(\[|\])//g; - $simplified =~ s/(\<|\>)//g; - if ($simplified eq $input) { - return $input; - } - $simplified = $input; - # Quote backslashes and quotes (in that order) - $simplified =~ s/\\/\\\\/g; - $simplified =~ s/\"/\\\"/g; - return '"' . $simplified . '"'; -} - ########################################################################### @@ -226,13 +199,6 @@ ( $ ) } @csv_varnames = $csv->fields(); # get the parsed fields - my $i = 0; - foreach my $var (@csv_varnames) { - # Quote names that Daikon could not otherwise parse as simple names. - $csv_varnames[$i] = formatVarName($csv_varnames[$i]); - $i++; - } - } my $varnames_input = ; @@ -251,16 +217,12 @@ ( $ ) } my $num_decl_vars = scalar(@decl_varnames); -# The csv index of each declared variable. A declared variable matches a -# csv column whose name is the same, either as written in the csv file or -# as transformed by formatVarName. +# The csv index of each declared variable. A declared variable matches the +# csv column with the same name. my @decl_csvindex; for (my $j = 0; $j < $num_decl_vars; $j++) { my $varname = $decl_varnames[$j]; my $csvindex = $varNameCsvIndex{$varname}; - if (!defined($csvindex)) { - $csvindex = $varNameCsvIndex{formatVarName($varname)}; - } if (!defined($csvindex)) { die "Declared variable " . escape_decl($varname) . " is not a column of $inputfilename"; } diff --git a/tests/kvasir-tests/ArrayTest-cpp/ArrayTest-cpp.comp.goal b/tests/kvasir-tests/ArrayTest-cpp/ArrayTest-cpp.comp.goal index f7c38c4370..a46d1baa10 100644 --- a/tests/kvasir-tests/ArrayTest-cpp/ArrayTest-cpp.comp.goal +++ b/tests/kvasir-tests/ArrayTest-cpp/ArrayTest-cpp.comp.goal @@ -687,6 +687,7 @@ return[..].foo_head return[..].foo_tail A:::OBJECT +-1: this this->B this->B[..] this->B[..].C this->B[..].C.baz_head this->B[..].C.baz_tail this->B[..].C.y this->B[..].D[0] this->B[..].D[0]->neverSeeMe this->B[..].D[0][0] this->B[..].D[1] this->B[..].D[1]->neverSeeMe this->B[..].D[1][0] this->B[..].D[2] this->B[..].D[2]->neverSeeMe this->B[..].D[2][0] this->B[..].bar_head this->B[..].bar_tail this->foo_head this->foo_tail ArrayTest_cpp.cpp.returnIntSum(int,\_int*):::ENTER ::abracadabra ::abracadabra.social_security[..] @@ -829,12 +830,17 @@ a b[..] return b _buffers:::OBJECT +-1: this this->SS this->age this->firstName this->lastName this->mallocMePlease this->middleName this->weight array_struct:::OBJECT +-1: this this->MIT_id this->MIT_id[..] this->birthday this->birthday[..] this->social_security this->social_security[..] unnamed_DWARF_ID_1:::OBJECT +-1: this this->C this->C.baz_head this->C.baz_tail this->C.y this->D this->D[..] this->D[..].neverSeeMe this->bar_head this->bar_tail unnamed_DWARF_ID_2:::OBJECT +-1: this this->baz_head this->baz_tail this->y unnamed_DWARF_ID_3:::OBJECT +-1: this this->neverSeeMe diff --git a/tests/kvasir-tests/Dstr/Dstr.comp.goal b/tests/kvasir-tests/Dstr/Dstr.comp.goal index 55534b1e15..7084cb7dfc 100644 --- a/tests/kvasir-tests/Dstr/Dstr.comp.goal +++ b/tests/kvasir-tests/Dstr/Dstr.comp.goal @@ -1207,4 +1207,5 @@ this->max this->used this[0] this->theBuffer Dstr:::OBJECT +-1: this this->max this->theBuffer this->used diff --git a/tests/kvasir-tests/SimpleClassesTest/SimpleClassesTest.comp.goal b/tests/kvasir-tests/SimpleClassesTest/SimpleClassesTest.comp.goal index 7da9f9178d..8349629358 100644 --- a/tests/kvasir-tests/SimpleClassesTest/SimpleClassesTest.comp.goal +++ b/tests/kvasir-tests/SimpleClassesTest/SimpleClassesTest.comp.goal @@ -78,6 +78,7 @@ A.setEverything():::EXIT0 this A:::OBJECT +-1: this this->privateIntA this->protectedIntA this->publicIntA B.setEverything():::ENTER ::arrayOfBees @@ -120,6 +121,7 @@ B.setEverything():::EXIT0 this B:::OBJECT +-1: this this->C.privateIntC this->C.protectedIntC this->C.publicIntC this->D.privateIntD this->D.protectedIntD this->D.publicIntD this->E.A.privateIntA this->E.A.protectedIntA this->E.A.publicIntA this->E.privateIntE this->E.protectedIntE this->E.publicIntE this->privateIntB this->protectedIntB this->publicIntB C.setEverything():::ENTER ::arrayOfBees @@ -162,6 +164,7 @@ C.setEverything():::EXIT0 this C:::OBJECT +-1: this this->privateIntC this->protectedIntC this->publicIntC D.setEverything():::ENTER ::arrayOfBees @@ -204,6 +207,7 @@ D.setEverything():::EXIT0 this D:::OBJECT +-1: this this->privateIntD this->protectedIntD this->publicIntD E.setEverything():::ENTER ::arrayOfBees @@ -246,4 +250,5 @@ E.setEverything():::EXIT0 this E:::OBJECT +-1: this this->A.privateIntA this->A.protectedIntA this->A.publicIntA this->privateIntE this->protectedIntE this->publicIntE diff --git a/tests/kvasir-tests/StackArrayCppTest/StackArrayCppTest.comp.goal b/tests/kvasir-tests/StackArrayCppTest/StackArrayCppTest.comp.goal index 9234f1c472..fe6b707434 100644 --- a/tests/kvasir-tests/StackArrayCppTest/StackArrayCppTest.comp.goal +++ b/tests/kvasir-tests/StackArrayCppTest/StackArrayCppTest.comp.goal @@ -151,4 +151,5 @@ this->myName this->stackRep[..] Stack:::OBJECT +-1: this this->maxElts this->myName this->numElts this->stackRep this->stackRep[..] diff --git a/tests/kvasir-tests/StackCppTest/StackCppTest.comp.goal b/tests/kvasir-tests/StackCppTest/StackCppTest.comp.goal index 14362d0973..9c6880e0dd 100644 --- a/tests/kvasir-tests/StackCppTest/StackCppTest.comp.goal +++ b/tests/kvasir-tests/StackCppTest/StackCppTest.comp.goal @@ -36,6 +36,7 @@ this->next[..].next[0] this[0] Link:::OBJECT +-1: this this->data this->next this->next[..] this->next[..].data this->next[..].next this->next[..].next->data this->next[..].next->next this->next[..].next->next->data this->next[..].next->next->next this->next[..].next->next->next[0] this->next[..].next->next[0] this->next[..].next[0] Stack.Stack(char*):::ENTER Stack::numStacksCreated @@ -282,4 +283,5 @@ this->myName this->numElements this[0] Stack:::OBJECT +-1: this this->head this->head[..] this->head[..].data this->head[..].next this->head[..].next->data this->head[..].next->next this->head[..].next->next->data this->head[..].next->next->next this->head[..].next->next->next[0] this->head[..].next->next[0] this->head[..].next[0] this->myName this->numElements diff --git a/tests/kvasir-tests/StackCppTestInline/StackCppTestInline.comp.goal b/tests/kvasir-tests/StackCppTestInline/StackCppTestInline.comp.goal index 9527d55986..f8ba81789c 100644 --- a/tests/kvasir-tests/StackCppTestInline/StackCppTestInline.comp.goal +++ b/tests/kvasir-tests/StackCppTestInline/StackCppTestInline.comp.goal @@ -40,6 +40,7 @@ this->next[..].next[0] this[0] Link:::OBJECT +-1: this this->data this->next this->next[..] this->next[..].data this->next[..].next this->next[..].next->data this->next[..].next->next this->next[..].next->next->data this->next[..].next->next->next this->next[..].next->next->next[0] this->next[..].next->next[0] this->next[..].next[0] Stack.Stack(char*):::ENTER Stack::numStacksCreated @@ -283,4 +284,5 @@ this->myName this->numElements this[0] Stack:::OBJECT +-1: this this->head this->head[..] this->head[..].data this->head[..].next this->head[..].next->data this->head[..].next->next this->head[..].next->next->data this->head[..].next->next->next this->head[..].next->next->next[0] this->head[..].next->next[0] this->head[..].next[0] this->myName this->numElements From 11387903ec6c09e9d04de2b2fbe234bc8c2f459d Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Mon, 12 Oct 2026 04:22:35 -0700 Subject: [PATCH 14/15] Reject duplicate CSV column names; fix dtrace-indent error message --- scripts/convertcsv.pl | 3 +++ scripts/dtrace-indent.pl | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/scripts/convertcsv.pl b/scripts/convertcsv.pl index 7aa52376dd..3279d00149 100755 --- a/scripts/convertcsv.pl +++ b/scripts/convertcsv.pl @@ -209,6 +209,9 @@ ( $ ) for (my $i=0; $i <$text>"; + die "What is this line? <$suffix> <$text>"; } if ($suffix =~ /^EXIT/) { $indentation--; From b69410562ac699cc08cdf2ba112ece601bdced61 Mon Sep 17 00:00:00 2001 From: Michael Ernst Date: Mon, 12 Oct 2026 12:19:04 -0700 Subject: [PATCH 15/15] Update ArrayTest-cpp.comp.goal-Rocky for variables without comparability --- .../ArrayTest-cpp/ArrayTest-cpp.comp.goal-Rocky | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/tests/kvasir-tests/ArrayTest-cpp/ArrayTest-cpp.comp.goal-Rocky b/tests/kvasir-tests/ArrayTest-cpp/ArrayTest-cpp.comp.goal-Rocky index dc2be6c35e..ce6528540d 100644 --- a/tests/kvasir-tests/ArrayTest-cpp/ArrayTest-cpp.comp.goal-Rocky +++ b/tests/kvasir-tests/ArrayTest-cpp/ArrayTest-cpp.comp.goal-Rocky @@ -685,6 +685,7 @@ return[..].foo_head return[..].foo_tail A:::OBJECT +-1: this this->B this->B[..] this->B[..].C this->B[..].C.baz_head this->B[..].C.baz_tail this->B[..].C.y this->B[..].D[0] this->B[..].D[0]->neverSeeMe this->B[..].D[0][0] this->B[..].D[1] this->B[..].D[1]->neverSeeMe this->B[..].D[1][0] this->B[..].D[2] this->B[..].D[2]->neverSeeMe this->B[..].D[2][0] this->B[..].bar_head this->B[..].bar_tail this->foo_head this->foo_tail ArrayTest_cpp.cpp.returnIntSum(int,\_int*):::ENTER ::abracadabra ::abracadabra.social_security[..] @@ -825,12 +826,17 @@ a b[..] return b _buffers:::OBJECT +-1: this this->SS this->age this->firstName this->lastName this->mallocMePlease this->middleName this->weight array_struct:::OBJECT +-1: this this->MIT_id this->MIT_id[..] this->birthday this->birthday[..] this->social_security this->social_security[..] unnamed_DWARF_ID_1:::OBJECT +-1: this this->C this->C.baz_head this->C.baz_tail this->C.y this->D this->D[..] this->D[..].neverSeeMe this->bar_head this->bar_tail unnamed_DWARF_ID_2:::OBJECT +-1: this this->baz_head this->baz_tail this->y unnamed_DWARF_ID_3:::OBJECT +-1: this this->neverSeeMe