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-without-check($*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-without-check($*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. unless $dependency-precomp.is-up-to-date($dependency, :check-source($resolve)) {
  118. $dependency-precomp.close;
  119. return False;
  120. }
  121. @dependencies.push: $dependency-precomp;
  122. }
  123. $loaded-lock.protect: {
  124. for @dependencies -> $dependency-precomp {
  125. unless %loaded{$dependency-precomp.id}:exists {
  126. %loaded{$dependency-precomp.id} = self!load-handle-for-path($dependency-precomp);
  127. }
  128. }
  129. }
  130. # report back id and source location of dependency to dependant
  131. if $*W and $*W.record_precompilation_dependencies {
  132. for $precomp-unit.dependencies -> $dependency {
  133. say $dependency.serialize;
  134. }
  135. }
  136. if $resolve {
  137. self.store.store-repo-id($compiler-id, $precomp-unit.id, :repo-id($repo.id));
  138. }
  139. True
  140. }
  141. proto method load(|) {*}
  142. multi method load(
  143. Str $id,
  144. Instant :$since,
  145. IO::Path :$source,
  146. CompUnit::PrecompilationStore :@precomp-stores = Array[CompUnit::PrecompilationStore].new($.store),
  147. ) {
  148. self.load(CompUnit::PrecompilationId.new($id), :$since, :@precomp-stores)
  149. }
  150. multi method load(
  151. CompUnit::PrecompilationId $id,
  152. IO::Path :$source,
  153. Str :$checksum is copy,
  154. Instant :$since,
  155. CompUnit::PrecompilationStore :@precomp-stores = Array[CompUnit::PrecompilationStore].new($.store),
  156. ) {
  157. $loaded-lock.protect: {
  158. return %loaded{$id} if %loaded{$id}:exists;
  159. }
  160. my $RMD = $*RAKUDO_MODULE_DEBUG;
  161. my $compiler-id = CompUnit::PrecompilationId.new-without-check($*PERL.compiler.id);
  162. my $unit = self!load-file(@precomp-stores, $id);
  163. if $unit {
  164. if (not $since or $unit.modified > $since)
  165. and (not $source or ($checksum //= nqp::sha1($source.slurp(:enc<iso-8859-1>))) eq $unit.source-checksum)
  166. and self!load-dependencies($unit, @precomp-stores)
  167. {
  168. my \loaded = self!load-handle-for-path($unit);
  169. $loaded-lock.protect: { %loaded{$id} = loaded };
  170. return (loaded, $unit.checksum);
  171. }
  172. else {
  173. $RMD("Outdated precompiled {$unit}{$source ?? " for $source" !! ''}\n"
  174. ~ " mtime: {$unit.modified}{$since ?? ", since: $since" !! ''}\n"
  175. ~ " checksum: {$unit.source-checksum}, expected: $checksum") if $RMD;
  176. $unit.close;
  177. fail "Outdated precompiled $unit";
  178. }
  179. }
  180. Nil
  181. }
  182. proto method precompile(|) {*}
  183. multi method precompile(
  184. IO::Path:D $path,
  185. Str $id,
  186. Bool :$force = False,
  187. :$source-name = $path.Str
  188. ) {
  189. self.precompile($path, CompUnit::PrecompilationId.new($id), :$force, :$source-name)
  190. }
  191. multi method precompile(
  192. IO::Path:D $path,
  193. CompUnit::PrecompilationId $id,
  194. Bool :$force = False,
  195. :$source-name = $path.Str
  196. ) {
  197. my $compiler-id = CompUnit::PrecompilationId.new-without-check($*PERL.compiler.id);
  198. my $io = self.store.destination($compiler-id, $id);
  199. return False unless $io;
  200. my $RMD = $*RAKUDO_MODULE_DEBUG;
  201. if not $force and $io.e and $io.s {
  202. $RMD("$source-name\nalready precompiled into\n$io") if $RMD;
  203. self.store.unlock;
  204. return True;
  205. }
  206. my $source-checksum = nqp::sha1($path.slurp(:enc<iso-8859-1>));
  207. my $bc = "$io.bc".IO;
  208. $lle //= Rakudo::Internals.LL-EXCEPTION;
  209. $profile //= Rakudo::Internals.PROFILE;
  210. $optimize //= Rakudo::Internals.OPTIMIZE;
  211. my %env = %*ENV; # Local copy for us to tweak
  212. %env<RAKUDO_PRECOMP_WITH> = $*REPO.repo-chain.map(*.path-spec).join(',');
  213. my $rakudo_precomp_loading = %env<RAKUDO_PRECOMP_LOADING>;
  214. my $modules = $rakudo_precomp_loading ?? Rakudo::Internals::JSON.from-json: $rakudo_precomp_loading !! [];
  215. die "Circular module loading detected trying to precompile $path" if $modules.Set{$path.Str}:exists;
  216. %env<RAKUDO_PRECOMP_LOADING> = Rakudo::Internals::JSON.to-json: [|$modules, $path.Str];
  217. %env<RAKUDO_PRECOMP_DIST> = $*RESOURCES ?? $*RESOURCES.Str !! '{}';
  218. $RMD("Precompiling $path into $bc ($lle $profile $optimize)") if $RMD;
  219. my $perl6 = $*EXECUTABLE
  220. .subst('perl6-debug', 'perl6') # debugger would try to precompile it's UI
  221. .subst('perl6-gdb', 'perl6')
  222. .subst('perl6-jdb-server', 'perl6-j') ;
  223. if %env<RAKUDO_PRECOMP_NESTED_JDB> {
  224. $perl6.subst-mutate('perl6-j', 'perl6-jdb-server');
  225. note "starting jdb on port " ~ ++%env<RAKUDO_JDB_PORT>;
  226. }
  227. my $out = '';
  228. my $err = '';
  229. my $status;
  230. react {
  231. my $proc = Proc::Async.new(
  232. $perl6,
  233. $lle,
  234. $profile,
  235. $optimize,
  236. "--target=" ~ Rakudo::Internals.PRECOMP-TARGET,
  237. "--output=$bc",
  238. "--source-name=$source-name",
  239. $path
  240. );
  241. whenever $proc.stdout {
  242. $out ~= $_
  243. }
  244. unless $RMD {
  245. whenever $proc.stderr {
  246. $err ~= $_
  247. }
  248. }
  249. whenever $proc.start(ENV => %env) {
  250. $status = .exitcode
  251. }
  252. }
  253. my @result = $out.lines.unique;
  254. if $status { # something wrong
  255. self.store.unlock;
  256. $RMD("Precompiling $path failed: $status") if $RMD;
  257. Rakudo::Internals.VERBATIM-EXCEPTION(1);
  258. die $RMD ?? @result !! $err;
  259. }
  260. if not $RMD and $err -> $warnings {
  261. $*ERR.print($warnings);
  262. }
  263. unless $bc.e {
  264. $RMD("$path aborted precompilation without failure") if $RMD;
  265. self.store.unlock;
  266. return False;
  267. }
  268. $RMD("Precompiled $path into $bc") if $RMD;
  269. my str $dependencies = '';
  270. my CompUnit::PrecompilationDependency::File @dependencies;
  271. my %dependencies;
  272. for @result -> $dependency-str {
  273. unless $dependency-str ~~ /^<[A..Z0..9]> ** 40 \0 .+/ {
  274. say $dependency-str;
  275. next
  276. }
  277. my $dependency = CompUnit::PrecompilationDependency::File.deserialize($dependency-str);
  278. next if %dependencies{$dependency.Str}++; # already got that one
  279. $RMD($dependency.Str()) if $RMD;
  280. @dependencies.push: $dependency;
  281. }
  282. $RMD("Writing dependencies and byte code to $io.tmp for source checksum: $source-checksum") if $RMD;
  283. self.store.store-unit(
  284. $compiler-id,
  285. $id,
  286. self.store.new-unit(:$id, :@dependencies, :$source-checksum, :bytecode($bc.slurp(:bin))),
  287. );
  288. $bc.unlink;
  289. self.store.store-repo-id($compiler-id, $id, :repo-id($*REPO.id));
  290. self.store.unlock;
  291. True
  292. }
  293. }