[svn:parrot] r44719 - in branches/ops_pct/compilers/opsc: src/Ops src/Ops/Compiler src/Ops/Trans t

cotto at svn.parrot.org cotto at svn.parrot.org
Sun Mar 7 00:15:21 UTC 2010


Author: cotto
Date: Sun Mar  7 00:15:10 2010
New Revision: 44719
URL: https://trac.parrot.org/parrot/changeset/44719

Log:
[opsc] transform op args and OP_SIZE in Ops::Trans::C

Modified:
   branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
   branches/ops_pct/compilers/opsc/src/Ops/Op.pm
   branches/ops_pct/compilers/opsc/src/Ops/Trans.pm
   branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm
   branches/ops_pct/compilers/opsc/t/06-emitter.t

Modified: branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm	Sat Mar  6 23:51:15 2010	(r44718)
+++ branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm	Sun Mar  7 00:15:10 2010	(r44719)
@@ -254,7 +254,7 @@
     #
 
     if ($body ~~ / [ goto | restart ] \s+ OFFSET / ) {
-        $op<flags> := 'PARROT_JUMP_RELATIVE';
+        $op<jump> := ~ 'PARROT_JUMP_RELATIVE';
     }
 
     #'goto ADDRESS((foo))' -> '{{=foo}}'

Modified: branches/ops_pct/compilers/opsc/src/Ops/Op.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Op.pm	Sat Mar  6 23:51:15 2010	(r44718)
+++ branches/ops_pct/compilers/opsc/src/Ops/Op.pm	Sun Mar  7 00:15:10 2010	(r44719)
@@ -127,9 +127,13 @@
 
 method args($args?) { self.attr('args', $args, defined($args)) }
 
-method arg_types($args?) { self.attr('arg_types', $args, defined($args)) }
-method arg_dirs($args?) { self.attr('arg_dirs', $args, defined($args)) }
+method arg_types($args?)  { self.attr('arg_types', $args, defined($args)) }
+method arg_dirs($args?)   { self.attr('arg_dirs', $args, defined($args)) }
 
+method arg_type($arg_num) {
+    my @arg_types := self.arg_types;
+    @arg_types[$arg_num];
+}
 
 method full_name() {
     my $name      := self.name;
@@ -215,17 +219,22 @@
 
 # Called from rewrite_body() to perform the actual substitutions.
 method _substitute($str, $trans) {
-    $str;
-=begin 
+
 
     #also needed:
-    s/OP_SIZE/ self.size /g;
-    check that {{@1}}, {{@2}}, ... are defined
+    #s/OP_SIZE/ self.size /g;
+    $str := subst($str, /'OP_SIZE'/, self.size);
+
+    #my $rewrote_access = s/{{\@([^{]*?)}}/   $trans->access_arg($self->arg_type($1 - 1), $1, $self); /me;
 
-    my $rewrote_access =
-        s/{{\@([^{]*?)}}/   $trans->access_arg($self->arg_type($1 - 1), $1, $self); /me;
+    $str := subst($str, 
+        /'{{' '@' $<op_num>=[<digit>+] '}}'/, 
+        -> $m { $trans.access_arg( self.arg_type(+$m<op_num> - 1), +$m<op_num>) }
+    );
 
-    die "Argument access not allowed in preamble\n"
+=begin COMMENT    
+
+        #die "Argument access not allowed in preamble\n"
         if $preamble_only && $rewrote_access;
 
     s/{{=0,=([^{]*?)}}/   $trans->restart_address($1) . "; {{=0}}"; /me;
@@ -241,8 +250,9 @@
     s/{{\^-([^{]*?)}}/    $trans->expr_offset(-$1); /me;
     s/{{\^([^{]*?)}}/     $trans->expr_address($1); /me;
 
-    return $_;
-=end
+=end COMMENT    
+
+    $str;
 }
 
 =begin
@@ -260,15 +270,6 @@
 
 method rewrite_body( $body, $trans ) {
 
-    # use vtable macros
-#    $body =~ s!
-#        (?:
-#            {{\@\d+\}}
-#            |
-#            \b\w+(?:->\w+)*
-#        )->vtable->\s*(\w+)\(
-#        !VTABLE_$1(!sgx;
-
     while (1) {
         my $new_body := self._substitute( $body, $trans );
 

Modified: branches/ops_pct/compilers/opsc/src/Ops/Trans.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Trans.pm	Sat Mar  6 23:51:15 2010	(r44718)
+++ branches/ops_pct/compilers/opsc/src/Ops/Trans.pm	Sun Mar  7 00:15:10 2010	(r44719)
@@ -42,13 +42,17 @@
 method op_func($emitter) { 'NULL' }
 method getop($emitter)   { '( int (*)(PARROT_INTERP, const char *, int) )NULL' };
 
+our %arg_maps := {};
+
+method access_arg($type, $num) { die('...'); }
+
 method restart_address($addr) { die('...'); }
-method restart_offset($addr) { die('...'); }
+method restart_offset($offset) { die('...'); }
 
 method goto_address($addr) { die('...'); }
-method goto_offset($addr) { die('...'); }
+method goto_offset($offset) { die('...'); }
 
 method expr_address($addr) { die('...'); }
-method expr_offset($addr) { die('...'); }
+method expr_offset($offset) { die('...'); }
 
 # vim: expandtab shiftwidth=4 ft=perl6:

Modified: branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm	Sat Mar  6 23:51:15 2010	(r44718)
+++ branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm	Sun Mar  7 00:15:10 2010	(r44719)
@@ -15,6 +15,24 @@
 
     self<num_entries> := 0;
 
+    self<arg_maps> := hash(
+        :op("cur_opcode[NUM]"),
+
+        :i("IREG(NUM)"),
+        :n("NREG(NUM)"),
+        :p("PREG(NUM)"),
+        :s("SREG(NUM)"),
+        :k("PREG(NUM)"),
+        :ki("IREG(NUM)"),
+
+        :ic("cur_opcode[NUM]"),
+        :nc("CONST(NUM)->u.number"),
+        :pc("CONST(NUM)->u.key"),
+        :sc("CONST(NUM)->u.string"),
+        :kc("CONST(NUM)->u.key"),
+        :kic("cur_opcode[NUM]")
+    );
+
     self;
 }
 
@@ -58,7 +76,16 @@
     }
 }
 
-method restart_address($addr) { "interp->resume_offset = $addr; interp->resume_flag = 1"; }
+method access_arg($type, $num) {
+    my $access := self<arg_maps>{$type};
+    die("unrecognized arg type '$type'") unless $access;
+    subst($access, /NUM/, $num);
+}
+
+method restart_address($addr) { 
+    "interp->resume_offset = $addr; interp->resume_flag = 1";
+}
+
 method restart_offset($offset) {
     "interp->resume_offset = REL_PC + $offset; interp->resume_flag = 1";
 }

Modified: branches/ops_pct/compilers/opsc/t/06-emitter.t
==============================================================================
--- branches/ops_pct/compilers/opsc/t/06-emitter.t	Sat Mar  6 23:51:15 2010	(r44718)
+++ branches/ops_pct/compilers/opsc/t/06-emitter.t	Sun Mar  7 00:15:10 2010	(r44719)
@@ -3,7 +3,7 @@
 pir::load_bytecode("compilers/opsc/opsc.pbc");
 pir::load_bytecode("nqp-settings.pbc");
 
-plan(13);
+plan(15);
 
 my $trans := Ops::Trans::C.new();
 
@@ -59,6 +59,9 @@
 ok($source ~~ /PARROT_FUNCTION_CORE/, 'Trans::C core_type preserved');
 ok($source ~~ /static \s size_t \s hash_str/, 'Trans::C op_lookup preserved');
 
+ok($source ~~ /'PREG(1)'/, 'Trans::C arg translation works');
+ok($source ~! /'OP_SIZE'/, 'Trans::C translates OP_SIZE');
+
 say($source);
 
 # vim: expandtab shiftwidth=4 ft=perl6:


More information about the parrot-commits mailing list