[svn:parrot] r46945 - in trunk: . lib/Parrot lib/Parrot/OpTrans lib/Parrot/Ops2c lib/Parrot/Ops2pm t/tools/ops2cutils t/tools/ops2pm
cotto at svn.parrot.org
cotto at svn.parrot.org
Mon May 24 07:59:37 UTC 2010
Author: cotto
Date: Mon May 24 07:59:36 2010
New Revision: 46945
URL: https://trac.parrot.org/parrot/changeset/46945
Log:
[ops2c] start nuking obsolete ops2c and ops2pm perl code
Deleted:
trunk/lib/Parrot/Op.pm
trunk/lib/Parrot/OpTrans/
trunk/lib/Parrot/OpTrans.pm
trunk/lib/Parrot/Ops2c/
trunk/lib/Parrot/Ops2pm/
trunk/lib/Parrot/Ops2pm.pm
trunk/lib/Parrot/OpsFile.pm
trunk/lib/Parrot/OpsRenumber.pm
trunk/t/tools/ops2cutils/
trunk/t/tools/ops2pm/
Modified:
trunk/MANIFEST
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST Mon May 24 06:04:42 2010 (r46944)
+++ trunk/MANIFEST Mon May 24 07:59:36 2010 (r46945)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Sun May 23 18:01:00 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Mon May 24 07:44:19 2010 UT
#
# See below for documentation on the format of this file.
#
@@ -1065,16 +1065,6 @@
lib/Parrot/IO/Path.pm [devel]lib
lib/Parrot/Install.pm [devel]lib
lib/Parrot/Manifest.pm [devel]lib
-lib/Parrot/Op.pm [devel]lib
-lib/Parrot/OpTrans.pm [devel]lib
-lib/Parrot/OpTrans/C.pm [devel]lib
-lib/Parrot/Ops2c/Auxiliary.pm [devel]lib
-lib/Parrot/Ops2c/Utils.pm [devel]lib
-lib/Parrot/Ops2pm.pm [devel]lib
-lib/Parrot/Ops2pm/Auxiliary.pm [devel]lib
-lib/Parrot/Ops2pm/Base.pm [devel]lib
-lib/Parrot/OpsFile.pm [devel]lib
-lib/Parrot/OpsRenumber.pm [devel]lib
lib/Parrot/Pmc2c/Attribute.pm [devel]lib
lib/Parrot/Pmc2c/ComposedMethod.pm [devel]lib
lib/Parrot/Pmc2c/Dumper.pm [devel]lib
Deleted: trunk/lib/Parrot/Op.pm
==============================================================================
--- trunk/lib/Parrot/Op.pm Mon May 24 07:59:36 2010 (r46944)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,423 +0,0 @@
-#! perl
-# Copyright (C) 2001-2009, Parrot Foundation.
-# $Id$
-
-=head1 NAME
-
-Parrot::Op - Parrot Operation
-
-=head1 SYNOPSIS
-
- use Parrot::Op;
-
-=head1 DESCRIPTION
-
-C<Parrot::Op> represents a Parrot operation (op, for short), as read
-from an ops file via C<Parrot::OpsFile>, or perhaps even generated by
-some other means. It is the Perl equivalent of the C<op_info_t> C
-C<struct> defined in F<include/parrot/op.h>.
-
-=head2 Op Type
-
-Ops are either I<auto> or I<manual>. Manual ops are responsible for
-having explicit next-op C<RETURN()> statements, while auto ops can count
-on an automatically generated next-op to be appended to the op body.
-
-Note that F<tools/build/ops2c.pl> supplies either 'inline' or 'function'
-as the op's type, depending on whether the C<inline> keyword is present
-in the op definition. This has the effect of causing all ops to be
-considered manual.
-
-=head2 Op Arguments
-
-Note that argument 0 is considered to be the op itself, with arguments
-1..9 being the arguments passed to the op.
-
-Op argument direction and type are represented by short one or two letter
-descriptors.
-
-Op Direction:
-
- i The argument is incoming
- o The argument is outgoing
- io The argument is both incoming and outgoing
-
-Op Type:
-
- i The argument is an integer register index.
- n The argument is a number register index.
- p The argument is a PMC register index.
- s The argument is a string register index.
- ic The argument is an integer constant (in-line).
- nc The argument is a number constant index.
- pc The argument is a PMC constant index.
- sc The argument is a string constant index.
- kc The argument is a key constant index.
- ki The argument is a key integer register index.
- kic The argument is a key integer constant (in-line).
-
-=head2 Class Methods
-
-=over 4
-
-=cut
-
-package Parrot::Op;
-
-use strict;
-use warnings;
-
-=item C<new($code, $type, $name, $args, $argdirs, $labels, $flags)>
-
-Allocates a new bodyless op. A body must be provided eventually for the
-op to be usable.
-
-C<$code> is the integer identifier for the op.
-
-C<$type> is the type of op (see the note on op types above).
-
-C<$name> is the name of the op.
-
-C<$args> is a reference to an array of argument type descriptors.
-
-C<$argdirs> is a reference to an array of argument direction
-descriptors. Element I<x> is the direction of argument C<< $args->[I<x>]
->>.
-
-C<$labels> is a reference to an array of boolean values indicating
-whether each argument direction was prefixed by 'C<label>'.
-
-C<$flags> is a hash reference containing zero or more I<hints> or
-I<directives>.
-
-=cut
-
-sub new {
- my $class = shift;
- my ( $code, $type, $name, $args, $argdirs, $labels, $flags ) = @_;
-
- my $self = {
- CODE => $code,
- TYPE => $type,
- NAME => $name,
- ARGS => [@$args],
- ARGDIRS => [@$argdirs],
- LABELS => [@$labels],
- FLAGS => $flags,
- BODY => '',
- JUMP => 0,
- };
-
- return bless $self, $class;
-}
-
-=back
-
-=head2 Instance Methods
-
-=over 4
-
-=item C<code()>
-
-Returns the op code.
-
-=cut
-
-sub code {
- my $self = shift;
-
- return $self->{CODE};
-}
-
-=item C<type()>
-
-The type of the op, either 'inline' or 'function'.
-
-=cut
-
-sub type {
- my $self = shift;
-
- return $self->{TYPE};
-}
-
-=item C<name()>
-
-The (short or root) name of the op.
-
-=cut
-
-sub name {
- my $self = shift;
-
- return $self->{NAME};
-}
-
-=item C<full_name()>
-
-For argumentless ops, it's the same as C<name()>. For ops with
-arguments, an underscore followed by underscore-separated argument types
-are appended to the name.
-
-=cut
-
-sub full_name {
- my $self = shift;
- my $name = $self->name;
- my @arg_types = $self->arg_types;
-
- $name .= "_" . join( "_", @arg_types ) if @arg_types;
-
- return $name;
-}
-
-=item C<func_name()>
-
-The same as C<full_name()>, but with 'C<Parrot_>' prefixed.
-
-=cut
-
-sub func_name {
- my ( $self, $trans ) = @_;
-
- return $trans->prefix . $self->full_name;
-}
-
-=item C<arg_types()>
-
-Returns the types of the op's arguments.
-
-=cut
-
-sub arg_types {
- my $self = shift;
-
- return @{ $self->{ARGS} };
-}
-
-=item C<arg_type($index)>
-
-Returns the type of the op's argument at C<$index>.
-
-=cut
-
-sub arg_type {
- my $self = shift;
-
- return $self->{ARGS}[shift];
-}
-
-=item C<arg_dirs()>
-
-Returns the directions of the op's arguments.
-
-=cut
-
-sub arg_dirs {
- my $self = shift;
-
- return @{ $self->{ARGDIRS} };
-}
-
-=item C<labels()>
-
-Returns the labels.
-
-=cut
-
-sub labels {
- my $self = shift;
-
- return @{ $self->{LABELS} };
-}
-
-=item C<flags(@flags)>
-
-=item C<flags()>
-
-Sets/gets the op's flags. This returns a hash reference, whose keys are any
-flags (passed as ":flag") specified for the op.
-
-=cut
-
-sub flags {
- my $self = shift;
-
- if (@_) {
- $self->{FLAGS} = shift;
- }
-
- return $self->{FLAGS};
-}
-
-=item C<arg_dir($index)>
-
-Returns the direction of the op's argument at C<$index>.
-
-=cut
-
-sub arg_dir {
- my $self = shift;
-
- return $self->{ARGDIRS}[shift];
-}
-
-=item C<body($body)>
-
-=item C<body()>
-
-Sets/gets the op's code body.
-
-=cut
-
-sub body {
- my $self = shift;
-
- if (@_) {
- $self->{BODY} = shift;
- }
-
- return $self->{BODY};
-}
-
-=item C<jump($jump)>
-
-=item C<jump()>
-
-Sets/gets a string containing one or more C<op_jump_t> values joined with
-C<|> (see F<include/parrot/op.h>). This indicates if and how an op
-may jump.
-
-=cut
-
-sub jump {
- my $self = shift;
-
- if (@_) {
- $self->{JUMP} = shift;
- }
-
- return $self->{JUMP};
-}
-
-# Called from rewrite_body() to perform the actual substitutions.
-sub _substitute {
- my $self = shift;
- local $_ = shift;
- my $trans = shift;
- my $preamble_only = shift;
-
- my $rewrote_access =
- s/{{\@([^{]*?)}}/ $trans->access_arg($self->arg_type($1 - 1), $1, $self); /me;
-
- die "Argument access not allowed in preamble\n"
- if $preamble_only && $rewrote_access;
-
- s/{{=0,=([^{]*?)}}/ $trans->restart_address($1) . "; {{=0}}"; /me;
- s/{{=0,\+=([^{]*?)}}/ $trans->restart_offset($1) . "; {{=0}}"; /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_address($1); /me;
-
- return $_;
-}
-
-=item C<rewrite_body($body, $trans, [$preamble])>
-
-Performs the various macro substitutions using the specified transform,
-correctly handling nested substitions, and repeating over the whole string
-until no more substitutions can be made.
-
-C<VTABLE_> macros are enforced by converting C<<< I<< x >>->vtable->I<<
-method >> >>> to C<VTABLE_I<method>>.
-
-=cut
-
-sub rewrite_body {
- my ( $self, $body, $trans, $preamble_only ) = @_;
-
- while (1) {
- my $new_body = $self->_substitute( $body, $trans, !!$preamble_only );
-
- last if $body eq $new_body;
-
- $body = $new_body;
- }
-
- return $body;
-}
-
-=item C<source($trans)>
-
-Returns the L<C<body()>> of the op with substitutions made by
-C<$trans> (a subclass of C<Parrot::OpTrans>).
-
-=cut
-
-sub source {
- my ( $self, $trans ) = @_;
-
- my $flags = $self->flags;
-
- if (exists($$flags{pic})
- && !( ref($trans) eq 'Parrot::OpTrans::CGP' || ref($trans) eq 'Parrot::OpTrans::CSwitch' ) )
- {
- return qq{PANIC(interp, "How did you do that");\n};
- }
-
- my $prelude = $trans->can( 'add_body_prelude' )
- ? $trans->add_body_prelude()
- : '';
-
- return $self->rewrite_body( $prelude . $self->body, $trans );
-}
-
-=item C<size()>
-
-Returns the op's number of arguments. Note that this also includes
-the op itself as one argument.
-
-=cut
-
-sub size {
- my $self = shift;
-
- return scalar( $self->arg_types + 1 );
-}
-
-=back
-
-=head1 SEE ALSO
-
-=over 4
-
-=item C<Parrot::OpsFile>
-
-=item C<Parrot::OpTrans>
-
-=item F<tools/build/ops2c.pl>
-
-=item F<tools/build/ops2pm.pl>
-
-=item F<tools/build/pbc2c.pl>
-
-=back
-
-=head1 HISTORY
-
-Author: Gregor N. Purdy E<lt>gregor at focusresearch.comE<gt>
-
-=cut
-
-1;
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Deleted: trunk/lib/Parrot/OpTrans.pm
==============================================================================
--- trunk/lib/Parrot/OpTrans.pm Mon May 24 07:59:36 2010 (r46944)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,225 +0,0 @@
-# Copyright (C) 2002-2007, Parrot Foundation.
-# $Id$
-
-=head1 NAME
-
-Parrot::OpTrans - Transform Ops to C Code
-
-=head1 DESCRIPTION
-
-C<Parrot::OpTrans> is the abstract superclass for the Parrot op to C
-transforms. Each transform contains various bits of information needed
-to generate the C code, and creates a different type of run loop. The
-methods defined here supply various default values and behaviour common
-to all transforms.
-
-The subclass hierarchy is as follows:
-
- OpTrans
- |
- |
- C
-
-=head2 Class Methods
-
-=over 4
-
-=cut
-
-package Parrot::OpTrans;
-
-use strict;
-use warnings;
-
-=item C<new()>
-
-Returns a new instance.
-
-=cut
-
-sub new {
- return bless {}, shift;
-}
-
-=back
-
-=head2 Instance Methods
-
-=over 4
-
-=item C<prefix()>
-
-Returns the default 'C<Parrot_>' prefix.
-
-Used by C<Parrot::Op>'s C<func_name()> to individuate op function names.
-
-=cut
-
-sub prefix {
- return 'Parrot_';
-}
-
-=item C<suffix()>
-
-Implemented in subclasses to return a suffix with which to individuate
-variable names. This default implementation returns an empty string.
-
-=cut
-
-sub suffix {
- return '';
-}
-
-=item C<core_type()>
-
-Implemented in subclasses to return the type of core created by the
-transform. This default implementation raises an exception indicating
-that the core type is missing. See the C<Parrot_Run_core_t> C<enum> in
-F<include/parrot/interpreter.h> for a list of the core types.
-
-=cut
-
-sub core_type {
- my $self = shift;
-
- die ref($self) . " doesn't have core_type()";
-}
-
-=item C<run_core_func_decl($base)>
-
-Optionally implemented in subclasses to return the C code for the run
-core function declaration. C<$base> is the name of the main ops file minus
-the .ops extension.
-
-=item C<ops_addr_decl($base_suffix)>
-
-Optionally implemented in subclasses to return the C code for the ops
-address declaration. C<$base_suffix> is the name of the main ops file minus
-the .ops extension with C<suffix()> and an underscore appended.
-
-=item C<run_core_func_decl($base)>
-
-Optionally implemented in subclasses to return the C code for the run
-core function declaration. C<$base> is the same as for
-C<run_core_func_decl()>.
-
-=item C<run_core_func_start()>
-
-Implemented in subclasses, if C<run_core_func_decl()> is implemented, to
-return the C code prior to the run core function.
-
-=item C<run_core_after_addr_table($base_suffix)>
-
-Optionally implemented in subclasses to return the run core C code for
-section after the address table. C<$base_suffix> is the same as for
-C<ops_addr_decl()>.
-
-=item C<run_core_finish($base)>
-
-Implemented in subclasses to return the C code following the run core
-function. C<$base> is the same as for C<run_core_func_decl()>.
-
-=item C<init_func_init1($base)>
-
-Optionally implemented in subclasses to return the C code for the core's
-init function. C<$base> is the same as for C<run_core_func_decl()>.
-
-=item C<init_set_dispatch($base_suffix)>
-
-Optionally implemented in subclasses to return the C code for
-initializing the dispatch mechanism within the core's init function.
-C<$base_suffix> is the same as for C<ops_addr_decl()>.
-
-=back
-
-B<Macro Substitutions>
-
-The following methods are called by C<Parrot::OpFile> to perform ops
-file macro substitutions.
-
-=over
-
-=item C<access_arg($type, $value, $op)>
-
-Implemented in subclasses to return the C code for the specified op
-argument type and value. C<$op> is an instance of C<Parrot::Op>.
-
-=item C<gen_goto($where)>
-
-The various C<goto_I<X>> methods below call this method with the return
-value of an C<expr_I<X>> method (implemented in subclass).
-
-=cut
-
-sub gen_goto {
- my ( $self, $where_str ) = @_;
-
- return "return $where_str";
-}
-
-=item C<restart_address($address)>
-
-Implemented in subclasses to return the C code for C<restart
-ADDRESS($address)>.
-
-=item C<restart_offset($offset)>
-
-Implemented in subclasses to return the C code for C<restart
-OFFSET($offset)>.
-
-=item C<goto_address($address)>
-
-Transforms the C<goto ADDRESS($address)> macro in an ops file into the
-relevant C code.
-
-=cut
-
-sub goto_address {
- my $self = shift;
-
- return $self->gen_goto( $self->expr_address(@_) );
-}
-
-=item C<goto_offset($offset)>
-
-Transforms the C<goto OFFSET($offset)> macro in an ops file into the
-relevant C code.
-
-=cut
-
-sub goto_offset {
- my $self = shift;
-
- return $self->gen_goto( $self->expr_offset(@_) );
-}
-
-=item C<expr_offset($offset)>
-
-Implemented in subclasses to return the C code for C<OFFSET($offset)>.
-Called by C<goto_offset()>.
-
-=item C<expr_address($address)>
-
-Implemented in subclasses to return the C code for C<ADDRESS($address)>.
-Called by C<goto_address()>.
-
-=back
-
-=head1 SEE ALSO
-
-=over 4
-
-=item C<Parrot::OpTrans::C>
-
-=back
-
-=cut
-
-1;
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Deleted: trunk/lib/Parrot/Ops2pm.pm
==============================================================================
--- trunk/lib/Parrot/Ops2pm.pm Mon May 24 07:59:36 2010 (r46944)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,537 +0,0 @@
-# Copyright (C) 2007, Parrot Foundation.
-# $Id$
-package Parrot::Ops2pm;
-use strict;
-use warnings;
-use Cwd;
-use Data::Dumper ();
-use File::Path ();
-use File::Spec;
-use lib qw ( lib );
-use base qw( Parrot::Ops2pm::Base );
-use Parrot::OpsFile;
-
-=head1 NAME
-
-Parrot::Ops2pm - Methods holding functionality for F<tools/build/ops2pm.pl>.
-
-=head1 SYNOPSIS
-
- use Parrot::Ops2pm;
-
- $self = Parrot::Ops2pm->new( {
- argv => [ @ARGV ],
- nolines => $nolines_flag,
- moddir => "lib/Parrot/OpLib",
- module => "core.pm",
- inc_dir => "include/parrot/oplib",
- inc_f => "ops.h",
- script => "tools/build/ops2pm.pl",
- } );
-
- $self->prepare_ops();
- $self->load_op_map_files();
- $self->sort_ops();
- $self->prepare_real_ops();
- $self->print_module();
- $self->print_h();
- exit 0;
-
-=cut
-
-=head1 DESCRIPTION
-
-Parrot::Ops2pm provides methods called by F<tools/build/ops2pm.pl>, a
-program which is called at the very beginning of the Parrot F<make> process.
-The program's function is to build two files:
-
-=over 4
-
-=item * F<lib/Parrot/OpLib/core.pm>
-
-=item * F<include/parrot/oplib/ops.h>
-
-=back
-
-The functionality once (pre-April 2007) found in F<tools/build/ops2pm.pl> has
-been extracted into this package's methods in order to support
-component-focused testing and future refactoring.
-
-=head1 METHODS
-
-=head2 C<new()>
-
-Inherited from Parrot::Ops2pm::Base and documented in
-F<lib/Parrot/Ops2pm/Base.pm>.
-
-=head2 C<prepare_ops()>
-
-Inherited from Parrot::Ops2pm::Base and documented in
-F<lib/Parrot/Ops2pm/Base.pm>.
-
-=head2 C<load_op_map_files()>
-
-=over 4
-
-=item * Purpose
-
-When F<tools/build/ops2pm.pl> is called by F<make>, this method
-checks the number of ops strictly against F<src/ops/ops.num> and
-F<src/ops/ops.skip>.
-
-=item * Arguments
-
-None. (Implicitly requires that the C<argv> and C<script> keys
-have been provided to the constructor.)
-
-=item * Return Value and Side Effects
-
-Returns true value upon success. Internally, sets these
-values in these elements in the object's data structure:
-
-=over 4
-
-=item * C<max_op_num>
-
-Scalar holding number of highest non-experimental op. Example:
-
- 'max_op_num' => 1246,
-
-=item * C<optable>
-
-Reference to hash holding mapping of opcode names ops to their numbers.
-Example:
-
- 'optable' => {
- 'pow_p_p_i' => 650,
- 'say_s' => 463,
- 'lsr_p_p_i' => 207,
- 'lt_s_sc_ic' => 289,
- # ...
- 'debug_init' => 429,
- 'iseq_i_nc_n' => 397,
- 'eq_addr_sc_s_ic' => 254
- },
-
-Per F<src/ops/ops.num>, this mapping exists so that we can nail down
-the op numbers for the core opcodes in a particular version of the
-bytecode and provide backward-compatibility for bytecode.
-
-=item * C<skiptable>
-
-Reference to a 'seen-hash' of skipped opcodes.
-
- 'skiptable' => {
- 'bor_i_ic_ic' => 1,
- 'xor_i_ic_ic' => 1,
- 'tanh_n_nc' => 1,
- # ...
- },
-
-As F<src/ops/ops.skip> states, these are "... opcodes that could be listed in
-F<[src/ops/]ops.num> but aren't ever to be generated or implemented because
-they are useless and/or silly."
-
-=back
-
-=back
-
-=cut
-
-sub load_op_map_files {
- my $self = shift;
- my $num_file = $self->{num_file};
- my $skip_file = $self->{skip_file};
-
- my ( $op, $name, $number, $prev );
-
- $self->{max_op_num} ||= 0;
-
- open $op, '<', $num_file
- or die "Can't open $num_file: $!";
- $prev = -1;
- while (<$op>) {
- chomp;
- s/#.*$//;
- s/\s*$//;
- s/^\s*//;
- next unless $_;
- ( $name, $number ) = split( /\s+/, $_ );
- if ( $prev + 1 != $number ) {
- die "hole in ops.num before #$number";
- }
- if ( exists $self->{optable}{$name} ) {
- die "duplicate opcode $name and $number";
- }
- $prev = $number;
- $self->{optable}{$name} = $number;
- if ( $number > $self->{max_op_num} ) {
- $self->{max_op_num} = $number;
- }
- }
- undef $op;
-
- open $op, '<', $skip_file
- or die "Can't open $skip_file: $!";
- while (<$op>) {
- chomp;
- s/#.*$//;
- s/\s*$//;
- s/^\s*//;
- next unless $_;
- ($name) = split( /\s+/, $_ );
- if ( exists $self->{optable}{$name} ) {
- die "skipped opcode is also in $num_file:$.";
- }
- $self->{skiptable}{$name} = 1;
- }
- undef $op;
- return 1;
-}
-
-=head2 C<sort_ops()>
-
-=over 4
-
-=item * Purpose
-
-Internal manipulation of the Parrot::Ops2pm object: sorting by number of the
-list of op codes found in the object's C<{ops}-E<gt>{OPS}> element.
-
-=item * Arguments
-
-None.
-
-=item * Return Value and Side Effects
-
-No return value. Internally, re-sets the C<ops> key of the object's data
-structure.
-
-=item * Comment
-
-It is at this point that warnings about experimental opcodes will be
-emitted if you are working in a checkout from the Parrot repository. Example:
-
- trap 1247 experimental, not in ops.num
-
-=back
-
-=cut
-
-sub sort_ops {
- my $self = shift;
- for my $el ( @{ $self->{ops}{OPS} } ) {
- if ( exists $self->{optable}{ $el->full_name } ) {
- $el->{CODE} = $self->{optable}{ $el->full_name };
- }
- elsif ( exists $self->{skiptable}{ $el->full_name } ) {
- $el->{CODE} = -1;
- }
- elsif ( $el->{experimental} ) {
- my $n = $self->{optable}{ $el->full_name } = ++$self->{max_op_num};
- warn sprintf(
- "%-25s %-10s experimental, not in ops.num\n",
- $el->full_name, $n
- ) if -e "DEVELOPING";
- $el->{CODE} = $n;
- }
- else {
- die sprintf(
- "%-25s %-10s FATAL: not in ops.num nor ops.skip\n",
- $el->full_name, ""
- ) if -e "DEVELOPING";
- $el->{CODE} = -1;
- }
- }
- @{ $self->{ops}{OPS} } =
- sort { $a->{CODE} <=> $b->{CODE} } ( @{ $self->{ops}{OPS} } );
-}
-
-=head2 C<prepare_real_ops()>
-
-=over 4
-
-=item * Purpose
-
-Final stage of preparation of ops.
-
-=item * Arguments
-
-None. (Same implicit requirements for the constructor as
-C<load_op_map_files()> above.)
-
-=item * Return Value and Side Effects
-
-No return value. Internally, adds the C<real_ops> key of the object's
-data structure. Its value is a Parrot::OpsFile object.
-
-=back
-
-=cut
-
-sub prepare_real_ops {
- my $self = shift;
-
- my $real_ops = Parrot::OpsFile->new( [], $self->{nolines} );
- $real_ops->{PREAMBLE} = $self->{ops}{PREAMBLE};
- $real_ops->version( $self->{ops}->version );
-
- # verify opcode numbers
- my $seq = 0;
- for my $el ( @{ $self->{ops}{OPS} } ) {
- next if $el->{CODE} < 0; # skip
- my $opname = $el->full_name;
- my $n = $self->{optable}{$opname}; # former global
- if ( $n != $el->{CODE} ) {
- die "op $opname: number mismatch: ops.num $n vs. core.ops $el->{CODE}";
- }
- if ( $seq != $el->{CODE} ) {
- die "op $opname: sequence mismatch: ops.num $seq vs. core.ops $el->{CODE}";
- }
- push @{ $real_ops->{OPS} }, $el;
- ++$seq;
- }
- $self->{real_ops} = $real_ops;
-}
-
-=head2 C<print_module()>
-
-=over 4
-
-=item * Purpose
-
-Uses information in the object's data structure -- principally
-the C<real_ops> element -- to create F<lib/Parrot/OpLib/core.pm>.
-
-=item * Arguments
-
-None. (Implicitly requires that the constructor have the
-following keys defined: C<argv>, C<script>, C<moddir> and C<module>.)
-
-=item * Return Value
-
-Returns true value upon success.
-
-=item * Comment
-
-=back
-
-=cut
-
-sub print_module {
- my $self = shift;
- my $cwd = cwd();
- my $fulldir = File::Spec->catdir( $cwd, $self->{moddir} );
- if ( !-d $fulldir ) {
- if ( !File::Path::mkpath( [ $fulldir ], 0, 0755 ) ) {
- -d $fulldir
- or die "$self->{script}: Could not mkdir $fulldir: $!!\n";
- }
- }
- my $fullpath = File::Spec->catfile( ($fulldir), $self->{module} );
- open my $MODULE, '>', $fullpath
- or die "$self->{script}: Could not open module file '$fullpath' for writing: $!!\n";
-
- my $version = $self->{real_ops}->version();
- ( my $pod = <<"END_POD") =~ s/^ //osmg;
- =head1 NAME
-
- Parrot::OpLib::core - Parrot Op Info
-
- =head1 DESCRIPTION
-
- This is an autogenerated file, created by F<$self->{script}>.
-
- It contains Parrot version info, a preamble for inclusion in C code,
- and an array of C<Parrot::Op> instances representing the Parrot ops.
-
- =cut
-END_POD
-
- my $preamble = <<END_C;
-#! perl -w
-#
-# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
-#
-# This file is generated automatically from '$self->{file}'.
-# Any changes made here will be lost!
-#
-
-$pod
-
-use strict;
-
-package Parrot::OpLib::core;
-
-use vars qw(\$VERSION \$ops \$preamble);
-
-\$VERSION = "$version";
-
-END_C
-
- print {$MODULE} $preamble;
- print {$MODULE} Data::Dumper->Dump( [ $self->{real_ops}->preamble, [ $self->{real_ops}->ops ] ],
- [qw($preamble $ops)] );
-
- print {$MODULE} <<END_C;
-
-1;
-END_C
-
- close $MODULE or die;
-
- return 1;
-}
-
-=head2 C<print_h()>
-
-=over 4
-
-=item * Purpose
-
-Uses information in the object's data structure -- principally
-the C<real_ops> key -- to create F<include/parrot/oplib/ops.h>.
-
-=item * Arguments
-
-None. (Implicitly requires that the constructor have the
-following keys defined: C<argv>, C<script>, C<inc_dir> and C<inc_f>.)
-
-=item * Return Value
-
-Returns true value upon success.
-
-=item * Comment
-
-=back
-
-=cut
-
-sub print_h {
- my $self = shift;
- my $cwd = cwd();
- my $fulldir = File::Spec->catdir( $cwd, $self->{inc_dir} );
- if ( !-d $fulldir ) {
- if ( !File::Path::mkpath( [ $fulldir ], 0, 0755 ) ) {
- -d $fulldir
- or die "$self->{script}: Could not mkdir $fulldir: $!!\n";
- }
- }
-
- my $fullpath = File::Spec->catfile( ($fulldir), $self->{inc_f} );
- open my $OUT, '>', $fullpath
- or die "$self->{script}: Could not open module file '$fullpath' for writing: $!!\n";
-
- print $OUT <<END_C;
-/* ex: set ro:
- * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
- *
- * This file is generated automatically from '$self->{file}'
- * by $self->{script}.
- *
- * Any changes made here will be lost!
- */
-
-#ifndef PARROT_OPS_H_GUARD
-#define PARROT_OPS_H_GUARD
-
-typedef enum {
-END_C
-
- my @OPS = @{ $self->{real_ops}->{OPS} };
- for my $el (@OPS) {
- my $opname = $el->full_name;
- my $n = $el->{CODE};
- my $comma = $n < @OPS - 1 ? "," : "";
- $opname = "PARROT_OP_$opname$comma";
-
- printf $OUT " %-30s\t/* %4d */\n", $opname, $n;
- }
-
- print $OUT <<END_C;
-} parrot_opcode_enums;
-
-#endif /* PARROT_OPS_H_GUARD */
-
-END_C
-
- # append the C code coda
- print $OUT <<END_C;
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
-END_C
- close $OUT;
- return 1;
-}
-
-=head1 NOTE ON TESTING
-
-A suite of test files to accompany this package is found in
-F<t/tools/ops2pm>. This suite has been developed to maximize its
-coverage of the code of Parrot::Ops2pm (as measured by Perl module
-Devel::Cover). Should you wish to refactor this package, it is recommended
-that you do so in a B<test-driven> manner:
-
-=over 4
-
-=item 1
-
-Write the specification for any additions or modifications to
-Parrot::Ops2pm' interface.
-
-=item 2
-
-Write tests that reflect any such modifications.
-
-=item 3
-
-Write the additional or modified code that reflects the new specification.
-
-=item 4
-
-Test the new code and debug. The tests in the suite should be run B<after>
-Parrot's F<Configure.pl> has run but B<before> F<make> has run. Example:
-
- $> perl Configure.pl
- $> prove -v t/tools/ops2pm/*.t
- $> make
-
-=item 5
-
-Use Devel::Cover to measure the extent to which the existing and new tests
-cover the existing and revised code.
-
-=item 6
-
-Refactor and retest to ensure high test coverage.
-
-=back
-
-This package's methods are called by F<tools/build/ops2pm.pl>, which in turn
-is invoked by F<make> in the Parrot build process. Successful execution of
-F<make> proves that the functionality in this package achieved its overall
-objective but does not necessarily invoke many of the individual code
-statements in the package. That is the rationale for the component-focused
-testing provided by the test suite.
-
-=head1 AUTHOR
-
-See F<tools/build/ops2pm.pl> for a list of the Parrot hackers who, over a
-period of several years, developed the functionality now found in the methods
-of Parrot::Ops2pm. Jim Keenan extracted that functionality and placed
-it in this package's methods.
-
-=cut
-
-1;
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Deleted: trunk/lib/Parrot/OpsFile.pm
==============================================================================
--- trunk/lib/Parrot/OpsFile.pm Mon May 24 07:59:36 2010 (r46944)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,750 +0,0 @@
-#! perl
-# Copyright (C) 2001-2009, Parrot Foundation.
-# $Id$
-
-=head1 NAME
-
-Parrot::OpsFile - Ops To C Code Generation
-
-=head1 SYNOPSIS
-
- use Parrot::OpsFile;
-
-=head1 DESCRIPTION
-
-C<Parrot::OpsFile> takes one or more files of op functions and
-creates real C code for them.
-
-This class is used by F<tools/build/ops2c.pl>,
-F<tools/build/ops2pm.pl> and F<tools/build/pbc2c.pl>.
-
-=head2 Op Functions
-
-For ops that have trivial bodies (such as just a call to some other
-function and a C<return> statement), opcode functions are in the format:
-
- inline op opname (args) :flags {
- ... body of function ...
- }
-
-Note that currently the C<inline> op type is ignored.
-
-Alternately, for opcode functions that have more internal complexity the
-format is:
-
- op opname (args) :flags {
- ... body of function ...
- }
-
-There may be more than one C<return>.
-
-In both cases the closing brace B<must> be on its own line.
-
-When specifying multiple flags, each flag gets its own prefixing colon.
-
-=head2 Op Arguments
-
-Op arguments are a comma-separated list of direction and type pairs.
-
-Argument direction is one of:
-
- in the argument passes a value into the op
- out the argument passes a value out of the op
- inout the argument passes a value into and out of the op
- inconst the argument passes a constant value into the op
- invar the argument passes a variable value into the op
-
-Argument direction is used to determine the life times of symbols and
-their related register allocations. When an argument is passed into an
-op a register is read from, when it's passed out of an op a register is
-written to.
-
-Argument type is one of:
-
- INT the argument is an integer
- NUM the argument is an numeric
- STR the argument is an string
- PMC the argument is an PMC
- KEY the argument is an aggregate PMC key
- INTKEY the argument is an aggregate PMC integer key
- LABEL the argument is an integer branch offset or address
-
-The size of the return offset is determined from the op function's
-signature.
-
-=head2 Op Flags
-
-The flags are of two types:
-
-=over 4
-
-=item 1 class
-
-The classification of ops is intended to facilitate the selection of
-suitable ops for a Parrot safe mode.
-
-=item 2 behavior
-
-The presence (or absence) of certain flags will change how the op behaves. For
-example, the lack of the C<flow> flag will cause the op to be implicitly
-terminated with C<goto NEXT()>. (See next section).
-
-The :deprecated flag will generate a diagnostic to standard error at
-runtime when a deprecated opcode is invoked and
-C<PARROT_WARNINGS_DEPRECATED_FLAG> has been set.
-
-=back
-
-=head2 Op Body (Macro Substitutions)
-
-In the following macro descriptions, C<PC> and C<PC'> are the current
-and next position within the Parrot code.
-
-=over 4
-
-=item C<goto OFFSET(X)>
-
-Transforms to C<PC' = PC + X>. This is used for branches.
-
-=item C<goto NEXT()>
-
-Transforms to C<PC' = PC + S>, where C<S> is the size of an op.
-
-=item C<goto ADDRESS(X)>
-
-Transforms to C<PC' = X>. This is used for absolute jumps.
-
-=item C<expr OFFSET(X)>
-
-Transforms to C<PC + X>. This is used to give a relative address.
-
-=item C<expr NEXT()>
-
-Transforms to C<PC + S>, the position of the next op.
-
-=item C<expr ADDRESS(X)>
-
-Transforms to C<X>, an absolute address.
-
-=item C<restart OFFSET(X)>
-
-Transforms to C<PC' = 0> and restarts at C<PC + X>.
-
-=item C<restart NEXT()>
-
-Transforms to C<PC' = 0> and restarts at C<PC + S>.
-
-=item C<$n>
-
-Transforms to the op function's nth argument. C<$0> is the opcode itself.
-
-=back
-
-Note that, 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 ))
-
-=head2 Class Methods
-
-=over 4
-
-=cut
-
-package Parrot::OpsFile;
-
-use strict;
-use warnings;
-
-use base qw( Exporter );
-
-use Parrot::Op;
-use Parrot::Config;
-
-our %op_body;
-our @EXPORT = qw( %op_body );
-
-# private sub _trim()
-#
-# Trim leading and trailing spaces.
-
-sub _trim {
- my $value = shift;
-
- $value =~ s/^\s+//;
- $value =~ s/\s+$//;
-
- return $value;
-}
-
-=item C<new(@files)>
-
-Returns a new instance initialized by calling C<read_ops()> on each of
-the specified op files.
-
-=cut
-
-sub new {
- my ( $class, $files, $nolines ) = @_;
-
- my $self = bless { PREAMBLE => '' }, $class;
-
- $self->read_ops( $_, $nolines ) for @{$files};
-
- # FILE holds a space separated list of opsfile name
- if ( $self->{FILE} ) {
- $self->{FILE} =~ s/, $//;
- $self->{FILE} =~ s/, $//;
- }
-
- return $self;
-}
-
-=back
-
-=head2 Instance Methods
-
-=over 4
-
-=item C<read_ops($file,$nolines)>
-
-Reads in the specified .ops file, gathering information about the ops.
-
-=cut
-
-sub read_ops {
- my ( $self, $file, $nolines ) = @_;
-
- my $ops_file = "src/" . $file;
-
- die "Parrot::OpFunc::init(): No file specified!\n" unless defined $file;
-
- $self->{FILE} .= $file . ', ';
-
- my $orig = $file;
-
- open my $OPS, '<', $file or die "Can't open $file, $!/$^E";
-
- $self->version( $PConfig{VERSION} );
-
- if ( !( $file =~ s/\.ops$/.c/ ) ) {
- $file .= ".c";
- }
-
- #
- # Read through the file, creating and storing Parrot::Op objects:
- #
-
- my $count = 0;
- my ( $name, $footer );
- my $type;
- my $body;
- my $short_name;
- my $args;
- my @args;
- my @argdirs;
- my $seen_pod;
- my $seen_op;
- my $in_preamble;
- my $line;
- my $flags;
- my @labels;
-
- while (<$OPS>) {
- $seen_pod = 1 if m|^=|;
- $in_preamble = 1 if s|^BEGIN_OPS_PREAMBLE||;
-
- unless ( $seen_op or m|^(inline\s+)?op\s+| ) {
-
- if (m|^END_OPS_PREAMBLE|) {
- $_ = '';
- $in_preamble = 0;
- }
- elsif ($in_preamble) {
- $self->{PREAMBLE} .= $_;
- }
-
- next;
- }
-
- die "No 'VERSION = ...;' line found before beginning of ops in file '$orig'!\n"
- unless defined $self->version;
-
- #
- # Handle start-of-op:
- #
- # We create a new Parrot::Op instance based on the type, name and args.
- # We query the Parrot::Op for the op size, etc., which we use later.
- #
- # Either of these two forms work:
- #
- # inline op name (args) {
- # op name (args) {
- #
- # The args are a comma-separated list of items from this table of argument
- # types (even if no formal args are specified, there will be a single 'o'
- # entry):
- #
- # op The opcode
- #
- # i Integer register index
- # n Number register index
- # p PMC register index
- # s String register index
- #
- # ic Integer constant (in-line)
- # nc Number constant index
- # pc PMC constant index
- # sc String constant index
- # kc Key constant index
- # kic Integer Key constant index (in-line)
- #
-
- my $op_sig_RE = qr/
- ^
- (inline\s+)? # optional keywords
- op
- \s+
- ([a-zA-Z]\w*) # op name
- \s*
- \((.*)\) # argument signature
- \s*
- ((?: \:\w+\s*)*) # :flags
- \s*
- {
- $
- /x;
-
- if ($_ =~ $op_sig_RE) {
- if ($seen_op) {
- die "$ops_file [$.]: Cannot define an op within an op definition!\n";
- }
-
- $type = defined($1) ? 'inline' : 'function';
- $short_name = $2;
- $args = _trim( lc $3 );
- $flags = $4 ? _trim( lc $4 ) : "";
- @args = split( /\s*,\s*/, $args );
- @argdirs = ();
- @labels = ();
- $body = '';
- $seen_op = 1;
- $line = $. + 1;
-
- $flags = { map { $_ => undef } (split(/[ :]+/, $flags)) };
-
- my @temp;
-
- for my $arg (@args) {
- my ( $use, $type ) =
- $arg =~ m/^(in|out|inout|inconst|invar)
- \s+
- (INT|NUM|STR|PMC|KEY|INTKEY|LABEL)$/ix;
-
- die "Unrecognized arg format '$arg' in '$_'!"
- unless defined($use) and defined($type);
-
- # remember it's a label, then turn it to an int
- if ( $type =~ /^LABEL$/i ) {
- $type = 'i';
- push @labels, 1;
- }
- else {
- push @labels, 0;
- }
-
- if ( $type =~ /^INTKEY$/i ) {
- $type = 'ki';
- }
- else {
- $type = lc substr( $type, 0, 1 );
- }
-
- if ( $use eq 'in' ) {
- push @temp, "$type|${type}c";
- push @argdirs, 'i';
- }
- elsif ( $use eq 'invar' ) {
- push @temp, $type;
- push @argdirs, 'i';
- }
- elsif ( $use eq 'inconst' ) {
- push @temp, "${type}c";
- push @argdirs, 'i';
- }
- elsif ( $use eq 'inout' ) {
- push @temp, $type;
- push @argdirs, 'io';
- }
- else {
- push @temp, $type;
- push @argdirs, 'o';
- }
- }
-
- @args = @temp;
-
- next;
- }
-
- #
- # Handle end-of-op:
- #
- # We stash the accumulated body of source code in the Parrot::Op, push the
- # Parrot::Op onto our op array, and forget the op so we can start the next
- # one.
- #
-
- if (/^}\s*$/) {
- $count += $self->make_op(
- $count, $type, $short_name, $body, \@args, \@argdirs,
- $line, $orig, \@labels, $flags, $nolines
- );
-
- $seen_op = 0;
-
- next;
- }
-
- #
- # Accumulate the code into the op's body:
- #
-
- if ($seen_op) {
- $body .= $_;
- }
- else {
- die "Parrot::OpsFile: Unrecognized line: '$_'!\n";
- }
- }
-
- if ($seen_op) {
- die "Parrot::OpsFile: File ended with incomplete op definition!\n";
- }
-
- close $OPS or die "Could not close ops file '$file' ($!)!";
-
- return;
-}
-
-# Extends a string containing an or expression "0" .. "A" .. "A|B" etc.
-sub or_flag {
- my ( $flag, $value ) = @_;
-
- if ( $$flag eq '0' ) {
- $$flag = $value;
- }
- else {
- $$flag .= "|$value";
- }
-}
-
-=item C<make_op($code,
-$type, $short_name, $body, $args, $argdirs, $line, $file, $labels, $flags, $nolines)>
-
-Returns a new C<Parrot::Op> instance for the specified arguments.
-
-=cut
-
-sub make_op {
- my (
- $self, $code, $type, $short_name, $body, $args,
- $argdirs, $line, $file, $labels, $flags, $nolines
- ) = @_;
- my $counter = 0;
- my $branch = 0;
- my $pop = 0;
-
- if (exists($$flags{deprecated})) {
- $body = <<"END_CODE" . $body;
-INTVAL unused = PARROT_WARNINGS_test(interp,PARROT_WARNINGS_DEPRECATED_FLAG) &&
- fprintf(stderr,"Warning: instruction '$short_name' is deprecated\\n");
-END_CODE
-}
- unless (exists($$flags{flow})) {
- $body .= "\ngoto NEXT();";
- }
-
- foreach my $variant ( expand_args(@$args) ) {
- my (@fixedargs) = split( /,/, $variant );
- my $op =
- Parrot::Op->new( $code++, $type, $short_name, [@fixedargs], [@$argdirs], [@$labels],
- $flags );
- my $op_size = $op->size;
- my $jumps = "0";
-
- #
- # 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.).
- #
- if ($body =~ /(goto|restart)\s+OFFSET\(.*?\)/ || $short_name =~ /runinterp/) {
- $branch = 1;
- }
-
- $body =~ s/\bgoto\s+ADDRESS\(\( (.*?) \)\)/{{=$1}}/mg;
- $body =~ s/\bexpr\s+ADDRESS\(\( (.*?) \)\)/{{^$1}}/mg;
- $body =~ s/\bgoto\s+ADDRESS\((.*?)\)/{{=$1}}/mg;
- $body =~ s/\bexpr\s+ADDRESS\((.*?)\)/{{^$1}}/mg;
-
- $body =~ s/\bgoto\s+OFFSET\(\( (.*?) \)\)/{{+=$1}}/mg;
- $body =~ s/\bexpr\s+OFFSET\(\( (.*?) \)\)/{{^+$1}}/mg;
- $body =~ s/\bgoto\s+OFFSET\((.*?)\)/{{+=$1}}/mg;
- $body =~ s/\bexpr\s+OFFSET\((.*?)\)/{{^+$1}}/mg;
-
- $body =~ s/\bexpr\s+NEXT\(\)/{{^+$op_size}}/mg;
- $body =~ s/\bgoto\s+NEXT\(\)/{{+=$op_size}}/mg;
-
- $body =~ s/\brestart\s+OFFSET\((.*?)\)/{{=0,+=$1}}/mg;
- $body =~ s/\brestart\s+NEXT\(\)/{{=0,+=$op_size}}/mg;
- $body =~ s/\brestart\s+ADDRESS\((.*?)\)/{{=$1}}/mg;
-
- $body =~ s/\$(\d+)/{{\@$1}}/mg;
-
- # We can only reference as many parameters as we declare
- my $max_arg_num = @$args;
- my @found_args = ($body =~ m/{{@(\d+)}}/g);
- foreach my $arg (@found_args) {
- die "opcode '$short_name' uses '\$$arg' but only has $max_arg_num parameters.\n" if $arg > $max_arg_num;
- }
-
-
- 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;
-
- $op->jump($jumps);
- $self->push_op($op);
- $counter++;
- }
-
- return $counter;
-}
-
-=item C<expand_args(@args)>
-
-Given an argument list, returns a list of all the possible argument
-combinations.
-
-=cut
-
-sub expand_args {
- my (@args) = @_;
-
- return "" if ( !scalar(@args) );
-
- my $arg = shift(@args);
- my @var = split( /\|/, $arg );
-
- if ( !scalar(@args) ) {
- return @var;
- }
- else {
- my @list = expand_args(@args);
- my @results;
-
- foreach my $l (@list) {
- foreach my $v (@var) {
- push( @results, "$v,$l" );
- }
- }
-
- return @results;
- }
-}
-
-=item C<ops()>
-
-Returns the C<Parrot::Op> instances found in the file(s).
-
-=cut
-
-sub ops {
- my ($self) = @_;
-
- return @{ $self->{OPS} };
-}
-
-=item C<op($index)>
-
-Returns the op at C<$index>.
-
-=cut
-
-sub op {
- my ( $self, $index ) = @_;
-
- return $self->{OPS}[$index];
-}
-
-=item C<preamble()>
-
-=item C<preamble($trans)>
-
-Returns any lines found prior to first op definition.
-
-If C<$trans> (an C<Parrot::OpTrans> subclass) is supplied then
-substitutions are made.
-
-=cut
-
-sub preamble {
- my ( $self, $trans ) = @_;
-
- local $_ = $self->{PREAMBLE};
-
- if ($trans) {
- s/goto\s+OFFSET\((.*)\)/{{+=$1}}/mg;
-
- #s/goto\s+NEXT\(\)/{{+=$op_size}}/mg; #not supported--dependent on op size
- s/goto\s+ADDRESS\((.*)\)/{{=$1}}/mg;
-
- $_ = Parrot::Op->rewrite_body( $_, $trans, 'preamble' );
- }
-
- return $_;
-}
-
-=item C<version($major, $minor, $patch)>
-
-=item C<version($version)>
-
-=item C<version()>
-
-Sets/gets the version number.
-
-=cut
-
-sub version {
- my $self = shift;
-
- if ( @_ == 1 ) {
- $self->{VERSION} = shift;
- }
- elsif ( @_ == 3 ) {
- $self->{VERSION} = join( '.', @_ );
- }
- elsif ( @_ == 0 ) {
- if (wantarray) {
- return split( /\./, $self->{VERSION} );
- }
- else {
- return $self->{VERSION};
- }
- }
- else {
- die "Parrot::OpsFile::version(): Illegal argument count" . scalar(@_) . "!";
- }
-}
-
-=item C<major_version()>
-
-Returns the major version number.
-
-=cut
-
-sub major_version {
- my $self = shift;
-
- $self->{VERSION} =~ m/^(\d+)\./;
-
- return $1;
-}
-
-=item C<minor_version()>
-
-Returns the minor version number.
-
-=cut
-
-sub minor_version {
- my $self = shift;
-
- $self->{VERSION} =~ m/^\d+\.(\d+)\./;
-
- return $1;
-}
-
-=item C<patch_version()>
-
-Returns the patch version number.
-
-=cut
-
-sub patch_version {
- my $self = shift;
-
- $self->{VERSION} =~ m/^\d+\.\d+\.(\d+)/;
-
- return $1;
-}
-
-=item C<push_op($op)>
-
-Adds C<$op> to the end of the op list.
-
-=cut
-
-sub push_op {
- my ( $self, $op ) = @_;
-
- push @{ $self->{OPS} }, $op;
-}
-
-=back
-
-=head1 SEE ALSO
-
-=over 4
-
-=item C<Parrot::Op>
-
-=item C<Parrot::OpTrans>
-
-=item F<tools/build/ops2c.pl>
-
-=item F<tools/build/ops2pm.pl>
-
-=item F<tools/build/pbc2c.pl>
-
-=back
-
-=cut
-
-1;
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Deleted: trunk/lib/Parrot/OpsRenumber.pm
==============================================================================
--- trunk/lib/Parrot/OpsRenumber.pm Mon May 24 07:59:36 2010 (r46944)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,190 +0,0 @@
-# Copyright (C) 2007, Parrot Foundation.
-# $Id$
-package Parrot::OpsRenumber;
-use strict;
-use warnings;
-use lib qw ( lib );
-use base qw( Parrot::Ops2pm::Base );
-
-=head1 NAME
-
-Parrot::OpsRenumber - Methods holding functionality for F<tools/dev/opsrenumber.pl>.
-
-=head1 SYNOPSIS
-
- use Parrot::OpsRenumber;
-
- $self = Parrot::OpsRenumber->new( {
- argv => [ @ARGV ],
- moddir => "lib/Parrot/OpLib",
- module => "core.pm",
- inc_dir => "include/parrot/oplib",
- inc_f => "ops.h",
- script => "tools/dev/opsrenumber.pl",
- } );
-
- $self->prepare_ops();
- $self->renum_op_map_file();
-
-=cut
-
-=head1 DESCRIPTION
-
-Parrot::OpsRenumber provides methods called by F<tools/dev/opsrenumber.pl>.
-
-=head1 METHODS
-
-=head2 C<new()>
-
-Inherited from Parrot::Ops2pm::Base and documented in
-F<lib/Parrot/Ops2pm/Base.pm>.
-
-=head2 C<prepare_ops()>
-
-Inherited from Parrot::Ops2pm::Base and documented in
-F<lib/Parrot/Ops2pm/Base.pm>.
-
-=head2 C<renum_op_map_file()>
-
-=over 4
-
-=item * Purpose
-
-This method renumbers F<src/ops/ops.num> based on the already
-existing file of that name and additional F<.ops> files.
-
-=item * Arguments
-
-Two scalars. First is Parrot major version number. Second is optional:
-string holding name of an F<.ops> file; defaults to F<src/ops/ops.num>.
-(Implicitly requires that the C<argv> and C<script> elements were provided to
-the constructor.)
-
-=item * Return Value
-
-Returns true value upon success.
-
-=back
-
-=cut
-
-
-my $OPSENUM_PREAMBLE =<<END;
-/* ex: set ro ft=c:
- * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
- *
- * This file is generated automatically from 'lib/Parrot/OpsRenumber.pm'.
- *
- * Any changes made here will be lost!
- *
- */
-#ifndef OPSENUM_H_GUARD
-#define OPSENUM_H_GUARD
-enum OPS_ENUM {
-END
-
-my $OPSENUM_POSTAMBLE =<<END;
-};
-#endif /* OPSENUM_H_GUARD */
-/* GENERATED BY lib/Parrot/OpsRenumber.pm */
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
-END
-
-sub renum_op_map_file {
- my $self = shift;
-
- my $file = $self->{num_file};
-
- # We open up the currently existing ops.num and file and read it
- # line-by-line. That file is basically divided into two halves
- # separated by the ###DYNAMIC### line. Above that line are found
- # (a) # inline comments and
- # (b) the first 7, never-to-be-altered opcodes.
- # Below that line are all the remaining opcodes. All opcode lines
- # match the pattern /^(\w+)\s+(\d+)$/. Everything above the line gets
- # pushed into @lines and, if it's an opcode line, gets split and
- # pushed into %fixed as well. Nothing happens to the (opcode) lines
- # below the DYNAMIC line.
-
- my ( $name, $number, @lines, %seen, %fixed, $fix );
- $fix = 1;
- open my $OP, '<', $file
- or die "Can't open $file, error $!";
- while (<$OP>) {
- push @lines, $_ if $fix;
- chomp;
- $fix = 0 if /^###DYNAMIC###/;
- s/#.*$//;
- s/\s*$//;
- s/^\s*//;
- next unless $_;
- ( $name, $number ) = split( /\s+/, $_ );
- $seen{$name} = 1;
- $fixed{$name} = $number if $fix;
- }
- close $OP;
-
- # Now we re-open the very same file we just read -- this time for
- # writing. We directly print all the lines in @lines, i.e., those
- # above the DYNAMIC line. For the purpose of renumbering, we create
- # an index $n.
-
- my $opsenumfn = $self->{opsenum_file};
- open my $OPSENUM, '>', $opsenumfn or die "Can't open $opsenumfn, error $!";
- print $OPSENUM $OPSENUM_PREAMBLE;
- open $OP, '>', $file
- or die "Can't open $file, error $!";
- print $OP @lines;
- my ($n);
-
- # We can't use all autogenerated ops from oplib/core
- # there are unwanted permutations like 'add_i_ic_ic
- # which aren't opcodes but calculated at compile-time.
-
- # The ops element is set by prepare_ops(), which is inherited from
- # Parrot::Ops2pm::Base. prepare_ops(), in turn, works off
- # Parrot::OpsFile.
-
- # So whether a particular opcode will continue to appear in ops.num
- # depends entirely on whether or not it's found in
- # @{ $self->{ops}->{OPS} }. If a particular opcode has been deleted or
- # gone missing from that array, then it won't appear in the new
- # ops.num.
-
- for ( @{ $self->{ops}->{OPS} } ) {
-
- # To account for the number of opcodes above the line, we'll
- # increment the index by one for every element in %fixed.
-
- if ( defined $fixed{ $_->full_name } ) {
- $n = $fixed{ $_->full_name };
- }
-
- # For all other opcodes, we'll print the opcode, increment the
- # index, then print the index on that same line.
-
- elsif ( $seen{ $_->full_name } ) {
- printf $OP "%-31s%4d\n", $_->full_name, ++$n;
- printf $OPSENUM " enum_ops_%-31s= %4d,\n", $_->full_name, $n;
- }
- }
- close $OP;
- print $OPSENUM $OPSENUM_POSTAMBLE;
- close $OPSENUM;
-
- return 1;
-}
-
-1;
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
More information about the parrot-commits
mailing list