1. {
  2. role CompUnit::PrecompilationRepository {
  3. method try-load(
  4. CompUnit::PrecompilationDependency::File $dependency,
  5. IO::Path :$source,
  6. CompUnit::PrecompilationStore :@precomp-stores,
  7. --> CompUnit::Handle:D) {
  8. Nil
  9. }
  10. method load(CompUnit::PrecompilationId $id --> Nil) { }
  11. method may-precomp(--> Bool:D) {
  12. True # would be a good place to check an environment variable
  13. }
  14. }
  15. }
  16. BEGIN CompUnit::PrecompilationRepository::<None> := CompUnit::PrecompilationRepository.new;
  17. class CompUnit { ... }
  18. class CompUnit::PrecompilationRepository::Default does CompUnit::PrecompilationRepository {
  19. has CompUnit::PrecompilationStore $.store;
  20. my %loaded;
  21. my $loaded-lock = Lock.new;
  22. my $first-repo-id;
  23. my $lle;
  24. my $profile;
  25. my $optimize;
  26. method try-load(
  27. CompUnit::PrecompilationDependency::File $dependency,
  28. IO::Path :$source = $dependency.src.IO,
  29. CompUnit::PrecompilationStore :@precomp-stores = Array[CompUnit::PrecompilationStore].new($.store),
  30. --> CompUnit::Handle:D) {
  31. my $RMD = $*RAKUDO_MODULE_DEBUG;
  32. my $id = $dependency.id;
  33. $RMD("try-load $id: $source") if $RMD;
  34. # Even if we may no longer precompile, we should use already loaded files
  35. $loaded-lock.protect: {
  36. return %loaded{$id} if %loaded{$id}:exists;
  37. }
  38. my ($handle, $checksum) = (
  39. self.may-precomp and (
  40. my $loaded = self.load($id, :since($source.modified), :@precomp-stores) # already precompiled?
  41. or self.precompile($source, $id, :source-name($dependency.source-name), :force($loaded ~~ Failure))
  42. and self.load($id, :@precomp-stores) # if not do it now
  43. )
  44. );
  45. if $*W and $*W.record_precompilation_dependencies {
  46. if $handle {
  47. $dependency.checksum = $checksum;
  48. say $dependency.serialize;
  49. }
  50. else {
  51. nqp::exit(0);
  52. }
  53. }
  54. $handle ?? $handle !! Nil
  55. }
  56. method !load-handle-for-path(CompUnit::PrecompilationUnit $unit) {
  57. my $preserve_global := nqp::ifnull(nqp::gethllsym('perl6', 'GLOBAL'), Mu);
  58. if $*RAKUDO_MODULE_DEBUG -> $RMD { $RMD("Loading precompiled\n$unit") }
  59. my $handle := CompUnit::Loader.load-precompilation-file($unit.bytecode-handle);
  60. nqp::bindhllsym('perl6', 'GLOBAL', $preserve_global);
  61. CATCH {
  62. default {
  63. nqp::bindhllsym('perl6', 'GLOBAL', $preserve_global);
  64. .throw;
  65. }
  66. }
  67. $handle
  68. }
  69. method !load-file(
  70. CompUnit::PrecompilationStore @precomp-stores,
  71. CompUnit::PrecompilationId $id,
  72. :$repo-id,
  73. ) {
  74. my $compiler-id = CompUnit::PrecompilationId.new($*PERL.compiler.id);
  75. my $RMD = $*RAKUDO_MODULE_DEBUG;
  76. for @precomp-stores -> $store {
  77. $RMD("Trying to load {$id ~ ($repo-id ?? '.repo-id' !! '')} from $store.prefix()") if $RMD;
  78. my $file = $repo-id
  79. ?? $store.load-repo-id($compiler-id, $id)
  80. !! $store.load-unit($compiler-id, $id);
  81. return $file if $file;
  82. }
  83. Nil
  84. }
  85. method !load-dependencies(CompUnit::PrecompilationUnit:D $precomp-unit, Instant $since, @precomp-stores) {
  86. my $compiler-id = CompUnit::PrecompilationId.new($*PERL.compiler.id);
  87. my $RMD = $*RAKUDO_MODULE_DEBUG;
  88. my $resolve = False;
  89. my $repo = $*REPO;
  90. $first-repo-id //= $repo.id;
  91. my $repo-id = self!load-file(@precomp-stores, $precomp-unit.id, :repo-id);
  92. if $repo-id ne $repo.id {
  93. $RMD("Repo changed: $repo-id ne {$repo.id}. Need to re-check dependencies.") if $RMD;
  94. $resolve = True;
  95. }
  96. if $repo-id ne $first-repo-id {
  97. $RMD("Repo chain changed: $repo-id ne {$first-repo-id}. Need to re-check dependencies.") if $RMD;
  98. $resolve = True;
  99. }
  100. my @dependencies;
  101. for $precomp-unit.dependencies -> $dependency {
  102. $RMD("dependency: $dependency") if $RMD;
  103. if $resolve {
  104. my $comp-unit = $repo.resolve($dependency.spec);
  105. $RMD("Old id: $dependency.id(), new id: {$comp-unit.repo-id}") if $RMD;
  106. return False unless $comp-unit and $comp-unit.repo-id eq $dependency.id;
  107. }
  108. my $file;
  109. my $store = @precomp-stores.first({ $file = $_.path($compiler-id, $dependency.id); $file.e });
  110. $RMD("Could not find $dependency.spec()") if $RMD and not $store;
  111. return False unless $store;
  112. if $resolve { # a repo changed, so maybe it's a change in our source file
  113. my $modified = $file.modified;
  114. $RMD("$file\nspec: $dependency.spec()\nmtime: $modified\nsince: $since")
  115. if $RMD;
  116. my $srcIO = CompUnit::RepositoryRegistry.file-for-spec($dependency.src) // $dependency.src.IO;
  117. $RMD("source: $srcIO mtime: " ~ $srcIO.modified) if $RMD and $srcIO.e;
  118. return False if not $srcIO.e or $modified < $srcIO.modified;
  119. }
  120. my $dependency-precomp = $store.load-unit($compiler-id, $dependency.id);
  121. $RMD("dependency checksum $dependency.checksum() unit: $dependency-precomp.checksum()") if $RMD;
  122. return False if $dependency-precomp.checksum ne $dependency.checksum;
  123. @dependencies.push: $dependency-precomp;
  124. }
  125. $loaded-lock.protect: {
  126. for @dependencies -> $dependency-precomp {
  127. unless %loaded{$dependency-precomp.id}:exists {
  128. %loaded{$dependency-precomp.id} = self!load-handle-for-path($dependency-precomp);
  129. }
  130. }
  131. }
  132. # report back id and source location of dependency to dependant
  133. if $*W and $*W.record_precompilation_dependencies {
  134. for $precomp-unit.dependencies -> $dependency {
  135. say $dependency.serialize;
  136. }
  137. }
  138. if $resolve {
  139. self.store.store-repo-id($compiler-id, $precomp-unit.id, :repo-id($repo.id));
  140. }
  141. True
  142. }
  143. proto method load(|) {*}
  144. multi method load(
  145. Str $id,
  146. Instant :$since,
  147. CompUnit::PrecompilationStore :@precomp-stores = Array[CompUnit::PrecompilationStore].new($.store),
  148. ) {
  149. self.load(CompUnit::PrecompilationId.new($id), :$since, :@precomp-stores)
  150. }
  151. multi method load(
  152. CompUnit::PrecompilationId $id,
  153. Instant :$since,
  154. CompUnit::PrecompilationStore :@precomp-stores = Array[CompUnit::PrecompilationStore].new($.store),
  155. ) {
  156. $loaded-lock.protect: {
  157. return %loaded{$id} if %loaded{$id}:exists;
  158. }
  159. my $RMD = $*RAKUDO_MODULE_DEBUG;
  160. my $compiler-id = CompUnit::PrecompilationId.new($*PERL.compiler.id);
  161. my $unit = self!load-file(@precomp-stores, $id);
  162. if $unit {
  163. my $modified = $unit.modified;
  164. if (not $since or $modified > $since)
  165. and self!load-dependencies($unit, $modified, @precomp-stores)
  166. {
  167. my \loaded = self!load-handle-for-path($unit);
  168. $loaded-lock.protect: { %loaded{$id} = loaded };
  169. return (loaded, $unit.checksum);
  170. }
  171. else {
  172. if $*RAKUDO_MODULE_DEBUG -> $RMD {
  173. $RMD("Outdated precompiled $unit\nmtime: $modified\nsince: $since")
  174. }
  175. $unit.close;
  176. fail "Outdated precompiled $unit";
  177. }
  178. }
  179. Nil
  180. }
  181. proto method precompile(|) {*}
  182. multi method precompile(
  183. IO::Path:D $path,
  184. Str $id,
  185. Bool :$force = False,
  186. :$source-name = $path.Str
  187. ) {
  188. self.precompile($path, CompUnit::PrecompilationId.new($id), :$force, :$source-name)
  189. }
  190. multi method precompile(
  191. IO::Path:D $path,
  192. CompUnit::PrecompilationId $id,
  193. Bool :$force = False,
  194. :$source-name = $path.Str
  195. ) {
  196. my $compiler-id = CompUnit::PrecompilationId.new($*PERL.compiler.id);
  197. my $io = self.store.destination($compiler-id, $id);
  198. return False unless $io;
  199. my $RMD = $*RAKUDO_MODULE_DEBUG;
  200. if not $force and $io.e and $io.s {
  201. $RMD("$source-name\nalready precompiled into\n$io") if $RMD;
  202. self.store.unlock;
  203. return True;
  204. }
  205. my $bc = "$io.bc".IO;
  206. $lle //= Rakudo::Internals.LL-EXCEPTION;
  207. $profile //= Rakudo::Internals.PROFILE;
  208. $optimize //= Rakudo::Internals.OPTIMIZE;
  209. my %env = %*ENV; # Local copy for us to tweak
  210. %env<RAKUDO_PRECOMP_WITH> = $*REPO.repo-chain.map(*.path-spec).join(',');
  211. my $rakudo_precomp_loading = %env<RAKUDO_PRECOMP_LOADING>;
  212. my $modules = $rakudo_precomp_loading ?? Rakudo::Internals::JSON.from-json: $rakudo_precomp_loading !! [];
  213. die "Circular module loading detected trying to precompile $path" if $modules.Set{$path.Str}:exists;
  214. %env<RAKUDO_PRECOMP_LOADING> = Rakudo::Internals::JSON.to-json: [|$modules, $path.Str];
  215. %env<RAKUDO_PRECOMP_DIST> = $*RESOURCES ?? $*RESOURCES.Str !! '{}';
  216. $RMD("Precompiling $path into $bc ($lle $profile $optimize)") if $RMD;
  217. my $perl6 = $*EXECUTABLE
  218. .subst('perl6-debug', 'perl6') # debugger would try to precompile it's UI
  219. .subst('perl6-gdb', 'perl6')
  220. .subst('perl6-jdb-server', 'perl6-j') ;
  221. if %env<RAKUDO_PRECOMP_NESTED_JDB> {
  222. $perl6.subst-mutate('perl6-j', 'perl6-jdb-server');
  223. note "starting jdb on port " ~ ++%env<RAKUDO_JDB_PORT>;
  224. }
  225. my $proc = run(
  226. $perl6,
  227. $lle,
  228. $profile,
  229. $optimize,
  230. "--target=" ~ Rakudo::Internals.PRECOMP-TARGET,
  231. "--output=$bc",
  232. "--source-name=$source-name",
  233. $path,
  234. :out,
  235. :err,
  236. :%env
  237. );
  238. my @result = $proc.out.lines.unique;
  239. if not $proc.out.close or $proc.status { # something wrong
  240. self.store.unlock;
  241. $RMD("Precomping $path failed: $proc.status()") if $RMD;
  242. Rakudo::Internals.VERBATIM-EXCEPTION(1);
  243. die $proc.err.slurp-rest(:close);
  244. }
  245. if $proc.err.slurp-rest(:close) -> $warnings {
  246. $*ERR.print($warnings);
  247. }
  248. unless $bc.e {
  249. $RMD("$path aborted precompilation without failure") if $RMD;
  250. self.store.unlock;
  251. return False;
  252. }
  253. $RMD("Precompiled $path into $bc") if $RMD;
  254. my str $dependencies = '';
  255. my CompUnit::PrecompilationDependency::File @dependencies;
  256. my %dependencies;
  257. for @result -> $dependency-str {
  258. unless $dependency-str ~~ /^<[A..Z0..9]> ** 40 \0 .+/ {
  259. say $dependency-str;
  260. next
  261. }
  262. my $dependency = CompUnit::PrecompilationDependency::File.deserialize($dependency-str);
  263. next if %dependencies{$dependency.Str}++; # already got that one
  264. $RMD("id: $dependency.id(), src: $dependency.src(), spec: $dependency.spec()") if $RMD;
  265. @dependencies.push: $dependency;
  266. }
  267. $RMD("Writing dependencies and byte code to $io.tmp") if $RMD;
  268. self.store.store-unit(
  269. $compiler-id,
  270. $id,
  271. self.store.new-unit(:$id, :@dependencies, :bytecode($bc.slurp(:bin))),
  272. );
  273. $bc.unlink;
  274. self.store.store-repo-id($compiler-id, $id, :repo-id($*REPO.id));
  275. self.store.unlock;
  276. True
  277. }
  278. }