...
 
Commits (4)
......@@ -62,6 +62,10 @@ examples/rubyish/t/rubyish-3-tests.t
examples/rubyish/t/rubyish-4-tests.t
examples/rubyish/t/scoping.t
examples/rubyish/t/template.t
examples/sub-lines2words.nqp
examples/test-ws.nqp
examples/use-classes.nqp
examples/use-hashes.nqp
examples/webpacked/README.md
examples/webpacked/example.nqp
examples/webpacked/index.html
......@@ -70,6 +74,7 @@ gen/js/.gitignore
gen/jvm/.gitignore
gen/moar/.gitignore
nqp-js-on-js/.gitignore
nqp-js-on-js/.npmignore
nqp-js-on-js/package.json
package.json
ports/macports/Portfile
......@@ -160,15 +165,11 @@ src/vm/js/bin/run_tests_bootstrapped.pl
src/vm/js/const_map.nqp
src/vm/js/nqp-loader/main.js
src/vm/js/nqp-loader/package.json
src/vm/js/nqp-runtime/.bignum.js.swo
src/vm/js/nqp-runtime/.core.js.swn
src/vm/js/nqp-runtime/.core.js.swo
src/vm/js/nqp-runtime/.ctx.js.swo
src/vm/js/nqp-runtime/.nativecall.js.swo
src/vm/js/nqp-runtime/.unicode-props.js.swo
src/vm/js/nqp-runtime/BOOT.js
src/vm/js/nqp-runtime/async-continuations.js
src/vm/js/nqp-runtime/bignum.js
src/vm/js/nqp-runtime/bootstrap.js
src/vm/js/nqp-runtime/browser.js
src/vm/js/nqp-runtime/capture.js
src/vm/js/nqp-runtime/cclass.js
src/vm/js/nqp-runtime/code-ref-with-statevars.js
......@@ -182,8 +183,11 @@ src/vm/js/nqp-runtime/ctx-just-handler.js
src/vm/js/nqp-runtime/ctx-with-static.js
src/vm/js/nqp-runtime/ctx.js
src/vm/js/nqp-runtime/curlexpad.js
src/vm/js/nqp-runtime/dbcs-codec.js
src/vm/js/nqp-runtime/deserialization.js
src/vm/js/nqp-runtime/exceptions-stack.js
src/vm/js/nqp-runtime/fake-stable.js
src/vm/js/nqp-runtime/fiber-continuations.js
src/vm/js/nqp-runtime/graphemes.js
src/vm/js/nqp-runtime/hash-iter.js
src/vm/js/nqp-runtime/hash.js
......@@ -202,7 +206,6 @@ src/vm/js/nqp-runtime/nqp-object.js
src/vm/js/nqp-runtime/nqp-str.js
src/vm/js/nqp-runtime/null.js
src/vm/js/nqp-runtime/null_s.js
src/vm/js/nqp-runtime/package-lock.json
src/vm/js/nqp-runtime/package.json
src/vm/js/nqp-runtime/refs.js
src/vm/js/nqp-runtime/repossession.js
......@@ -214,6 +217,7 @@ src/vm/js/nqp-runtime/serialization.js
src/vm/js/nqp-runtime/sixmodel.js
src/vm/js/nqp-runtime/static-ctx.js
src/vm/js/nqp-runtime/strip-marks.js
src/vm/js/nqp-runtime/tables/shiftjis.json
src/vm/js/nqp-runtime/unicode-data.js
src/vm/js/nqp-runtime/unicode-props.js
src/vm/jvm/HLL/Backend.nqp
......@@ -474,6 +478,7 @@ t/moar/08-indexic.t
t/moar/09-concat.t
t/moar/10-eqatim.t
t/moar/11-decode.t
t/moar/12-decodelocaltime.t
t/moar/50-jit-register-alloc.t
t/moar/51-jit-div_i.t
t/moar/52-pluggable-spesh.t
......@@ -587,6 +592,7 @@ t/nqp/109-coercions.t
t/nqp/110-normalization.t
t/nqp/111-spawnprocasync.t
t/nqp/112-call.t
t/nqp/112-continuations.t
t/nqp/113-run-command.t
t/nqp/114-pod-panic.t
t/nqp/115-nums.t
......
nqp (2018.09+dfsg-1) unstable; urgency=medium
* New upstream version 2018.09+dfsg
-- Robert Lemmen <robertle@semistable.com> Mon, 24 Sep 2018 08:49:01 +0200
nqp (2018.06+dfsg-1) unstable; urgency=medium
[ Dominique Dumont ]
......
......@@ -10,7 +10,7 @@ Build-Depends: debhelper (>= 9),
libjs-jquery,
libreadline-dev,
libtommath-dev (>= 0.42.0-1.2),
moarvm-dev (>= 2018.06),
moarvm-dev (>= 2018.09),
perl
Standards-Version: 4.1.4
Vcs-Browser: https://salsa.debian.org/perl6-team/nqp
......
This diff is collapsed.
#!/usr/bin/env nqp
# create a line => words splitting function
my $line := ' # one two ';
say("\$line: '$line'");
my @w := words($line);
say("'$line' => words");
for @w {
say(" word: $_");
}
sub words($line) {
my @arr := nqp::split(' ', $line);
my @words := [];
for @arr {
my $s := $_;
# remove any whitespace
$s := subst($s, /\s+/, '', :global);
next if !$s;
@words.push($s);
}
return @words;
}
#!/usr/bin/env nqp
# test regexes for deleting and normalizing whitespace in text
# interspersed with comments
my $txt := 'blah # comment
# comment
blah';
my $rx := /
<!after \S>
\h*
[
| [\h* '#' \N* \n]
| [\h* \n]
]*
\h*
/;
my $s := subst($txt, $rx, ' ');
say("original text = '$txt'");
say("new text = '$s'");
#!/usr/bin/env nqp
# based on blog post by Andrew Shitov:
#
# https://perl6.online/2018/01/09/what-does-nqpgetattr-do/
#
# class C {
# has $.attr is rw;
# }
#
# my $o := nqp::create(C);
# $o.attr = 'other value';
# nqp::say(nqp::getattr($o, C, '$!attr')); # other value
class Foo {
has $!line;
has @!contents;
method set-line($value) {
$!line := $value;
}
method set-contents(@value) {
@!contents := @value;
}
method add2contents($value) {
@!contents.push($value);
}
method empty-contents() {
@!contents := [];
}
# note the empty parens are required in the declaration
method show-line() {
say(" \$!line: '$!line'");
}
# note the empty parens are required in the declaration
method show-contents() {
say(" \@!contents:");
if !nqp::elems(@!contents) {
say(" [empty]");
return;
}
for @!contents {
say(" $_");
}
}
}
my $line1 := ' # text ';
my $line2 := ' text ';
my $o1 := nqp::create(Foo);
$o1.set-line($line1);
my $o2 := nqp::create(Foo);
$o2.set-line($line2);
my $L1 := nqp::getattr($o1, Foo, '$!line');
my $L2 := nqp::getattr($o2, Foo, '$!line');
say("\$o1.line: '$L1'");
say("\$o2.line: '$L2'");
my @arr := nqp::list(
'elem 0',
'elem 1',
);
$o1.set-contents(@arr);
my @list := nqp::getattr($o1, Foo, '@!contents');
say("\$o1's contents:");
for @list {
say(" $_");
}
$o1.add2contents('another elem');
@list := nqp::getattr($o1, Foo, '@!contents');
say("\n\$o1's contents after an update:");
for @list {
say(" $_");
}
$o1.empty-contents;
@list := nqp::getattr($o1, Foo, '@!contents');
say("\n\$o1's contents after emptying:");
if !nqp::elems(@list) {
say(" \$o1's \@contents are empty");
}
else {
for @list {
say(" $_");
}
}
my $o3:= nqp::create(Foo);
$o3.set-contents(@arr);
$o3.set-line('line 3');
$o3.show-contents;
$o3.show-line;
#!/usr/bin/env nqp
# create a hash
my %h := nqp::hash(
'k1', 0,
'k2', 1,
);
# iterate over the hash
for %h {
my $k := nqp::iterkey_s($_);
my $v := nqp::iterval($_);
say("key $k => val $v");
}
my $k1 := 'k1';
my $k2 := 'k2';
# return value of a key
my $v := nqp::atkey(%h, $k1);
say("value of key $k1 is $v");
my $k3 := 'k3';
my $v3 := 3;
# add a new pair
nqp::bindkey(%h, $k3, $v3);
# check existence of a key
if nqp::existskey(%h, $k3) {
say("key $k3 exists");
}
{
"version": "0.1.0",
"version": "0.4.0",
"name": "nqp-js-on-js",
"bin": {
"nqp-js-on-js": "nqp-bootstrapped.js"
"nqp-js-on-js": "nqp-bootstrapped.js"
},
"files": [
"*.js"
],
"licenses": [
{
"type": "Artistic 2",
......@@ -11,6 +14,6 @@
}
],
"dependencies": {
"nqp-runtime": "0.1.0"
"nqp-runtime": "0.2.0"
}
}
......@@ -242,7 +242,7 @@ class HLL::Actions {
method charname($/) {
my $codepoint := $<integer>
?? nqp::chr($<integer>.made)
!! nqp::getstrfromname(~$/);
!! nqp::strfromname(~$/);
$/.panic("Unrecognized character name '$/'") if $codepoint eq '';
make $codepoint;
}
......
......@@ -196,18 +196,17 @@ class HLL::CommandLine::Parser {
if $i == $arg-count - 1 {
nqp::die("Option $opt needs a value");
} else {
$i++;
@args[$i];
@args[++$i];
}
}
# called after a terminator that declares the rest
# as not containing any options
sub slurp-rest() {
$i++;
++$i;
while $i < $arg-count {
$result.add-argument(@args[$i]);
$i++;
++$i;
}
}
......@@ -269,7 +268,7 @@ class HLL::CommandLine::Parser {
else {
nqp::die("Grouped options '-$opt' contain '$o', which is not a valid option")
}
$i++;
++$i;
}
}
}
......@@ -284,5 +283,3 @@ class HLL::CommandLine::Parser {
return $result;
}
}
......@@ -521,15 +521,15 @@ class HLL::Compiler does HLL::Backend::Default {
if %adverbs<transcode> {
$s := $!backend.apply_transcodings($s, %adverbs<transcode>);
}
my $outer_ctx := %adverbs<outer_ctx>;
my $outer_ctx := %adverbs<outer_ctx>;
if nqp::existskey(%adverbs, 'grammar') {
$grammar := %adverbs<grammar>;
$actions := %adverbs<actions>;
}
else {
$grammar := self.parsegrammar;
$actions := self.parseactions;
}
$grammar := %adverbs<grammar>;
$actions := %adverbs<actions>;
}
else {
$grammar := self.parsegrammar;
$actions := self.parseactions;
}
$grammar.HOW.trace-on($grammar) if %adverbs<rxtrace>;
my $match := $grammar.parse($s, p => 0, actions => $actions);
$grammar.HOW.trace-off($grammar) if %adverbs<rxtrace>;
......
......@@ -282,7 +282,7 @@ position C<pos>.
# see if the opening bracket is repeated
my int $len := 1;
while nqp::eqat($target, $start, ++$pos) {
$len++;
++$len;
}
if $len > 1 {
$start := nqp::x($start, $len);
......@@ -621,16 +621,17 @@ An operator precedence parser.
}
method LANG($lang, $regex, *@args) {
self.check_PACKAGE_oopsies('LANG1');
my $actions := self.slang_actions($lang);
my $lang_cursor := self.slang_grammar($lang).'!cursor_init'(self.orig(), :p(self.pos()), :shared(self.'!shared'()));
self.check_PACKAGE_oopsies('LANG1');
my $lang_cursor := self.slang_grammar($lang).'!cursor_init'(
self.orig(), :p(self.pos), :shared(self.'!shared'()));
$lang_cursor.clone_braid_from(self);
$lang_cursor.set_actions($actions);
if self.HOW.traced(self) {
$lang_cursor.HOW.trace-on($lang_cursor, self.HOW.trace_depth(self));
}
$lang_cursor.check_PACKAGE_oopsies('LANG2');
my $result := $lang_cursor."$regex"(|@args);
$result.set_braid_from(self)
$lang_cursor.set_actions(self.slang_actions($lang));
$lang_cursor.HOW.trace-on($lang_cursor, self.HOW.trace_depth(self))
if self.HOW.traced(self);
$lang_cursor.check_PACKAGE_oopsies('LANG2');
(@args ?? $lang_cursor."$regex"(|@args) !! $lang_cursor."$regex"()
).set_braid_from(self)
}
}
......@@ -285,7 +285,7 @@ class NQP::Actions is HLL::Actions {
}
# build if/then/elsif structure
while $count > 0 {
$count--;
--$count;
my $else := $ast;
$ast := xblock_immediate( $<xblock>[$count].ast );
$ast.push($else);
......@@ -580,7 +580,11 @@ class NQP::Actions is HLL::Actions {
# Construct meta-object with specified metaclass, adding it to the
# serialization context for this compilation unit.
my $HOW := $*W.find_sym($<metaclass><identifier>);
my $PACKAGE := $*W.pkg_create_mo($HOW, :name(~$<name>));
my %args;
if $<repr> {
%args<repr> := ~$<repr><quote_delimited><quote_atom>[0];
}
my $PACKAGE := $*W.pkg_create_mo($HOW, :name(~$<name>), |%args);
# Install it in the current package or current lexpad as needed.
if $*SCOPE eq 'our' || $*SCOPE eq '' {
......@@ -608,7 +612,7 @@ class NQP::Actions is HLL::Actions {
my @ns := nqp::clone($<name><identifier>);
my $name := ~@ns.pop;
my $how := $/.how($*PKGDECL);
my $package := $/.package;
my $package := $/.package;
# Get the body code.
my $ast;
......@@ -1498,7 +1502,7 @@ class NQP::Actions is HLL::Actions {
$ast[$i].named(1) if nqp::istype($ast[$i], QAST::Var)
&& nqp::eqat($ast[$i].name, '%', 0);
}
$i++;
++$i;
}
make $ast;
}
......
......@@ -316,13 +316,9 @@ grammar NQP::Grammar is HLL::Grammar {
token term:sym<package_declarator> { <package_declarator> }
token term:sym<scope_declarator> { <scope_declarator> }
token term:sym<routine_declarator> { <routine_declarator> }
token term:sym<multi_declarator> {
<?before 'multi'|'proto'|'only'>
<!before 'proto' <.ws> ['regex'|'token'|'rule']>
<multi_declarator>
}
token term:sym<regex_declarator> { <regex_declarator> }
token term:sym<multi_declarator> { <multi_declarator> }
token term:sym<statement_prefix> { <statement_prefix> }
token term:sym<lambda> { <?lambda> <pblock> }
token term:sym<last> { <sym> [<.ws> <identifier> <?{ $*W.is_lexical(~$<identifier>) }>]? { $*CONTROL_USED := 1 } }
......@@ -401,6 +397,7 @@ grammar NQP::Grammar is HLL::Grammar {
:my $*PKGDECL := 'stub';
<sym> <name>
'metaclass' <metaclass=.name>
[ 'is' 'repr(' <repr=.quote_EXPR> ')' ]?
'{' '...' '}'
}
......@@ -426,11 +423,11 @@ grammar NQP::Grammar is HLL::Grammar {
}
my $how := self.how($*PKGDECL);
my $INNER := $*W.cur_lexpad();
my $package := $*W.pkg_create_mo($how, |%args);
$*PACKAGE := $package;
$/.set_package($package);
$/.check_PACKAGE_oopsies('package_def1');
$*LANG := $/;
my $package := $*W.pkg_create_mo($how, |%args);
$*PACKAGE := $package;
$/.set_package($package);
$/.check_PACKAGE_oopsies('package_def1');
$*LANG := $/;
# these need to be installed early so that they may be referenced from subs in the block
if nqp::can($how, 'parametric') && $how.parametric($how) {
......
......@@ -193,7 +193,7 @@ class NQP::Optimizer {
$itvar := $item;
last;
}
$i++;
++$i;
}
# Provided we found it, turn it from param to decl, so it will
......
......@@ -159,7 +159,7 @@ class QAST::Node {
nqp::push(@anns, self.dump_flags);
if nqp::ishash(%!annotations) {
for sorted_keys(%!annotations) -> $k {
my $v := %!annotations{$_};
my $v := %!annotations{$k};
try {
if nqp::isconcrete($v) {
if $k eq 'IN_DECL' || $k eq 'BY' || $k eq 'statement_id' {
......
......@@ -33,7 +33,7 @@ class QAST::Op is QAST::Node does QAST::Children {
my int $elems := nqp::elems(@(self));
while $i < $elems {
self[$i].count_inline_placeholder_usages(@usages);
$i++;
++$i;
}
}
......@@ -44,7 +44,7 @@ class QAST::Op is QAST::Node does QAST::Children {
while $i < $elems {
$result[$i] := self[$i].substitute_inline_placeholders(@fillers)
unless nqp::isstr(self[$i]);
$i++;
++$i;
}
$result
}
......
......@@ -16,7 +16,7 @@ class QAST::Stmt is QAST::Node does QAST::Children {
my int $elems := nqp::elems(@(self));
while $i < $elems {
self[$i].count_inline_placeholder_usages(@usages);
$i++;
++$i;
}
}
......@@ -26,7 +26,7 @@ class QAST::Stmt is QAST::Node does QAST::Children {
my int $elems := nqp::elems(@(self));
while $i < $elems {
$result[$i] := self[$i].substitute_inline_placeholders(@fillers);
$i++;
++$i;
}
$result
}
......
......@@ -16,7 +16,7 @@ class QAST::Stmts is QAST::Node does QAST::Children {
my int $elems := nqp::elems(@(self));
while $i < $elems {
self[$i].count_inline_placeholder_usages(@usages);
$i++;
++$i;
}
}
......@@ -26,7 +26,7 @@ class QAST::Stmts is QAST::Node does QAST::Children {
my $elems := nqp::elems(@(self));
while $i < $elems {
$result[$i] := self[$i].substitute_inline_placeholders(@fillers);
$i := $i + 1;
++$i;
}
$result
}
......@@ -37,7 +37,7 @@ class QAST::Stmts is QAST::Node does QAST::Children {
my $elems := nqp::elems(@(self));
while $i < $elems {
$result[$i] := self[$i].evaluate_unquotes(@unquotes);
$i := $i + 1;
++$i;
}
$result
}
......
......@@ -18,23 +18,24 @@ class QAST::VM is QAST::Node does QAST::Children {
}
method dump_children(int $indent, @onto) {
for %!alternatives {
for sorted_keys(%!alternatives) -> $k {
my $v := %!alternatives{$k};
nqp::push(@onto, nqp::x(' ', $indent));
nqp::push(@onto, '[');
nqp::push(@onto, $_.key);
nqp::push(@onto, $k);
nqp::push(@onto, "]\n");
if nqp::istype($_.value, QAST::Node) {
nqp::push(@onto, $_.value.dump($indent+2));
if nqp::istype($v, QAST::Node) {
nqp::push(@onto, $v.dump($indent+2));
}
else {
nqp::push(@onto, nqp::x(' ', $indent+2));
nqp::push(@onto, '- ');
if $_.key eq 'loadlibs' {
nqp::push(@onto, nqp::join(' ',$_.value));
if $k eq 'loadlibs' {
nqp::push(@onto, nqp::join(' ',$v));
}
else {
nqp::push(@onto, ~$_.value);
nqp::push(@onto, ~$v);
}
nqp::push(@onto, "\n");
}
......
......@@ -14,7 +14,7 @@ my class ParseShared is export {
my %cursors_created;
my $cursors_total;
method log_cc($name) {
%cursors_created{$name}++;
++%cursors_created{$name};
$cursors_total++;
}
method log_dump() {
......@@ -181,7 +181,7 @@ role NQPMatchRole is export {
my int $n := 0;
for $item {
$str := $str ~ dump_array($key ~ "[$n]", $_);
$n++
++$n
}
}
$str;
......@@ -190,7 +190,7 @@ role NQPMatchRole is export {
my int $n := 0;
for self.list {
$str := $str ~ dump_array($key ~ '[' ~ $n ~ ']', $_);
$n++
++$n
}
for self.hash {
$str := $str ~ dump_array($key ~ '<' ~ $_.key ~ '>', $_.value);
......@@ -238,12 +238,11 @@ role NQPMatchRole is export {
method check_PACKAGE_oopsies($tag?) {
nqp::die("No braid!") unless $!braid;
$tag := "" unless $tag;
my $value := $*PACKAGE;
my $bvalue := nqp::getattr($!braid, Braid, '$!package');
if nqp::isnull($bvalue) || nqp::objectid($bvalue) != nqp::objectid($value) {
my $target := nqp::getattr_s($!shared, ParseShared, '$!target');
note("Out-of-sync package detected in $tag at " ~ nqp::substr($target, $!pos-10, 30) ~ "");
note("Out-of-sync package detected in " ~ ($tag || '') ~ " at " ~ nqp::substr($target, $!pos-10, 30) ~ "");
note(" (value in braid: " ~ $bvalue.HOW.name($bvalue) ~ ", value in \$*PACKAGE: " ~ $value.HOW.name($value) ~ ")")
unless nqp::isnull($bvalue);
# nqp::die("croak");
......@@ -254,13 +253,12 @@ role NQPMatchRole is export {
method check_LANG_oopsies($tag?) {
nqp::die("No braid!") unless $!braid;
$tag := "" unless $tag;
for %*LANG {
my $name := $_.key;
my $value := $_.value;
my $bvalue := nqp::atkey(nqp::getattr($!braid, Braid, '$!slangs'),$name);
if nqp::isnull($bvalue) || nqp::objectid($bvalue) != nqp::objectid($value) {
note("Deprecated use of %*LANG\<$name> assignment detected in $tag; module should export syntax using \$*LANG.define_slang(\"$name\",<grammar>,<actions>) instead")
note("Deprecated use of %*LANG\<$name> assignment detected in " ~ ($tag || '') ~ "; module should export syntax using \$*LANG.define_slang(\"$name\",<grammar>,<actions>) instead")
unless nqp::index($name,"-actions") > 0;
note(" (value in braid: " ~ $bvalue.HOW.name($bvalue) ~ ", value in %*LANG: " ~ $value.HOW.name($value) ~ ")")
unless nqp::isnull($bvalue);
......@@ -385,7 +383,7 @@ role NQPMatchRole is export {
}
}
}
$csi++;
++$csi;
}
}
......@@ -737,7 +735,7 @@ role NQPMatchRole is export {
my int $fate := 0;
for $regex.ALT_NFA($name) {
$nfa.mergesubstates($start, 0, $fate, $_, self);
$fate++;
++$fate;
}
$nfa.optimize();
$nfa
......@@ -824,7 +822,7 @@ role NQPMatchRole is export {
}
$first := $cs_cur;
}
$n--;
--$n;
}
if nqp::isconcrete($last) {
my int $from := $first.from;
......@@ -840,7 +838,7 @@ role NQPMatchRole is export {
method !BACKREF-LATEST-CAPTURE($name) {
my $cur := self."!cursor_start_cur"();
my int $n := $!cstack ?? nqp::elems($!cstack) - 1 !! -1;
$n-- while $n >= 0 && (nqp::isnull_s(nqp::getattr_s($!cstack[$n], $?CLASS, '$!name')) ||
--$n while $n >= 0 && (nqp::isnull_s(nqp::getattr_s($!cstack[$n], $?CLASS, '$!name')) ||
nqp::getattr_s($!cstack[$n], $?CLASS, '$!name') ne $name);
if $n >= 0 {
my $subcur := $!cstack[$n];
......
......@@ -746,7 +746,7 @@ class QRegex::NFA {
}
$i := $i + 3;
}
$from++;
++$from;
}
$copy
......
......@@ -11,12 +11,12 @@ class QRegex::P5Regex::World is HLL::World {
# Tag it as a static code ref and add it to the root code refs set.
nqp::markcodestatic($dummy);
self.add_root_code_ref($dummy, $ast);
# Create code object.
my $code_obj := nqp::create(NQPRegex);
nqp::bindattr($code_obj, NQPRegex, '$!do', $dummy);
my $slot := self.add_object($code_obj);
# Add fixup of the code object and the $!do attribute.
my $fixups := QAST::Stmt.new();
$fixups.push(QAST::Op.new(
......@@ -56,18 +56,18 @@ grammar QRegex::P5Regex::Grammar is HLL::Grammar {
}
<alternation>
}
token rxstopper { $ }
token alternation {
<sequence>+ % '|'
}
token sequence {
<.ws> # XXX assuming old /x here?
<quantified_atom>*
}
token quantified_atom {
<![|)]>
<!rxstopper>
......@@ -75,7 +75,7 @@ grammar QRegex::P5Regex::Grammar is HLL::Grammar {
[ <.ws> <!before <.rxstopper> > <quantifier=p5quantifier> ]**0..1
<.ws>
}
token atom {
[
| \w
......@@ -85,7 +85,7 @@ grammar QRegex::P5Regex::Grammar is HLL::Grammar {
}
proto token p5metachar { <...> }
token p5metachar:sym<quant> {
<![(?]>
<quantifier=p5quantifier>
......@@ -109,7 +109,7 @@ grammar QRegex::P5Regex::Grammar is HLL::Grammar {
token p5metachar:sym<(?: )> { '(?:' {} <nibbler> ')' }
token p5metachar:sym<( )> { '(' {} <nibbler> ')' }
token p5metachar:sym<[ ]> { <?before '['> <cclass> }
token cclass {
:my $astfirst := 0;
'['
......@@ -121,7 +121,7 @@ grammar QRegex::P5Regex::Grammar is HLL::Grammar {
\s* '-' \s*
( '\\' <backslash=p5backslash> || (<-[\]\\]>) )
]**0..1
{ $astfirst++ }
{ ++$astfirst }
)+
']'
|| <.panic: "failed to parse character class; unescaped ']'?">
......@@ -129,7 +129,7 @@ grammar QRegex::P5Regex::Grammar is HLL::Grammar {
}
proto token p5backslash { <...> }
token p5backslash:sym<A> { <sym> }
token p5backslash:sym<b> { $<sym>=[<[bB]>] }
token p5backslash:sym<r> { <sym> }
......@@ -151,11 +151,11 @@ grammar QRegex::P5Regex::Grammar is HLL::Grammar {
token p5backslash:sym<oops> { <.panic: "Unrecognized Perl 5 regex backslash sequence"> }
proto token p5assertion { <...> }
token p5assertion:sym«<» { <sym> $<neg>=['='|'!'] [ <?before ')'> | <nibbler> ] }
token p5assertion:sym<=> { <sym> [ <?before ')'> | <nibbler> ] }
token p5assertion:sym<!> { <sym> [ <?before ')'> | <nibbler> ] }
token p5mod { <[imsox]>* }
token p5mods { <on=p5mod> [ '-' <off=p5mod> ]**0..1 }
token p5assertion:sym<mod> {
......@@ -172,17 +172,17 @@ grammar QRegex::P5Regex::Grammar is HLL::Grammar {
}
proto token p5quantifier { <...> }
token p5quantifier:sym<*> { <sym> <quantmod> }
token p5quantifier:sym<+> { <sym> <quantmod> }
token p5quantifier:sym<?> { <sym> <quantmod> }
token p5quantifier:sym<{ }> {
'{'
$<start>=[\d+]
'{'
$<start>=[\d+]
[ $<comma>=',' $<end>=[\d*] ]**0..1
'}' <quantmod>
}
token quantmod { [ '?' | '+' ]? }
token ws {
......
......@@ -174,7 +174,7 @@ class QRegex::P6Regex::Actions is HLL::Actions {
my $max := -1;
my $upto := $<upto>;
if $<from> eq '^' { $min++ }
if $<from> eq '^' { ++$min }
if ! $<max> {
$max := $min
......@@ -182,7 +182,7 @@ class QRegex::P6Regex::Actions is HLL::Actions {
elsif $<max> ne '*' {
$max := nqp::radix(10, $<max>, 0, 0)[0];
if $<upto> eq '^' {
$max--;
--$max;
}
$/.panic("Empty range") if $min > $max;
}
......@@ -646,7 +646,7 @@ class QRegex::P6Regex::Actions is HLL::Actions {
else {
$qast := QAST::Regex.new( $qast, $ast, :rxtype<alt>, :node($/));
}
$i++;
++$i;
}
make $qast;
}
......
......@@ -23,7 +23,7 @@ class QRegex::Optimizer {
my int $res := 0;
for $node {
return -1 if $node.rxtype ne $type;
$res++;
++$res;
}
return $res;
}
......@@ -142,7 +142,7 @@ class QRegex::Optimizer {
if nqp::isstr($node) {
return;
}
my int $i := 0;
my int $n := nqp::elems(@($node));
while $i < $n {
......
......@@ -6,7 +6,7 @@ my knowhow NQPRoutine {
has $!dispatch_order;
has $!clone_callback;
has int $!onlystar;
# Adds a multi-dispatch candidate.
method add_dispatchee($code) {
nqp::scwbdisable();
......@@ -15,31 +15,31 @@ my knowhow NQPRoutine {
nqp::push($!dispatchees, $code);
nqp::scwbenable();
}
# Checks if this code object is a dispatcher.
method is_dispatcher() {
nqp::defined($!dispatchees)
}
# Derives a new dispatcher.
method derive_dispatcher() {
# Clone the underlying VM code ref.
my $do := nqp::clone($!do);
# Clone and attach the code object.
my $der := nqp::clone(self);
nqp::bindattr($der, NQPRoutine, '$!do', $do);
nqp::bindattr($der, NQPRoutine, '$!dispatchees', nqp::clone($!dispatchees));
nqp::setcodeobj($do, $der);
# If needed, arrange for a fixup of the cloned code-ref.
unless nqp::isnull($!clone_callback) {
$!clone_callback($!do, $do, $der);
}
$der
}
# Checks if one type is narrower than the other.
sub is_narrower_type($a, $b) {
# If one of the types is null, then we know that's automatically
......@@ -48,7 +48,7 @@ my knowhow NQPRoutine {
elsif nqp::isnull($a) || nqp::isnull($b) { 0 }
else { nqp::istype($a, $b) }
}
# Sorts the dispatchees. Puts nulls between groups that are of equal weight.
# The most specific group comes first.
my int $SLURPY_ARITY := nqp::bitshiftl_i(1, 30);
......@@ -56,7 +56,7 @@ my knowhow NQPRoutine {
my int $EDGE_REMOVED := -2;
my int $DEFINED_ONLY := 1;
my int $UNDEFINED_ONLY := 2;
method sort_dispatchees() {
method sort_dispatchees() {
# Takes two candidates and determines if the first one is narrower than the
# second. Returns a true value if they are.
sub is_narrower(%a, %b) {
......@@ -81,15 +81,15 @@ my knowhow NQPRoutine {
my $type_obj_a := %a<types>[$i];
my $type_obj_b := %b<types>[$i];
if nqp::eqaddr($type_obj_a, $type_obj_b) {
$tied++;
++$tied;
}
elsif is_narrower_type($type_obj_a, $type_obj_b) {
$narrower++;
++$narrower;
}
elsif !is_narrower_type($type_obj_b, $type_obj_a) {
$tied++;
++$tied;
}
$i++;
++$i;
}
# If one is narrower than the other from current analysis, we're done.
......@@ -132,15 +132,15 @@ my knowhow NQPRoutine {
my int $j := 0;
while $j < $sig_elems {
# XXX TODO: Worry about optional and slurpy later.
%info<max_arity>++;
%info<min_arity>++;
++%info<max_arity>;
++%info<min_arity>;
# Record type info for this parameter. */
nqp::push(%info<types>, @types_list[$j]);
nqp::push(%info<definednesses>, @definedness_list[$j]);
%info<num_types>++;
$j++;
++%info<num_types>;
++$j;
}
# Add it to graph node, and initialize list of edges.
......@@ -151,7 +151,7 @@ my knowhow NQPRoutine {
'edges_out', 0
));
$i++;
++$i;
}
# Now analyze type narrowness of the candidates relative to each other
......@@ -163,13 +163,13 @@ my knowhow NQPRoutine {
if ($i != $j) {
if is_narrower(@graph[$i]<info>, @graph[$j]<info>) {
@graph[$i]<edges>[@graph[$i]<edges_out>] := @graph[$j];
@graph[$i]<edges_out>++;
@graph[$j]<edges_in>++;
++@graph[$i]<edges_out>;
++@graph[$j]<edges_in>;
}
}
$j++;
++$j;
}
$i++;
++$i;
}
# Perform the topological sort.
......@@ -185,10 +185,10 @@ my knowhow NQPRoutine {
if @graph[$i]<edges_in> == 0 {
# Add to results.
nqp::push(@result, @graph[$i]<info>);
$candidates_to_sort--;
--$candidates_to_sort;
@graph[$i]<edges_in> := $EDGE_REMOVAL_TODO;
}
$i++;
++$i;
}
if $rem_results == nqp::elems(@result) {
nqp::die("Circularity detected in multi sub types");
......@@ -201,24 +201,24 @@ my knowhow NQPRoutine {
if @graph[$i]<edges_in> == $EDGE_REMOVAL_TODO {
my int $j := 0;
while $j < @graph[$i]<edges_out> {
@graph[$i]<edges>[$j]<edges_in>--;
$j++;
--@graph[$i]<edges>[$j]<edges_in>;
++$j;
}
@graph[$i]<edges_in> := $EDGE_REMOVED;
}
$i++;
++$i;
}
# Add gap between groups.
nqp::push(@result, nqp::null());
}
# Add final null sentinel.
nqp::push(@result, nqp::null());
return @result;
}
method dispatch($capture) {
# Count arguments.
my int $num_args := nqp::captureposelems($capture);
......@@ -243,7 +243,7 @@ my knowhow NQPRoutine {
my $cur_candidate;
while 1 {
$cur_candidate := @candidates[$cur_idx];
if nqp::isnull($cur_candidate) {
# If we have some possible candidate(s), we're done in this loop.
if nqp::elems(@possibles) {
......@@ -251,8 +251,7 @@ my knowhow NQPRoutine {
}
# Otherwise, we keep looping and looking, unless we really hit the end.
$cur_idx++;
if nqp::isnull(@candidates[$cur_idx]) {
if nqp::isnull(@candidates[++$cur_idx]) {
last;
}
else {
......@@ -262,7 +261,7 @@ my knowhow NQPRoutine {
# Check if it's admissible by arity.
if $num_args < $cur_candidate<min_arity> || $num_args > $cur_candidate<max_arity> {
$cur_idx++;
++$cur_idx;
next;
}
......@@ -289,17 +288,17 @@ my knowhow NQPRoutine {
last;
}
}
$i++;
++$i;
}
if $type_mismatch {
$cur_idx++;
++$cur_idx;
next;
}
# If we get here, it's an admissible candidate; add to list. */
nqp::push(@possibles, $cur_candidate);
$cur_idx++;
++$cur_idx;
}
# Cache the result if there's a single chosen one and return it.
......@@ -319,32 +318,32 @@ my knowhow NQPRoutine {
nqp::die("Ambiguous dispatch to multi '" ~ self.name ~ "'.")
}
}
method clone() {
# Clone the underlying VM code ref.
my $do := nqp::clone($!do);
# Clone and attach the code object.
my $der := nqp::clone(self);
nqp::bindattr($der, NQPRoutine, '$!do', $do);
nqp::setcodeobj($do, $der);
# If needed, arrange for a fixup of the cloned code-ref.
unless nqp::isnull($!clone_callback) {
$!clone_callback($!do, $do, $der);
}
$der
}
method !set_name($name) {
nqp::setcodename($!do, $name);
}
method name() {
nqp::getcodename($!do)
}
method signature() { $!signature }
method gist() {
......@@ -426,17 +425,17 @@ my knowhow NQPRegex {
method clone() {
# Clone the underlying VM code ref.
my $do := nqp::clone($!do);
# Clone and attach the code object.
my $der := nqp::clone(self);
nqp::bindattr($der, NQPRegex, '$!do', $do);
nqp::setcodeobj($do, $der);
# If needed, arrange for a fixup of the cloned code-ref.
unless nqp::isnull($!clone_callback) {
$!clone_callback($!do, $do, $der);
}
$der
}
my $nfa_type;
......
......@@ -114,6 +114,12 @@ sub run-command($command, :$stdout, :$stderr) {
++$read-all2;
}
};
$config<error> := -> $err {
my $ex := nqp::newexception();
nqp::setmessage($ex, $err);
nqp::setpayload($ex, nqp::null());
nqp::throw($ex)
}
# define the task
my $task := nqp::spawnprocasync($queue, $command, nqp::cwd(),
......
......@@ -2396,7 +2396,7 @@ QAST::OperationsJAST.map_classlib_core_op('normalizecodes', $TYPE_OPS, 'normaliz
QAST::OperationsJAST.map_classlib_core_op('codes', $TYPE_OPS, 'codes', [$RT_STR], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('codepointfromname', $TYPE_OPS, 'codepointfromname', [$RT_STR], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('getstrfromname', $TYPE_OPS, 'getstrfromname', [$RT_STR], $RT_STR);
QAST::OperationsJAST.map_classlib_core_op('strfromname', $TYPE_OPS, 'strfromname', [$RT_STR], $RT_STR);
QAST::OperationsJAST.map_classlib_core_op('encode', $TYPE_OPS, 'encode', [$RT_STR, $RT_STR, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('encoderep', $TYPE_OPS, 'encoderep', [$RT_STR, $RT_STR, $RT_STR, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('decode', $TYPE_OPS, 'decode', [$RT_OBJ, $RT_STR], $RT_STR, :tc);
......@@ -2630,6 +2630,9 @@ QAST::OperationsJAST.map_classlib_core_op('unbox_s', $TYPE_OPS, 'unbox_s', [$RT_
QAST::OperationsJAST.map_classlib_core_op('box_i', $TYPE_OPS, 'box_i', [$RT_INT, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('box_n', $TYPE_OPS, 'box_n', [$RT_NUM, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('box_s', $TYPE_OPS, 'box_s', [$RT_STR, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('hllboxtype_i', $TYPE_OPS, 'hllboxtype_i', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('hllboxtype_n', $TYPE_OPS, 'hllboxtype_n', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('hllboxtype_s', $TYPE_OPS, 'hllboxtype_s', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('can', $TYPE_OPS, 'can', [$RT_OBJ, $RT_STR], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('reprname', $TYPE_OPS, 'reprname', [$RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('newtype', $TYPE_OPS, 'newtype', [$RT_OBJ, $RT_STR], $RT_OBJ, :tc);
......@@ -2663,6 +2666,7 @@ QAST::OperationsJAST.map_classlib_core_op('what_nd', $TYPE_OPS, 'what_nd', [$RT_
QAST::OperationsJAST.map_classlib_core_op('how_nd', $TYPE_OPS, 'how_nd', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('clone_nd', $TYPE_OPS, 'clone_nd', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('isconcrete_nd', $TYPE_OPS, 'isconcrete_nd', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('istype_nd', $TYPE_OPS, 'istype_nd', [$RT_OBJ, $RT_OBJ], $RT_INT, :tc);
# container related
QAST::OperationsJAST.map_classlib_core_op('setcontspec', $TYPE_OPS, 'setcontspec', [$RT_OBJ, $RT_STR, $RT_OBJ], $RT_OBJ, :tc);
......@@ -2672,6 +2676,10 @@ QAST::OperationsJAST.map_classlib_core_op('iscont_n', $TYPE_OPS, 'iscont_n', [$R
QAST::OperationsJAST.map_classlib_core_op('iscont_s', $TYPE_OPS, 'iscont_s', [$RT_OBJ], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('isrwcont', $TYPE_OPS, 'isrwcont', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('decont', $TYPE_OPS, 'decont', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.add_core_op('wantdecont', -> $qastcomp, $op {
# Currently, no optimization for this on JVM backend.
$qastcomp.as_jast($op[0])
});
QAST::OperationsJAST.map_classlib_core_op('decont_i', $TYPE_OPS, 'decont_i', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('decont_n', $TYPE_OPS, 'decont_n', [$RT_OBJ], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('decont_s', $TYPE_OPS, 'decont_s', [$RT_OBJ], $RT_STR, :tc);
......@@ -2806,6 +2814,8 @@ QAST::OperationsJAST.map_classlib_core_op('settypehll', $TYPE_OPS, 'settypehll',
QAST::OperationsJAST.map_classlib_core_op('settypehllrole', $TYPE_OPS, 'settypehllrole', [$RT_OBJ, $RT_INT], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('hllize', $TYPE_OPS, 'hllize', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('hllizefor', $TYPE_OPS, 'hllizefor', [$RT_OBJ, $RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('hllbool', $TYPE_OPS, 'hllbool', [$RT_INT], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('hllboolfor', $TYPE_OPS, 'hllboolfor', [$RT_INT, $RT_STR], $RT_OBJ, :tc);
# regex engine related opcodes
QAST::OperationsJAST.map_classlib_core_op('nfafromstatelist', $TYPE_OPS, 'nfafromstatelist', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
......@@ -2880,9 +2890,6 @@ QAST::OperationsJAST.map_classlib_core_op('continuationcontrol', $TYPE_OPS, 'con
QAST::OperationsJAST.map_classlib_core_op('continuationinvoke', $TYPE_OPS, 'continuationinvoke', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc, :cont);
# JVM interop ops
QAST::OperationsJAST.map_classlib_core_op('jvmeqaddr', $TYPE_OPS, 'jvmeqaddr', [$RT_OBJ, $RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('jvmisnull', $TYPE_OPS, 'jvmisnull', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('jvmbootinterop', $TYPE_OPS, 'jvmbootinterop', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('backendconfig', $TYPE_OPS, 'jvmgetconfig', [], $RT_OBJ, :tc);
# Native call ops
......@@ -2908,6 +2915,9 @@ 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);
QAST::OperationsJAST.map_classlib_core_op('coerce_si', $TYPE_OPS, 'coerce_si', [$RT_STR], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('coerce_is', $TYPE_OPS, 'coerce_is', [$RT_INT], $RT_STR, :tc);
class QAST::CompilerJAST {
# Responsible for handling issues around code references, building the
# switch statement dispatcher, etc.
......
......@@ -91,10 +91,10 @@ public class AsyncServerSocketHandle implements IIOBindable, IIOCancelable {
result.push_boxed(curTC, task.schedulee);
result.push_boxed(curTC, ioHandle);
result.push_boxed(curTC, Null);
result.push_boxed(curTC, Ops.box_s(socketHost, Str, curTC));
result.push_boxed(curTC, Ops.box_i(socketPort, Int, curTC));
result.push_boxed(curTC, Ops.box_s(peerHost, Str, curTC));
result.push_boxed(curTC, Ops.box_i(peerPort, Int, curTC));
result.push_boxed(curTC, Ops.box_s(socketHost, Str, curTC));
result.push_boxed(curTC, Ops.box_i(socketPort, Int, curTC));
((ConcBlockingQueueInstance) task.queue).push_boxed(curTC, result);
}
......@@ -106,9 +106,50 @@ public class AsyncServerSocketHandle implements IIOBindable, IIOCancelable {
result.push_boxed(curTC, task.schedulee);
result.push_boxed(curTC, IOType);
result.push_boxed(curTC, Ops.box_s(exc.toString(), Str, curTC));
result.push_boxed(curTC, Str);
result.push_boxed(curTC, Int);
result.push_boxed(curTC, Str);
result.push_boxed(curTC, Int);
}
};
try {
InetSocketAddress localAddress;
HLLConfig hllConfig = tc.curFrame.codeRef.staticInfo.compUnit.hllConfig;
final SixModelObject IOType = hllConfig.ioType;
final SixModelObject Array = hllConfig.listType;
final SixModelObject Null = hllConfig.nullValue;
final SixModelObject Int = hllConfig.intBoxType;
final SixModelObject Str = hllConfig.strBoxType;
try {
localAddress = (InetSocketAddress) listenChan.getLocalAddress();
} catch (IOException e) {
throw ExceptionHandling.dieInternal(tc, e);
}
String socketHost = localAddress.getAddress().getHostAddress();
if (socketHost.equals("0:0:0:0:0:0:0:1"))
socketHost = "::1";
int socketPort = localAddress.getPort();
SixModelObject result = Array.st.REPR.allocate(tc, Array.st);
result.push_boxed(tc, task.schedulee);
result.push_boxed(tc, IOType);
result.push_boxed(tc, Null);
result.push_boxed(tc, Str);
result.push_boxed(tc, Int);
result.push_boxed(tc, Ops.box_s(socketHost, Str, tc));
result.push_boxed(tc, Ops.box_i(socketPort, Int, tc));
((ConcBlockingQueueInstance) task.queue).push_boxed(tc, result);
}
catch (Exception e) {
throw ExceptionHandling.dieInternal(tc, e);
}
try {
listenChan.accept(task, handler);
} catch (NotYetBoundException e) {
......
......@@ -75,6 +75,9 @@ public class HLLConfig {
public SixModelObject foreignTypeStr;
public SixModelObject nullValue;
public SixModelObject trueValue;
public SixModelObject falseValue;
/**
* HLL interop mappers.
*/
......
......@@ -45,6 +45,14 @@ public abstract class SixModelObject implements Cloneable {
String name, long hint) {
throw ExceptionHandling.dieInternal(tc, this.st.REPR.name + " representation does not support attributes");
}
public SixModelObject cas_attribute_boxed(ThreadContext tc,SixModelObject class_handle,
String name, SixModelObject expected, SixModelObject value) {
throw ExceptionHandling.dieInternal(tc, this.st.REPR.name + " representation does not support cas of attributes");
}
public void atomic_bind_attribute_boxed(ThreadContext tc,SixModelObject class_handle,
String name, SixModelObject value) {
throw ExceptionHandling.dieInternal(tc, this.st.REPR.name + " representation does not support atomic binding to attributes");
}
/**
* Boxing related functions.
......
......@@ -5,6 +5,9 @@ import org.perl6.nqp.sixmodel.SerializationReader;
import org.perl6.nqp.sixmodel.SixModelObject;
import org.perl6.nqp.sixmodel.TypeObject;
import java.lang.reflect.Field;
import sun.misc.Unsafe;
public class P6OpaqueBaseInstance extends SixModelObject {
// If this is not null, all operations are delegate to it. Used when we
// load the object from an SC or when we mix in and it causes a resize.
......@@ -106,6 +109,51 @@ public class P6OpaqueBaseInstance extends SixModelObject {
return super.is_attribute_initialized(tc, class_handle, name, hint);
}
private Unsafe unsafe;
private long scalarValueOffset;
@SuppressWarnings("restriction")
private void ensureAtomicsReady() {
if (unsafe == null) {
try {
Field unsafeField = Unsafe.class.getDeclaredField("theUnsafe");
unsafeField.setAccessible(true);
unsafe = (Unsafe)unsafeField.get(null);
}
catch (Exception e) {
throw new RuntimeException(e);
}
}
}
public SixModelObject cas_attribute_boxed(ThreadContext tc,SixModelObject class_handle,
String name, SixModelObject expected, SixModelObject value) {
ensureAtomicsReady();
try {
long offset = unsafe.objectFieldOffset(this.getClass().getDeclaredField(
"field_" + resolveAttribute(class_handle, name)));
return unsafe.compareAndSwapObject(this, offset, expected, value)
? expected
: (SixModelObject)unsafe.getObjectVolatile(this, offset);
}
catch (Exception e) {
throw new RuntimeException(e);
}
}
public void atomic_bind_attribute_boxed(ThreadContext tc,SixModelObject class_handle,
String name, SixModelObject value) {
ensureAtomicsReady();
try {
long offset = unsafe.objectFieldOffset(this.getClass().getDeclaredField(
"field_" + resolveAttribute(class_handle, name)));
unsafe.putObjectVolatile(this, offset, value);
}
catch (Exception e) {
throw new RuntimeException(e);
}
}
public SixModelObject posDelegate() {
if (this.delegate != null)
return ((P6OpaqueBaseInstance)this.delegate).posDelegate();
......
......@@ -117,6 +117,8 @@ class HLL::Backend::MoarVM {
my $id_remap := nqp::hash();
my $id_to_thing := nqp::hash();
my %type-info := nqp::hash();
sub post_process_call_graph_node($node) {
try {
if nqp::existskey($id_remap, $node<id>) {
......@@ -128,6 +130,7 @@ class HLL::Backend::MoarVM {
}
if nqp::existskey($node, "allocations") {
for $node<allocations> -> %alloc_info {
my $orig-id := %alloc_info<id>;
if nqp::existskey($id_remap, %alloc_info<id>) {
%alloc_info<id> := $id_remap{%alloc_info<id>};
} else {
......@@ -137,14 +140,31 @@ class HLL::Backend::MoarVM {
}
unless nqp::existskey($id_to_thing, %alloc_info<id>) {
my $typename;
my $scdesc;
try {
my $type := %alloc_info<type>;
my $type := %type-info{$orig-id}[1]<type>;
$typename := $type.HOW.name($type);
}
unless $typename {
$typename := "<unknown type>";
}
try {
my $type := %type-info{$orig-id}[1]<type>;
my $sc := nqp::getobjsc($type);
if $sc {
$scdesc := nqp::scgetdesc($sc);
}
}
unless $scdesc {
$scdesc := "";
}
%type-info{$orig-id}[1]<typename> := $typename;
%type-info{$orig-id}[1]<scdesc> := $scdesc;
$id_to_thing{%alloc_info<id>} := $typename;
unless nqp::existskey(%type-info, %alloc_info<id>) {
nqp::bindkey(%type-info, %alloc_info<id>, nqp::list());
}
%type-info{%alloc_info<id>}[1] := %type-info{$orig-id}[1];
}
nqp::deletekey(%alloc_info, "type");
}
......@@ -233,6 +253,77 @@ class HLL::Backend::MoarVM {
}
}
sub to_sql_json($obj, $pieces?) {
my $will-return := !nqp::isconcrete($pieces);
unless nqp::isconcrete($obj) {
if $will-return {
return "null";
}
nqp::push_s($pieces, "null");
return;
}
unless nqp::isconcrete($pieces) {
$pieces := nqp::list_s;
}
if nqp::islist($obj) {
nqp::push_s($pieces, 'json_array(');
my int $first := 1;
for $obj {
if $first {
$first := 0;
}
else {
nqp::push_s($pieces, ',');
}
to_sql_json($_, $pieces);
}
nqp::push_s($pieces, ')');
}
elsif nqp::ishash($obj) {
nqp::push_s($pieces, 'json_object(');
my int $first := 1;
for sorted_keys($obj) {
if $first {
$first := 0;
}
else {
nqp::push_s($pieces, ',');
}
nqp::push_s($pieces, "'");
nqp::push_s($pieces, $_);
nqp::push_s($pieces, "', ");
to_sql_json($obj{$_}, $pieces);
}
nqp::push_s($pieces, ')');
}
elsif nqp::isstr($obj) {
if nqp::index($obj, '\\') {
$obj := literal_subst($obj, '\\', '\\\\');
}
if nqp::index($obj, '"') {
$obj := literal_subst($obj, '"', '\\"');
}
if nqp::index($obj, "'") {
$obj := literal_subst($obj, "'", "\\'");
}
nqp::push_s($pieces, "'");
nqp::push_s($pieces, $obj);
nqp::push_s($pieces, "'");
}
elsif nqp::isint($obj) || nqp::isnum($obj) {
nqp::push_s($pieces, ~$obj);
}
elsif nqp::can($obj, 'Str') {
to_sql_json(nqp::unbox_s($obj.Str), $pieces);
}
else {
nqp::push_s($pieces, 'null');
}
if $will-return {
return nqp::join("", $pieces);
}
}
sub to_sql($obj) {
my int $node_id := 0;
#my %profile := nqp::hash();
......@@ -253,13 +344,19 @@ class HLL::Backend::MoarVM {
~ "');\n");
}
else {
my $type-info := %type-info{nqp::iterkey_s($k)};
nqp::push_s($pieces, "INSERT INTO types VALUES ('");
nqp::push_s($pieces,
nqp::join("','",
nqp::list(
nqp::iterkey_s($k),
literal_subst(~$v, "'", "''")))
~ "');\n");
nqp::list_s(
$k,
literal_subst(~$v, "'", "''"),
))
~ "',"
~ to_sql_json($type-info[1])
~ ","
~ "json_object()"
~ ");\n");
}
if nqp::elems($pieces) > 500 {
$profile_fh.say(nqp::join("", $pieces));
......@@ -342,6 +439,17 @@ class HLL::Backend::MoarVM {
nqp::splice($pieces, $empty-array, 0, nqp::elems($pieces));
}
# The actual first entry in the profile data is an array that
# stores type information as a list of hashes with a "key"
# key.
{
my @type-infos := nqp::shift($data);
for @type-infos {
%type-info{$_[0]} := $_
}
}
# Post-process the call data, turning objects into flat data.
for $data {
if nqp::existskey($_, "call_graph") {
......@@ -382,7 +490,7 @@ class HLL::Backend::MoarVM {
}
elsif $want_sql {
$profile_fh.say('BEGIN;');
$profile_fh.say('CREATE TABLE types(id INTEGER PRIMARY KEY ASC, name TEXT);');
$profile_fh.say('CREATE TABLE types(id INTEGER PRIMARY KEY ASC, name TEXT, extra_info JSON, type_links JSON);');
$profile_fh.say('CREATE TABLE routines(id INTEGER PRIMARY KEY ASC, name TEXT, line INT, file TEXT);');
$profile_fh.say('CREATE TABLE gcs(time INT, retained_bytes INT, promoted_bytes INT, gen2_roots INT, full INT, responsible INT, cleared_bytes INT, start_time INT, sequence_num INT, thread_id INT);');
$profile_fh.say('CREATE TABLE calls(id INTEGER PRIMARY KEY ASC, parent_id INT, routine_id INT, osr INT, spesh_entries INT, jit_entries INT, inlined_entries INT, inclusive_time INT, exclusive_time INT, entries INT, deopt_one INT, deopt_all INT, rec_depth INT, FOREIGN KEY(routine_id) REFERENCES routines(id));');
......
......@@ -518,6 +518,9 @@ my class MASTCompilerInstance {
elsif $got == $MVM_reg_void {
push_op($il, 'const_s', $res_reg, MAST::SVal.new( :value('') ));
}
elsif $got == $MVM_reg_uint64 {
push_op($il, 'coerce_us', $res_reg, $reg);
}
else {
nqp::die("Unknown coercion case for str; got: "~$got);
}
......
This diff is collapsed.
#! nqp
#!/usr/bin/env nqp
say("1..0 # Skipped: design changes, need re-work");
#use NQPHLL;
#
#plan(2);
#
#ok( nqp::getcomp('parrot') ~~ HLL::Compiler, 'compreg for Parrot returns a HLL::Compiler' );
#ok( nqp::getcomp('parrot').language eq 'parrot', '.language gives "parrot"' );
use NQPHLL;
plan(2);
ok( nqp::getcomp('nqp') ~~ HLL::Compiler, 'compreg for NQP returns a HLL::Compiler' );
ok( nqp::getcomp('nqp').language eq 'nqp', '.language gives "nqp"' );
......@@ -8,5 +8,5 @@ ok($square(4) == 16, "passing integers to a js func");
my $twice := $comp.eval('(function(func) {return function(x) {return func(func(x))}})');
my $twiced := $twice(sub ($x) {"[$x]"})("abc");