Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Get a very first cut (with lots of comments about what's left) of nqp…

… operations that map to PIR opcodes in place.
  • Loading branch information...
commit e2aea7ef3461081e13dfa32bbe1b2cb9537e4da5 1 parent 2e28049
@jnthn jnthn authored
Showing with 51 additions and 4 deletions.
  1. +51 −4 src/QAST/Operations.nqp
View
55 src/QAST/Operations.nqp
@@ -21,16 +21,63 @@ class QAST::Operations {
}
# Adds a core op that maps to a PIR op.
- method add_core_pir_mapping($op, $pirop, $sig) {
+ method add_core_pirop_mapping($op, $pirop, $sig) {
%core_ops{$op} := pirop_mapper($pirop, $sig);
}
# Adds a HLL op that maps to a PIR op.
- method add_hll_pir_mapping($hll, $op, $pirop, $sig) {
+ method add_hll_pirop_mapping($hll, $op, $pirop, $sig) {
%hll_ops{$hll} := {} unless %hll_ops{$hll};
%hll_ops{$hll}{$op} := pirop_mapper($pirop, $sig);
}
+
+ # Returns a mapper closure for turning an operation into a PIR op.
+ sub pirop_mapper($pirop, $sig) {
+ # Parse arg types out.
+ my @arg_types := nqp::split('', $sig);
+ my $ret_type := @arg_types.shift();
+
+ # Work out register method for return type, if any.
+ my $ret_meth;
+ if $ret_type eq 'P' { $ret_meth := "fresh_p"; }
+ elsif $ret_type eq 'S' { $ret_meth := "fresh_s"; }
+ elsif $ret_type eq 'I' { $ret_meth := "fresh_i"; }
+ elsif $ret_type eq 'N' { $ret_meth := "fresh_n"; }
+
+ -> $qastcomp, $op {
+ my $ops := $qastcomp.post_new('Ops');
+
+ # If we need a result register, create it and make it the
+ # first argument.
+ my @args;
+ if $ret_meth {
+ my $reg := $*REGALLOC."$ret_meth"();
+ @args.push($reg);
+ $ops.result($reg);
+ }
+
+ # Build the arguments list.
+ # XXX keyed
+ # XXX coercions/boxings/unboxings
+ # XXX count check
+ for $op.list {
+ my $post := $qastcomp.as_post($_);
+ $ops.push($post);
+ @args.push($post.result);
+ }
+
+ # If we have an integer as the return type, find the arg that
+ # becomes the result.
+ if !$ret_meth && $ret_type ne 'v' && +$ret_type eq $ret_type {
+ $ops.result(@args[+$ret_type]);
+ }
+
+ # Construct and return the op.
+ $ops.push_pirop($pirop, |@args);
+ $ops
+ }
+ }
}
-INIT {
-}
+# Straight mappings to Parrot opcodes.
+QAST::Operations.add_core_pirop_mapping('add_i', 'add', 'Iii');
Please sign in to comment.
Something went wrong with that request. Please try again.