[svn:parrot] r44722 - in branches/ops_pct/compilers/opsc: . src/Ops src/Ops/Compiler t
cotto at svn.parrot.org
cotto at svn.parrot.org
Sun Mar 7 02:57:03 UTC 2010
Author: cotto
Date: Sun Mar 7 02:56:59 2010
New Revision: 44722
URL: https://trac.parrot.org/parrot/changeset/44722
Log:
[opsc] implement {{...}} to C transformation in rewrite_body, fix a subtle mistranslation in the actions
Modified:
branches/ops_pct/compilers/opsc/TODO
branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
branches/ops_pct/compilers/opsc/src/Ops/Op.pm
branches/ops_pct/compilers/opsc/t/06-emitter.t
Modified: branches/ops_pct/compilers/opsc/TODO
==============================================================================
--- branches/ops_pct/compilers/opsc/TODO Sun Mar 7 00:38:25 2010 (r44721)
+++ branches/ops_pct/compilers/opsc/TODO Sun Mar 7 02:56:59 2010 (r44722)
@@ -2,7 +2,6 @@
Required for initial self-hosting:
- * Implement Op.rewrite_body
* Implement handling of flags in Compiler:Actions
* Implement handling of labels in Trans::C
* Replacement for ops2c.pl
Modified: branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm Sun Mar 7 00:38:25 2010 (r44721)
+++ branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm Sun Mar 7 02:56:59 2010 (r44722)
@@ -121,7 +121,7 @@
if $arg<type> eq 'INTKEY' {
$res<type> := 'ki';
}
- else {
+ elsif $arg<type> ne 'LABEL' {
$res<type> := lc(substr($arg<type>, 0, 1));
}
Modified: branches/ops_pct/compilers/opsc/src/Ops/Op.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Op.pm Sun Mar 7 00:38:25 2010 (r44721)
+++ branches/ops_pct/compilers/opsc/src/Ops/Op.pm Sun Mar 7 02:56:59 2010 (r44722)
@@ -228,27 +228,77 @@
#my $rewrote_access = s/{{\@([^{]*?)}}/ $trans->access_arg($self->arg_type($1 - 1), $1, $self); /me;
$str := subst($str,
- /'{{' '@' $<op_num>=[<digit>+] '}}'/,
+ /'{{@' $<op_num>=[<digit>+] '}}'/,
-> $m { $trans.access_arg( self.arg_type(+$m<op_num> - 1), +$m<op_num>) }
);
-=begin COMMENT
+ #XXX: the following substitutions need to be rewritten to exclude nested expressions
+ # e.g. {{={{=0}},=foo}}
+
+ #s/{{=0,=([^{]*?)}}/ $trans->restart_address($1) . "; {{=0}}"; /me;
+ $str := subst($str,
+ /'{{=0,=' $<addr>=[.*?] '}}'/,
+ -> $m { $trans.restart_address($m<addr>) ~ '; {{=0}}' }
+ );
+
+ #s/{{=0,\+=([^{]*?)}}/ $trans->restart_offset($1) . "; {{=0}}"; /me;
+ $str := subst($str,
+ /'{{=0,+=' $<offset>=[.*?] '}}'/,
+ -> $m { $trans.restart_offset($m<offset>) ~ '; {{=0}}' }
+ );
+
+ #s/{{=0,-=([^{]*?)}}/ $trans->restart_offset(-$1) . "; {{=0}}"; /me;
+ $str := subst($str,
+ /'{{=0,-=' $<offset>=[.*?] '}}'/,
+ -> $m { $trans.restart_offset( '-' ~ $m<offset>) ~ '; {{=0}}' }
+ );
+
+ #s/{{=([^*][^{]*?)}}/ $trans->goto_address($1); /me;
+ $str := subst($str,
+ /'{{=' $<addr>=[.*?] '}}'/,
+ -> $m { $trans.goto_address($m<addr>) }
+ );
+
+ #s/{{\+=([^{]*?)}}/ $trans->goto_offset($1); /me;
+ $str := subst($str,
+ /'{{+=' $<offset>=[.*?] '}}'/,
+ -> $m { $trans.goto_offset($m<offset>) }
+ );
- #die "Argument access not allowed in preamble\n"
- if $preamble_only && $rewrote_access;
+ #s/{{-=([^{]*?)}}/ $trans->goto_offset(-$1); /me;
+ $str := subst($str,
+ /'{{-=' $<offset>=[.*?] '}}'/,
+ -> $m { $trans.goto_offset( '-' ~ $m<offset>) }
+ );
+
+ #s/{{\^(-?\d+)}}/ $1 /me;
+ $str := subst($str,
+ /'{{^' $<addr>=[ '-'? <digit>+] '}}'/,
+ -> $m { $m<addr> }
+ );
+
+ #s/{{\^\+([^{]*?)}}/ $trans->expr_offset($1); /me;
+ $str := subst($str,
+ /'{{^+' $<offset>=[.*?] '}}'/,
+ -> $m { $trans.expr_offset($m<offset>) }
+ );
+
+ #s/{{\^-([^{]*?)}}/ $trans->expr_offset(-$1); /me;
+ $str := subst($str,
+ /'{{^-' $<offset>=[.*?] '}}'/,
+ -> $m { $trans.expr_offset( '-' ~ $m<offset>) }
+ );
+
+ #s/{{\^([^{]*?)}}/ $trans->expr_address($1); /me;
+ $str := subst($str,
+ /'{{^' $<addr>=[.*?] '}}'/,
+ -> $m { $trans.expr_address($m<addr>) }
+ );
+
+=begin COMMENT
- s/{{=0,=([^{]*?)}}/ $trans->restart_address($1) . "; {{=0}}"; /me;
- s/{{=0,\+=([^{]*?)}}/ $trans->restart_offset($1) . "; {{=0}}"; /me;
- s/{{=0,-=([^{]*?)}}/ $trans->restart_offset(-$1) . "; {{=0}}"; /me;
-
- s/{{\+=([^{]*?)}}/ $trans->goto_offset($1); /me;
- s/{{-=([^{]*?)}}/ $trans->goto_offset(-$1); /me;
- s/{{=([^*][^{]*?)}}/ $trans->goto_address($1); /me;
-
- s/{{\^(-?\d+)}}/ $1 /me;
- s/{{\^\+([^{]*?)}}/ $trans->expr_offset($1); /me;
- s/{{\^-([^{]*?)}}/ $trans->expr_offset(-$1); /me;
- s/{{\^([^{]*?)}}/ $trans->expr_address($1); /me;
+ #XXX: die "Argument access not allowed in preamble\n"
+ #XXX: if $preamble_only && $rewrote_access;
=end COMMENT
Modified: branches/ops_pct/compilers/opsc/t/06-emitter.t
==============================================================================
--- branches/ops_pct/compilers/opsc/t/06-emitter.t Sun Mar 7 00:38:25 2010 (r44721)
+++ branches/ops_pct/compilers/opsc/t/06-emitter.t Sun Mar 7 02:56:59 2010 (r44722)
@@ -3,7 +3,7 @@
pir::load_bytecode("compilers/opsc/opsc.pbc");
pir::load_bytecode("nqp-settings.pbc");
-plan(15);
+plan(17);
my $trans := Ops::Trans::C.new();
@@ -62,6 +62,40 @@
ok($source ~~ /'PREG(1)'/, 'Trans::C arg translation works');
ok($source ~! /'OP_SIZE'/, 'Trans::C translates OP_SIZE');
-say($source);
+
+my $op_body := '
+inline op do_stuff(invar PMC)
+{
+ restart ADDRESS(234);
+}';
+my $new_body := translate_op_body($trans, $op_body);
+my $restart_addr_ok := $new_body ~~ /'return' \s '(' 'opcode_t' \s '*' ')' \s '234'/;
+ok($restart_addr_ok, "restart ADDRESS() translated ok");
+
+$op_body := '
+inline op branch(in LABEL) :base_loop :flow {
+ goto OFFSET($1);
+}';
+$new_body := translate_op_body($trans, $op_body);
+$restart_addr_ok := $new_body ~~ /'return (opcode_t *) cur_opcode + IREG(1);'/;
+ok($restart_addr_ok, "goto OFFSET() and \$1 translated ok");
+
+#say($source);
+
+sub translate_op_body($trans, $body) {
+ my $file := Ops::File.new_str($body);
+ my $emitter := Ops::Emitter.new(
+ :ops_file($file),
+ :trans($trans),
+ :script("opsc"),
+ :flags( hash(core => '1') )
+ );
+
+ my $sh := pir::new__Ps('StringHandle');
+ $sh.open('your_bank_account_information.txt', 'w');
+ $emitter.emit_c_source_file($sh);
+ $sh.close();
+ $sh.readall();
+}
# vim: expandtab shiftwidth=4 ft=perl6:
More information about the parrot-commits
mailing list