Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Get PRE/POST support mostly in place.

  • Loading branch information...
commit d4ffd7c21e7bed97eeeec3502299da0d1276abd4 1 parent a8ca889
@jnthn jnthn authored
View
12 src/Perl6/Metamodel/BOOTSTRAP.nqp
@@ -1897,7 +1897,7 @@ nqp::sethllconfig('perl6', nqp::hash(
'exit_handler', -> $coderef, $resultish {
my $code := nqp::getcodeobj($coderef);
my %phasers := nqp::getattr($code, Block, '$!phasers');
- unless nqp::isnull(%phasers) {
+ unless nqp::isnull(%phasers) || nqp::p6inpre() {
my @leaves := nqp::atkey(%phasers, '!LEAVE-ORDER');
my @keeps := nqp::atkey(%phasers, 'KEEP');
my @undos := nqp::atkey(%phasers, 'UNDO');
@@ -1935,6 +1935,16 @@ nqp::sethllconfig('perl6', nqp::hash(
$i++;
}
}
+
+ my @posts := nqp::atkey(%phasers, 'POST');
+ unless nqp::isnull(@posts) {
+ my int $n := nqp::elems(@posts);
+ my int $i := 0;
+ while $i < $n {
+ nqp::atpos(@posts, $i)(nqp::isnull($resultish, Mu));
+ $i++;
+ }
+ }
}
}
));
View
1  src/Perl6/World.nqp
@@ -1750,6 +1750,7 @@ class Perl6::World is HLL::World {
if $phaser eq 'POST' {
# Needs $_ that can be set to the return value.
+ $phaser_past.custom_args(1);
$phaser_past[0].unshift(QAST::Op.new( :op('p6bindsig') ));
if $phaser_past.symbol('$_') {
for @($phaser_past[0]) {
View
2  src/vm/jvm/Perl6/Ops.nqp
@@ -75,6 +75,7 @@ $ops.map_classlib_hll_op('perl6', 'p6bindassert', $TYPE_P6OPS, 'p6bindassert', [
$ops.map_classlib_hll_op('perl6', 'p6stateinit', $TYPE_P6OPS, 'p6stateinit', [], $RT_INT, :tc);
$ops.map_classlib_hll_op('perl6', 'p6setpre', $TYPE_P6OPS, 'p6setpre', [], $RT_OBJ, :tc);
$ops.map_classlib_hll_op('perl6', 'p6clearpre', $TYPE_P6OPS, 'p6clearpre', [], $RT_OBJ, :tc);
+$ops.map_classlib_hll_op('perl6', 'p6inpre', $TYPE_P6OPS, 'p6inpre', [], $RT_INT, :tc);
$ops.map_classlib_hll_op('perl6', 'p6setfirstflag', $TYPE_P6OPS, 'p6setfirstflag', [$RT_OBJ], $RT_OBJ, :tc);
$ops.map_classlib_hll_op('perl6', 'p6takefirstflag', $TYPE_P6OPS, 'p6takefirstflag', [], $RT_INT, :tc);
$ops.add_hll_op('perl6', 'p6return', -> $qastcomp, $op {
@@ -167,6 +168,7 @@ $ops.map_classlib_hll_op('nqp', 'p6var', $TYPE_P6OPS, 'p6var', [$RT_OBJ], $RT_OB
$ops.map_classlib_hll_op('nqp', 'p6parcel', $TYPE_P6OPS, 'p6parcel', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
$ops.map_classlib_hll_op('nqp', 'p6isbindable', $TYPE_P6OPS, 'p6isbindable', [$RT_OBJ, $RT_OBJ], $RT_INT, :tc);
$ops.map_classlib_hll_op('nqp', 'p6trialbind', $TYPE_P6OPS, 'p6trialbind', [$RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_INT, :tc);
+$ops.map_classlib_hll_op('nqp', 'p6inpre', $TYPE_P6OPS, 'p6inpre', [], $RT_INT, :tc);
# Override defor to call defined method.
QAST::OperationsJAST.add_hll_op('perl6', 'defor', -> $qastcomp, $op {
View
19 src/vm/jvm/runtime/org/perl6/rakudo/RakOps.java
@@ -1,5 +1,6 @@
package org.perl6.rakudo;
+import java.util.ArrayList;
import java.util.Arrays;
import java.util.Calendar;
import java.util.Comparator;
@@ -18,6 +19,7 @@
public static class ThreadExt {
public SixModelObject firstPhaserCodeBlock;
+ public ArrayList<CallFrame> prePhaserFrames = new ArrayList<CallFrame>();
public ThreadExt(ThreadContext tc) { }
}
@@ -653,6 +655,23 @@ public static long p6takefirstflag(ThreadContext tc) {
return matches ? 1 : 0;
}
+ public static SixModelObject p6setpre(ThreadContext tc) {
+ ThreadExt tcx = key.getTC(tc);
+ tcx.prePhaserFrames.add(tc.curFrame);
+ return null;
+ }
+
+ public static SixModelObject p6clearpre(ThreadContext tc) {
+ ThreadExt tcx = key.getTC(tc);
+ tcx.prePhaserFrames.remove(tc.curFrame);
+ return null;
+ }
+
+ public static long p6inpre(ThreadContext tc) {
+ ThreadExt tcx = key.getTC(tc);
+ return tcx.prePhaserFrames.remove(tc.curFrame.caller) ? 1 : 0;
+ }
+
private static final CallSiteDescriptor dispVivifier = new CallSiteDescriptor(
new byte[] { CallSiteDescriptor.ARG_OBJ, CallSiteDescriptor.ARG_OBJ,
CallSiteDescriptor.ARG_OBJ, CallSiteDescriptor.ARG_OBJ }, null);
Please sign in to comment.
Something went wrong with that request. Please try again.