← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/vm/moar/NQP/Ops.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/NQP/Ops.nqp
 
1
my $ops := QAST::MASTCompiler.operations();
 
2
my $MVM_reg_int64           := 4;
 
3
my $MVM_reg_num64           := 6;
 
4
my $MVM_reg_str             := 7;
 
5
my $MVM_reg_obj             := 8;
 
6
 
 
7
$ops.add_hll_op('nqp', 'preinc', -> $qastcomp, $op {
 
8
    my $var := $op[0];
 
9
    unless nqp::istype($var, QAST::Var) {
 
10
        nqp::die("Pre-increment can only work on a variable");
 
11
    }
 
12
    $qastcomp.as_mast(QAST::Op.new(
 
13
        :op('bind'),
 
14
        $var,
 
15
        QAST::Op.new(
 
16
            :op('add_n'),
 
17
            $var,
 
18
            QAST::IVal.new( :value(1) )
 
19
        )));
 
20
});
 
21
 
 
22
$ops.add_hll_op('nqp', 'predec', -> $qastcomp, $op {
 
23
    my $var := $op[0];
 
24
    unless nqp::istype($var, QAST::Var) {
 
25
        nqp::die("Pre-decrement can only work on a variable");
 
26
    }
 
27
    $qastcomp.as_mast(QAST::Op.new(
 
28
        :op('bind'),
 
29
        $var,
 
30
        QAST::Op.new(
 
31
            :op('sub_n'),
 
32
            $var,
 
33
            QAST::IVal.new( :value(1) )
 
34
        )));
 
35
});
 
36
 
 
37
$ops.add_hll_op('nqp', 'postinc', -> $qastcomp, $op {
 
38
    my $var := $op[0];
 
39
    my $tmp := QAST::Op.unique('tmp');
 
40
    unless nqp::istype($var, QAST::Var) {
 
41
        nqp::die("Post-increment can only work on a variable");
 
42
    }
 
43
    $qastcomp.as_mast(QAST::Op.new(
 
44
        :op('locallifetime'),
 
45
        QAST::Stmt.new(
 
46
            :resultchild(0),
 
47
            QAST::Op.new(
 
48
                :op('bind'),
 
49
                QAST::Var.new( :name($tmp), :scope('local'), :decl('var'), :returns($var.returns) ),
 
50
                $var
 
51
            ),
 
52
            QAST::Op.new(
 
53
                :op('bind'),
 
54
                $var,
 
55
                QAST::Op.new(
 
56
                    :op('add_n'),
 
57
                    QAST::Var.new( :name($tmp), :scope('local'), :returns($var.returns)  ),
 
58
                    QAST::IVal.new( :value(1) )
 
59
                )
 
60
            )),
 
61
        $tmp));
 
62
});
 
63
 
 
64
$ops.add_hll_op('nqp', 'postdec', -> $qastcomp, $op {
 
65
    my $var := $op[0];
 
66
    my $tmp := QAST::Op.unique('tmp');
 
67
    unless nqp::istype($var, QAST::Var) {
 
68
        nqp::die("Post-decrement can only work on a variable");
 
69
    }
 
70
    $qastcomp.as_mast(QAST::Op.new(
 
71
        :op('locallifetime'),
 
72
        QAST::Stmt.new(
 
73
            :resultchild(0),
 
74
            QAST::Op.new(
 
75
                :op('bind'),
 
76
                QAST::Var.new( :name($tmp), :scope('local'), :decl('var') ),
 
77
                $var
 
78
            ),
 
79
            QAST::Op.new(
 
80
                :op('bind'),
 
81
                $var,
 
82
                QAST::Op.new(
 
83
                    :op('sub_n'),
 
84
                    QAST::Var.new( :name($tmp), :scope('local') ),
 
85
                    QAST::IVal.new( :value(1) )
 
86
                )
 
87
            )),
 
88
        $tmp));
 
89
});
 
90
 
 
91
$ops.add_hll_op('nqp', 'numify', -> $qastcomp, $op {
 
92
    $qastcomp.as_mast($op[0], :want($MVM_reg_num64))
 
93
});
 
94
 
 
95
$ops.add_hll_op('nqp', 'stringify', -> $qastcomp, $op {
 
96
    $qastcomp.as_mast($op[0], :want($MVM_reg_str))
 
97
});
 
98
 
 
99
$ops.add_hll_op('nqp', 'falsey', -> $qastcomp, $op {
 
100
    unless $op.list == 1 {
 
101
        nqp::die('falsey op requires one child');
 
102
    }
 
103
    my $val := $qastcomp.as_mast($op[0]);
 
104
    if $val.result_kind == $MVM_reg_int64 {
 
105
        my $not_reg := $*REGALLOC.fresh_register($MVM_reg_int64);
 
106
        my @ins := $val.instructions;
 
107
        push_op(@ins, 'not_i', $not_reg, $val.result_reg);
 
108
        MAST::InstructionList.new(@ins, $not_reg, $MVM_reg_int64)
 
109
    }
 
110
    elsif $val.result_kind == $MVM_reg_obj {
 
111
        my $not_reg := $*REGALLOC.fresh_register($MVM_reg_int64);
 
112
        my @ins := $val.instructions;
 
113
        push_op(@ins, 'isfalse', $not_reg, $val.result_reg);
 
114
        MAST::InstructionList.new(@ins, $not_reg, $MVM_reg_int64)
 
115
    }
 
116
    elsif $val.result_kind == $MVM_reg_str {
 
117
        my $not_reg := $*REGALLOC.fresh_register($MVM_reg_int64);
 
118
        my @ins := $val.instructions;
 
119
        push_op(@ins, 'isfalse_s', $not_reg, $val.result_reg);
 
120
        MAST::InstructionList.new(@ins, $not_reg, $MVM_reg_int64)
 
121
    }
 
122
    else {
 
123
        nqp::die("This case of nqp falsey op NYI");
 
124
    }
 
125
});
 
126
 
 
127
# NQP object unbox, which also must somewhat handle coercion.
 
128
 
 
129
# XXX TODO
 
130
 
 
131
sub push_op(@dest, $op, *@args) {
 
132
    #$op := $op.name if nqp::istype($op, QAST::Op);
 
133
    nqp::push(@dest, MAST::Op.new(
 
134
        :op($op),
 
135
        |@args
 
136
    ));
 
137
}