#!/usr/bin/perl -w
#
# Copyright (C) 2005-2009 FAUmachine Team <info@faumachine.org>.
# This program is free software. You can redistribute it and/or modify it
# under the terms of the GNU General Public License, either version 2 of
# the License, or (at your option) any later version. See COPYING.
#

#FIXME JOSEF: take care that no .text.* get section patched too

$DEBUG = 0;
$PROGRAM = "preasm_patcher.pl";

$GEN_HEAD = "\t/* Generated by $PROGRAM */	\n";
$GEN_TAIL = "\t/* End of $PROGRAM */		\n";
$in_file = $ARGV[0];
$out_file = $ARGV[1];
# when specified, sections beginning with default names .text, .data .rodata*
# get prefixed with that name

$section_prefix = $ARGV[2];

@def_sec_names = ('.text','.data','.rodata');

sub check_section_spec
{

	my ($section);
	my ($line);
	($line) = @_;

	# ".section" keyword
	if ($line =~ /^\s*\.section\b\s*([\.\w]*)/) {
		$section = $1;
	
	# ".text" keyword
	} elsif ($line =~ /^\s*\.text\s*/) {
		$section = ".text";
	
	# ".data" keyword
	} elsif ($line =~ /^\s*\.data\s*/) {;
		$section = ".data";

	# No section specifier
	} else {
		$section = undef;
	}
	
	return $section;
}

# FIXME JOSEF: section prefix
##if (defined($section_prefix) and ($section_prefix =~ /--sec-prefix=((\.|\w)*)/)) {
##	$section_prefix = $1;
##} else {
	$section_prefix = undef;
##}

open(INFILE, $in_file) 
	|| die "$PROGRAM: unable to open input file \"$in_file\" ($!)";

my ($cur_sect);
$cur_sect = ".text";
my %local_labels = ();

# First pass: collect necessary data 
while (defined($line = <INFILE>)) {
	if (defined(check_section_spec($line))) {
		$cur_sect =  check_section_spec($line);
	} elsif ($line =~ /\s*(.*):.*/) {
		$local_labels{$1} = [$cur_sect];
	}# Nothing todo any more 
}

# Second pass: patch it
seek(INFILE, 0, 0);
open(OUT, ">$out_file") 
	|| die "$PROGRAM: unable to open output file \"$out_file\" ($!)";


@patched_func_bodies = ();
$code_size = 32;
$func_body = undef;
$cur_sect = ".text";

while (defined($line = <INFILE>)) {
	

	# Detect 32-bit code
	if ($line =~ /\s*\.code32\b\s*/) {
		if ($DEBUG) {
			print OUT "/* $PROGRAM: Begin of 32-bit code */\n";
		}
		$code_size = 32;
	} elsif ($line =~ /\s*\.code16(|gcc)\b\s*/) {
		if ($code_size eq 32) {
			$code_size = 16;
			if ($DEBUG) {
				print OUT "/* $PROGRAM: End of 32-bit code */\n";
			}
		}
	}

	#Detect current section
	if (defined(check_section_spec($line))) {
		$cur_sect = check_section_spec($line);
		if ($DEBUG) {
			print OUT "/* $PROGRAM: Begin of section: $cur_sect */\n";
		}
	}

	## Patch default section names
	if (defined($section_prefix) and defined(check_section_spec($line))) {

		## .section pseudo opcode
		$new_line = undef;
		foreach $s (@def_sec_names) {
			$_ = $line;
			# REMEMBER: from whitespace to "." is no \b pattern
			s/\s*\.section\b\s*${s}/\t.section ${section_prefix}${s}/;
			if ($_ ne $line) {
				$new_line = $_;
				last;
			}
		}

		## .data and .text pseudo opcode
		if (not defined($new_line)) {
			$_ = $line;
			s/^\s*\.text\s*/\t.section ${section_prefix}.text, "ax", \@progbits\n/;
			s/^\s*\.data\s*/\t.section ${section_prefix}.data, "ax", \@progbits\n/;
			$new_line = $_;
		}

		## Write patched line
		if ($new_line ne $line) {
			if ($DEBUG) {
				print OUT $GEN_HEAD, "\t/* section patch */	\n";
				## FIXME JOSEF: prettier
				print OUT "/* old section spec: $line */	\n";
				print OUT $GEN_TAIL;
			}
			print OUT $new_line;
		} else {
			print OUT $line; 
		}

	# Patch "RET NEAR" instruction
	} elsif ($code_size eq 16 && $line =~ /\bret(\b|;)/i) {

		print OUT $GEN_HEAD;
		print OUT "\t/* target: func return */ 	\n";
		print OUT "\tlretw		\n";
		print OUT $GEN_TAIL;

		push(@patched_func_bodies, $func_body);
	# Patch "CALL NEAR" instruction
	} elsif ($code_size eq 16 && $line =~ /\bcall\b\s*\b((\w|_).*)\b/) {
		$func = $1;
		print OUT $GEN_HEAD;
		print OUT "\t/* call to function $func */\n";
		print OUT "\tex_lcall	$func		 \n";
		print OUT $GEN_TAIL;

	# Patch "JMP NEAR" instruction
	} elsif ($code_size eq 16 && $line =~ /\bjmp\b\s*\b((\w|_)\w*)\b/) {
		$src_sect = $cur_sect;
		$tar_label = $1;
		$tar_type = undef;
		$instr_type = undef;
		# Local label
		if ($tar_label =~ /\d(b|f)/) {
			print OUT $line;
		} else {
			if (grep($tar_label eq $_, keys %local_labels)) {
				$tar_sect = $local_labels{$tar_label}[0]; 
				if ($src_sect eq $tar_sect) {
					# Source and Dest. in same section
					$tar_type = "local (same section)";
					$instr_type = "near";
				} else {
					# Source and Dest. in different sections
					$tar_type = "local (diff. section)";
					$instr_type = "far";

				}
			} else {
				$tar_type = "external";
				$tar_sect = "*unknown*";
				$instr_type = "far";
			}
			if ($DEBUG) {
				print OUT $GEN_HEAD;
				print OUT "\t/* jump from section: ${src_sect} to ${tar_type} label ${tar_label} section: ${tar_sect} */\n";
			}
			if ($instr_type eq "far") {
				print OUT "\tex_ljmp $tar_label	\n";
			} elsif ($instr_type eq "near") {
				print OUT "\tjmp $tar_label	\n";
			}
			if ($DEBUG) {
				print OUT $GEN_TAIL;
			}
		}
# No code to patch
	} else {
		print OUT "$line";
	}
}

close(INFILE) 
	|| die "$PROGRAM: unable to close input file \"$in_file\" ($!)";
close(OUT) 
	|| die "$PROGRAM: unable to close output file \"$in_file\" ($!)";


if ($DEBUG) {
	$all_bodies = join(",", @patched_func_bodies);
	print "patched function bodies: $all_bodies\n"
}