Author: jkeenan
Date: Sat Feb 10 11:10:33 2007
New Revision: 16937
Modified:
branches/buildtools/tools/build/ops2c.pl
Log:
Extensive refactoring of code from blocks into subroutines, moving from the
end of the file back towards the beginning. Passes 'make'. More to come.
Modified: branches/buildtools/tools/build/ops2c.pl
==============================================================================
--- branches/buildtools/tools/build/ops2c.pl (original)
+++ branches/buildtools/tools/build/ops2c.pl Sat Feb 10 11:10:33 2007
@@ -6,7 +6,6 @@
use lib 'lib';
use Getopt::Long qw(:config permute);
-use Data::Dumper;
use Parrot::OpsFile;
use Parrot::OpLib::core;
@@ -40,7 +39,7 @@
my $suffix = $trans->suffix(); # Invoked (sometimes) as ${suffix}
my $file = $flagref->{core} ? 'core.ops' : shift @ARGV;
-my $base = $file;
+my $base = $file; # Invoked (sometimes) as ${base}
$base =~ s/\.ops$//;
my $incdir = "include/parrot/oplib";
@@ -92,9 +91,11 @@
}
}
-my $major_version = $ops->major_version;
-my $minor_version = $ops->minor_version;
-my $patch_version = $ops->patch_version;
+my %versions = (
+ major => $ops->major_version,
+ minor => $ops->minor_version,
+ patch => $ops->patch_version,
+);
my $num_ops = scalar $ops->ops;
my $num_entries = $num_ops + 1; # For trailing NULL
@@ -112,9 +113,7 @@
q{Parrot},
q{DynOp},
$base . $suffix,
- $major_version,
- $minor_version,
- $patch_version
+ @versions{ qw(major minor patch) },
);
# Open the C-header (.h) file
@@ -139,7 +138,6 @@
my $run_core_func = $trans->run_core_func_decl($base);
print $HEADER "$run_core_func;\n";
}
-my $bs = "${base}${suffix}_"; # Also invoked as ${bs}
_print_coda($HEADER);
@@ -147,14 +145,15 @@
##### END printing to $HEADER #####
my $defines = $trans->defines(); # Invoked as: ${defines}
+my $bs = "${base}${suffix}_"; # Also invoked as ${bs}
my $opsarraytype = $trans->opsarraytype();
-my $core_type = $trans->core_type();
my %arg_dir_mapping = (
'' => 'PARROT_ARGDIR_IGNORED',
'i' => 'PARROT_ARGDIR_IN',
'o' => 'PARROT_ARGDIR_OUT',
'io' => 'PARROT_ARGDIR_INOUT'
);
+#my $core_type = $trans->core_type();
##### BEGIN printing to $SOURCE #####
open my $SOURCE, '>', $source
@@ -183,76 +182,237 @@
print $SOURCE $trans->run_core_func_start;
}
-#
# Iterate over the ops, appending HEADER and SOURCE fragments:
-#
+my $op_funcs_ref;
+my $op_func_table_ref;
+my $cg_jump_table_ref;
+my $index;
+
+($index, $op_funcs_ref, $op_func_table_ref, $cg_jump_table_ref) =
+ _iterate_over_ops( {
+ ops => $ops,
+ trans => $trans,
+ opsarraytype => $opsarraytype,
+ suffix => $suffix,
+ bs => $bs,
+ } );
+
+my @op_funcs = @{$op_funcs_ref};
+my @op_func_table = @{$op_func_table_ref};
+my @cg_jump_table = @{$cg_jump_table_ref};
-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 *interp";
- 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)";
- }
+_print_cg_jump_table( {
+ source => $SOURCE,
+ cg_jump_table => [EMAIL PROTECTED],
+ suffix => $suffix,
+ trans => $trans,
+ bs => $bs,
+} );
+
+_print_goto_opcode( {
+ source => $SOURCE,
+ suffix => $suffix,
+ bs => $bs,
+} );
+
+_print_op_function_definitions( {
+ source => $SOURCE,
+ op_funcs => [EMAIL PROTECTED],
+ trans => $trans,
+ base => $base,
+} );
+
+# reset #line in the SOURCE file.
+$SOURCE = _reset_line_number( {
+ flag => $flagref,
+ source => $SOURCE,
+ sourcefile => $source,
+} );
+
+my ($op_info, $op_func, $getop) = _op_func_table( {
+ suffix => $suffix,
+ bs => $bs,
+ num_ops => $num_ops,
+ num_entries => $num_entries,
+ op_func_table => [EMAIL PROTECTED],
+ source => $SOURCE,
+} );
+
+my $namesref = {};
+($namesref, $op_info, $index) = _op_info_table( {
+ suffix => $suffix,
+ bs => $bs,
+ source => $SOURCE,
+ op_info => $op_info,
+ num_entries => $num_entries,
+ index => $index,
+ ops => $ops,
+ names => $namesref,
+} );
+
+$getop = _op_lookup( {
+ getop => $getop,
+ suffix => $suffix,
+ flag => $flagref,
+ index => $index,
+ names => $namesref,
+ source => $SOURCE,
+ num_ops => $num_ops,
+ bs => $bs,
+} );
+
+_print_op_lib_descriptor( {
+ source => $SOURCE,
+ bs => $bs,
+ base => $base,
+ suffix => $suffix,
+ trans => $trans,
+ versions => \%versions,
+ num_ops => $num_ops,
+ op_info => $op_info,
+ op_func => $op_func,
+ getop => $getop,
+} );
+
+_generate_init_func( {
+ trans => $trans,
+ base => $base,
+ bs => $bs,
+ source => $SOURCE,
+ init_func => $init_func,
+} );
+
+_print_dynamic_lib_load( {
+ flag => $flagref,
+ base => $base,
+ suffix => $suffix,
+ source => $SOURCE,
+ sym_export => $sym_export,
+ init_func => $init_func,
+} );
+
+_print_coda($SOURCE);
+
+close $SOURCE or die "Unable to close handle to $source: $!";
+##### END printing to $SOURCE #####
+
+_rename_source($source);
+
+exit 0;
+
+
+#################### SUBROUTINES ####################
+
+sub _compose_preamble {
+ my ($file, $script) = @_;
+ 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 $script.
+ *
+ * Any changes made here will be lost!
+ *
+ */
- my $src = $op->source($trans);
- $src =~ s/\bop_lib\b/${bs}op_lib/g;
- $src =~ s/\bops_addr\b/${bs}ops_addr/g;
+END_C
+ return $preamble;
+}
+
+sub _print_coda {
+ my $fh = shift;
+ print $fh <<END_C;
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
+END_C
+}
- if ( $suffix =~ /cg/ ) {
+sub _iterate_over_ops {
+ my $argsref = shift;
+ my @op_funcs;
+ my @op_func_table;
+ my @cg_jump_table;
+ my $index = 0;
+ my ( $prev_src, $prev_index );
+
+ $prev_src = '';
+ foreach my $op ( $argsref->{ops}->ops ) {
+ my $func_name = $op->func_name($argsref->{trans});
+ my $arg_types = "$argsref->{opsarraytype} *, Interp *";
+ my $prototype = "$sym_export $argsref->{opsarraytype} * $func_name
($arg_types)";
+ my $args = "$argsref->{opsarraytype} *cur_opcode, Interp *interp";
+ my $definition;
+ my $comment = '';
+ my $one_op = "";
+
+ if ( $argsref->{suffix} =~ /cg/ ) {
+ $definition = "PC_$index:";
+ $comment = "/* " . $op->full_name() . " */";
+ }
+ elsif ( $argsref->{suffix} =~ /switch/ ) {
+ $definition = "case $index:";
+ $comment = "/* " . $op->full_name() . " */";
+ }
+ else {
+ $definition = "$prototype;\n$argsref->{opsarraytype} *\n$func_name
($args)";
+ }
+
+ my $src = $op->source($argsref->{trans});
+ $src =~ s/\bop_lib\b/$argsref->{bs}op_lib/g;
+ $src =~ s/\bops_addr\b/$argsref->{bs}ops_addr/g;
+
+ if ( $argsref->{suffix} =~ /cg/ ) {
+ if ( $prev_src eq $src ) {
+ push @cg_jump_table, " &&PC_$prev_index,\n";
+ }
+ else {
+ push @cg_jump_table, " &&PC_$index,\n";
+ }
+ }
+ elsif ( $argsref->{suffix} eq '' ) {
+ push @op_func_table, sprintf( " %-50s /* %6ld */\n",
"$func_name,", $index );
+ }
if ( $prev_src eq $src ) {
- push @cg_jump_table, " &&PC_$prev_index,\n";
+ push @op_funcs, "$comment\n";
}
else {
- push @cg_jump_table, " &&PC_$index,\n";
+ $one_op .= "$definition $comment {\n$src}\n\n";
+ push @op_funcs, $one_op;
+ $prev_src = $src if ( $argsref->{suffix} eq '_cgp' ||
$argsref->{suffix} eq '_switch' );
+ $prev_index = $index;
}
+ $index++;
}
- 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++;
+ return ($index, [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED]);
}
-if ( $suffix =~ /cg/ ) {
- print $SOURCE @cg_jump_table;
- print $SOURCE <<END_C;
+sub _print_cg_jump_table {
+ my $argsref = shift;
+ my $fh = $argsref->{source};
+ my @cg_jump_table = @{$argsref->{cg_jump_table}};
+
+ if ( $argsref->{suffix} =~ /cg/ ) {
+ print $fh @cg_jump_table;
+ print $fh <<END_C;
NULL
};
END_C
- print $SOURCE $trans->run_core_after_addr_table($bs);
+ print $fh $argsref->{trans}->run_core_after_addr_table($argsref->{bs});
+ }
}
-if ( $suffix =~ /cgp/ ) {
- print $SOURCE <<END_C;
+sub _print_goto_opcode {
+ my $argsref = shift;
+ my $fh = $argsref->{source};
+
+ if ( $argsref->{suffix} =~ /cgp/ ) {
+ print $fh <<END_C;
#ifdef __GNUC__
# ifdef I386
else if (cur_opcode == (void **) 1)
@@ -263,136 +423,151 @@
goto **cur_opcode;
END_C
-}
-elsif ( $suffix =~ /cg/ ) {
- print $SOURCE <<END_C;
-goto *${bs}ops_addr[*cur_opcode];
+ }
+ elsif ( $argsref->{suffix} =~ /cg/ ) {
+ print $fh <<END_C;
+goto *$argsref->{bs}ops_addr[*cur_opcode];
END_C
+ }
+ return 1;
}
-print $SOURCE <<END_C;
+sub _print_op_function_definitions {
+ my $argsref = shift;
+ my $fh = $argsref->{source};
+ my @op_funcs = @{$argsref->{op_funcs}};
+ print $fh <<END_C;
/*
** Op Function Definitions:
*/
END_C
-#
-# Finish the SOURCE file's array initializer:
-#
-my $CORE_SPLIT = 300;
-for ( my $i = 0 ; $i < @op_funcs ; $i++ ) {
- if ( $i && $i % $CORE_SPLIT == 0 && $trans->can("run_core_split") ) {
- print $SOURCE $trans->run_core_split($base);
+ # Finish the SOURCE file's array initializer:
+ my $CORE_SPLIT = 300;
+ for ( my $i = 0 ; $i < @op_funcs ; $i++ ) {
+ if ( $i &&
+ $i % $CORE_SPLIT == 0 &&
+ $argsref->{trans}->can("run_core_split") )
+ {
+ print $fh $argsref->{trans}->run_core_split($argsref->{base});
+ }
+ print $fh $op_funcs[$i];
}
- print $SOURCE $op_funcs[$i];
-}
-
-if ( $trans->can("run_core_finish") ) {
- print $SOURCE $trans->run_core_finish($base);
+
+ if ( $trans->can("run_core_finish") ) {
+ print $fh $trans->run_core_finish($base);
+ }
+ close($fh) || die "Unable to close after writing: $!";
}
-#
-# reset #line in the SOURCE file.
-#
-
-close($SOURCE);
-open( $SOURCE, '<', $source ) || die "Error re-reading $source: $!\n";
-my $line = 0;
-while (<$SOURCE>) { $line++; }
-$line += 2;
-close($SOURCE);
-open( $SOURCE, '>>', $source ) || die "Error appending to $source: $!\n";
-unless ($flagref->{nolines}) {
- my $source_escaped = $source;
- $source_escaped =~ s|\.temp||;
- $source_escaped =~ s|(\\)|$1$1|g; # escape backslashes
- print $SOURCE qq{#line $line "$source_escaped"\n};
+sub _reset_line_number {
+ my $argsref = shift;
+ my $fh = $argsref->{source};
+ my $source = $argsref->{sourcefile};
+ my $line = 0;
+ open( $fh, '<', $source ) || die "Error re-reading $source: $!\n";
+ while (<$fh>) { $line++; }
+ $line += 2;
+ close($fh) || die "Error closing $source: $!";
+ open( $fh, '>>', $source ) || die "Error appending to $source: $!\n";
+ unless ($flagref->{nolines}) {
+ my $source_escaped = $source;
+ $source_escaped =~ s|\.temp||;
+ $source_escaped =~ s|(\\)|$1$1|g; # escape backslashes
+ print $fh qq{#line $line "$source_escaped"\n};
+ }
+ return $fh; # filehandle remains open
}
-#
-# write op_func_func
-#
-
-my ( $op_info, $op_func, $getop );
-$op_info = $op_func = 'NULL';
-$getop = '( int (*)(const char *, int) )NULL';
-
-if ( $suffix eq '' ) {
- $op_func = "${bs}op_func_table";
- print $SOURCE <<END_C;
+sub _op_func_table {
+ my $argsref = shift;
+ my $fh = $argsref->{source};
+ my ( $op_info, $op_func, $getop );
+ $op_info = $op_func = 'NULL';
+ $getop = '( int (*)(const char *, int) )NULL';
+
+ if ( $argsref->{suffix} eq '' ) {
+ $op_func = $argsref->{bs} . q{op_func_table};
+ print $fh <<END_C;
-INTVAL ${bs}numops${suffix} = $num_ops;
+INTVAL $argsref->{bs}numops$argsref->{suffix} = $argsref->{num_ops};
/*
** Op Function Table:
*/
-static op_func${suffix}_t ${op_func}\[$num_entries] = {
+static op_func$argsref->{suffix}_t ${op_func}\[$argsref->{num_entries}] = {
END_C
- print $SOURCE @op_func_table;
+ print $fh @{$argsref->{op_func_table}};
- print $SOURCE <<END_C;
- (op_func${suffix}_t)0 /* NULL function pointer */
+ print $fh <<END_C;
+ (op_func$argsref->{suffix}_t)0 /* NULL function pointer */
};
END_C
+ }
+ return ($op_info, $op_func, $getop);
}
-my ( %names, $tot );
-if ( $suffix eq '' ) {
- $op_info = "${bs}op_info_table";
-
- #
- # Op Info Table:
- #
- print $SOURCE <<END_C;
+sub _op_info_table {
+ my $argsref = shift;
+ my $fh = $argsref->{source};
+ my %names = %{$argsref->{names}};
+
+ if ( $argsref->{suffix} eq '' ) {
+ $argsref->{op_info} = "$argsref->{bs}op_info_table";
+
+ #
+ # Op Info Table:
+ #
+ print $fh <<END_C;
/*
** Op Info Table:
*/
-static op_info_t $op_info\[$num_entries] = {
+static op_info_t $argsref->{op_info}\[$argsref->{num_entries}] = {
END_C
- $index = 0;
-
- foreach my $op ( $ops->ops ) {
- my $type = sprintf( "PARROT_%s_OP", uc $op->type );
- my $name = $op->name;
- $names{$name} = 1;
- my $full_name = $op->full_name;
- my $func_name = $op->func_name($trans);
- my $body = $op->body;
- my $jump = $op->jump || 0;
- my $arg_count = $op->size;
-
- ## 0 inserted if arrays are empty to prevent msvc compiler errors
- my $arg_types = "{ "
- . join( ", ",
- scalar $op->arg_types
- ? map { sprintf( "PARROT_ARG_%s", uc $_ ) } $op->arg_types
- : 0 )
- . " }";
- my $arg_dirs = "{ "
- . join(
- ", ", scalar $op->arg_dirs
- ? map { $arg_dir_mapping{$_} } $op->arg_dirs
- : 0
- ) . " }";
- my $labels = "{ "
- . join(
- ", ", scalar $op->labels
- ? $op->labels
- : 0
- ) . " }";
- my $flags = 0;
-
- print $SOURCE <<END_C;
- { /* $index */
+ $argsref->{index} = 0;
+
+ foreach my $op ( $argsref->{ops}->ops ) {
+ my $type = sprintf( "PARROT_%s_OP", uc $op->type );
+ my $name = $op->name;
+ $names{$name} = 1;
+ my $full_name = $op->full_name;
+ my $func_name = $op->func_name($trans);
+ my $body = $op->body;
+ my $jump = $op->jump || 0;
+ my $arg_count = $op->size;
+
+ ## 0 inserted if arrays are empty to prevent msvc compiler errors
+ my $arg_types = "{ "
+ . join( ", ",
+ scalar $op->arg_types
+ ? map { sprintf( "PARROT_ARG_%s", uc $_ ) } $op->arg_types
+ : 0 )
+ . " }";
+ my $arg_dirs = "{ "
+ . join(
+ ", ", scalar $op->arg_dirs
+ ? map { $arg_dir_mapping{$_} } $op->arg_dirs
+ : 0
+ ) . " }";
+ my $labels = "{ "
+ . join(
+ ", ", scalar $op->labels
+ ? $op->labels
+ : 0
+ ) . " }";
+ my $flags = 0;
+
+ print $fh <<END_C;
+ { /* $argsref->{index} */
/* type $type, */
"$name",
"$full_name",
@@ -407,29 +582,35 @@
},
END_C
- $index++;
- }
- print $SOURCE <<END_C;
+ $argsref->{index}++;
+ }
+ print $fh <<END_C;
};
END_C
+ }
+ return (\%names, $argsref->{op_info}, $argsref->{index});
}
-if ( $suffix eq '' && !$flagref->{dynamic} ) {
- $getop = 'get_op';
- my $hash_size = 3041;
- $tot = $index + scalar keys(%names);
- if ( $hash_size < $tot * 1.2 ) {
- print STDERR "please increase hash_size ($hash_size) in
tools/build/ops2c.pl "
- . "to a prime number > ", $tot * 1.2, "\n";
- }
- print $SOURCE <<END_C;
+sub _op_lookup {
+ my $argsref = shift;
+ my $fh = $argsref->{source};
+
+ if ( $argsref->{suffix} eq '' && !$argsref->{flag}->{dynamic} ) {
+ $argsref->{getop} = 'get_op';
+ my $hash_size = 3041;
+ my $tot = $argsref->{index} + scalar keys(%{$argsref->{names}});
+ if ( $hash_size < $tot * 1.2 ) {
+ print STDERR "please increase hash_size ($hash_size) in
tools/build/ops2c.pl "
+ . "to a prime number > ", $tot * 1.2, "\n";
+ }
+ print $fh <<END_C;
/*
** Op lookup function:
*/
-#define NUM_OPS $num_ops
+#define NUM_OPS $argsref->{num_ops}
#define OP_HASH_SIZE $hash_size
@@ -495,18 +676,18 @@
}
for (p = hop[hidx]; p; p = p->next) {
if(!strcmp(name, full ? p->info->full_name : p->info->name))
- return p->info - ${bs}op_lib.op_info_table;
+ return p->info - $argsref->{bs}op_lib.op_info_table;
}
return -1;
}
static void hop_init() {
size_t i;
- op_info_t * info = ${bs}op_lib.op_info_table;
+ op_info_t * info = $argsref->{bs}op_lib.op_info_table;
/* store full names */
- for (i = 0; i < ${bs}op_lib.op_count; i++)
+ for (i = 0; i < $argsref->{bs}op_lib.op_count; i++)
store_op(info + i, 1);
/* plus one short name */
- for (i = 0; i < ${bs}op_lib.op_count; i++)
+ for (i = 0; i < $argsref->{bs}op_lib.op_count; i++)
if (get_op(info[i].name, 0) == -1)
store_op(info + i, 0);
}
@@ -527,54 +708,64 @@
}
END_C
-
-}
-else {
- print $SOURCE <<END_C;
+ return $argsref->{getop};
+ } else {
+ print $fh <<END_C;
static void hop_deinit(void) {}
END_C
+ return $argsref->{getop};
+ }
}
-print $SOURCE <<END_C;
+sub _print_op_lib_descriptor {
+ my $argsref = shift;
+ my $fh = $argsref->{source};
+ my $trans = $argsref->{trans};
+ my $core_type = $trans->core_type();
+ print $fh <<END_C;
/*
** op lib descriptor:
*/
-static op_lib_t ${bs}op_lib = {
- "$base", /* name */
- "$suffix", /* suffix */
- $core_type, /* core_type = PARROT_XX_CORE */
- 0, /* flags */
- $major_version, /* major_version */
- $minor_version, /* minor_version */
- $patch_version, /* patch_version */
- $num_ops, /* op_count */
- $op_info, /* op_info_table */
- $op_func, /* op_func_table */
- $getop /* op_code() */
+static op_lib_t $argsref->{bs}op_lib = {
+ "$argsref->{base}", /* name */
+ "$argsref->{suffix}", /* suffix */
+ $core_type, /* core_type = PARROT_XX_CORE */
+ 0, /* flags */
+ $argsref->{versions}->{major}, /* major_version */
+ $argsref->{versions}->{minor}, /* minor_version */
+ $argsref->{versions}->{patch}, /* patch_version */
+ $argsref->{num_ops}, /* op_count */
+ $argsref->{op_info}, /* op_info_table */
+ $argsref->{op_func}, /* op_func_table */
+ $argsref->{getop} /* op_code() */
};
END_C
-
-# generate initfunc
-my $init1_code = "";
-if ( $trans->can("init_func_init1") ) {
- $init1_code = $trans->init_func_init1($base);
-}
-
-my $init_set_dispatch = "";
-if ( $trans->can("init_set_dispatch") ) {
- $init_set_dispatch = $trans->init_set_dispatch($bs);
}
-print $SOURCE <<END_C;
+sub _generate_init_func {
+ my $argsref = shift;
+ my $fh = $argsref->{source};
+ my $init1_code = "";
+ if ( $argsref->{trans}->can("init_func_init1") ) {
+ $init1_code = $argsref->{trans}->init_func_init1($argsref->{base});
+ }
+
+ my $init_set_dispatch = "";
+ if ( $argsref->{trans}->can("init_set_dispatch") ) {
+ $init_set_dispatch
+ = $argsref->{trans}->init_set_dispatch($argsref->{bs});
+ }
+
+ print $fh <<END_C;
op_lib_t *
-$init_func(long init) {
+$argsref->{init_func}(long init) {
/* initialize and return op_lib ptr */
if (init == 1) {
$init1_code
- return &${bs}op_lib;
+ return &$argsref->{bs}op_lib;
}
/* set op_lib to the passed ptr (in init) */
else if (init) {
@@ -588,28 +779,7 @@
}
END_C
-
-_print_dynamic_lib_load( {
- flag => $flagref,
- base => $base,
- suffix => $suffix,
- source => $SOURCE,
- sym_export => $sym_export,
- init_func => $init_func,
-} );
-
-_print_coda($SOURCE);
-
-close $SOURCE or die "Unable to close handle to $source: $!";
-##### END printing to $SOURCE #####
-
-
-_rename_source($source);
-
-exit 0;
-
-
-#################### SUBROUTINES ####################
+}
sub _print_dynamic_lib_load {
my $argsref = shift;
@@ -639,36 +809,6 @@
}
}
-sub _compose_preamble {
- my ($file, $script) = @_;
- 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 $script.
- *
- * Any changes made here will be lost!
- *
- */
-
-END_C
- return $preamble;
-}
-
-sub _print_coda {
- my $fh = shift;
- print $fh <<END_C;
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
-END_C
-}
-
sub _rename_source {
my $source = shift;
my $final = $source;
