<commit_before>#! perl
# Copyright (C) 2001-2006, The Perl Foundation.
# $Id$

=head1 NAME

tools/build/ops2c.pl - Parser for .ops files

=head1 SYNOPSIS

    % perl tools/build/ops2c.pl trans [--help] [--no-lines] [--dynamic]
                                      [--core | input.ops [input2.ops ...]]
       trans := C | CGoto | CGP | CSwitch | CPrederef

For example:

    % perl tools/build/ops2c.pl C --core

    % perl tools/build/ops2c.pl C --dynamic myops.ops

=head1 DESCRIPTION

This script uses a supplied transform to create a pair of C header and
implementation files from the operation definitions found in one or more
F<*.ops> files.

=head2 Transforms

The first command-line argument is the last package name component of a
subclass of C<Parrot::OpTrans>. These subclasses all have full names of
the form C<Parrot::OpTrans::*>. An instance of the class is created and
later consulted for various bits of information needed to generate the C
code. Each creates a different type of run loop.

=over

=item C<C>

Create the function-based (slow or fast core) run loop.

=item C<CGoto>

Create the C<goto> run loop.

=item C<CGP>

Create the C<goto> and predereferenced run loop.

=item C<CSwitch>

Create the C<switch>ed and predereferenced run loop.

=item C<CPrederef>

Create the predereferenced run loop.

=back

=head2 Options

=over 4

=item C<--help>

Print synopsis.

=item C<--dynamic>

Indicate that the opcode library is dynamic.

=item C<--core>

Build the Parrot core opcode library.

=item C<--no-lines>

Do not generate C<#line> directives in the generated C code.

=back

=head1 SEE ALSO

=over 4

=item F<tools/build/ops2pm.pl>

=item C<Parrot::OpsFile>

=item C<Parrot::Op>

=item C<Parrot::OpTrans>

=item C<Parrot::OpTrans::C>

=item C<Parrot::OpTrans::CGoto>

=item C<Parrot::OpTrans::Compiled>

=item C<Parrot::OpTrans::CGP>

=item C<Parrot::OpTrans::CSwitch>

=item C<Parrot::OpTrans::CPrederef>

=back

=cut

use warnings;
use strict;
use lib 'lib';

use Pod::Usage;
use Getopt::Long qw(:config permute);

use Parrot::OpsFile;
use Parrot::OpLib::core;
use Parrot::Config;

my %arg_dir_mapping = (
    ''   => 'PARROT_ARGDIR_IGNORED',
    'i'  => 'PARROT_ARGDIR_IN',
    'o'  => 'PARROT_ARGDIR_OUT',
    'io' => 'PARROT_ARGDIR_INOUT'
);

#
# Look at the command line options
#
sub Usage {
    pod2usage(-exitval => 1, -verbose => 0, -output => \*STDERR);
}

my ( $nolines_flag, $help_flag, $dynamic_flag, $core_flag );
GetOptions(
    "no-lines"      => \$nolines_flag,
    "help"          => \$help_flag,
    "dynamic|d"     => \$dynamic_flag,
    "core"          => \$core_flag,
) || Usage();

Usage() if $help_flag;
Usage() unless @ARGV;

my $class_name = shift @ARGV;
my %is_allowed = map { $_ => 1 } qw(C CGoto CGP CSwitch CPrederef);
Usage() unless $is_allowed{$class_name};
my $trans_class = "Parrot::OpTrans::" . $class_name;

eval "require $trans_class";

my $trans = $trans_class->new();

# Not used
my $prefix  = $trans->prefix();
my $suffix  = $trans->suffix();
# Used as ${defines}
my $defines = $trans->defines();
my $opsarraytype = $trans->opsarraytype();
my $core_type = $trans->core_type();

my $file = $core_flag ? 'core.ops' : shift @ARGV;

my $base = $file;
$base =~ s/\.ops$//;

my $incdir  = "include/parrot/oplib";
my $include = "parrot/oplib/${base}_ops${suffix}.h";
my $header  = "include/$include";
# SOURCE is closed and reread, which confuses make -j
# create a temp file and rename it
my $source  = "src/ops/${base}_ops${suffix}.c.temp";

if ($base =~ m!^src/dynoplibs/! || $dynamic_flag) {
    $source  =~ s!src/ops/!!;
    $header = "${base}_ops${suffix}.h";
    $base =~ s!^.*[/\\]!!;
    $include = "${base}_ops${suffix}.h";
    $dynamic_flag = 1;
}

my $sym_export = $dynamic_flag ? 'PARROT_DYNEXT_EXPORT' : 'PARROT_API';

my %hashed_ops;

#
# Read the input files:
#

my $ops;
if ($core_flag) {
    $ops = Parrot::OpsFile->new( [ "src/ops/$file" ], $nolines_flag );
    $ops->{OPS} = $Parrot::OpLib::core::ops;
    $ops->{PREAMBLE} = $Parrot::OpLib::core::preamble;
}
else {
    my %opsfiles;
    my @opsfiles;

    foreach my $opsfile ($file, @ARGV) {
        if ($opsfiles{$opsfile}) {
            print STDERR "$0: Ops file '$opsfile' mentioned more than once!\n";
            next;
        }

        $opsfiles{$opsfile} = 1;
        push @opsfiles, $opsfile;

        die "$0: Could not read ops file '$opsfile'!\n" unless -r $opsfile;
    }

    $ops = Parrot::OpsFile->new( \@opsfiles, $nolines_flag );

    my $cur_code = 0;
    for(@{$ops->{OPS}}) {
        $_->{CODE}=$cur_code++;
    }
}


my $version       = $ops->version;
my $major_version = $ops->major_version;
my $minor_version = $ops->minor_version;
my $patch_version = $ops->patch_version;
my $num_ops     = scalar $ops->ops;
my $num_entries = $num_ops + 1; # For trailing NULL


#
# Open the output files:
#

if (!$dynamic_flag && ! -d $incdir) {
    mkdir($incdir, 0755) or die "ops2c.pl: Could not mkdir $incdir $!!\n";
}

open HEADER, ">$header"
    or die "ops2c.pl: Cannot open header file '$header' for writing: $!!\n";

open SOURCE, ">$source"
    or die "ops2c.pl: Cannot open source file '$source' for writing: $!!\n";


#
# Print the preamble for the HEADER and SOURCE files:
#

my $preamble = <<END_C;
/* ex: set ro:
 * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 *
 * This file is generated automatically from '$file' (and possibly other
 * .ops files). by $0.
 *
 * Any changes made here will be lost!
 *
 */

END_C

my $mmp_v = "${major_version}_${minor_version}_${patch_version}";
my $init_func = "Parrot_DynOp_${base}${suffix}_$mmp_v";

print HEADER $preamble;
if ($dynamic_flag) {
    print HEADER "#define PARROT_IN_EXTENSION\n";
}
print HEADER <<END_C;
#include "parrot/parrot.h"
#include "parrot/oplib.h"

$sym_export extern op_lib_t *$init_func(long init);

END_C
my $cg_func = $trans->core_prefix . $base;


if ($trans->can("run_core_func_decl")) {
    my $run_core_func = $trans->run_core_func_decl($base);
    print HEADER "$run_core_func;\n";
}
my $bs = "${base}${suffix}_";

print SOURCE $preamble;
print SOURCE <<END_C;
#include "$include"

${defines}
static op_lib_t ${bs}op_lib;

END_C

my $text = $ops->preamble($trans);
$text =~ s/\bops_addr\b/${bs}ops_addr/g;
print SOURCE $text;


if ($trans->can("ops_addr_decl")) {
    print SOURCE $trans->ops_addr_decl($bs);
}
if ($trans->can("run_core_func_decl")) {
    print SOURCE $trans->run_core_func_decl($base);
    print SOURCE "\n{\n";
    print SOURCE $trans->run_core_func_start;
}

#
# Iterate over the ops, appending HEADER and SOURCE fragments:
#

my @op_funcs;
my @op_func_table;
my @cg_jump_table;
my $index = 0;
my ($prev_src, $prev_index);

$prev_src = '';
foreach my $op ($ops->ops) {
    my $func_name  = $op->func_name($trans);
    my $arg_types  = "$opsarraytype *, Interp *";
    my $prototype  = "$sym_export $opsarraytype * $func_name ($arg_types)";
    my $args       = "$opsarraytype *cur_opcode, Interp * interpreter";
    my $definition;
    my $comment    = '';
    my $one_op     = "";

    if ($suffix =~ /cg/) {
	$definition = "PC_$index:";
	$comment    = "/* ". $op->full_name() ." */";
    } elsif ($suffix =~ /switch/) {
	$definition = "case $index:";
	$comment    = "/* ". $op->full_name() ." */";
    }
    else {
        $definition = "$prototype;\n$opsarraytype *\n$func_name ($args)";
    }

    my $src = $op->source($trans);
    $src    =~ s/\bop_lib\b/${bs}op_lib/;
    $src    =~ s/\bops_addr\b/${bs}ops_addr/g;

    if ($suffix =~ /cg/) {
	if ($prev_src eq $src) {
	    push @cg_jump_table, "        &&PC_$prev_index,\n";
	}
	else {
	    push @cg_jump_table, "        &&PC_$index,\n";
	}
    }
    elsif ($suffix eq '') {
        push @op_func_table, sprintf("  %-50s /* %6ld */\n",
            "$func_name,", $index);
    }
    if ($prev_src eq $src) {
	push @op_funcs, "$comment\n";
    }
    else {
	$one_op .= "$definition $comment {\n$src}\n\n";
	push @op_funcs, $one_op;
	$prev_src = $src if ($suffix eq '_cgp' || $suffix eq '_switch');
    }
    $prev_index = $index;
    $index++;
}

if ($suffix =~ /cg/) {
    print SOURCE @cg_jump_table;
    print SOURCE <<END_C;
        NULL
    };
END_C
    print SOURCE $trans->run_core_after_addr_table($bs);
}

if ($suffix =~ /cgp/) {
    print SOURCE <<END_C;
#ifdef __GNUC__
# ifdef I386
    else if (cur_opcode == (opcode_t *) 1)
    asm ("jmp *4(%ebp)");	/* jump to ret addr, used by JIT */
# endif
#endif
    _reg_base = (char*)interpreter->ctx.bp.regs_i;
    goto *((void *)*cur_opcode);

END_C
} elsif ($suffix =~ /cg/) {
    print SOURCE <<END_C;
goto *${bs}ops_addr[*cur_opcode];
<commit_msg>[ops] conflate opcode bodies - 2<commit_after>#! perl
# Copyright (C) 2001-2006, The Perl Foundation.
# $Id$

=head1 NAME

tools/build/ops2c.pl - Parser for .ops files

=head1 SYNOPSIS

    % perl tools/build/ops2c.pl trans [--help] [--no-lines] [--dynamic]
                                      [--core | input.ops [input2.ops ...]]
       trans := C | CGoto | CGP | CSwitch | CPrederef

For example:

    % perl tools/build/ops2c.pl C --core

    % perl tools/build/ops2c.pl C --dynamic myops.ops

=head1 DESCRIPTION

This script uses a supplied transform to create a pair of C header and
implementation files from the operation definitions found in one or more
F<*.ops> files.

=head2 Transforms

The first command-line argument is the last package name component of a
subclass of C<Parrot::OpTrans>. These subclasses all have full names of
the form C<Parrot::OpTrans::*>. An instance of the class is created and
later consulted for various bits of information needed to generate the C
code. Each creates a different type of run loop.

=over

=item C<C>

Create the function-based (slow or fast core) run loop.

=item C<CGoto>

Create the C<goto> run loop.

=item C<CGP>

Create the C<goto> and predereferenced run loop.

=item C<CSwitch>

Create the C<switch>ed and predereferenced run loop.

=item C<CPrederef>

Create the predereferenced run loop.

=back

=head2 Options

=over 4

=item C<--help>

Print synopsis.

=item C<--dynamic>

Indicate that the opcode library is dynamic.

=item C<--core>

Build the Parrot core opcode library.

=item C<--no-lines>

Do not generate C<#line> directives in the generated C code.

=back

=head1 SEE ALSO

=over 4

=item F<tools/build/ops2pm.pl>

=item C<Parrot::OpsFile>

=item C<Parrot::Op>

=item C<Parrot::OpTrans>

=item C<Parrot::OpTrans::C>

=item C<Parrot::OpTrans::CGoto>

=item C<Parrot::OpTrans::Compiled>

=item C<Parrot::OpTrans::CGP>

=item C<Parrot::OpTrans::CSwitch>

=item C<Parrot::OpTrans::CPrederef>

=back

=cut

use warnings;
use strict;
use lib 'lib';

use Pod::Usage;
use Getopt::Long qw(:config permute);

use Parrot::OpsFile;
use Parrot::OpLib::core;
use Parrot::Config;

my %arg_dir_mapping = (
    ''   => 'PARROT_ARGDIR_IGNORED',
    'i'  => 'PARROT_ARGDIR_IN',
    'o'  => 'PARROT_ARGDIR_OUT',
    'io' => 'PARROT_ARGDIR_INOUT'
);

#
# Look at the command line options
#
sub Usage {
    pod2usage(-exitval => 1, -verbose => 0, -output => \*STDERR);
}

my ( $nolines_flag, $help_flag, $dynamic_flag, $core_flag );
GetOptions(
    "no-lines"      => \$nolines_flag,
    "help"          => \$help_flag,
    "dynamic|d"     => \$dynamic_flag,
    "core"          => \$core_flag,
) || Usage();

Usage() if $help_flag;
Usage() unless @ARGV;

my $class_name = shift @ARGV;
my %is_allowed = map { $_ => 1 } qw(C CGoto CGP CSwitch CPrederef);
Usage() unless $is_allowed{$class_name};
my $trans_class = "Parrot::OpTrans::" . $class_name;

eval "require $trans_class";

my $trans = $trans_class->new();

# Not used
my $prefix  = $trans->prefix();
my $suffix  = $trans->suffix();
# Used as ${defines}
my $defines = $trans->defines();
my $opsarraytype = $trans->opsarraytype();
my $core_type = $trans->core_type();

my $file = $core_flag ? 'core.ops' : shift @ARGV;

my $base = $file;
$base =~ s/\.ops$//;

my $incdir  = "include/parrot/oplib";
my $include = "parrot/oplib/${base}_ops${suffix}.h";
my $header  = "include/$include";
# SOURCE is closed and reread, which confuses make -j
# create a temp file and rename it
my $source  = "src/ops/${base}_ops${suffix}.c.temp";

if ($base =~ m!^src/dynoplibs/! || $dynamic_flag) {
    $source  =~ s!src/ops/!!;
    $header = "${base}_ops${suffix}.h";
    $base =~ s!^.*[/\\]!!;
    $include = "${base}_ops${suffix}.h";
    $dynamic_flag = 1;
}

my $sym_export = $dynamic_flag ? 'PARROT_DYNEXT_EXPORT' : 'PARROT_API';

my %hashed_ops;

#
# Read the input files:
#

my $ops;
if ($core_flag) {
    $ops = Parrot::OpsFile->new( [ "src/ops/$file" ], $nolines_flag );
    $ops->{OPS} = $Parrot::OpLib::core::ops;
    $ops->{PREAMBLE} = $Parrot::OpLib::core::preamble;
}
else {
    my %opsfiles;
    my @opsfiles;

    foreach my $opsfile ($file, @ARGV) {
        if ($opsfiles{$opsfile}) {
            print STDERR "$0: Ops file '$opsfile' mentioned more than once!\n";
            next;
        }

        $opsfiles{$opsfile} = 1;
        push @opsfiles, $opsfile;

        die "$0: Could not read ops file '$opsfile'!\n" unless -r $opsfile;
    }

    $ops = Parrot::OpsFile->new( \@opsfiles, $nolines_flag );

    my $cur_code = 0;
    for(@{$ops->{OPS}}) {
        $_->{CODE}=$cur_code++;
    }
}


my $version       = $ops->version;
my $major_version = $ops->major_version;
my $minor_version = $ops->minor_version;
my $patch_version = $ops->patch_version;
my $num_ops     = scalar $ops->ops;
my $num_entries = $num_ops + 1; # For trailing NULL


#
# Open the output files:
#

if (!$dynamic_flag && ! -d $incdir) {
    mkdir($incdir, 0755) or die "ops2c.pl: Could not mkdir $incdir $!!\n";
}

open HEADER, ">$header"
    or die "ops2c.pl: Cannot open header file '$header' for writing: $!!\n";

open SOURCE, ">$source"
    or die "ops2c.pl: Cannot open source file '$source' for writing: $!!\n";


#
# Print the preamble for the HEADER and SOURCE files:
#

my $preamble = <<END_C;
/* ex: set ro:
 * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 *
 * This file is generated automatically from '$file' (and possibly other
 * .ops files). by $0.
 *
 * Any changes made here will be lost!
 *
 */

END_C

my $mmp_v = "${major_version}_${minor_version}_${patch_version}";
my $init_func = "Parrot_DynOp_${base}${suffix}_$mmp_v";

print HEADER $preamble;
if ($dynamic_flag) {
    print HEADER "#define PARROT_IN_EXTENSION\n";
}
print HEADER <<END_C;
#include "parrot/parrot.h"
#include "parrot/oplib.h"

$sym_export extern op_lib_t *$init_func(long init);

END_C
my $cg_func = $trans->core_prefix . $base;


if ($trans->can("run_core_func_decl")) {
    my $run_core_func = $trans->run_core_func_decl($base);
    print HEADER "$run_core_func;\n";
}
my $bs = "${base}${suffix}_";

print SOURCE $preamble;
print SOURCE <<END_C;
#include "$include"

${defines}
static op_lib_t ${bs}op_lib;

END_C

my $text = $ops->preamble($trans);
$text =~ s/\bops_addr\b/${bs}ops_addr/g;
print SOURCE $text;


if ($trans->can("ops_addr_decl")) {
    print SOURCE $trans->ops_addr_decl($bs);
}
if ($trans->can("run_core_func_decl")) {
    print SOURCE $trans->run_core_func_decl($base);
    print SOURCE "\n{\n";
    print SOURCE $trans->run_core_func_start;
}

#
# Iterate over the ops, appending HEADER and SOURCE fragments:
#

my @op_funcs;
my @op_func_table;
my @cg_jump_table;
my $index = 0;
my ($prev_src, $prev_index);

$prev_src = '';
foreach my $op ($ops->ops) {
    my $func_name  = $op->func_name($trans);
    my $arg_types  = "$opsarraytype *, Interp *";
    my $prototype  = "$sym_export $opsarraytype * $func_name ($arg_types)";
    my $args       = "$opsarraytype *cur_opcode, Interp * interpreter";
    my $definition;
    my $comment    = '';
    my $one_op     = "";

    if ($suffix =~ /cg/) {
	$definition = "PC_$index:";
	$comment    = "/* ". $op->full_name() ." */";
    } elsif ($suffix =~ /switch/) {
	$definition = "case $index:";
	$comment    = "/* ". $op->full_name() ." */";
    }
    else {
        $definition = "$prototype;\n$opsarraytype *\n$func_name ($args)";
    }

    my $src = $op->source($trans);
    $src    =~ s/\bop_lib\b/${bs}op_lib/;
    $src    =~ s/\bops_addr\b/${bs}ops_addr/g;

    if ($suffix =~ /cg/) {
	if ($prev_src eq $src) {
	    push @cg_jump_table, "        &&PC_$prev_index,\n";
	}
	else {
	    push @cg_jump_table, "        &&PC_$index,\n";
	}
    }
    elsif ($suffix eq '') {
        push @op_func_table, sprintf("  %-50s /* %6ld */\n",
            "$func_name,", $index);
    }
    if ($prev_src eq $src) {
	push @op_funcs, "$comment\n";
    }
    else {
	$one_op .= "$definition $comment {\n$src}\n\n";
	push @op_funcs, $one_op;
	$prev_src = $src if ($suffix eq '_cgp' || $suffix eq '_switch');
	$prev_index = $index;
    }
    $index++;
}

if ($suffix =~ /cg/) {
    print SOURCE @cg_jump_table;
    print SOURCE <<END_C;
        NULL
    };
END_C
    print SOURCE $trans->run_core_after_addr_table($bs);
}

if ($suffix =~ /cgp/) {
    print SOURCE <<END_C;
#ifdef __GNUC__
# ifdef I386
    else if (cur_opcode == (opcode_t *) 1)
    asm ("jmp *4(%ebp)");	/* jump to ret addr, used by JIT */
# endif
#endif
    _reg_base = (char*)interpreter->ctx.bp.regs_i;
    goto *((void *)*cur_opcode);

END_C
} elsif ($suffix =~ /cg/) {
    print SOURCE <<END_C;
goto *${bs}ops_addr[*cur_opcode];

{'fraction_non_alphanumeric': 0.1738045496750232, 'fraction_numerical': 0.005745125348189415, 'mean_word_length': 3.391692150866463, 'pattern_counts': {'":': 0, '<': 79, '<?xml version=': 0, '>': 149, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5404249', 'n_tokens_mistral': 6810, 'n_tokens_neox': 6606, 'n_words': 1704}