[svn:parrot] r46679 - in branches/ops_pct: . lib/Parrot lib/Parrot/Docs/Section lib/Parrot/OpTrans lib/Parrot/Ops2c lib/Parrot/Ops2pm tools/build
cotto at svn.parrot.org
cotto at svn.parrot.org
Sat May 15 18:23:56 UTC 2010
Author: cotto
Date: Sat May 15 18:23:55 2010
New Revision: 46679
URL: https://trac.parrot.org/parrot/changeset/46679
Log:
[ops2c] nuke a bunch of obsolete perl ops2c and ops2pm code
Deleted:
branches/ops_pct/lib/Parrot/Op.pm
branches/ops_pct/lib/Parrot/OpTrans/
branches/ops_pct/lib/Parrot/OpTrans.pm
branches/ops_pct/lib/Parrot/Ops2c/
branches/ops_pct/lib/Parrot/Ops2pm.pm
branches/ops_pct/lib/Parrot/Ops2pm/Auxiliary.pm
branches/ops_pct/lib/Parrot/Ops2pm/Base.pm
branches/ops_pct/lib/Parrot/OpsFile.pm
branches/ops_pct/tools/build/ops2pm.pl
Modified:
branches/ops_pct/MANIFEST
branches/ops_pct/lib/Parrot/Distribution.pm
branches/ops_pct/lib/Parrot/Docs/Section/Ops.pm
branches/ops_pct/lib/Parrot/Docs/Section/Perl.pm
Modified: branches/ops_pct/MANIFEST
==============================================================================
--- branches/ops_pct/MANIFEST Sat May 15 18:22:15 2010 (r46678)
+++ branches/ops_pct/MANIFEST Sat May 15 18:23:55 2010 (r46679)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Fri May 14 15:26:02 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sat May 15 17:15:58 2010 UT
#
# See below for documentation on the format of this file.
#
@@ -188,6 +188,7 @@
config/auto/env.pm []
config/auto/env/test_setenv_c.in []
config/auto/env/test_unsetenv_c.in []
+config/auto/extra_nci_thunks.pm []
config/auto/format.pm []
config/auto/frames.pm []
config/auto/frames/test_exec_cygwin_c.in []
@@ -879,6 +880,7 @@
ext/nqp-rx/src/stage0/NQP-s0.pir []
ext/nqp-rx/src/stage0/P6Regex-s0.pir []
ext/nqp-rx/src/stage0/Regex-s0.pir []
+ext/nqp-rx/src/stage0/nqp-setting.pm []
ext/nqp-rx/t/nqp/01-literals.t [test]
ext/nqp-rx/t/nqp/02-if.t [test]
ext/nqp-rx/t/nqp/03-if-else.t [test]
@@ -977,6 +979,7 @@
include/parrot/op.h [main]include
include/parrot/oplib.h [main]include
include/parrot/oplib/core_ops.h [main]include
+include/parrot/oplib/ops.h [main]include
include/parrot/packfile.h [main]include
include/parrot/parrot.h [main]include
include/parrot/platform_interface.h [main]include
@@ -1058,15 +1061,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
@@ -1952,6 +1946,7 @@
t/steps/auto/cpu-01.t [test]
t/steps/auto/ctags-01.t [test]
t/steps/auto/env-01.t [test]
+t/steps/auto/extra_nci_thunks-01.t [test]
t/steps/auto/format-01.t [test]
t/steps/auto/frames-01.t [test]
t/steps/auto/gc-01.t [test]
@@ -2050,6 +2045,8 @@
t/tools/install/testlib/src/pmc/pmc_object.h [test]
t/tools/install/testlib/tools/build/ops2c.pl [test]
t/tools/install/testlib/vtable.dump [test]
+t/tools/ops2cutils [test]
+t/tools/ops2pm [test]
t/tools/parrot_debugger.t [test]
t/tools/pbc_disassemble.t [test]
t/tools/pbc_dump.t [test]
@@ -2069,7 +2066,6 @@
tools/build/h2inc.pl []
tools/build/headerizer.pl []
tools/build/ops2c.pl [devel]
-tools/build/ops2pm.pl []
tools/build/parrot_config_c.pl []
tools/build/pbcversion_h.pl []
tools/build/pmc2c.pl [devel]
@@ -2147,6 +2143,7 @@
tools/util/release.json []
tools/util/templates.json []
tools/util/update_copyright.pl []
+update []
# Local variables:
# mode: text
# buffer-read-only: t
Modified: branches/ops_pct/lib/Parrot/Distribution.pm
==============================================================================
--- branches/ops_pct/lib/Parrot/Distribution.pm Sat May 15 18:22:15 2010 (r46678)
+++ branches/ops_pct/lib/Parrot/Distribution.pm Sat May 15 18:23:55 2010 (r46679)
@@ -708,7 +708,7 @@
> ),
map( "lib/Parrot/$_" => qw<
Config Configure Configure/Step Docs Docs/Section IO
- OpTrans PIR Pmc2c Test
+ PIR Pmc2c Test
> ),
;
}
Modified: branches/ops_pct/lib/Parrot/Docs/Section/Ops.pm
==============================================================================
--- branches/ops_pct/lib/Parrot/Docs/Section/Ops.pm Sat May 15 18:22:15 2010 (r46678)
+++ branches/ops_pct/lib/Parrot/Docs/Section/Ops.pm Sat May 15 18:23:55 2010 (r46679)
@@ -57,7 +57,6 @@
'Tools',
'',
$self->new_item( '', 'tools/build/ops2c.pl' ),
- $self->new_item( '', 'tools/build/ops2pm.pl' ),
),
$self->new_group( 'Opcode Libraries', '', @core_ops ),
$self->new_group( 'Dynamic Opcode Libraries', '', @dynamic_ops ),
Modified: branches/ops_pct/lib/Parrot/Docs/Section/Perl.pm
==============================================================================
--- branches/ops_pct/lib/Parrot/Docs/Section/Perl.pm Sat May 15 18:22:15 2010 (r46678)
+++ branches/ops_pct/lib/Parrot/Docs/Section/Perl.pm Sat May 15 18:23:55 2010 (r46679)
@@ -40,15 +40,6 @@
'perl.html',
'',
$self->new_group(
- 'Operations',
- '',
- $self->new_item(
- 'Ops to C Code Generation',
- 'lib/Parrot/OpsFile.pm', 'lib/Parrot/Op.pm',
- 'lib/Parrot/OpTrans.pm', 'lib/Parrot/OpTrans'
- ),
- ),
- $self->new_group(
'PMCs', '', 'lib/Parrot/Pmc2c', 'lib/Parrot/Pmc2c/PMC',
$self->new_item( '', 'lib/Parrot/Vtable.pm' ),
),
Deleted: branches/ops_pct/lib/Parrot/Op.pm
==============================================================================
--- branches/ops_pct/lib/Parrot/Op.pm Sat May 15 18:23:55 2010 (r46678)
+++ /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: branches/ops_pct/lib/Parrot/OpTrans.pm
==============================================================================
--- branches/ops_pct/lib/Parrot/OpTrans.pm Sat May 15 18:23:55 2010 (r46678)
+++ /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: branches/ops_pct/lib/Parrot/Ops2pm.pm
==============================================================================
--- branches/ops_pct/lib/Parrot/Ops2pm.pm Sat May 15 18:23:55 2010 (r46678)
+++ /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: branches/ops_pct/lib/Parrot/Ops2pm/Auxiliary.pm
==============================================================================
--- branches/ops_pct/lib/Parrot/Ops2pm/Auxiliary.pm Sat May 15 18:23:55 2010 (r46678)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,121 +0,0 @@
-# Copyright (C) 2007, Parrot Foundation.
-# $Id$
-package Parrot::Ops2pm::Auxiliary;
-use strict;
-use warnings;
-use vars qw(@ISA @EXPORT_OK);
- at ISA = qw( Exporter );
- at EXPORT_OK = qw( Usage getoptions );
-use Getopt::Long;
-
-sub Usage {
- print STDERR <<_EOF_;
-usage: tools/build/ops2pm.pl [--help] [--no-lines] input.ops [input2.ops ...]
-_EOF_
- return 1;
-}
-
-sub getoptions {
- my %flags;
- GetOptions(
- "no-lines" => \$flags{nolines},
- "help" => \$flags{help},
- "renum" => \$flags{renum},
- );
- return \%flags;
-}
-
-1;
-
-#################### DOCUMENTATION ####################
-
-=head1 NAME
-
-Parrot::Ops2pm::Auxiliary - Non-method subroutines holding functionality for F<tools/build/ops2pm.pl>.
-
-=head1 SYNOPSIS
-
- use Parrot::Ops2pm::Auxiliary qw( Usage getoptions );
-
- Usage();
-
- $flagref = getoptions();
-
-=cut
-
-=head1 DESCRIPTION
-
-Parrot::Ops2pm::Auxiliary provides subroutines called by F<tools/build/ops2pm.pl>, a
-program which is called at the very beginning of the Parrot F<make> process.
-This package is intended to hold subroutines used by that program I<other
-than> the object-oriented methods provided by Parrot::Ops2pm.
-
-Extraction of the subroutines exported by this package from
-F<tools/build/ops2pm.pl> facilitates the testing of their functionality by the
-tests in F<t/tools/ops2pm/*.t>.
-
-=head1 SUBROUTINES
-
-=head2 C<Usage()>
-
-=over 4
-
-=item * Purpose
-
-Display a short description of how to use F<tools/build/ops2pm.pl> on
-standard output.
-
- usage: tools/build/ops2pm.pl [--help] [--no-lines] input.ops [input2.ops ...]
-
-=item * Arguments
-
-None.
-
-=item * Return Value
-
-Implicitly returns true upon successful printing.
-
-=back
-
-=head2 C<getoptions>
-
-=over 4
-
-=item * Purpose
-
-Process arguments provided on command-line to F<tools/build/ops2pm.pl>.
-
-=item * Arguments
-
-None.
-
-=item * Return Value
-
-Hash reference where any of the following keys may or may not be defined.
-
- no-lines
- help
- renum
-
-=item * Comment
-
-A wrapper around Getopt::Long::GetOptions() designed to assure testability.
-
-=back
-
-=head1 AUTHOR
-
-Jim Keenan (refactoring code originally found in F<tools/build/ops2pm.pl>).
-
-=head1 SEE ALSO
-
-Parrot::Ops2pm. F<tools/build/ops2pm.pl>.
-
-=cut
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Deleted: branches/ops_pct/lib/Parrot/Ops2pm/Base.pm
==============================================================================
--- branches/ops_pct/lib/Parrot/Ops2pm/Base.pm Sat May 15 18:23:55 2010 (r46678)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,191 +0,0 @@
-# Copyright (C) 2007, Parrot Foundation.
-# $Id$
-package Parrot::Ops2pm::Base;
-use strict;
-use warnings;
-use Cwd;
-use File::Spec;
-use lib qw ( lib );
-use Parrot::OpsFile;
-
-=head1 NAME
-
-Parrot::Ops2pm::Base - Methods inherited by Parrot::Ops2pm and Parrot::OpsRenumber.
-
-=head1 SYNOPSIS
-
- use base qw( Parrot::Ops2pm::Base );
-
- $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();
-
-=cut
-
-=head1 DESCRIPTION
-
-Parrot::Ops2pm::Base provides a constructor and other method(s) to be
-inherited by Parrot::Ops2pm and Parrot::OpsRenumber. The former 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 latter is called by
-F<tools/dev/opsrenumber.pl>.
-
-=head1 METHODS
-
-=head2 C<new()>
-
-=over 4
-
-=item * Purpose
-
-Process files provided as command-line arguments to
-F<tools/build/ops2pm.pl> and construct a Parrot::Ops2pm object.
-
-=item * Arguments
-
-Hash reference with the following elements:
-
- argv : reference to @ARGV
- nolines : set to true value to eliminate #line
- directives in output
- moddir : directory where output module is created
- (generally, lib/Parrot/OpLib)
- module : name of output module
- (generally, core.pm)
- inc_dir : directory where C-header file is created
- (generally, include/parrot/oplib)
- inc_f : name of output C-header file
- (generally, ops.h)
- script : name of the script to be executed by 'make'
- (generally, either tools/build/ops2pm.pl
- or tools/dev/opsrenumber.pl)
-
-=item * Return Value
-
-Object of the invoking class (Parrot::Ops2pm or Parrot::OpsRenumber, as the
-case may be).
-
-=item * Comment
-
-Arguments for the constructor have been selected so as to provide
-subsequent methods with all information needed to execute properly and to be
-testable. A Parrot::Ops2pm object I<can> be constructed lacking some
-of these arguments and still suffice for the execution of particular methods
--- this is done during the test suite -- but such an object would not suffice
-for F<make>'s call to F<tools/build/ops2pm.pl>.
-
-=back
-
-=cut
-
-sub new {
- my ( $class, $argsref ) = @_;
- my @argv = @{ $argsref->{argv} };
- my $file = shift @argv;
- die "$argsref->{script}: Could not find ops file '$file'!\n"
- unless -e $file;
- $argsref->{file} = $file;
- $argsref->{argv} = \@argv;
- $argsref->{num_file} = "src/ops/ops.num";
- $argsref->{skip_file} = "src/ops/ops.skip";
- $argsref->{opsenum_file} = File::Spec->catfile(
- cwd(), qw( include parrot opsenum.h )
- );
- return bless $argsref, $class;
-}
-
-=head2 C<prepare_ops()>
-
-=over 4
-
-=item * Purpose
-
-Call C<Parrot::OpsFile::new()>, then populate the resulting
-C<$opts> hash reference with information from each of the F<.ops> files
-provided as command-line arguments to F<tools/build/ops2pm.pl>.
-
-=item * Arguments
-
-None. (Implicitly requires that at least the C<argv> and
-C<script> elements were provided to the constructor.)
-
-=item * Return Value
-
-None. Internally, sets the C<ops> key in the object's data
-structure.
-
-=item * Comment
-
-This method calls C<Parrot::OpsFile::new()> on the first F<.ops>
-file found in C<@ARGV>, then copies the ops from the remaining F<.ops> files
-to the object just created. Experimental ops are marked as such.
-
-=back
-
-=cut
-
-sub prepare_ops {
- my $self = shift;
- my $ops = Parrot::OpsFile->new( [ $self->{file} ], $self->{nolines} );
- die "$self->{script}: Could not read ops file '$self->{file}'!\n"
- unless defined $ops;
-
- # Copy the ops from the remaining .ops files to the object just created.
- my %seen;
-
- while ( defined( my $f = shift( @{ $self->{argv} } ) ) ) {
- if ( $seen{$f} ) {
- print STDERR "$self->{script}: Ops file '$f' mentioned more than once!\n";
- next;
- }
- $seen{$f} = 1;
-
- die "$self->{script}: Could not find ops file '$f'!\n"
- unless -e $f;
- my $temp_ops = Parrot::OpsFile->new( [$f], $self->{nolines} );
- die "$self->{script}: Could not read ops file '$f'!\n"
- unless defined $temp_ops;
-
- my $experimental = $f =~ /experimental/;
-
- if (! ref $temp_ops->{OPS}) {
- my $message = "OPS invalid for $f";
- if ($experimental) {
- # empty experimental.ops file is OK.
- warn $message;
- next;
- }
- else {
- die $message;
- }
- }
-
- # mark experimental ops
- if ($experimental) {
- for my $el ( @{ $temp_ops->{OPS} } ) {
- $el->{experimental} = 1;
- }
- }
-
- push @{ $ops->{OPS} }, @{ $temp_ops->{OPS} };
- $ops->{PREAMBLE} .= "\n" . $temp_ops->{PREAMBLE};
- }
- $self->{ops} = $ops;
-}
-
-1;
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Deleted: branches/ops_pct/lib/Parrot/OpsFile.pm
==============================================================================
--- branches/ops_pct/lib/Parrot/OpsFile.pm Sat May 15 18:23:55 2010 (r46678)
+++ /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: branches/ops_pct/tools/build/ops2pm.pl
==============================================================================
--- branches/ops_pct/tools/build/ops2pm.pl Sat May 15 18:23:55 2010 (r46678)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,164 +0,0 @@
-#! perl
-# Copyright (C) 2001-2007, Parrot Foundation.
-# $Id$
-
-use strict;
-use warnings;
-
-use lib 'lib';
-use Parrot::Ops2pm;
-use Parrot::Ops2pm::Auxiliary qw( Usage getoptions );
-
-my $flagref = getoptions();
-
-if ( $flagref->{help} or !@ARGV ) {
- Usage();
- exit;
-}
-
-my $self = Parrot::Ops2pm->new(
- {
- argv => [@ARGV],
- nolines => $flagref->{nolines},
- renum => $flagref->{renum},
- 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;
-
-################### DOCUMENTATION ####################
-
-=head1 NAME
-
-tools/build/ops2pm.pl - Generate Perl module from operation definitions
-
-=head1 SYNOPSIS
-
- $ perl tools/build/ops2pm.pl [--help] [--no-lines] input.ops [input2.ops ...]
- $ perl tools/build/ops2pm.pl [--renum] input.ops [input2.ops ...]
-
-=head1 DESCRIPTION
-
-Reads the ops files listed on the command line and outputs a
-F<Parrot::OpLib::core> module containing information about the ops.
-Also outputs F<include/parrot/oplib/ops.h>. This program is called by Parrot's
-F<make>.
-
-If called with the C<--renum> flag, renumbers the file F<src/ops/ops.num>.
-This is mandatory when adding or removing opcodes.
-
-=head1 OPTIONS
-
-=over 4
-
-=item C<--help>
-
-Print synopsis.
-
-=item C<--no-lines>
-
-Do not generate C<#line> directives in the generated C code.
-
-=item C<--renum>
-
-Renumber opcodes according to existing ops in ops/num and natural
-order in the given ops files. See also F<tools/dev/ops_renum.mak>.
-
-=back
-
-Most of the functionality in this program is now held in Parrot::Ops2pm::Util
-methods and a small number of Parrot::Ops2pm::Auxiliary subroutines.
-See those modules' documentation for discussion of those functions.
-Revisions to the functionality should be made in those packages and tested
-against tests found in F<t/tools/ops2pm/>.
-
-=head1 WARNING
-
-Generating a C<Parrot::OpLib::core> module for a set of ops files that
-you do not later turn into C code (see F<tools/build/ops2c.pl>) with the
-same op content and order is a recipe for disaster. But as long as you
-just run these tools in the standard build process via C<make> there
-shouldn't be a problem.
-
-=head1 TODO
-
-The original design of the ops processing code was intended to be
-a read-only representation of what was in a particular ops file. It was
-not originally intended that it was a mechanism for building a bigger
-virtual ops file from multiple physical ops files.
-
-This code does half of that job (the other half is getting them to
-compile together instead of separately in a F<*_ops.c> file).
-
-You can see evidence of this by the way this code reaches in to the
-internal C<OPS> hash key to do its concatenation, and the way it
-twiddles each op's C<CODE> hash key after that.
-
-If the op and oplib Perl modules are going to be used for modifying
-information read from ops files in addition to reading it, they should
-be changed to make the above operations explicitly supported.
-
-Otherwise, the Parrot build and interpreter start-up logic should be
-modified so that it doesn't need to concatenate separate ops files.
-
-=head1 SEE ALSO
-
-=over 4
-
-=item F<tools/build/ops2c.pl>.
-
-=item F<lib/Parrot/Ops2pm.pm>.
-
-=item F<lib/Parrot/Ops2pm/Auxiliary.pm>.
-
-=item F<tools/dev/ops_renum.mak>.
-
-=back
-
-=head1 AUTHOR
-
-Over the years, F<tools/build/ops2pm.pl> has been worked on by the following Parrot hackers:
-
- bernhard
- brentdax
- chip
- chromatic
- coke
- dan
- gregor
- jkeenan
- leo
- mikescott
- particle
- paultcochrane
- petdance
- robert
- simon
- tewk
-
-Others who provided code cited in the version control logs include:
-
- Andy Dougherty
- Jeff Gof
- Steve Fink
-
-=cut
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
More information about the parrot-commits
mailing list