[svn:parrot] r39948 - in branches/ops_pct/compilers/opsc: . compiler op
cotto at svn.parrot.org
cotto at svn.parrot.org
Wed Jul 8 08:40:38 UTC 2009
Author: cotto
Date: Wed Jul 8 08:40:37 2009
New Revision: 39948
URL: https://trac.parrot.org/parrot/changeset/39948
Log:
[opsc] use a custom Op class to store Op-related information
Modified:
branches/ops_pct/compilers/opsc/builtins.pir
branches/ops_pct/compilers/opsc/compiler/actions.pm
branches/ops_pct/compilers/opsc/op/op.pir
branches/ops_pct/compilers/opsc/op/op.pm
branches/ops_pct/compilers/opsc/opsc.pir
Modified: branches/ops_pct/compilers/opsc/builtins.pir
==============================================================================
--- branches/ops_pct/compilers/opsc/builtins.pir Wed Jul 8 08:04:35 2009 (r39947)
+++ branches/ops_pct/compilers/opsc/builtins.pir Wed Jul 8 08:40:37 2009 (r39948)
@@ -43,6 +43,13 @@
.return ($P0)
.end
+.sub 'elements'
+ .param pmc p
+ $I0 = elements p
+ .return ($I0)
+.end
+
+
.sub 'substr'
.param string orig
.param int from
@@ -51,6 +58,43 @@
.return ($S0)
.end
+.sub 'match'
+ .param string pattern
+ .param string subject
+
+ .local pmc recomp, resub, match, recache
+
+ load_bytecode 'PGE.pbc'
+
+ #hash cache mapping patterns to subs, avoiding unneeded recompilation
+ recache = get_hll_global ['Ops';'Op'], '%recache'
+ $I0 = isnull recache
+ if $I0 goto no_cache
+ $I0 = exists recache[pattern]
+ if $I0 goto found_re
+ goto no_re
+
+ no_cache:
+ recache = new ['Hash']
+
+ no_re:
+ recomp = compreg 'PGE::Perl6Regex'
+ resub = recomp(pattern)
+ recache[pattern] = resub
+
+ found_re:
+ resub = recache[pattern]
+ set_hll_global ['Ops';'Op'], '%recache', recache
+
+ match = resub(subject)
+ if match goto found_match
+ .return (0)
+ found_match:
+ .return (1)
+.end
+
+
+
# Local Variables:
# mode: pir
# fill-column: 100
Modified: branches/ops_pct/compilers/opsc/compiler/actions.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/compiler/actions.pm Wed Jul 8 08:04:35 2009 (r39947)
+++ branches/ops_pct/compilers/opsc/compiler/actions.pm Wed Jul 8 08:40:37 2009 (r39948)
@@ -45,17 +45,20 @@
$<op_body>.ast
);
+ my $op := Ops::Op.new( :name(~$<op_name>) );
+ $op.set_body(~$<op_body>);
+
# Handling flags.
for $<op_flag> {
- $past<flags>{~$_<identifier>} := 1;
+ $op.op_flags.push(~$_<identifier>);
}
# Handling parameters.
if $<op_params> {
- $past<parameters> := $<op_params>[0].ast;
+ $op<parameters> := $<op_params>[0].ast;
}
- make $past;
+ make $op;
}
method op_params($/) {
Modified: branches/ops_pct/compilers/opsc/op/op.pir
==============================================================================
--- branches/ops_pct/compilers/opsc/op/op.pir Wed Jul 8 08:04:35 2009 (r39947)
+++ branches/ops_pct/compilers/opsc/op/op.pir Wed Jul 8 08:40:37 2009 (r39948)
@@ -0,0 +1,71 @@
+# $Id$
+
+=head1 NAME
+
+PAST - Parrot abstract syntax tree for PMC.
+
+=head1 DESCRIPTION
+
+PAST node for a single Op
+
+=cut
+
+.sub '' :anon :load :init
+ ## create the classes
+ .local pmc p6meta
+ p6meta = new 'P6metaclass'
+
+ p6meta.'new_class'('Ops::Op', 'parent'=>'PAST::Op')
+
+ .return ()
+.end
+
+=head1 NODES
+
+=head2 C<PMC::Class>
+
+PMC class by it self.
+
+=cut
+
+.namespace [ 'Ops';'Op' ]
+
+.sub 'new' :method
+ .param pmc children :slurpy
+ .param pmc adverbs :slurpy :named
+
+ .local pmc res
+ $P0 = self.'HOW'()
+ $P0 = getattribute $P0, 'parrotclass'
+ res = new $P0
+ res.'init'(children :flat, adverbs :flat :named)
+
+ # Initialize various attributes
+ $P1 = new ['ResizableStringArray']
+ res.'attr'('op_flags', $P1, 1)
+
+ .return (res)
+.end
+
+=item C<does>
+
+How does this PMC act?.
+
+=cut
+
+.sub 'op_flags' :method
+ .tailcall self.'attr'('op_flags',0,0)
+.end
+
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009, Parrot Foundation.
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Modified: branches/ops_pct/compilers/opsc/op/op.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/op/op.pm Wed Jul 8 08:04:35 2009 (r39947)
+++ branches/ops_pct/compilers/opsc/op/op.pm Wed Jul 8 08:40:37 2009 (r39948)
@@ -0,0 +1,66 @@
+# Copyright (C) 2009, Parrot Foundation.
+# $Id$
+
+class Ops::Op;
+
+=item C<set_body>
+
+Set the body of this Op and do some processing on the body to determine which
+jump flags need to be set.
+
+=cut
+
+method set_body($body) {
+ my %jumps;
+ my @jumps;
+
+ #figure out which control flow flags need to be set for this op
+ if (match( " 'goto' \s+ 'ADDRESS' ", $body)) {
+ %jumps{'PARROT_JUMP_ADDRESS'} := 1;
+ }
+
+ if (match( " 'goto' \s+ 'OFFSET' ", $body) ||
+ self.name eq 'runinterp' ) {
+ %jumps{'PARROT_JUMP_RELATIVE'} := 1;
+ }
+
+ if (match( " 'goto' \s+ 'POP' ", $body)) {
+ %jumps{'PARROT_JUMP_POP'} := 1;
+ }
+
+ if (match( " 'expr' \s+ 'NEXT' ", $body) ||
+ self.name eq 'runinterp' ) {
+ %jumps{'PARROT_JUMP_ENEXT'} := 1;
+ }
+
+ if (match( " 'restart' \s+ 'OFFSET' ", $body)) {
+ %jumps{'PARROT_JUMP_RELATIVE'} := 1;
+ %jumps{'PARROT_JUMP_RESTART'} := 1;
+ }
+ elsif (match( " 'restart' \s+ 'OFFSET' ", $body)) {
+ %jumps{'PARROT_JUMP_RESTART'} := 1;
+ %jumps{'PARROT_JUMP_ENEXT'} := 1;
+ }
+ elsif (self.name eq 'branch_cs' || self.name eq 'returncc' ) {
+ %jumps{'PARROT_JUMP_RESTART'} := 1;
+ }
+ elsif (match( " 'restart' \s+ 'ADDRESS' ", $body)) {
+ %jumps{'PARROT_JUMP_RESTART'} := 1;
+ %jumps{'PARROT_JUMP_ENEXT'} := 0;
+ }
+
+ #XXX: need to handle PARROT_JUMP_GNEXT
+
+ for %jumps {
+ if %jumps{$_} {
+ @jumps.push($_);
+ }
+ }
+
+ if + at jumps == 0 {
+ self<jump_flags> := '0';
+ }
+ else {
+ self<jump_flags> := join('|', @jumps);
+ }
+}
Modified: branches/ops_pct/compilers/opsc/opsc.pir
==============================================================================
--- branches/ops_pct/compilers/opsc/opsc.pir Wed Jul 8 08:04:35 2009 (r39947)
+++ branches/ops_pct/compilers/opsc/opsc.pir Wed Jul 8 08:40:37 2009 (r39948)
@@ -23,9 +23,17 @@
$P0.'removestage'('post')
$P0.'removestage'('pir')
$P0.'removestage'('evalpmc')
+ $P0.'addstage'('die', 'after'=>'past')
.end
+.sub 'die' :method
+ .param pmc past
+ .param pmc adverbs :slurpy :named
+
+ exit 0
+.end
+
.sub 'main' :main
.param pmc args
@@ -37,8 +45,8 @@
.include 'builtins.pir'
.include 'compiler/gen_grammar.pir'
.include 'compiler/gen_actions.pir'
-.include 'op/gen_op.pir'
.include 'op/op.pir'
+.include 'op/gen_op.pir'
.include 'runcore/gen_base.pir'
.include 'runcore/gen_c.pir'
More information about the parrot-commits
mailing list