Author: jkeenan Date: Tue Feb 13 19:03:08 2007 New Revision: 16975 Modified: branches/buildtools/lib/Parrot/Ops2c/Utils.pm branches/buildtools/tools/build/ops2c.pl
Log: Began refactoring code blocks in ops2c.pl which print to the .c file into Parrot::Ops2c::Utils::print_c_source_top(). (That name may change.) Passing 'make', but formal tests not yet written. Modified: branches/buildtools/lib/Parrot/Ops2c/Utils.pm ============================================================================== --- branches/buildtools/lib/Parrot/Ops2c/Utils.pm (original) +++ branches/buildtools/lib/Parrot/Ops2c/Utils.pm Tue Feb 13 19:03:08 2007 @@ -237,4 +237,250 @@ END_C } +sub print_c_source_top { + my $self = shift; + my $defines = $self->{trans}->defines(); # Invoked as: ${defines} + my $bs = "$self->{base}$self->{suffix}_"; # Also invoked as ${bs} + my $opsarraytype = $self->{trans}->opsarraytype(); + + ##### BEGIN printing to $SOURCE ##### + open my $SOURCE, '>', $self->{source} + or die "ops2c.pl: Cannot open source file '$self->{source}' for writing: $!!\n"; + + _print_preamble_source( { + fh => $SOURCE, + preamble => $self->{preamble}, + include => $self->{include}, + defines => $defines, + bs => $bs, + ops => $self->{ops}, + trans => $self->{trans}, + } ); + + _print_ops_addr_decl( { + trans => $self->{trans}, + fh => $SOURCE, + bs => $bs, + } ); + + _print_run_core_func_decl_source( { + trans => $self->{trans}, + fh => $SOURCE, + base => $self->{base}, + } ); + + # 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 => $self->{ops}, + trans => $self->{trans}, + opsarraytype => $opsarraytype, + suffix => $self->{suffix}, + bs => $bs, + sym_export => $self->{sym_export}, + } ); + + my @op_funcs = @{$op_funcs_ref}; + my @op_func_table = @{$op_func_table_ref}; + my @cg_jump_table = @{$cg_jump_table_ref}; + + _print_cg_jump_table( { + fh => $SOURCE, + cg_jump_table => [EMAIL PROTECTED], + suffix => $self->{suffix}, + trans => $self->{trans}, + bs => $bs, + } ); + + _print_goto_opcode( { + fh => $SOURCE, + suffix => $self->{suffix}, + bs => $bs, + } ); + + _print_op_function_definitions( { + fh => $SOURCE, + op_funcs => [EMAIL PROTECTED], + trans => $self->{trans}, + base => $self->{base}, + } ); + return ($SOURCE, [EMAIL PROTECTED], $bs, $index); +} + +################### + +sub _print_preamble_source { + my $argsref = shift; + my $fh = $argsref->{fh}; + + print $fh $argsref->{preamble}; + print $fh <<END_C; +#include "$argsref->{include}" + +$argsref->{defines} +static op_lib_t $argsref->{bs}op_lib; + +END_C + + my $text = $argsref->{ops}->preamble($argsref->{trans}); + $text =~ s/\bops_addr\b/$argsref->{bs}ops_addr/g; + print $fh $text; +} + +sub _print_ops_addr_decl { + my $argsref = shift; + if ( $argsref->{trans}->can("ops_addr_decl") ) { + my $fh = $argsref->{fh}; + print $fh $argsref->{trans}->ops_addr_decl($argsref->{bs}); + } else { + return; + } +} + +sub _print_run_core_func_decl_source { + my $argsref = shift; + if ( $argsref->{trans}->can("run_core_func_decl") ) { + my $fh = $argsref->{fh}; + print $fh $argsref->{trans}->run_core_func_decl($argsref->{base}); + print $fh "\n{\n"; + print $fh $argsref->{trans}->run_core_func_start; + } else { + return; + } +} + +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 = "$argsref->{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 @op_funcs, "$comment\n"; + } + else { + $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++; + } + return ($index, [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED]); +} + +sub _print_cg_jump_table { + my $argsref = shift; + my $fh = $argsref->{fh}; + 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 $fh $argsref->{trans}->run_core_after_addr_table($argsref->{bs}); + } +} + +sub _print_goto_opcode { + my $argsref = shift; + my $fh = $argsref->{fh}; + + if ( $argsref->{suffix} =~ /cgp/ ) { + print $fh <<END_C; +#ifdef __GNUC__ +# ifdef I386 + else if (cur_opcode == (void **) 1) + asm ("jmp *4(%ebp)"); /* jump to ret addr, used by JIT */ +# endif +#endif + _reg_base = (char*)interp->ctx.bp.regs_i; + goto **cur_opcode; + +END_C + } + elsif ( $argsref->{suffix} =~ /cg/ ) { + print $fh <<END_C; +goto *$argsref->{bs}ops_addr[*cur_opcode]; + +END_C + } + return 1; +} + +sub _print_op_function_definitions { + my $argsref = shift; + my $fh = $argsref->{fh}; + 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 && + $argsref->{trans}->can("run_core_split") ) + { + print $fh $argsref->{trans}->run_core_split($argsref->{base}); + } + print $fh $op_funcs[$i]; + } + + if ( $argsref->{trans}->can("run_core_finish") ) { + print $fh $argsref->{trans}->run_core_finish($argsref->{base}); + } + close($fh) || die "Unable to close after writing: $!"; +} + 1; Modified: branches/buildtools/tools/build/ops2c.pl ============================================================================== --- branches/buildtools/tools/build/ops2c.pl (original) +++ branches/buildtools/tools/build/ops2c.pl Tue Feb 13 19:03:08 2007 @@ -5,8 +5,6 @@ use strict; use Data::Dumper; use lib 'lib'; -#use Parrot::OpsFile; -#use Parrot::OpLib::core; use Parrot::Config; use Parrot::Ops2c::Auxiliary qw( Usage getoptions ); use Parrot::Ops2c::Utils; @@ -55,76 +53,9 @@ $self->print_c_header_file(); ##### END printing to $HEADER ##### -my $defines = $trans->defines(); # Invoked as: ${defines} -my $bs = "${base}${suffix}_"; # Also invoked as ${bs} -my $opsarraytype = $trans->opsarraytype(); - -##### BEGIN printing to $SOURCE ##### -open my $SOURCE, '>', $source - or die "ops2c.pl: Cannot open source file '$source' for writing: $!!\n"; +my ($SOURCE, $op_func_table_ref, $bs, $index) = $self->print_c_source_top(); -_print_preamble_source( { - fh => $SOURCE, - preamble => $preamble, - include => $include, - defines => $defines, - bs => $bs, - ops => $ops, - trans => $trans, -} ); - -_print_ops_addr_decl( { - trans => $trans, - fh => $SOURCE, - bs => $bs, -} ); - -_print_run_core_func_decl_source( { - trans => $trans, - fh => $SOURCE, - base => $base, -} ); - -# 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}; - -_print_cg_jump_table( { - fh => $SOURCE, - cg_jump_table => [EMAIL PROTECTED], - suffix => $suffix, - trans => $trans, - bs => $bs, -} ); - -_print_goto_opcode( { - fh => $SOURCE, - suffix => $suffix, - bs => $bs, -} ); - -_print_op_function_definitions( { - fh => $SOURCE, - op_funcs => [EMAIL PROTECTED], - trans => $trans, - base => $base, -} ); -####### +my @op_func_table = @{$op_func_table_ref}; # reset #line in the SOURCE file. $SOURCE = _reset_line_number( { @@ -220,175 +151,6 @@ END_C } -sub _print_preamble_source { - my $argsref = shift; - my $fh = $argsref->{fh}; - - print $fh $argsref->{preamble}; - print $fh <<END_C; -#include "$argsref->{include}" - -$argsref->{defines} -static op_lib_t $argsref->{bs}op_lib; - -END_C - - my $text = $argsref->{ops}->preamble($argsref->{trans}); - $text =~ s/\bops_addr\b/${bs}ops_addr/g; - print $fh $text; -} - -sub _print_ops_addr_decl { - my $argsref = shift; - if ( $argsref->{trans}->can("ops_addr_decl") ) { - my $fh = $argsref->{fh}; - print $fh $argsref->{trans}->ops_addr_decl($argsref->{bs}); - } else { - return; - } -} - -sub _print_run_core_func_decl_source { - my $argsref = shift; - if ( $argsref->{trans}->can("run_core_func_decl") ) { - my $fh = $argsref->{fh}; - print $fh $argsref->{trans}->run_core_func_decl($argsref->{base}); - print $fh "\n{\n"; - print $fh $argsref->{trans}->run_core_func_start; - } else { - return; - } -} - -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 @op_funcs, "$comment\n"; - } - else { - $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++; - } - return ($index, [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED]); -} - -sub _print_cg_jump_table { - my $argsref = shift; - my $fh = $argsref->{fh}; - 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 $fh $argsref->{trans}->run_core_after_addr_table($argsref->{bs}); - } -} - -sub _print_goto_opcode { - my $argsref = shift; - my $fh = $argsref->{fh}; - - if ( $argsref->{suffix} =~ /cgp/ ) { - print $fh <<END_C; -#ifdef __GNUC__ -# ifdef I386 - else if (cur_opcode == (void **) 1) - asm ("jmp *4(%ebp)"); /* jump to ret addr, used by JIT */ -# endif -#endif - _reg_base = (char*)interp->ctx.bp.regs_i; - goto **cur_opcode; - -END_C - } - elsif ( $argsref->{suffix} =~ /cg/ ) { - print $fh <<END_C; -goto *$argsref->{bs}ops_addr[*cur_opcode]; - -END_C - } - return 1; -} - -sub _print_op_function_definitions { - my $argsref = shift; - my $fh = $argsref->{fh}; - 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 && - $argsref->{trans}->can("run_core_split") ) - { - print $fh $argsref->{trans}->run_core_split($argsref->{base}); - } - print $fh $op_funcs[$i]; - } - - if ( $trans->can("run_core_finish") ) { - print $fh $trans->run_core_finish($base); - } - close($fh) || die "Unable to close after writing: $!"; -} - sub _reset_line_number { my $argsref = shift; my $fh = $argsref->{fh};