[svn:parrot] r44851 - in branches/ops_pct/compilers/opsc/src/Ops: . Compiler Trans
cotto at svn.parrot.org
cotto at svn.parrot.org
Wed Mar 10 07:46:39 UTC 2010
Author: cotto
Date: Wed Mar 10 07:46:37 2010
New Revision: 44851
URL: https://trac.parrot.org/parrot/changeset/44851
Log:
[opsc] do most of the work to remove textual substitutions in the op body
The build completes but Ops::Op.get_body is incomplete, probably among others.
Modified:
branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
branches/ops_pct/compilers/opsc/src/Ops/Compiler/Grammar.pm
branches/ops_pct/compilers/opsc/src/Ops/File.pm
branches/ops_pct/compilers/opsc/src/Ops/Op.pm
branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm
Modified: branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm Wed Mar 10 07:13:47 2010 (r44850)
+++ branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm Wed Mar 10 07:46:37 2010 (r44851)
@@ -74,7 +74,6 @@
my $op := Ops::Op.new(
:name(~$<op_name>),
-
$<op_body>.ast
);
@@ -227,146 +226,78 @@
}
method op_body($/) {
- # Single big chunk
- my $op := PAST::Op.new(
+ my $past := PAST::Block.new(
:node($/),
- :pasttype('inline'),
);
- $op<inline> := munch_body($op, ~$<body>);
- make $op;
-}
-
-sub munch_body($op, $body) {
- #
- # Macro substitutions:
- #
- # We convert the following notations:
- #
- # .ops file Op body Meaning Comment
- # ----------------- ------- ------------ ----------------------------------
- # goto OFFSET(X) {{+=X}} PC' = PC + X Used for branches
- # goto NEXT() {{+=S}} PC' = PC + S Where S is op size
- # goto ADDRESS(X) {{=X}} PC' = X Used for absolute jumps
- # expr OFFSET(X) {{^+X}} PC + X Relative address
- # expr NEXT() {{^+S}} PC + S Where S is op size
- # expr ADDRESS(X) {{^X}} X Absolute address
- # restart OFFSET(X) {{=0,+=X}} PC' = 0 Restarts at PC + X
- # restart NEXT() {{=0,+=S}} PC' = 0 Restarts at PC + S
- #
- # $X {{@X}} Argument X $0 is opcode, $1 is first arg
- #
- # For ease of parsing, if the argument to one of the above
- # notations in a .ops file contains parentheses, then double the
- # enclosing parentheses and add a space around the argument,
- # like so:
- #
- # goto OFFSET(( (void*)interp->happy_place ))
- #
- # Later transformations turn the Op body notations into C code, based
- # on the mode of operation (function calls, switch statements, gotos
- # with labels, etc.).
- #
-
- $op<jump> := '0';
-
- if ($body ~~ / [ goto | restart ] \s+ OFFSET / ) {
- $op<jump> := 'PARROT_JUMP_RELATIVE';
+ $past<jump> := 0;
+ my $prev_words := '';
+ for $<body_word> {
+ if $prev_words && $_<word> {
+ $prev_words := $prev_words ~ ~$_<word>;
+ }
+ elsif $_<word> {
+ $prev_words := ~$_<word>;
+ }
+ else {
+ $past.push(PAST::Op.new(
+ :pasttype('inline'),
+ $prev_words
+ ));
+ $prev_words := '';
+
+ if $_<macro_param> {
+ $past.push(PAST::Var.new(
+ :name(~$_<macro_param><num>)
+ ));
+ }
+ elsif $_<op_macro> {
+ my $op := $_<op_macro>;
+ my $op_arg;
+ #macro_sanity_checks($op);
+ if $op<macro_arg><macro_param> {
+ $op_arg := PAST::Var.new(
+ :name(~$op<macro_arg><macro_param><num>)
+ );
+ }
+ elsif $op<macro_arg><macro_word> {
+ $op_arg := PAST::Op.new(
+ :pasttype('inline'),
+ ~$op<macro_arg><macro_word>
+ );
+ }
+ else {
+ $op_arg := PAST::Op.new(
+ :pasttype('inline'),
+ ''
+ );
+ }
+ my $macro_name := ~$op<macro_type> ~ '_' ~ lc(~$op<macro_destination>);
+ if $macro_name eq 'restart_offset' || $macro_name eq 'goto_offset' {
+ $past<jump> := 'PARROT_JUMP_RELATIVE';
+ }
+ my $macro_past := PAST::Op.new(
+ :pasttype('call'),
+ :name($macro_name),
+ $op_arg
+ );
+ $past.push($macro_past);
+ }
+ }
}
+ if $prev_words {
+ $past.push(PAST::Op.new(
+ :pasttype('inline'),
+ $prev_words
+ ));
+ }
+ make $past;
+}
- #'goto ADDRESS((foo))' -> '{{=foo}}'
- $body := subst($body,
- /goto \s+ ADDRESS '((' $<addr>=[.*?] '))'/,
- -> $m { '{{=' ~ $m<addr> ~ '}}' }
- );
-
- #'expr ADDRESS((foo))' -> '{{^foo}}'
- $body := subst($body,
- /expr \s+ ADDRESS '((' $<addr>=[.*?] '))'/,
- -> $m { '{{^' ~ $m<addr> ~ '}}' }
- );
-
-
- #'goto ADDRESS(foo)' -> '{{=foo}}'
- $body := subst($body,
- /goto \s+ ADDRESS '(' $<addr>=[.*?] ')'/,
- -> $m { '{{=' ~ $m<addr> ~ '}}' }
- );
-
- #'expr ADDRESS(foo)' -> '{{^=foo}}'
- $body := subst($body,
- /expr \s+ ADDRESS '(' $<addr>=[.*?] ')'/,
- -> $m { '{{^' ~ $m<addr> ~ '}}' }
- );
-
- #'goto OFFSET((foo))' -> '{{+=foo}}'
- $body := subst($body,
- /goto \s+ OFFSET '((' $<addr>=[.*?] '))'/,
- -> $m { '{{+=' ~ $m<addr> ~ '}}' }
- );
-
-
- #'goto OFFSET(foo)' -> '{{+=foo}}'
- $body := subst($body,
- /goto \s+ OFFSET '(' $<addr>=[.*?] ')'/,
- -> $m { '{{+=' ~ $m<addr> ~ '}}' }
- );
-
- #'expr OFFSET((foo))' -> '{{+=foo}}'
- $body := subst($body,
- /expr \s+ OFFSET '((' $<addr>=[.*?] '))'/,
- -> $m { '{{^=' ~ $m<addr> ~ '}}' }
- );
-
-
- #'expr OFFSET(foo)' -> '{{+=foo}}'
- $body := subst($body,
- /expr \s+ OFFSET '(' $<addr>=[.*?] ')'/,
- -> $m { '{{^=' ~ $m<addr> ~ '}}' }
- );
-
- #'expr NEXT()' -> '{{^+OP_SIZE}}'
- $body := subst($body, /expr \s+ NEXT '(' ')'/, '{{^+OP_SIZE}}');
- #'goto NEXT()' -> '{{+=OP_SIZE}}'
- $body := subst($body, /goto \s+ NEXT '(' ')'/, '{{+=OP_SIZE}}');
-
-
- #'restart OFFSET(foo)' -> '{{=0,+=foo}}'
- $body := subst($body,
- /restart \s+ OFFSET '(' $<addr>=[.*?] ')'/,
- -> $m { '{{=0,+=' ~ $m<addr> ~ '}}' }
- );
-
- #'restart NEXT()' -> '{{=0,+=OP_SIZE}}'
- $body := subst($body,
- /restart \s+ NEXT '(' ')'/,
- '{{=0,+=OP_SIZE}}'
- );
-
- #'restart ADDRESS(foo)' -> '{{=foo}}'
- $body := subst($body,
- /restart \s+ ADDRESS '(' $<addr>=[.*?] ')'/,
- -> $m { '{{=' ~ $m<addr> ~ '}}' }
- );
-
- #'$1' -> '{{@1}}'
- $body := subst($body,
- /'$' $<arg_num>=[\d+]/,
- -> $m { '{{@' ~ $m<arg_num> ~ '}}' }
- );
-
-
-=begin COMMENT
-
- my $file_escaped = $file;
- $file_escaped =~ s|(\\)|$1$1|g; # escape backslashes
- $op->body( $nolines ? $body : qq{#line $line "$file_escaped"\n$body} );
-
- # Constants here are defined in include/parrot/op.h
- or_flag( \$jumps, "PARROT_JUMP_RELATIVE" ) if $branch;
-
-=end COMMENT
- $body;
+method macro_sanity_checks($/) {
+ #can't have NEXT with non-empty param
+ #must have param with OFFSET or ADDRESS
+ #can't have restart ADDRESS
}
Modified: branches/ops_pct/compilers/opsc/src/Ops/Compiler/Grammar.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Compiler/Grammar.pm Wed Mar 10 07:13:47 2010 (r44850)
+++ branches/ops_pct/compilers/opsc/src/Ops/Compiler/Grammar.pm Wed Mar 10 07:46:37 2010 (r44851)
@@ -84,8 +84,57 @@
}
# OpBody starts with '{' and ends with single '}' on line.
-token op_body {
- '{' $<body>=[.*?] ^^ '}' {*}
+regex op_body {
+ '{'
+ <body_word>*?
+ ^^ '}'
+ {*}
+}
+
+#Process op body by breaking it into "words" consisting entirely of whitespace,
+#alnums or a single punctuation, then checking for interesting macros (e.g $1
+#or goto NEXT() ) in the midst of the words.
+regex body_word {
+ [
+ | <macro_param>
+ | <op_macro>
+ | $<word>=[<alnum>+|<punct>|<space>+]
+ ]
+}
+
+regex macro_param {
+ '$' $<num>=[<digit>+]
+}
+
+regex op_macro {
+ <macro_type> <space>*? <macro_destination> <space>*? <macro_arg>
+}
+
+regex macro_type {
+ [
+ | 'goto'
+ | 'expr'
+ | 'restart'
+ ]
+}
+
+regex macro_destination {
+ [
+ | 'OFFSET'
+ | 'ADDRESS'
+ | 'NEXT'
+ ]
+}
+
+regex macro_arg {
+ #XXX; needs to match balanced parens
+ '('
+ [
+ |
+ | <macro_param>
+ | $<macro_word>=[[ <alnum>+ | <punct> | <space>+ ]*? ]
+ ]
+ ')'
}
token identifier {
Modified: branches/ops_pct/compilers/opsc/src/Ops/File.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/File.pm Wed Mar 10 07:13:47 2010 (r44850)
+++ branches/ops_pct/compilers/opsc/src/Ops/File.pm Wed Mar 10 07:46:37 2010 (r44851)
@@ -244,6 +244,10 @@
$past;
}
+method get_parse_tree($str) {
+ my $compiler := pir::compreg__Ps('Ops');
+ $compiler.compile($str, :target('parse'));
+}
method preamble() { self<preamble> };
method ops() { self<ops> };
Modified: branches/ops_pct/compilers/opsc/src/Ops/Op.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Op.pm Wed Mar 10 07:13:47 2010 (r44850)
+++ branches/ops_pct/compilers/opsc/src/Ops/Op.pm Wed Mar 10 07:46:37 2010 (r44851)
@@ -199,22 +199,22 @@
=begin
-=item C<source($trans)>
+=item C<source($trans, $op)>
Returns the L<C<body()>> of the op with substitutions made by
C<$trans> (a subclass of C<Ops::Trans>).
=end
-method source( $trans ) {
+method source( $trans, $op ) {
my $prelude := $trans.body_prelude;
- self.rewrite_body( $prelude ~ self.body, $trans );
+ return self.get_body( $prelude, $trans, $op );
}
# Called from rewrite_body() to perform the actual substitutions.
-method _substitute($str, $trans) {
+method substitute($str, $trans) {
#also needed:
@@ -282,7 +282,7 @@
=begin
-=item C<rewrite_body($body, $trans, [$preamble])>
+=item C<get_body($prelude, $trans, $op)>
Performs the various macro substitutions using the specified transform,
correctly handling nested substitions, and repeating over the whole string
@@ -293,15 +293,17 @@
=end
-method rewrite_body( $body, $trans ) {
+method get_body( $prelude, $trans, $op ) {
- while (1) {
- my $new_body := self._substitute( $body, $trans );
+ my $body := $prelude;
- return $body if $body eq $new_body;
+ #work through the op_body tree
+ for $op<op_body> {
- $body := $new_body;
+ pir::say("found an op body thing");
}
+
+ return self.substitute( $body, $trans );
}
=begin
Modified: branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm Wed Mar 10 07:13:47 2010 (r44850)
+++ branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm Wed Mar 10 07:46:37 2010 (r44851)
@@ -57,7 +57,7 @@
my $prototype := $emitter.sym_export
~ " opcode_t * $func_name (opcode_t *, PARROT_INTERP);\n";
- my $src := $op.source( self );
+ my $src := $op.source( self, $op );
@op_func_table.push(sprintf( " %-50s /* %6ld */\n", "$func_name,", $index ));
More information about the parrot-commits
mailing list