Skip to content

Commit

Permalink
Merge pull request #4934 from vrurg/problem-solving-323-back-to-lock
Browse files Browse the repository at this point in the history
Get back to using Lock in Stash and CompUnit
  • Loading branch information
vrurg committed May 22, 2022
2 parents 9fd893f + ddef646 commit 1c46805
Show file tree
Hide file tree
Showing 9 changed files with 133 additions and 196 deletions.
5 changes: 0 additions & 5 deletions src/core.c/CompUnit/PrecompilationRepository.pm6
Expand Up @@ -33,12 +33,7 @@ class CompUnit::PrecompilationRepository::Default

my $loaded := nqp::hash;
my $resolved := nqp::hash;
#?if moar
my $loaded-lock := Lock::Soft.new;
#?endif
#?if !moar
my $loaded-lock := Lock.new;
#?endif
my $first-repo-id;

my constant $compiler-id =
Expand Down
5 changes: 0 additions & 5 deletions src/core.c/CompUnit/PrecompilationStore/FileSystem.pm6
Expand Up @@ -16,12 +16,7 @@ class CompUnit::PrecompilationStore::FileSystem
has $!update-lock;

submethod TWEAK(--> Nil) {
#?if moar
$!update-lock := Lock::Soft.new;
#?endif
#?if !moar
$!update-lock := Lock.new;
#?endif
$!loaded := nqp::hash;
$!dir-cache := nqp::hash;
$!compiler-cache := nqp::hash;
Expand Down
5 changes: 0 additions & 5 deletions src/core.c/CompUnit/PrecompilationUnit/File.pm6
Expand Up @@ -19,12 +19,7 @@ my class CompUnit::PrecompilationUnit::File does CompUnit::PrecompilationUnit {
else {
$!initialized := False;
}
#?if moar
$!update-lock := Lock::Soft.new;
#?endif
#?if !moar
$!update-lock := Lock.new;
#?endif
}

method modified(--> Instant:D) {
Expand Down
5 changes: 0 additions & 5 deletions src/core.c/CompUnit/Repository/AbsolutePath.pm6
Expand Up @@ -4,12 +4,7 @@ class CompUnit::Repository::AbsolutePath does CompUnit::Repository {

method TWEAK(--> Nil) {
$!loaded := nqp::hash;
#?if moar
$!lock := Lock::Soft.new;
#?endif
#?if !moar
$!lock := Lock.new;
#?endif
}

method need(CompUnit::Repository::AbsolutePath:D:
Expand Down
6 changes: 0 additions & 6 deletions src/core.c/CompUnit/Repository/FileSystem.pm6
Expand Up @@ -16,14 +16,8 @@ class CompUnit::Repository::FileSystem
my constant @extensions = <.rakumod .pm6 .pm>;

method TWEAK(--> Nil) {
#?if moar
$!loaded-lock := Lock::Soft.new;
$!seen-lock := Lock::Soft.new;
#?endif
#?if !moar
$!loaded-lock := Lock.new;
$!seen-lock := Lock.new;
#?endif
$!seen := nqp::hash;
}

Expand Down
268 changes: 129 additions & 139 deletions src/core.c/CompUnit/Repository/Installation.pm6
Expand Up @@ -37,12 +37,7 @@ sub MAIN(:$name, :$auth, :$ver, *@, *%) {


method TWEAK() {
#?if moar
$!lock := Lock::Soft.new;
#?endif
#?if !moar
$!lock := Lock.new;
#?endif
$!loaded := nqp::hash;
$!seen := nqp::hash;
$!dist-metas := nqp::hash;
Expand Down Expand Up @@ -232,150 +227,145 @@ sub MAIN(:$name, :$auth, :$ver, *@, *%) {
$link ~~ Str ?? ($link => $link) !! ($link.keys[0] => $link.values[0])
}

my $already-installed = False;
$!lock.protect( {
my @*MODULES;
my $path = self!writeable-path or die "No writeable path found, $.prefix not writeable";
my $lock = $.prefix.add('repo.lock').open(:create, :w);
$lock.lock;

my $version = self!repository-version;
self.upgrade-repository unless $version == 2;

my $dist-id = $dist.id;
my $dist-dir = self!dist-dir;
if not $force and $dist-dir.add($dist-id) ~~ :e {
$lock.unlock;
$already-installed = True;
}
else {
my $sources-dir = self!sources-dir;
my $resources-dir = self!resources-dir;
my $bin-dir = self!bin-dir;
my $is-win = Rakudo::Internals.IS-WIN;

self!add-short-name($dist.meta<name>, $dist); # so scripts can find their dist

my %links; # map name-path to new content address
my %provides; # meta data gets added, but the format needs to change to
# only extend the structure, not change it

# the following 3 `for` loops should be a single loop, but has been
# left this way due to impeding precomp changes

# lib/ source files
for $dist.meta<provides>.kv -> $name, $file is copy {
# $name is "Inline::Perl5" while $file is "lib/Inline/Perl5.pm6"
my $id = self!file-id(~$name, $dist-id);
my $destination = $sources-dir.add($id);
my $handle = $dist.content($file);
my $content = $handle.open(:bin).slurp(:close);

self!add-short-name($name, $dist, $id,
nqp::sha1(nqp::join("\n", nqp::split("\r\n",
$content.decode('iso-8859-1')))));
%provides{ $name } = ~$file => {
:file($id),
:time(try $file.IO.modified.Num),
};
note("Installing {$name} for {$dist.meta<name>}") if $verbose and $name ne $dist.meta<name>;
$destination.spurt($content);
}
my @*MODULES;
my $path = self!writeable-path or die "No writeable path found, $.prefix not writeable";
my $lock = $.prefix.add('repo.lock').open(:create, :w);
$lock.lock;

# bin/ scripts
for %files.kv -> $name-path, $file is copy {
next unless $name-path.starts-with('bin/');
my $name = $name-path.subst(/^bin\//, '');
my $id = self!file-id(~$file, $dist-id);
# wrappers are put in bin/; originals in resources/
my $destination = $resources-dir.add($id);
my $withoutext = $name-path.subst(/\.[exe|bat]$/, '');
for @script-postfixes -> $be {
$.prefix.add("$withoutext$be").IO.spurt:
$raku-wrapper.subst('#name#', $name, :g).subst('#raku#', "rakudo$be");
if $is-win {
$.prefix.add("$withoutext$be.bat").IO.spurt:
$windows-wrapper.subst('#raku#', "rakudo$be", :g);
}
else {
$.prefix.add("$withoutext$be").IO.chmod(0o755);
}
}
self!add-short-name($name-path, $dist, $id);
%links{$name-path} = $id;
my $handle = $dist.content($file);
my $content = $handle.open.slurp(:bin,:close);
$destination.spurt($content);
$handle.close;
}
my $version = self!repository-version;
self.upgrade-repository unless $version == 2;

my $dist-id = $dist.id;
my $dist-dir = self!dist-dir;
if not $force and $dist-dir.add($dist-id) ~~ :e {
$lock.unlock;
fail "$dist already installed";
}

my $sources-dir = self!sources-dir;
my $resources-dir = self!resources-dir;
my $bin-dir = self!bin-dir;
my $is-win = Rakudo::Internals.IS-WIN;

self!add-short-name($dist.meta<name>, $dist); # so scripts can find their dist

my %links; # map name-path to new content address
my %provides; # meta data gets added, but the format needs to change to
# only extend the structure, not change it

# the following 3 `for` loops should be a single loop, but has been
# left this way due to impeding precomp changes

# lib/ source files
for $dist.meta<provides>.kv -> $name, $file is copy {
# $name is "Inline::Perl5" while $file is "lib/Inline/Perl5.pm6"
my $id = self!file-id(~$name, $dist-id);
my $destination = $sources-dir.add($id);
my $handle = $dist.content($file);
my $content = $handle.open(:bin).slurp(:close);

self!add-short-name($name, $dist, $id,
nqp::sha1(nqp::join("\n", nqp::split("\r\n",
$content.decode('iso-8859-1')))));
%provides{ $name } = ~$file => {
:file($id),
:time(try $file.IO.modified.Num),
};
note("Installing {$name} for {$dist.meta<name>}") if $verbose and $name ne $dist.meta<name>;
$destination.spurt($content);
}

# resources/
for %files.kv -> $name-path, $file is copy {
next unless $name-path.starts-with('resources/');
# $name-path is 'resources/libraries/p5helper' while $file is 'resources/libraries/libp5helper.so'
my $id = self!file-id(~$name-path, $dist-id) ~ '.' ~ $file.IO.extension;
my $destination = $resources-dir.add($id);
%links{$name-path} = $id;
my $handle = $dist.content($file);
my $content = $handle.open.slurp(:bin,:close);
$destination.spurt($content);
$handle.close;
# bin/ scripts
for %files.kv -> $name-path, $file is copy {
next unless $name-path.starts-with('bin/');
my $name = $name-path.subst(/^bin\//, '');
my $id = self!file-id(~$file, $dist-id);
# wrappers are put in bin/; originals in resources/
my $destination = $resources-dir.add($id);
my $withoutext = $name-path.subst(/\.[exe|bat]$/, '');
for @script-postfixes -> $be {
$.prefix.add("$withoutext$be").IO.spurt:
$raku-wrapper.subst('#name#', $name, :g).subst('#raku#', "rakudo$be");
if $is-win {
$.prefix.add("$withoutext$be.bat").IO.spurt:
$windows-wrapper.subst('#raku#', "rakudo$be", :g);
}
else {
$.prefix.add("$withoutext$be").IO.chmod(0o755);
}
}
self!add-short-name($name-path, $dist, $id);
%links{$name-path} = $id;
my $handle = $dist.content($file);
my $content = $handle.open.slurp(:bin,:close);
$destination.spurt($content);
$handle.close;
}

my %meta = %($dist.meta);
%meta<files> = %links; # add our new name-path => content-id mapping
%meta<provides> = %provides; # new meta data added to provides
nqp::bindkey($!dist-metas,$dist-id,%meta);
$dist-dir.add($dist-id).spurt: Rakudo::Internals::JSON.to-json(%meta, :sorted-keys);

# reset cached id so it's generated again on next access.
# identity changes with every installation of a dist.
$!id = Any;

if $precompile {
my $head := $*REPO;
CATCH { PROCESS::<$REPO> := $head }
# Precomp files should only depend on downstream repos
PROCESS::<$REPO> := self;

my $precomp = $head.precomp-repository;
my $repo-prefix = self!repo-prefix;
my $*DISTRIBUTION = CompUnit::Repository::Distribution.new($dist, :repo(self), :$dist-id);
my $*RESOURCES = Distribution::Resources.new(:repo(self), :$dist-id);
my %done;

my $compiler-id = CompUnit::PrecompilationId.new-without-check($*RAKU.compiler.id);
for %provides.sort {
my $id = CompUnit::PrecompilationId.new-without-check($_.value.values[0]<file>);
$precomp.store.delete($compiler-id, $id);
}
# resources/
for %files.kv -> $name-path, $file is copy {
next unless $name-path.starts-with('resources/');
# $name-path is 'resources/libraries/p5helper' while $file is 'resources/libraries/libp5helper.so'
my $id = self!file-id(~$name-path, $dist-id) ~ '.' ~ $file.IO.extension;
my $destination = $resources-dir.add($id);
%links{$name-path} = $id;
my $handle = $dist.content($file);
my $content = $handle.open.slurp(:bin,:close);
$destination.spurt($content);
$handle.close;
}

for %provides.sort {
my $id = $_.value.values[0]<file>;
my $source = $sources-dir.add($id);
my $source-file = $repo-prefix ?? $repo-prefix ~ $source.relative($.prefix) !! $source;
my %meta = %($dist.meta);
%meta<files> = %links; # add our new name-path => content-id mapping
%meta<provides> = %provides; # new meta data added to provides
nqp::bindkey($!dist-metas,$dist-id,%meta);
$dist-dir.add($dist-id).spurt: Rakudo::Internals::JSON.to-json(%meta, :sorted-keys);

# reset cached id so it's generated again on next access.
# identity changes with every installation of a dist.
$!id = Any;

if $precompile {
my $head := $*REPO;
CATCH { PROCESS::<$REPO> := $head }
# Precomp files should only depend on downstream repos
PROCESS::<$REPO> := self;

my $precomp = $head.precomp-repository;
my $repo-prefix = self!repo-prefix;
my $*DISTRIBUTION = CompUnit::Repository::Distribution.new($dist, :repo(self), :$dist-id);
my $*RESOURCES = Distribution::Resources.new(:repo(self), :$dist-id);
my %done;

my $compiler-id = CompUnit::PrecompilationId.new-without-check($*RAKU.compiler.id);
for %provides.sort {
my $id = CompUnit::PrecompilationId.new-without-check($_.value.values[0]<file>);
$precomp.store.delete($compiler-id, $id);
}

if %done{$id} {
note "(Already did $id)" if $verbose;
next;
}
note("Precompiling $id ($_.key())") if $verbose;
$precomp.precompile(
$source,
CompUnit::PrecompilationId.new-without-check($id),
:source-name("$source-file ($_.key())"),
);
%done{$id} = 1;
}
PROCESS::<$REPO> := $head;
}
for %provides.sort {
my $id = $_.value.values[0]<file>;
my $source = $sources-dir.add($id);
my $source-file = $repo-prefix ?? $repo-prefix ~ $source.relative($.prefix) !! $source;

$lock.unlock;
if %done{$id} {
note "(Already did $id)" if $verbose;
next;
}
note("Precompiling $id ($_.key())") if $verbose;
$precomp.precompile(
$source,
CompUnit::PrecompilationId.new-without-check($id),
:source-name("$source-file ($_.key())"),
);
%done{$id} = 1;
}
} );
PROCESS::<$REPO> := $head;
}

$already-installed ?? fail "$dist already installed" !! True
}
$lock.unlock;
} ) }

my sub unlink-if-exists(IO::Path:D $io) { $io.unlink if $io.e }

Expand Down
5 changes: 0 additions & 5 deletions src/core.c/CompUnit/Repository/Locally.pm6
Expand Up @@ -5,12 +5,7 @@ role CompUnit::Repository::Locally {
has Str $.path-spec is built(False);

my $instances := nqp::hash; # cache with instances, keyed on WHICH
#?if moar
my $lock := Lock::Soft.new; # serializing access to instances hash
#?endif
#?if !moar
my $lock := Lock.new; # serializing access to instances hash
#?endif

# handle a new object that wasn't cached before
method !SET-SELF(Str:D $abspath, str $WHICH) {
Expand Down

0 comments on commit 1c46805

Please sign in to comment.