Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use separate files to store maps between source and preprocessed files #752

Merged
merged 1 commit into from
Dec 3, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
66 changes: 53 additions & 13 deletions perl/Galacticus/Build/SourceTree.pm
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ use warnings;
use utf8;
use Cwd;
use lib $ENV{'GALACTICUS_EXEC_PATH'}."/perl";
use Encode;
use Data::Dumper;
use Scalar::Util qw(reftype);
use Fortran::Utils;
Expand Down Expand Up @@ -516,30 +517,69 @@ sub ReplaceNode {
sub Serialize {
my $node = shift();
my (%options) = @_;
$options{'annotate'} = 1
unless ( exists($options{'annotate'}) );
my $serialization;
my $currentNode = $node;
$options{'annotate' } = 1
unless ( exists($options{'annotate' }) );
$options{'stripMappings'} = 0
unless ( exists($options{'stripMappings'}) );
my %optionsChild = %options;
$optionsChild{'stripMappings'} = 0;
# Walk the tree, serializing code.
my $lineNumber = 0 ;
my $serialization ;
my $mappings ;
my $currentNode = $node ;
while ( $currentNode ) {
$serialization .= "!--> ".$currentNode->{'line'}." \"".$currentNode->{'source'}."\"\n"
if ( exists($currentNode->{'source'}) && exists($currentNode->{'line'}) && $options{'annotate'} );
# Generate a line number mapping from the original file to the pre-processed file.
if ( exists($currentNode->{'source'}) && exists($currentNode->{'line'}) && $options{'annotate'} ) {
my $mapping = "!--> ".$currentNode->{'line'}." ".$lineNumber." \"".$currentNode->{'source'}."\"\n";
if ( $options{'stripMappings'} ) {
$mappings .= $mapping;
} else {
++$lineNumber;
$serialization .= $mapping;
}
}
# Serialize the current node.
my $serializationNode = "";
if ( $currentNode->{'type'} eq "code" ) {
$serialization .= $currentNode->{'content'}
$serializationNode .= $currentNode->{'content'};
} else {
$serialization .= $currentNode->{'opener'}
if ( exists($currentNode->{'opener'}) );
$serialization .= &Serialize($currentNode->{'firstChild'},%options)
if ( $currentNode->{'firstChild'} );
$serialization .= $currentNode->{'closer'}
$serializationNode .= $currentNode->{'opener'}
if ( exists($currentNode->{'opener'}) );
if ( $currentNode->{'firstChild'} ) {
(my $serializationChild) = &Serialize($currentNode->{'firstChild'},%optionsChild);
$serializationNode .= $serializationChild;
}
$serializationNode .= $currentNode->{'closer'}
if ( exists($currentNode->{'closer'}) );
}
# Strip out any line number mappings from the serialization.
if ( $options{'stripMappings'} ) {
my $serializationNodeStripped = "";
my $serializationNodeEncoded = encode(q{utf8},$serializationNode);
open(my $code, q{<:utf8}, \$serializationNodeEncoded);
while ( my $line = <$code> ) {
if ( $line =~ m/^!\-\->\s+(\d+)\s+(\d+)\s+"(.+)"/ ) {
$mappings .= "!--> ".$1." ".($lineNumber+1)." \"".$3."\"\n";
} else {
++$lineNumber;
$serializationNodeStripped .= $line;
}
}
close($code);
$serializationNode = $serializationNodeStripped;
} else {
$lineNumber += $serializationNode =~ tr/\n//;
}
# Accumulate the serialization.
$serialization .= $serializationNode;
if ( $currentNode->{'sibling' } ) {
$currentNode = $currentNode->{'sibling'};
} else {
undef($currentNode);
}
}
return $serialization;
return $serialization, $mappings;
}

sub InsertAfterNode {
Expand Down
3 changes: 3 additions & 0 deletions perl/Galacticus/Build/SourceTree/Parse/Directives.pm
Original file line number Diff line number Diff line change
Expand Up @@ -70,6 +70,9 @@ sub Parse_Directives {
$rawCode .= $line;
} elsif ( $line =~ m/^\s*!!\[/ ) {
$rawOpener = $line;
} else {
$rawCodeLine = $lineNumber+1;
$rawDirectiveLine = $lineNumber+1;
}
# Process code and directive blocks as necessary.
if ( ( $inDirective == 1 || eof($code) ) && $rawCode ) {
Expand Down
6 changes: 5 additions & 1 deletion perl/Galacticus/Build/SourceTree/Process/FunctionClass.pm
Original file line number Diff line number Diff line change
Expand Up @@ -2789,10 +2789,14 @@ CODE
&Galacticus::Build::SourceTree::PrependChildToNode($submodule,$codeContent->{'submodule'}->{$className}->{'preContains' });
&Galacticus::Build::SourceTree::InsertPostContains($submodule,$codeContent->{'submodule'}->{$className}->{'postContains'});
# Write the submodule to a temporary file, and update the actual file only if it has changed (to avoid recompilation cascades).
(my $submoduleContent, my $submoduleMappings) = &Galacticus::Build::SourceTree::Serialize($file, stripMappings => 1);
open(my $submoduleFile,">",$codeContent->{'submodule'}->{$className}->{'fileName'}.".tmp");
print $submoduleFile &Galacticus::Build::SourceTree::Serialize($file);
print $submoduleFile $submoduleContent;
close($submoduleFile);
&File::Changes::Update($codeContent->{'submodule'}->{$className}->{'fileName'},$codeContent->{'submodule'}->{$className}->{'fileName'}.".tmp", proveUpdate => "yes");
open(my $mappingFile,">",$codeContent->{'submodule'}->{$className}->{'fileName'}.".lmap");
print $mappingFile $submoduleMappings;
close($mappingFile);
}
}
$node = &Galacticus::Build::SourceTree::Walk_Tree($node,\$depth);
Expand Down
3 changes: 2 additions & 1 deletion perl/Galacticus/Build/SourceTree/Process/Generics.pm
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,8 @@ sub Process_Generics {
$copyNode = &Galacticus::Build::SourceTree::Walk_Tree($copyNode,\$copyDepth);
}
# Reparse the new content.
my $copyReparsed = &Galacticus::Build::SourceTree::ParseCode(&Galacticus::Build::SourceTree::Serialize($copy),$tree->{'name'}, instrument => 0 ,reinstateBlocks => 1);
(my $copySerialized ) = &Galacticus::Build::SourceTree::Serialize($copy);
my $copyReparsed = &Galacticus::Build::SourceTree::ParseCode($copySerialized,$tree->{'name'}, instrument => 0 ,reinstateBlocks => 1);
# Push copy to list of copies.
push(@copies,$copyReparsed);
}
Expand Down
19 changes: 10 additions & 9 deletions scripts/build/buildCode.pl
Original file line number Diff line number Diff line change
Expand Up @@ -213,16 +213,17 @@
# Generate output. For Fortran source we run the code through the processor first. Otherwise it is simply output.
open(my $outputFile,">",$build->{'fileName'}.".tmp");
# Parse Fortran files, simply output other files.
print $outputFile
$build->{'fileName'} =~ m/\.Inc$/
?
&Galacticus::Build::SourceTree::Serialize(
&Galacticus::Build::SourceTree::ProcessTree(
if ( $build->{'fileName'} =~ m/\.Inc$/ ) {
(my $codePreprocessed) =
&Galacticus::Build::SourceTree::Serialize(
&Galacticus::Build::SourceTree::ProcessTree(
&Galacticus::Build::SourceTree::ParseCode($build->{'content'},$build->{'fileName'})
)
)
:
$build->{'content'};
)
);
print $outputFile $codePreprocessed;
} else {
print $outputFile $build->{'content'};
}
close($outputFile);
&File::Changes::Update($build->{'fileName'},$build->{'fileName'}.".tmp", proveUpdate => "yes");
exit;
42 changes: 23 additions & 19 deletions scripts/build/postprocess.pl
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
use lib $ENV{'GALACTICUS_EXEC_PATH'}."/perl";
use Data::Dumper;
use Fortran::Utils;
use File::Slurp qw(slurp);
use utf8;
use open ":std", ":encoding(UTF-8)";
my $haveColor = eval
Expand All @@ -23,9 +24,6 @@
# Determine if interactive.
$haveColor = -t STDOUT ? $haveColor : 0;

# Initalize a map.
my @map;

# Initialize a hash of (possibly) unused functions.
my %unusedFunctions;

Expand All @@ -41,30 +39,36 @@
# Initialize a structure for interoperable variables.
my $interoperableVariables;

# Open and read the file.
my $lineNumber = 0;
my $unitName;
push(
@map,
{
source => $preprocessedSourceName,
line => 1,
lineOriginal => 1
}
# Parse the map of line numbers.
my @map =
(
{
source => $preprocessedSourceName,
line => 1,
lineOriginal => 1
}
);
open(my $file,$preprocessedSourceName);
while ( my $line = <$file> ) {
++$lineNumber;
if ( $line =~ m/^\!\-\-\>\s+(\d+)\s+\"([a-zA-Z0-9_\-\.\/\(\):]+)\"\s*$/ ) {
open(my $mapFile,$preprocessedSourceName.".lmap");
while ( my $line = <$mapFile> ) {
if ( $line =~ m/^\!\-\-\>\s+(\d+)\s+(\d+)\s+\"([a-zA-Z0-9_\-\.\/\(\):]+)\"\s*$/ ) {
push(
@map,
{
source => $2,
source => $3,
line => $1,
lineOriginal => $lineNumber+1 # We add 1 here because the line marker actually refers to the next line in the file.
lineOriginal => $2
}
);
}
}
close($mapFile);

# Open and read the file.
my $lineNumber = 0;
my $unitName;
open(my $file,$preprocessedSourceName);
while ( my $line = <$file> ) {
++$lineNumber;
# Detect functions/subroutines/submodule procedure.
foreach my $type ( 'subroutine', 'function', 'moduleProcedure' ) {
if ( my @matches = ( $line =~ $Fortran::Utils::unitOpeners{$type}->{'regEx'} ) ) {
Expand Down
12 changes: 11 additions & 1 deletion scripts/build/preprocess.pl
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,8 @@
use lib $ENV{'GALACTICUS_EXEC_PATH'}."/perl";
use Galacticus::Build::SourceTree;
use File::Changes;
use utf8;
use open ":std", ":encoding(UTF-8)";

# Preprocess a Galacticus Fortran source file.
# Andrew Benson (17-April-2015)
Expand All @@ -25,10 +27,18 @@
&Galacticus::Build::SourceTree::AnalyzeTree($tree)
if ( exists($ENV{'GALACTICUS_PREPROCESSOR_ANALYZE'}) && $ENV{'GALACTICUS_PREPROCESSOR_ANALYZE'} eq "yes" );

# Get the serialized source code.
(my $codeSerialized, my $mappings) = &Galacticus::Build::SourceTree::Serialize($tree, stripMappings => 1);

# Serialize back to source code.
open(my $outputFile,">:raw",$outputFileName.".tmp");
print $outputFile &Galacticus::Build::SourceTree::Serialize($tree);
print $outputFile $codeSerialized;
close($outputFile);
&File::Changes::Update($outputFileName,$outputFileName.".tmp", proveUpdate => "yes");

# Output line number mappings.
open(my $lineMapFile,">",$outputFileName.".lmap");
print $lineMapFile $mappings;
close($lineMapFile);

exit;
Loading