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