Permalink
Browse files

Redo MapIter with nqp ops; handle next/last/redo.

This tosses the JVM specific version with something generic, which
means it can be re-used for MoarVM later on too. pmichaud++ for the
suggestion to do it this way.
  • Loading branch information...
1 parent a0d138a commit 8506c14cff3c0e444e13a9a6b0711774f818cf48 @jnthn jnthn committed Jun 20, 2013
Showing with 35 additions and 218 deletions.
  1. +32 −2 src/core/MapIter.pm
  2. +3 −216 src/vm/jvm/Perl6/Ops.nqp
View
@@ -122,8 +122,38 @@ my class MapIter is Iterator {
};
#?endif
#?if !parrot
- nqp::p6mapiter(MapIter, $!items, $rpa, nqp::unbox_i($argc),
- nqp::unbox_i($count), self, $block);
+ my int $state = 1;
+ my int $itmp;
+ my Mu $args := nqp::list();
+ nqp::while(($state && nqp::elems($rpa) < $count), nqp::handle(
+ nqp::stmts(
+ nqp::if(nqp::iseq_i($state, 1), nqp::stmts(
+ ($itmp = nqp::elems($!items)),
+ nqp::unless($itmp >= $argc, nqp::stmts(
+ ($itmp = $argc - $itmp),
+ nqp::if($!listiter, $!listiter.reify($itmp))
+ )),
+ nqp::setelems($args, 0),
+ nqp::p6shiftpush($args, $!items, $argc),
+ nqp::if($args, $state = 2, $state = 0)
+ )),
+ nqp::if(nqp::iseq_i($state, 2), nqp::stmts(
+ nqp::push($rpa, nqp::p6invokeflat($block, $args)),
+ $state = 3
+ )),
+ nqp::if(nqp::iseq_i($state, 3), nqp::stmts(
+ nqp::if($NEXT, $block.fire_phasers('NEXT')),
+ ($state = 1)
+ ))
+ ),
+ 'LAST', nqp::stmts(
+ ($!items := Any),
+ ($!listiter := Any),
+ ($state = 0)
+ ),
+ 'REDO', $state = 2,
+ 'NEXT', $state = 3
+ ));
#?endif
if $!items || $!listiter {
View
@@ -129,222 +129,9 @@ $ops.add_hll_op('perl6', 'p6handletake', -> $qastcomp, $op {
$qastcomp.as_jast(QAST::Op.new( :op('handle'), $op[0], 'TAKE', $op[1]));
});
-# MapIter core.
-$ops.add_hll_op('perl6', 'p6mapiter', -> $qastcomp, $op {
- # Create labels.
- my $map_id := $qastcomp.unique('map');
- my $loop_lbl := JAST::Label.new( :name($map_id ~ '_loop') );
- my $done_lbl := JAST::Label.new( :name($map_id ~ '_done') );
- my $redo_lbl := JAST::Label.new( :name($map_id ~ '_redo') );
-
- # Produce handlers.
- #my $l_handler_id := &*REGISTER_UNWIND_HANDLER($*HANDLER_IDX, $EX_CAT_LAST);
- #my $nr_handler_id := &*REGISTER_UNWIND_HANDLER($l_handler_id, $EX_CAT_NEXT + $EX_CAT_REDO);
-
- # Initialize.
- my $il := JAST::InstructionList.new();
- my $initres := $qastcomp.as_jast(:want($RT_VOID),
- QAST::Stmts.new(
- QAST::Op.new(
- :op('bind'),
- QAST::Var.new( :name('MapIter'), :scope('local'), :decl('var') ),
- $op[0]
- ),
- QAST::Op.new(
- :op('bind'),
- QAST::Var.new( :name('items'), :scope('local'), :decl('var') ),
- $op[1]
- ),
- QAST::Op.new(
- :op('bind'),
- QAST::Var.new( :name('rpa'), :scope('local'), :decl('var') ),
- $op[2]
- ),
- QAST::Op.new(
- :op('bind'),
- QAST::Var.new( :name('argc'), :scope('local'), :decl('var'), :returns(int) ),
- $op[3]
- ),
- QAST::Op.new(
- :op('bind'),
- QAST::Var.new( :name('count'), :scope('local'), :decl('var'), :returns(int) ),
- $op[4]
- ),
- QAST::Op.new(
- :op('bind'),
- QAST::Var.new( :name('self'), :scope('local'), :decl('var') ),
- $op[5]
- ),
- QAST::Op.new(
- :op('bind'),
- QAST::Var.new( :name('block'), :scope('local'), :decl('var') ),
- $op[6]
- ),
- QAST::Op.new(
- :op('bind'),
- QAST::Var.new( :name('args'), :scope('local'), :decl('var') ),
- QAST::Op.new( :op('list') )
- )
- ));
- $il.append($initres.jast);
- $*STACK.obtain($il, $initres);
-
-# .local int NEXT, is_sink
-# .local pmc handler, result
-# handler = root_new ['parrot';'ExceptionHandler']
-# NEXT = find_lex '$NEXT'
-# is_sink = find_lex '$is_sink'
-#
-# set_addr handler, catch
-# handler.'handle_types'(.CONTROL_LOOP_LAST, .CONTROL_LOOP_NEXT, .CONTROL_LOOP_REDO)
-# push_eh handler
-
-# iter_loop:
- $il.append($loop_lbl);
-
-# $I0 = elements rpa
-# unless $I0 < count goto iter_done
- my $rpaelemsres := $qastcomp.as_jast(:want($RT_INT),
- QAST::Op.new(
- :op('islt_i'),
- QAST::Op.new(
- :op('elems'),
- QAST::Var.new( :name('rpa'), :scope('local') )
- ),
- QAST::Var.new( :name('count'), :scope('local') )));
- $il.append($rpaelemsres.jast);
- $*STACK.obtain($il, $rpaelemsres);
- $il.append(JAST::Instruction.new( :op('l2i') ));
- $il.append(JAST::Instruction.new( :op('ifeq'), $done_lbl ));
-
-# $I0 = elements items
-# if $I0 >= argc goto have_items
-# $I0 = argc - $I0
-# $P0 = getattribute self, MapIter, '$!listiter'
-# unless $P0 goto have_items
-# $P0.'reify'($I0)
-# have_items:
- my $itemsres := $qastcomp.as_jast(:want($RT_VOID),
- QAST::Stmts.new(
- QAST::Op.new(
- :op('bind'),
- QAST::Var.new( :name('itmp'), :scope('local'), :decl('var') ),
- QAST::Op.new(
- :op('elems'),
- QAST::Var.new( :name('items'), :scope('local') )
- )),
- QAST::Op.new(
- :op('unless'),
- QAST::Op.new(
- :op('isge_i'),
- QAST::Var.new( :name('itmp'), :scope('local') ),
- QAST::Var.new( :name('argc'), :scope('local') )
- ),
- QAST::Stmts.new(
- QAST::Op.new(
- :op('bind'),
- QAST::Var.new( :name('itmp'), :scope('local') ),
- QAST::Op.new(
- :op('sub_i'),
- QAST::Var.new( :name('argc'), :scope('local') ),
- QAST::Var.new( :name('itmp'), :scope('local') )
- )),
- QAST::Op.new(
- :op('bind'),
- QAST::Var.new( :name('otmp'), :scope('local'), :decl('var') ),
- QAST::Var.new(
- :name('$!listiter'), :scope('attribute'),
- QAST::Var.new( :name('self'), :scope('local') ),
- QAST::Var.new( :name('MapIter'), :scope('local') )
- )),
- QAST::Op.new(
- :op('if'),
- QAST::Var.new( :name('otmp'), :scope('local') ),
- QAST::Op.new(
- :op('callmethod'), :name('reify'),
- QAST::Var.new( :name('otmp'), :scope('local') ),
- QAST::Var.new( :name('itmp'), :scope('local') )
- )))
- )));
- $il.append($itemsres.jast);
- $*STACK.obtain($il, $itemsres);
-
-# args = 0
-# perl6_shiftpush args, items, argc
-# unless args goto iter_done
- my $argres := $qastcomp.as_jast(:want($RT_INT),
- QAST::Stmts.new(
- QAST::Op.new(
- :op('setelems'),
- QAST::Var.new( :name('args'), :scope('local') ),
- QAST::IVal.new( :value(0) )
- ),
- QAST::Op.new(
- :op('istrue'),
- QAST::Op.new(
- :op('p6shiftpush'),
- QAST::Var.new( :name('args'), :scope('local') ),
- QAST::Var.new( :name('items'), :scope('local') ),
- QAST::Var.new( :name('argc'), :scope('local') )
- ))));
- $il.append($argres.jast);
- $*STACK.obtain($il, $argres);
- $il.append(JAST::Instruction.new( :op('l2i') ));
- $il.append(JAST::Instruction.new( :op('ifeq'), $done_lbl ));
-
-# redo:
- $il.append($redo_lbl);
-# result = block(args :flat)
-# if is_sink goto sink_result
-# push rpa, result
-# goto next
- my $invres := $qastcomp.as_jast(:want($RT_VOID),
- QAST::Op.new(
- :op('push'),
- QAST::Var.new( :name('rpa'), :scope('local') ),
- QAST::Op.new(
- :op('call'),
- QAST::Var.new( :name('block'), :scope('local') ),
- QAST::Var.new( :name('args'), :scope('local'), :flat(1) )
- )));
- $il.append($invres.jast);
- $*STACK.obtain($il, $invres);
- $il.append(JAST::Instruction.new( :op('goto'), $loop_lbl ));
-
-# sink_result:
-# $I0 = repr_defined result
-# unless $I0 goto next
-# $I0 = can result, 'sink'
-# unless $I0 goto next
-# $I0 = defined result
-# unless $I0 goto next
-# result.'sink'()
-# goto next
-# catch:
-# .local pmc exception, type
-# .get_results (exception)
-# null $P0
-# perl6_invoke_catchhandler $P0, exception
-# result = getattribute exception, 'payload'
-# push rpa, result
-# type = getattribute exception, 'type'
-# if type == .CONTROL_LOOP_REDO goto redo
-# if type == .CONTROL_LOOP_LAST goto last
-# next:
-# unless NEXT goto iter_loop
-# block.'fire_phasers'('NEXT')
-# goto iter_loop
-# last:
-# $P0 = find_lex 'Any'
-# setattribute self, MapIter, '$!items', $P0
-# setattribute self, MapIter, '$!listiter', $P0
-
-# iter_done:
- $il.append($done_lbl);
-# pop_eh
-
- $il.append(JAST::Instruction.new( :op('aconst_null') ));
- $ops.result($il, $RT_OBJ);
+$ops.add_hll_op('perl6', 'p6invokeflat', -> $qastcomp, $op {
+ $op[1].flat(1);
+ $qastcomp.as_jast(QAST::Op.new( :op('call'), $op[0], $op[1]));
});
# Make some of them also available from NQP land, since we use them in the

0 comments on commit 8506c14

Please sign in to comment.