#!/usr/bin/perl

# Copyright (C) 2007 John C. Luciani Jr. 

# Calculates the MCTL value for the MSP430x1xx USART using the
# equations on pages 272-276 of SLAU049E.pdf 

use strict;
use warnings;
use Carp;
use Data::Dumper;

my @M;        # Modulation Bits
my $Max_err; # The maximum error produced using the bits in @M


# test the example in SLAU049E.pdf

if (@ARGV) {
    while (@ARGV) {
	my ($br, $brclk, $num_bits, $mctl) = splice @ARGV, 0, 4;
	die "baud rate is not defined" unless defined $br;
	die "baud rate clock is not defined" unless defined $brclk;
	$num_bits = 11 unless defined $num_bits;
	&error_table($br, $brclk, $num_bits, $mctl);
    }
} else {
    #&error_table(2400, 32768, 11, 0x6B);
    &error_table(2400, 32768, 11);
    #&error_table(57600, 4000000, 11);                    
    #&error_table(2400, 32768, 11);                    
    #&error_table(9600, 32768, 11);                    
    #&error_table(9600, 32768, 11);
    #&error_table(38400, 1000000, 11);
    #&error_table(115200, 1000000,11);
}


# error_table (1) computes values for the modulation bits and 
# (2) prints the transmit and recieve bit errors. 

# parameters --

#   $br       desired baudrate
#   $brclk    the frequency (in Hz) of the baudrate clock
#   $num_bits the number of modulations bits to calculate
#   $mctl     optional value of the MCTL register
#             this is useful for debuging. If $mctl is not
#             specified then the modulation bits that produce
#             the smallest transmit error are calculated.

sub error_table ($$$;$) {
    my ($br, $brclk, $num_bits,$mctl) = @_;
    my @mctl = defined $mctl ? ($mctl) : (0..255);
    foreach (@mctl) {
	&calc_tx_error($br, $brclk, $num_bits, $_);
    }
    &print_error_table($br, $brclk, $num_bits);
}

sub sum {
    my ($mref, $j0, $jn) = @_;
    my $sum = 0;
    map { $sum += $mref->[$_ % 8]{bit} } ($j0..$jn);
    return $sum;
}

# From SLAU049E.pdf page 274

sub rx_error {
    my ($br, $brclk, $j, $mref) = @_;
    my $uxbr = int($brclk/$br);
    my $err = (($br/$brclk) * (2 * ($mref->[0]{bit} + int($uxbr/2)) 
			       + ($j * $uxbr + &sum($mref, 1, $j)))
	       -1-$j) * 100;
}

# From SLAU049E.pdf page 273

sub tx_error {
    my ($br, $brclk, $j, $mref) = @_;
    my $uxbr = int($brclk/$br);
    my $err = (($br/$brclk) * (($j+1) * $uxbr + &sum($mref, 0, $j)) 
	       -($j + 1)) * 100;
    return($err);
}

sub m_hex {
    my $mref = shift;
    my $m = 0;
    my $bv = 1;
    foreach (0..7) {
	$m += $bv if $mref->[$_]{bit};
	$bv *= 2;
    }
    return($m);
}

sub print_error_table {
    my ($br, $brclk, $num_bits) = @_;
    printf("\n\nBaud Rate = %i\n", $br);
    printf("BR Clock  = %i\n\n", $brclk);
    printf("MCTL      = 0x%X\n", &m_hex(\@M));
    printf("UxBR1     = 0x%02X\n", int($brclk/$br)>>8);
    printf("UxBR0     = 0x%02X\n\n", int($brclk/$br));
    printf("Transmit Errors\n\n",  );
    printf("      Min Error\n----- ------------\n");
    my $max_err;
    my $line_count = 0;
    my $i = 0;
    foreach (@M) {
	my $err = $_->{err}[$_->{bit}];
	printf("m%-2i=%i err = %7.2f%%   err0 = %7.2f%%  err1 = %7.2f%%\n", 
	       $i++,
	       $_->{bit}, 
	       $err, 
	       $_->{err}[0], 
	       $_->{err}[1]);
	$max_err = $err unless defined $max_err && abs($max_err) > abs($err);
	printf("----- -------------\n") if ++$line_count % 4 == 0;
    }
    printf("      max = %7.2f%%\n", $max_err);
    printf("\nReceive Errors\n\n",  &m_hex(\@M));
    printf("      Min Error\n----- ------------\n");
    $max_err = undef;
    $line_count = 0;
    foreach (0..$num_bits-1) {
	my $err = &rx_error($br, $brclk, $_, \@M);
	printf("m%-2i=%i err = %7.2f%%\n", $_, $M[$_]{bit}, $err);
	$max_err = $err unless defined $max_err && abs($max_err) > abs($err);
	printf("----- -------------\n") if ++$line_count % 4 == 0;
    }
    printf("      max = %7.2f%%\n", $max_err);

}

sub calc_tx_error {
    my ($br, $brclk, $num_bits, $mctl) = @_;
    my @m;
    my @bits;
    my $max_err;
    if (defined $mctl) {
	foreach (0..7) {
	    push @bits, $mctl & 2**$_ ? 1 : 0;
	}
    }
    foreach my $j (0..$num_bits - 1) {
	my @err;
	$m[$j]{bit} = 0;
	$err[0] = &tx_error($br, $brclk, $j, \@m);
	$m[$j]{bit} = 1;
	$err[1] = &tx_error($br, $brclk, $j, \@m);
	my $bit;

	# There are 8 modulation bits. If we are past the eighth bit
	# then wrap-around otherwise if a bit was passed in the
	# subroutine call then use it otherwise use the bit with the
	# lowest error.

	if ($j > 7) {
	    $bit = $m[$j % 8]{bit};
	} elsif (defined $bits[$j]) {
	    $bit = $bits[$j];
	} else {
	    $bit = abs($err[0]) < abs($err[1]) ? 0 : 1;
	}
	$max_err = abs($err[$bit]) unless defined $max_err && $max_err > abs($err[$bit]);
	return -1 if defined $Max_err && $Max_err < $max_err;
	$m[$j] = { bit => $bit,
		   err => [$err[0], $err[1]] }; 
    }
    printf("%s%02X", defined $Max_err ? ',' : 'Best MCTL ', $mctl);
    $Max_err = $max_err;
    @M = @m;
    return 0;
}


# Style (adapted from the Perl Cookbook, First Edition, Recipe 12.4)

# 1. Names of functions and local variables are all lowercase.
# 2. The program's persistent variables (either file lexicals
#    or package globals) are capitalized.
# 3. Identifiers with multiple words have each of these
#    separated by an underscore for readability.
# 4. Constants are all uppercase.
# 5. If the arrow operator (->) is followed by either a
#    method name or a variable containing a method name then
#    there is a space before and after the operator.