Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Start porting the core of MapIter. 
It was a blob of PIR. This does it mostly with QAST trees. Not yet
complete; missing control exception handling and sink stuff. Works for
the basic cases, though.
  • Loading branch information
@jnthn
jnthn committed Jun 12, 2013
1 parent 978aeee commit 76de8c7
Show file tree
Hide file tree
Showing 2 changed files with 225 additions and 1 deletion.
3 changes: 2 additions & 1 deletion src/core/MapIter.pm
View file
Expand Up @@ -122,7 +122,8 @@ my class MapIter is Iterator {
};
#?endif
#?if !parrot
die "MapIter NYI on JVM backend";
nqp::p6mapiter(MapIter, $!items, $rpa, nqp::unbox_i($argc),
nqp::unbox_i($count), self, $block);
#?endif

if $!items || $!listiter {
Expand Down
223 changes: 223 additions & 0 deletions src/vm/jvm/Perl6/Ops.nqp
View file
Expand Up @@ -13,6 +13,11 @@ my $TYPE_TC := 'Lorg/perl6/nqp/runtime/ThreadContext;';
my $TYPE_STR := 'Ljava/lang/String;';
my $TYPE_OBJ := 'Ljava/lang/Object;';

# Exception categories.
my $EX_CAT_NEXT := 4;
my $EX_CAT_REDO := 8;
my $EX_CAT_LAST := 16;

# Opcode types.
my $RT_OBJ := 0;
my $RT_INT := 1;
Expand Down Expand Up @@ -120,6 +125,224 @@ my $p6bool := -> $qastcomp, $op {
};
$ops.add_hll_op('perl6', 'p6bool', $p6bool);

# 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);
});

# Make some of them also available from NQP land, since we use them in the
# metamodel and bootstrap.
$ops.add_hll_op('nqp', 'p6bool', $p6bool);
Expand Down

0 comments on commit 76de8c7

Please sign in to comment.