Navigation Menu

Skip to content

Instantly share code, notes, and snippets.

@peschwa

peschwa/nqp.patch

Created June 11, 2016 09:19
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save peschwa/abd8b24a04eef9bea12529304b4bbb5b to your computer and use it in GitHub Desktop.
Save peschwa/abd8b24a04eef9bea12529304b4bbb5b to your computer and use it in GitHub Desktop.
Download ZIP
Raw
nqp.patch
diff --git a/src/vm/jvm/HLL/Backend.nqp b/src/vm/jvm/HLL/Backend.nqp
index 4c32e70..18dae14 100644
--- a/src/vm/jvm/HLL/Backend.nqp
+++ b/src/vm/jvm/HLL/Backend.nqp
@@ -61,7 +61,7 @@ class HLL::Backend::JVM {
method jast($qast, *%adverbs) {
my $classname := %*COMPILING<%?OPTIONS><javaclass> || nqp::sha1('eval-at-' ~ nqp::time_n() ~ $compile_count++);
- nqp::getcomp('QAST').jast($qast, :$classname);
+ nqp::getcomp('QAST').jast($qast, :$classname, |%adverbs);
}
method classfile($jast, *%adverbs) {
diff --git a/src/vm/jvm/QAST/Compiler.nqp b/src/vm/jvm/QAST/Compiler.nqp
index fd66557..e423b9d 100644
--- a/src/vm/jvm/QAST/Compiler.nqp
+++ b/src/vm/jvm/QAST/Compiler.nqp
@@ -2782,7 +2782,13 @@ QAST::OperationsJAST.map_classlib_core_op('getuniprop_str', $TYPE_OPS, 'getunipr
QAST::OperationsJAST.map_classlib_core_op('force_gc', $TYPE_OPS, 'force_gc', [], $RT_OBJ, :tc);
-class QAST::CompilerJAST {
+class QAST::CompilerJASTInstance {
+ has $!JCLASS;
+ has $!NEXT_QBID;
+ has %!CUID_TO_QBID;
+ has $!HLL;
+ has $!COMP_MODE;
+
# Responsible for handling issues around code references, building the
# switch statement dispatcher, etc.
my class CodeRefBuilder {
@@ -2792,14 +2798,16 @@ class QAST::CompilerJAST {
has @!cuids;
has @!callsites;
has %!callsite_map;
+ has $!jclass;
- method BUILD() {
+ method BUILD(:$jclass) {
$!cur_idx := 0;
%!cuid_to_idx := {};
@!jastmeth_names := [];
@!cuids := [];
@!callsites := [];
%!callsite_map := {};
+ $!jclass := $jclass;
}
method register_method($jastmeth, $cuid) {
@@ -2887,7 +2895,7 @@ class QAST::CompilerJAST {
# Return the array. Add method to class.
$csa.append($ARETURN);
- $*JCLASS.add_method($csa);
+ $!jclass.add_method($csa);
}
}
@@ -3142,15 +3150,23 @@ class QAST::CompilerJAST {
# Set up a JAST::Class that will hold all the blocks (which become Java
# methods) that we shall compile.
my $file := nqp::ifnull(nqp::getlexdyn('$?FILES'), "");
- my $*JCLASS := JAST::Class.new(
+ my $!JCLASS := JAST::Class.new(
:name($classname),
:super('org.perl6.nqp.runtime.CompilationUnit'),
:filename($file)
);
+ if nqp::existskey(%adverbs, 'mast_frames') {
+ if nqp::existskey(%adverbs<mast_frames>, 'jclass') {
+ $!JCLASS := nqp::atkey(%adverbs<mast_frames>, 'jclass');
+ }
+ else {
+ nqp::bindkey(%adverbs<mast_frames>, 'jclass', $!JCLASS);
+ }
+ }
# We'll also need to keep track of all the blocks we compile into Java
# methods; the CodeRefBuilder takes care of that.
- my $*CODEREFS := CodeRefBuilder.new();
+ my $*CODEREFS := CodeRefBuilder.new(:jclass($!JCLASS));
# Now compile $source. By the end of this, the various data structures
# set up above will be fully populated.
@@ -3160,7 +3176,7 @@ class QAST::CompilerJAST {
$*CODEREFS.jastify();
# Finally, we hand back the finished class.
- return $*JCLASS
+ return $!JCLASS
}
# Tracks what is currently on the stack, and what things that were on the
@@ -3307,8 +3323,13 @@ class QAST::CompilerJAST {
}
method cuid_to_qbid(str $cuid) {
- my $map := %*CUID_TO_QBID;
- nqp::existskey($map, $cuid) ?? $map{$cuid} !! ($map{$cuid} := $*NEXT_QBID++);
+ my $map := %!CUID_TO_QBID;
+ if nqp::existskey($map, $cuid) {
+ $map{$cuid}
+ } else {
+ $map{$cuid} := $!NEXT_QBID++;
+ $map{$cuid}
+ }
}
multi method as_jast(QAST::CompUnit $cu, :$want) {
@@ -3316,9 +3337,9 @@ class QAST::CompilerJAST {
my $*EH_IDX := 1;
# Set HLL.
- my $*HLL := '';
+ my $!HLL := '';
if $cu.hll {
- $*HLL := $cu.hll;
+ $!HLL := $cu.hll;
}
# Should have a single child which is the outer block.
@@ -3326,13 +3347,14 @@ class QAST::CompilerJAST {
nqp::die("QAST::CompUnit should have one child that is a QAST::Block");
}
- my %*CUID_TO_QBID;
- my $*NEXT_QBID := 0;
+ my %!CUID_TO_QBID;
+ my $!NEXT_QBID := 0;
# Pre-seed to make sure that qbids correspond to serialization IDs
- my $*COMP_MODE := $cu.compilation_mode;
- if $*COMP_MODE {
+ my $!COMP_MODE := $cu.compilation_mode;
+ if $!COMP_MODE {
for $cu.code_ref_blocks() -> $qblock {
- %*CUID_TO_QBID{$qblock.cuid} := $*NEXT_QBID++;
+ %!CUID_TO_QBID{$qblock.cuid} := $!NEXT_QBID++;
+ nqp::sayfh(nqp::getstderr(), "cuid {$qblock.cuid} with qbid $!NEXT_QBID");
}
}
@@ -3347,6 +3369,7 @@ class QAST::CompilerJAST {
# If we are in compilation mode, or have pre-deserialization or
# post-deserialization tasks, handle those. Overall, the process
# is to desugar this into simpler QAST nodes, then compile those.
+ my $is_nested := $cu.is_nested;
my @pre_des := $cu.pre_deserialize;
my @post_des := $cu.post_deserialize;
if %*BLOCK_LEX_VALUES {
@@ -3355,7 +3378,7 @@ class QAST::CompilerJAST {
QAST::Op.new( :op('setup_blv'), %*BLOCK_LEX_VALUES )
));
}
- if $*COMP_MODE || @pre_des || @post_des || need_set_code_object($cu) {
+ if $!COMP_MODE || @pre_des || @post_des || need_set_code_object($cu) {
# Create a block into which we'll install all of the other
# pieces.
my $block := QAST::Block.new( :blocktype('raw') );
@@ -3366,13 +3389,13 @@ class QAST::CompilerJAST {
}
# If we need to do deserialization, emit code for that.
- if $*COMP_MODE {
+ if $!COMP_MODE && !$is_nested {
$block.push(self.deserialization_code($cu.sc(), $cu.code_ref_blocks(),
$cu.repo_conflict_resolver()));
}
# Add code object fixups.
- if $cu.code_ref_blocks() {
+ if $cu.code_ref_blocks() && !$is_nested {
my $cur_pd_block := QAST::Block.new( :blocktype('immediate') );
my $i := 0;
for $cu.code_ref_blocks() {
@@ -3414,7 +3437,7 @@ class QAST::CompilerJAST {
my $des_meth := JAST::Method.new( :name('deserializeQbid'), :returns('I'), :static(0) );
$des_meth.append(JAST::PushIndex.new( :value(self.cuid_to_qbid($block.cuid)) ));
$des_meth.append($IRETURN);
- $*JCLASS.add_method($des_meth);
+ $!JCLASS.add_method($des_meth);
}
# Compile and include load-time logic, if any.
@@ -3428,13 +3451,14 @@ class QAST::CompilerJAST {
my $load_meth := JAST::Method.new( :name('loadQbid'), :returns('I'), :static(0) );
$load_meth.append(JAST::PushIndex.new( :value(self.cuid_to_qbid($load_block.cuid)) ));
$load_meth.append($IRETURN);
- $*JCLASS.add_method($load_meth);
+ $!JCLASS.add_method($load_meth);
}
# Compile and include main-time logic, if any, and then add a Java
# main that will lead to its invocation.
+ my $main_block;
if nqp::defined($cu.main) {
- my $main_block := QAST::Block.new(
+ $main_block := QAST::Block.new(
:blocktype('raw'),
$cu.main,
QAST::Op.new( :op('null') )
@@ -3442,33 +3466,33 @@ class QAST::CompilerJAST {
self.as_jast($main_block);
my $main_meth := JAST::Method.new( :name('main'), :returns('Void') );
$main_meth.add_argument('argv', "[$TYPE_STR");
- $main_meth.append(JAST::PushCVal.new( :value('L' ~ $*JCLASS.name ~ ';') ));
+ $main_meth.append(JAST::PushCVal.new( :value('L' ~ $!JCLASS.name ~ ';') ));
$main_meth.append(JAST::PushIndex.new( :value(self.cuid_to_qbid($main_block.cuid)) ));
$main_meth.append($ALOAD_0);
$main_meth.append(JAST::Instruction.new( :op('invokestatic'),
$TYPE_CU, 'enterFromMain',
'Void', 'Ljava/lang/Class;', 'I', "[$TYPE_STR"));
$main_meth.append($RETURN);
- $*JCLASS.add_method($main_meth);
+ $!JCLASS.add_method($main_meth);
my $entry_cuid_meth := JAST::Method.new( :name('entryQbid'), :returns('I'), :static(0) );
$entry_cuid_meth.append(JAST::PushIndex.new( :value(self.cuid_to_qbid($main_block.cuid)) ));
$entry_cuid_meth.append($IRETURN);
- $*JCLASS.add_method($entry_cuid_meth);
+ $!JCLASS.add_method($entry_cuid_meth);
}
# Add method that returns HLL name.
my $hll_meth := JAST::Method.new( :name('hllName'), :returns($TYPE_STR), :static(0) );
- $hll_meth.append(JAST::PushSVal.new( :value($*HLL) ));
+ $hll_meth.append(JAST::PushSVal.new( :value($!HLL) ));
$hll_meth.append($ARETURN);
- $*JCLASS.add_method($hll_meth);
+ $!JCLASS.add_method($hll_meth);
# Add method that returns the mainline block.
my $mainline_meth := JAST::Method.new( :name('mainlineQbid'), :returns('I'), :static(0) );
$mainline_meth.append(JAST::PushIndex.new( :value(self.cuid_to_qbid($cu[0].cuid)) ));
$mainline_meth.append($IRETURN);
- $*JCLASS.add_method($mainline_meth);
+ $!JCLASS.add_method($mainline_meth);
- return $*JCLASS;
+ return $!JCLASS;
}
sub need_set_code_object($cu) {
@@ -3486,7 +3510,7 @@ class QAST::CompilerJAST {
my $serialized := nqp::serialize($sc, $sh);
if %*COMPILING<%?OPTIONS><target> eq 'jar' {
- $*JCLASS.serialized($serialized);
+ $!JCLASS.serialized($serialized);
$serialized := nqp::null();
}
@@ -3520,7 +3544,7 @@ class QAST::CompilerJAST {
my $count_meth := JAST::Method.new( :name('serializedCodeRefCount'), :returns('I'), :static(0) );
$count_meth.append(JAST::PushIndex.new( :value(+@code_ref_blocks) ));
$count_meth.append($IRETURN);
- $*JCLASS.add_method($count_meth);
+ $!JCLASS.add_method($count_meth);
# Overall deserialization QAST.
QAST::Stmts.new(
@@ -3672,8 +3696,9 @@ class QAST::CompilerJAST {
# unique ID and name. (Note, always void return here as return values
# are handled out of band).
my $*JMETH := JAST::Method.new( :name('qb_'~self.cuid_to_qbid($node.cuid)), :returns('Void'), :static(1) );
+ nqp::printfh(nqp::getstderr(), "declared JMETH 'qb_{self.cuid_to_qbid($node.cuid)} for cuid {$node.cuid}'\n");
$*JMETH.cr_name($node.name);
- $*JMETH.cr_cuid($node.cuid) unless $*COMP_MODE;
+ $*JMETH.cr_cuid($node.cuid) unless $!COMP_MODE;
$*CODEREFS.register_method($*JMETH, $node.cuid);
# Set outer if we have one.
@@ -4014,7 +4039,7 @@ class QAST::CompilerJAST {
}
# Finalize method and add it to the class.
- $*JCLASS.add_method($*JMETH);
+ $!JCLASS.add_method($*JMETH);
}
# Now go by block type for producing a result; also need to special-case
@@ -4047,13 +4072,13 @@ class QAST::CompilerJAST {
# Emit the virtual call.
if $args_expectation == $ARG_EXP_NO_ARGS {
$il.append(savesite(JAST::Instruction.new( :op('invokestatic'),
- 'L' ~ $*JCLASS.name ~ ';',
+ 'L' ~ $!JCLASS.name ~ ';',
$*CODEREFS.cuid_to_jastmethname($node.cuid),
'V', $TYPE_CU, $TYPE_TC, $TYPE_CR, $TYPE_CSD, $TYPE_RESUME )));
}
else {
$il.append(savesite(JAST::Instruction.new( :op('invokestatic'),
- 'L' ~ $*JCLASS.name ~ ';',
+ 'L' ~ $!JCLASS.name ~ ';',
$*CODEREFS.cuid_to_jastmethname($node.cuid),
'V', $TYPE_CU, $TYPE_TC, $TYPE_CR, $TYPE_CSD, $TYPE_RESUME, "[$TYPE_OBJ" )));
}
@@ -4144,7 +4169,7 @@ class QAST::CompilerJAST {
multi method as_jast(QAST::Op $node, :$want) {
my $hll := '';
- try $hll := $*HLL;
+ try $hll := $!HLL;
QAST::OperationsJAST.compile_op(self, $hll, $node);
}
@@ -4751,12 +4776,12 @@ class QAST::CompilerJAST {
}
elsif $desired == $RT_OBJ {
my $hll := '';
- try $hll := $*HLL;
+ try $hll := $!HLL;
return QAST::OperationsJAST.box(self, $hll, $got);
}
elsif $got == $RT_OBJ {
my $hll := '';
- try $hll := $*HLL;
+ try $hll := $!HLL;
return QAST::OperationsJAST.unbox(self, $hll, $desired);
}
elsif $desired == $RT_INT {
@@ -6391,6 +6416,20 @@ class QAST::CompilerJAST {
method operations() { QAST::OperationsJAST }
}
+class QAST::CompilerJAST {
+ method jast($qast, :$classname, *%adverbs) {
+ QAST::CompilerJASTInstance.new.jast($qast, :$classname, |%adverbs)
+ }
+
+ method operations() {
+ QAST::OperationsJAST
+ }
+
+ method instance() {
+ QAST::CompilerJASTInstance
+ }
+}
+
# Register as the QAST compiler.
if nqp::isnull(nqp::getcomp('QAST')) {
nqp::bindcomp('QAST', QAST::CompilerJAST);
diff --git a/src/vm/jvm/runtime/org/perl6/nqp/runtime/CompilationUnit.java b/src/vm/jvm/runtime/org/perl6/nqp/runtime/CompilationUnit.java
index 68b5ede..aec6901 100644
--- a/src/vm/jvm/runtime/org/perl6/nqp/runtime/CompilationUnit.java
+++ b/src/vm/jvm/runtime/org/perl6/nqp/runtime/CompilationUnit.java
@@ -69,6 +69,10 @@ public abstract class CompilationUnit {
return cu;
}
+ public class SomethingFishyException extends RuntimeException {
+ public SomethingFishyException(String msg) { super(msg); }
+ }
+
/**
* Does initialization work for the compilation unit.
*/
@@ -98,7 +102,8 @@ public abstract class CompilationUnit {
cr.st = BOOTCodeSTable;
codeRefList.add(cr);
- if (m.qbid >= 0 && m.qbid < qbidToCodeRef.length) qbidToCodeRef[m.qbid] = cr;
+ if (m.qbid >= 0 && m.qbid < qbidToCodeRef.length) { qbidToCodeRef[m.qbid] = cr; }
+ else { throw new SomethingFishyException("what even"); }
/* Stash outer, for later resolution. */
outerCuid.add(ann);
Raw
rakudo.patch
diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp
index 6a09ecf..7cdfd44 100644
--- a/src/Perl6/Grammar.nqp
+++ b/src/Perl6/Grammar.nqp
@@ -447,11 +447,15 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
&& $outer_world.is_precompilation_mode()
);
+ my %mast_frames := nqp::defined(%*COMPILING<%?OPTIONS><mast_frames>)
+ ?? %*COMPILING<%?OPTIONS><mast_frames>
+ !! nqp::hash();
+
my $*W := $is_nested
?? $outer_world.create_nested()
!! nqp::isnull($file)
- ?? Perl6::World.new(:handle($source_id))
- !! Perl6::World.new(:handle($source_id), :description($file));
+ ?? Perl6::World.new(:handle($source_id), :%mast_frames)
+ !! Perl6::World.new(:handle($source_id), :%mast_frames, :description($file));
unless $is_nested {
$*W.add_initializations();
diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp
index e33fd06..c2f5f09 100644
--- a/src/Perl6/World.nqp
+++ b/src/Perl6/World.nqp
@@ -458,6 +458,12 @@ class Perl6::World is HLL::World {
# are we module debugging?
has $!RAKUDO_MODULE_DEBUG;
+ has %!mast_frames;
+
+ method mast_frames() {
+ nqp::defined(%!mast_frames) || nqp::hash
+ }
+
method BUILD(*%adv) {
%!code_object_fixup_list := {};
}
diff --git a/src/core/CompUnit/PrecompilationRepository.pm b/src/core/CompUnit/PrecompilationRepository.pm
index 2976e02..f224d27 100644
--- a/src/core/CompUnit/PrecompilationRepository.pm
+++ b/src/core/CompUnit/PrecompilationRepository.pm
@@ -201,6 +201,11 @@ class CompUnit::PrecompilationRepository::Default does CompUnit::PrecompilationR
.subst('perl6-debug', 'perl6') # debugger would try to precompile it's UI
.subst('perl6-gdb', 'perl6')
.subst('perl6-jdb-server', 'perl6-j') ;
+ if %*ENV<HACKY_DEBUG> {
+ %ENV<PERL6_JDB_PORT>++;
+ $perl6.=subst('perl6-j', 'perl6-jdb-server');
+ }
+ $RMD("Running $perl6 $lle $profile --target={Rakudo::Internals.PRECOMP-TARGET} --output={$bc} --source-name=$source-name $path") if $RMD;
my $proc = run(
$perl6,
$lle,
@@ -210,7 +215,7 @@ class CompUnit::PrecompilationRepository::Default does CompUnit::PrecompilationR
"--source-name=$source-name",
$path,
:out,
- :err,
+ #:err,
);
%ENV.DELETE-KEY(<RAKUDO_PRECOMP_WITH>);
%ENV.DELETE-KEY(<RAKUDO_PRECOMP_LOADING>);
@@ -220,13 +225,14 @@ class CompUnit::PrecompilationRepository::Default does CompUnit::PrecompilationR
if not $proc.out.close or $proc.status { # something wrong
self.store.unlock;
$RMD("Precomping $path failed: $proc.status()") if $RMD;
- Rakudo::Internals.VERBATIM-EXCEPTION(1);
- die $proc.err.slurp-rest;
+ die @result;
+ #Rakudo::Internals.VERBATIM-EXCEPTION(1);
+ #die $proc.err.slurp-rest;
}
- if $proc.err.slurp-rest -> $warnings {
- $*ERR.print($warnings);
- }
+ #if $proc.err.slurp-rest -> $warnings {
+ # $*ERR.print($warnings);
+ #}
unless $bc.e {
$RMD("$path aborted precompilation without failure") if $RMD;
self.store.unlock;
diff --git a/src/core/CompUnit/PrecompilationStore/File.pm b/src/core/CompUnit/PrecompilationStore/File.pm
index bce07e1..03aed59 100644
--- a/src/core/CompUnit/PrecompilationStore/File.pm
+++ b/src/core/CompUnit/PrecompilationStore/File.pm
@@ -37,8 +37,26 @@ class CompUnit::PrecompilationStore::File does CompUnit::PrecompilationStore {
}
method bytecode(--> Buf) {
+# #?if !jvm
self!read-dependencies;
$!bytecode //= $!file.slurp-rest(:bin)
+# #?endif
+##?if jvm
+# # this can go once mixing get() and slurp-rest(:bin) on the JVM works
+# $!file.seek(0);
+# my $buf = $!file.slurp-rest(:bin);
+# #my $buf = $!path.slurp(:bin);
+# my int $elems = $buf.elems;
+# my int $start = 0;
+# my $prev = 0x0a;
+# loop (my int $i = 0; $i < $elems; $i++) {
+# if $prev == 0x0a and $buf[$i] == 0x0a {
+# $start = $i;
+# last;
+# }
+# }
+# $!bytecode = $buf.subbuf($start + 1);
+##?endif
}
method bytecode-handle(--> IO::Handle) {
diff --git a/src/core/Exception.pm b/src/core/Exception.pm
index 297bd00..d277e44 100644
--- a/src/core/Exception.pm
+++ b/src/core/Exception.pm
@@ -744,8 +744,8 @@ my class X::Trait::Scope is Exception {
has $.scope; # not supported (but used) scope
has $.supported; # hint about what is allowed instead
method message () {
- "Can't apply trait '$.type $.subtype' on a $.scope scoped $.declaring."
- ~ ( $.supported ?? " Only {$.supported.join(' and ')} scoped {$.declaring}s are supported." !! '' );
+ "Can't apply trait '$.type $.subtype' on a '$.scope' scoped $.declaring."
+ ~ ( $.supported ?? " Only '{$.supported.join("' and '")}' scoped {$.declaring}s are supported." !! '' );
}
}
my class X::Comp::Trait::Scope is X::Trait::Scope does X::Comp { };
diff --git a/src/core/control.pm b/src/core/control.pm
index 3ff9699..8ec64d2 100644
--- a/src/core/control.pm
+++ b/src/core/control.pm
@@ -211,7 +211,9 @@ proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) {
}
my $eval_ctx := nqp::getattr(nqp::decont($context // CALLER::), PseudoStash, '$!ctx');
my $?FILES := 'EVAL_' ~ (state $no)++;
- my \mast_frames := nqp::hash();
+ my \mast_frames := ($*W and $*W.is_precompilation_mode() and %*COMPILING<%?OPTIONS><mast_frames>)
+ ?? $*W.mast_frames
+ !! nqp::hash();
my $compiled := $compiler.compile(
$code.Stringy,
:outer_ctx($eval_ctx),
diff --git a/tools/build/create-jvm-runner.pl b/tools/build/create-jvm-runner.pl
index ffb5818..fcd3724 100644
--- a/tools/build/create-jvm-runner.pl
+++ b/tools/build/create-jvm-runner.pl
@@ -71,6 +71,6 @@ if ($debugger) {
}
else {
install "perl6-j", "java $jopts perl6";
- install "perl6-jdb-server", "java -Xdebug -Xrunjdwp:transport=dt_socket,address=8000,server=y,suspend=y $jopts perl6";
+ install "perl6-jdb-server", "java -Xdebug -Xrunjdwp:transport=dt_socket,address=\"\${PERL6_JDB_PORT:=8000}\",server=y,suspend=y $jopts perl6";
install "perl6-eval-server", "java -Xmx3000m -XX:MaxPermSize=200m $jopts org.perl6.nqp.tools.EvalServer";
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment