← Back to branch summary

~ubuntu-branches/ubuntu/vivid/nqp/vivid-proposed

« back to all changes in this revision

Viewing changes to src/vm/moar/QAST/QASTOperationsMAST.nqp

  • Committer: Package Import Robot
  • Author(s): Alessandro Ghedini
  • Date: 2013-11-01 12:09:18 UTC
  • mfrom: (1.1.4)
  • Revision ID: package-import@ubuntu.com-20131101120918-kx51sl0sxl3exsxi
Tags: 2013.10-1
* New upstream release
* Bump versioned (Build-)Depends on parrot
* Update patches
* Install new README.pod
* Fix vcs-field-not-canonical
* Do not install rubyish examples
* Do not Depends on parrot-devel anymore
* Add 07_disable-serialization-tests.patch

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/vm/moar/QAST/QASTOperationsMAST.nqp
 
1
my $MVM_operand_literal     := 0;
 
2
my $MVM_operand_read_reg    := 1;
 
3
my $MVM_operand_write_reg   := 2;
 
4
my $MVM_operand_read_lex    := 3;
 
5
my $MVM_operand_write_lex   := 4;
 
6
my $MVM_operand_rw_mask     := 7;
 
7
 
 
8
my $MVM_operand_int8        := ($MVM_reg_int8 * 8);
 
9
my $MVM_operand_int16       := ($MVM_reg_int16 * 8);
 
10
my $MVM_operand_int32       := ($MVM_reg_int32 * 8);
 
11
my $MVM_operand_int64       := ($MVM_reg_int64 * 8);
 
12
my $MVM_operand_num32       := ($MVM_reg_num32 * 8);
 
13
my $MVM_operand_num64       := ($MVM_reg_num64 * 8);
 
14
my $MVM_operand_str         := ($MVM_reg_str * 8);
 
15
my $MVM_operand_obj         := ($MVM_reg_obj * 8);
 
16
my $MVM_operand_ins         := (9 * 8);
 
17
my $MVM_operand_type_var    := (10 * 8);
 
18
my $MVM_operand_lex_outer   := (11 * 8);
 
19
my $MVM_operand_coderef     := (12 * 8);
 
20
my $MVM_operand_callsite    := (13 * 8);
 
21
my $MVM_operand_type_mask   := (15 * 8);
 
22
 
 
23
# This is used as a return value from all of the various compilation routines.
 
24
# It groups together a set of instructions along with a result register and a
 
25
# result kind.  It also tracks the source filename and line number.
 
26
class MAST::InstructionList {
 
27
    has @!instructions;
 
28
    has $!result_reg;
 
29
    has int $!result_kind;
 
30
    has str $!filename;
 
31
    has int $!lineno;
 
32
 
 
33
    method new(@instructions, $result_reg, $result_kind, :$filename = '<anon>', :$lineno = 0) {
 
34
        my $obj := nqp::create(self);
 
35
        nqp::bindattr($obj, MAST::InstructionList, '@!instructions', @instructions);
 
36
        nqp::bindattr($obj, MAST::InstructionList, '$!result_reg', $result_reg);
 
37
        nqp::bindattr_i($obj, MAST::InstructionList, '$!result_kind', $result_kind);
 
38
        nqp::bindattr_s($obj, MAST::InstructionList, '$!filename', $filename);
 
39
        nqp::bindattr_i($obj, MAST::InstructionList, '$!lineno', $lineno);
 
40
        $obj
 
41
    }
 
42
 
 
43
    method instructions() { @!instructions }
 
44
    method result_reg()   { $!result_reg }
 
45
    method result_kind()  { $!result_kind }
 
46
    method filename()     { $!filename }
 
47
    method lineno()       { $!lineno }
 
48
 
 
49
    method append(MAST::InstructionList $other) {
 
50
        push_ilist(@!instructions, $other);
 
51
        $!result_reg := $other.result_reg;
 
52
        $!result_kind := $other.result_kind;
 
53
    }
 
54
}
 
55
 
 
56
# Marker object for void.
 
57
class MAST::VOID { }
 
58
 
 
59
class QAST::MASTOperations {
 
60
 
 
61
    # Maps operations to code that will handle them. Hash of code.
 
62
    my %core_ops;
 
63
 
 
64
    # Maps HLL-specific operations to code that will handle them.
 
65
    # Hash of hash of code.
 
66
    my %hll_ops;
 
67
 
 
68
    # Mapping of how to box/unbox by HLL.
 
69
    my %hll_box;
 
70
    my %hll_unbox;
 
71
 
 
72
    # Compiles an operation to MAST.
 
73
    method compile_op($qastcomp, $hll, $op) {
 
74
        my $name := $op.op;
 
75
        if ($hll && %hll_ops{$hll} && %hll_ops{$hll}{$name})
 
76
                || %core_ops{$name} -> $mapper {
 
77
            return $mapper($qastcomp, $op);
 
78
        }
 
79
        nqp::die("No registered operation handler for '$name'");
 
80
    }
 
81
 
 
82
    my @kind_names := ['VOID','int8','int16','int32','int','num32','num','str','obj'];
 
83
    my @kind_types := [0,1,1,1,1,2,2,3,4];
 
84
 
 
85
    my @operands_offsets := MAST::Ops.WHO<@offsets>;
 
86
    my @operands_counts := MAST::Ops.WHO<@counts>;
 
87
    my @operands_values := MAST::Ops.WHO<@values>;
 
88
    my %op_codes := MAST::Ops.WHO<%codes>;
 
89
    method compile_mastop($qastcomp, $op, @args, :$returnarg = -1, :$opname = 'none', :$want) {
 
90
        #$op := $op.name if nqp::istype($op, QAST::Op);
 
91
 
 
92
        my $op_num := %op_codes{$op};
 
93
        my $num_args := +@args;
 
94
        my $num_operands := nqp::atpos_i(@operands_counts, $op_num);
 
95
        my $operands_offset := nqp::atpos_i(@operands_offsets, $op_num);
 
96
        my $operand_num := 0;
 
97
        my $result_kind := $MVM_reg_void;
 
98
        my $result_reg := MAST::VOID;
 
99
        my $needs_write := 0;
 
100
        my $type_var_kind := 0;
 
101
 
 
102
        my @arg_regs;
 
103
        my @all_ins;
 
104
        my @release_regs;
 
105
        my @release_kinds;
 
106
 
 
107
        # if the op has operands, and the first operand is a write register,
 
108
        # and the number of args provided is one less than the number of operands needed,
 
109
        # mark that we need to generate a result register at the end, and
 
110
        # advance to the second operand.
 
111
        if ($num_operands
 
112
                && (nqp::atpos_i(@operands_values, $operands_offset) +& $MVM_operand_rw_mask) == $MVM_operand_write_reg
 
113
                    # allow the QASTree to define its own write register
 
114
                && $num_args == $num_operands - 1) {
 
115
            $needs_write := 1;
 
116
            $operand_num++;
 
117
        }
 
118
 
 
119
        if ($num_args != $num_operands - $operand_num) {
 
120
            nqp::die("Arg count $num_args doesn't equal required operand count "~($num_operands - $operand_num)~" for op '$op'");
 
121
        }
 
122
 
 
123
        if ($op eq 'return') {
 
124
            $*BLOCK.return_kind($MVM_reg_void);
 
125
        }
 
126
 
 
127
        my $arg_num := 0;
 
128
        # Compile provided args.
 
129
        for @args {
 
130
            my $operand := nqp::atpos_i(@operands_values, $operands_offset + $operand_num++);
 
131
            my $operand_kind := ($operand +& $MVM_operand_type_mask);
 
132
            my $constant_operand := !($operand +& $MVM_operand_rw_mask);
 
133
            my $arg := $operand_kind == $MVM_operand_type_var
 
134
                ?? $qastcomp.as_mast($_)
 
135
                !! $qastcomp.as_mast($_, :want($operand_kind/8));
 
136
            my $arg_kind := $arg.result_kind;
 
137
 
 
138
            if $arg_num == 0 && nqp::substr($op, 0, 7) eq 'return_' {
 
139
                $*BLOCK.return_kind($arg.result_kind);
 
140
            }
 
141
 
 
142
            # args cannot be void
 
143
            if $arg_kind == $MVM_reg_void {
 
144
                nqp::die("Cannot use a void register as an argument to op '$op'");
 
145
            }
 
146
 
 
147
            if ($operand_kind == $MVM_operand_type_var) {
 
148
                # handle ops that have type-variables as operands
 
149
                if ($type_var_kind) {
 
150
                    # if we've already seen a type-var
 
151
                    if ($arg_kind != $type_var_kind) {
 
152
                        # the arg types must match
 
153
                        nqp::die("variable-type op requires same-typed args");
 
154
                    }
 
155
                }
 
156
                else {
 
157
                    # set this variable-type op's typecode
 
158
                    $type_var_kind := $arg_kind;
 
159
                }
 
160
            } # allow nums and ints to be bigger than their destination width
 
161
            elsif (@kind_types[$arg_kind] != @kind_types[$operand_kind/8]) {
 
162
                $qastcomp.coerce($arg, $operand_kind/8);
 
163
                $arg_kind := $operand_kind/8;
 
164
                # the arg typecode left shifted 3 must match the operand typecode
 
165
            #    nqp::die("arg type {@kind_names[$arg_kind]} does not match operand type {@kind_names[$operand_kind/8]} to op '$op'");
 
166
            }
 
167
 
 
168
            # if this is the write register, get the result reg and type from it
 
169
            if ($operand +& $MVM_operand_rw_mask) == $MVM_operand_write_reg
 
170
                || ($operand +& $MVM_operand_rw_mask) == $MVM_operand_write_lex
 
171
                || $returnarg != -1 && $returnarg == $arg_num {
 
172
                $result_reg := $arg.result_reg;
 
173
                $result_kind := $arg_kind;
 
174
            }
 
175
            # otherwise it's a read register, so it can be released if it's an
 
176
            # intermediate value
 
177
            else {
 
178
                # if it's not a write register, queue it to be released it to the allocator
 
179
                nqp::push(@release_regs, $arg.result_reg);
 
180
                nqp::push(@release_kinds, $arg_kind);
 
181
            }
 
182
 
 
183
            # put the arg exression's generation code in the instruction list
 
184
            nqp::splice(@all_ins, $arg.instructions, +@all_ins, 0)
 
185
                unless $constant_operand;
 
186
            nqp::push(@arg_regs, $constant_operand
 
187
                ?? $qastcomp.as_mast_constant($_)
 
188
                !! $arg.result_reg);
 
189
 
 
190
            $arg_num++;
 
191
        }
 
192
 
 
193
        # release the registers to the allocator. See comment there.
 
194
        my $release_i := 0;
 
195
        $*REGALLOC.release_register($_, @release_kinds[$release_i++]) for @release_regs;
 
196
 
 
197
        # unshift in a generated write register arg if it needs one
 
198
        if ($needs_write) {
 
199
            # do this after the args to possibly reuse a register,
 
200
            # and so we know the type of result register for ops with type_var operands.
 
201
 
 
202
            $result_kind := (nqp::atpos_i(@operands_values, $operands_offset) +& $MVM_operand_type_mask) / 8;
 
203
 
 
204
            # fixup the variable typecode if there is one
 
205
            if ($type_var_kind && $result_kind == $MVM_operand_type_var / 8) {
 
206
                $result_kind := $type_var_kind;
 
207
            }
 
208
 
 
209
            $result_reg := $*REGALLOC.fresh_register($result_kind);
 
210
 
 
211
            nqp::unshift(@arg_regs, $result_reg);
 
212
        }
 
213
 
 
214
        # Add operation node.
 
215
        nqp::push(@all_ins, MAST::Op.new(
 
216
            :op($op),
 
217
            |@arg_regs));
 
218
 
 
219
        # Build instruction list.
 
220
        nqp::defined($want)
 
221
            ?? $qastcomp.coerce(MAST::InstructionList.new(@all_ins, $result_reg, $result_kind), $want)
 
222
            !! MAST::InstructionList.new(@all_ins, $result_reg, $result_kind);
 
223
    }
 
224
 
 
225
    # Adds a core op handler.
 
226
    method add_core_op($op, $handler) {
 
227
        %core_ops{$op} := $handler;
 
228
    }
 
229
 
 
230
    # Adds a HLL op handler.
 
231
    method add_hll_op($hll, $op, $handler) {
 
232
        %hll_ops{$hll} := {} unless %hll_ops{$hll};
 
233
        %hll_ops{$hll}{$op} := $handler;
 
234
    }
 
235
 
 
236
    # Adds a core op that maps to a Moar op.
 
237
    method add_core_moarop_mapping($op, $moarop, $ret = -1, :$mapper?) {
 
238
        my $moarop_mapper := $mapper
 
239
            ?? $mapper(self, $moarop, $ret)
 
240
            !! self.moarop_mapper($moarop, $ret);
 
241
        %core_ops{$op} := -> $qastcomp, $op {
 
242
            $moarop_mapper($qastcomp, $op.op, $op.list)
 
243
        };
 
244
    }
 
245
 
 
246
    # Adds a HLL op that maps to a Moar op.
 
247
    method add_hll_moarop_mapping($hll, $op, $moarop, $ret = -1, :$mapper?) {
 
248
        my $moarop_mapper := $mapper
 
249
            ?? $mapper(self, $moarop, $ret)
 
250
            !! self.moarop_mapper($moarop, $ret);
 
251
        %hll_ops{$hll} := {} unless %hll_ops{$hll};
 
252
        %hll_ops{$hll}{$op} := -> $qastcomp, $op {
 
253
            $moarop_mapper($qastcomp, $op.op, $op.list)
 
254
        };
 
255
    }
 
256
 
 
257
    # Returns a mapper closure for turning an operation into a Moar op.
 
258
    # $ret is the 0-based index of which arg to use as the result when
 
259
    # the moarop is void.
 
260
    method moarop_mapper($moarop, $ret) {
 
261
        # do a little checking of input values
 
262
 
 
263
        my $self := self;
 
264
 
 
265
        if $ret != -1 {
 
266
            my $op_num := %op_codes{$moarop};
 
267
            my $num_operands := nqp::atpos_i(@operands_counts, $op_num);
 
268
            my $operands_offset := nqp::atpos_i(@operands_offsets, $op_num);
 
269
            nqp::die("moarop $moarop return arg index out of range")
 
270
                if $ret < -1 || $ret >= $num_operands;
 
271
            nqp::die("moarop $moarop is not void")
 
272
                if $num_operands && (nqp::atpos_i(@operands_values, $operands_offset) +& $MVM_operand_rw_mask) ==
 
273
                    $MVM_operand_write_reg;
 
274
        }
 
275
 
 
276
        -> $qastcomp, $op_name, @op_args {
 
277
            $self.compile_mastop($qastcomp, $moarop, @op_args,
 
278
                :returnarg($ret), :opname($op_name))
 
279
        }
 
280
    }
 
281
 
 
282
    # Adds a HLL box handler.
 
283
    method add_hll_box($hll, $type, $handler) {
 
284
        unless $type == $MVM_reg_int64 || $type == $MVM_reg_num64 || $type == $MVM_reg_str || $type == $MVM_reg_void {
 
285
            nqp::die("Unknown box type '$type'");
 
286
        }
 
287
        %hll_box{$hll} := {} unless nqp::existskey(%hll_box, $hll);
 
288
        %hll_box{$hll}{$type} := $handler;
 
289
    }
 
290
 
 
291
    # Adds a HLL unbox handler.
 
292
    method add_hll_unbox($hll, $type, $handler) {
 
293
        unless $type == $MVM_reg_int64 || $type == $MVM_reg_num64 || $type == $MVM_reg_str {
 
294
            nqp::die("Unknown unbox type '$type'");
 
295
        }
 
296
        %hll_unbox{$hll} := {} unless nqp::existskey(%hll_unbox, $hll);
 
297
        %hll_unbox{$hll}{$type} := $handler;
 
298
    }
 
299
 
 
300
    # Generates instructions to box the result in reg.
 
301
    method box($qastcomp, $hll, $type, $reg) {
 
302
        (%hll_box{$hll}{$type} // %hll_box{''}{$type})($qastcomp, $reg)
 
303
    }
 
304
 
 
305
    # Generates instructions to unbox the result in reg.
 
306
    method unbox($qastcomp, $hll, $type, $reg) {
 
307
        (%hll_unbox{$hll}{$type} // %hll_unbox{''}{$type})($qastcomp, $reg)
 
308
    }
 
309
}
 
310
 
 
311
# Set of sequential statements
 
312
QAST::MASTOperations.add_core_op('stmts', -> $qastcomp, $op {
 
313
    $qastcomp.as_mast(QAST::Stmts.new( |@($op) ))
 
314
});
 
315
 
 
316
# Data structures
 
317
QAST::MASTOperations.add_core_op('list', -> $qastcomp, $op {
 
318
    # Just desugar to create the empty list.
 
319
    my $arr := $qastcomp.as_mast(QAST::Op.new(
 
320
        :op('create'),
 
321
        QAST::Op.new( :op('hlllist') )
 
322
    ));
 
323
    if +$op.list {
 
324
        my $arr_reg := $arr.result_reg;
 
325
        # Push things to the list.
 
326
        for $op.list {
 
327
            my $item := $qastcomp.as_mast($_, :want($MVM_reg_obj));
 
328
            my $item_reg := $item.result_reg;
 
329
            $arr.append($item);
 
330
            push_op($arr.instructions, 'push_o', $arr_reg, $item_reg);
 
331
            $*REGALLOC.release_register($item_reg, $MVM_reg_obj);
 
332
        }
 
333
        my $newer := MAST::InstructionList.new(nqp::list(), $arr_reg, $MVM_reg_obj);
 
334
        $arr.append($newer);
 
335
    }
 
336
    $arr
 
337
});
 
338
QAST::MASTOperations.add_core_op('list_i', -> $qastcomp, $op {
 
339
    # Just desugar to create the empty list.
 
340
    my $arr := $qastcomp.as_mast(QAST::Op.new(
 
341
        :op('create'),
 
342
        QAST::Op.new( :op('bootintarray') )
 
343
    ));
 
344
    if +$op.list {
 
345
        my $arr_reg := $arr.result_reg;
 
346
        # Push things to the list.
 
347
        for $op.list {
 
348
            my $item := $qastcomp.as_mast($_, :want($MVM_reg_int64));
 
349
            my $item_reg := $item.result_reg;
 
350
            $arr.append($item);
 
351
            push_op($arr.instructions, 'push_i', $arr_reg, $item_reg);
 
352
            $*REGALLOC.release_register($item_reg, $MVM_reg_int64);
 
353
        }
 
354
        my $newer := MAST::InstructionList.new(nqp::list(), $arr_reg, $MVM_reg_obj);
 
355
        $arr.append($newer);
 
356
    }
 
357
    $arr
 
358
});
 
359
QAST::MASTOperations.add_core_op('list_n', -> $qastcomp, $op {
 
360
    # Just desugar to create the empty list.
 
361
    my $arr := $qastcomp.as_mast(QAST::Op.new(
 
362
        :op('create'),
 
363
        QAST::Op.new( :op('bootnumarray') )
 
364
    ));
 
365
    if +$op.list {
 
366
        my $arr_reg := $arr.result_reg;
 
367
        # Push things to the list.
 
368
        for $op.list {
 
369
            my $item := $qastcomp.as_mast($_, :want($MVM_reg_num64));
 
370
            my $item_reg := $item.result_reg;
 
371
            $arr.append($item);
 
372
            push_op($arr.instructions, 'push_n', $arr_reg, $item_reg);
 
373
            $*REGALLOC.release_register($item_reg, $MVM_reg_num64);
 
374
        }
 
375
        my $newer := MAST::InstructionList.new(nqp::list(), $arr_reg, $MVM_reg_obj);
 
376
        $arr.append($newer);
 
377
    }
 
378
    $arr
 
379
});
 
380
QAST::MASTOperations.add_core_op('list_s', -> $qastcomp, $op {
 
381
    # Just desugar to create the empty list.
 
382
    my $arr := $qastcomp.as_mast(QAST::Op.new(
 
383
        :op('create'),
 
384
        QAST::Op.new( :op('bootstrarray') )
 
385
    ));
 
386
    if +$op.list {
 
387
        my $arr_reg := $arr.result_reg;
 
388
        # Push things to the list.
 
389
        for $op.list {
 
390
            my $item := $qastcomp.as_mast($_, :want($MVM_reg_str));
 
391
            my $item_reg := $item.result_reg;
 
392
            $arr.append($item);
 
393
            push_op($arr.instructions, 'push_s', $arr_reg, $item_reg);
 
394
            $*REGALLOC.release_register($item_reg, $MVM_reg_str);
 
395
        }
 
396
        my $newer := MAST::InstructionList.new(nqp::list(), $arr_reg, $MVM_reg_obj);
 
397
        $arr.append($newer);
 
398
    }
 
399
    $arr
 
400
});
 
401
QAST::MASTOperations.add_core_op('list_b', -> $qastcomp, $op {
 
402
    # Just desugar to create the empty list.
 
403
    my $arr := $qastcomp.as_mast(QAST::Op.new(
 
404
        :op('create'),
 
405
        QAST::Op.new( :op('bootarray') )
 
406
    ));
 
407
    if +$op.list {
 
408
        my $arr_reg := $arr.result_reg;
 
409
        # Push things to the list.
 
410
        for $op.list {
 
411
            nqp::die("list_b must have a list of blocks")
 
412
                unless nqp::istype($_, QAST::Block);
 
413
            my $cuid  := $_.cuid();
 
414
            my $frame := %*MAST_FRAMES{$cuid};
 
415
            my $item_reg := $*REGALLOC.fresh_register($MVM_reg_obj);
 
416
            push_op($arr.instructions, 'getcode', $item_reg, $frame);
 
417
            push_op($arr.instructions, 'push_o', $arr_reg, $item_reg);
 
418
            $*REGALLOC.release_register($item_reg, $MVM_reg_obj);
 
419
        }
 
420
        my $newer := MAST::InstructionList.new(nqp::list(), $arr_reg, $MVM_reg_obj);
 
421
        $arr.append($newer);
 
422
    }
 
423
    $arr
 
424
});
 
425
QAST::MASTOperations.add_core_op('qlist', -> $qastcomp, $op {
 
426
    $qastcomp.as_mast(QAST::Op.new( :op('list'), |@($op) ))
 
427
});
 
428
QAST::MASTOperations.add_core_op('hash', -> $qastcomp, $op {
 
429
    # Just desugar to create the empty hash.
 
430
    my $hash := $qastcomp.as_mast(QAST::Op.new(
 
431
        :op('create'),
 
432
        QAST::Op.new( :op('hllhash') )
 
433
    ));
 
434
    if +$op.list {
 
435
        my $hash_reg := $hash.result_reg;
 
436
        for $op.list -> $key, $val {
 
437
            my $key_mast := $qastcomp.as_mast($key, :want($MVM_reg_str));
 
438
            my $val_mast := $qastcomp.as_mast($val, :want($MVM_reg_obj));
 
439
            my $key_reg := $key_mast.result_reg;
 
440
            my $val_reg := $val_mast.result_reg;
 
441
            $hash.append($key_mast);
 
442
            $hash.append($val_mast);
 
443
            push_op($hash.instructions, 'bindkey_o', $hash_reg, $key_reg, $val_reg);
 
444
            $*REGALLOC.release_register($key_reg, $MVM_reg_str);
 
445
            $*REGALLOC.release_register($val_reg, $MVM_reg_obj);
 
446
        }
 
447
        my $newer := MAST::InstructionList.new(nqp::list(), $hash_reg, $MVM_reg_obj);
 
448
        $hash.append($newer);
 
449
    }
 
450
    $hash
 
451
});
 
452
 
 
453
# Conditionals.
 
454
for <if unless> -> $op_name {
 
455
    QAST::MASTOperations.add_core_op($op_name, -> $qastcomp, $op {
 
456
        # Check operand count.
 
457
        my $operands := +$op.list;
 
458
        nqp::die("Operation '$op_name' needs either 2 or 3 operands")
 
459
            if $operands < 2 || $operands > 3;
 
460
 
 
461
        # Create labels.
 
462
        my $if_id    := $qastcomp.unique($op_name);
 
463
        my $else_lbl := MAST::Label.new(:name($if_id ~ '_else'));
 
464
        my $end_lbl  := MAST::Label.new(:name($if_id ~ '_end'));
 
465
 
 
466
        # Compile each of the children, handling any that want the conditional
 
467
        # value to be passed.
 
468
        my @comp_ops;
 
469
        sub needs_cond_passed($n) {
 
470
            nqp::istype($n, QAST::Block) && $n.arity > 0 &&
 
471
                ($n.blocktype eq 'immediate' || $n.blocktype eq 'immediate_static')
 
472
        }
 
473
        my $cond_temp_lbl := needs_cond_passed($op[1]) || needs_cond_passed($op[2])
 
474
            ?? $qastcomp.unique('__im_cond_')
 
475
            !! '';
 
476
        if $cond_temp_lbl {
 
477
            @comp_ops[0] := $qastcomp.as_mast(QAST::Op.new(
 
478
                :op('bind'),
 
479
                QAST::Var.new( :name($cond_temp_lbl), :scope('local'), :decl('var') ),
 
480
                $op[0]));
 
481
        } else {
 
482
            @comp_ops[0] := $qastcomp.as_mast($op[0]);
 
483
        }
 
484
        if needs_cond_passed($op[1]) {
 
485
            $op[1].blocktype('declaration');
 
486
            @comp_ops[1] := $qastcomp.as_mast(QAST::Op.new(
 
487
                :op('call'),
 
488
                $op[1],
 
489
                QAST::Var.new( :name($cond_temp_lbl), :scope('local') )));
 
490
        }
 
491
        else {
 
492
            @comp_ops[1] := $qastcomp.as_mast($op[1]);
 
493
        }
 
494
        if needs_cond_passed($op[2]) {
 
495
            $op[2].blocktype('declaration');
 
496
            @comp_ops[2] := $qastcomp.as_mast(QAST::Op.new(
 
497
                :op('call'),
 
498
                $op[2],
 
499
                QAST::Var.new( :name($cond_temp_lbl), :scope('local') )));
 
500
        }
 
501
        elsif $op[2] {
 
502
            @comp_ops[2] := $qastcomp.as_mast($op[2]);
 
503
        }
 
504
 
 
505
        if (@comp_ops[0].result_kind == $MVM_reg_void) {
 
506
            nqp::die("operation '$op_name' condition cannot be void");
 
507
        }
 
508
 
 
509
        my $res_kind;
 
510
        my $res_reg;
 
511
        my $is_void := nqp::defined($*WANT) && $*WANT == $MVM_reg_void;
 
512
        if $is_void {
 
513
            $res_reg := MAST::VOID;
 
514
        }
 
515
        else {
 
516
            $res_kind := $operands == 3
 
517
                ?? (@comp_ops[1].result_kind == @comp_ops[2].result_kind
 
518
                && @comp_ops[1].result_kind != $MVM_reg_void
 
519
                    ?? @comp_ops[1].result_kind
 
520
                    !! $MVM_reg_obj)
 
521
                !! (@comp_ops[0].result_kind == @comp_ops[1].result_kind
 
522
                    ?? @comp_ops[0].result_kind
 
523
                    !! $MVM_reg_obj);
 
524
            $res_reg := $*REGALLOC.fresh_register($res_kind);
 
525
        }
 
526
 
 
527
        my @ins;
 
528
 
 
529
        # Evaluate the condition first; store result if needed.
 
530
        push_ilist(@ins, @comp_ops[0]);
 
531
        if $operands == 2 && !$is_void {
 
532
            my $il := MAST::InstructionList.new(@ins, @comp_ops[0].result_reg, @comp_ops[0].result_kind);
 
533
            $qastcomp.coerce($il, $res_kind);
 
534
            push_op(@ins, 'set', $res_reg, $il.result_reg);
 
535
        }
 
536
 
 
537
        # Emit the jump.
 
538
        push_op(@ins,
 
539
            resolve_condition_op(@comp_ops[0].result_kind, $op_name eq 'if'),
 
540
            @comp_ops[0].result_reg,
 
541
            ($operands == 3 ?? $else_lbl !! $end_lbl)
 
542
        );
 
543
 
 
544
        # Emit the then, stash the result
 
545
        push_ilist(@ins, @comp_ops[1]);
 
546
        if (!$is_void && @comp_ops[1].result_kind != $res_kind) {
 
547
            my $coercion := $qastcomp.coercion(@comp_ops[1],
 
548
                (nqp::defined($*WANT) ?? $*WANT !! $MVM_reg_obj));
 
549
            push_ilist(@ins, $coercion);
 
550
            $*REGALLOC.release_register($res_reg, $res_kind);
 
551
            $res_reg := $*REGALLOC.fresh_register($coercion.result_kind);
 
552
            push_op(@ins, 'set', $res_reg, $coercion.result_reg);
 
553
            $res_kind := $coercion.result_kind;
 
554
        }
 
555
        elsif !$is_void {
 
556
            push_op(@ins, 'set', $res_reg, @comp_ops[1].result_reg);
 
557
        }
 
558
        $*REGALLOC.release_register(@comp_ops[1].result_reg, @comp_ops[1].result_kind);
 
559
 
 
560
        # Handle else branch (coercion of condition result if 2-arg).
 
561
        push_op(@ins, 'goto', $end_lbl);
 
562
        nqp::push(@ins, $else_lbl);
 
563
        if $operands == 3 {
 
564
            push_ilist(@ins, @comp_ops[2]);
 
565
            if !$is_void {
 
566
                if @comp_ops[2].result_kind != $res_kind {
 
567
                    my $coercion := $qastcomp.coercion(@comp_ops[2], $res_kind);
 
568
                    push_ilist(@ins, $coercion);
 
569
                    push_op(@ins, 'set', $res_reg, $coercion.result_reg);
 
570
                }
 
571
                else {
 
572
                    push_op(@ins, 'set', $res_reg, @comp_ops[2].result_reg);
 
573
                }
 
574
            }
 
575
            $*REGALLOC.release_register(@comp_ops[2].result_reg, @comp_ops[2].result_kind);
 
576
        }
 
577
        else {
 
578
            if !$is_void && @comp_ops[0].result_kind != $res_kind {
 
579
                my $coercion := $qastcomp.coercion(@comp_ops[0], $res_kind);
 
580
                push_ilist(@ins, $coercion);
 
581
                push_op(@ins, 'set', $res_reg, $coercion.result_reg);
 
582
            }
 
583
        }
 
584
        $*REGALLOC.release_register(@comp_ops[0].result_reg, @comp_ops[0].result_kind);
 
585
        nqp::push(@ins, $end_lbl);
 
586
 
 
587
        MAST::InstructionList.new(@ins, $res_reg, $res_kind)
 
588
    });
 
589
}
 
590
 
 
591
QAST::MASTOperations.add_core_op('defor', -> $qastcomp, $op {
 
592
    if +$op.list != 2 {
 
593
        nqp::die("Operation 'defor' needs 2 operands");
 
594
    }
 
595
 
 
596
    # Compile the expression.
 
597
    my $res_reg := $*REGALLOC.fresh_o();
 
598
    my $expr := $qastcomp.as_mast($op[0], :want($MVM_reg_obj));
 
599
 
 
600
    # Emit defined check.
 
601
    my $def_reg := $*REGALLOC.fresh_i();
 
602
    my $lbl := MAST::Label.new(:name($qastcomp.unique('defor')));
 
603
    push_op($expr.instructions, 'set', $res_reg, $expr.result_reg);
 
604
    push_op($expr.instructions, 'isconcrete', $def_reg, $res_reg);
 
605
    push_op($expr.instructions, 'if_i', $def_reg, $lbl);
 
606
    $*REGALLOC.release_register($def_reg, $MVM_reg_int64);
 
607
 
 
608
    # Emit "then" part.
 
609
    my $then := $qastcomp.as_mast($op[1], :want($MVM_reg_obj));
 
610
    $*REGALLOC.release_register($expr.result_reg, $MVM_reg_obj);
 
611
    $expr.append($then);
 
612
    push_op($expr.instructions, 'set', $res_reg, $then.result_reg);
 
613
    nqp::push($expr.instructions, $lbl);
 
614
    $*REGALLOC.release_register($then.result_reg, $MVM_reg_obj);
 
615
    my $newer := MAST::InstructionList.new(nqp::list(), $res_reg, $MVM_reg_obj);
 
616
    $expr.append($newer);
 
617
 
 
618
    $expr
 
619
});
 
620
 
 
621
QAST::MASTOperations.add_core_op('ifnull', -> $qastcomp, $op {
 
622
    if +$op.list != 2 {
 
623
        nqp::die("The 'ifnull' op expects two children");
 
624
    }
 
625
 
 
626
    # Compile the expression.
 
627
    my $res_reg := $*REGALLOC.fresh_o();
 
628
    my $expr := $qastcomp.as_mast($op[0], :want($MVM_reg_obj));
 
629
 
 
630
    # Emit null check.
 
631
    my $lbl := MAST::Label.new(:name($qastcomp.unique('ifnull')));
 
632
    push_op($expr.instructions, 'set', $res_reg, $expr.result_reg);
 
633
    push_op($expr.instructions, 'ifnonnull', $expr.result_reg, $lbl);
 
634
 
 
635
    # Emit "then" part.
 
636
    my $then := $qastcomp.as_mast($op[1], :want($MVM_reg_obj));
 
637
    $*REGALLOC.release_register($expr.result_reg, $MVM_reg_obj);
 
638
    $expr.append($then);
 
639
    push_op($expr.instructions, 'set', $res_reg, $then.result_reg);
 
640
    nqp::push($expr.instructions, $lbl);
 
641
    $*REGALLOC.release_register($then.result_reg, $MVM_reg_obj);
 
642
    my $newer := MAST::InstructionList.new(nqp::list(), $res_reg, $MVM_reg_obj);
 
643
    $expr.append($newer);
 
644
 
 
645
    $expr
 
646
});
 
647
 
 
648
# Loops.
 
649
for ('', 'repeat_') -> $repness {
 
650
    for <while until> -> $op_name {
 
651
        QAST::MASTOperations.add_core_op("$repness$op_name", -> $qastcomp, $op {
 
652
            # Create labels.
 
653
            my $while_id := $qastcomp.unique($op_name);
 
654
            my $test_lbl := MAST::Label.new(:name($while_id ~ '_test'));
 
655
            my $next_lbl := MAST::Label.new(:name($while_id ~ '_next'));
 
656
            my $redo_lbl := MAST::Label.new(:name($while_id ~ '_redo'));
 
657
            my $done_lbl := MAST::Label.new(:name($while_id ~ '_done'));
 
658
 
 
659
            # Compile each of the children; we'll need to look at the result
 
660
            # types and pick an overall result type if in non-void context.
 
661
            my @comp_ops;
 
662
            my @comp_types;
 
663
            my $handler := 1;
 
664
            my $*IMM_ARG;
 
665
            for $op.list {
 
666
                if $_.named eq 'nohandler' { $handler := 0; }
 
667
                else {
 
668
                    my $*HAVE_IMM_ARG := $_.arity > 0 && $_ =:= $op.list[1];
 
669
                    my $comp := $qastcomp.as_mast($_);
 
670
                    @comp_ops.push($comp);
 
671
                    @comp_types.push($comp.result_kind);
 
672
                    if $*HAVE_IMM_ARG && !$*IMM_ARG {
 
673
                        nqp::die("$op_name block expects an argument, but there's no immediate block to take it");
 
674
                    }
 
675
                }
 
676
            }
 
677
            my $res_kind := @comp_types[0] == @comp_types[1]
 
678
                ?? @comp_types[0]
 
679
                !! $MVM_reg_obj;
 
680
            my $res_reg := $*REGALLOC.fresh_register($res_kind);
 
681
 
 
682
            # Check operand count.
 
683
            my $operands := +@comp_ops;
 
684
            nqp::die("Operation '$repness$op_name' needs 2 or 3 operands")
 
685
                if $operands != 2 && $operands != 3;
 
686
 
 
687
            # Test the condition and jump to the loop end if it's
 
688
            # not met.
 
689
            my @loop_il;
 
690
            my $coerced := $qastcomp.coerce(@comp_ops[0], $res_kind);
 
691
            if $repness {
 
692
                # It's a repeat_ variant, need to go straight into the
 
693
                # loop body unconditionally. Be sure to set the register
 
694
                # for the result to something first.
 
695
                if $res_kind == $MVM_reg_obj {
 
696
                    push_op(@loop_il, 'null', $res_reg);
 
697
                }
 
698
                elsif $res_kind == $MVM_reg_str {
 
699
                    push_op(@loop_il, 'null_s', $res_reg);
 
700
                }
 
701
                elsif $res_kind == $MVM_reg_num64 {
 
702
                    push_op(@loop_il, 'const_n64', $res_reg,
 
703
                        MAST::NVal.new( :value(0.0) ));
 
704
                }
 
705
                else {
 
706
                    push_op(@loop_il, 'const_i64', $res_reg,
 
707
                        MAST::IVal.new( :value(0) ));
 
708
                }
 
709
                push_op(@loop_il, 'goto', $redo_lbl);
 
710
            }
 
711
            nqp::push(@loop_il, $test_lbl);
 
712
            push_ilist(@loop_il, $coerced);
 
713
            push_op(@loop_il, 'set', $res_reg, $coerced.result_reg);
 
714
            push_op(@loop_il,
 
715
                resolve_condition_op(@comp_ops[0].result_kind, $op_name eq 'while'),
 
716
                @comp_ops[0].result_reg,
 
717
                $done_lbl
 
718
            );
 
719
 
 
720
            # Handle immediate blocks wanting the value as an arg.
 
721
            if $*IMM_ARG {
 
722
                $*IMM_ARG($res_reg);
 
723
            }
 
724
 
 
725
            # Emit the loop body; stash the result.
 
726
            my $body := $qastcomp.coerce(@comp_ops[1], $res_kind);
 
727
            nqp::push(@loop_il, $redo_lbl);
 
728
            push_ilist(@loop_il, $body);
 
729
            push_op(@loop_il, 'set', $res_reg, $body.result_reg);
 
730
 
 
731
            # If there's a third child, evaluate it as part of the
 
732
            # "next".
 
733
            if $operands == 3 {
 
734
                nqp::push(@loop_il, $next_lbl);
 
735
                push_ilist(@loop_il, @comp_ops[2]);
 
736
            }
 
737
 
 
738
            # Emit the iteration jump.
 
739
            push_op(@loop_il, 'goto', $test_lbl);
 
740
 
 
741
            # Emit postlude, with exception handlers if needed. Note that we
 
742
            # don't actually need to emit a bunch of handlers; since a handler
 
743
            # scope will happily throw control to a label of our choosing, we
 
744
            # just have the goto label be the place the control exception
 
745
            # needs to send control to.
 
746
            if $handler {
 
747
                my @redo_il := [MAST::HandlerScope.new(
 
748
                    :instructions(@loop_il),
 
749
                    :category_mask($HandlerCategory::redo),
 
750
                    :action($HandlerAction::unwind_and_goto),
 
751
                    :goto($redo_lbl)
 
752
                )];
 
753
                my @next_il := [MAST::HandlerScope.new(
 
754
                    :instructions(@redo_il),
 
755
                    :category_mask($HandlerCategory::next),
 
756
                    :action($HandlerAction::unwind_and_goto),
 
757
                    :goto($operands == 3 ?? $next_lbl !! $test_lbl)
 
758
                )];
 
759
                my @last_il := [MAST::HandlerScope.new(
 
760
                    :instructions(@next_il),
 
761
                    :category_mask($HandlerCategory::last),
 
762
                    :action($HandlerAction::unwind_and_goto),
 
763
                    :goto($done_lbl)
 
764
                )];
 
765
                nqp::push(@last_il, $done_lbl);
 
766
                MAST::InstructionList.new(@last_il, $res_reg, $res_kind)
 
767
            }
 
768
            else {
 
769
                nqp::push(@loop_il, $done_lbl);
 
770
                MAST::InstructionList.new(@loop_il, $res_reg, $res_kind)
 
771
            }
 
772
        });
 
773
    }
 
774
}
 
775
 
 
776
QAST::MASTOperations.add_core_op('for', -> $qastcomp, $op {
 
777
    my $handler := 1;
 
778
    my @operands;
 
779
    for $op.list {
 
780
        if $_.named eq 'nohandler' { $handler := 0; }
 
781
        else { @operands.push($_) }
 
782
    }
 
783
 
 
784
    if +@operands != 2 {
 
785
        nqp::die("Operation 'for' needs 2 operands");
 
786
    }
 
787
    unless nqp::istype(@operands[1], QAST::Block) {
 
788
        nqp::die("Operation 'for' expects a block as its second operand");
 
789
    }
 
790
    if @operands[1].blocktype eq 'immediate' {
 
791
        @operands[1].blocktype('declaration');
 
792
    }
 
793
    elsif @operands[1].blocktype eq 'immediate_static' {
 
794
        @operands[1].blocktype('declaration_static');
 
795
    }
 
796
 
 
797
    # Create result temporary if we'll need one.
 
798
    my $res := $*WANT == $MVM_reg_void ?? 0 !! $*REGALLOC.fresh_o();
 
799
 
 
800
    # Evaluate the thing we'll iterate over, get the iterator and
 
801
    # store it in a temporary.
 
802
    my $il := [];
 
803
    my $list_il := $qastcomp.as_mast(@operands[0], :want($MVM_reg_obj));
 
804
    push_ilist($il, $list_il);
 
805
    if $res {
 
806
        push_op($il, 'set', $res, $list_il.result_reg);
 
807
    }
 
808
    my $iter_tmp := $*REGALLOC.fresh_o();
 
809
    push_op($il, 'iter', $iter_tmp, $list_il.result_reg);
 
810
 
 
811
    # Do similar for the block.
 
812
    my $block_res := $qastcomp.as_mast(@operands[1], :want($MVM_reg_obj));
 
813
    push_ilist($il, $block_res);
 
814
 
 
815
    # Some labels we'll need.
 
816
    my $for_id := $qastcomp.unique('for');
 
817
    my $lbl_next := MAST::Label.new( :name($for_id ~ 'next') );
 
818
    my $lbl_redo := MAST::Label.new( :name($for_id ~ 'redo') );
 
819
    my $lbl_done := MAST::Label.new( :name($for_id ~ 'done') );
 
820
 
 
821
    # Emit loop test.
 
822
    my $loop_il := ();
 
823
    nqp::push($loop_il, $lbl_next);
 
824
    push_op($loop_il, 'unless_o', $iter_tmp, $lbl_done);
 
825
    $loop_il := MAST::InstructionList.new($loop_il, MAST::VOID, $MVM_reg_void);
 
826
 
 
827
    # Fetch values into temporaries (on the stack ain't enough in case
 
828
    # of redo).
 
829
    my $val_il := ();
 
830
    my @val_temps;
 
831
    my @arg_flags;
 
832
    my $arity := @operands[1].arity || 1;
 
833
    while $arity > 0 {
 
834
        my $tmp := $*REGALLOC.fresh_o();
 
835
        push_op($val_il, 'shift_o', $tmp, $iter_tmp);
 
836
        nqp::push(@val_temps, $tmp);
 
837
        nqp::push(@arg_flags, $Arg::obj);
 
838
        $arity := $arity - 1;
 
839
    }
 
840
    nqp::push($val_il, $lbl_redo);
 
841
    $val_il := MAST::InstructionList.new($val_il, MAST::VOID, $MVM_reg_void);
 
842
 
 
843
    # Now do block invocation.
 
844
    my $inv_il := $res
 
845
        ?? MAST::Call.new(
 
846
            :target($block_res.result_reg),
 
847
            :flags(@arg_flags),
 
848
            |@val_temps,
 
849
            :result($res)
 
850
        )
 
851
        !! MAST::Call.new(
 
852
            :target($block_res.result_reg),
 
853
            :flags(@arg_flags),
 
854
            |@val_temps
 
855
        );
 
856
    $inv_il := MAST::InstructionList.new([$inv_il], MAST::VOID, $MVM_reg_void);
 
857
    push_ilist($val_il.instructions, $inv_il);
 
858
 
 
859
    # Emit next.
 
860
    push_ilist($loop_il.instructions, $val_il);
 
861
    push_op($loop_il.instructions, 'goto', $lbl_next );
 
862
 
 
863
    # Emit postlude, wrapping in handlers if needed.
 
864
    if $handler {
 
865
        my @ins_wrap := $loop_il.instructions;
 
866
        @ins_wrap := [MAST::HandlerScope.new(
 
867
            :instructions(@ins_wrap),
 
868
            :category_mask($HandlerCategory::redo),
 
869
            :action($HandlerAction::unwind_and_goto),
 
870
            :goto($lbl_redo)
 
871
        )];
 
872
        @ins_wrap := [MAST::HandlerScope.new(
 
873
            :instructions(@ins_wrap),
 
874
            :category_mask($HandlerCategory::next),
 
875
            :action($HandlerAction::unwind_and_goto),
 
876
            :goto($lbl_next)
 
877
        )];
 
878
        nqp::push($il, MAST::HandlerScope.new(
 
879
            :instructions(@ins_wrap),
 
880
            :category_mask($HandlerCategory::last),
 
881
            :action($HandlerAction::unwind_and_goto),
 
882
            :goto($lbl_done)
 
883
        ));
 
884
    }
 
885
    else {
 
886
        push_ilist($il, $loop_il);
 
887
    }
 
888
    nqp::push($il, $lbl_done);
 
889
 
 
890
    # Result, as needed.
 
891
    my $result := $res ?? MAST::InstructionList.new($il, $res, $*WANT) !! MAST::InstructionList.new($il, MAST::VOID, $MVM_reg_void);
 
892
    $*REGALLOC.release_register($list_il.result_reg, $list_il.result_kind);
 
893
    $*REGALLOC.release_register($block_res.result_reg, $block_res.result_kind);
 
894
    for @val_temps { $*REGALLOC.release_register($_, $MVM_reg_obj) }
 
895
    $*REGALLOC.release_register($inv_il.result_reg, $inv_il.result_kind);
 
896
    $result
 
897
});
 
898
 
 
899
# Calling
 
900
my @kind_to_args := [0,
 
901
    $Arg::int,  # $MVM_reg_int8            := 1;
 
902
    $Arg::int,  # $MVM_reg_int16           := 2;
 
903
    $Arg::int,  # $MVM_reg_int32           := 3;
 
904
    $Arg::int,  # $MVM_reg_int64           := 4;
 
905
    $Arg::num,  # $MVM_reg_num32           := 5;
 
906
    $Arg::num,  # $MVM_reg_num64           := 6;
 
907
    $Arg::str,  # $MVM_reg_str             := 7;
 
908
    $Arg::obj   # $MVM_reg_obj             := 8;
 
909
];
 
910
 
 
911
sub handle_arg($arg, $qastcomp, @ins, @arg_regs, @arg_flags, @arg_kinds) {
 
912
    # generate the code for the arg expression
 
913
    my $arg_mast := $qastcomp.as_mast($arg);
 
914
 
 
915
    nqp::die("arg expression cannot be void")
 
916
        if $arg_mast.result_kind == $MVM_reg_void;
 
917
 
 
918
    nqp::die("arg code did not result in a MAST::Local")
 
919
        unless $arg_mast.result_reg && $arg_mast.result_reg ~~ MAST::Local;
 
920
 
 
921
    nqp::push(@arg_kinds, $arg_mast.result_kind);
 
922
 
 
923
    # append the code to the main instruction list
 
924
    push_ilist(@ins, $arg_mast);
 
925
 
 
926
    # build up the typeflag
 
927
    my $result_typeflag := @kind_to_args[$arg_mast.result_kind];
 
928
    if nqp::can($arg, 'flat') && $arg.flat {
 
929
        if $arg.named {
 
930
            $result_typeflag := $result_typeflag +| $Arg::flatnamed;
 
931
        }
 
932
        else {
 
933
            $result_typeflag := $result_typeflag +| $Arg::flat;
 
934
        }
 
935
    }
 
936
    elsif nqp::can($arg, 'named') && $arg.named -> $name {
 
937
        # add in the extra arg for the name
 
938
        nqp::push(@arg_regs, MAST::SVal.new( value => $name ));
 
939
 
 
940
        $result_typeflag := $result_typeflag +| $Arg::named;
 
941
    }
 
942
 
 
943
    # stash the result register and result typeflag
 
944
    nqp::push(@arg_regs, $arg_mast.result_reg);
 
945
    nqp::push(@arg_flags, $result_typeflag);
 
946
}
 
947
 
 
948
sub arrange_args(@in) {
 
949
    my @named := ();
 
950
    my @posit := ();
 
951
    for @in {
 
952
        nqp::push(((nqp::can($_, 'named') && $_.named && (!nqp::can($_, 'flat') || !$_.flat)) ?? @named !! @posit), $_);
 
953
    }
 
954
    for @named { nqp::push(@posit, $_) }
 
955
    @posit
 
956
}
 
957
 
 
958
QAST::MASTOperations.add_core_op('call', sub ($qastcomp, $op) {
 
959
    # Cheat for __MVM__ => nqp::foo
 
960
    if nqp::substr($op.name, 0, 8) eq '&__MVM__' {
 
961
        my $realname := nqp::substr($op.name, 8);
 
962
        return $qastcomp.as_mast(QAST::Op.new( :op($realname), |$op.list ));
 
963
    }
 
964
 
 
965
    # Work out what callee is.
 
966
    my $callee;
 
967
    my @args := $op.list;
 
968
    if $op.name {
 
969
        $callee := $qastcomp.as_mast(QAST::Var.new( :name($op.name), :scope('lexical') ));
 
970
    }
 
971
    elsif +@args {
 
972
        @args := nqp::clone(@args);
 
973
        $callee := $qastcomp.as_mast(@args.shift());
 
974
    }
 
975
    else {
 
976
        nqp::die("No name for call and empty children list");
 
977
    }
 
978
    @args := arrange_args(@args);
 
979
 
 
980
    nqp::die("callee expression must be an object")
 
981
        unless $callee.result_kind == $MVM_reg_obj;
 
982
 
 
983
    nqp::die("callee code did not result in a MAST::Local")
 
984
        unless $callee.result_reg && $callee.result_reg ~~ MAST::Local;
 
985
 
 
986
    # main instruction list
 
987
    my @ins := nqp::list();
 
988
    # the result MAST::Locals of the arg expressions
 
989
    my @arg_regs := nqp::list();
 
990
    # the result kind codes of the arg expressions
 
991
    my @arg_kinds := nqp::list();
 
992
    # the args' flags in the protocol the MAST compiler expects
 
993
    my @arg_flags := nqp::list();
 
994
 
 
995
    # Append the code to evaluate the callee expression
 
996
    push_ilist(@ins, $callee);
 
997
 
 
998
    # Process arguments.
 
999
    for @args {
 
1000
        handle_arg($_, $qastcomp, @ins, @arg_regs, @arg_flags, @arg_kinds);
 
1001
    }
 
1002
 
 
1003
    # Release the callee's result register
 
1004
    $*REGALLOC.release_register($callee.result_reg, $MVM_reg_obj);
 
1005
 
 
1006
    # Release each arg's result register
 
1007
    my $arg_num := 0;
 
1008
    for @arg_regs -> $reg {
 
1009
        if $reg ~~ MAST::Local {
 
1010
            $*REGALLOC.release_register($reg, @arg_kinds[$arg_num]);
 
1011
            $arg_num++;
 
1012
        }
 
1013
    }
 
1014
 
 
1015
    # Figure out result register type
 
1016
    my $res_kind := $qastcomp.type_to_register_kind($op.returns);
 
1017
 
 
1018
    # and allocate a register for it. Probably reuse an arg's or the callee's.
 
1019
    my $res_reg := $*REGALLOC.fresh_register($res_kind);
 
1020
 
 
1021
    # Generate call.
 
1022
    nqp::push(@ins, MAST::Call.new(
 
1023
        :target($callee.result_reg),
 
1024
        :flags(@arg_flags),
 
1025
        |@arg_regs,
 
1026
        :result($res_reg)
 
1027
    ));
 
1028
 
 
1029
    MAST::InstructionList.new(@ins, $res_reg, $res_kind)
 
1030
});
 
1031
 
 
1032
QAST::MASTOperations.add_core_op('callmethod', -> $qastcomp, $op {
 
1033
    my @args := nqp::clone($op.list);
 
1034
    if +@args == 0 {
 
1035
        nqp::die('Method call node requires at least one child');
 
1036
    }
 
1037
    my $invocant := $qastcomp.as_mast(@args.shift(), :want($MVM_reg_obj));
 
1038
    my $methodname_expr;
 
1039
    if $op.name {
 
1040
        # great!
 
1041
    }
 
1042
    elsif +@args >= 1 {
 
1043
        $methodname_expr := @args.shift();
 
1044
    }
 
1045
    else {
 
1046
        nqp::die("Method call must either supply a name or have a child node that evaluates to the name");
 
1047
    }
 
1048
    @args := arrange_args(@args);
 
1049
 
 
1050
    nqp::die("invocant expression must be an object")
 
1051
        unless $invocant.result_kind == $MVM_reg_obj;
 
1052
 
 
1053
    nqp::die("invocant code did not result in a MAST::Local")
 
1054
        unless $invocant.result_reg && $invocant.result_reg ~~ MAST::Local;
 
1055
 
 
1056
    # main instruction list
 
1057
    my @ins := [];
 
1058
    # the result MAST::Locals of the arg expressions
 
1059
    my @arg_regs := [$invocant.result_reg];
 
1060
    # the result kind codes of the arg expressions
 
1061
    my @arg_kinds := [$MVM_reg_obj];
 
1062
    # the args' flags in the protocol the MAST compiler expects
 
1063
    my @arg_flags := [$Arg::obj];
 
1064
 
 
1065
    # evaluate the invocant expression
 
1066
    push_ilist(@ins, $invocant);
 
1067
 
 
1068
    # Process arguments.
 
1069
    for @args {
 
1070
        handle_arg($_, $qastcomp, @ins, @arg_regs, @arg_flags, @arg_kinds);
 
1071
    }
 
1072
 
 
1073
    # generate and emit findmethod code
 
1074
    my $callee_reg := $*REGALLOC.fresh_o();
 
1075
 
 
1076
    # This will hold the 3rd argument to findmeth(_s) - the method name
 
1077
    # either a MAST::SVal or an $MVM_reg_str
 
1078
    my $method_name;
 
1079
    if $op.name {
 
1080
        $method_name := MAST::SVal.new( :value($op.name) );
 
1081
    }
 
1082
    else {
 
1083
        my $method_name_ilist := $qastcomp.as_mast($methodname_expr, :want($MVM_reg_str));
 
1084
        push_ilist(@ins, $method_name_ilist);
 
1085
        $method_name := $method_name_ilist.result_reg;
 
1086
    }
 
1087
 
 
1088
    # push the op that finds the method based on either the provided name
 
1089
    # or the provided name-producing expression.
 
1090
    push_op(@ins, ($op.name ?? 'findmeth' !! 'findmeth_s'),
 
1091
        $callee_reg, $invocant.result_reg, $method_name);
 
1092
 
 
1093
    # release the method name register if we used one
 
1094
    $*REGALLOC.release_register($method_name, $MVM_reg_str) unless $op.name;
 
1095
 
 
1096
    # release the callee register
 
1097
    $*REGALLOC.release_register($callee_reg, $MVM_reg_obj);
 
1098
 
 
1099
    # Release the invocant's and each arg's result registers
 
1100
    my $arg_num := 0;
 
1101
    for @arg_regs -> $reg {
 
1102
        if $reg ~~ MAST::Local {
 
1103
            $*REGALLOC.release_register($reg, @arg_kinds[$arg_num]);
 
1104
            $arg_num++;
 
1105
        }
 
1106
    }
 
1107
 
 
1108
    # Figure out expected result register type
 
1109
    my $res_kind := $qastcomp.type_to_register_kind($op.returns);
 
1110
 
 
1111
    # and allocate a register for it. Probably reuse an arg's or the invocant's.
 
1112
    my $res_reg := $*REGALLOC.fresh_register($res_kind);
 
1113
 
 
1114
    # Generate call.
 
1115
    nqp::push(@ins, MAST::Call.new(
 
1116
        :target($callee_reg),
 
1117
        :result($res_reg),
 
1118
        :flags(@arg_flags),
 
1119
        |@arg_regs
 
1120
    ));
 
1121
 
 
1122
    MAST::InstructionList.new(@ins, $res_reg, $res_kind)
 
1123
});
 
1124
 
 
1125
QAST::MASTOperations.add_core_op('lexotic', -> $qastcomp, $op {
 
1126
    my $lex_label := MAST::Label.new( :name($qastcomp.unique('lexotic_')) );
 
1127
    my $end_label := MAST::Label.new( :name($qastcomp.unique('lexotic_end_')) );
 
1128
 
 
1129
    # Create new lexotic and install it lexically.
 
1130
    my @ins;
 
1131
    my $lex_tmp := $*REGALLOC.fresh_register($MVM_reg_obj);
 
1132
    $*BLOCK.add_lexical(QAST::Var.new( :name($op.name), :scope('lexical'), :decl('var') ));
 
1133
    push_op(@ins, 'newlexotic', $lex_tmp, $lex_label);
 
1134
    push_op(@ins, 'bindlex', $*BLOCK.lexical($op.name), $lex_tmp);
 
1135
 
 
1136
    # Emit the body, and go to the end of the lexotic code; the body's result
 
1137
    # is what we want.
 
1138
    my $body := $qastcomp.compile_all_the_stmts($op.list, :want($MVM_reg_obj));
 
1139
    nqp::push(@ins, MAST::HandlerScope.new(
 
1140
        :instructions($body.instructions),
 
1141
        :category_mask($HandlerCategory::return),
 
1142
        :action($HandlerAction::unwind_and_goto),
 
1143
        :goto($lex_label)
 
1144
    ));
 
1145
    push_op(@ins, 'goto', $end_label);
 
1146
 
 
1147
    # Finally, emit the lexotic handler.
 
1148
    nqp::push(@ins, $lex_label);
 
1149
    push_op(@ins, 'lexoticresult', $body.result_reg, $lex_tmp);
 
1150
    nqp::push(@ins, $end_label);
 
1151
 
 
1152
    $*REGALLOC.release_register($lex_tmp, $MVM_reg_obj);
 
1153
 
 
1154
    MAST::InstructionList.new(@ins, $body.result_reg, $MVM_reg_obj)
 
1155
});
 
1156
 
 
1157
# Binding
 
1158
QAST::MASTOperations.add_core_op('bind', -> $qastcomp, $op {
 
1159
    # Sanity checks.
 
1160
    my @children := $op.list;
 
1161
    if +@children != 2 {
 
1162
        nqp::die("A 'bind' op must have exactly two children");
 
1163
    }
 
1164
    unless nqp::istype(@children[0], QAST::Var) {
 
1165
        nqp::die("First child of a 'bind' op must be a QAST::Var");
 
1166
    }
 
1167
 
 
1168
    # Set the QAST of the think we're to bind, then delegate to
 
1169
    # the compilation of the QAST::Var to handle the rest.
 
1170
    my $*BINDVAL := @children[1];
 
1171
    $qastcomp.as_mast(@children[0])
 
1172
});
 
1173
 
 
1174
# Exception handling/munging.
 
1175
QAST::MASTOperations.add_core_moarop_mapping('die', 'die');
 
1176
QAST::MASTOperations.add_core_moarop_mapping('die_s', 'die');
 
1177
QAST::MASTOperations.add_core_moarop_mapping('exception', 'exception');
 
1178
QAST::MASTOperations.add_core_moarop_mapping('getextype', 'getexcategory');
 
1179
QAST::MASTOperations.add_core_moarop_mapping('setextype', 'bindexcategory', 1);
 
1180
QAST::MASTOperations.add_core_moarop_mapping('getpayload', 'getexpayload');
 
1181
QAST::MASTOperations.add_core_moarop_mapping('setpayload', 'bindexpayload', 1);
 
1182
QAST::MASTOperations.add_core_moarop_mapping('getmessage', 'getexmessage');
 
1183
QAST::MASTOperations.add_core_moarop_mapping('setmessage', 'bindexmessage', 1);
 
1184
QAST::MASTOperations.add_core_moarop_mapping('newexception', 'newexception');
 
1185
QAST::MASTOperations.add_core_moarop_mapping('backtracestrings', 'backtracestrings');
 
1186
# XXX backtrace
 
1187
QAST::MASTOperations.add_core_moarop_mapping('throw', 'throwdyn');
 
1188
QAST::MASTOperations.add_core_moarop_mapping('rethrow', 'rethrow');
 
1189
QAST::MASTOperations.add_core_moarop_mapping('resume', 'resume');
 
1190
 
 
1191
my %handler_names := nqp::hash(
 
1192
    'CATCH',   $HandlerCategory::catch,
 
1193
    'CONTROL', $HandlerCategory::control,
 
1194
    'NEXT',    $HandlerCategory::next,
 
1195
    'LAST',    $HandlerCategory::last,
 
1196
    'REDO',    $HandlerCategory::redo,
 
1197
    'TAKE',    $HandlerCategory::take,
 
1198
    'WARN',    $HandlerCategory::warn,
 
1199
    'PROCEED', $HandlerCategory::proceed,
 
1200
    'SUCCEED', $HandlerCategory::succeed,
 
1201
);
 
1202
QAST::MASTOperations.add_core_op('handle', sub ($qastcomp, $op) {
 
1203
    my @children := nqp::clone($op.list());
 
1204
    if @children == 0 {
 
1205
        nqp::die("The 'handle' op requires at least one child");
 
1206
    }
 
1207
 
 
1208
    # If there's exactly one child, then there's nothing protecting
 
1209
    # it; just compile it and we're done.
 
1210
    my $protected := @children.shift();
 
1211
    unless @children {
 
1212
        return $qastcomp.as_mast($protected);
 
1213
    }
 
1214
 
 
1215
    # Otherwise, we need to generate and install a handler block, which will
 
1216
    # decide that to do by category.
 
1217
    my $mask := 0;
 
1218
    my $hblock := QAST::Block.new(
 
1219
        QAST::Op.new(
 
1220
            :op('bind'),
 
1221
            QAST::Var.new( :name('__category__'), :scope('local'), :decl('var') ),
 
1222
            QAST::Op.new(
 
1223
                :op('getextype'),
 
1224
                QAST::Op.new( :op('exception') )
 
1225
            )));
 
1226
    my $push_target := $hblock;
 
1227
    for @children -> $type, $handler {
 
1228
        # Get the category mask.
 
1229
        unless nqp::existskey(%handler_names, $type) {
 
1230
            nqp::die("Invalid handler type '$type'");
 
1231
        }
 
1232
        my $cat_mask := %handler_names{$type};
 
1233
 
 
1234
        # Chain in this handler.
 
1235
        my $check := QAST::Op.new(
 
1236
            :op('if'),
 
1237
            QAST::Op.new(
 
1238
                :op('bitand_i'),
 
1239
                QAST::Var.new( :name('__category__'), :scope('local') ),
 
1240
                QAST::IVal.new( :value($cat_mask) )
 
1241
            ),
 
1242
            $handler
 
1243
        );
 
1244
        $push_target.push($check);
 
1245
        $push_target := $check;
 
1246
 
 
1247
        # Add to mask.
 
1248
        $mask := nqp::bitor_i($mask, $cat_mask);
 
1249
    }
 
1250
 
 
1251
    # Add a local and store the handler block into it.
 
1252
    my $hblocal := MAST::Local.new(:index($*MAST_FRAME.add_local(NQPMu)));
 
1253
    my $il      := nqp::list();
 
1254
    my $hbmast  := $qastcomp.as_mast($hblock, :want($MVM_reg_obj));
 
1255
    push_ilist($il, $hbmast);
 
1256
    push_op($il, 'set', $hblocal, $hbmast.result_reg);
 
1257
    $*REGALLOC.release_register($hbmast.result_reg, $MVM_reg_obj);
 
1258
 
 
1259
    # Wrap instructions to try up in a handler and evaluate to the result
 
1260
    # of the protected code of the exception handler.
 
1261
    my $protil := $qastcomp.as_mast($protected, :want($MVM_reg_obj));
 
1262
    my $uwlbl  := MAST::Label.new( :name($qastcomp.unique('handle_unwind_')) );
 
1263
    my $endlbl := MAST::Label.new( :name($qastcomp.unique('handle_end_')) );
 
1264
    push_op($protil.instructions, 'goto', $endlbl);
 
1265
    nqp::push($il, MAST::HandlerScope.new(
 
1266
        :instructions($protil.instructions), :goto($uwlbl), :block($hblocal),
 
1267
        :category_mask($mask), :action($HandlerAction::invoke_and_we'll_see)));
 
1268
    nqp::push($il, $uwlbl);
 
1269
    push_op($il, 'takehandlerresult', $protil.result_reg);
 
1270
    nqp::push($il, $endlbl);
 
1271
 
 
1272
    MAST::InstructionList.new($il, $protil.result_reg, $MVM_reg_obj)
 
1273
});
 
1274
 
 
1275
# Control exception throwing.
 
1276
my %control_map := nqp::hash(
 
1277
    'next', $HandlerCategory::next,
 
1278
    'last', $HandlerCategory::last,
 
1279
    'redo', $HandlerCategory::redo
 
1280
);
 
1281
QAST::MASTOperations.add_core_op('control', -> $qastcomp, $op {
 
1282
    my $name := $op.name;
 
1283
    if nqp::existskey(%control_map, $name) {
 
1284
        my $il := nqp::list();
 
1285
        my $res := $*REGALLOC.fresh_register($MVM_reg_obj);
 
1286
        push_op($il, 'throwcatdyn', $res,
 
1287
            MAST::IVal.new( :value(%control_map{$name}) ));
 
1288
        MAST::InstructionList.new($il, $res, $MVM_reg_obj)
 
1289
    }
 
1290
    else {
 
1291
        nqp::die("Unknown control exception type '$name'");
 
1292
    }
 
1293
});
 
1294
 
 
1295
# Default ways to box/unbox (for no particular HLL).
 
1296
QAST::MASTOperations.add_hll_unbox('', $MVM_reg_int64, -> $qastcomp, $reg {
 
1297
    my $il := nqp::list();
 
1298
    my $a := $*REGALLOC.fresh_register($MVM_reg_num64);
 
1299
    my $b := $*REGALLOC.fresh_register($MVM_reg_int64);
 
1300
    push_op($il, 'smrt_numify', $a, $reg);
 
1301
    push_op($il, 'coerce_ni', $b, $a);
 
1302
    $*REGALLOC.release_register($a, $MVM_reg_num64);
 
1303
    $*REGALLOC.release_register($reg, $MVM_reg_obj);
 
1304
    MAST::InstructionList.new($il, $b, $MVM_reg_int64)
 
1305
});
 
1306
QAST::MASTOperations.add_hll_unbox('', $MVM_reg_num64, -> $qastcomp, $reg {
 
1307
    my $il := nqp::list();
 
1308
    my $res_reg := $*REGALLOC.fresh_register($MVM_reg_num64);
 
1309
    push_op($il, 'smrt_numify', $res_reg, $reg);
 
1310
    $*REGALLOC.release_register($reg, $MVM_reg_obj);
 
1311
    MAST::InstructionList.new($il, $res_reg, $MVM_reg_num64)
 
1312
});
 
1313
QAST::MASTOperations.add_hll_unbox('', $MVM_reg_str, -> $qastcomp, $reg {
 
1314
    my $il := nqp::list();
 
1315
    my $res_reg := $*REGALLOC.fresh_register($MVM_reg_str);
 
1316
    push_op($il, 'smrt_strify', $res_reg, $reg);
 
1317
    $*REGALLOC.release_register($reg, $MVM_reg_obj);
 
1318
    MAST::InstructionList.new($il, $res_reg, $MVM_reg_str)
 
1319
});
 
1320
sub boxer($kind, $type_op, $op) {
 
1321
    -> $qastcomp, $reg {
 
1322
        my $il := nqp::list();
 
1323
        my $res_reg := $*REGALLOC.fresh_register($MVM_reg_obj);
 
1324
        push_op($il, $type_op, $res_reg);
 
1325
        push_op($il, $op, $res_reg, $reg, $res_reg);
 
1326
        $*REGALLOC.release_register($reg, $kind);
 
1327
        MAST::InstructionList.new($il, $res_reg, $MVM_reg_obj)
 
1328
    }
 
1329
}
 
1330
QAST::MASTOperations.add_hll_box('', $MVM_reg_int64, boxer($MVM_reg_int64, 'hllboxtype_i', 'box_i'));
 
1331
QAST::MASTOperations.add_hll_box('', $MVM_reg_num64, boxer($MVM_reg_num64, 'hllboxtype_n', 'box_n'));
 
1332
QAST::MASTOperations.add_hll_box('', $MVM_reg_str, boxer($MVM_reg_str, 'hllboxtype_s', 'box_s'));
 
1333
QAST::MASTOperations.add_hll_box('', $MVM_reg_void, -> $qastcomp, $reg {
 
1334
    my $il := nqp::list();
 
1335
    my $res_reg := $*REGALLOC.fresh_register($MVM_reg_obj);
 
1336
    push_op($il, 'null', $res_reg);
 
1337
    MAST::InstructionList.new($il, $res_reg, $MVM_reg_obj)
 
1338
});
 
1339
 
 
1340
# Context introspection
 
1341
QAST::MASTOperations.add_core_moarop_mapping('ctx', 'ctx');
 
1342
QAST::MASTOperations.add_core_moarop_mapping('ctxouter', 'ctxouter');
 
1343
QAST::MASTOperations.add_core_moarop_mapping('ctxcaller', 'ctxcaller');
 
1344
QAST::MASTOperations.add_core_moarop_mapping('curcode', 'curcode');
 
1345
QAST::MASTOperations.add_core_moarop_mapping('callercode', 'callercode');
 
1346
QAST::MASTOperations.add_core_moarop_mapping('ctxlexpad', 'ctxlexpad');
 
1347
QAST::MASTOperations.add_core_moarop_mapping('curlexpad', 'ctx');
 
1348
QAST::MASTOperations.add_core_moarop_mapping('lexprimspec', 'lexprimspec');
 
1349
 
 
1350
# Argument capture processing, for writing things like multi-dispatchers in
 
1351
# high level languages.
 
1352
QAST::MASTOperations.add_core_moarop_mapping('usecapture', 'usecapture');
 
1353
QAST::MASTOperations.add_core_moarop_mapping('savecapture', 'savecapture');
 
1354
QAST::MASTOperations.add_core_moarop_mapping('captureposelems', 'captureposelems');
 
1355
QAST::MASTOperations.add_core_moarop_mapping('captureposarg', 'captureposarg');
 
1356
QAST::MASTOperations.add_core_moarop_mapping('captureposarg_i', 'captureposarg_i');
 
1357
QAST::MASTOperations.add_core_moarop_mapping('captureposarg_n', 'captureposarg_n');
 
1358
QAST::MASTOperations.add_core_moarop_mapping('captureposarg_s', 'captureposarg_s');
 
1359
QAST::MASTOperations.add_core_moarop_mapping('captureposprimspec', 'captureposprimspec');
 
1360
QAST::MASTOperations.add_core_moarop_mapping('objprimspec', 'objprimspec');
 
1361
 
 
1362
# Multiple dispatch related.
 
1363
QAST::MASTOperations.add_core_moarop_mapping('invokewithcapture', 'invokewithcapture');
 
1364
QAST::MASTOperations.add_core_moarop_mapping('multicacheadd', 'multicacheadd');
 
1365
QAST::MASTOperations.add_core_moarop_mapping('multicachefind', 'multicachefind');
 
1366
 
 
1367
# Constant mapping.
 
1368
my %const_map := nqp::hash(
 
1369
    'CCLASS_ANY',           65535,
 
1370
    'CCLASS_UPPERCASE',     1,
 
1371
    'CCLASS_LOWERCASE',     2,
 
1372
    'CCLASS_ALPHABETIC',    4,
 
1373
    'CCLASS_NUMERIC',       8,
 
1374
    'CCLASS_HEXADECIMAL',   16,
 
1375
    'CCLASS_WHITESPACE',    32,
 
1376
    'CCLASS_PRINTING',      64,
 
1377
    'CCLASS_BLANK',         256,
 
1378
    'CCLASS_CONTROL',       512,
 
1379
    'CCLASS_PUNCTUATION',   1024,
 
1380
    'CCLASS_ALPHANUMERIC',  2048,
 
1381
    'CCLASS_NEWLINE',       4096,
 
1382
    'CCLASS_WORD',          8192,
 
1383
 
 
1384
    'HLL_ROLE_NONE',        0,
 
1385
    'HLL_ROLE_INT',         1,
 
1386
    'HLL_ROLE_NUM',         2,
 
1387
    'HLL_ROLE_STR',         3,
 
1388
    'HLL_ROLE_ARRAY',       4,
 
1389
    'HLL_ROLE_HASH',        5,
 
1390
    'HLL_ROLE_CODE',        6,
 
1391
 
 
1392
    'CONTROL_TAKE',         32,
 
1393
    'CONTROL_LAST',         16,
 
1394
    'CONTROL_NEXT',         4,
 
1395
    'CONTROL_REDO',         8,
 
1396
    'CONTROL_SUCCEED',      128,
 
1397
    'CONTROL_PROCEED',      256,
 
1398
    'CONTROL_WARN',         64,
 
1399
 
 
1400
    'STAT_EXISTS',             0,
 
1401
    'STAT_FILESIZE',           1,
 
1402
    'STAT_ISDIR',              2,
 
1403
    'STAT_ISREG',              3,
 
1404
    'STAT_ISDEV',              4,
 
1405
    'STAT_CREATETIME',         5,
 
1406
    'STAT_ACCESSTIME',         6,
 
1407
    'STAT_MODIFYTIME',         7,
 
1408
    'STAT_CHANGETIME',         8,
 
1409
    'STAT_BACKUPTIME',         9,
 
1410
    'STAT_UID',                10,
 
1411
    'STAT_GID',                11,
 
1412
    'STAT_ISLNK',              12,
 
1413
    'STAT_PLATFORM_DEV',       -1,
 
1414
    'STAT_PLATFORM_INODE',     -2,
 
1415
    'STAT_PLATFORM_MODE',      -3,
 
1416
    'STAT_PLATFORM_NLINKS',    -4,
 
1417
    'STAT_PLATFORM_DEVTYPE',   -5,
 
1418
    'STAT_PLATFORM_BLOCKSIZE', -6,
 
1419
    'STAT_PLATFORM_BLOCKS',    -7,
 
1420
);
 
1421
QAST::MASTOperations.add_core_op('const', -> $qastcomp, $op {
 
1422
    if nqp::existskey(%const_map, $op.name) {
 
1423
        $qastcomp.as_mast(QAST::IVal.new( :value(%const_map{$op.name}) ))
 
1424
    }
 
1425
    else {
 
1426
        nqp::die("Unknown constant '" ~ $op.name ~ "'");
 
1427
    }
 
1428
});
 
1429
 
 
1430
# Default way to do positional and associative lookups.
 
1431
QAST::MASTOperations.add_core_moarop_mapping('positional_get', 'atpos_o');
 
1432
QAST::MASTOperations.add_core_moarop_mapping('positional_bind', 'bindpos_o', 2);
 
1433
QAST::MASTOperations.add_core_moarop_mapping('associative_get', 'atkey_o');
 
1434
QAST::MASTOperations.add_core_moarop_mapping('associative_bind', 'bindkey_o', 2);
 
1435
 
 
1436
# I/O opcodes
 
1437
QAST::MASTOperations.add_core_moarop_mapping('say', 'say', 0);
 
1438
QAST::MASTOperations.add_core_moarop_mapping('print', 'print', 0);
 
1439
QAST::MASTOperations.add_core_moarop_mapping('stat', 'stat');
 
1440
QAST::MASTOperations.add_core_moarop_mapping('open', 'open_fh');
 
1441
QAST::MASTOperations.add_core_moarop_mapping('flushfh', 'sync_fh');
 
1442
QAST::MASTOperations.add_core_moarop_mapping('getstdin', 'getstdin');
 
1443
QAST::MASTOperations.add_core_moarop_mapping('getstdout', 'getstdout');
 
1444
QAST::MASTOperations.add_core_moarop_mapping('getstderr', 'getstderr');
 
1445
QAST::MASTOperations.add_core_moarop_mapping('setencoding', 'setencoding');
 
1446
QAST::MASTOperations.add_core_moarop_mapping('tellfh', 'tell_fh');
 
1447
QAST::MASTOperations.add_core_moarop_mapping('printfh', 'write_fhs');
 
1448
# QAST::MASTOperations.add_core_moarop_mapping('sayfh', ?);
 
1449
QAST::MASTOperations.add_core_moarop_mapping('readlinefh', 'readline_fh');
 
1450
QAST::MASTOperations.add_core_moarop_mapping('readlineintfh', 'readlineint_fh');
 
1451
QAST::MASTOperations.add_core_moarop_mapping('readallfh', 'readall_fh');
 
1452
QAST::MASTOperations.add_core_moarop_mapping('eoffh', 'eof_fh');
 
1453
QAST::MASTOperations.add_core_moarop_mapping('closefh', 'close_fh', 0);
 
1454
 
 
1455
QAST::MASTOperations.add_core_moarop_mapping('chmod', 'chmod_f', 0);
 
1456
QAST::MASTOperations.add_core_moarop_mapping('unlink', 'delete_f', 0);
 
1457
QAST::MASTOperations.add_core_moarop_mapping('rmdir', 'rmdir', 0);
 
1458
QAST::MASTOperations.add_core_moarop_mapping('cwd', 'cwd');
 
1459
QAST::MASTOperations.add_core_moarop_mapping('chdir', 'chdir', 0);
 
1460
QAST::MASTOperations.add_core_moarop_mapping('mkdir', 'mkdir', 0);
 
1461
QAST::MASTOperations.add_core_moarop_mapping('rename', 'rename_f', 0);
 
1462
QAST::MASTOperations.add_core_moarop_mapping('copy', 'copy_f', 0);
 
1463
# QAST::MASTOperations.add_core_moarop_mapping('symlink', ?);
 
1464
# QAST::MASTOperations.add_core_moarop_mapping('link', ?);
 
1465
QAST::MASTOperations.add_core_op('sprintf', -> $qastcomp, $op {
 
1466
    my @operands := $op.list;
 
1467
    $qastcomp.as_mast(
 
1468
        QAST::Op.new(
 
1469
            :op('call'),
 
1470
            :returns(str),
 
1471
            QAST::Op.new(
 
1472
                :op('gethllsym'),
 
1473
                QAST::SVal.new( :value('nqp') ),
 
1474
                QAST::SVal.new( :value('sprintf') )
 
1475
            ),
 
1476
            |@operands )
 
1477
    );
 
1478
});
 
1479
QAST::MASTOperations.add_core_op('sprintfaddargumenthandler', -> $qastcomp, $op {
 
1480
    my @operands := $op.list;
 
1481
    $qastcomp.as_mast(
 
1482
        QAST::Op.new(
 
1483
            :op('call'),
 
1484
            :returns(str),
 
1485
            QAST::Op.new(
 
1486
                :op('gethllsym'),
 
1487
                QAST::SVal.new( :value('nqp') ),
 
1488
                QAST::SVal.new( :value('sprintfaddargumenthandler') )
 
1489
            ),
 
1490
            |@operands )
 
1491
    );
 
1492
});
 
1493
 
 
1494
# terms
 
1495
QAST::MASTOperations.add_core_moarop_mapping('time_i', 'time_i');
 
1496
QAST::MASTOperations.add_core_moarop_mapping('time_n', 'time_n');
 
1497
 
 
1498
# Arithmetic ops
 
1499
QAST::MASTOperations.add_core_moarop_mapping('add_i', 'add_i');
 
1500
QAST::MASTOperations.add_core_moarop_mapping('add_I', 'add_I');
 
1501
QAST::MASTOperations.add_core_moarop_mapping('add_n', 'add_n');
 
1502
QAST::MASTOperations.add_core_moarop_mapping('sub_i', 'sub_i');
 
1503
QAST::MASTOperations.add_core_moarop_mapping('sub_I', 'sub_I');
 
1504
QAST::MASTOperations.add_core_moarop_mapping('sub_n', 'sub_n');
 
1505
QAST::MASTOperations.add_core_moarop_mapping('mul_i', 'mul_i');
 
1506
QAST::MASTOperations.add_core_moarop_mapping('mul_I', 'mul_I');
 
1507
QAST::MASTOperations.add_core_moarop_mapping('mul_n', 'mul_n');
 
1508
QAST::MASTOperations.add_core_moarop_mapping('div_i', 'div_i');
 
1509
QAST::MASTOperations.add_core_moarop_mapping('div_I', 'div_I');
 
1510
QAST::MASTOperations.add_core_moarop_mapping('div_In', 'div_In');
 
1511
QAST::MASTOperations.add_core_moarop_mapping('div_n', 'div_n');
 
1512
QAST::MASTOperations.add_core_moarop_mapping('mod_i', 'mod_i');
 
1513
QAST::MASTOperations.add_core_moarop_mapping('mod_I', 'mod_I');
 
1514
QAST::MASTOperations.add_core_moarop_mapping('expmod_I', 'expmod_I');
 
1515
QAST::MASTOperations.add_core_moarop_mapping('mod_n', 'mod_n');
 
1516
QAST::MASTOperations.add_core_moarop_mapping('neg_i', 'neg_i');
 
1517
QAST::MASTOperations.add_core_moarop_mapping('neg_I', 'neg_I');
 
1518
QAST::MASTOperations.add_core_moarop_mapping('neg_n', 'neg_n');
 
1519
QAST::MASTOperations.add_core_moarop_mapping('pow_n', 'pow_n');
 
1520
QAST::MASTOperations.add_core_moarop_mapping('pow_I', 'pow_I');
 
1521
QAST::MASTOperations.add_core_moarop_mapping('abs_i', 'abs_i');
 
1522
QAST::MASTOperations.add_core_moarop_mapping('abs_I', 'abs_I');
 
1523
QAST::MASTOperations.add_core_moarop_mapping('abs_n', 'abs_n');
 
1524
QAST::MASTOperations.add_core_moarop_mapping('ceil_n', 'ceil_n');
 
1525
QAST::MASTOperations.add_core_moarop_mapping('floor_n', 'floor_n');
 
1526
QAST::MASTOperations.add_core_moarop_mapping('ln_n', 'log_n'); # looks like this one is never used
 
1527
QAST::MASTOperations.add_core_moarop_mapping('sqrt_n', 'sqrt_n');
 
1528
QAST::MASTOperations.add_core_moarop_mapping('base_I', 'base_I');
 
1529
QAST::MASTOperations.add_core_moarop_mapping('isbig_I', 'isbig_I');
 
1530
QAST::MASTOperations.add_core_moarop_mapping('radix', 'radix');
 
1531
QAST::MASTOperations.add_core_moarop_mapping('radix_I', 'radix_I');
 
1532
QAST::MASTOperations.add_core_moarop_mapping('log_n', 'log_n');
 
1533
QAST::MASTOperations.add_core_moarop_mapping('exp_n', 'exp_n');
 
1534
#QAST::MASTOperations.add_core_moarop_mapping('isnanorinf', 'is_inf_or_nan', 'In');
 
1535
QAST::MASTOperations.add_core_moarop_mapping('isprime_I', 'isprime_I');
 
1536
QAST::MASTOperations.add_core_moarop_mapping('rand_I', 'rand_I');
 
1537
 
 
1538
# bigint <-> string/num conversions
 
1539
QAST::MASTOperations.add_core_moarop_mapping('tostr_I', 'coerce_Is');
 
1540
QAST::MASTOperations.add_core_moarop_mapping('fromstr_I', 'coerce_sI');
 
1541
QAST::MASTOperations.add_core_moarop_mapping('tonum_I', 'coerce_In');
 
1542
QAST::MASTOperations.add_core_moarop_mapping('fromnum_I', 'coerce_nI');
 
1543
 
 
1544
# trig opcodes
 
1545
QAST::MASTOperations.add_core_moarop_mapping('sin_n', 'sin_n');
 
1546
QAST::MASTOperations.add_core_moarop_mapping('asin_n', 'asin_n');
 
1547
QAST::MASTOperations.add_core_moarop_mapping('cos_n', 'cos_n');
 
1548
QAST::MASTOperations.add_core_moarop_mapping('acos_n', 'acos_n');
 
1549
QAST::MASTOperations.add_core_moarop_mapping('tan_n', 'tan_n');
 
1550
QAST::MASTOperations.add_core_moarop_mapping('atan_n', 'atan_n');
 
1551
QAST::MASTOperations.add_core_moarop_mapping('atan2_n', 'atan2_n');
 
1552
QAST::MASTOperations.add_core_moarop_mapping('sec_n', 'sec_n');
 
1553
QAST::MASTOperations.add_core_moarop_mapping('asec_n', 'asec_n');
 
1554
QAST::MASTOperations.add_core_moarop_mapping('asin_n', 'asin_n');
 
1555
QAST::MASTOperations.add_core_moarop_mapping('sinh_n', 'sinh_n');
 
1556
QAST::MASTOperations.add_core_moarop_mapping('cosh_n', 'cosh_n');
 
1557
QAST::MASTOperations.add_core_moarop_mapping('tanh_n', 'tanh_n');
 
1558
QAST::MASTOperations.add_core_moarop_mapping('sech_n', 'sech_n');
 
1559
 
 
1560
# esoteric math opcodes
 
1561
QAST::MASTOperations.add_core_moarop_mapping('gcd_i', 'gcd_i');
 
1562
QAST::MASTOperations.add_core_moarop_mapping('gcd_I', 'gcd_I');
 
1563
QAST::MASTOperations.add_core_moarop_mapping('lcm_i', 'lcm_i');
 
1564
QAST::MASTOperations.add_core_moarop_mapping('lcm_I', 'lcm_I');
 
1565
 
 
1566
# string opcodes
 
1567
QAST::MASTOperations.add_core_moarop_mapping('chars', 'chars');
 
1568
QAST::MASTOperations.add_core_moarop_mapping('uc', 'uc');
 
1569
QAST::MASTOperations.add_core_moarop_mapping('lc', 'lc');
 
1570
QAST::MASTOperations.add_core_moarop_mapping('tc', 'tc');
 
1571
QAST::MASTOperations.add_core_moarop_mapping('x', 'repeat_s');
 
1572
QAST::MASTOperations.add_core_moarop_mapping('iscclass', 'iscclass');
 
1573
QAST::MASTOperations.add_core_moarop_mapping('findcclass', 'findcclass');
 
1574
QAST::MASTOperations.add_core_moarop_mapping('findnotcclass', 'findnotcclass');
 
1575
QAST::MASTOperations.add_core_moarop_mapping('escape', 'escape');
 
1576
QAST::MASTOperations.add_core_moarop_mapping('flip', 'flip');
 
1577
QAST::MASTOperations.add_core_moarop_mapping('concat', 'concat_s');
 
1578
QAST::MASTOperations.add_core_moarop_mapping('join', 'join');
 
1579
QAST::MASTOperations.add_core_moarop_mapping('split', 'split');
 
1580
QAST::MASTOperations.add_core_moarop_mapping('chr', 'chr');
 
1581
QAST::MASTOperations.add_core_moarop_mapping('ordfirst', 'ordfirst');
 
1582
QAST::MASTOperations.add_core_moarop_mapping('ordat', 'ordat');
 
1583
QAST::MASTOperations.add_core_moarop_mapping('index_s', 'index_s');
 
1584
QAST::MASTOperations.add_core_moarop_mapping('rindexfrom', 'rindexfrom');
 
1585
QAST::MASTOperations.add_core_moarop_mapping('substr_s', 'substr_s');
 
1586
QAST::MASTOperations.add_core_moarop_mapping('codepointfromname', 'getcpbyname');
 
1587
QAST::MASTOperations.add_core_moarop_mapping('encode', 'encode');
 
1588
QAST::MASTOperations.add_core_moarop_mapping('decode', 'decode');
 
1589
 
 
1590
QAST::MASTOperations.add_core_op('substr', -> $qastcomp, $op {
 
1591
    my @operands := $op.list;
 
1592
    if +@operands == 2 { nqp::push(@operands, QAST::IVal.new( :value(-1) )) }
 
1593
    $qastcomp.as_mast(QAST::Op.new( :op('substr_s'), |@operands ));
 
1594
});
 
1595
 
 
1596
QAST::MASTOperations.add_core_op('ord',  -> $qastcomp, $op {
 
1597
    my @operands := $op.list;
 
1598
    $qastcomp.as_mast(+@operands == 1
 
1599
        ?? QAST::Op.new( :op('ordfirst'), |@operands )
 
1600
        !! QAST::Op.new( :op('ordat'), |@operands ));
 
1601
});
 
1602
 
 
1603
QAST::MASTOperations.add_core_op('index',  -> $qastcomp, $op {
 
1604
    my @operands := $op.list;
 
1605
    $qastcomp.as_mast(+@operands == 2
 
1606
        ?? QAST::Op.new( :op('index_s'), |@operands, QAST::IVal.new( :value(0)) )
 
1607
        !! QAST::Op.new( :op('index_s'), |@operands ));
 
1608
});
 
1609
 
 
1610
QAST::MASTOperations.add_core_op('rindex',  -> $qastcomp, $op {
 
1611
    my @operands := $op.list;
 
1612
    $qastcomp.as_mast(+@operands == 2
 
1613
        ?? QAST::Op.new( :op('rindexfrom'), |@operands, QAST::IVal.new( :value(-1) ) )
 
1614
        !! QAST::Op.new( :op('rindexfrom'), |@operands ));
 
1615
});
 
1616
 
 
1617
# serialization context opcodes
 
1618
QAST::MASTOperations.add_core_moarop_mapping('sha1', 'sha1');
 
1619
QAST::MASTOperations.add_core_moarop_mapping('createsc', 'createsc');
 
1620
QAST::MASTOperations.add_core_moarop_mapping('scsetobj', 'scsetobj', 2);
 
1621
QAST::MASTOperations.add_core_moarop_mapping('scsetcode', 'scsetcode', 2);
 
1622
QAST::MASTOperations.add_core_moarop_mapping('scgetobj', 'scgetobj');
 
1623
QAST::MASTOperations.add_core_moarop_mapping('scgethandle', 'scgethandle');
 
1624
QAST::MASTOperations.add_core_moarop_mapping('scgetdesc', 'scgetdesc');
 
1625
QAST::MASTOperations.add_core_moarop_mapping('scgetobjidx', 'scgetobjidx');
 
1626
QAST::MASTOperations.add_core_moarop_mapping('scsetdesc', 'scsetdesc', 1);
 
1627
QAST::MASTOperations.add_core_moarop_mapping('scobjcount', 'scobjcount');
 
1628
QAST::MASTOperations.add_core_moarop_mapping('setobjsc', 'setobjsc', 0);
 
1629
QAST::MASTOperations.add_core_moarop_mapping('getobjsc', 'getobjsc');
 
1630
QAST::MASTOperations.add_core_moarop_mapping('serialize', 'serialize');
 
1631
QAST::MASTOperations.add_core_moarop_mapping('deserialize', 'deserialize', 0);
 
1632
QAST::MASTOperations.add_core_moarop_mapping('scwbdisable', 'scwbdisable');
 
1633
QAST::MASTOperations.add_core_moarop_mapping('scwbenable', 'scwbenable');
 
1634
QAST::MASTOperations.add_core_moarop_mapping('pushcompsc', 'pushcompsc', 0);
 
1635
QAST::MASTOperations.add_core_moarop_mapping('popcompsc', 'popcompsc');
 
1636
 
 
1637
# bitwise opcodes
 
1638
QAST::MASTOperations.add_core_moarop_mapping('bitor_i', 'bor_i');
 
1639
QAST::MASTOperations.add_core_moarop_mapping('bitxor_i', 'bxor_i');
 
1640
QAST::MASTOperations.add_core_moarop_mapping('bitand_i', 'band_i');
 
1641
QAST::MASTOperations.add_core_moarop_mapping('bitshiftl_i', 'blshift_i');
 
1642
QAST::MASTOperations.add_core_moarop_mapping('bitshiftr_i', 'brshift_i');
 
1643
QAST::MASTOperations.add_core_moarop_mapping('bitneg_i', 'bnot_i');
 
1644
 
 
1645
QAST::MASTOperations.add_core_moarop_mapping('bitor_I', 'bor_I');
 
1646
QAST::MASTOperations.add_core_moarop_mapping('bitxor_I', 'bxor_I');
 
1647
QAST::MASTOperations.add_core_moarop_mapping('bitand_I', 'band_I');
 
1648
QAST::MASTOperations.add_core_moarop_mapping('bitneg_I', 'bnot_I');
 
1649
QAST::MASTOperations.add_core_moarop_mapping('bitshiftl_I', 'blshift_I');
 
1650
QAST::MASTOperations.add_core_moarop_mapping('bitshiftr_I', 'brshift_I');
 
1651
 
 
1652
# relational opcodes
 
1653
QAST::MASTOperations.add_core_moarop_mapping('cmp_i', 'cmp_i');
 
1654
QAST::MASTOperations.add_core_moarop_mapping('iseq_i', 'eq_i');
 
1655
QAST::MASTOperations.add_core_moarop_mapping('isne_i', 'ne_i');
 
1656
QAST::MASTOperations.add_core_moarop_mapping('islt_i', 'lt_i');
 
1657
QAST::MASTOperations.add_core_moarop_mapping('isle_i', 'le_i');
 
1658
QAST::MASTOperations.add_core_moarop_mapping('isgt_i', 'gt_i');
 
1659
QAST::MASTOperations.add_core_moarop_mapping('isge_i', 'ge_i');
 
1660
 
 
1661
QAST::MASTOperations.add_core_moarop_mapping('cmp_n', 'cmp_n');
 
1662
QAST::MASTOperations.add_core_moarop_mapping('not_i', 'not_i');
 
1663
QAST::MASTOperations.add_core_moarop_mapping('iseq_n', 'eq_n');
 
1664
QAST::MASTOperations.add_core_moarop_mapping('isne_n', 'ne_n');
 
1665
QAST::MASTOperations.add_core_moarop_mapping('islt_n', 'lt_n');
 
1666
QAST::MASTOperations.add_core_moarop_mapping('isle_n', 'le_n');
 
1667
QAST::MASTOperations.add_core_moarop_mapping('isgt_n', 'gt_n');
 
1668
QAST::MASTOperations.add_core_moarop_mapping('isge_n', 'ge_n');
 
1669
 
 
1670
QAST::MASTOperations.add_core_moarop_mapping('cmp_s', 'cmp_s');
 
1671
QAST::MASTOperations.add_core_moarop_mapping('iseq_s', 'eq_s');
 
1672
QAST::MASTOperations.add_core_moarop_mapping('isne_s', 'ne_s');
 
1673
QAST::MASTOperations.add_core_moarop_mapping('islt_s', 'lt_s');
 
1674
QAST::MASTOperations.add_core_moarop_mapping('isle_s', 'le_s');
 
1675
QAST::MASTOperations.add_core_moarop_mapping('isgt_s', 'gt_s');
 
1676
QAST::MASTOperations.add_core_moarop_mapping('isge_s', 'ge_s');
 
1677
 
 
1678
QAST::MASTOperations.add_core_moarop_mapping('bool_I', 'bool_I');
 
1679
QAST::MASTOperations.add_core_moarop_mapping('cmp_I', 'cmp_I');
 
1680
QAST::MASTOperations.add_core_moarop_mapping('iseq_I', 'eq_I');
 
1681
QAST::MASTOperations.add_core_moarop_mapping('isne_I', 'ne_I');
 
1682
QAST::MASTOperations.add_core_moarop_mapping('islt_I', 'lt_I');
 
1683
QAST::MASTOperations.add_core_moarop_mapping('isle_I', 'le_I');
 
1684
QAST::MASTOperations.add_core_moarop_mapping('isgt_I', 'gt_I');
 
1685
QAST::MASTOperations.add_core_moarop_mapping('isge_I', 'ge_I');
 
1686
 
 
1687
# aggregate opcodes
 
1688
QAST::MASTOperations.add_core_moarop_mapping('atpos', 'atpos_o');
 
1689
QAST::MASTOperations.add_core_moarop_mapping('atpos_i', 'atpos_i');
 
1690
QAST::MASTOperations.add_core_moarop_mapping('atpos_n', 'atpos_n');
 
1691
QAST::MASTOperations.add_core_moarop_mapping('atpos_s', 'atpos_s');
 
1692
QAST::MASTOperations.add_core_moarop_mapping('atkey', 'atkey_o');
 
1693
QAST::MASTOperations.add_core_moarop_mapping('atkey_i', 'atkey_i');
 
1694
QAST::MASTOperations.add_core_moarop_mapping('atkey_n', 'atkey_n');
 
1695
QAST::MASTOperations.add_core_moarop_mapping('atkey_s', 'atkey_s');
 
1696
QAST::MASTOperations.add_core_moarop_mapping('bindpos', 'bindpos_o', 2);
 
1697
QAST::MASTOperations.add_core_moarop_mapping('bindpos_i', 'bindpos_i', 2);
 
1698
QAST::MASTOperations.add_core_moarop_mapping('bindpos_n', 'bindpos_n', 2);
 
1699
QAST::MASTOperations.add_core_moarop_mapping('bindpos_s', 'bindpos_s', 2);
 
1700
QAST::MASTOperations.add_core_moarop_mapping('bindkey', 'bindkey_o', 2);
 
1701
QAST::MASTOperations.add_core_moarop_mapping('bindkey_i', 'bindkey_i', 2);
 
1702
QAST::MASTOperations.add_core_moarop_mapping('bindkey_n', 'bindkey_n', 2);
 
1703
QAST::MASTOperations.add_core_moarop_mapping('bindkey_s', 'bindkey_s', 2);
 
1704
QAST::MASTOperations.add_core_moarop_mapping('existskey', 'existskey');
 
1705
QAST::MASTOperations.add_core_moarop_mapping('deletekey', 'deletekey');
 
1706
QAST::MASTOperations.add_core_moarop_mapping('elems', 'elems');
 
1707
QAST::MASTOperations.add_core_moarop_mapping('setelems', 'setelemspos', 0);
 
1708
QAST::MASTOperations.add_core_moarop_mapping('existspos', 'existspos');
 
1709
QAST::MASTOperations.add_core_moarop_mapping('push', 'push_o', 1);
 
1710
QAST::MASTOperations.add_core_moarop_mapping('push_i', 'push_i', 1);
 
1711
QAST::MASTOperations.add_core_moarop_mapping('push_n', 'push_n', 1);
 
1712
QAST::MASTOperations.add_core_moarop_mapping('push_s', 'push_s', 1);
 
1713
QAST::MASTOperations.add_core_moarop_mapping('pop', 'pop_o');
 
1714
QAST::MASTOperations.add_core_moarop_mapping('pop_i', 'pop_i');
 
1715
QAST::MASTOperations.add_core_moarop_mapping('pop_n', 'pop_n');
 
1716
QAST::MASTOperations.add_core_moarop_mapping('pop_s', 'pop_s');
 
1717
QAST::MASTOperations.add_core_moarop_mapping('unshift', 'unshift_o', 1);
 
1718
QAST::MASTOperations.add_core_moarop_mapping('unshift_i', 'unshift_i', 1);
 
1719
QAST::MASTOperations.add_core_moarop_mapping('unshift_n', 'unshift_n', 1);
 
1720
QAST::MASTOperations.add_core_moarop_mapping('unshift_s', 'unshift_s', 1);
 
1721
QAST::MASTOperations.add_core_moarop_mapping('shift', 'shift_o');
 
1722
QAST::MASTOperations.add_core_moarop_mapping('shift_i', 'shift_i');
 
1723
QAST::MASTOperations.add_core_moarop_mapping('shift_n', 'shift_n');
 
1724
QAST::MASTOperations.add_core_moarop_mapping('shift_s', 'shift_s');
 
1725
QAST::MASTOperations.add_core_moarop_mapping('splice', 'splice');
 
1726
QAST::MASTOperations.add_core_moarop_mapping('isint', 'isint');
 
1727
QAST::MASTOperations.add_core_moarop_mapping('isnum', 'isnum');
 
1728
QAST::MASTOperations.add_core_moarop_mapping('isstr', 'isstr');
 
1729
QAST::MASTOperations.add_core_moarop_mapping('islist', 'islist');
 
1730
QAST::MASTOperations.add_core_moarop_mapping('ishash', 'ishash');
 
1731
QAST::MASTOperations.add_core_moarop_mapping('iterator', 'iter');
 
1732
QAST::MASTOperations.add_core_moarop_mapping('iterkey_s', 'iterkey_s');
 
1733
QAST::MASTOperations.add_core_moarop_mapping('iterval', 'iterval');
 
1734
 
 
1735
# object opcodes
 
1736
QAST::MASTOperations.add_core_moarop_mapping('null', 'null');
 
1737
QAST::MASTOperations.add_core_moarop_mapping('null_s', 'null_s');
 
1738
QAST::MASTOperations.add_core_moarop_mapping('what', 'getwhat');
 
1739
QAST::MASTOperations.add_core_moarop_mapping('how', 'gethow');
 
1740
QAST::MASTOperations.add_core_moarop_mapping('who', 'getwho');
 
1741
QAST::MASTOperations.add_core_moarop_mapping('where', 'getwhere');
 
1742
QAST::MASTOperations.add_core_moarop_mapping('findmethod', 'findmeth_s');
 
1743
QAST::MASTOperations.add_core_moarop_mapping('setwho', 'setwho');
 
1744
QAST::MASTOperations.add_core_moarop_mapping('rebless', 'rebless');
 
1745
QAST::MASTOperations.add_core_moarop_mapping('knowhow', 'knowhow');
 
1746
QAST::MASTOperations.add_core_moarop_mapping('knowhowattr', 'knowhowattr');
 
1747
QAST::MASTOperations.add_core_moarop_mapping('bootint', 'bootint');
 
1748
QAST::MASTOperations.add_core_moarop_mapping('bootnum', 'bootnum');
 
1749
QAST::MASTOperations.add_core_moarop_mapping('bootstr', 'bootstr');
 
1750
QAST::MASTOperations.add_core_moarop_mapping('bootarray', 'bootarray');
 
1751
QAST::MASTOperations.add_core_moarop_mapping('bootintarray', 'bootintarray');
 
1752
QAST::MASTOperations.add_core_moarop_mapping('bootnumarray', 'bootnumarray');
 
1753
QAST::MASTOperations.add_core_moarop_mapping('bootstrarray', 'bootstrarray');
 
1754
QAST::MASTOperations.add_core_moarop_mapping('boothash', 'boothash');
 
1755
QAST::MASTOperations.add_core_moarop_mapping('hlllist', 'hlllist');
 
1756
QAST::MASTOperations.add_core_moarop_mapping('hllhash', 'hllhash');
 
1757
QAST::MASTOperations.add_core_moarop_mapping('create', 'create');
 
1758
QAST::MASTOperations.add_core_moarop_mapping('clone', 'clone');
 
1759
QAST::MASTOperations.add_core_moarop_mapping('isconcrete', 'isconcrete');
 
1760
QAST::MASTOperations.add_core_moarop_mapping('iscont', 'iscont');
 
1761
QAST::MASTOperations.add_core_moarop_mapping('decont', 'decont');
 
1762
QAST::MASTOperations.add_core_moarop_mapping('isnull', 'isnull');
 
1763
QAST::MASTOperations.add_core_moarop_mapping('isnull_s', 'isnull_s');
 
1764
QAST::MASTOperations.add_core_moarop_mapping('istrue', 'istrue');
 
1765
QAST::MASTOperations.add_core_moarop_mapping('isfalse', 'isfalse');
 
1766
QAST::MASTOperations.add_core_moarop_mapping('istype', 'istype');
 
1767
QAST::MASTOperations.add_core_moarop_mapping('eqaddr', 'eqaddr');
 
1768
QAST::MASTOperations.add_core_moarop_mapping('getattr', 'getattrs_o');
 
1769
QAST::MASTOperations.add_core_moarop_mapping('getattr_i', 'getattrs_i');
 
1770
QAST::MASTOperations.add_core_moarop_mapping('getattr_n', 'getattrs_n');
 
1771
QAST::MASTOperations.add_core_moarop_mapping('getattr_s', 'getattrs_s');
 
1772
QAST::MASTOperations.add_core_moarop_mapping('attrinited', 'attrinited');
 
1773
QAST::MASTOperations.add_core_moarop_mapping('bindattr', 'bindattrs_o', 3);
 
1774
QAST::MASTOperations.add_core_moarop_mapping('bindattr_i', 'bindattrs_i', 3);
 
1775
QAST::MASTOperations.add_core_moarop_mapping('bindattr_n', 'bindattrs_n', 3);
 
1776
QAST::MASTOperations.add_core_moarop_mapping('bindattr_s', 'bindattrs_s', 3);
 
1777
QAST::MASTOperations.add_core_moarop_mapping('unbox_i', 'unbox_i');
 
1778
QAST::MASTOperations.add_core_moarop_mapping('unbox_n', 'unbox_n');
 
1779
QAST::MASTOperations.add_core_moarop_mapping('unbox_s', 'unbox_s');
 
1780
QAST::MASTOperations.add_core_moarop_mapping('box_i', 'box_i');
 
1781
QAST::MASTOperations.add_core_moarop_mapping('box_n', 'box_n');
 
1782
QAST::MASTOperations.add_core_moarop_mapping('box_s', 'box_s');
 
1783
QAST::MASTOperations.add_core_moarop_mapping('can', 'can_s');
 
1784
QAST::MASTOperations.add_core_moarop_mapping('reprname', 'reprname');
 
1785
QAST::MASTOperations.add_core_moarop_mapping('newtype', 'newtype');
 
1786
QAST::MASTOperations.add_core_moarop_mapping('composetype', 'composetype');
 
1787
QAST::MASTOperations.add_core_moarop_mapping('setboolspec', 'setboolspec', 0);
 
1788
QAST::MASTOperations.add_core_moarop_mapping('setmethcache', 'setmethcache', 0);
 
1789
QAST::MASTOperations.add_core_moarop_mapping('setmethcacheauth', 'setmethcacheauth', 0);
 
1790
QAST::MASTOperations.add_core_moarop_mapping('settypecache', 'settypecache', 0);
 
1791
QAST::MASTOperations.add_core_moarop_mapping('isinvokable', 'isinvokable');
 
1792
QAST::MASTOperations.add_core_moarop_mapping('setinvokespec', 'setinvokespec', 0);
 
1793
QAST::MASTOperations.add_core_moarop_mapping('setcontspec', 'setcontspec', 0);
 
1794
QAST::MASTOperations.add_core_moarop_mapping('assign', 'assign', 0);
 
1795
QAST::MASTOperations.add_core_moarop_mapping('assignunchecked', 'assignunchecked', 0);
 
1796
 
 
1797
# defined - overridden by HLL, but by default same as .DEFINITE.
 
1798
QAST::MASTOperations.add_core_moarop_mapping('defined', 'isconcrete');
 
1799
 
 
1800
# lexical related opcodes
 
1801
QAST::MASTOperations.add_core_moarop_mapping('getlex', 'getlex_no');
 
1802
QAST::MASTOperations.add_core_moarop_mapping('getlex_i', 'getlex_ni');
 
1803
QAST::MASTOperations.add_core_moarop_mapping('getlex_n', 'getlex_nn');
 
1804
QAST::MASTOperations.add_core_moarop_mapping('getlex_s', 'getlex_ns');
 
1805
QAST::MASTOperations.add_core_moarop_mapping('bindlex', 'bindlex_no', 1);
 
1806
QAST::MASTOperations.add_core_moarop_mapping('bindlex_i', 'bindlex_ni', 1);
 
1807
QAST::MASTOperations.add_core_moarop_mapping('bindlex_n', 'bindlex_nn', 1);
 
1808
QAST::MASTOperations.add_core_moarop_mapping('bindlex_s', 'bindlex_ns', 1);
 
1809
QAST::MASTOperations.add_core_moarop_mapping('getlexdyn', 'getdynlex');
 
1810
QAST::MASTOperations.add_core_moarop_mapping('bindlexdyn', 'binddynlex');
 
1811
QAST::MASTOperations.add_core_op('locallifetime', -> $qastcomp, $op {
 
1812
    # TODO: take advantage of this info for code-gen, if possible.
 
1813
    $qastcomp.as_mast($op[0])
 
1814
});
 
1815
 
 
1816
# code object related opcodes
 
1817
# XXX explicit takeclosure will go away under new model; for now, no-op it.
 
1818
QAST::MASTOperations.add_core_op('takeclosure', -> $qastcomp, $op {
 
1819
    unless +@($op) == 1 {
 
1820
        nqp::die('takeclosure op requires one argument');
 
1821
    }
 
1822
    $qastcomp.as_mast($op[0])
 
1823
});
 
1824
QAST::MASTOperations.add_core_moarop_mapping('getcodeobj', 'getcodeobj');
 
1825
QAST::MASTOperations.add_core_moarop_mapping('setcodeobj', 'setcodeobj', 0);
 
1826
QAST::MASTOperations.add_core_moarop_mapping('getcodename', 'getcodename');
 
1827
QAST::MASTOperations.add_core_moarop_mapping('setcodename', 'setcodename', 0);
 
1828
QAST::MASTOperations.add_core_moarop_mapping('forceouterctx', 'forceouterctx', 0);
 
1829
QAST::MASTOperations.add_core_op('setup_blv', -> $qastcomp, $op {
 
1830
    if +@($op) != 1 || !nqp::ishash($op[0]) {
 
1831
        nqp::die('setup_blv requires one hash operand');
 
1832
    }
 
1833
 
 
1834
    my @ops;
 
1835
    for $op[0] {
 
1836
        my $frame     := %*MAST_FRAMES{$_.key};
 
1837
        my $block_reg := $*REGALLOC.fresh_register($MVM_reg_obj);
 
1838
        push_op(@ops, 'getcode', $block_reg, $frame);
 
1839
        for $_.value -> @lex {
 
1840
            my $valres := $qastcomp.as_mast(QAST::WVal.new( :value(@lex[1]) ));
 
1841
            push_ilist(@ops, $valres);
 
1842
            push_op(@ops, 'setlexvalue', $block_reg, MAST::SVal.new( :value(@lex[0]) ),
 
1843
                $valres.result_reg, MAST::IVal.new( :value(@lex[2]) ));
 
1844
            $*REGALLOC.release_register($valres.result_reg, $MVM_reg_obj);
 
1845
        }
 
1846
        $*REGALLOC.release_register($block_reg, $MVM_reg_obj);
 
1847
    }
 
1848
 
 
1849
    MAST::InstructionList.new(@ops, $*REGALLOC.fresh_o(), $MVM_reg_obj)
 
1850
});
 
1851
QAST::MASTOperations.add_core_moarop_mapping('freshcoderef', 'freshcoderef');
 
1852
QAST::MASTOperations.add_core_moarop_mapping('iscoderef', 'iscoderef');
 
1853
QAST::MASTOperations.add_core_moarop_mapping('markcodestatic', 'markcodestatic');
 
1854
QAST::MASTOperations.add_core_moarop_mapping('markcodestub', 'markcodestub');
 
1855
QAST::MASTOperations.add_core_moarop_mapping('getstaticcode', 'getstaticcode');
 
1856
QAST::MASTOperations.add_core_moarop_mapping('getcodecuid', 'getcodecuid');
 
1857
 
 
1858
# language/compiler ops
 
1859
QAST::MASTOperations.add_core_moarop_mapping('getcomp', 'getcomp');
 
1860
QAST::MASTOperations.add_core_moarop_mapping('bindcomp', 'bindcomp');
 
1861
QAST::MASTOperations.add_core_moarop_mapping('gethllsym', 'gethllsym');
 
1862
QAST::MASTOperations.add_core_moarop_mapping('bindhllsym', 'bindhllsym', 2);
 
1863
QAST::MASTOperations.add_core_moarop_mapping('getcurhllsym', 'getcurhllsym');
 
1864
QAST::MASTOperations.add_core_moarop_mapping('bindcurhllsym', 'bindcurhllsym');
 
1865
QAST::MASTOperations.add_core_moarop_mapping('sethllconfig', 'sethllconfig');
 
1866
QAST::MASTOperations.add_core_moarop_mapping('loadbytecode', 'loadbytecode');
 
1867
QAST::MASTOperations.add_core_moarop_mapping('settypehll', 'settypehll', 0);
 
1868
QAST::MASTOperations.add_core_moarop_mapping('settypehllrole', 'settypehllrole', 0);
 
1869
QAST::MASTOperations.add_core_moarop_mapping('usecompileehllconfig', 'usecompileehllconfig');
 
1870
QAST::MASTOperations.add_core_moarop_mapping('usecompilerhllconfig', 'usecompilerhllconfig');
 
1871
QAST::MASTOperations.add_core_moarop_mapping('hllize', 'hllize');
 
1872
QAST::MASTOperations.add_core_moarop_mapping('hllizefor', 'hllizefor');
 
1873
 
 
1874
# regex engine related opcodes
 
1875
QAST::MASTOperations.add_core_moarop_mapping('nfafromstatelist', 'nfafromstatelist');
 
1876
QAST::MASTOperations.add_core_moarop_mapping('nfarunproto', 'nfarunproto');
 
1877
QAST::MASTOperations.add_core_moarop_mapping('nfarunalt', 'nfarunalt', 0);
 
1878
 
 
1879
# process related opcodes
 
1880
QAST::MASTOperations.add_core_moarop_mapping('exit', 'exit', 0);
 
1881
QAST::MASTOperations.add_core_moarop_mapping('sleep', 'sleep', 0);
 
1882
QAST::MASTOperations.add_core_moarop_mapping('getenvhash', 'getenvhash');
 
1883
QAST::MASTOperations.add_core_moarop_mapping('shell', 'shell');
 
1884
QAST::MASTOperations.add_core_moarop_mapping('rand_i', 'rand_i');
 
1885
QAST::MASTOperations.add_core_moarop_mapping('rand_n', 'rand_n');
 
1886
QAST::MASTOperations.add_core_moarop_mapping('seed', 'seed');
 
1887
 
 
1888
# MoarVM-specific compilation ops
 
1889
QAST::MASTOperations.add_core_moarop_mapping('masttofile', 'masttofile', 2);
 
1890
QAST::MASTOperations.add_core_moarop_mapping('masttocu', 'masttocu');
 
1891
QAST::MASTOperations.add_core_moarop_mapping('iscompunit', 'iscompunit');
 
1892
QAST::MASTOperations.add_core_moarop_mapping('compunitmainline', 'compunitmainline');
 
1893
QAST::MASTOperations.add_core_moarop_mapping('compunitcodes', 'compunitcodes');
 
1894
 
 
1895
sub resolve_condition_op($kind, $negated) {
 
1896
    return $negated ??
 
1897
        $kind == $MVM_reg_int64 ?? 'unless_i' !!
 
1898
        $kind == $MVM_reg_num64 ?? 'unless_n' !!
 
1899
        $kind == $MVM_reg_str   ?? 'unless_s0' !!
 
1900
        $kind == $MVM_reg_obj   ?? 'unless_o' !!
 
1901
        nqp::die("unhandled kind $kind")
 
1902
     !! $kind == $MVM_reg_int64 ?? 'if_i' !!
 
1903
        $kind == $MVM_reg_num64 ?? 'if_n' !!
 
1904
        $kind == $MVM_reg_str   ?? 'if_s0' !!
 
1905
        $kind == $MVM_reg_obj   ?? 'if_o' !!
 
1906
        nqp::die("unhandled kind $kind")
 
1907
}
 
1908
 
 
1909
sub push_op(@dest, $op, *@args) {
 
1910
    #$op := $op.name if nqp::istype($op, QAST::Op);
 
1911
    nqp::push(@dest, MAST::Op.new(
 
1912
        :op($op),
 
1913
        |@args
 
1914
    ));
 
1915
}
 
1916
 
 
1917
sub push_ilist(@dest, $src) is export {
 
1918
    nqp::splice(@dest, $src.instructions, +@dest, 0);
 
1919
}