Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

4780 lines (4345 sloc) 225.073 kB
use JASTNodes;
use QASTNode;
# Should we try handling all the SC stuff?
my $ENABLE_SC_COMP := 1;
# Some common types we'll need.
my $TYPE_TC := 'Lorg/perl6/nqp/runtime/ThreadContext;';
my $TYPE_CU := 'Lorg/perl6/nqp/runtime/CompilationUnit;';
my $TYPE_CR := 'Lorg/perl6/nqp/runtime/CodeRef;';
my $TYPE_CF := 'Lorg/perl6/nqp/runtime/CallFrame;';
my $TYPE_OPS := 'Lorg/perl6/nqp/runtime/Ops;';
my $TYPE_CSD := 'Lorg/perl6/nqp/runtime/CallSiteDescriptor;';
my $TYPE_SMO := 'Lorg/perl6/nqp/sixmodel/SixModelObject;';
my $TYPE_STR := 'Ljava/lang/String;';
my $TYPE_OBJ := 'Ljava/lang/Object;';
my $TYPE_MATH := 'Ljava/lang/Math;';
my $TYPE_MH := 'Ljava/lang/invoke/MethodHandle;';
my $TYPE_MT := 'Ljava/lang/invoke/MethodType;';
my $TYPE_MHS := 'Ljava/lang/invoke/MethodHandles;';
my $TYPE_MHL := 'Ljava/lang/invoke/MethodHandles$Lookup;';
my $TYPE_CLASS := 'Ljava/lang/Class;';
my $TYPE_LONG := 'Ljava/lang/Long;';
my $TYPE_DOUBLE := 'Ljava/lang/Double;';
my $TYPE_EH := 'Lorg/perl6/nqp/runtime/ExceptionHandling;';
my $TYPE_EX_LEX := 'Lorg/perl6/nqp/runtime/LexoticException;';
my $TYPE_EX_UNWIND := 'Lorg/perl6/nqp/runtime/UnwindException;';
my $TYPE_EX_CONT := 'Lorg/perl6/nqp/runtime/ControlException;';
my $TYPE_EX_RT := 'Ljava/lang/RuntimeException;';
my $TYPE_THROWABLE := 'Ljava/lang/Throwable;';
# Exception handler categories.
my $EX_CAT_CATCH := 1;
my $EX_CAT_CONTROL := 2;
my $EX_CAT_NEXT := 4;
my $EX_CAT_REDO := 8;
my $EX_CAT_LAST := 16;
# Exception handler kinds.
my $EX_UNWIND_SIMPLE := 0;
my $EX_UNWIND_OBJECT := 1;
my $EX_BLOCK := 2;
# Represents the result of turning some QAST into JAST. That includes any
# instructions, but also some metadata that goes with them.
my $RT_OBJ := 0;
my $RT_INT := 1;
my $RT_NUM := 2;
my $RT_STR := 3;
my $RT_VOID := -1;
my class Result {
has $!jast; # The JAST
has int $!type; # Result type (obj/int/num/str)
has str $!local; # Local where the result is; if empty, it's on the stack
method jast() { $!jast }
method type() { $!type }
method local() { $!local }
method set_local($local) { $!local := $local }
}
sub result($jast, int $type) {
my $r := nqp::create(Result);
nqp::bindattr($r, Result, '$!jast', $jast);
nqp::bindattr_i($r, Result, '$!type', $type);
nqp::bindattr_s($r, Result, '$!local', '');
$*STACK.push($r);
$r
}
my @jtypes := [$TYPE_SMO, 'Long', 'Double', $TYPE_STR];
sub jtype($type_idx) { @jtypes[$type_idx] }
my @rttypes := [$RT_OBJ, $RT_INT, $RT_NUM, $RT_STR];
sub rttype_from_typeobj($typeobj) {
@rttypes[nqp::objprimspec($typeobj)]
}
my @typeobjs := [NQPMu, int, num, str];
sub typeobj_from_rttype($rttype) {
@typeobjs[$rttype]
}
my @typechars := ['o', 'i', 'n', 's'];
sub typechar($type_idx) { @typechars[$type_idx] }
# Various typed instructions.
my @store_ins := ['astore', 'lstore', 'dstore', 'astore'];
sub store_ins($type) {
@store_ins[$type]
}
my @load_ins := ['aload', 'lload', 'dload', 'aload'];
sub load_ins($type) {
@load_ins[$type]
}
my @dup_ins := [
JAST::Instruction.new( :op('dup') ),
JAST::Instruction.new( :op('dup2') ),
JAST::Instruction.new( :op('dup2') ),
JAST::Instruction.new( :op('dup') )
];
sub dup_ins($type) {
@dup_ins[$type]
}
my @pop_ins := [
JAST::Instruction.new( :op('pop') ),
JAST::Instruction.new( :op('pop2') ),
JAST::Instruction.new( :op('pop2') ),
JAST::Instruction.new( :op('pop') )
];
sub pop_ins($type) {
@pop_ins[$type]
}
# Mapping of QAST::Want type identifiers to $RT_*.
my %WANTMAP := nqp::hash(
'v', $RT_VOID,
'I', $RT_INT, 'i', $RT_INT,
'N', $RT_NUM, 'n', $RT_NUM,
'S', $RT_STR, 's', $RT_STR,
'P', $RT_OBJ, 'p', $RT_OBJ
);
# Utility for getting a fresh temporary by type.
my @fresh_methods := ["fresh_o", "fresh_i", "fresh_n", "fresh_s"];
sub fresh($type) {
my $meth := @fresh_methods[$type];
$*TA."$meth"()
}
sub bfresh($type) {
my $meth := @fresh_methods[$type];
$*BLOCK_TA."$meth"()
}
# Argument flags.
my $ARG_OBJ := 0;
my $ARG_INT := 1;
my $ARG_NUM := 2;
my $ARG_STR := 4;
my $ARG_NAMED := 8;
my $ARG_FLAT := 16;
my @arg_types := [$ARG_OBJ, $ARG_INT, $ARG_NUM, $ARG_STR];
sub arg_type($t) { @arg_types[$t] }
class QAST::OperationsJAST {
# Maps operations to code that will handle them. Hash of code.
my %core_ops;
# Maps HLL-specific operations to code that will handle them.
# Hash of hash of code.
my %hll_ops;
# Mapping of how to box/unbox by HLL.
my %hll_box;
my %hll_unbox;
# What we know about inlinability.
my %core_inlinability;
my %hll_inlinability;
# Compiles an operation.
method compile_op($qastcomp, $hll, $op) {
my $name := $op.op;
if $hll {
if %hll_ops{$hll} && %hll_ops{$hll}{$name} -> $mapper {
return $mapper($qastcomp, $op);
}
}
if %core_ops{$name} -> $mapper {
return $mapper($qastcomp, $op);
}
nqp::die("No registered operation handler for '$name'");
}
# Adds a core op handler.
method add_core_op($op, $handler, :$inlinable = 0) {
%core_ops{$op} := $handler;
self.set_core_op_inlinability($op, $inlinable);
}
# Adds a HLL op handler.
method add_hll_op($hll, $op, $handler, :$inlinable = 0) {
%hll_ops{$hll} := {} unless nqp::existskey(%hll_ops, $hll);
%hll_ops{$hll}{$op} := $handler;
self.set_hll_op_inlinability($hll, $op, $inlinable);
}
# Sets op inlinability at a core level.
method set_core_op_inlinability($op, $inlinable) {
%core_inlinability{$op} := $inlinable;
}
# Sets op inlinability at a HLL level. (Can override at HLL level whether
# or not the HLL overrides the op itself.)
method set_hll_op_inlinability($hll, $op, $inlinable) {
%hll_inlinability{$hll} := {} unless nqp::existskey(%hll_inlinability, $hll);
%hll_inlinability{$hll}{$op} := $inlinable;
}
# Checks if an op is considered inlinable.
method is_inlinable($hll, $op) {
if nqp::existskey(%hll_inlinability, $hll) {
if nqp::existskey(%hll_inlinability{$hll}, $op) {
return %hll_inlinability{$hll}{$op};
}
}
return %core_inlinability{$op} // 0;
}
# Adds a core nqp:: op provided directly by a JVM op.
method map_jvm_core_op($op, $jvm_op, @stack_in, $stack_out) {
my $ins := JAST::Instruction.new( :op($jvm_op) );
self.add_core_op($op, op_mapper($op, $ins, @stack_in, $stack_out));
}
# Adds a HLL nqp:: op provided directly by a JVM op.
method map_jvm_hll_op($hll, $op, $jvm_op, @stack_in, $stack_out) {
my $ins := JAST::Instruction.new( :op($jvm_op) );
self.add_hll_op($hll, $op, op_mapper($op, $ins, @stack_in, $stack_out));
}
# Adds a core nqp:: op provided by a static method in the
# class library.
method map_classlib_core_op($op, $class, $method, @stack_in, $stack_out, :$tc) {
my @jtypes_in;
for @stack_in {
nqp::push(@jtypes_in, jtype($_));
}
nqp::push(@jtypes_in, $TYPE_TC) if $tc;
my $ins := JAST::Instruction.new( :op('invokestatic'),
$class, $method, jtype($stack_out), |@jtypes_in );
self.add_core_op($op, op_mapper($op, $ins, @stack_in, $stack_out, :$tc));
}
# Adds a core nqp:: op provided by a static method in the
# class library.
method map_classlib_hll_op($hll, $op, $class, $method, @stack_in, $stack_out, :$tc) {
my @jtypes_in;
for @stack_in {
nqp::push(@jtypes_in, jtype($_));
}
nqp::push(@jtypes_in, $TYPE_TC) if $tc;
my $ins := JAST::Instruction.new( :op('invokestatic'),
$class, $method, jtype($stack_out), |@jtypes_in );
self.add_hll_op($hll, $op, op_mapper($op, $ins, @stack_in, $stack_out, :$tc));
}
# Generates an operation mapper. Covers a range of operations,
# including those provided by calling a method and those that are
# just JVM op invocations.
sub op_mapper($op, $instruction, @stack_in, $stack_out, :$tc = 0) {
my int $expected_args := +@stack_in;
return -> $qastcomp, $node {
if +@($node) != $expected_args {
nqp::die("Operation '$op' requires $expected_args operands");
}
# Emit operands.
my $il := JAST::InstructionList.new();
my int $i := 0;
my @arg_res;
while $i < $expected_args {
my $type := @stack_in[$i];
my $operand := $node[$i];
my $operand_res := $qastcomp.as_jast($node[$i], :want($type));
$il.append($operand_res.jast);
$i++;
nqp::push(@arg_res, $operand_res);
}
# Emit operation.
$*STACK.obtain($il, |@arg_res) if @arg_res;
if $tc {
$il.append(JAST::Instruction.new( :op('aload_1') ));
}
$il.append($instruction);
result($il, $stack_out)
}
}
# Adds a HLL box handler.
method add_hll_box($hll, $type, $handler) {
unless $type == $RT_INT || $type == $RT_NUM || $type == $RT_STR {
nqp::die("Unknown box type '$type'");
}
%hll_box{$hll} := {} unless nqp::existskey(%hll_box, $hll);
%hll_box{$hll}{$type} := $handler;
}
# Adds a HLL unbox handler.
method add_hll_unbox($hll, $type, $handler) {
unless $type == $RT_INT || $type == $RT_NUM || $type == $RT_STR {
nqp::die("Unknown unbox type '$type'");
}
%hll_unbox{$hll} := {} unless nqp::existskey(%hll_unbox, $hll);
%hll_unbox{$hll}{$type} := $handler;
}
# Generates instructions to box what's currently on the stack top.
method box($qastcomp, $hll, $type) {
(%hll_box{$hll} // %hll_box{''}){$type}($qastcomp)
}
# Generates instructions to unbox what's currently on the stack top.
method unbox($qastcomp, $hll, $type) {
(%hll_unbox{$hll} // %hll_unbox{''}){$type}($qastcomp)
}
# Builds a result; helper method for extensions to the ops from outside
# of this file.
method result($jast, int $type) {
result($jast, $type)
}
}
# Set of sequential statements
QAST::OperationsJAST.add_core_op('stmts', -> $qastcomp, $op {
$qastcomp.as_jast(QAST::Stmts.new( |@($op) ))
});
# Data structures
QAST::OperationsJAST.add_core_op('list', -> $qastcomp, $op {
# Just desugar to create the empty list.
my $arr := $qastcomp.as_jast(QAST::Op.new(
:op('create'),
QAST::Op.new( :op('hlllist') )
));
if +$op.list {
# Put list into a temporary so we can push to it.
my $il := JAST::InstructionList.new();
$il.append($arr.jast);
$*STACK.obtain($il, $arr);
my $list_tmp := $*TA.fresh_o();
$il.append(JAST::Instruction.new( :op('astore'), $list_tmp ));
# Push things to the list.
for $op.list {
my $item := $qastcomp.as_jast($_, :want($RT_OBJ));
$il.append($item.jast);
$*STACK.obtain($il, $item);
$il.append(JAST::Instruction.new( :op('aload'), $list_tmp ));
$il.append(JAST::Instruction.new( :op('swap') ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS, 'push',
$TYPE_SMO, $TYPE_SMO, $TYPE_SMO, $TYPE_TC ));
$il.append(JAST::Instruction.new( :op('pop') ));
}
$il.append(JAST::Instruction.new( :op('aload'), $list_tmp ));
result($il, $RT_OBJ);
}
else {
$arr
}
});
QAST::OperationsJAST.add_core_op('list_i', -> $qastcomp, $op {
# Just desugar to create the empty list.
my $arr := $qastcomp.as_jast(QAST::Op.new(
:op('create'),
QAST::Op.new( :op('bootintarray') )
));
if +$op.list {
# Put list into a temporary so we can push to it.
my $il := JAST::InstructionList.new();
$il.append($arr.jast);
$*STACK.obtain($il, $arr);
my $list_tmp := $*TA.fresh_o();
$il.append(JAST::Instruction.new( :op('astore'), $list_tmp ));
# Push things to the list.
for $op.list {
my $item := $qastcomp.as_jast($_, :want($RT_INT));
$il.append($item.jast);
$*STACK.obtain($il, $item);
$il.append(JAST::Instruction.new( :op('aload'), $list_tmp ));
$il.append(JAST::Instruction.new( :op('dup_x2') ));
$il.append(JAST::Instruction.new( :op('pop') ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS, 'push_i',
'Long', $TYPE_SMO, 'Long', $TYPE_TC ));
$il.append(JAST::Instruction.new( :op('pop2') ));
}
$il.append(JAST::Instruction.new( :op('aload'), $list_tmp ));
result($il, $RT_OBJ);
}
else {
$arr
}
});
QAST::OperationsJAST.add_core_op('list_n', -> $qastcomp, $op {
# Just desugar to create the empty list.
my $arr := $qastcomp.as_jast(QAST::Op.new(
:op('create'),
QAST::Op.new( :op('bootnumarray') )
));
if +$op.list {
# Put list into a temporary so we can push to it.
my $il := JAST::InstructionList.new();
$il.append($arr.jast);
$*STACK.obtain($il, $arr);
my $list_tmp := $*TA.fresh_o();
$il.append(JAST::Instruction.new( :op('astore'), $list_tmp ));
# Push things to the list.
for $op.list {
my $item := $qastcomp.as_jast($_, :want($RT_NUM));
$il.append($item.jast);
$*STACK.obtain($il, $item);
$il.append(JAST::Instruction.new( :op('aload'), $list_tmp ));
$il.append(JAST::Instruction.new( :op('dup_x2') ));
$il.append(JAST::Instruction.new( :op('pop') ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS, 'push_n',
'Double', $TYPE_SMO, 'Double', $TYPE_TC ));
$il.append(JAST::Instruction.new( :op('pop2') ));
}
$il.append(JAST::Instruction.new( :op('aload'), $list_tmp ));
result($il, $RT_OBJ);
}
else {
$arr
}
});
QAST::OperationsJAST.add_core_op('list_s', -> $qastcomp, $op {
# Just desugar to create the empty list.
my $arr := $qastcomp.as_jast(QAST::Op.new(
:op('create'),
QAST::Op.new( :op('bootstrarray') )
));
if +$op.list {
# Put list into a temporary so we can push to it.
my $il := JAST::InstructionList.new();
$il.append($arr.jast);
$*STACK.obtain($il, $arr);
my $list_tmp := $*TA.fresh_o();
$il.append(JAST::Instruction.new( :op('astore'), $list_tmp ));
# Push things to the list.
for $op.list {
my $item := $qastcomp.as_jast($_, :want($RT_STR));
$il.append($item.jast);
$*STACK.obtain($il, $item);
$il.append(JAST::Instruction.new( :op('aload'), $list_tmp ));
$il.append(JAST::Instruction.new( :op('swap') ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS, 'push_s',
$TYPE_STR, $TYPE_SMO, $TYPE_STR, $TYPE_TC ));
$il.append(JAST::Instruction.new( :op('pop') ));
}
$il.append(JAST::Instruction.new( :op('aload'), $list_tmp ));
result($il, $RT_OBJ);
}
else {
$arr
}
});
QAST::OperationsJAST.add_core_op('list_b', -> $qastcomp, $op {
# Just desugar to create the empty list.
my $arr := $qastcomp.as_jast(QAST::Op.new(
:op('create'),
QAST::Op.new( :op('hlllist') )
));
if +$op.list {
my $il := JAST::InstructionList.new();
$il.append($arr.jast);
$*STACK.obtain($il, $arr);
for $op.list {
nqp::die("list_b must have a list of blocks")
unless nqp::istype($_, QAST::Block);
$il.append(JAST::Instruction.new( :op('dup') ));
$il.append(JAST::Instruction.new( :op('aload_0') ));
$il.append(JAST::PushSVal.new( :value($_.cuid) ));
$il.append(JAST::Instruction.new( :op('invokevirtual'),
$TYPE_CU, 'lookupCodeRef', $TYPE_CR, $TYPE_STR ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS, 'push',
$TYPE_SMO, $TYPE_SMO, $TYPE_SMO, $TYPE_TC ));
$il.append(JAST::Instruction.new( :op('pop') ));
}
result($il, $RT_OBJ);
}
else {
$arr
}
});
QAST::OperationsJAST.add_core_op('qlist', -> $qastcomp, $op {
$qastcomp.as_jast(QAST::Op.new( :op('list'), |@($op) ))
});
QAST::OperationsJAST.add_core_op('hash', -> $qastcomp, $op {
# Just desugar to create the empty hash.
my $hash := $qastcomp.as_jast(QAST::Op.new(
:op('create'),
QAST::Op.new( :op('hllhash') )
));
if +$op.list {
# Put hash into a temporary so we can add the items to it.
my $il := JAST::InstructionList.new();
$il.append($hash.jast);
$*STACK.obtain($il, $hash);
my $hash_tmp := $*TA.fresh_o();
$il.append(JAST::Instruction.new( :op('astore'), $hash_tmp ));
my $key_tmp := $*TA.fresh_s();
my $val_tmp := $*TA.fresh_o();
for $op.list -> $key, $val {
my $key_res := $qastcomp.as_jast($key, :want($RT_STR));
$il.append($key_res.jast);
$*STACK.obtain($il, $key_res);
$il.append(JAST::Instruction.new( :op('astore'), $key_tmp ));
my $val_res := $qastcomp.as_jast($val, :want($RT_OBJ));
$il.append($val_res.jast);
$*STACK.obtain($il, $val_res);
$il.append(JAST::Instruction.new( :op('astore'), $val_tmp ));
$il.append(JAST::Instruction.new( :op('aload'), $hash_tmp ));
$il.append(JAST::Instruction.new( :op('aload'), $key_tmp ));
$il.append(JAST::Instruction.new( :op('aload'), $val_tmp ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS, 'bindkey',
$TYPE_SMO, $TYPE_SMO, $TYPE_STR, $TYPE_SMO, $TYPE_TC ));
$il.append(JAST::Instruction.new( :op('pop') ));
}
$il.append(JAST::Instruction.new( :op('aload'), $hash_tmp ));
result($il, $RT_OBJ);
}
else {
$hash
}
});
# Conditionals.
sub boolify_instructions($il, $cond_type) {
if $cond_type == $RT_INT {
$il.append(JAST::PushIVal.new( :value(0) ));
$il.append(JAST::Instruction.new( :op('lcmp') ));
}
elsif $cond_type == $RT_NUM {
$il.append(JAST::PushNVal.new( :value(0.0) ));
$il.append(JAST::Instruction.new( :op('dcmpl') ));
}
elsif $cond_type == $RT_STR {
$il.append(JAST::Instruction.new( :op('invokestatic'),
$TYPE_OPS, 'istrue_s', 'Long', $TYPE_STR ));
$il.append(JAST::PushIVal.new( :value(0) ));
$il.append(JAST::Instruction.new( :op('lcmp') ));
}
else {
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'),
$TYPE_OPS, 'istrue', 'Long', $TYPE_SMO, $TYPE_TC ));
$il.append(JAST::PushIVal.new( :value(0) ));
$il.append(JAST::Instruction.new( :op('lcmp') ));
}
}
for <if unless> -> $op_name {
QAST::OperationsJAST.add_core_op($op_name, -> $qastcomp, $op {
# Check operand count.
my $operands := +$op.list;
nqp::die("Operation '$op_name' needs either 2 or 3 operands")
if $operands < 2 || $operands > 3;
# See if any immediate block wants to be passed the condition.
my $im_then := nqp::istype($op[1], QAST::Block) &&
$op[1].blocktype eq 'immediate' &&
$op[1].arity > 0;
my $im_else := $operands == 3 &&
nqp::istype($op[2], QAST::Block) &&
$op[2].blocktype eq 'immediate' &&
$op[2].arity > 0;
# Create labels and a place to store the overall result.
my $if_id := $qastcomp.unique($op_name);
my $else_lbl := JAST::Label.new(:name($if_id ~ '_else'));
my $end_lbl := JAST::Label.new(:name($if_id ~ '_end'));
my $res_temp;
my $res_type;
# Compile conditional expression and saving of it if we need to.
my $il := JAST::InstructionList.new();
$*STACK.spill_to_locals($il);
my $cond := $qastcomp.as_jast($op[0]);
$il.append($cond.jast);
$*STACK.obtain($il, $cond);
if $im_then || $im_else {
my $im_local := QAST::Node.unique('__IM_');
$*BLOCK.add_local(QAST::Var.new(
:name($im_local),
:returns(typeobj_from_rttype($cond.type))
));
if $im_then {
$op[1].blocktype('declaration');
$op[1] := QAST::Op.new(
:op('call'), $op[1],
QAST::Var.new( :name($im_local), :scope('local') )
);
}
if $im_else {
$op[2].blocktype('declaration');
$op[2] := QAST::Op.new(
:op('call'), $op[2],
QAST::Var.new( :name($im_local), :scope('local') )
);
}
$il.append(dup_ins($cond.type));
$il.append(JAST::Instruction.new( :op(store_ins($cond.type)), $im_local ));
}
unless $*WANT == $RT_VOID || $operands == 3 {
$il.append(dup_ins($cond.type));
$res_type := $cond.type;
$res_temp := fresh($res_type);
$il.append(JAST::Instruction.new( :op(store_ins($res_type)), $res_temp ));
}
# Emit test.
boolify_instructions($il, $cond.type);
$il.append(JAST::Instruction.new($else_lbl,
:op($op_name eq 'if' ?? 'ifeq' !! 'ifne')));
# Compile the "then".
my $then := $qastcomp.as_jast($op[1]);
$il.append($then.jast);
# What comes next depends on whether there's an else.
if $operands == 3 {
# A little care needed here; we make sure we obtain the
# result of the then, but before we actually use it we
# compile the else branch so we can see what result type
# is needed. It's fine as we don't append the else JAST
# until later.
$*STACK.obtain($il, $then);
my $else := $qastcomp.as_jast($op[2]);
if $*WANT == $RT_VOID {
$il.append(pop_ins($then.type));
}
else {
$res_type := $then.type == $else.type ?? $then.type !! $RT_OBJ;
$res_temp := fresh($res_type);
$il.append($qastcomp.coercion($then, $res_type));
$il.append(JAST::Instruction.new( :op(store_ins($res_type)), $res_temp ));
}
# Then branch needs to go to the loop end.
$il.append(JAST::Instruction.new( :op('goto'), $end_lbl ));
# Emit the else branch.
$il.append($else_lbl);
$il.append($else.jast);
$*STACK.obtain($il, $else);
if $*WANT == $RT_VOID {
$il.append(pop_ins($else.type));
}
else {
$il.append($qastcomp.coercion($else, $res_type));
$il.append(JAST::Instruction.new( :op(store_ins($res_type)), $res_temp ));
}
}
else {
# If void context, just pop the result and we're done.
# Otherwise, need to find a common type between it and
# the condition.
$*STACK.obtain($il, $then);
if $*WANT == $RT_VOID {
$il.append(pop_ins($then.type));
$il.append($else_lbl);
}
elsif $then.type == $res_type {
# Already have a common type.
$il.append(JAST::Instruction.new( :op(store_ins($res_type)), $res_temp ));
$il.append($else_lbl);
}
else {
# Need a new result, and to coerce both condition and
# result of then to it as needed (basically, add an else
# that handles coercion).
my $old_res_type := $res_type;
my $old_res_temp := $res_temp;
$res_type := $RT_OBJ;
$res_temp := fresh($res_type);
$il.append($qastcomp.coercion($then, $res_type));
$il.append(JAST::Instruction.new( :op(store_ins($res_type)), $res_temp ));
$il.append(JAST::Instruction.new( :op('goto'), $end_lbl ));
$il.append($else_lbl);
$il.append(JAST::Instruction.new( :op(load_ins($old_res_type)), $old_res_temp ));
$il.append($qastcomp.coercion($cond, $res_type));
$il.append(JAST::Instruction.new( :op(store_ins($res_type)), $res_temp ));
}
}
# Add final label and load result if neded.
$il.append($end_lbl);
if $res_temp {
$il.append(JAST::Instruction.new( :op(load_ins($res_type)), $res_temp ));
result($il, $res_type);
}
else {
result($il, $RT_VOID);
}
});
}
QAST::OperationsJAST.add_core_op('defor', -> $qastcomp, $op {
if +$op.list != 2 {
nqp::die("Operation 'defor' needs 2 operands");
}
my $tmp := $op.unique('defined');
$qastcomp.as_jast(QAST::Stmts.new(
QAST::Op.new(
:op('bind'),
QAST::Var.new( :name($tmp), :scope('local'), :decl('var') ),
$op[0]
),
QAST::Op.new(
:op('if'),
QAST::Op.new(
:op('defined'),
QAST::Var.new( :name($tmp), :scope('local') )
),
QAST::Var.new( :name($tmp), :scope('local') ),
$op[1]
)))
});
QAST::OperationsJAST.add_core_op('ifnull', -> $qastcomp, $op {
if +$op.list != 2 {
nqp::die("The 'ifnull' op expects two children");
}
# Compile the expression.
my $il := JAST::InstructionList.new();
$*STACK.spill_to_locals($il);
my $expr := $qastcomp.as_jast($op[0], :want($RT_OBJ));
$il.append($expr.jast);
# Emit null check.
my $lbl := JAST::Label.new( :name($qastcomp.unique('ifnull_')) );
$*STACK.obtain($il, $expr);
$il.append(JAST::Instruction.new( :op('dup') ));
$il.append(JAST::Instruction.new( :op('ifnonnull'), $lbl ));
# Emit "then" part.
$il.append(JAST::Instruction.new( :op('pop') ));
my $then := $qastcomp.as_jast($op[1], :want($RT_OBJ));
$il.append($then.jast);
$*STACK.obtain($il, $then);
$il.append($lbl);
result($il, $RT_OBJ);
});
# Loops.
for ('', 'repeat_') -> $repness {
for <while until> -> $op_name {
QAST::OperationsJAST.add_core_op("$repness$op_name", -> $qastcomp, $op {
# Check if we need a handler and operand count.
my $handler := 1;
my @operands;
for $op.list {
if $_.named eq 'nohandler' { $handler := 0; }
else { @operands.push($_) }
}
if +@operands != 2 && +@operands != 3 {
nqp::die("Operation '$repness$op_name' needs 2 or 3 operands");
}
# Create labels.
my $while_id := $qastcomp.unique($op_name);
my $test_lbl := JAST::Label.new( :name($while_id ~ '_test') );
my $next_lbl := JAST::Label.new( :name($while_id ~ '_next') );
my $redo_lbl := JAST::Label.new( :name($while_id ~ '_redo') );
my $done_lbl := JAST::Label.new( :name($while_id ~ '_done') );
# If we need handlers, produce them.
my $l_handler_id;
my $nr_handler_id;
if $handler {
$l_handler_id := &*REGISTER_UNWIND_HANDLER($*HANDLER_IDX, $EX_CAT_LAST);
$nr_handler_id := &*REGISTER_UNWIND_HANDLER($l_handler_id, $EX_CAT_NEXT + $EX_CAT_REDO)
}
# Emit loop prelude, evaluating condition.
my $testil := JAST::InstructionList.new();
$*STACK.spill_to_locals($testil);
if $repness {
# It's a repeat_ variant, need to go straight into the
# loop body unconditionally.
$testil.append(JAST::Instruction.new( :op('goto'), $redo_lbl ));
}
$testil.append($test_lbl);
my $cond_res := $qastcomp.as_jast_in_handler(@operands[0], $l_handler_id || $*HANDLER_IDX);
$testil.append($cond_res.jast);
$*STACK.obtain($testil, $cond_res);
# Compile loop body, then do any analysis of result type if
# in non-void context.
my $body_res := $qastcomp.as_jast_in_handler(@operands[1], $nr_handler_id || $*HANDLER_IDX);
my $res;
my $res_type;
if $*WANT != $RT_VOID {
$res_type := $cond_res.type == $body_res.type
?? $cond_res.type
!! $RT_OBJ;
$res := $*TA."fresh_{typechar($res_type)}"();
}
# If we're non-void, store the condition's evaluation as a
# result.
if $res {
$testil.append(dup_ins($cond_res.type));
$testil.append($qastcomp.coercion($cond_res, $res_type));
$testil.append(JAST::Instruction.new( :op(store_ins($res_type)), $res ));
}
# Emit test.
boolify_instructions($testil, $cond_res.type);
$testil.append(JAST::Instruction.new($done_lbl,
:op($op_name eq 'while' ?? 'ifeq' !! 'ifne')));
# Emit the loop body; stash the result if needed.
my $il := JAST::InstructionList.new();
$il.append($redo_lbl);
my $body_il := JAST::InstructionList.new();
$body_il.append($body_res.jast);
$*STACK.obtain($body_il, $body_res);
if $res {
$body_il.append($qastcomp.coercion($body_res, $res_type));
$body_il.append(JAST::Instruction.new( :op(store_ins($res_type)), $res ));
}
else {
$body_il.append(pop_ins($body_res.type));
}
# Add redo and next handler if needed.
if $handler {
my $catch := JAST::InstructionList.new();
$qastcomp.unwind_check($catch, $nr_handler_id);
$catch.append(JAST::Instruction.new( :op('getfield'), $TYPE_EX_UNWIND, 'category', 'Long' ));
$catch.append(JAST::PushIVal.new( :value($EX_CAT_REDO) ));
$catch.append(JAST::Instruction.new( :op('lcmp') ));
$catch.append(JAST::Instruction.new( :op('ifeq'), $redo_lbl ));
$body_il := $qastcomp.delimit_handler(
JAST::TryCatch.new( :try($body_il), :$catch, :type($TYPE_EX_UNWIND) ),
$l_handler_id, $nr_handler_id);
}
$il.append($body_il);
# If there's a third child, evaluate it as part of the
# "next".
if +@operands == 3 {
my $next_res := $qastcomp.as_jast_in_handler(@operands[2],
$l_handler_id || $*HANDLER_IDX, :want($RT_VOID));
$il.append($next_res.jast);
$*STACK.obtain($il, $next_res);
}
# Emit the iteration jump and end label.
$il.append(JAST::Instruction.new( :op('goto'), $test_lbl ));
$il.append($done_lbl);
# If needed, wrap the whole thing in a last exception handler.
if $handler {
my $catch := JAST::InstructionList.new();
$qastcomp.unwind_check($catch, $l_handler_id);
$catch.append(JAST::Instruction.new( :op('pop') ));
$il := $qastcomp.delimit_handler(
JAST::TryCatch.new( :try($il), :catch($catch), :type($TYPE_EX_UNWIND) ),
$*HANDLER_IDX, $l_handler_id);
}
my $res_il := JAST::InstructionList.new();
$res_il.append($testil);
$res_il.append($il);
if $res {
$res_il.append(JAST::Instruction.new( :op(load_ins($res_type)), $res ));
result($res_il, $res_type)
}
else {
result($res_il, $RT_VOID)
}
});
}
}
QAST::OperationsJAST.add_core_op('for', -> $qastcomp, $op {
my $handler := 1;
my @operands;
for $op.list {
if $_.named eq 'nohandler' { $handler := 0; }
else { @operands.push($_) }
}
if +@operands != 2 {
nqp::die("Operation 'for' needs 2 operands");
}
unless nqp::istype(@operands[1], QAST::Block) {
nqp::die("Operation 'for' expects a block as its second operand");
}
if @operands[1].blocktype eq 'immediate' {
@operands[1].blocktype('declaration');
}
# Create result temporary if we'll need one.
my $res := $*WANT == $RT_VOID ?? 0 !! $*TA.fresh_o();
# If we need handlers, produce them.
my $l_handler_id;
my $n_handler_id;
my $r_handler_id;
if $handler {
$l_handler_id := &*REGISTER_UNWIND_HANDLER($*HANDLER_IDX, $EX_CAT_LAST);
$n_handler_id := &*REGISTER_UNWIND_HANDLER($l_handler_id, $EX_CAT_NEXT);
$r_handler_id := &*REGISTER_UNWIND_HANDLER($n_handler_id, $EX_CAT_REDO);
}
# Evaluate the thing we'll iterate over, get the iterator and
# store it in a temporary.
my $il := JAST::InstructionList.new();
$*STACK.spill_to_locals($il);
my $list_res := $qastcomp.as_jast(@operands[0]);
$il.append($list_res.jast);
$*STACK.obtain($il, $list_res);
if $res {
$il.append(JAST::Instruction.new( :op('dup') ));
$il.append(JAST::Instruction.new( :op('astore'), $res ));
}
my $iter_tmp := $*TA.fresh_o();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'),
$TYPE_OPS, 'iter', $TYPE_SMO, $TYPE_SMO, $TYPE_TC ));
$il.append(JAST::Instruction.new( :op('astore'), $iter_tmp ));
# Do similar for the block.
my $block_res := $qastcomp.as_jast(@operands[1], :want($RT_OBJ));
my $block_tmp := $op.unique('iterblock');
$*BLOCK.add_local(QAST::Var.new( :name($block_tmp), :scope('local') ));
$il.append($block_res.jast);
$*STACK.obtain($il, $block_res);
$il.append(JAST::Instruction.new( :op('astore'), $block_tmp ));
# Some labels we'll need.
my $for_id := $qastcomp.unique('for');
my $lbl_next := JAST::Label.new( :name($for_id ~ 'next') );
my $lbl_redo := JAST::Label.new( :name($for_id ~ 'redo') );
my $lbl_done := JAST::Label.new( :name($for_id ~ 'done') );
# Emit loop test.
my $loop_il := JAST::InstructionList.new();
$loop_il.append($lbl_next);
$loop_il.append(JAST::Instruction.new( :op('aload'), $iter_tmp ));
$loop_il.append(JAST::Instruction.new( :op('aload_1') ));
$loop_il.append(JAST::Instruction.new( :op('invokestatic'),
$TYPE_OPS, 'istrue', 'Long', $TYPE_SMO, $TYPE_TC ));
$loop_il.append(JAST::Instruction.new( :op('l2i') ));
$loop_il.append(JAST::Instruction.new( :op('ifeq'), $lbl_done ));
# Fetch values into temporaries (on the stack ain't enough in case
# of redo).
my $val_il := JAST::InstructionList.new();
my @val_temps;
my $arity := @operands[1].arity || 1;
while $arity > 0 {
my $tmp := $op.unique('itertmp');
$*BLOCK.add_local(QAST::Var.new( :name($tmp), :scope('local') ));
$val_il.append(JAST::Instruction.new( :op('aload'), $iter_tmp ));
$val_il.append(JAST::Instruction.new( :op('aload_1') ));
$val_il.append(JAST::Instruction.new( :op('invokestatic'),
$TYPE_OPS, 'shift', $TYPE_SMO, $TYPE_SMO, $TYPE_TC ));
$val_il.append(JAST::Instruction.new( :op('astore'), $tmp ));
nqp::push(@val_temps, $tmp);
$arity := $arity - 1;
}
$val_il.append($lbl_redo);
# Now do block invocation.
my $inv_ast := QAST::Op.new(
:op('call'),
QAST::Var.new( :name($block_tmp), :scope('local') )
);
for @val_temps {
$inv_ast.push(QAST::Var.new( :name($_), :scope('local') ));
}
my $inv_res := $qastcomp.as_jast($inv_ast, :want($res ?? $RT_OBJ !! $RT_VOID));
my $inv_il := JAST::InstructionList.new();
$inv_il.append($inv_res.jast);
$*STACK.obtain($inv_il, $inv_res);
if $res {
$inv_il.append(JAST::Instruction.new( :op('astore'), $res ));
}
# Wrap block invocation in redo handler if needed.
if $handler {
my $catch := JAST::InstructionList.new();
$qastcomp.unwind_check($catch, $r_handler_id);
$catch.append(JAST::Instruction.new( :op('pop') ));
$catch.append(JAST::Instruction.new( :op('goto'), $lbl_redo ));
$inv_il := $qastcomp.delimit_handler(
JAST::TryCatch.new( :try($inv_il), :$catch, :type($TYPE_EX_UNWIND) ),
$n_handler_id, $r_handler_id);
}
$val_il.append($inv_il);
# Wrap value fetching and call in "next" handler if needed.
if $handler {
my $catch := JAST::InstructionList.new();
$qastcomp.unwind_check($catch, $n_handler_id);
$catch.append(JAST::Instruction.new( :op('pop') ));
$val_il := $qastcomp.delimit_handler(
JAST::TryCatch.new( :try($val_il), :$catch, :type($TYPE_EX_UNWIND) ),
$l_handler_id, $n_handler_id);
}
$loop_il.append($val_il);
$loop_il.append(JAST::Instruction.new( :op('goto'), $lbl_next ));
# Emit postlude, wrapping in last handler if needed.
if $handler {
my $catch := JAST::InstructionList.new();
$qastcomp.unwind_check($catch, $l_handler_id);
$catch.append(JAST::Instruction.new( :op('pop') ));
$catch.append(JAST::Instruction.new( :op('goto'), $lbl_done ));
$loop_il := $qastcomp.delimit_handler(
JAST::TryCatch.new( :try($loop_il), :$catch, :type($TYPE_EX_UNWIND) ),
$*HANDLER_IDX, $l_handler_id);
}
$il.append($loop_il);
$il.append($lbl_done);
# Result, as needed.
if $res {
$il.append(JAST::Instruction.new( :op('aload'), $res ));
result($il, $RT_OBJ)
}
else {
result($il, $RT_VOID)
}
});
# Calling
sub process_args_onto_stack($qastcomp, @children, $il, :$obj_first, :$inv_first, :$name_first, :$obj_second) {
# Make sure we do positionals before nameds.
my @pos;
my @named;
for @children {
nqp::push(($_.named ?? @named !! @pos), $_);
}
my @order := @pos;
for @named { nqp::push(@order, $_) }
# Process the arguments, computing each of them and putting them onto the
# stack.
my @arg_results;
my @arg_jtypes := [$TYPE_TC];
my @callsite;
my @argnames;
my int $i := 0;
while $i < +@order {
my $arg_res;
if $i == 0 && ($obj_first || $inv_first) || $i == 1 && $obj_second {
$arg_res := $qastcomp.as_jast(@order[$i], :want($RT_OBJ));
}
elsif $i == 0 && $name_first {
$arg_res := $qastcomp.as_jast(@order[$i], :want($RT_STR));
}
else {
$arg_res := $qastcomp.as_jast(@order[$i]);
}
$il.append($arg_res.jast);
nqp::push(@arg_results, $arg_res);
my int $type := $arg_res.type;
if $type == $RT_INT {
nqp::push(@arg_jtypes, 'J');
}
elsif $type == $RT_NUM {
nqp::push(@arg_jtypes, 'D');
}
else {
nqp::push(@arg_jtypes, jtype($arg_res.type));
}
unless $i == 0 && ($inv_first || $name_first) {
my int $flags := 0;
if @order[$i].flat {
$flags := @order[$i].named ?? 24 !! 16;
}
elsif @order[$i].named -> $name {
$flags := 8;
nqp::push(@argnames, $name);
}
nqp::push(@callsite, arg_type($type) + $flags);
}
$i++;
}
# Return callsite index (which may create it if needed).
return [$*CODEREFS.get_callsite_idx(@callsite, @argnames), @arg_results, @arg_jtypes];
}
QAST::OperationsJAST.add_core_op('call', sub ($qastcomp, $node) {
my $il := JAST::InstructionList.new();
# If it's a direct call, then use invokedynamic to resolve the name in
# the current lexical scope.
if $node.name ne "" {
# Process arguments and force them into locals.
my @argstuff := process_args_onto_stack($qastcomp, @($node), $il);
my $cs_idx := @argstuff[0];
$*STACK.spill_to_locals($il);
# Emit the call. Note, name passed as extra arg as some valid names in
# Perl 6 are not valid method names on the JVM. We use the fact that
# the stack was spilled to sneak the ThreadContext arg in.
$il.append(JAST::Instruction.new( :op('aload_1') ));
$*STACK.obtain($il, |@argstuff[1]) if @argstuff[1];
$il.append(JAST::InvokeDynamic.new(
'subcall', 'V', @argstuff[2],
'org/perl6/nqp/runtime/IndyBootstrap', 'subcall',
[
JAST::PushSVal.new( :value($node.name) ),
JAST::PushIndex.new( :value($cs_idx) )
]
));
}
# Otherwise, it's an indirect call.
else {
# Ensure we have a thing to invoke.
nqp::die("A 'call' node must have a name or at least one child") unless +@($node) >= 1;
# Proces arguments, making sure first one is an object (since that is
# the thing to invoke).
my @argstuff := process_args_onto_stack($qastcomp, @($node), $il, :inv_first);
my $cs_idx := @argstuff[0];
$*STACK.spill_to_locals($il);
# Emit the call, using the same thread context trick. The first thing
# will be invoked.
$il.append(JAST::Instruction.new( :op('aload_1') ));
$*STACK.obtain($il, |@argstuff[1]) if @argstuff[1];
$il.append(JAST::InvokeDynamic.new(
'indcall', 'V', @argstuff[2],
'org/perl6/nqp/runtime/IndyBootstrap', 'indcall',
[
JAST::PushIndex.new( :value($cs_idx) )
]
));
}
# Load result onto the stack, unless in void context.
if $*WANT != $RT_VOID {
my $rtype := rttype_from_typeobj($node.returns);
$il.append(JAST::Instruction.new( :op('aload'), 'cf' ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'result_' ~ typechar($rtype), jtype($rtype), $TYPE_CF ));
result($il, $rtype)
}
else {
result($il, $RT_VOID)
}
});
QAST::OperationsJAST.add_core_op('callmethod', -> $qastcomp, $node {
my $il := JAST::InstructionList.new();
# Ensure we have an invocant.
if +@($node) == 0 {
nqp::die("A 'callmethod' node must have at least one child");
}
my @children := nqp::clone(@($node));
# If it's a direct call, we can get invokedynamic to do something smart
# with guard clauses for us.
if $node.name ne '' {
# Process arguments and force them into locals.
my @argstuff := process_args_onto_stack($qastcomp, @children, $il, :obj_first);
my $cs_idx := @argstuff[0];
$*STACK.spill_to_locals($il);
# Emit the call. Note, name passed as extra arg as some valid names in
# Perl 6 are not valid method names on the JVM. We use the fact that
# the stack was spilled to sneak the ThreadContext arg in.
$il.append(JAST::Instruction.new( :op('aload_1') ));
$*STACK.obtain($il, |@argstuff[1]) if @argstuff[1];
$il.append(JAST::InvokeDynamic.new(
'methcall', 'V', @argstuff[2],
'org/perl6/nqp/runtime/IndyBootstrap', 'methcall',
[
JAST::PushSVal.new( :value($node.name) ),
JAST::PushIndex.new( :value($cs_idx) )
]
));
}
# Otherwise, it's indirect, and we need to resolve the method each and
# every call. Still wire it through invokedynamic, but it can't do quite
# so much for us.
else {
# Ensure we have a name, and re-arrange it to come first.
if +@children == 1 {
nqp::die("Method call must either supply a name or have a child node that evaluates to the name");
}
my $inv := nqp::shift(@children);
my $name := nqp::shift(@children);
nqp::unshift(@children, $inv);
nqp::unshift(@children, $name);
# Process arguments and force them into locals.
my @argstuff := process_args_onto_stack($qastcomp, @children, $il, :name_first, :obj_second);
my $cs_idx := @argstuff[0];
$*STACK.spill_to_locals($il);
# Emit the call.
$il.append(JAST::Instruction.new( :op('aload_1') ));
$*STACK.obtain($il, |@argstuff[1]) if @argstuff[1];
$il.append(JAST::InvokeDynamic.new(
'indmethcall', 'V', @argstuff[2],
'org/perl6/nqp/runtime/IndyBootstrap', 'indmethcall',
[
JAST::PushIndex.new( :value($cs_idx) )
]
));
}
# Load result onto the stack, unless in void context.
if $*WANT != $RT_VOID {
my $rtype := rttype_from_typeobj($node.returns);
$il.append(JAST::Instruction.new( :op('aload'), 'cf' ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'result_' ~ typechar($rtype), jtype($rtype), $TYPE_CF ));
result($il, $rtype)
}
else {
result($il, $RT_VOID)
}
});
my $num_lexotics := 0;
QAST::OperationsJAST.add_core_op('lexotic', -> $qastcomp, $op {
# Create the lexotic lexical.
my $target := nqp::floor_n(nqp::time_n() * 1000) * 10000 + $num_lexotics++;
my $il := JAST::InstructionList.new();
$*BLOCK.add_lexical(QAST::Var.new( :name($op.name) ));
$il.append(JAST::PushIVal.new( :value($target) ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'lexotic', $TYPE_SMO, 'Long' ));
$il.append(JAST::Instruction.new( :op('aload'), 'cf' ));
$il.append(JAST::PushIndex.new( :value($*BLOCK.lexical_idx($op.name)) ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'bindlex_o', $TYPE_SMO, $TYPE_SMO, $TYPE_CF, 'Integer' ));
$il.append(JAST::Instruction.new( :op('pop') ));
# Compile the things inside the lexotic
my $*WANT := $RT_OBJ;
my $stmt_res := $qastcomp.coerce($qastcomp.compile_all_the_stmts($op.list()), $RT_OBJ);
$*STACK.obtain($il, $stmt_res);
# Build up catch for the lexotic (rethrows if wrong thing).
my $miss_lbl := JAST::Label.new( :name($qastcomp.unique('lexotic_miss_')) );
my $done_lbl := JAST::Label.new( :name($qastcomp.unique('lexotic_done_')) );
my $catch_il := JAST::InstructionList.new();
$catch_il.append(JAST::Instruction.new( :op('dup') ));
$catch_il.append(JAST::Instruction.new( :op('getfield'), $TYPE_EX_LEX, 'target', 'Long' ));
$catch_il.append(JAST::PushIVal.new( :value($target) ));
$catch_il.append(JAST::Instruction.new( :op('lcmp') ));
$catch_il.append(JAST::Instruction.new( :op('ifne'), $miss_lbl ));
$catch_il.append(JAST::Instruction.new( :op('getfield'), $TYPE_EX_LEX, 'payload', $TYPE_SMO ));
$catch_il.append(JAST::Instruction.new( :op('goto'), $done_lbl ));
$catch_il.append($miss_lbl);
$catch_il.append(JAST::Instruction.new( :op('athrow') ));
$catch_il.append($done_lbl);
# Finally, assemble try/catch.
$il.append(JAST::TryCatch.new(
:try($stmt_res.jast),
:catch($catch_il),
:type($TYPE_EX_LEX)
));
result($il, $RT_OBJ);
});
# Binding
QAST::OperationsJAST.add_core_op('bind', -> $qastcomp, $op {
# Sanity checks.
my @children := $op.list;
if +@children != 2 {
nqp::die("A 'bind' op must have exactly two children");
}
unless nqp::istype(@children[0], QAST::Var) {
nqp::die("First child of a 'bind' op must be a QAST::Var");
}
# Set the QAST of the think we're to bind, then delegate to
# the compilation of the QAST::Var to handle the rest.
my $*BINDVAL := @children[1];
$qastcomp.as_jast(@children[0])
});
# Exception handling/munging.
QAST::OperationsJAST.map_classlib_core_op('die_s', $TYPE_OPS, 'die_s', [$RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('die', $TYPE_OPS, 'die_s', [$RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('exception', $TYPE_OPS, 'exception', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('getextype', $TYPE_OPS, 'getextype', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('getpayload', $TYPE_OPS, 'getpayload', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('getmessage', $TYPE_OPS, 'getmessage', [$RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('backtracestrings', $TYPE_OPS, 'backtracestrings', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('rethrow', $TYPE_OPS, 'rethrow', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('resume', $TYPE_OPS, 'resume', [$RT_OBJ], $RT_OBJ, :tc);
my %handler_names := nqp::hash(
'CATCH', $EX_CAT_CATCH,
'CONTROL', $EX_CAT_CONTROL,
'NEXT', $EX_CAT_NEXT,
'LAST', $EX_CAT_LAST,
'REDO', $EX_CAT_REDO
);
QAST::OperationsJAST.add_core_op('handle', sub ($qastcomp, $op) {
my @children := nqp::clone($op.list());
if @children == 0 {
nqp::die("The 'handle' op requires at least one child");
}
# If there's exactly one child, then there's nothing protecting
# it; just compile it and we're done.
my $protected := @children.shift();
unless @children {
return $qastcomp.as_jast($protected);
}
# Otherwise, we need to generate an install a handler block, which will
# decide that to do by category.
my $mask := 0;
my $hblock := QAST::Block.new(
QAST::Op.new(
:op('bind'),
QAST::Var.new( :name('__category__'), :scope('local'), :decl('var') ),
QAST::Op.new(
:op('getextype'),
QAST::Op.new( :op('exception') )
)));
my $push_target := $hblock;
for @children -> $type, $handler {
# Get the category mask.
unless nqp::existskey(%handler_names, $type) {
nqp::die("Invalid handler type '$type'");
}
my $cat_mask := %handler_names{$type};
# Chain in this handler.
my $check := QAST::Op.new(
:op('if'),
QAST::Op.new(
:op('bitand_i'),
QAST::Var.new( :name('__category__'), :scope('local') ),
QAST::IVal.new( :value($cat_mask) )
),
$handler
);
$push_target.push($check);
$push_target := $check;
# Add to mask.
$mask := nqp::bitor_i($mask, $cat_mask);
}
# Compile, create a lexical to put the handler in, and add it. Should
# also force the stack to empty.
my $name := QAST::Node.unique('!HANDLER_');
$*BLOCK.add_lexical(QAST::Var.new( :name($name) ));
my $lexidx := $*BLOCK.lexical_idx($name);
my $il := JAST::InstructionList.new();
$*STACK.spill_to_locals($il);
my $hb_res := $qastcomp.as_jast($hblock, :want($RT_OBJ));
$il.append($hb_res.jast);
$*STACK.obtain($il, $hb_res);
$il.append(JAST::Instruction.new( :op('aload'), 'cf' ));
$il.append(JAST::PushIndex.new( :value($lexidx) ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'bindlex_o', $TYPE_SMO, $TYPE_SMO, $TYPE_CF, 'Integer' ));
$il.append(JAST::Instruction.new( :op('pop') ));
# Register a handler.
my $handler := &*REGISTER_BLOCK_HANDLER($*HANDLER_IDX, $mask, $lexidx);
# Evaluate the protected code and stash it in a temporary.
my $result := $*TA.fresh_o();
my $prores := $qastcomp.as_jast_in_handler($protected, $handler, :want($RT_OBJ));
my $tryil := JAST::InstructionList.new();
$tryil.append($prores.jast);
$*STACK.obtain($tryil, $prores);
$tryil.append(JAST::Instruction.new( :op('astore'), $result ));
# The catch part just handles unwind; grab the result.
my $catchil := JAST::InstructionList.new();
$qastcomp.unwind_check($catchil, $handler);
$catchil.append(JAST::Instruction.new( :op('getfield'), $TYPE_EX_UNWIND, 'result', $TYPE_SMO ));
$catchil.append(JAST::Instruction.new( :op('astore'), $result ));
# Wrap it all up in try/catch etc.
$il.append($qastcomp.delimit_handler(
JAST::TryCatch.new( :try($tryil), :catch($catchil), :type($TYPE_EX_UNWIND) ),
$*HANDLER_IDX, $handler));
# Evaluate to the result.
$il.append(JAST::Instruction.new( :op('aload'), $result ));
result($il, $RT_OBJ);
});
# Control exception throwing.
my %control_map := nqp::hash(
'next', $EX_CAT_NEXT,
'last', $EX_CAT_LAST,
'redo', $EX_CAT_REDO
);
QAST::OperationsJAST.add_core_op('control', -> $qastcomp, $op {
my $name := $op.name;
if nqp::existskey(%control_map, $name) {
my $cat := %control_map{$name};
my $il := JAST::InstructionList.new();
$il.append(JAST::PushIVal.new( :value($cat) ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'throwcatdyn', $TYPE_SMO, 'Long', $TYPE_TC ));
result($il, $RT_OBJ);
}
else {
nqp::die("Unknown control exception type '$name'");
}
});
# Default ways to box/unbox (for no particular HLL).
QAST::OperationsJAST.add_hll_box('', $RT_INT, -> $qastcomp {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'bootint', $TYPE_SMO, $TYPE_TC ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'box_i', $TYPE_SMO, 'Long', $TYPE_SMO, $TYPE_TC ));
$il
});
QAST::OperationsJAST.add_hll_box('', $RT_NUM, -> $qastcomp {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'bootnum', $TYPE_SMO, $TYPE_TC ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'box_n', $TYPE_SMO, 'Double', $TYPE_SMO, $TYPE_TC ));
$il
});
QAST::OperationsJAST.add_hll_box('', $RT_STR, -> $qastcomp {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'bootstr', $TYPE_SMO, $TYPE_TC ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'box_s', $TYPE_SMO, $TYPE_STR, $TYPE_SMO, $TYPE_TC ));
$il
});
QAST::OperationsJAST.add_hll_unbox('', $RT_INT, -> $qastcomp {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'unbox_i', 'Long', $TYPE_SMO, $TYPE_TC ));
$il
});
QAST::OperationsJAST.add_hll_unbox('', $RT_NUM, -> $qastcomp {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'unbox_n', 'Double', $TYPE_SMO, $TYPE_TC ));
$il
});
QAST::OperationsJAST.add_hll_unbox('', $RT_STR, -> $qastcomp {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'unbox_s', $TYPE_STR, $TYPE_SMO, $TYPE_TC ));
$il
});
# Context introspection; note that lexpads and contents are actually the same object
# in the JVM port, which allows a little op re-use.
QAST::OperationsJAST.map_classlib_core_op('ctx', $TYPE_OPS, 'ctx', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('ctxouter', $TYPE_OPS, 'ctxouter', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('ctxcaller', $TYPE_OPS, 'ctxcaller', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('curcode', $TYPE_OPS, 'curcode', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('callercode', $TYPE_OPS, 'callercode', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('ctxlexpad', $TYPE_OPS, 'ctxlexpad', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('curlexpad', $TYPE_OPS, 'ctx', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('lexprimspec', $TYPE_OPS, 'lexprimspec', [$RT_OBJ, $RT_STR], $RT_INT, :tc);
# Argument capture processing, for writing things like multi-dispatchers in
# high level languages.
QAST::OperationsJAST.add_core_op('usecapture', -> $qastcomp, $op {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('aload'), 'csd' ));
$il.append(JAST::Instruction.new( :op('aload'), '__args' ));
$il.append(JAST::Instruction.new( :op('invokestatic'),
$TYPE_OPS, 'usecapture', $TYPE_SMO, $TYPE_TC, $TYPE_CSD, "[$TYPE_OBJ" ));
result($il, $RT_OBJ)
});
QAST::OperationsJAST.add_core_op('savecapture', -> $qastcomp, $op {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('aload'), 'csd' ));
$il.append(JAST::Instruction.new( :op('aload'), '__args' ));
$il.append(JAST::Instruction.new( :op('invokestatic'),
$TYPE_OPS, 'savecapture', $TYPE_SMO, $TYPE_TC, $TYPE_CSD, "[$TYPE_OBJ" ));
result($il, $RT_OBJ)
});
QAST::OperationsJAST.map_classlib_core_op('captureposelems', $TYPE_OPS, 'captureposelems', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('captureposarg', $TYPE_OPS, 'captureposarg', [$RT_OBJ, $RT_INT], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('captureposarg_i', $TYPE_OPS, 'captureposarg_i', [$RT_OBJ, $RT_INT], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('captureposarg_n', $TYPE_OPS, 'captureposarg_n', [$RT_OBJ, $RT_INT], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('captureposarg_s', $TYPE_OPS, 'captureposarg_s', [$RT_OBJ, $RT_INT], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('captureposprimspec', $TYPE_OPS, 'captureposprimspec', [$RT_OBJ, $RT_INT], $RT_INT, :tc);
# Multiple dispatch related.
QAST::OperationsJAST.map_classlib_core_op('invokewithcapture', $TYPE_OPS, 'invokewithcapture', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('multicacheadd', $TYPE_OPS, 'multicacheadd', [$RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('multicachefind', $TYPE_OPS, 'multicachefind', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
# Constant mapping.
my %const_map := nqp::hash(
'CCLASS_ANY', 65535,
'CCLASS_UPPERCASE', 1,
'CCLASS_LOWERCASE', 2,
'CCLASS_ALPHABETIC', 4,
'CCLASS_NUMERIC', 8,
'CCLASS_HEXADECIMAL', 16,
'CCLASS_WHITESPACE', 32,
'CCLASS_BLANK', 256,
'CCLASS_CONTROL', 512,
'CCLASS_PUNCTUATION', 1024,
'CCLASS_ALPHANUMERIC', 2048,
'CCLASS_NEWLINE', 4096,
'CCLASS_WORD', 8192
);
QAST::OperationsJAST.add_core_op('const', -> $qastcomp, $op {
if nqp::existskey(%const_map, $op.name) {
$qastcomp.as_jast(QAST::IVal.new( :value(%const_map{$op.name}) ))
}
else {
nqp::die("Unknown constant '" ~ $op.name ~ "'");
}
});
# Default way to do positional and associative lookups.
QAST::OperationsJAST.map_classlib_core_op('positional_get', $TYPE_OPS, 'atpos', [$RT_OBJ, $RT_INT], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('positional_bind', $TYPE_OPS, 'bindpos', [$RT_OBJ, $RT_INT, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('associative_get', $TYPE_OPS, 'atkey', [$RT_OBJ, $RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('associative_bind', $TYPE_OPS, 'bindkey', [$RT_OBJ, $RT_STR, $RT_OBJ], $RT_OBJ, :tc);
# I/O opcodes
QAST::OperationsJAST.map_classlib_core_op('print', $TYPE_OPS, 'print', [$RT_STR], $RT_STR);
QAST::OperationsJAST.map_classlib_core_op('say', $TYPE_OPS, 'say', [$RT_STR], $RT_STR);
QAST::OperationsJAST.map_classlib_core_op('stat', $TYPE_OPS, 'stat', [$RT_STR, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('open', $TYPE_OPS, 'open', [$RT_STR, $RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('getstdin', $TYPE_OPS, 'getstdin', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('getstdout', $TYPE_OPS, 'getstdout', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('getstderr', $TYPE_OPS, 'getstderr', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('setencoding', $TYPE_OPS, 'setencoding', [$RT_OBJ, $RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('tellfh', $TYPE_OPS, 'tellfh', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('printfh', $TYPE_OPS, 'printfh', [$RT_OBJ, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('sayfh', $TYPE_OPS, 'sayfh', [$RT_OBJ, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('readlinefh', $TYPE_OPS, 'readlinefh', [$RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('readlineintfh', $TYPE_OPS, 'readlineintfh', [$RT_OBJ, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('readallfh', $TYPE_OPS, 'readallfh', [$RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('eoffh', $TYPE_OPS, 'eoffh', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('closefh', $TYPE_OPS, 'closefh', [$RT_OBJ], $RT_OBJ, :tc);
# terms
QAST::OperationsJAST.map_classlib_core_op('time_i', $TYPE_OPS, 'time_i', [], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('time_n', $TYPE_OPS, 'time_n', [], $RT_NUM);
# Arithmetic ops
QAST::OperationsJAST.map_jvm_core_op('add_i', 'ladd', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('add_I', $TYPE_OPS, 'add_I', [$RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_jvm_core_op('add_n', 'dadd', [$RT_NUM, $RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_jvm_core_op('sub_i', 'lsub', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('sub_I', $TYPE_OPS, 'sub_I', [$RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_jvm_core_op('sub_n', 'dsub', [$RT_NUM, $RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_jvm_core_op('mul_i', 'lmul', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('mul_I', $TYPE_OPS, 'mul_I', [$RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_jvm_core_op('mul_n', 'dmul', [$RT_NUM, $RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_jvm_core_op('div_i', 'ldiv', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('div_I', $TYPE_OPS, 'div_I', [$RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('div_In', $TYPE_OPS, 'div_In', [$RT_OBJ, $RT_OBJ], $RT_NUM, :tc);
QAST::OperationsJAST.map_jvm_core_op('div_n', 'ddiv', [$RT_NUM, $RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_jvm_core_op('mod_i', 'lrem', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('mod_I', $TYPE_OPS, 'mod_I', [$RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('expmod_I', $TYPE_OPS, 'expmod_I', [$RT_OBJ, $RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('isprime_I', $TYPE_OPS, 'isprime_I', [$RT_OBJ, $RT_INT], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('rand_I', $TYPE_OPS, 'rand_I', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_jvm_core_op('mod_n', 'drem', [$RT_NUM, $RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('pow_n', $TYPE_MATH, 'pow', [$RT_NUM, $RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('pow_I', $TYPE_OPS, 'pow_I', [$RT_OBJ, $RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_jvm_core_op('neg_i', 'lneg', [$RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('neg_I', $TYPE_OPS, 'neg_I', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_jvm_core_op('neg_n', 'dneg', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('abs_i', $TYPE_MATH, 'abs', [$RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('abs_I', $TYPE_OPS, 'abs_I', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('abs_n', $TYPE_MATH, 'abs', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('ceil_n', $TYPE_MATH, 'ceil', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('floor_n', $TYPE_MATH, 'floor', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('ln_n', $TYPE_MATH, 'log', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('sqrt_n', $TYPE_MATH, 'sqrt', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('exp_n', $TYPE_MATH, 'exp', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('radix', $TYPE_OPS, 'radix', [$RT_INT, $RT_STR, $RT_INT, $RT_INT], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('radix_I', $TYPE_OPS, 'radix_I', [$RT_INT, $RT_STR, $RT_INT, $RT_INT, $RT_OBJ], $RT_OBJ, :tc);
# trig opcodes
QAST::OperationsJAST.map_classlib_core_op('sin_n', $TYPE_MATH, 'sin', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('asin_n', $TYPE_MATH, 'asin', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('cos_n', $TYPE_MATH, 'cos', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('acos_n', $TYPE_MATH, 'acos', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('tan_n', $TYPE_MATH, 'tan', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('atan_n', $TYPE_MATH, 'atan', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('atan2_n', $TYPE_MATH, 'atan2', [$RT_NUM, $RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('sinh_n', $TYPE_MATH, 'sinh', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('cosh_n', $TYPE_MATH, 'cosh', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('tanh_n', $TYPE_MATH, 'tanh', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('sec_n', $TYPE_OPS, 'sec_n', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('asec_n', $TYPE_OPS, 'asec_n', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('sech_n', $TYPE_OPS, 'sech_n', [$RT_NUM], $RT_NUM);
# esoteric math opcodes
QAST::OperationsJAST.map_classlib_core_op('gcd_i', $TYPE_OPS, 'gcd_i', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('gcd_I', $TYPE_OPS, 'gcd_I', [$RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('lcm_i', $TYPE_OPS, 'lcm_i', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('lcm_I', $TYPE_OPS, 'lcm_I', [$RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
# string opcodes
QAST::OperationsJAST.map_classlib_core_op('chars', $TYPE_OPS, 'chars', [$RT_STR], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('uc', $TYPE_OPS, 'uc', [$RT_STR], $RT_STR);
QAST::OperationsJAST.map_classlib_core_op('lc', $TYPE_OPS, 'lc', [$RT_STR], $RT_STR);
QAST::OperationsJAST.map_classlib_core_op('x', $TYPE_OPS, 'x', [$RT_STR, $RT_INT], $RT_STR);
QAST::OperationsJAST.map_classlib_core_op('iscclass', $TYPE_OPS, 'iscclass', [$RT_INT, $RT_STR, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('concat', $TYPE_OPS, 'concat', [$RT_STR, $RT_STR], $RT_STR);
QAST::OperationsJAST.map_classlib_core_op('chr', $TYPE_OPS, 'chr', [$RT_INT], $RT_STR);
QAST::OperationsJAST.map_classlib_core_op('join', $TYPE_OPS, 'join', [$RT_STR, $RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('split', $TYPE_OPS, 'split', [$RT_STR, $RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('findcclass', $TYPE_OPS, 'findcclass', [$RT_INT, $RT_STR, $RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('findnotcclass', $TYPE_OPS, 'findnotcclass', [$RT_INT, $RT_STR, $RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('sprintf', $TYPE_OPS, 'sprintf', [$RT_STR, $RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('escape', $TYPE_OPS, 'escape', [$RT_STR], $RT_STR);
QAST::OperationsJAST.map_classlib_core_op('flip', $TYPE_OPS, 'flip', [$RT_STR], $RT_STR);
# substr can take 2 or 3 args, so needs special handling.
QAST::OperationsJAST.map_classlib_core_op('substr2', $TYPE_OPS, 'substr2', [$RT_STR, $RT_INT], $RT_STR);
QAST::OperationsJAST.map_classlib_core_op('substr3', $TYPE_OPS, 'substr3', [$RT_STR, $RT_INT, $RT_INT], $RT_STR);
QAST::OperationsJAST.add_core_op('substr', -> $qastcomp, $op {
my @operands := $op.list;
$qastcomp.as_jast(+@operands == 2
?? QAST::Op.new( :op('substr2'), |@operands )
!! QAST::Op.new( :op('substr3'), |@operands ));
});
# ord can be on a the first char in a string or at a particular char.
QAST::OperationsJAST.map_classlib_core_op('ordfirst', $TYPE_OPS, 'ordfirst', [$RT_STR], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('ordat', $TYPE_OPS, 'ordat', [$RT_STR, $RT_INT], $RT_INT);
QAST::OperationsJAST.add_core_op('ord', -> $qastcomp, $op {
my @operands := $op.list;
$qastcomp.as_jast(+@operands == 1
?? QAST::Op.new( :op('ordfirst'), |@operands )
!! QAST::Op.new( :op('ordat'), |@operands ));
});
# index may or may not take a starting position
QAST::OperationsJAST.map_classlib_core_op('indexfrom', $TYPE_OPS, 'indexfrom', [$RT_STR, $RT_STR, $RT_INT], $RT_INT);
QAST::OperationsJAST.add_core_op('index', -> $qastcomp, $op {
my @operands := $op.list;
$qastcomp.as_jast(+@operands == 2
?? QAST::Op.new( :op('indexfrom'), |@operands, QAST::IVal.new( :value(0)) )
!! QAST::Op.new( :op('indexfrom'), |@operands ));
});
# rindex may or may not take a starting position
QAST::OperationsJAST.map_classlib_core_op('rindexfromend', $TYPE_OPS, 'rindexfromend', [$RT_STR, $RT_STR], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('rindexfrom', $TYPE_OPS, 'rindexfrom', [$RT_STR, $RT_STR, $RT_INT], $RT_INT);
QAST::OperationsJAST.add_core_op('rindex', -> $qastcomp, $op {
my @operands := $op.list;
$qastcomp.as_jast(+@operands == 2
?? QAST::Op.new( :op('rindexfromend'), |@operands )
!! QAST::Op.new( :op('rindexfrom'), |@operands ));
});
QAST::OperationsJAST.map_classlib_core_op('codepointfromname', $TYPE_OPS, 'codepointfromname', [$RT_STR], $RT_INT);
# serialization context opcodes
QAST::OperationsJAST.map_classlib_core_op('sha1', $TYPE_OPS, 'sha1', [$RT_STR], $RT_STR);
QAST::OperationsJAST.map_classlib_core_op('createsc', $TYPE_OPS, 'createsc', [$RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('scsetobj', $TYPE_OPS, 'scsetobj', [$RT_OBJ, $RT_INT, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('scsetcode', $TYPE_OPS, 'scsetcode', [$RT_OBJ, $RT_INT, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('scgetobj', $TYPE_OPS, 'scgetobj', [$RT_OBJ, $RT_INT], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('scgethandle', $TYPE_OPS, 'scgethandle', [$RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('scgetdesc', $TYPE_OPS, 'scgetdesc', [$RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('scgetobjidx', $TYPE_OPS, 'scgetobjidx', [$RT_OBJ, $RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('scsetdesc', $TYPE_OPS, 'scsetdesc', [$RT_OBJ, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('scobjcount', $TYPE_OPS, 'scobjcount', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('setobjsc', $TYPE_OPS, 'setobjsc', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('getobjsc', $TYPE_OPS, 'getobjsc', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('serialize', $TYPE_OPS, 'serialize', [$RT_OBJ, $RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('deserialize', $TYPE_OPS, 'deserialize', [$RT_STR, $RT_OBJ, $RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('wval', $TYPE_OPS, 'wval', [$RT_STR, $RT_INT], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('scwbdisable', $TYPE_OPS, 'scwbdisable', [], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('scwbenable', $TYPE_OPS, 'scwbenable', [], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('pushcompsc', $TYPE_OPS, 'pushcompsc', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('popcompsc', $TYPE_OPS, 'popcompsc', [], $RT_OBJ, :tc);
# bitwise opcodes
QAST::OperationsJAST.map_classlib_core_op('bitor_i', $TYPE_OPS, 'bitor_i', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('bitor_I', $TYPE_OPS, 'bitor_I', [$RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bitxor_i', $TYPE_OPS, 'bitxor_i', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('bitxor_I', $TYPE_OPS, 'bitxor_I', [$RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bitand_i', $TYPE_OPS, 'bitand_i', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('bitand_I', $TYPE_OPS, 'bitand_I', [$RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bitneg_i', $TYPE_OPS, 'bitneg_i', [$RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('bitneg_I', $TYPE_OPS, 'bitneg_I', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bitshiftl_i', $TYPE_OPS, 'bitshiftl_i', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('bitshiftl_I', $TYPE_OPS, 'bitshiftl_I', [$RT_OBJ, $RT_INT, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bitshiftr_i', $TYPE_OPS, 'bitshiftr_i', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('bitshiftr_I', $TYPE_OPS, 'bitshiftr_I', [$RT_OBJ, $RT_INT, $RT_OBJ], $RT_OBJ, :tc);
# relational opcodes
QAST::OperationsJAST.map_classlib_core_op('cmp_i', $TYPE_OPS, 'cmp_i', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('iseq_i', $TYPE_OPS, 'iseq_i', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('isne_i', $TYPE_OPS, 'isne_i', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('islt_i', $TYPE_OPS, 'islt_i', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('isle_i', $TYPE_OPS, 'isle_i', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('isgt_i', $TYPE_OPS, 'isgt_i', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('isge_i', $TYPE_OPS, 'isge_i', [$RT_INT, $RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('bool_I', $TYPE_OPS, 'bool_I', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('cmp_I', $TYPE_OPS, 'cmp_I', [$RT_OBJ, $RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('iseq_I', $TYPE_OPS, 'iseq_I', [$RT_OBJ, $RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('isne_I', $TYPE_OPS, 'isne_I', [$RT_OBJ, $RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('islt_I', $TYPE_OPS, 'islt_I', [$RT_OBJ, $RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('isle_I', $TYPE_OPS, 'isle_I', [$RT_OBJ, $RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('isgt_I', $TYPE_OPS, 'isgt_I', [$RT_OBJ, $RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('isge_I', $TYPE_OPS, 'isge_I', [$RT_OBJ, $RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('cmp_n', $TYPE_OPS, 'cmp_n', [$RT_NUM, $RT_NUM], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('iseq_n', $TYPE_OPS, 'iseq_n', [$RT_NUM, $RT_NUM], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('isne_n', $TYPE_OPS, 'isne_n', [$RT_NUM, $RT_NUM], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('islt_n', $TYPE_OPS, 'islt_n', [$RT_NUM, $RT_NUM], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('isle_n', $TYPE_OPS, 'isle_n', [$RT_NUM, $RT_NUM], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('isgt_n', $TYPE_OPS, 'isgt_n', [$RT_NUM, $RT_NUM], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('isge_n', $TYPE_OPS, 'isge_n', [$RT_NUM, $RT_NUM], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('cmp_s', $TYPE_OPS, 'cmp_s', [$RT_STR, $RT_STR], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('iseq_s', $TYPE_OPS, 'iseq_s', [$RT_STR, $RT_STR], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('isne_s', $TYPE_OPS, 'isne_s', [$RT_STR, $RT_STR], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('islt_s', $TYPE_OPS, 'islt_s', [$RT_STR, $RT_STR], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('isle_s', $TYPE_OPS, 'isle_s', [$RT_STR, $RT_STR], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('isgt_s', $TYPE_OPS, 'isgt_s', [$RT_STR, $RT_STR], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('isge_s', $TYPE_OPS, 'isge_s', [$RT_STR, $RT_STR], $RT_INT);
# bigint ops
QAST::OperationsJAST.map_classlib_core_op('fromstr_I', $TYPE_OPS, 'fromstr_I', [$RT_STR, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('tostr_I', $TYPE_OPS, 'tostr_I', [$RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('base_I', $TYPE_OPS, 'base_I', [$RT_OBJ, $RT_INT], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('isbig_I', $TYPE_OPS, 'isbig_I', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('fromnum_I', $TYPE_OPS, 'fromnum_I', [$RT_NUM, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('tonum_I', $TYPE_OPS, 'tonum_I', [$RT_OBJ], $RT_NUM, :tc);
# boolean opcodes
QAST::OperationsJAST.map_classlib_core_op('not_i', $TYPE_OPS, 'not_i', [$RT_INT], $RT_INT);
# aggregate opcodes
QAST::OperationsJAST.map_classlib_core_op('atpos', $TYPE_OPS, 'atpos', [$RT_OBJ, $RT_INT], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('atpos_i', $TYPE_OPS, 'atpos_i', [$RT_OBJ, $RT_INT], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('atpos_n', $TYPE_OPS, 'atpos_n', [$RT_OBJ, $RT_INT], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('atpos_s', $TYPE_OPS, 'atpos_s', [$RT_OBJ, $RT_INT], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('atkey', $TYPE_OPS, 'atkey', [$RT_OBJ, $RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('atkey_i', $TYPE_OPS, 'atkey_i', [$RT_OBJ, $RT_STR], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('atkey_n', $TYPE_OPS, 'atkey_n', [$RT_OBJ, $RT_STR], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('atkey_s', $TYPE_OPS, 'atkey_s', [$RT_OBJ, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindpos', $TYPE_OPS, 'bindpos', [$RT_OBJ, $RT_INT, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindpos_i', $TYPE_OPS, 'bindpos_i', [$RT_OBJ, $RT_INT, $RT_INT], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindpos_n', $TYPE_OPS, 'bindpos_n', [$RT_OBJ, $RT_INT, $RT_NUM], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindpos_s', $TYPE_OPS, 'bindpos_s', [$RT_OBJ, $RT_INT, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindkey', $TYPE_OPS, 'bindkey', [$RT_OBJ, $RT_STR, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindkey_i', $TYPE_OPS, 'bindkey_i', [$RT_OBJ, $RT_STR, $RT_INT], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindkey_n', $TYPE_OPS, 'bindkey_n', [$RT_OBJ, $RT_STR, $RT_NUM], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindkey_s', $TYPE_OPS, 'bindkey_s', [$RT_OBJ, $RT_STR, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('existspos', $TYPE_OPS, 'existspos', [$RT_OBJ, $RT_INT], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('existskey', $TYPE_OPS, 'existskey', [$RT_OBJ, $RT_STR], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('deletekey', $TYPE_OPS, 'deletekey', [$RT_OBJ, $RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('elems', $TYPE_OPS, 'elems', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('setelems', $TYPE_OPS, 'setelems', [$RT_OBJ, $RT_INT], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('push', $TYPE_OPS, 'push', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('push_i', $TYPE_OPS, 'push_i', [$RT_OBJ, $RT_INT], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('push_n', $TYPE_OPS, 'push_n', [$RT_OBJ, $RT_NUM], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('push_s', $TYPE_OPS, 'push_s', [$RT_OBJ, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('pop', $TYPE_OPS, 'pop', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('pop_i', $TYPE_OPS, 'pop_i', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('pop_n', $TYPE_OPS, 'pop_n', [$RT_OBJ], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('pop_s', $TYPE_OPS, 'pop_s', [$RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('unshift', $TYPE_OPS, 'unshift', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('unshift_i', $TYPE_OPS, 'unshift_i', [$RT_OBJ, $RT_INT], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('unshift_n', $TYPE_OPS, 'unshift_n', [$RT_OBJ, $RT_NUM], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('unshift_s', $TYPE_OPS, 'unshift_s', [$RT_OBJ, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('shift', $TYPE_OPS, 'shift', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('shift_i', $TYPE_OPS, 'shift_i', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('shift_n', $TYPE_OPS, 'shift_n', [$RT_OBJ], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('shift_s', $TYPE_OPS, 'shift_s', [$RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('splice', $TYPE_OPS, 'splice', [$RT_OBJ, $RT_OBJ, $RT_INT, $RT_INT], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('isint', $TYPE_OPS, 'isint', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('isnum', $TYPE_OPS, 'isnum', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('isstr', $TYPE_OPS, 'isstr', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('islist', $TYPE_OPS, 'islist', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('ishash', $TYPE_OPS, 'ishash', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('iterator', $TYPE_OPS, 'iter', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('iterkey_s', $TYPE_OPS, 'iterkey_s', [$RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('iterval', $TYPE_OPS, 'iterval', [$RT_OBJ], $RT_OBJ, :tc);
# object opcodes
QAST::OperationsJAST.map_jvm_core_op('null', 'aconst_null', [], $RT_OBJ);
QAST::OperationsJAST.map_jvm_core_op('null_s', 'aconst_null', [], $RT_STR);
QAST::OperationsJAST.map_classlib_core_op('what', $TYPE_OPS, 'what', [$RT_OBJ], $RT_OBJ);
QAST::OperationsJAST.map_classlib_core_op('how', $TYPE_OPS, 'how', [$RT_OBJ], $RT_OBJ);
QAST::OperationsJAST.map_classlib_core_op('who', $TYPE_OPS, 'who', [$RT_OBJ], $RT_OBJ);
QAST::OperationsJAST.map_classlib_core_op('where', $TYPE_OPS, 'where', [$RT_OBJ], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('findmethod', $TYPE_OPS, 'findmethod', [$RT_OBJ, $RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('setwho', $TYPE_OPS, 'setwho', [$RT_OBJ, $RT_OBJ], $RT_OBJ);
QAST::OperationsJAST.map_classlib_core_op('rebless', $TYPE_OPS, 'rebless', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('knowhow', $TYPE_OPS, 'knowhow', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('knowhowattr', $TYPE_OPS, 'knowhowattr', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bootint', $TYPE_OPS, 'bootint', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bootnum', $TYPE_OPS, 'bootnum', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bootstr', $TYPE_OPS, 'bootstr', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bootarray', $TYPE_OPS, 'bootarray', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bootintarray', $TYPE_OPS, 'bootintarray', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bootnumarray', $TYPE_OPS, 'bootnumarray', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bootstrarray', $TYPE_OPS, 'bootstrarray', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('boothash', $TYPE_OPS, 'boothash', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('hlllist', $TYPE_OPS, 'hlllist', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('hllhash', $TYPE_OPS, 'hllhash', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('create', $TYPE_OPS, 'create', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('clone', $TYPE_OPS, 'clone', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('isconcrete', $TYPE_OPS, 'isconcrete', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('iscont', $TYPE_OPS, 'iscont', [$RT_OBJ], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('decont', $TYPE_OPS, 'decont', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('isnull', $TYPE_OPS, 'isnull', [$RT_OBJ], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('isnull_s', $TYPE_OPS, 'isnull_s', [$RT_STR], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('istrue', $TYPE_OPS, 'istrue', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('isfalse', $TYPE_OPS, 'isfalse', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('istype', $TYPE_OPS, 'istype', [$RT_OBJ, $RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('eqaddr', $TYPE_OPS, 'eqaddr', [$RT_OBJ, $RT_OBJ], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('getattr', $TYPE_OPS, 'getattr', [$RT_OBJ, $RT_OBJ, $RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('getattr_i', $TYPE_OPS, 'getattr_i', [$RT_OBJ, $RT_OBJ, $RT_STR], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('getattr_n', $TYPE_OPS, 'getattr_n', [$RT_OBJ, $RT_OBJ, $RT_STR], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('getattr_s', $TYPE_OPS, 'getattr_s', [$RT_OBJ, $RT_OBJ, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindattr', $TYPE_OPS, 'bindattr', [$RT_OBJ, $RT_OBJ, $RT_STR, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindattr_i', $TYPE_OPS, 'bindattr_i', [$RT_OBJ, $RT_OBJ, $RT_STR, $RT_INT], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindattr_n', $TYPE_OPS, 'bindattr_n', [$RT_OBJ, $RT_OBJ, $RT_STR, $RT_NUM], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindattr_s', $TYPE_OPS, 'bindattr_s', [$RT_OBJ, $RT_OBJ, $RT_STR, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('attrinited', $TYPE_OPS, 'attrinited', [$RT_OBJ, $RT_OBJ, $RT_STR], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('unbox_i', $TYPE_OPS, 'unbox_i', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('unbox_n', $TYPE_OPS, 'unbox_n', [$RT_OBJ], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('unbox_s', $TYPE_OPS, 'unbox_s', [$RT_OBJ], $RT_STR, :tc);
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('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);
QAST::OperationsJAST.map_classlib_core_op('newtype', $TYPE_OPS, 'newtype', [$RT_OBJ, $RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('composetype', $TYPE_OPS, 'composetype', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('setboolspec', $TYPE_OPS, 'setboolspec', [$RT_OBJ, $RT_INT, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('setmethcache', $TYPE_OPS, 'setmethcache', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('setmethcacheauth', $TYPE_OPS, 'setmethcacheauth', [$RT_OBJ, $RT_INT], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('settypecache', $TYPE_OPS, 'settypecache', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('settypecheckmode', $TYPE_OPS, 'settypecheckmode', [$RT_OBJ, $RT_INT], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('objprimspec', $TYPE_OPS, 'objprimspec', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('isinvokable', $TYPE_OPS, 'isinvokable', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('setinvokespec', $TYPE_OPS, 'setinvokespec', [$RT_OBJ, $RT_OBJ, $RT_STR, $RT_OBJ], $RT_OBJ, :tc);
# defined - overridden by HLL, but by default same as .DEFINITE.
QAST::OperationsJAST.map_classlib_core_op('defined', $TYPE_OPS, 'isconcrete', [$RT_OBJ], $RT_INT, :tc);
# lexical related opcodes
QAST::OperationsJAST.map_classlib_core_op('getlex', $TYPE_OPS, 'getlex', [$RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('getlex_i', $TYPE_OPS, 'getlex_i', [$RT_STR], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('getlex_n', $TYPE_OPS, 'getlex_n', [$RT_STR], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('getlex_s', $TYPE_OPS, 'getlex_s', [$RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindlex', $TYPE_OPS, 'bindlex', [$RT_STR, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindlex_i', $TYPE_OPS, 'bindlex_i', [$RT_STR, $RT_INT], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindlex_n', $TYPE_OPS, 'bindlex_n', [$RT_STR, $RT_NUM], $RT_NUM, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindlex_s', $TYPE_OPS, 'bindlex_s', [$RT_STR, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('getlexdyn', $TYPE_OPS, 'getlexdyn', [$RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindlexdyn', $TYPE_OPS, 'bindlexdyn', [$RT_STR, $RT_OBJ], $RT_OBJ, :tc);
# code object related opcodes
QAST::OperationsJAST.map_classlib_core_op('takeclosure', $TYPE_OPS, 'takeclosure', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('getcodeobj', $TYPE_OPS, 'getcodeobj', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('setcodeobj', $TYPE_OPS, 'setcodeobj', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('getcodename', $TYPE_OPS, 'getcodename', [$RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('setcodename', $TYPE_OPS, 'setcodename', [$RT_OBJ, $RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('getcodecuid', $TYPE_OPS, 'getcodecuid', [$RT_OBJ], $RT_STR, :tc);
QAST::OperationsJAST.add_core_op('setstaticlex', -> $qastcomp, $op {
if +@($op) != 3 {
nqp::die('setstaticlex requires three operands');
}
unless nqp::istype($op[0], QAST::Block) {
nqp::die('First operand to setstaticlex must be a QAST::Block');
}
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_0') ));
my $obj_res := $qastcomp.as_jast($op[2], :want($RT_OBJ));
$il.append($obj_res.jast);
$*STACK.obtain($il, $obj_res);
my $name_res := $qastcomp.as_jast($op[1], :want($RT_STR));
$il.append($name_res.jast);
$*STACK.obtain($il, $name_res);
$il.append(JAST::PushSVal.new( :value($op[0].cuid) ));
$il.append(JAST::Instruction.new( :op('invokevirtual'),
$TYPE_CU, 'setStaticLex', $TYPE_SMO, $TYPE_SMO, $TYPE_STR, $TYPE_STR ));
result($il, $RT_OBJ)
});
QAST::OperationsJAST.map_classlib_core_op('forceouterctx', $TYPE_OPS, 'forceouterctx', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('freshcoderef', $TYPE_OPS, 'freshcoderef', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('markcodestatic', $TYPE_OPS, 'markcodestatic', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('markcodestub', $TYPE_OPS, 'markcodestub', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('getstaticcode', $TYPE_OPS, 'getstaticcode', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.add_core_op('setdispatcher', -> $qastcomp, $op {
if +@($op) != 1 {
nqp::die('setdispatcher requires one operand');
}
my $il := JAST::InstructionList.new();
my $dispres := $qastcomp.as_jast($op[0], :want($RT_OBJ));
$il.append($dispres.jast);
$*STACK.obtain($il, $dispres);
$il.append(JAST::Instruction.new( :op('dup') ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('swap') ));
$il.append(JAST::Instruction.new( :op('putfield'), $TYPE_TC, 'currentDispatcher', $TYPE_SMO ));
result($il, $RT_OBJ);
});
QAST::OperationsJAST.add_core_op('takedispatcher', -> $qastcomp, $op {
if +@($op) != 1 || !nqp::istype($op[0], QAST::SVal) {
nqp::die('takedispatcher requires one string literal operand');
}
my $idx := $*BLOCK.lexical_type($op[0].value);
unless nqp::defined($idx) {
nqp::die('takedispatcher used with non-existing lexical');
}
my $il := JAST::InstructionList.new();
$il.append(JAST::PushIndex.new( :value($idx) ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('invokestatic'),
$TYPE_OPS, 'takedispatcher', 'V', 'I', $TYPE_TC ));
result($il, $RT_VOID);
});
# language/compiler ops
QAST::OperationsJAST.map_classlib_core_op('getcomp', $TYPE_OPS, 'getcomp', [$RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindcomp', $TYPE_OPS, 'bindcomp', [$RT_STR, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('getcurhllsym', $TYPE_OPS, 'getcurhllsym', [$RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindcurhllsym', $TYPE_OPS, 'bindcurhllsym', [$RT_STR, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('gethllsym', $TYPE_OPS, 'gethllsym', [$RT_STR, $RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('bindhllsym', $TYPE_OPS, 'bindhllsym', [$RT_STR, $RT_STR, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('sethllconfig', $TYPE_OPS, 'sethllconfig', [$RT_STR, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('loadbytecode', $TYPE_OPS, 'loadbytecode', [$RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('usecompilerhllconfig', $TYPE_OPS, 'usecompilerhllconfig', [], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('usecompileehllconfig', $TYPE_OPS, 'usecompileehllconfig', [], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('settypehll', $TYPE_OPS, 'settypehll', [$RT_OBJ, $RT_STR], $RT_OBJ, :tc);
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);
# regex engine related opcodes
QAST::OperationsJAST.map_classlib_core_op('nfafromstatelist', $TYPE_OPS, 'nfafromstatelist', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('nfatostatelist', $TYPE_OPS, 'nfatostatelist', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('nfarunproto', $TYPE_OPS, 'nfarunproto', [$RT_OBJ, $RT_STR, $RT_INT], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('nfarunalt', $TYPE_OPS, 'nfarunalt', [$RT_OBJ, $RT_STR, $RT_INT, $RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
# process related opcodes
QAST::OperationsJAST.map_classlib_core_op('exit', $TYPE_OPS, 'exit', [$RT_INT], $RT_INT);
QAST::OperationsJAST.map_classlib_core_op('sleep', $TYPE_OPS, 'sleep', [$RT_NUM], $RT_NUM);
QAST::OperationsJAST.map_classlib_core_op('getenvhash', $TYPE_OPS, 'getenvhash', [], $RT_OBJ, :tc);
# JVM-specific ops for compilation unit handling
QAST::OperationsJAST.map_classlib_core_op('compilejast', $TYPE_OPS, 'compilejast', [$RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('compilejasttofile', $TYPE_OPS, 'compilejasttofile', [$RT_STR, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('loadcompunit', $TYPE_OPS, 'loadcompunit', [$RT_OBJ, $RT_INT], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('iscompunit', $TYPE_OPS, 'iscompunit', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('compunitmainline', $TYPE_OPS, 'compunitmainline', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('compunitcodes', $TYPE_OPS, 'compunitcodes', [$RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('jvmclasspaths', $TYPE_OPS, 'jvmclasspaths', [], $RT_OBJ, :tc);
class QAST::CompilerJAST {
# Responsible for handling issues around code references, building the
# switch statement dispatcher, etc.
my class CodeRefBuilder {
has int $!cur_idx;
has %!cuid_to_idx;
has @!jastmeth_names;
has @!cuids;
has @!names;
has @!lexical_name_lists;
has @!outer_mappings;
has @!callsites;
has %!callsite_map;
has @!handlers;
method BUILD() {
$!cur_idx := 0;
%!cuid_to_idx := {};
@!jastmeth_names := [];
@!cuids := [];
@!names := [];
@!lexical_name_lists := [];
@!outer_mappings := [];
@!callsites := [];
%!callsite_map := {};
@!handlers := [];
}
my $nolex := [[],[],[],[]];
my $noargs := [0,0,0,0];
method register_method($jastmeth, $cuid, $name, @handlers) {
%!cuid_to_idx{$cuid} := $!cur_idx;
nqp::push(@!jastmeth_names, $jastmeth.name);
nqp::push(@!cuids, $cuid);
nqp::push(@!names, $name);
nqp::push(@!lexical_name_lists, $nolex);
nqp::push(@!handlers, @handlers);
$!cur_idx := $!cur_idx + 1;
}
method cuid_to_idx($cuid) {
nqp::existskey(%!cuid_to_idx, $cuid)
?? %!cuid_to_idx{$cuid}
!! nqp::die("Unknown CUID '$cuid'")
}
method cuid_to_jastmethname($cuid) {
@!jastmeth_names[self.cuid_to_idx($cuid)]
}
method set_lexical_names($cuid, @ilex, @nlex, @slex, @olex) {
@!lexical_name_lists[self.cuid_to_idx($cuid)] := [@ilex, @nlex, @slex, @olex];
}
method set_outer($cuid, $outer_cuid) {
nqp::push(@!outer_mappings,
[self.cuid_to_idx($cuid), self.cuid_to_idx($outer_cuid)]);
}
method get_callsite_idx(@arg_types, @arg_names) {
my $key := join("-", @arg_types) ~ ';' ~ join("\0", @arg_names);
if nqp::existskey(%!callsite_map, $key) {
return %!callsite_map{$key};
}
else {
my $idx := +@!callsites;
nqp::push(@!callsites, [@arg_types, @arg_names]);
%!callsite_map{$key} := $idx;
return $idx;
}
}
method jastify() {
self.coderef_array();
self.outer_map_array();
self.callsites();
}
# Emits the code-ref array construction.
method coderef_array() {
my $cra := JAST::Method.new( :name('getCodeRefs'), :returns("[$TYPE_CR;"), :static(0) );
# Get method handle lookup object.
$cra.add_local('mhl', $TYPE_MHL);
$cra.append(JAST::Instruction.new( :op('invokestatic'),
$TYPE_MHS, 'lookup', $TYPE_MHL ));
$cra.append(JAST::Instruction.new( :op('astore'), 'mhl' ));
# Everything is same type at the moment; construct MethodType.
$cra.add_local('mt', $TYPE_MT);
$cra.append(JAST::Instruction.new( :op('getstatic'),
'Ljava/lang/Void;', 'TYPE', $TYPE_CLASS ));
$cra.append(JAST::PushCVal.new( :value($TYPE_TC) ));
$cra.append(JAST::PushIndex.new( :value(3) ));
$cra.append(JAST::Instruction.new( :op('anewarray'), $TYPE_CLASS ));
$cra.append(JAST::Instruction.new( :op('dup') ));
$cra.append(JAST::PushIndex.new( :value(0) ));
$cra.append(JAST::PushCVal.new( :value($TYPE_CR) ));
$cra.append(JAST::Instruction.new( :op('aastore') ));
$cra.append(JAST::Instruction.new( :op('dup') ));
$cra.append(JAST::PushIndex.new( :value(1) ));
$cra.append(JAST::PushCVal.new( :value($TYPE_CSD) ));
$cra.append(JAST::Instruction.new( :op('aastore') ));
$cra.append(JAST::Instruction.new( :op('dup') ));
$cra.append(JAST::PushIndex.new( :value(2) ));
$cra.append(JAST::PushCVal.new( :value("[$TYPE_OBJ") ));
$cra.append(JAST::Instruction.new( :op('aastore') ));
$cra.append(JAST::Instruction.new( :op('invokestatic'),
$TYPE_MT, 'methodType', $TYPE_MT, $TYPE_CLASS, $TYPE_CLASS, "[$TYPE_CLASS" ));
$cra.append(JAST::Instruction.new( :op('astore'), 'mt' ));
# Create array.
$cra.append(JAST::PushIndex.new( :value($!cur_idx) ));
$cra.append(JAST::Instruction.new( :op('anewarray'), $TYPE_CR ));
# Add all the code-refs.
my $TYPE_STRARR := "[$TYPE_STR;";
my int $i := 0;
while $i < $!cur_idx {
$cra.append(JAST::Instruction.new( :op('dup') )); # The target array
$cra.append(JAST::PushIndex.new( :value($i) )); # The array index
$cra.append(JAST::Instruction.new( :op('new'), $TYPE_CR ));
$cra.append(JAST::Instruction.new( :op('dup') ));
# Compilation unit.
$cra.append(JAST::Instruction.new( :op('aload_0') ));
# Method handle.
$cra.append(JAST::Instruction.new( :op('aload'), 'mhl' ));
$cra.append(JAST::PushCVal.new( :value('L' ~ $*JCLASS.name ~ ';') ));
$cra.append(JAST::PushSVal.new( :value(@!jastmeth_names[$i]) ));
$cra.append(JAST::Instruction.new( :op('aload'), 'mt' ));
$cra.append(JAST::Instruction.new( :op('invokevirtual'),
$TYPE_MHL, 'findVirtual', $TYPE_MH, $TYPE_CLASS, $TYPE_STR, $TYPE_MT ));
$cra.append(JAST::Instruction.new( :op('aload_0') ));
$cra.append(JAST::Instruction.new( :op('invokevirtual'),
$TYPE_MH, 'bindTo', $TYPE_MH, $TYPE_OBJ ));
# Name and comp-unit unique ID.
$cra.append(JAST::PushSVal.new( :value(@!names[$i]) ));
$cra.append(JAST::PushSVal.new( :value(@!cuids[$i]) ));
for @!lexical_name_lists[$i] {
if $_ {
$cra.append(JAST::PushSVal.new( :value(nqp::join("\0", $_)) ));
}
else {
$cra.append(JAST::Instruction.new( :op('aconst_null') ));
}
}
$cra.append(JAST::PushIndex.new( :value(+@!handlers[$i]) ));
$cra.append(JAST::Instruction.new( :op('anewarray'), "[J" ));
my $hidx := 0;
for @!handlers[$i] {
$cra.append(JAST::Instruction.new( :op('dup') ));
$cra.append(JAST::PushIndex.new( :value($hidx++) ));
$cra.append(JAST::PushIndex.new( :value(nqp::elems($_)) ));
$cra.append(JAST::Instruction.new( :op('newarray'), "J" ));
my $idx := 0;
for $_ {
$cra.append(JAST::Instruction.new( :op('dup') ));
$cra.append(JAST::PushIndex.new( :value($idx++) ));
$cra.append(JAST::PushIVal.new( :value($_) ));
$cra.append(JAST::Instruction.new( :op('lastore') ));
}
$cra.append(JAST::Instruction.new( :op('aastore') ));
}
$cra.append(JAST::Instruction.new( :op('invokespecial'),
$TYPE_CR, '<init>',
'Void', $TYPE_CU, $TYPE_MH, $TYPE_STR, $TYPE_STR,
$TYPE_STR, $TYPE_STR, $TYPE_STR, $TYPE_STR,
"[[J"));
$cra.append(JAST::Instruction.new( :op('aastore') )); # Push to the array
$i++;
}
# Return the array. Add method to class.
$cra.append(JAST::Instruction.new( :op('areturn') ));
$*JCLASS.add_method($cra);
}
# Emits the mappings of code refs to their outer code refs.
method outer_map_array() {
my $oma := JAST::Method.new( :name('getOuterMap'), :returns("[Integer;"), :static(0) );
# Create array.
$oma.append(JAST::PushIndex.new( :value(2 * @!outer_mappings) ));
$oma.append(JAST::Instruction.new( :op('newarray'), 'Integer' ));
# Add all the mappings.
my int $i := 0;
for @!outer_mappings -> @m {
for @m {
$oma.append(JAST::Instruction.new( :op('dup') ));
$oma.append(JAST::PushIndex.new( :value($i++) ));
$oma.append(JAST::PushIndex.new( :value($_) ));
$oma.append(JAST::Instruction.new( :op('iastore') ));
}
}
# Return the array. Add method to class.
$oma.append(JAST::Instruction.new( :op('areturn') ));
$*JCLASS.add_method($oma);
}
method callsites() {
my $csa := JAST::Method.new( :name('getCallSites'), :returns("[$TYPE_CSD"), :static(0) );
# Create array.
$csa.append(JAST::PushIndex.new( :value(+@!callsites) ));
$csa.append(JAST::Instruction.new( :op('anewarray'), $TYPE_CSD ));
# All all the callsites
my int $i := 0;
for @!callsites -> @cs {
my @cs_flags := @cs[0];
my @cs_names := @cs[1];
$csa.append(JAST::Instruction.new( :op('dup') )); # Target array.
$csa.append(JAST::PushIndex.new( :value($i++) )); # Index.
$csa.append(JAST::Instruction.new( :op('new'), $TYPE_CSD ));
$csa.append(JAST::Instruction.new( :op('dup') ));
$csa.append(JAST::PushIndex.new( :value(+@cs_flags) ));
$csa.append(JAST::Instruction.new( :op('newarray'), 'Byte' ));
my int $j := 0;
for @cs_flags {
$csa.append(JAST::Instruction.new( :op('dup') ));
$csa.append(JAST::PushIndex.new( :value($j++) ));
$csa.append(JAST::PushIndex.new( :value($_) ));
$csa.append(JAST::Instruction.new( :op('i2b') ));
$csa.append(JAST::Instruction.new( :op('bastore') ));
}
if @cs_names {
$csa.append(JAST::PushIndex.new( :value(+@cs_names) ));
$csa.append(JAST::Instruction.new( :op('anewarray'), $TYPE_STR ));
$j := 0;
for @cs_names {
$csa.append(JAST::Instruction.new( :op('dup') ));
$csa.append(JAST::PushIndex.new( :value($j++) ));
$csa.append(JAST::PushSVal.new( :value($_) ));
$csa.append(JAST::Instruction.new( :op('aastore') ));
}
}
else {
$csa.append(JAST::Instruction.new( :op('aconst_null') ));
}
$csa.append(JAST::Instruction.new( :op('invokespecial'),
$TYPE_CSD, '<init>', 'Void', '[Byte', "[$TYPE_STR"));
$csa.append(JAST::Instruction.new( :op('aastore') ));
}
# Return the array. Add method to class.
$csa.append(JAST::Instruction.new( :op('areturn') ));
$*JCLASS.add_method($csa);
}
}
# Holds information about the QAST::Block we're currently compiling.
my class BlockInfo {
has $!qast; # The QAST::Block
has $!outer; # Outer block's BlockInfo
has @!params; # QAST::Var nodes of params
has @!locals; # QAST::Var nodes of declared locals
has @!lexicals; # QAST::Var nodes of declared lexicals
has %!local_types; # Mapping of local registers to type names
has %!lexical_types; # Mapping of lexical names to types
has %!lexical_idxs; # Lexical indexes (but have to know type too)
has @!lexical_names; # List by type of lexial name lists
method new($qast, $outer) {
my $obj := nqp::create(self);
$obj.BUILD($qast, $outer);
$obj
}
method BUILD($qast, $outer) {
$!qast := $qast;
$!outer := $outer;
@!params := nqp::list();
@!locals := nqp::list();
@!lexicals := nqp::list();
%!local_types := nqp::hash();
%!lexical_types := nqp::hash();
%!lexical_idxs := nqp::hash();
@!lexical_names := nqp::list([],[],[],[]);
}
method add_param($var) {
if $var.scope eq 'local' {
self.add_local($var);
}
else {
self.add_lexical($var);
}
@!params[+@!params] := $var;
}
method add_lexical($var) {
self.register_lexical($var);
@!lexicals[+@!lexicals] := $var;
}
method add_local($var) {
self.register_local($var);
@!locals[+@!locals] := $var;
}
method register_lexical($var) {
my $name := $var.name;
my $type := rttype_from_typeobj($var.returns);
if nqp::existskey(%!lexical_types, $name) {
nqp::die("Lexical '$name' already declared");
}
%!lexical_types{$name} := $type;
%!lexical_idxs{$name} := +@!lexical_names[$type];
nqp::push(@!lexical_names[$type], $name);
}
method register_local($var) {
my $name := $var.name;
if nqp::existskey(%!local_types, $name) {
nqp::die("Local '$name' already declared");
}
%!local_types{$name} := rttype_from_typeobj($var.returns);
}
method qast() { $!qast }
method outer() { $!outer }
method params() { @!params }
method lexicals() { @!lexicals }
method locals() { @!locals }
method local_type($name) { %!local_types{$name} }
method lexical_type($name) { %!lexical_types{$name} }
method lexical_idx($name) { %!lexical_idxs{$name} }
method lexical_names_by_type() { @!lexical_names }
}
my class BlockTempAlloc {
has int $!cur_i;
has int $!cur_n;
has int $!cur_s;
has int $!cur_o;
has @!free_i;
has @!free_n;
has @!free_s;
has @!free_o;
method fresh_i() {
@!free_i ?? nqp::pop(@!free_i) !! "__TMP_I_" ~ $!cur_i++
}
method fresh_n() {
@!free_n ?? nqp::pop(@!free_n) !! "__TMP_N_" ~ $!cur_n++
}
method fresh_s() {
@!free_s ?? nqp::pop(@!free_s) !! "__TMP_S_" ~ $!cur_s++
}
method fresh_o() {
@!free_o ?? nqp::pop(@!free_o) !! "__TMP_O_" ~ $!cur_o++
}
method release(@i, @n, @s, @o) {
for @i { nqp::push(@!free_i, $_) }
for @n { nqp::push(@!free_n, $_) }
for @s { nqp::push(@!free_s, $_) }
for @o { nqp::push(@!free_o, $_) }
}
method add_temps_to_method($jmeth) {
sub temps($prefix, $n, $type) {
my int $i := 0;
while $i < $n {
$jmeth.add_local("$prefix$i", $type);
$i++;
}
}
temps("__TMP_I_", $!cur_i, 'Long');
temps("__TMP_N_", $!cur_n, 'Double');
temps("__TMP_S_", $!cur_s, $TYPE_STR);
temps("__TMP_O_", $!cur_o, $TYPE_SMO);
}
}
my class StmtTempAlloc {
has @!used_i;
has @!used_n;
has @!used_s;
has @!used_o;
method fresh_i() {
my $al := $*BLOCK_TA.fresh_i();
nqp::push(@!used_i, $al);
$al
}
method fresh_n() {
my $al := $*BLOCK_TA.fresh_n();
nqp::push(@!used_n, $al);
$al
}
method fresh_s() {
my $al := $*BLOCK_TA.fresh_s();
nqp::push(@!used_s, $al);
$al
}
method fresh_o() {
my $al := $*BLOCK_TA.fresh_o();
nqp::push(@!used_o, $al);
$al
}
method release() {
$*BLOCK_TA.release(@!used_i, @!used_n, @!used_s, @!used_o)
}
}
method jast($source, :$classname!, *%adverbs) {
# Wrap $source in a QAST::Block if it's not already a viable root node.
$source := QAST::Block.new($source)
unless nqp::istype($source, QAST::CompUnit) || nqp::istype($source, QAST::Block);
# Set up a JAST::Class that will hold all the blocks (which become Java
# methods) that we shall compile.
my $*JCLASS := JAST::Class.new(
:name($classname),
:super('org.perl6.nqp.runtime.CompilationUnit')
);
# 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();
# Now compile $source. By the end of this, the various data structures
# set up above will be fully populated.
self.as_jast($source);
# Make various code-ref/dispatch related things.
$*CODEREFS.jastify();
# Finally, we hand back the finished class.
return $*JCLASS
}
# Tracks what is currently on the stack, and what things that were on the
# stack have been spilled to temporaries and thus will need re-instating
# at some point in the future.
my class StackState {
has @!stack;
has @!spill_locals;
method push($result) {
nqp::istype($result, Result)
?? nqp::push(@!stack, $result)
!! nqp::die("Can only push a Result onto the stack")
}
method obtain($il, *@things) {
# Sanity checks.
if nqp::elems(@things) == 0 {
nqp::die("Should not try to obtain zero stack elements");
}
if nqp::elems(@!stack) < nqp::elems(@things) {
nqp::die("Cannot obtain from empty or undersized stack");
}
# See if the things we need are all on the stack.
my int $sp := @!stack - +@things;
my int $tp := 0;
my int $ok := 1;
my int $all_stack := 1;
my int $all_local := 1;
while $tp < +@things {
unless nqp::istype(@things[$tp], Result) {
nqp::die("Should only look up Result objects on the stack");
}
unless nqp::eqaddr(@!stack[$sp], @things[$tp]) {
$ok := 0;
last;
}
if @!stack[$sp].local {
$all_stack := 0;
}
else {
$all_local := 0;
}
$sp++, $tp++;
}
if $ok {
# If they're all on the stack, easy.
if $all_stack {
for @things { nqp::pop(@!stack) }
return 1;
}
# If they're all local, load them onto the stack. Also, we can
# re-use the stack saving temporaries.
elsif $all_local {
for @things {
my $local := $_.local;
my $type := $_.type;
$il.append(JAST::Instruction.new( :op(load_ins($type)), $local ));
if nqp::islist(@!spill_locals[$type]) {
nqp::push(@!spill_locals[$type], $local);
}
else {
@!spill_locals[$type] := [$local];
}
nqp::pop(@!stack)
}
return 1;
}
# Mix of local and stack: just spill everything still on the
# stack, and try again.
else {
self.spill_to_locals($il);
return self.obtain($il, |@things);
}
}
# Otherwise, bad access.
nqp::die("Out-of-order access or re-use of stack items");
}
# Spills the currnet stack contents to local variables.
method spill_to_locals($il) {
sub obtain_temp($type) {
if $type == $RT_VOID {
nqp::die("Cannot spill a stack containing a void");
}
if @!spill_locals[$type] {
nqp::pop(@!spill_locals[$type])
}
else {
bfresh($type);
}
}
my $sp := nqp::elems(@!stack);
while $sp-- {
my $item := @!stack[$sp];
unless $item.local {
my $temp := obtain_temp($item.type);
$il.append(JAST::Instruction.new( :op(store_ins($item.type)), $temp ));
$item.set_local($temp);
}
}
}
}
our $serno;
INIT {
$serno := 10;
}
method unique($prefix = '') { $prefix ~ $serno++ }
proto method as_jast($node, :$want) {
my $*WANT;
if nqp::defined($want) {
$*WANT := %WANTMAP{$want} // $want;
if nqp::istype($node, QAST::Want) {
self.coerce(self.as_jast(want($node, $*WANT)), $*WANT)
}
else {
self.coerce({*}, $*WANT)
}
}
else {
{*}
}
}
multi method as_jast(QAST::CompUnit $cu, :$want) {
# A compilation-unit-wide source of IDs for handlers.
my $*EH_IDX := 1;
# Set HLL.
my $*HLL := '';
if $cu.hll {
$*HLL := $cu.hll;
}
# Should have a single child which is the outer block.
if +@($cu) != 1 || !nqp::istype($cu[0], QAST::Block) {
nqp::die("QAST::CompUnit should have one child that is a QAST::Block");
}
# Compile the block.
my $block_jast := self.as_jast($cu[0]);
# 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 $comp_mode := $cu.compilation_mode;
my @pre_des := $cu.pre_deserialize;
my @post_des := $cu.post_deserialize;
if $ENABLE_SC_COMP && ($comp_mode || @pre_des || @post_des) {
# Create a block into which we'll install all of the other
# pieces.
my $block := QAST::Block.new( :blocktype('raw') );
# Add pre-deserialization tasks, each as a QAST::Stmt.
for @pre_des {
$block.push(QAST::Stmt.new($_));
}
# If we need to do deserialization, emit code for that.
if $comp_mode {
$block.push(self.deserialization_code($cu.sc(), $cu.code_ref_blocks(),
$cu.repo_conflict_resolver()));
}
# Add post-deserialization tasks.
for @post_des {
$block.push(QAST::Stmt.new($_));
}
# Compile to JAST and register this block as the deserialization
# handler.
self.as_jast($block);
my $des_meth := JAST::Method.new( :name('deserializeIdx'), :returns('Integer'), :static(0) );
$des_meth.append(JAST::PushIndex.new( :value($*CODEREFS.cuid_to_idx($block.cuid)) ));
$des_meth.append(JAST::Instruction.new( :op('ireturn') ));
$*JCLASS.add_method($des_meth);
}
# Compile and include load-time logic, if any.
if nqp::defined($cu.load) {
my $load_block := QAST::Block.new(
:blocktype('raw'),
$cu.load,
QAST::Op.new( :op('null') )
);
self.as_jast($load_block);
my $load_meth := JAST::Method.new( :name('loadIdx'), :returns('Integer'), :static(0) );
$load_meth.append(JAST::PushIndex.new( :value($*CODEREFS.cuid_to_idx($load_block.cuid)) ));
$load_meth.append(JAST::Instruction.new( :op('ireturn') ));
$*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.
if nqp::defined($cu.main) {
my $main_block := QAST::Block.new(
:blocktype('raw'),
$cu.main,
QAST::Op.new( :op('null') )
);
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::PushIndex.new( :value($*CODEREFS.cuid_to_idx($main_block.cuid)) ));
$main_meth.append(JAST::Instruction.new( :op('aload_0') ));
$main_meth.append(JAST::Instruction.new( :op('invokestatic'),
$TYPE_CU, 'enterFromMain',
'Void', 'Ljava/lang/Class;', 'Integer', "[$TYPE_STR"));
$main_meth.append(JAST::Instruction.new( :op('return') ));
$*JCLASS.add_method($main_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::Instruction.new( :op('areturn') ));
$*JCLASS.add_method($hll_meth);
# Add method that returns the mainline block.
my $mainline_meth := JAST::Method.new( :name('mainlineIdx'), :returns('Integer'), :static(0) );
$mainline_meth.append(JAST::PushIndex.new( :value($*CODEREFS.cuid_to_idx($cu[0].cuid)) ));
$mainline_meth.append(JAST::Instruction.new( :op('ireturn') ));
$*JCLASS.add_method($mainline_meth);
return $*JCLASS;
}
method deserialization_code($sc, @code_ref_blocks, $repo_conf_res) {
# Serialize it.
my $sh := nqp::list_s();
my $serialized := nqp::serialize($sc, $sh);
# Now it's serialized, pop this SC off the compiling SC stack.
nqp::popcompsc();
# String heap QAST.
my $sh_ast := QAST::Op.new( :op('list_s') );
my $sh_elems := nqp::elems($sh);
my $i := 0;
while $i < $sh_elems {
$sh_ast.push(nqp::isnull_s(nqp::atpos_s($sh, $i))
?? QAST::Op.new( :op('null_s') )
!! QAST::SVal.new( :value(nqp::atpos_s($sh, $i)) ));
$i := $i + 1;
}
# Code references.
my $cr_past := QAST::Op.new( :op('list_b'), |@code_ref_blocks );
# Handle repossession conflict resolution code, if any.
if $repo_conf_res {
$repo_conf_res.push(QAST::Var.new( :name('conflicts'), :scope('local') ));
}
else {
$repo_conf_res := QAST::Op.new(
:op('die_s'),
QAST::SVal.new( :value('Repossession conflicts occurred during deserialization') )
);
}
# Overall deserialization QAST.
QAST::Stmts.new(
QAST::Op.new(
:op('bind'),
QAST::Var.new( :name('cur_sc'), :scope('local'), :decl('var') ),
QAST::Op.new( :op('createsc'), QAST::SVal.new( :value(nqp::scgethandle($sc)) ) )
),
QAST::Op.new(
:op('scsetdesc'),
QAST::Var.new( :name('cur_sc'), :scope('local') ),
QAST::SVal.new( :value(nqp::scgetdesc($sc)) )
),
QAST::Op.new(
:op('bind'),
QAST::Var.new( :name('conflicts'), :scope('local'), :decl('var') ),
QAST::Op.new( :op('list') )
),
QAST::Op.new(
:op('deserialize'),
QAST::SVal.new( :value($serialized) ),
QAST::Var.new( :name('cur_sc'), :scope('local') ),
$sh_ast,
QAST::Block.new( :blocktype('immediate'), $cr_past ),
QAST::Var.new( :name('conflicts'), :scope('local') )
),
QAST::Op.new(
:op('if'),
QAST::Op.new(
:op('elems'),
QAST::Var.new( :name('conflicts'), :scope('local') )
),
$repo_conf_res
)
)
}
multi method as_jast(QAST::Block $node, :$want) {
# Do block compilation in a tested block, so we can produce a result based on
# the containing block's stack.
{
# Block gets fresh BlockInfo.
my $*BINDVAL := 0;
my $outer := try $*BLOCK;
my $block := BlockInfo.new($node, $outer);
# This array will contain any catch/control exception handlers the
# block gets. A contextual lets us track nesting of handlers.
my @handlers;
my $*HANDLER_IDX := 0;
my &*REGISTER_UNWIND_HANDLER := sub ($outer, $category, :$ex_obj) {
my $unwind := $*EH_IDX++;
nqp::push(@handlers, [$unwind, $outer, $category,
$ex_obj ?? $EX_UNWIND_OBJECT !! $EX_UNWIND_SIMPLE]);
$unwind
}
my &*REGISTER_BLOCK_HANDLER := sub ($outer, $category, $lexidx) {
my $unwind := $*EH_IDX++;
nqp::push(@handlers, [$unwind, $outer, $category,
$EX_BLOCK, $lexidx]);
$unwind
}
# Create JAST method and register it with the block's compilation unit
# unique ID and name. (Note, always void return here as return values
# are handled out of band).
my $*JMETH := JAST::Method.new( :name(self.unique('qb_')), :returns('Void'), :static(0) );
$*CODEREFS.register_method($*JMETH, $node.cuid, $node.name, @handlers);
# Set outer if we have one.
if nqp::istype($outer, BlockInfo) {
$*CODEREFS.set_outer($node.cuid, $outer.qast.cuid);
}
# Always take ThreadContext and callsite descriptor as arguments.
$*JMETH.add_argument('tc', $TYPE_TC);
$*JMETH.add_argument('cr', $TYPE_CR);
$*JMETH.add_argument('csd', $TYPE_CSD);
$*JMETH.add_argument('__args', "[$TYPE_OBJ");
# Set up temporaries allocator.
my $*BLOCK_TA := BlockTempAlloc.new();
my $*TA := $*BLOCK_TA;
# Compile method body.
my $body;
my $*STACK := StackState.new();
{
my $*BLOCK := $block;
my $*WANT;
$body := self.compile_all_the_stmts($node.list, :node($node.node));
$*STACK.obtain(NQPMu, $body);
}
# Stash lexical names.
$*CODEREFS.set_lexical_names($node.cuid, |$block.lexical_names_by_type());
# Emit prelude. This creates and stashes the CallFrame.
$*JMETH.add_local('cf', $TYPE_CF);
$*JMETH.append(JAST::Instruction.new( :op('new'), $TYPE_CF ));
$*JMETH.append(JAST::Instruction.new( :op('dup') ));
$*JMETH.append(JAST::Instruction.new( :op('aload_1') ));
$*JMETH.append(JAST::Instruction.new( :op('aload'), 'cr' ));
$*JMETH.append(JAST::Instruction.new( :op('invokespecial'), $TYPE_CF, '<init>',
'Void', $TYPE_TC, $TYPE_CR ));
$*JMETH.append(JAST::Instruction.new( :op('astore'), 'cf' ));
# Analyze parameters to get count of required/optional and make sure
# all is in order.
my int $pos_required := 0;
my int $pos_optional := 0;
my int $pos_slurpy := 0;
for $block.params {
if $_.named {
# Don't count.
}
elsif $_.slurpy {
$pos_slurpy := 1;
}
elsif $_.default {
if $pos_slurpy {
nqp::die("Optional positionals must come before all slurpy positionals");
}
$pos_optional++;
}
else {
if $pos_optional {
nqp::die("Required positionals must come before all optional positionals");
}
if $pos_slurpy {
nqp::die("Required positionals must come before all slurpy positionals");
}
$pos_required++;
}
}
# Emit arity check instruction.
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload'), 'cf' ));
$il.append(JAST::Instruction.new( :op('aload'), 'csd' ));
$il.append(JAST::Instruction.new( :op('aload'), '__args' ));
$il.append(JAST::PushIndex.new( :value($pos_required) ));
$il.append(JAST::PushIndex.new( :value($pos_slurpy ?? -1 !! $pos_required + $pos_optional) ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
"checkarity", $TYPE_CSD, $TYPE_CF, $TYPE_CSD, "[$TYPE_OBJ", 'Integer', 'Integer' ));
$il.append(JAST::Instruction.new( :op('astore'), 'csd' ));
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('getfield'), $TYPE_TC, 'flatArgs', "[$TYPE_OBJ" ));
$il.append(JAST::Instruction.new( :op('astore'), '__args' ));
# Emit instructions to load each parameter.
my int $param_idx := 0;
for $block.params {
my $type;
if $_.slurpy {
$type := $RT_OBJ;
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('aload'), 'cf' ));
$il.append(JAST::Instruction.new( :op('aload'), 'csd' ));
$il.append(JAST::Instruction.new( :op('aload'), '__args' ));
if $_.named {
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
"namedslurpy", $TYPE_SMO, $TYPE_TC, $TYPE_CF, $TYPE_CSD, "[$TYPE_OBJ" ));
}
else {
$il.append(JAST::PushIndex.new( :value($pos_required + $pos_optional) ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
"posslurpy", $TYPE_SMO, $TYPE_TC, $TYPE_CF, $TYPE_CSD, "[$TYPE_OBJ", 'Integer' ));
}
}
else {
$type := rttype_from_typeobj($_.returns);
my $jt := jtype($type);
my $tc := typechar($type);
my $opt := $_.default ?? "opt_" !! "";
$il.append(JAST::Instruction.new( :op('aload'), 'cf' ));
$il.append(JAST::Instruction.new( :op('aload'), 'csd' ));
$il.append(JAST::Instruction.new( :op('aload'), '__args' ));
if $_.named {
$il.append(JAST::PushSVal.new( :value($_.named) ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
"namedparam_$opt$tc", $jt, $TYPE_CF, $TYPE_CSD, "[$TYPE_OBJ", $TYPE_STR ));
}
else {
$il.append(JAST::PushIndex.new( :value($param_idx) ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
"posparam_$opt$tc", $jt, $TYPE_CF, $TYPE_CSD, "[$TYPE_OBJ", 'Integer' ));
}
if $opt {
my $lbl := JAST::Label.new( :name(self.unique("opt_param")) );
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('getfield'), $TYPE_TC,
'lastParameterExisted', "Integer" ));
$il.append(JAST::Instruction.new( :op('ifne'), $lbl ));
$il.append(pop_ins($type));
my $default := self.as_jast($_.default, :want($type));
$il.append($default.jast);
$*STACK.obtain($il, $default);
$il.append($lbl);
}
}
if $_.scope eq 'local' {
$il.append(JAST::Instruction.new( :op(store_ins($type)), $_.name ));
}
else {
my $jtype := jtype($type);
$il.append(JAST::Instruction.new( :op('aload'), 'cf' ));
$il.append(JAST::PushIndex.new( :value($block.lexical_idx($_.name)) ));
$il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
'bindlex_' ~ typechar($type), $jtype, $jtype, $TYPE_CF, 'Integer' ));
$il.append(pop_ins($type));
}
$param_idx++;
}
# Add all the locals.
for $block.locals {
$*JMETH.add_local($_.name, jtype($block.local_type($_.name)));
}
$*BLOCK_TA.add_temps_to_method($*JMETH);
# Add method body JAST.
$il.append($body.jast);
# Store return value.
$il.append(JAST::Instruction.new( :op('aload'), 'cf' ));
$il.append(JAST::Instruction.new( :op(